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

;;; Typeout window and mouse-sensitive items
;;;Menu type item typeout window
(DEFFLAVOR BASIC-MOUSE-SENSITIVE-ITEMS
	((ITEM-TYPE-ALIST NIL)			;Associates actions with types of items
	 (ITEM-LIST NIL)			;All the currently exposed items
	 ITEM-BLINKER				;Highlights mousable items
	 MENU)					;For when item clicked on with right button
	()
  (:INCLUDED-FLAVORS ESSENTIAL-MOUSE STREAM-MIXIN)
  (:SETTABLE-INSTANCE-VARIABLES ITEM-TYPE-ALIST)
  (:DOCUMENTATION :MIXIN "Menu like operations for a typeout window"))

;;;Item typed out by :ITEM or :ITEM-LIST messages
(DEFSTRUCT (TYPEOUT-ITEM LIST (:CONSTRUCTOR NIL))
  TYPEOUT-ITEM-TYPE				;For looking in ITEM-TYPE-ALIST
  TYPEOUT-ITEM-ITEM				;Identifier of item
  TYPEOUT-ITEM-LEFT				;Screen area occupied by item, relative to
  TYPEOUT-ITEM-TOP				;sheet, not to margins
  TYPEOUT-ITEM-RIGHT
  TYPEOUT-ITEM-BOTTOM)

;;;Make a blinker for the menu type items and the pop-up menu
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :INIT) (IGNORE)
  (SETQ ITEM-BLINKER (MAKE-BLINKER SELF 'HOLLOW-RECTANGULAR-BLINKER ':VISIBILITY NIL)
	MENU (MAKE-WINDOW 'MOMENTARY-MENU ':SUPERIOR SELF)))

;;;Forget any items on screen if cleared
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :REFRESH) (&OPTIONAL IGNORE)
  (OR RESTORED-BITS-P (TYPEOUT-ITEM-WINDOW-REMOVE-ITEMS)))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-MOUSE-SENSITIVE-ITEMS)
(DEFUN TYPEOUT-ITEM-WINDOW-REMOVE-ITEMS (&REST IGNORE)
  (SETQ ITEM-LIST NIL)
  (BLINKER-SET-VISIBILITY ITEM-BLINKER NIL)))

(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :CLEAR-SCREEN)
    TYPEOUT-ITEM-WINDOW-REMOVE-ITEMS)

(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :CLEAR-EOF) (&AUX TEM)
  (COND ((SETQ TEM (MEMQ 'WRAPAROUND ITEM-LIST))
	 (RPLACD TEM NIL)
	 (MOUSE-WAKEUP))))

(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :EXPOSE-FOR-TYPEOUT)
    TYPEOUT-ITEM-WINDOW-REMOVE-ITEMS)

;;; Record a blip when the screen wraps around
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :END-OF-PAGE-EXCEPTION) ()
  (PUSH 'WRAPAROUND ITEM-LIST))

;;;Type out item, either as itself or FORMAT-ARGS.  TYPE is used for indexing into
;;;ITEM-TYPE-ALIST
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :ITEM) (TYPE ITEM &REST FORMAT-ARGS)
  (LET ((X CURSOR-X))
    (IF FORMAT-ARGS (LEXPR-FUNCALL #'FORMAT SELF FORMAT-ARGS) (PRINC ITEM SELF))
    (PUSH (LIST TYPE ITEM X CURSOR-Y CURSOR-X (+ CURSOR-Y LINE-HEIGHT)) ITEM-LIST)))

;;;Make an item without drawing anything (assuming the caller has drawn it already)
;;;Instead you just pass in an enclosing rectangle
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :PRIMITIVE-ITEM) (TYPE ITEM LEFT TOP RIGHT BOTTOM)
  (PUSH (LIST TYPE ITEM (+ LEFT (SHEET-INSIDE-LEFT)) (+ TOP (SHEET-INSIDE-TOP))
			(+ RIGHT (SHEET-INSIDE-LEFT)) (+ BOTTOM (SHEET-INSIDE-TOP)))
	ITEM-LIST))

