;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.25
;;; Reason:
;;;  In prompting mechanism for FQUERY, modified printing of timeout values
;;;  to use TIME:PRINT-INTERVAL-OR-NEVER.  This gives much more intelligible 
;;;  intervals; for example, 
;;;    (Automatic default after 1 week 3 days, Y)
;;;  instead of
;;;    (Automatic default after 864000 seconds, Y)
;;;  
;;;  This new behavior shows up, of course, in Y-OR-N-P-WITH-TIMEOUT
;;;  and friends.
;;; Written 3-Jun-88 20:05:08 by keith (Keith M. Corbett) at site Gigamos Cambridge
;;; while running on Breaking Glass from band 3
;;; with Experimental System 124.24, Experimental Local-File 74.1, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.1, microcode 1756, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.IO1; FQUERY.LISP#57 at 3-Jun-88 20:05:54
#8R FORMAT#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FORMAT")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO1; FQUERY  "


(DEFUN FQUERY-PROMPT (STREAM &REST IGNORE)
  (AND FQUERY-FORMAT-STRING
       (APPLY #'FORMAT STREAM FQUERY-FORMAT-STRING FQUERY-FORMAT-ARGS))
  (AND FQUERY-LIST-CHOICES
       (DO ((CHOICES FQUERY-CHOICES (CDR CHOICES))
	    (FIRST-P T NIL)
	    (MANY (> (LENGTH FQUERY-CHOICES) 2))
	    (CHOICE))
	   ((NULL CHOICES)
	    (OR FIRST-P
		(SEND STREAM :STRING-OUT ") ")))
	 (SEND STREAM :STRING-OUT (COND (FIRST-P "(")
					    ((NOT (NULL (CDR CHOICES))) ", ")
					    (MANY ", or ")
					    (T " or ")))
	 (IF (EQ (CAR CHOICES) :ANY)
	     (SEND STREAM :STRING-OUT "anything else")
	   (SETQ CHOICE (CADAR CHOICES))
; character lossage
	   (COND ((TYPEP CHOICE '(OR NUMBER CHARACTER))
		  (FORMAT STREAM "~:@C" CHOICE))
		 ((EQUAL CHOICE "")
		  (PRINC "nothing" STREAM))
		 (T
		  (SEND STREAM :STRING-OUT CHOICE))))))
  (AND FQUERY-TIMEOUT
    ;attempt to print out what will return default-value.
       (DO ((CHOICES FQUERY-CHOICES (CDR CHOICES))
	    (choice))
	   ((NULL CHOICES)
	    (FORMAT STREAM "(Automatic default returns ~s after ~a) "
		    fquery-default-value
		    (time:print-interval-or-never
		      (// fquery-timeout 60.)
		      nil)))
	 (setq choice (car choices))
	 (cond ((eq choice :any))
	       ((equal fquery-default-value
		       (if (consp (car choice))
			   (caar choice)
			 (car choice)))
		(return
		  (format stream "(Automatic default after ~a, ~a) "
			  (time:print-interval-or-never
			    (// fquery-timeout 60.)
			    nil)
			  (cadr choice)))))))
)

))
