;;; -*- 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))))))) ) ))