X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fquery.lisp;h=4dc5d6ac92ebbdd60a59215f5a17146aa6038f0a;hb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;hp=3bfdd224df03ce61367c2c2fa9c5a8599846d585;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/query.lisp b/src/code/query.lisp
index 3bfdd22..4dc5d6a 100644
--- a/src/code/query.lisp
+++ b/src/code/query.lisp
@@ -11,60 +11,52 @@
 
 (in-package "SB!IMPL")
 
-(file-comment
-  "$Header$")
+(defun query-read-char ()
+  (clear-input *query-io*)
+  (prog1 (read-char *query-io*)
+    (clear-input *query-io*)))
 
-(defun query-readline ()
+(defun query-read-line ()
   (force-output *query-io*)
-  (string-trim " 	" (read-line *query-io*)))
+  (string-trim " " (read-line *query-io*)))
+
+(defun maybe-print-query (hint format-string &rest format-args)
+  (fresh-line *query-io*)
+  (when format-string
+    (apply #'format *query-io* format-string format-args)
+    (write-char #\Space *query-io*))
+  (format *query-io* "~A " hint)
+  (finish-output *query-io*))
 
-;;; FIXME: The ANSI documentation for these says that they
-;;; prompt with strings a la "(Y or N)" or "(Yes or No)", but
-;;; these implementations don't.
+(defun clarify-legal-query-input (yes no)
+  (format *query-io* "~&Please type \"~A\" for yes or \"~A\" for no.~%"
+          yes no))
 
 (defun y-or-n-p (&optional format-string &rest arguments)
   #!+sb-doc
-  "Y-OR-N-P prints the message, if any, and reads characters from *QUERY-IO*
-   until the user enters y or Y as an affirmative, or either n or N as a
-   negative answer. It ignores preceding whitespace and asks again if you
-   enter any other characters."
-  (when format-string
-    (fresh-line *query-io*)
-    (apply #'format *query-io* format-string arguments))
-  (loop
-    (let* ((line (query-readline))
-	   (ans (if (string= line "")
-		    #\? ;Force CASE below to issue instruction.
-		    (schar line 0))))
-      (unless (sb!impl::whitespacep ans)
-	(case ans
-	  ((#\y #\Y) (return t))
-	  ((#\n #\N) (return nil))
-	  (t
-	   (write-line "Please type \"y\" for yes or \"n\" for no. "
-		       *query-io*)
-	   (when format-string
-	     (apply #'format *query-io* format-string arguments))
-	   (force-output *query-io*)))))))
+  "Y-OR-N-P prints the message, if any, and reads characters from
+   *QUERY-IO* until the user enters y or Y as an affirmative, or either
+   n or N as a negative answer. It asks again if you enter any other
+   characters."
+  (flet ((print-query ()
+           (apply #'maybe-print-query "(y or n)" format-string arguments)))
+    (loop (print-query)
+          (case (query-read-char)
+            ((#\y #\Y) (return t))
+            ((#\n #\N) (return nil))
+            (t (clarify-legal-query-input "y" "n"))))))
 
-;;; This is similar to Y-OR-N-P, but it clears the input buffer, beeps, and
-;;; uses READ-LINE to get "YES" or "NO".
 (defun yes-or-no-p (&optional format-string &rest arguments)
   #!+sb-doc
   "YES-OR-NO-P is similar to Y-OR-N-P, except that it clears the
    input buffer, beeps, and uses READ-LINE to get the strings
    YES or NO."
-  (clear-input *query-io*)
-  (beep)
-  (when format-string
-    (fresh-line *query-io*)
-    (apply #'format *query-io* format-string arguments))
-  (do ((ans (query-readline) (query-readline)))
-      (())
-    (cond ((string-equal ans "YES") (return t))
-	  ((string-equal ans "NO") (return nil))
-	  (t
-	   (write-line "Please type \"yes\" for yes or \"no\" for no. "
-		       *query-io*)
-	   (when format-string
-	     (apply #'format *query-io* format-string arguments))))))
+  (flet ((print-query ()
+           (apply #'maybe-print-query "(yes or no)" format-string arguments)))
+    (beep *query-io*)
+    (loop (print-query)
+          (let ((input (query-read-line)))
+            (cond
+              ((string-equal input "yes") (return t))
+              ((string-equal input "no") (return nil))
+              (t (clarify-legal-query-input "yes" "no")))))))