Inherit FP modes for new threads on Windows.

[sbcl.git] / src / code / query.lisp

diff --git a/src/code/query.lisp b/src/code/query.lisp
index aa6dab7..4dc5d6a 100644 (file)
--- a/src/code/query.lisp
+++ b/src/code/query.lisp
@@ -11,57 +11,52 @@
 
 (in-package "SB!IMPL")
 
-(defun query-readline ()
+(defun query-read-char ()
+  (clear-input *query-io*)
+  (prog1 (read-char *query-io*)
+    (clear-input *query-io*)))
+
+(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 like "(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")))))))