Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/query.clisp
There are no other files named query.clisp in the archive.
;;; This is a -*-Lisp-*- file.
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; Querying the user.
;;; Written by Walter van Roggen, 27 December 1982.
;;;
;;; These functions are part of the standard Spice Lisp environment.
;;;
;;; **********************************************************************
;;;
(in-package 'lisp)
(export '(beep y-or-n-p yes-or-no-p))
;;; Y-OR-N-P prints the message, if any, and reads characters from
;;; *QUERY-IO* until any of "y", "Y", or <newline> are seen as an
;;; affirmative, or either "n" or "N" is seen as a negative answer.
;;; It ignores preceding whitespace and asks again if other characters
;;; are seen.
;;; YES-OR-NO-P is similar, except that it clears the input buffer,
;;; beeps, and uses READ-LINE to get "YES" or "NO".
(defun beep (stream)
"Beeps on the given stream."
(princ #\ stream))
(defun query-readline ()
(string-trim " " (read-line *query-io*)))
(defun y-or-n-p (&optional format-string &rest arguments)
"Prints the message on the given stream and reads characters until any of
y, Y, n, or N are seen."
(when format-string
(fresh-line *query-io*)
(apply #'format *query-io* format-string arguments))
(do ((ans (query-readline) (query-readline)))
(())
(case (unless (zerop (length ans)) (char ans 0))
((#\y #\Y) (return t))
((#\n #\N) (return nil))
(t
(write-line "Type \"y\" for yes or \"n\" for no. " *query-io*)
(when format-string
(apply #'format *query-io* format-string arguments))))))
(defun yes-or-no-p (&optional format-string &rest arguments)
"Similar to Y-OR-N-P, except that it clears the input buffer,
beeps, and uses READ-LINE to get YES or NO."
(clear-input *query-io*)
(beep *query-io*)
(when format-string
(fresh-line *query-io*)
(apply #'format *query-io* format-string arguments))
(do ((ans (query-readline) (query-readline)))
(())
(cond ((string-equal "YES" ans) (return t))
((string-equal "NO" ans) (return nil))
(t
(write-line "Type \"yes\" for yes or \"no\" for no. " *query-io*)
(when format-string
(apply #'format *query-io* format-string arguments))))))