Google
 

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))))))