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 (file-comment
  15   "$Header$")
  16
  17 (defun query-readline ()
  18   (force-output *query-io*)
  19   (string-trim "        " (read-line *query-io*)))
  20
  21 ;;; FIXME: The ANSI documentation for these says that they
  22 ;;; prompt with strings a la "(Y or N)" or "(Yes or No)", but
  23 ;;; these implementations don't.
  24
  25 (defun y-or-n-p (&optional format-string &rest arguments)
  26   #!+sb-doc
  27   "Y-OR-N-P prints the message, if any, and reads characters from *QUERY-IO*
  28    until the user enters y or Y as an affirmative, or either n or N as a
  29    negative answer. It ignores preceding whitespace and asks again if you
  30    enter any other characters."
  31   (when format-string
  32     (fresh-line *query-io*)
  33     (apply #'format *query-io* format-string arguments))
  34   (loop
  35     (let* ((line (query-readline))
  36            (ans (if (string= line "")
  37                     #\? ;Force CASE below to issue instruction.
  38                     (schar line 0))))
  39       (unless (sb!impl::whitespacep ans)
  40         (case ans
  41           ((#\y #\Y) (return t))
  42           ((#\n #\N) (return nil))
  43           (t
  44            (write-line "Please type \"y\" for yes or \"n\" for no. "
  45                        *query-io*)
  46            (when format-string
  47              (apply #'format *query-io* format-string arguments))
  48            (force-output *query-io*)))))))
  49
  50 ;;; This is similar to Y-OR-N-P, but it clears the input buffer, beeps, and
  51 ;;; uses READ-LINE to get "YES" or "NO".
  52 (defun yes-or-no-p (&optional format-string &rest arguments)
  53   #!+sb-doc
  54   "YES-OR-NO-P is similar to Y-OR-N-P, except that it clears the
  55    input buffer, beeps, and uses READ-LINE to get the strings
  56    YES or NO."
  57   (clear-input *query-io*)
  58   (beep)
  59   (when format-string
  60     (fresh-line *query-io*)
  61     (apply #'format *query-io* format-string arguments))
  62   (do ((ans (query-readline) (query-readline)))
  63       (())
  64     (cond ((string-equal ans "YES") (return t))
  65           ((string-equal ans "NO") (return nil))
  66           (t
  67            (write-line "Please type \"yes\" for yes or \"no\" for no. "
  68                        *query-io*)
  69            (when format-string
  70              (apply #'format *query-io* format-string arguments))))))