;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 122.10
;;; Reason:
;;;  If Peek window is deexposed for a long time, when you reexpose it, it won't
;;;  update the display -- frozen in the past!
;;; Written 29-Jul-87 12:19:41 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Azathoth from band 4
;;; with Experimental System 122.9, Experimental Local-File 73.0, Experimental FILE-Server 22.0, Experimental Unix-Interface 11.0, Experimental Tape 17.1, Experimental Tiger 26.0, Experimental KERMIT 33.1, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Site Data Editor 5.0, microcode 1754, SDU Boot Tape 3.12, SDU ROM 102, the old ones.



; From modified file DJ: L.WINDOW; PEEK.LISP#195 at 29-Jul-87 12:25:02
#8R TV#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; PEEK  "

(find-package '(arp))

(DEFUN PEEK-TOP-LEVEL (WINDOW MODE)
  (COND-EVERY
    ((AND MODE (SYMBOLP MODE)) (SETQ MODE (SYMBOL-NAME MODE)))
    ((STRINGP MODE) (SETQ MODE (CHAR MODE 0)))
    ((CHARACTERP MODE) (SETQ MODE (CHAR-INT MODE)))
;character lossage
    ((NUMBERP MODE) (SEND WINDOW :FORCE-KBD-INPUT MODE)))
  (BLOCK PEEK
    (DO-FOREVER
      (CATCH-ERROR-RESTART ((SYS:ABORT ERROR) "Return to PEEK command level.")
	(DO ((SLEEP-TIME PEEK-SLEEP-TIME)
	     (WAKEUP-TIME (TIME-DIFFERENCE (TIME) (- PEEK-SLEEP-TIME)))
	     (wakeup-time-passed nil)
	     (*TERMINAL-IO* (SEND WINDOW :TYPEOUT-WINDOW))
	     (ARG)
	     (CHAR))
	    (())
	  (when (or (TIME-LESSP WAKEUP-TIME (TIME)) wakeup-time-passed)
	    (SETQ WAKEUP-TIME (TIME-DIFFERENCE (TIME) (- SLEEP-TIME)))
	    (setq wakeup-time-passed nil))
	  (OR (= SLEEP-TIME 0)
	      (PROCESS-WAIT "Peek Timeout or TYI"
			    (LAMBDA (TIME FLAG-LOC STREAM PEEK-WINDOW)
				(if (SHEET-EXPOSED-P PEEK-WINDOW)
				    (OR wakeup-time-passed
					(TIME-LESSP TIME (TIME))
					(CONTENTS FLAG-LOC)
					(SEND STREAM :LISTEN))
				  ;;If sheet not exposed, notice when wakeup-time is passed
				  ;;If we don't do this and sheet is deexposed for a long time, peek
				  ;;stops redisplaying
				  (when (time-lessp time (time))
				    (setq wakeup-time-passed t)
				    nil)))
			    WAKEUP-TIME
			    (LOCATE-IN-INSTANCE WINDOW 'NEEDS-REDISPLAY)
			    *TERMINAL-IO*
			    (SEND WINDOW :ALIAS-FOR-SELECTED-WINDOWS)))
	  (DO ()
	      ((PROGN (PEEK-ASSURE-NO-TYPEOUT WINDOW)
		      (NULL (SETQ CHAR (SEND *TERMINAL-IO* :ANY-TYI-NO-HANG)))))
	    (COND-EVERY
	      ((CONSP CHAR)
	       ;; A special command (forced input, no doubt)
	       (CASE (CAR CHAR)
		 (SUPDUP (SUPDUP (CADR CHAR)))
		 (SUPDUP:TELNET (TELNET (CADR CHAR)))
		 (QSEND (QSEND (CADR CHAR))
			(SEND WINDOW :SET-NEEDS-REDISPLAY T)
			(SEND *TERMINAL-IO* :MAKE-COMPLETE))
		 (EH (EH (CADR CHAR)))
		 (INSPECT (INSPECT (CADR CHAR)))
		 (DESCRIBE (DESCRIBE (CADR CHAR)))
		 (arp:addr-stat (arp:addr-stat (cadr char)))
		 (:MENU (SETQ CHAR (FIRST (THIRD (SECOND CHAR)))))
		 (:mouse-button
		  (mouse-call-system-menu))
		 (OTHERWISE (BEEP)))
	       (SETQ ARG NIL))
	      ((NUMBERP CHAR)
	       (SETQ CHAR (INT-CHAR CHAR)))
	      ((CHARACTERP CHAR)
	       ;; Standard character, either accumulate arg or select new mode
	       (SETQ CHAR (CHAR-UPCASE CHAR))
	       (IF (DIGIT-CHAR-P CHAR)
		   (SETQ ARG (+ (* 10. (OR ARG 0)) (DIGIT-CHAR-P CHAR)))
		 (IF (PEEK-SET-MODE WINDOW CHAR ARG)
		     (SETQ ARG NIL)
		   ;; Check for standard character assignments
		   (CASE CHAR
		     (#/HELP
		      (SEND *STANDARD-OUTPUT* :CLEAR-WINDOW)
		      (LET (INPUT)
			(SETQ INPUT (SEND *STANDARD-INPUT* :LISTEN))
			(UNLESS INPUT
			  (FORMAT T "The Peek program shows a continuously updating status display.
  There are several modes that display different status.
  Here is a list of modes.  Select a mode by typing the character
  or by clicking on the corresponding menu item.~2%"))
			(DOLIST (E *PEEK-DEFAULT-MODE-ALIST*)
			  (WHEN (OR INPUT (SETQ INPUT (SEND *STANDARD-INPUT* :LISTEN)))
			    (RETURN))
			  (FORMAT T "~:@C~5T~A~%~@[~6T~A~%~]"
				  (FIRST E) (THIRD E) (FIFTH E)))
			(UNLESS INPUT
			  (FORMAT T "~%Q~5TQuit.~%")
			  (FORMAT T "nZ~5TSets sleep time between updates to n seconds.~2%")
			  (FORMAT T "[Help]  Prints this message.~2%")))
		      (SETQ ARG NIL))
		     (#/Q
		      (RETURN-FROM PEEK NIL))
		     (#/Z
		      (AND ARG (SETQ SLEEP-TIME (* 60. ARG)))
		      (SEND WINDOW :SET-NEEDS-REDISPLAY T)
		      (SETQ ARG NIL))
		     (#/SPACE (SEND WINDOW :SET-NEEDS-REDISPLAY T))
		     (OTHERWISE (BEEP))))))))
	  (WHEN (OR (SEND WINDOW :NEEDS-REDISPLAY) (TIME-LESSP WAKEUP-TIME (TIME)))
	    ;; We want to redisplay.  If have typeout, hang until user confirms.
	    (SEND WINDOW :SET-NEEDS-REDISPLAY NIL)
	    (SEND WINDOW :REDISPLAY)))))))

))