;;; 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.
;;; Spice Lisp is currently incomplete and under active development.
;;; 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.
;;;
;;; **********************************************************************
;;;
;;; 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 y-or-n-p (&optional message (stream *query-io*))
  (when message
	(fresh-line stream)
	(princ message stream))
  (do ((ch (read-char stream) (read-char stream))	;doesn't work quite yet
       (retval))
      ((case ch
	((#\y #\Y) (setq retval t) t)			;affirmative
	((#\n #\N) (setq retval ()) t)			;negative
	((#\space #\tab #\linefeed #\newline #\return) nil) ;ignore
	(t (fresh-line stream)
	  (princ "Type \"y\" for yes or \"n\" for no. " stream)
	  (when message			;ask again
		(fresh-line stream)
		(princ message stream))
	  nil))
       retval)))	;null body

(defun yes-or-no-p (&optional message (stream *query-io*))
  (when message
	(fresh-line stream)
	(beep stream)
	(princ message stream))
  (clear-input stream)
  (do ((ans (read-line stream) (read-line stream))
       (retval))
      ((cond ((string-equal "YES" ans) (setq retval t) t)
	     ((string-equal "NO" ans) (setq retval nil) t)
	     (t (fresh-line stream)
		(beep stream)
		(princ "Type \"yes\" for yes or \"no\" for no. " stream)
		(when message		;ask again
		    (fresh-line stream)
		    (princ message stream))
		nil ))
       retval)
    ))	;null body