From 0607c87ca54b672b0485613ad0991aa55119ec07 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 22 Feb 1990 10:14:31 +0000
Subject: [PATCH] Initial revision

---
 code/query.lisp | 79 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 code/query.lisp

diff --git a/code/query.lisp b/code/query.lisp
new file mode 100644
index 000000000..c5ca1b451
--- /dev/null
+++ b/code/query.lisp
@@ -0,0 +1,79 @@
+;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; Querying the user.
+;;; Written by Walter van Roggen, 27 December 1982.
+;;; Brought up to date and fixed somewhat by Rob MacLachlan.
+;;; Modified by Bill Chiles.
+;;;
+;;; These functions are part of the standard Spice Lisp environment.
+;;;
+;;; **********************************************************************
+;;;
+
+(in-package "LISP")
+
+(export '(y-or-n-p yes-or-no-p))
+
+(eval-when (compile)
+  (defmacro query-readline ()
+    `(string-trim " 	" (read-line *query-io*))))
+
+;;; Y-OR-N-P  --  Public.
+;;;
+;;; This prints the message, if any, and reads characters from *QUERY-IO* until
+;;; any of "y", "Y", or <newline> are seen as an affirmative, or either "n" or
+;;; "N" is seen as a negative answer.  It ignores preceding whitespace and asks
+;;; again if other characters are seen.
+;;;
+(defun y-or-n-p (&optional format-string &rest arguments)
+  "Y-OR-N-P prints the message, if any, and reads characters from
+   *QUERY-IO* until any of y, Y, or <newline> are seen as an 
+   affirmative, or either n or N is seen as a negative answer.
+   It ignores preceding whitespace and asks again if other characters
+   are seen."
+  (when format-string
+    (fresh-line *query-io*)
+    (apply #'format *query-io* format-string arguments)
+    (force-output *query-io*))
+  (loop
+    (let* ((line (query-readline))
+	   (ans (if (string= line "") :ignore-and-warn (schar line 0))))
+      (unless (whitespacep ans)
+	(case ans
+	  ((#\y #\Y) (return t))
+	  ((#\n #\N) (return nil))
+	  (t
+	   (write-line "Type \"y\" for yes or \"n\" for no. " *query-io*)
+	   (when format-string
+	     (apply #'format *query-io* format-string arguments))
+	   (force-output *query-io*)))))))
+
+;;; YES-OR-NO-P  --  Public.
+;;;
+;;; 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)
+  "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 "Type \"yes\" for yes or \"no\" for no. " *query-io*)
+	   (when format-string
+	     (apply #'format *query-io* format-string arguments))))))
-- 
GitLab