;;; -*- Mode: LISP;  Package: TV;  Base: 8 -*-
;;;	** (c) Copyright 1981 Massachusetts Institute of Technology **

;;; Hairier who-line system

(DEFFLAVOR WHO-LINE-SCREEN () (NO-CHANGE-OF-DEFAULT-FONT-MIXIN SCREEN))

(DEFMETHOD (WHO-LINE-SCREEN :USER-VISIBLE) () NIL)  

(DEFFLAVOR WHO-LINE-MIXIN ((WHO-LINE-ITEM-STATE NIL)) ()
				;WHO-LINE-ITEM-STATE is NIL if the contents of the window
				;is unknown and needs to be redrawn.  If non-NIL it
				;represents the current contents, to avoid extra redisplay.
  (:INCLUDED-FLAVORS MINIMUM-WINDOW)
  (:DEFAULT-INIT-PLIST :MORE-P NIL :BLINKER-P NIL)
  (:REQUIRED-METHODS :UPDATE)
  (:SELECT-METHOD-ORDER :UPDATE)
  (:INIT-KEYWORDS :FLAVOR)
  :INITABLE-INSTANCE-VARIABLES
  :SETTABLE-INSTANCE-VARIABLES
  :GETTABLE-INSTANCE-VARIABLES)

(DEFWRAPPER (WHO-LINE-MIXIN :UPDATE) (IGNORE . BODY)
  `(WITHOUT-INTERRUPTS
     (AND (SHEET-CAN-GET-LOCK SELF)
	  (NOT (SHEET-OUTPUT-HELD-P SELF))
	  (PROGN . ,BODY))))

(DEFMETHOD (WHO-LINE-MIXIN :AFTER :REFRESH) (&OPTIONAL TYPE)
  (COND ((NOT (AND RESTORED-BITS-P (NEQ TYPE ':SIZE-CHANGED)))
	 (FUNCALL-SELF ':CLOBBERED)
	 (FUNCALL-SELF ':UPDATE))))

;;; Should this actually do the updates here??
(DEFMETHOD (WHO-LINE-MIXIN :CLOBBERED) ()
  (SETQ WHO-LINE-ITEM-STATE NIL))

(DEFFLAVOR WHO-LINE-SHEET
	((WHO-LINE-UPDATE-FUNCTION NIL) (WHO-LINE-EXTRA-STATE NIL))
	(WHO-LINE-MIXIN MINIMUM-WINDOW)
  :INITABLE-INSTANCE-VARIABLES
  :SETTABLE-INSTANCE-VARIABLES
  :GETTABLE-INSTANCE-VARIABLES)

(DEFMETHOD (WHO-LINE-SHEET :BEFORE :INIT) (PLIST)
  (PUTPROP PLIST (GET PLIST ':WHO-LINE-UPDATE-FUNCTION) ':NAME))

(DEFMETHOD (WHO-LINE-SHEET :UPDATE) ()
  (AND WHO-LINE-UPDATE-FUNCTION
       (FUNCALL WHO-LINE-UPDATE-FUNCTION SELF)))

(DEFUN WHO-LINE-SETUP ()
  (COND ((NULL WHO-LINE-SCREEN)
	 (LET ((SHEET-AREA WHO-LINE-AREA))
	   (SETQ WHO-LINE-SCREEN
		 (DEFINE-SCREEN 'WHO-LINE-SCREEN "Who Line Screen"
			   	':DEFAULT-FONT FONTS:CPTFONT	;not *DEFAULT-FONT*
				':BUFFER (LSH 77 18.)
				':CONTROL-ADDRESS 377760
				':PROPERTY-LIST '(:VIDEO :BLACK-AND-WHITE
						  :CONTROLLER :SIMPLE
						  :WHO-LINE T)
				':WIDTH MAIN-SCREEN-WIDTH
				':CHARACTER-HEIGHT 2
				':VSP 0
				':Y NIL	;Force this to be calculated
				':BOTTOM MAIN-SCREEN-HEIGHT)))
	 ;; 18 characters of the date and time
	 (SETQ NWATCH-WHO-LINE-SHEET
	       (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-SHEET
			       ':WHO-LINE-UPDATE-FUNCTION 'NWATCH-WHO-FUNCTION
			       ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			       ':LEFT 0 ':RIGHT 144. ':BOTTOM (SHEET-HEIGHT WHO-LINE-SCREEN)))
	 ;; 13 characters of user id or process
	 (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-SHEET
			 ':WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-USER-OR-PROCESS
			 ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			 ':LEFT 144. ':RIGHT 248. ':BOTTOM (SHEET-HEIGHT WHO-LINE-SCREEN))
	 ;; 18 characters of package
	 (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-SHEET
			 ':WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-PACKAGE
			 ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			 ':LEFT 248. ':RIGHT 392. ':BOTTOM (SHEET-HEIGHT WHO-LINE-SCREEN))
	 ;; 11 characters of process state
	 (SETQ WHO-LINE-RUN-STATE-SHEET
	       (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-SHEET
			       ':WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-RUN-STATE
			       ':LEFT 392. ':RIGHT 480.
			       ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			       ':BOTTOM (SHEET-HEIGHT WHO-LINE-SCREEN)))
	 ;; The remaining 36 characters go to the file/idle/boot state
	 (SETQ WHO-LINE-FILE-STATE-SHEET
	       (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-FILE-SHEET
			       ':LEFT 480. ':RIGHT 768.
			       ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			       ':BOTTOM (SHEET-HEIGHT WHO-LINE-SCREEN)))
	 ;; Above those windows is a full line of mouse button documentation
	 (SETQ WHO-LINE-DOCUMENTATION-WINDOW
	       (WHO-LINE-FIELD ':FLAVOR 'WHO-LINE-SHEET
			       ':WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-DOCUMENTATION-FUNCTION
			       ':HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)
			       ':TOP 0 ':REVERSE-VIDEO-P T)))))

(DEFUN WHO-LINE-UPDATE (&OPTIONAL RUN-STATE-ONLY-P &AUX RL)
  (OR INHIBIT-WHO-LINE
      (NULL WHO-LINE-SCREEN)
      (WITHOUT-INTERRUPTS
	(SETQ RL (%XBUS-READ WHO-LINE-RUN-LIGHT-LOC))	;Don't clobber run light
	(IF RUN-STATE-ONLY-P
	    ;; The reason this is here is that this function conspires to do some
	    ;; minor nice things for you.  This note is here to remind HIC not to
	    ;; clean up this code.  --HIC
	    (AND WHO-LINE-RUN-STATE-SHEET
		 (FUNCALL WHO-LINE-RUN-STATE-SHEET ':UPDATE))
	    (DOLIST (I (SHEET-EXPOSED-INFERIORS WHO-LINE-SCREEN))
	      (AND (TYPEP I 'WHO-LINE-MIXIN)
		   (FUNCALL I ':UPDATE))))
	(%XBUS-WRITE WHO-LINE-RUN-LIGHT-LOC RL)))
  T)

(DEFUN WHO-LINE-CLOBBERED ()
  (AND WHO-LINE-SCREEN
       (DOLIST (I (SHEET-INFERIORS WHO-LINE-SCREEN))
	 (AND (TYPEP I 'WHO-LINE-MIXIN) (FUNCALL I ':CLOBBERED)))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-SHEET) 
(DEFUN WHO-LINE-STRING (WHO-SHEET NEW-STRING)
  (COND ((NEQ WHO-LINE-ITEM-STATE NEW-STRING)
	 (PREPARE-SHEET (WHO-SHEET)
	   (SHEET-CLEAR WHO-SHEET)
	   (SHEET-STRING-OUT WHO-SHEET NEW-STRING
			     0 (MIN (STRING-LENGTH NEW-STRING)
				    (// (SHEET-INSIDE-WIDTH WHO-SHEET)
					(SHEET-CHAR-WIDTH WHO-SHEET)))))
	 (SETQ WHO-LINE-ITEM-STATE NEW-STRING)))))

(DEFUN WHO-LINE-USER-OR-PROCESS (WHO-SHEET)
  (WHO-LINE-STRING WHO-SHEET (IF WHO-LINE-PROCESS (PROCESS-NAME WHO-LINE-PROCESS) USER-ID)))

(DEFUN WHO-LINE-RUN-STATE (WHO-SHEET)
  (WHO-LINE-STRING WHO-SHEET WHO-LINE-RUN-STATE))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-SHEET) 
(DEFUN WHO-LINE-PACKAGE (WHO-SHEET &AUX VAL SG)
  (LET ((PKG (COND ((SETQ LAST-WHO-LINE-PROCESS (OR WHO-LINE-PROCESS
						    (AND SELECTED-IO-BUFFER
							 (IO-BUFFER-LAST-OUTPUT-PROCESS
							   SELECTED-IO-BUFFER))))
		    (SETQ SG (PROCESS-STACK-GROUP LAST-WHO-LINE-PROCESS))
		    (COND ((EQ SG %CURRENT-STACK-GROUP) PACKAGE)
			  ((TYPEP SG ':STACK-GROUP) (SYMEVAL-IN-STACK-GROUP 'PACKAGE SG))
			  (T PACKAGE))))))
    (COND ((AND PKG (ARRAYP PKG)
		(NEQ WHO-LINE-ITEM-STATE (SETQ VAL (PKG-NAME PKG))))
	   (PREPARE-SHEET (WHO-SHEET)
	     (SHEET-CLEAR WHO-SHEET)
	     (SHEET-STRING-OUT WHO-SHEET VAL
			       0 (MIN (STRING-LENGTH VAL)
				      (1- (// (SHEET-INSIDE-WIDTH WHO-SHEET)
					      (SHEET-CHAR-WIDTH WHO-SHEET))))))
	   (SHEET-TYO WHO-SHEET #/:)
	   (SETQ WHO-LINE-ITEM-STATE VAL))))))

(DEFUN WHO-LINE-RUN-STATE-UPDATE (&AUX P)  ;Separate variable since other can be setq'ed
					   ;asynchronously by other processes
  (SETQ LAST-WHO-LINE-PROCESS
	(SETQ P (OR WHO-LINE-PROCESS
		    (PROGN (AND (NULL SELECTED-IO-BUFFER) 
				(NOT (NULL SELECTED-WINDOW))	;This can happen
				(SETQ SELECTED-IO-BUFFER
				      (FUNCALL SELECTED-WINDOW ':IO-BUFFER)))
			   (AND SELECTED-IO-BUFFER
				(IO-BUFFER-LAST-OUTPUT-PROCESS SELECTED-IO-BUFFER))))))
  (SETQ WHO-LINE-RUN-STATE (COND ((NULL P) "NIL")
				 ((ASSQ P ACTIVE-PROCESSES)
				  (PROCESS-WHOSTATE P))
				 ((NOT (NULL (SI:PROCESS-ARREST-REASONS P)))
				  "ARREST")
				 (T "STOP")))
  (WHO-LINE-UPDATE T))

(DEFUN WHO-LINE-FIELD (&REST ARGS &AUX W)
  (LET ((SHEET-AREA WHO-LINE-AREA))
    ;; Do sheet type consing in special area to increase locality
    (SETQ W (LEXPR-FUNCALL #'MAKE-WINDOW (GET (LOCF ARGS) ':FLAVOR)
			   ':SUPERIOR WHO-LINE-SCREEN
			   ':VSP 0
			   ARGS))
    (FUNCALL W ':ACTIVATE)
    (FUNCALL W ':EXPOSE)
    W))

(DEFFLAVOR WHO-LINE-FILE-SHEET
	((CURRENT-STREAM NIL)			;The one being displayed
	 ;; This is an array rather than a list to avoid consing.
	 (OPEN-STREAMS (MAKE-ARRAY 20. ':TYPE 'ART-Q-LIST ':LEADER-LIST '(0)))
	 ;; A list with elements (chaos-connection from-machine contact-name)
	 (SERVERS-LIST NIL)
	 DISPLAYED-PERCENT DISPLAYED-COUNT)
	(WHO-LINE-MIXIN MINIMUM-WINDOW))

(DEFMETHOD (WHO-LINE-FILE-SHEET :ADD-STREAM) (STREAM &OPTIONAL (UPDATE-P T))
  (AND (ARRAY-PUSH OPEN-STREAMS STREAM)		;Don't even bother if there are more than 20.
       (WHO-LINE-FILE-SHEET-COMPUTE-CURRENT-STREAM UPDATE-P)))

(DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-STREAM) (STREAM &AUX POS)
  (COND ((SETQ POS (FIND-POSITION-IN-LIST STREAM (G-L-P OPEN-STREAMS)))
	 (COND ((= POS (1- (ARRAY-LEADER OPEN-STREAMS 0)))
		(ARRAY-POP OPEN-STREAMS))
	       (T (ASET (ARRAY-POP OPEN-STREAMS) OPEN-STREAMS POS)))
	 (AND (EQ STREAM CURRENT-STREAM)
	      (WHO-LINE-FILE-SHEET-COMPUTE-CURRENT-STREAM)))))

(DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-ALL-STREAMS) ()
  (STORE-ARRAY-LEADER 0 OPEN-STREAMS 0)
  (SETQ CURRENT-STREAM NIL))

(ADD-INITIALIZATION "FIX-WHO-LINE-FILE-STATE-SHEET"
		    '(FUNCALL WHO-LINE-FILE-STATE-SHEET ':DELETE-ALL-STREAMS)
		    '(SYSTEM))

(DEFMETHOD (WHO-LINE-FILE-SHEET :OPEN-STREAMS) ()
  (G-L-P OPEN-STREAMS))

(DEFMETHOD (WHO-LINE-FILE-SHEET :ADD-SERVER) (CONNECTION CONTACT-NAME)
  (PUSH (LIST CONNECTION
	      (CHAOS:HOST-SHORT-NAME (CHAOS:FOREIGN-ADDRESS CONNECTION))
	      CONTACT-NAME)
	SERVERS-LIST))

;This isn't usually called; Normally servers are deleted automatically when
;it is noticed that the connection has been closed.
(DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-SERVER) (CONNECTION)
  (SETQ SERVERS-LIST (DEL #'(LAMBDA (X Y) (EQ X (CAR Y))) CONNECTION SERVERS-LIST)))

(DEFMETHOD (WHO-LINE-FILE-SHEET :DELETE-ALL-SERVERS) ()
  (SETQ SERVERS-LIST NIL))

(DEFMETHOD (WHO-LINE-FILE-SHEET :CLOSE-ALL-SERVERS) (REASON)
  (DO ((S SERVERS-LIST (CDR S)))
      ((NULL S) (SETQ SERVERS-LIST NIL))
    (CHAOS:CLOSE (CAAR S) REASON)))

(DEFMETHOD (WHO-LINE-FILE-SHEET :SERVERS) ()
  (PURGE-SERVERS)
  SERVERS-LIST)

;; User level functions
(DEFUN DESCRIBE-SERVERS ()
  (DOLIST (S (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':SERVERS))
    (FORMAT T "~%~A serving ~A" (THIRD S) (SECOND S))))

(DEFUN CLOSE-ALL-SERVERS (REASON)
  (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':CLOSE-ALL-SERVERS REASON))

;Remove all servers which aren't current anymore.
(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-FILE-SHEET)
(DEFUN PURGE-SERVERS ()
  (WITHOUT-INTERRUPTS
    (DO ((S SERVERS-LIST (CDR S)))
	((NULL S)
	 (SETQ SERVERS-LIST (DELQ NIL SERVERS-LIST)))
      (COND ((NEQ (CHAOS:STATE (CAAR S)) 'CHAOS:OPEN-STATE)
	     (SETF (CAR S) NIL)))))) )

;Take the most recently opened input stream if there is one.  Otherwise
;take the most recently opened output stream.
(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-FILE-SHEET)
(DEFUN WHO-LINE-FILE-SHEET-COMPUTE-CURRENT-STREAM (&OPTIONAL (UPDATE-P T))
  (DO ((I (1- (ARRAY-LEADER OPEN-STREAMS 0)) (1- I))
       (OUTPUT-WINNER NIL) (STREAM) (DIRECTION))
      ((MINUSP I)
       (SETQ CURRENT-STREAM OUTPUT-WINNER))
    (SETQ STREAM (AREF OPEN-STREAMS I))
    (MULTIPLE-VALUE (NIL DIRECTION)
      (FUNCALL STREAM ':WHO-LINE-INFORMATION))
    (SELECTQ DIRECTION
      ((:INPUT :BIDIRECTIONAL)
       (RETURN (SETQ CURRENT-STREAM STREAM)))
      (:OUTPUT
       (OR OUTPUT-WINNER
	   (SETQ OUTPUT-WINNER STREAM)))))
  (AND UPDATE-P (WHO-LINE-UPDATE))))

(DEFMETHOD (WHO-LINE-FILE-SHEET :UPDATE) (&AUX (MAX-CHARS (// (SHEET-INSIDE-WIDTH)
							      CHAR-WIDTH))
					       IDLE STRING)
  (COND (CURRENT-STREAM
	 (LET ((OLD-STREAM WHO-LINE-ITEM-STATE)
	       (PATHNAME) (DIRECTION) (PERCENT) (COUNT)
	       (FILE-NAME) (SP-POS) (FNTRUNC))
	   (MULTIPLE-VALUE (PATHNAME DIRECTION COUNT PERCENT)
	     (FUNCALL CURRENT-STREAM ':WHO-LINE-INFORMATION))
	   (SHEET-HOME SELF)
	   (COND ((AND (EQ OLD-STREAM CURRENT-STREAM)
		       (EQ PERCENT DISPLAYED-PERCENT)
		       (EQ COUNT DISPLAYED-COUNT)))
		 (T (OR (EQ OLD-STREAM CURRENT-STREAM)
			(SHEET-CLEAR-EOL SELF))
		    (SETQ WHO-LINE-ITEM-STATE CURRENT-STREAM
			  DISPLAYED-PERCENT PERCENT
			  DISPLAYED-COUNT COUNT)
		    (SHEET-STRING-OUT SELF (SELECTQ DIRECTION
					     (:INPUT " ")
					     (:OUTPUT " ")
					     (:BIDIRECTIONAL " ")))
		    (SETQ FILE-NAME (FUNCALL PATHNAME ':STRING-FOR-WHOLINE))
		    (AND ( (STRING-LENGTH FILE-NAME) (- MAX-CHARS 4))
			 ;; If not enough room for filename, then truncate
			 (SETQ FNTRUNC (- MAX-CHARS 7)))
		    (SHEET-STRING-OUT SELF FILE-NAME 0 FNTRUNC)
		    (SHEET-STRING-OUT SELF (IF FNTRUNC " " "  "))
		    (SETQ SP-POS (+ 4 (OR FNTRUNC (STRING-LENGTH FILE-NAME))))
		    (SHEET-CLEAR-EOL SELF)
		    (COND ((AND PERCENT
				( (+ SP-POS (STRING-LENGTH (SETQ STRING (FORMAT NIL "~D% ~D"
										 PERCENT
										 COUNT))))
				   MAX-CHARS)))
			  (PERCENT
			   (WITHOUT-INTERRUPTS
			     (RETURN-ARRAY STRING)
			     (SETQ STRING (FORMAT NIL "~D%" PERCENT))))
			  (T (WITHOUT-INTERRUPTS
			       (AND STRING (RETURN-ARRAY STRING))
			       (SETQ STRING (FORMAT NIL "~D" COUNT)))))
		    (SHEET-STRING-OUT SELF STRING
				      0 (MIN (- MAX-CHARS SP-POS) (STRING-LENGTH STRING)))
		    (WITHOUT-INTERRUPTS
		      (RETURN-ARRAY STRING)
		      (SETQ STRING NIL))))))
	((AND (NOT (NULL SERVERS-LIST))
	      (PROGN (PURGE-SERVERS)
		     (NOT (NULL SERVERS-LIST))))
	 (COND ((= (LENGTH SERVERS-LIST) 1)
		(COND ((NEQ WHO-LINE-ITEM-STATE (CAAR SERVERS-LIST))
		       (SHEET-HOME SELF)
		       (SHEET-CLEAR-EOL SELF)
		       (SETQ STRING (FORMAT NIL "~A serving ~A"
					    (CADDAR SERVERS-LIST) (CADAR SERVERS-LIST)))
		       (SHEET-STRING-OUT SELF STRING 0 (MIN (STRING-LENGTH STRING) MAX-CHARS))
		       (RETURN-ARRAY (PROG1 STRING (SETQ STRING NIL)))
		       (SETQ WHO-LINE-ITEM-STATE (CAAR SERVERS-LIST)))))
	       ((NEQ WHO-LINE-ITEM-STATE (LENGTH SERVERS-LIST))
		(SHEET-HOME SELF)
		(SHEET-HOME SELF)
		(SHEET-CLEAR-EOL SELF)
		(SETQ STRING (FORMAT NIL "~D Active Servers" (LENGTH SERVERS-LIST)))
		(SHEET-STRING-OUT SELF STRING 0 (MIN (STRING-LENGTH STRING) MAX-CHARS))
		(RETURN-ARRAY (PROG1 STRING (SETQ STRING NIL)))
		(SETQ WHO-LINE-ITEM-STATE (LENGTH SERVERS-LIST)))))
	(SI:WHO-LINE-JUST-COLD-BOOTED-P
	  (COND ((NEQ WHO-LINE-ITEM-STATE 'COLD)
		 (SHEET-CLEAR SELF)
		 (SETQ WHO-LINE-ITEM-STATE 'COLD)
		 (SHEET-STRING-OUT SELF "Cold-booted"))))
	((> (SETQ IDLE (// (TIME-DIFFERENCE (TIME) TV:KBD-LAST-ACTIVITY-TIME) 3600.)) 4)
						;Display keyboard idle time
	 (LET ((OLD-IDLE WHO-LINE-ITEM-STATE))
	   (COND ((OR (NOT (NUMBERP OLD-IDLE)) ( OLD-IDLE IDLE))
		  (SHEET-CLEAR SELF)
		  (WITHOUT-INTERRUPTS
		    (LET ((STRING (FORMAT NIL "Console idle ~D minute~P" IDLE IDLE)))
		      (SHEET-STRING-OUT SELF STRING)
		      (RETURN-ARRAY STRING)))
		  (SETQ WHO-LINE-ITEM-STATE IDLE)))))
	((NEQ WHO-LINE-ITEM-STATE 'NULL)
	 (SHEET-CLEAR SELF)
	 (SETQ WHO-LINE-ITEM-STATE 'NULL))))

;;; Date and time in the who-line, continuously updating.

(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-SHEET)
(DEFUN NWATCH-WHO-FUNCTION (WHO-SHEET)
  (OR WHO-LINE-EXTRA-STATE
      (LET ((DEFAULT-CONS-AREA WHO-LINE-AREA))
	(SETQ WHO-LINE-EXTRA-STATE (STRING-APPEND "MM//DD//YY HH:MM:SS"))))
  (LET (YEAR MONTH DAY HOURS MINUTES SECONDS LEFTX)
    (MULTIPLE-VALUE (SECONDS MINUTES HOURS DAY MONTH YEAR)
      (TIME:GET-TIME))
    (if (> year 100) (setq year (- year 100.)))
    (COND ((NULL SECONDS)			       
	   (SHEET-SET-CURSORPOS WHO-SHEET 0 0)
	   (SHEET-CLEAR-EOL WHO-SHEET)
	   (COPY-ARRAY-CONTENTS "MM//DD//YY HH:MM:SS" WHO-LINE-EXTRA-STATE))
	  (T
	   (SETQ LEFTX (MIN (NWATCH-N MONTH WHO-LINE-EXTRA-STATE 0)
			    (NWATCH-N DAY WHO-LINE-EXTRA-STATE 3)
			    (NWATCH-N YEAR WHO-LINE-EXTRA-STATE 6)
			    (NWATCH-N HOURS WHO-LINE-EXTRA-STATE 9)
			    (NWATCH-N MINUTES WHO-LINE-EXTRA-STATE 12.)
			    (NWATCH-N SECONDS WHO-LINE-EXTRA-STATE 15.)))
	   (OR WHO-LINE-ITEM-STATE (SETQ LEFTX 0)) ;was clobbered, redisplay all
	   (SHEET-SET-CURSORPOS WHO-SHEET (* LEFTX CHAR-WIDTH) 0)
	   (SHEET-CLEAR-EOL WHO-SHEET)
	   (SHEET-STRING-OUT WHO-SHEET WHO-LINE-EXTRA-STATE LEFTX)
	   (SETQ WHO-LINE-ITEM-STATE T))))))

;Returns first character position changed
(DEFUN NWATCH-N (N STR I)
  (LET ((DIG1 (+ (// N 10.) #/0))
	(DIG2 (+ (\ N 10.) #/0)))
    (PROG1 (COND ((NOT (= (AREF STR I) DIG1)) I)
		 ((NOT (= (AREF STR (1+ I)) DIG2)) (1+ I))
		 (T (ARRAY-LENGTH STR)))
	   (ASET DIG1 STR I)
	   (ASET DIG2 STR (1+ I)))))

;;; Support for documentation in the who line

(DEFMETHOD (SHEET :WHO-LINE-DOCUMENTATION-STRING) () NIL)

(DEFUN WHO-LINE-DOCUMENTATION (&OPTIONAL (ON-P T))
  (COND ((AND ON-P (NOT (SHEET-EXPOSED-P WHO-LINE-DOCUMENTATION-WINDOW)))
	 (SET-WHO-LINE-LINES (1+ (// (SHEET-INSIDE-HEIGHT WHO-LINE-SCREEN)
				     (SHEET-LINE-HEIGHT WHO-LINE-SCREEN))))
	 (FUNCALL WHO-LINE-DOCUMENTATION-WINDOW ':DEACTIVATE)
	 (DOLIST (I (COPYLIST (SHEET-INFERIORS WHO-LINE-SCREEN)))
	   (AND ( (SHEET-Y-OFFSET I) (SHEET-Y-OFFSET WHO-LINE-DOCUMENTATION-WINDOW))
		(FUNCALL I ':SET-POSITION
			 (SHEET-X-OFFSET I)
			 (+ (SHEET-Y-OFFSET I)
			    (SHEET-Y-OFFSET WHO-LINE-DOCUMENTATION-WINDOW)
			    (SHEET-HEIGHT WHO-LINE-DOCUMENTATION-WINDOW)))))
	 (FUNCALL WHO-LINE-DOCUMENTATION-WINDOW ':EXPOSE))
	((AND (NOT ON-P) WHO-LINE-DOCUMENTATION-WINDOW)
	 (COND ((SHEET-EXPOSED-P WHO-LINE-DOCUMENTATION-WINDOW)
		(FUNCALL WHO-LINE-DOCUMENTATION-WINDOW ':DEACTIVATE)
		(SET-WHO-LINE-LINES (1- (// (SHEET-INSIDE-HEIGHT WHO-LINE-SCREEN)
					    (SHEET-LINE-HEIGHT WHO-LINE-SCREEN))))
		(DOLIST (I (COPYLIST (SHEET-INFERIORS WHO-LINE-SCREEN)))
		  (AND ( (SHEET-Y-OFFSET I) (SHEET-Y-OFFSET WHO-LINE-DOCUMENTATION-WINDOW))
		       (FUNCALL I ':SET-POSITION
				(SHEET-X-OFFSET I)
				(- (SHEET-Y-OFFSET I)
				   (SHEET-Y-OFFSET WHO-LINE-DOCUMENTATION-WINDOW)
				   (SHEET-HEIGHT WHO-LINE-DOCUMENTATION-WINDOW))))))))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-SHEET)
(DEFUN WHO-LINE-DOCUMENTATION-FUNCTION (WHO-SHEET)
  (LET* ((W MOUSE-WINDOW)
	 (NEW-STATE (COND ((SYMBOLP W)
			   (AND W WHO-LINE-MOUSE-GRABBED-DOCUMENTATION))
			  (T (MULTIPLE-VALUE-BIND (DOC ERROR)
				 (CATCH-ERROR (FUNCALL W ':WHO-LINE-DOCUMENTATION-STRING)
					      NIL)
			       (IF ERROR "Error getting documentation string" DOC))))))
    (COND ((NEQ WHO-LINE-ITEM-STATE NEW-STATE)
	   (SETQ WHO-LINE-ITEM-STATE NEW-STATE)
	   (SHEET-CLEAR WHO-SHEET)
	   (AND (TYPEP NEW-STATE 'STRING)
		(SHEET-STRING-OUT WHO-SHEET NEW-STATE
				  0 (MIN (OR (STRING-SEARCH-CHAR #\NEWLINE NEW-STATE)
					     (STRING-LENGTH NEW-STATE))
					 (// (SHEET-INSIDE-WIDTH WHO-SHEET)
					     (SHEET-CHAR-WIDTH WHO-SHEET))))))))))

(DEFUN ADD-WHO-LINE-WINDOW (WINDOW)
  "Takes a window that must be an immediate inferior of the who line screen, and
exposes it at the top of the who-line, making the who-line larger if necessary."
  (OR (EQ (FUNCALL WINDOW ':SUPERIOR) WHO-LINE-SCREEN)
      (FERROR NIL "~A is not an immediate inferior of the who line screen" WINDOW))
  (COND ((NOT (SHEET-EXPOSED-P WINDOW))
	 (LET ((H (SHEET-HEIGHT WINDOW)))
	   (SET-WHO-LINE-HEIGHT (+ H (SHEET-HEIGHT WHO-LINE-SCREEN)))
	   (DOLIST (W (COPYLIST (SHEET-EXPOSED-INFERIORS WHO-LINE-SCREEN)))
	     (FUNCALL W ':SET-POSITION (SHEET-X-OFFSET W) (+ H (SHEET-Y-OFFSET W))))
	   (FUNCALL WINDOW ':SET-POSITION (SHEET-X-OFFSET WINDOW) 0)
	   (FUNCALL WINDOW ':EXPOSE)))))

(DEFUN DELETE-WHO-LINE-WINDOW (WINDOW)
  (OR (EQ (FUNCALL WINDOW ':SUPERIOR) WHO-LINE-SCREEN)
      (FERROR NIL "~A is not an immediate inferior of the who line screen" WINDOW))
  (COND ((SHEET-EXPOSED-P WINDOW)
	 (FUNCALL WINDOW ':DEACTIVATE)
	 (LET ((H (SHEET-HEIGHT WINDOW)))
	   (DOLIST (W (COPYLIST (SHEET-EXPOSED-INFERIORS WHO-LINE-SCREEN)))
	     (FUNCALL W ':SET-POSITION (SHEET-X-OFFSET W) (- (SHEET-Y-OFFSET W) H)))
	   (SET-WHO-LINE-HEIGHT (- (SHEET-HEIGHT WHO-LINE-SCREEN) H))))))

(DEFUN SET-WHO-LINE-HEIGHT (H)
  (WITH-MOUSE-USURPED
   (LOCK-SHEET (MAIN-SCREEN)
    (LOCK-SHEET (WHO-LINE-SCREEN)
      (WITHOUT-INTERRUPTS
	(LET ((MS MOUSE-SHEET) (SW SELECTED-WINDOW))
	  (AND (SHEET-ME-OR-MY-KID-P MS MAIN-SCREEN)
	       (SETQ MOUSE-SHEET NIL))
	  (FUNCALL WHO-LINE-SCREEN ':DEEXPOSE)
	  (FUNCALL MAIN-SCREEN ':DEEXPOSE)
	  (SETQ MOUSE-SHEET MS)
	  (FUNCALL WHO-LINE-SCREEN ':CHANGE-OF-SIZE-OR-MARGINS
		   ':BOTTOM MAIN-SCREEN-HEIGHT
		   ':TOP (- MAIN-SCREEN-HEIGHT H))
	  (FUNCALL MAIN-SCREEN ':CHANGE-OF-SIZE-OR-MARGINS
		   ':HEIGHT (- MAIN-SCREEN-HEIGHT (SHEET-HEIGHT WHO-LINE-SCREEN)))
	  (MOUSE-SET-SHEET MS)
	  (FUNCALL MAIN-SCREEN ':EXPOSE)
	  (FUNCALL WHO-LINE-SCREEN ':EXPOSE)
	  (AND SW (FUNCALL SW ':SELECT))))))))

(DEFFLAVOR WHO-LINE-WINDOW () (WHO-LINE-MIXIN WINDOW))

(DEFMETHOD (WHO-LINE-WINDOW :UPDATE) () )

(DEFUN MAKE-WHO-LINE-WINDOW (&REST ARGS)
  (LET ((SHEET-AREA WHO-LINE-AREA))
    ;; Do sheet type consing in special area to increase locality
    (LEXPR-FUNCALL #'MAKE-WINDOW (OR (GET (LOCF ARGS) ':FLAVOR) 'WHO-LINE-WINDOW)
		   ':SUPERIOR WHO-LINE-SCREEN
		   ARGS)))