;;;-*- Mode:Common-Lisp; Package:FORMAT; Cold-load:T; Base:8. -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.

;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151

;;; Copyright (C) 1985-1989 Texas Instruments Incorporated. All rights reserved.
;;; ** (c) Copyright 1980 Massachusetts Institute of Technology **


(DEFUN Y-OR-N-P (&OPTIONAL FORMAT-STRING &REST FORMAT-ARGS)
  "Ask the user a question he can answer with Y or N.
Passes the arguments to FORMAT.
With no args, asks the question without printing anything but the \"(Y or N)\".
Returns T if the answer was yes."
  (FQUERY Y-OR-N-P-OPTIONS
	  (AND FORMAT-STRING
	       (IF (= (AREF FORMAT-STRING (1- (LENGTH FORMAT-STRING))) #\SP)
		   "~&~?" "~&~? "))
	  FORMAT-STRING
	  FORMAT-ARGS))


(DEFUN YES-OR-NO-P (&OPTIONAL FORMAT-STRING &REST FORMAT-ARGS)
  "Ask the user a question he can answer with Yes or No.
Beeps and passes the arguments to FORMAT.
With no args, asks the question without printing anything but the \"(Yes or No)\".
Returns T if the answer was yes."
  (FQUERY YES-OR-NO-P-OPTIONS
	  (AND FORMAT-STRING
	       (IF (= (AREF FORMAT-STRING (1- (LENGTH FORMAT-STRING))) #\SP)
		   "~&~?" "~&~? "))
	  FORMAT-STRING
	  FORMAT-ARGS))

;; the following definitions are used in mini-builds. Please leave them commented out AND in the file --- DRH

;;;(DEFUN Y-OR-N-P (&OPTIONAL FORMAT-STRING &REST FORMAT-ARGS)
;;;  "Ask the user a question he can answer with Y or N.
;;;Passes the arguments to FORMAT.
;;;With no args, asks the question without printing anything but the \"(Y or N)\".
;;;Returns T if the answer was yes."
;;;  (IF FORMAT-STRING
;;;      (FORMAT *QUERY-IO*
;;;	      (LET ((LEN (LENGTH FORMAT-STRING)))
;;;		(IF (OR (= LEN 0)(= (AREF FORMAT-STRING (1- LEN)) #\SP))
;;;		    "~&~?(Y or N) "
;;;		    "~&~? (Y or N) "))
;;;	      FORMAT-STRING FORMAT-ARGS)
;;;      (PRINC " (Y or N) " *QUERY-IO*))
;;;  (IF (CHAR-EQUAL (PEEK-CHAR NIL *QUERY-IO*) #\HELP)
;;;      (PROGN (READ-CHAR *QUERY-IO*)
;;;	     (TERPRI *QUERY-IO*)
;;;	     (PRINC "(Type Y (Yes) or N (No)) " *QUERY-IO*)
;;;	     (APPLY #'Y-OR-N-P FORMAT-STRING FORMAT-ARGS))
;;;      (LET ((CH (READ-CHAR *QUERY-IO*)))
;;;	(COND
;;;	  ((MEMBER CH '(#\Y #\T #\SPACE #\HAND-UP) :TEST #'CHAR-EQUAL)
;;;           (PRINC "Yes." *QUERY-IO*)
;;;           T)
;;;	  ((MEMBER CH '(#\N #\F #\RUBOUT #\HAND-DOWN) :TEST #'CHAR-EQUAL)
;;;           (PRINC "No." *QUERY-IO*)
;;;           NIL)
;;;	  (T (APPLY #'Y-OR-N-P FORMAT-STRING FORMAT-ARGS))))))

;;;(DEFUN YES-OR-NO-P (&OPTIONAL FORMAT-STRING &REST FORMAT-ARGS)
;;;  "Ask the user a question he can answer with Yes or No.
;;;beeps and passes the arguments to FORMAT.
;;;With no args, asks the question without printing anything but the \"(Yes or No)\".
;;;Returns T if the answer was yes."
;;;  (BEEP NIL *QUERY-IO*)
;;;  (IF FORMAT-STRING
;;;      (FORMAT *QUERY-IO*
;;;	      (LET ((LEN (LENGTH FORMAT-STRING)))
;;;		(IF (OR (= LEN 0)(= (AREF FORMAT-STRING (1- LEN)) #\SP))
;;;		    "~&~?(Yes or No) "
;;;		    "~&~? (Yes or No) "))
;;;	      FORMAT-STRING FORMAT-ARGS)
;;;      (PRINC "(Yes or No) " *QUERY-IO*))
;;;  (IF (CHAR-EQUAL (PEEK-CHAR NIL *QUERY-IO*) #\HELP)
;;;    (PROGN (READ-CHAR *QUERY-IO*)
;;;	   (TERPRI *QUERY-IO*)
;;;	   (PRINC "(Type Yes or No) " *QUERY-IO*)
;;;	   (APPLY #'YES-OR-NO-P FORMAT-STRING FORMAT-ARGS))
;;;    (LET ((STRING (ZLC:READLINE *QUERY-IO*)))
;;;      (COND
;;;	((STRING-EQUAL "YES" STRING) T)
;;;	((STRING-EQUAL "NO" STRING) NIL)
;;;	(T (APPLY #'YES-OR-NO-P FORMAT-STRING FORMAT-ARGS))))))