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