src/code/query.lisp

   1 ;;;; querying the user: Y-OR-N-P, YES-OR-NO-P
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!IMPL")
  13
  14 (defun query-read-char ()
  15   (clear-input *query-io*)
  16   (prog1 (read-char *query-io*)
  17     (clear-input *query-io*)))
  18
  19 (defun query-read-line ()
  20   (force-output *query-io*)
  21   (string-trim #.(concatenate 'string '(#\Space #\Tab))
  22                (read-line *query-io*)))
  23
  24 (defun maybe-print-query (hint format-string &rest format-args)
  25   (fresh-line *query-io*)
  26   (when format-string
  27     (apply #'format *query-io* format-string format-args)
  28     (write-char #\Space *query-io*))
  29   (format *query-io* "~A " hint)
  30   (finish-output *query-io*))
  31
  32 (defun clarify-legal-query-input (yes no)
  33   (format *query-io* "~&Please type \"~A\" for yes or \"~A\" for no.~%"
  34           yes no))
  35
  36 (defun y-or-n-p (&optional format-string &rest arguments)
  37   #!+sb-doc
  38   "Y-OR-N-P prints the message, if any, and reads characters from
  39    *QUERY-IO* until the user enters y or Y as an affirmative, or either
  40    n or N as a negative answer. It asks again if you enter any other
  41    characters."
  42   (flet ((print-query ()
  43            (apply #'maybe-print-query "(y or n)" format-string arguments)))
  44     (loop (print-query)
  45           (case (query-read-char)
  46             ((#\y #\Y) (return t))
  47             ((#\n #\N) (return nil))
  48             (t (clarify-legal-query-input "y" "n"))))))
  49
  50 (defun yes-or-no-p (&optional format-string &rest arguments)
  51   #!+sb-doc
  52   "YES-OR-NO-P is similar to Y-OR-N-P, except that it clears the
  53    input buffer, beeps, and uses READ-LINE to get the strings
  54    YES or NO."
  55   (flet ((print-query ()
  56            (apply #'maybe-print-query "(yes or no)" format-string arguments)))
  57     (beep *query-io*)
  58     (loop (print-query)
  59           (let ((input (query-read-line)))
  60             (cond
  61               ((string-equal input "yes") (return t))
  62               ((string-equal input "no") (return nil))
  63               (t (clarify-legal-query-input "yes" "no")))))))