;;;Type out list of item as many as will fit on each line, centered.
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :ITEM-LIST) (TYPE LIST &AUX (MAXL 0) N
						  (INSIDE-WIDTH (SHEET-INSIDE-WIDTH)))
  (FUNCALL-SELF ':FRESH-LINE)
  (COND (LIST					;Do nothing if empty list
	 ;; Compute the maximum width of any item, in dots (MAXL).
	 (DOLIST (ITEM LIST)
	   (LET ((STRING (STRING (IF (LISTP ITEM) (CAR ITEM) ITEM))))
	     (SETQ MAXL (MAX (SHEET-STRING-LENGTH SELF STRING) MAXL))))
	 ;; How many items go on each line (except the last)?
	 (SETQ N (MAX (MIN (// INSIDE-WIDTH (+ MAXL (FONT-CHAR-WIDTH CURRENT-FONT)))
			   (LENGTH LIST))
		      1))			;Always print something, even if continuation
	 ;; Now print the items and store the data in the table.
	 ;; Move to a new line when we exhaust a line, and at the end.
	 ;; I counts from 1 thru N on each line.
	 (DO ((I 1 (1+ I))
	      (LIST LIST (CDR LIST))
	      (WIDTH-PER (// INSIDE-WIDTH N)))
	     ((NULL LIST))
	   ;; Actually make this item.
	   (IF (LISTP (CAR LIST))
	       (FUNCALL SELF ':ITEM TYPE (CDAR LIST) "~A" (CAAR LIST))
	       (FUNCALL SELF ':ITEM TYPE (CAR LIST)))
	   ;; Space out for next item, or move to new line.
	   (IF (AND ( I N) (CDR LIST))
	       ;; Not end of line, space out for next item.
	       (MULTIPLE-VALUE-BIND (X Y)
		   (SHEET-READ-CURSORPOS SELF)
		 (SHEET-SET-CURSORPOS SELF
				      (* WIDTH-PER
					 (// (+ (1- WIDTH-PER) X)
					     WIDTH-PER))
				      Y))
	       ;; End of line.
	       (SHEET-CRLF SELF)
	       (SETQ I 0))))))

;;; When mouse leaves the window, turn off the item blinker
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :AFTER :HANDLE-MOUSE) ()
  (FUNCALL ITEM-BLINKER ':SET-VISIBILITY NIL))

;;;Blink any item the mouse points to
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :MOUSE-MOVES) (X Y &AUX ITEM)
  (MOUSE-SET-BLINKER-CURSORPOS)
  (COND ((AND (SETQ ITEM (FUNCALL-SELF ':MOUSE-SENSITIVE-ITEM X Y))
	      (ASSQ (TYPEOUT-ITEM-TYPE ITEM) ITEM-TYPE-ALIST))
	 (LET ((LEFT (TYPEOUT-ITEM-LEFT ITEM))
	       (TOP (TYPEOUT-ITEM-TOP ITEM))
	       (RIGHT (TYPEOUT-ITEM-RIGHT ITEM))
	       (BOTTOM (TYPEOUT-ITEM-BOTTOM ITEM))
	       BWIDTH BHEIGHT)
	   (SETQ BWIDTH (- RIGHT LEFT)
		 BHEIGHT (- BOTTOM TOP))
	   (BLINKER-SET-CURSORPOS ITEM-BLINKER (- LEFT (SHEET-INSIDE-LEFT))
				  (- TOP (SHEET-INSIDE-TOP)))
	   (BLINKER-SET-SIZE ITEM-BLINKER BWIDTH BHEIGHT)
	   (BLINKER-SET-VISIBILITY ITEM-BLINKER T)))
	(T (BLINKER-SET-VISIBILITY ITEM-BLINKER NIL))))

;;;Mouse-left selects the blinking item, mouse-right pops up a menu near it
(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :MOUSE-CLICK) (BUTTON X Y &AUX ITEM)
  (COND ((SETQ ITEM (FUNCALL-SELF ':MOUSE-SENSITIVE-ITEM X Y))
	 (LET ((ITEM-TYPE (TYPEOUT-ITEM-TYPE ITEM)))
	   (COND ((SETQ ITEM-TYPE (ASSQ ITEM-TYPE ITEM-TYPE-ALIST))
		  (SELECTQ BUTTON
		    (#\MOUSE-1-1
		     (FUNCALL-SELF ':FORCE-KBD-INPUT
				   (LIST ':TYPEOUT-EXECUTE (CADR ITEM-TYPE)
					 (TYPEOUT-ITEM-ITEM ITEM)))
		     T)
		    (#\MOUSE-3-1
		     (PROCESS-RUN-FUNCTION "Menu Choose" #'TYPEOUT-MENU-CHOOSE
					   MENU (CDDDR ITEM-TYPE) ITEM SELF)
		     T))))))))

(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :MOUSE-SENSITIVE-ITEM) (X Y)
  (TYPEOUT-MOUSE-ITEM X Y))

;;;Return the item the mouse if pointing to
(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-MOUSE-SENSITIVE-ITEMS)
(DEFUN TYPEOUT-MOUSE-ITEM (X Y)
  (DO ((ITEMS ITEM-LIST (CDR ITEMS))
       (ITEM) (ITEM-Y) (WRAPPED-AROUND))
      ((NULL ITEMS))
    (IF (SYMBOLP (SETQ ITEM (CAR ITEMS)))
	(SETQ WRAPPED-AROUND T)
	(AND ( (SETQ ITEM-Y (TYPEOUT-ITEM-TOP ITEM)) CURSOR-Y) WRAPPED-AROUND
	     (RETURN NIL))
	(AND ( Y ITEM-Y)
	     (< Y (TYPEOUT-ITEM-BOTTOM ITEM))
	     ( X (TYPEOUT-ITEM-LEFT ITEM))
	     (< X (TYPEOUT-ITEM-RIGHT ITEM))
	     (RETURN ITEM))))))

(COMMENT
(DEFFLAVOR TYPEOUT-ITEM-TEST-WINDOW () (BASIC-MOUSE-SENSITIVE-ITEMS WINDOW)
  (:DOCUMENTATION :COMBINATION))
)

;;;Select thing to do with selected item from menu
(DEFUN TYPEOUT-MENU-CHOOSE (MENU ALIST TYPEOUT-ITEM TYPEOUT-WINDOW)
  (FUNCALL MENU ':SET-ITEM-LIST ALIST)
  (MOVE-WINDOW-NEAR-RECTANGLE MENU
			      (TYPEOUT-ITEM-LEFT TYPEOUT-ITEM)
			      (TYPEOUT-ITEM-TOP TYPEOUT-ITEM)
			      (TYPEOUT-ITEM-RIGHT TYPEOUT-ITEM)
			      (TYPEOUT-ITEM-BOTTOM TYPEOUT-ITEM))
  (LET ((CHOICE-RESULT (FUNCALL MENU ':CHOOSE)))
    (AND CHOICE-RESULT
	 (FUNCALL TYPEOUT-WINDOW ':FORCE-KBD-INPUT
		  (LIST ':TYPEOUT-EXECUTE CHOICE-RESULT (TYPEOUT-ITEM-ITEM TYPEOUT-ITEM))))))

;;; Useful for adding new types in various places
(DEFMACRO ADD-TYPEOUT-ITEM-TYPE (ALIST TYPE NAME FUNCTION &OPTIONAL DEFAULT-P DOCUMENTATION)
  `(SETQ ,ALIST (ADD-TYPEOUT-ITEM-TYPE-1 ,ALIST ',TYPE ',FUNCTION ,NAME ,DEFAULT-P
					 ,DOCUMENTATION)))

(DEFUN ADD-TYPEOUT-ITEM-TYPE-1 (ALIST TYPE FUNCTION NAME DEFAULT-P DOCUMENTATION &AUX EL1 EL2)
  (OR (SETQ EL1 (ASSQ TYPE ALIST))
      (PUSH (SETQ EL1 (LIST TYPE NIL NIL)) ALIST))
  (AND DEFAULT-P (SETF (SECOND EL1) FUNCTION))
  (OR (SETQ EL2 (ASSOC NAME (CDDDR EL1)))
      (PUSH (SETQ EL2 (NCONS NAME)) (CDDDR EL1)))
  (SETF (CDR EL2) `(:VALUE ,FUNCTION :DOCUMENTATION ,DOCUMENTATION))
  (SETF (THIRD EL1) (MAKE-TYPEOUT-MOUSE-PROMPT (THIRD EL1) (SECOND EL1)
					       (CDDDR EL1)))
  ALIST)

(DEFMETHOD (BASIC-MOUSE-SENSITIVE-ITEMS :WHO-LINE-DOCUMENTATION-STRING) (&AUX ITEM ITEM-TYPE
									      X Y)
  (MULTIPLE-VALUE (X Y)
    (SHEET-CALCULATE-OFFSETS SELF MOUSE-SHEET))
  (SETQ X (- MOUSE-X X)
	Y (- MOUSE-Y Y))
  (AND (SETQ ITEM (FUNCALL-SELF ':MOUSE-SENSITIVE-ITEM X Y))
       (SETQ ITEM-TYPE (TYPEOUT-ITEM-TYPE ITEM))
       (SETQ ITEM-TYPE (ASSQ ITEM-TYPE ITEM-TYPE-ALIST))
       (THIRD ITEM-TYPE)))

(DEFUN MAKE-TYPEOUT-MOUSE-PROMPT (STRING DEFAULT ALIST)
  (IF STRING
      (STORE-ARRAY-LEADER 0 STRING 0)
      (SETQ STRING (MAKE-ARRAY 100. ':TYPE 'ART-STRING ':LEADER-LIST '(0))))
  (DO ((L ALIST (CDR L)))
      ((NULL L))
    (AND (EQ DEFAULT (GET (CAR L) ':VALUE))
	 (SETQ DEFAULT (OR (GET (CAR L) ':DOCUMENTATION)
			   (CAAR L)))))
  (FORMAT STRING "Left: ~A  Right: menu of " DEFAULT)
  (DO ((L ALIST (CDR L))
       (FIRST-P T NIL))
      ((NULL L)
       (ARRAY-PUSH STRING #/.))
    (IF FIRST-P
	(SETQ FIRST-P NIL)
	(FORMAT STRING ", "))
    (FORMAT STRING "~A" (CAAR L)))
  STRING)

;;;Windows with typeout windows as inferiors
(DEFFLAVOR MOUSE-MOVES-MIXIN () ())
(DEFMETHOD (MOUSE-MOVES-MIXIN :MOUSE-MOVES) MOUSE-SET-BLINKER-CURSORPOS)


(DEFFLAVOR ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN ((TYPEOUT-WINDOW NIL)) ()
  (:INCLUDED-FLAVORS ESSENTIAL-MOUSE MOUSE-MOVES-MIXIN)
  (:GETTABLE-INSTANCE-VARIABLES TYPEOUT-WINDOW)
  (:INITABLE-INSTANCE-VARIABLES TYPEOUT-WINDOW)
  (:OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES TYPEOUT-WINDOW)
  (:DOCUMENTATION :MIXIN "A window that has a typeout window as an inferior"))

(DEFMETHOD (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :AFTER :INIT) (IGNORE)
  (AND (LISTP TYPEOUT-WINDOW)
       (SETQ TYPEOUT-WINDOW (LEXPR-FUNCALL #'MAKE-WINDOW (CAR TYPEOUT-WINDOW)
					   ':SUPERIOR SELF
					   (CDR TYPEOUT-WINDOW)))))

(DEFWRAPPER (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :CHANGE-OF-SIZE-OR-MARGINS) (IGNORE . BODY)
  ;`(WITH-SHEET-DEEXPOSED (TYPEOUT-WINDOW) . ,BODY)
  `(LET (.STATUS.)
     (DELAYING-SCREEN-MANAGEMENT
       (UNWIND-PROTECT
	 (PROGN
	   (COND (TYPEOUT-WINDOW			;May not be present during init
		  (SETQ .STATUS. (FUNCALL TYPEOUT-WINDOW ':STATUS))
		  (FUNCALL TYPEOUT-WINDOW ':DEEXPOSE ':DEFAULT ':NOOP)))
	   . ,BODY))
       (AND .STATUS.
	    (FUNCALL TYPEOUT-WINDOW ':SET-STATUS .STATUS.)))))

(DEFMETHOD (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :AFTER :CHANGE-OF-SIZE-OR-MARGINS)
	   									(&REST IGNORE)
  (AND TYPEOUT-WINDOW
       (FUNCALL TYPEOUT-WINDOW ':SET-EDGES (SHEET-INSIDE-LEFT) (SHEET-INSIDE-TOP)
		(SHEET-INSIDE-RIGHT) (SHEET-INSIDE-BOTTOM))))
  
(DEFMETHOD (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :TURN-OFF-BLINKERS-FOR-TYPEOUT) ())

(DEFMETHOD (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :TURN-ON-BLINKERS-FOR-TYPEOUT) ())

(DEFMETHOD (ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN :AFTER :SELECT) (&REST ARGS)
  (AND (BASIC-TYPEOUT-WINDOW-INCOMPLETE-P TYPEOUT-WINDOW)
       (LEXPR-FUNCALL TYPEOUT-WINDOW ':SELECT ARGS)))


(DEFFLAVOR WINDOW-WITH-TYPEOUT-MIXIN
	()
	(NO-SCREEN-MANAGING-MIXIN ESSENTIAL-WINDOW-WITH-TYPEOUT-MIXIN))


;;;Typeout windows themselves
;;; BOTTOM-REACHED is set to the largest Y clobbered, or NIL if nothing is clobbered.
;;; INCOMPLETE-P is set to T when the window is exposed, and NIL when it is deexposed
;;;  or by the :MAKE-COMPLETE method.
;;; For ordinary use, the command process of the program should check INCOMPLETE-P and wait
;;;   for the user to type space if that is set; the redisplay process should check
;;;   BOTTOM-REACHED and redisplay (only that portion, if it can) if that is set.
;;;  Thus things that typeout but that need not be saved for the user (like Y-OR-N-P's)
;;;   should send the :MAKE-COMPLETE message.
;;; By default, these windows cannot be selected from the system menu.
(DEFFLAVOR BASIC-TYPEOUT-WINDOW ((BOTTOM-REACHED NIL) (HAD-MOUSE-P NIL) (INCOMPLETE-P NIL))
	   (NO-SCREEN-MANAGING-MIXIN DONT-SELECT-WITH-MOUSE-MIXIN)
  (:INCLUDED-FLAVORS ESSENTIAL-MOUSE)
  (:GETTABLE-INSTANCE-VARIABLES INCOMPLETE-P)
  (:DEFAULT-INIT-PLIST :DEEXPOSED-TYPEOUT-ACTION '(:EXPOSE-FOR-TYPEOUT))
  (:OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES INCOMPLETE-P BOTTOM-REACHED)
  (:DOCUMENTATION :MIXIN "A window that grows over its superior"))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :ALIAS-FOR-SELECTED-WINDOWS) ()
  (FUNCALL SUPERIOR ':ALIAS-FOR-SELECTED-WINDOWS))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :HANDLE-MOUSE) ()
  (SETQ HAD-MOUSE-P T))

;;;For MOUSE-MOVES and MOUSE-BUTTONS message, the typeout-window, if exposed, will
;;;receive the messages and if it is not in the covered area, pass them off to the
;;;superior and throw out of the original message.
(DEFWRAPPER (BASIC-TYPEOUT-WINDOW :MOUSE-MOVES) ((IGNORE IGNORE) . BODY)
  `(*CATCH 'SUPERIOR-HANDLED-MOUSE
     . ,BODY))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :MOUSE-MOVES) (X Y)
  (IF (HANDLE-MOUSE-P X Y)
      (COND ((NOT HAD-MOUSE-P)
	     (FUNCALL SUPERIOR ':TURN-OFF-BLINKERS-FOR-TYPEOUT)
	     (SETQ HAD-MOUSE-P T)))
      (COND (HAD-MOUSE-P			;Send one extra message the first time out
	     (FUNCALL SUPERIOR ':TURN-ON-BLINKERS-FOR-TYPEOUT)
	     (SETQ HAD-MOUSE-P NIL))		;to turn off any blinkers
	    (T
	     (LET ((X (+ X X-OFFSET)) (Y (+ Y Y-OFFSET)))
	       (FUNCALL SUPERIOR ':MOUSE-MOVES X Y)
	       (*THROW 'SUPERIOR-HANDLED-MOUSE T))))))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :MOUSE-MOVES) MOUSE-SET-BLINKER-CURSORPOS)

(DEFWRAPPER (BASIC-TYPEOUT-WINDOW :MOUSE-BUTTONS) (IGNORE . BODY)
  `(*CATCH 'SUPERIOR-HANDLED-MOUSE
     . ,BODY))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :MOUSE-BUTTONS) (BD X Y)
  (OR (HANDLE-MOUSE-P X Y)
      (LET ((X (+ X X-OFFSET)) (Y (+ Y Y-OFFSET)))
	(FUNCALL SUPERIOR ':MOUSE-BUTTONS BD X Y)
	(*THROW 'SUPERIOR-HANDLED-MOUSE T))))

(DEFWRAPPER (BASIC-TYPEOUT-WINDOW :WHO-LINE-DOCUMENTATION-STRING) (IGNORE . BODY)
  `(MULTIPLE-VALUE-BIND (XOFF YOFF)
       (SHEET-CALCULATE-OFFSETS SELF MOUSE-SHEET)
     (IF (NULL (HANDLE-MOUSE-P (- MOUSE-X XOFF) (- MOUSE-Y YOFF)))
	 (FUNCALL SUPERIOR ':WHO-LINE-DOCUMENTATION-STRING)
	 . ,BODY)))

;;;Is the mouse somewhere the typeout window knows about?
(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-TYPEOUT-WINDOW)
(DEFUN HANDLE-MOUSE-P (X Y)
  (AND BOTTOM-REACHED (< (- Y LINE-HEIGHT)
			 (SETQ BOTTOM-REACHED (MAX BOTTOM-REACHED CURSOR-Y)))
       ( X 0) ( Y 0) (< X WIDTH))))

(DEFWRAPPER (BASIC-TYPEOUT-WINDOW :EXPOSE) (IGNORE . BODY)
  `(LOCAL-DECLARE ((SPECIAL .TYPEOUT-WAS-EXPOSED.))
     (LET ((.TYPEOUT-WAS-EXPOSED. EXPOSED-P))
       . ,BODY)))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :AFTER :EXPOSE) (&REST IGNORE)
  (LOCAL-DECLARE ((SPECIAL .TYPEOUT-WAS-EXPOSED.))
    (OR .TYPEOUT-WAS-EXPOSED.
	(SETQ BOTTOM-REACHED (OR BOTTOM-REACHED 0)
	      INCOMPLETE-P T))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-TYPEOUT-WINDOW)
(DEFUN MADE-INCOMPLETE (&REST IGNORE)
  (SETQ INCOMPLETE-P T)))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :TYO) MADE-INCOMPLETE)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :STRING-OUT) MADE-INCOMPLETE)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :LINE-OUT) MADE-INCOMPLETE)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :FRESH-LINE) MADE-INCOMPLETE)

(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-TYPEOUT-WINDOW)
(DEFUN COMPUTE-BOTTOM-REACHED (&REST IGNORE)
  (AND BOTTOM-REACHED (SETQ BOTTOM-REACHED (MAX BOTTOM-REACHED CURSOR-Y)))))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :HOME-CURSOR) COMPUTE-BOTTOM-REACHED)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :SET-CURSORPOS) COMPUTE-BOTTOM-REACHED)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BOTTOM-REACHED) COMPUTE-BOTTOM-REACHED)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :AFTER :REFRESH) (&OPTIONAL IGNORE)
  (OR RESTORED-BITS-P (REACHED-BOTTOM)))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (BASIC-TYPEOUT-WINDOW)
(DEFUN REACHED-BOTTOM (&REST IGNORE)
  (SETQ INCOMPLETE-P T
	BOTTOM-REACHED (SHEET-INSIDE-BOTTOM))))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :CLEAR-SCREEN) REACHED-BOTTOM)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :CLEAR-EOF) REACHED-BOTTOM)
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :END-OF-PAGE-EXCEPTION) REACHED-BOTTOM)

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :AFTER :DEEXPOSE) (&REST IGNORE)
  (SETQ BOTTOM-REACHED NIL))
       
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :MAKE-COMPLETE) ()
  (SETQ INCOMPLETE-P NIL))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :ACTIVE-P) ()
  BOTTOM-REACHED)

;;Expose, but don't clear the screen
(DEFMETHOD (BASIC-TYPEOUT-WINDOW :EXPOSE-FOR-TYPEOUT) ()
  ;; This is here so that we don't try to activate ourselves while we are locked,
  ;; so that we don't violate locking order, because activating requires getting
  ;; a lock on our superior
  (FUNCALL-SELF ':ACTIVATE)
  (FUNCALL-SELF ':EXPOSE NIL ':NOOP)
  (OR EXPOSED-P
      ;; If our superior has no screen array, we won't really be exposed.  So wait
      ;; until really exposed to prevent infinite regression
      (PROCESS-WAIT "Typeout Exposed" #'CAR (LOCF (SHEET-EXPOSED-P SELF))))
  (SHEET-HOME SELF)
  (SHEET-CLEAR-EOL SELF))

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :NOTICE) (EVENT &REST IGNORE)
  (AND (EQ EVENT ':ERROR)
       (SHEET-CAN-GET-LOCK SELF)	;Try not to get hung before deciding
       (SHEET-CAN-GET-LOCK SUPERIOR)	;to use the cold-load stream
       (SHEET-SCREEN-ARRAY SUPERIOR)	;KLUDGE: don't wait in above method for screen-array
       (EQUAL DEEXPOSED-TYPEOUT-ACTION '(:EXPOSE-FOR-TYPEOUT))	; and make sure of this too
       (FUNCALL-SELF ':OUTPUT-HOLD-EXCEPTION))
  NIL)

(DEFMETHOD (BASIC-TYPEOUT-WINDOW :BEFORE :DEEXPOSE) (&REST IGNORE)
  (SETQ INCOMPLETE-P NIL))

;;;THIS IS A BIT OF A KLUDGE AND SHOULD PERHAPS BE INCLUDED SOMEWHERE ELSE
(DEFFLAVOR KLUDGE-INFERIOR-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :MIXIN "Turns off superiors blinkers when exposed"))

(DEFWRAPPER (KLUDGE-INFERIOR-MIXIN :EXPOSE) (IGNORE . BODY)
  `(LOCAL-DECLARE ((SPECIAL .OLD-SELECTED-WINDOW.))
     (LET ((.OLD-SELECTED-WINDOW. SELECTED-WINDOW))
       . ,BODY)))

(DEFMETHOD (KLUDGE-INFERIOR-MIXIN :AFTER :SELECT) (&REST IGNORE)
  (TURN-OFF-SHEET-BLINKERS SUPERIOR))  

(DEFMETHOD (KLUDGE-INFERIOR-MIXIN :AFTER :EXPOSE) (&REST IGNORE)
  (LOCAL-DECLARE ((SPECIAL .OLD-SELECTED-WINDOW.))
    (AND (EQ SUPERIOR .OLD-SELECTED-WINDOW.)
	 (FUNCALL-SELF ':SELECT))))

(DEFMETHOD (KLUDGE-INFERIOR-MIXIN :BEFORE :DEEXPOSE) (&REST IGNORE)
  (AND (EQ SELF SELECTED-WINDOW) (FUNCALL SUPERIOR ':SELECT)))

(DEFFLAVOR TYPEOUT-WINDOW-WITH-MOUSE-SENSITIVE-ITEMS ((LABEL NIL) (BORDERS NIL))
  (BASIC-MOUSE-SENSITIVE-ITEMS KLUDGE-INFERIOR-MIXIN NOTIFICATION-MIXIN
   BASIC-TYPEOUT-WINDOW WINDOW)
  (:DOCUMENTATION :COMBINATION "Typeout window with item operations"))

(DEFFLAVOR TYPEOUT-WINDOW ((LABEL NIL) (BORDERS NIL))
  (BASIC-TYPEOUT-WINDOW KLUDGE-INFERIOR-MIXIN NOTIFICATION-MIXIN WINDOW))

(COMPILE-FLAVOR-METHODS TYPEOUT-WINDOW-WITH-MOUSE-SENSITIVE-ITEMS TYPEOUT-WINDOW)