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

;;; WINDOW type flavor
(DEFFLAVOR ESSENTIAL-WINDOW () (SHEET)
  (:INIT-KEYWORDS :EDGES-FROM :MINIMUM-WIDTH :MINIMUM-HEIGHT :ACTIVATE-P :EXPOSE-P)
  (:DOCUMENTATION :LOWLEVEL-MIXIN "The flavor that is part of every window
This had better be at the end of your any hierarchy, it should also always
be an :included-flavor of any window mixin just so that instance variables
are declared properly."))

(DEFMETHOD (ESSENTIAL-WINDOW :BEFORE :MOUSE-SELECT) (&REST IGNORE &AUX BUF)
  (WITHOUT-INTERRUPTS
    (AND SELECTED-WINDOW
	 (SETQ BUF (FUNCALL SELECTED-WINDOW ':IO-BUFFER))
	 (KBD-SNARF-INPUT BUF))))

(DEFMETHOD (ESSENTIAL-WINDOW :MOUSE-SELECT) (&REST ARGS)
  (LEXPR-FUNCALL-SELF ':SELECT ARGS))

(DEFMETHOD (ESSENTIAL-WINDOW :LISP-LISTENER-P) () NIL)

(DEFMETHOD (ESSENTIAL-WINDOW :SELECTABLE-WINDOWS) ()
  "Returns inferiors to all levels that are selectable in a form suitable for
use as a menu item-list."
  (LET ((SELECTABLE-WINDOWS (MAPCAN #'(LAMBDA (I) (FUNCALL I ':SELECTABLE-WINDOWS))
				    INFERIORS))
	(STRING))
    (AND (SETQ STRING (FUNCALL-SELF ':NAME-FOR-SELECTION))
	 (PUSH (LIST STRING SELF) SELECTABLE-WINDOWS))))

(DEFMETHOD (ESSENTIAL-WINDOW :BEFORE :INIT) (INIT-PLIST &AUX EDGES-FROM)

  (OR NAME
      (LET ((FLAVOR-NAME (TYPEP SELF)))
	(LET ((N (1+ (OR (GET FLAVOR-NAME 'UNNAMED-WINDOW-INSTANCE-COUNT) 0))))
	  (PUTPROP FLAVOR-NAME N 'UNNAMED-WINDOW-INSTANCE-COUNT)
	  (SETQ NAME (FORMAT NIL "~A-~D" FLAVOR-NAME N)))))

  (SETQ EDGES-FROM (GET INIT-PLIST ':EDGES-FROM))
  (COND ((NULL EDGES-FROM))
	((STRINGP EDGES-FROM)
	 (PUTPROP INIT-PLIST EDGES-FROM ':CHARACTER-WIDTH)
	 (PUTPROP INIT-PLIST EDGES-FROM ':CHARACTER-HEIGHT))
	(T
	 (PUTPROP INIT-PLIST
		  (COND ((LISTP EDGES-FROM)
			 ;; If a list, means explicit edges specified
			 EDGES-FROM)
			((EQ EDGES-FROM ':MOUSE)
			 ;; Get edges from mouse
			 (LET ((MINIMUM-WIDTH (OR (GET INIT-PLIST ':MINIMUM-WIDTH) 0))
			       (MINIMUM-HEIGHT (OR (GET INIT-PLIST ':MINIMUM-HEIGHT) 0)))
			   (MULTIPLE-VALUE-LIST
			     (MOUSE-SPECIFY-RECTANGLE-SET-SHEET NIL NIL NIL NIL SUPERIOR
								MINIMUM-WIDTH
								MINIMUM-HEIGHT))))
			((TYPEP EDGES-FROM 'ESSENTIAL-WINDOW)
			 ;; A window, use it's edges
			 (OR (EQ SUPERIOR (SHEET-SUPERIOR EDGES-FROM))
			     (FERROR NIL
				"Attempt to get edges from sheet (~S) with different superior"
				     EDGES-FROM))
			 (LIST (SHEET-X EDGES-FROM)
			       (SHEET-Y EDGES-FROM)
			       (+ (SHEET-X EDGES-FROM) (SHEET-WIDTH EDGES-FROM))
			       (+ (SHEET-Y EDGES-FROM) (SHEET-HEIGHT EDGES-FROM))))
			(T (FERROR NIL
				   "~S is illegal :EDGES-FROM specification" EDGES-FROM)))
		  ':EDGES)))
  (LET ((INSIDE-WIDTH (OR (GET INIT-PLIST ':INSIDE-WIDTH)
			  (FIRST (GET INIT-PLIST ':INSIDE-SIZE))))
	(INSIDE-HEIGHT (OR (GET INIT-PLIST ':INSIDE-HEIGHT)
			   (SECOND (GET INIT-PLIST ':INSIDE-SIZE)))))
    (AND INSIDE-WIDTH (SETQ WIDTH (+ INSIDE-WIDTH LEFT-MARGIN-SIZE RIGHT-MARGIN-SIZE)))
    (AND INSIDE-HEIGHT (SETQ HEIGHT (+ INSIDE-HEIGHT TOP-MARGIN-SIZE BOTTOM-MARGIN-SIZE)))))

(DEFFLAVOR MINIMUM-WINDOW () (ESSENTIAL-EXPOSE ESSENTIAL-ACTIVATE ESSENTIAL-SET-EDGES
			      ESSENTIAL-MOUSE ESSENTIAL-WINDOW)
  (:DOCUMENTATION :COMBINATION "Essential flavors for most normal windows
Most windows should include this at the end of their hierachy or all of its components."))

(DEFFLAVOR WINDOW-WITHOUT-LABEL () (STREAM-MIXIN BORDERS-MIXIN SELECT-MIXIN
				    POP-UP-NOTIFICATION-MIXIN GRAPHICS-MIXIN MINIMUM-WINDOW))

(DEFFLAVOR WINDOW () (STREAM-MIXIN BORDERS-MIXIN LABEL-MIXIN SELECT-MIXIN
		      POP-UP-NOTIFICATION-MIXIN GRAPHICS-MIXIN MINIMUM-WINDOW)
  (:DOCUMENTATION :COMBINATION "This is the simplest practical window
It probably isn't what you want, except for testing purposes; although it is useful for
mixing with one or two simple mixins to get something useful."))

;;; Basic exposure/deexposure
(DEFFLAVOR ESSENTIAL-EXPOSE () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :ESSENTIAL-MIXIN "Handles default exposure behaviour.
Makes sure the screen manager is aware of a window leaving or entering the screen."))

(DEFMETHOD (ESSENTIAL-EXPOSE :AFTER :EXPOSE) (&REST IGNORE)
  (SCREEN-CONFIGURATION-HAS-CHANGED SELF ':EXPOSE))

(DEFMETHOD (ESSENTIAL-EXPOSE :AFTER :DEEXPOSE) (&REST IGNORE)
  (SCREEN-CONFIGURATION-HAS-CHANGED SELF ':DEEXPOSE))

(DEFWRAPPER (ESSENTIAL-EXPOSE :BURY) (IGNORE . BODY)
  `(DELAYING-SCREEN-MANAGEMENT . ,BODY))

;;; Basic activation/deactivation
(DEFFLAVOR ESSENTIAL-ACTIVATE () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :ESSENTIAL-MIXIN "Handles default activation behaviour
Makes sure a window is activated before it can get exposed (see discussion of activation).
Also provides for the :STATUS and :SET-STATUS messages (q.v.)."))

(DEFMETHOD (ESSENTIAL-ACTIVATE :BEFORE :EXPOSE) (&REST IGNORE)
  (WITHOUT-SCREEN-MANAGEMENT
    (FUNCALL-SELF ':ACTIVATE)))

(DEFMETHOD (ESSENTIAL-ACTIVATE :AFTER :ACTIVATE) ()
  (SCREEN-ACTIVITY-HAS-CHANGED SELF T))

(DEFMETHOD (ESSENTIAL-ACTIVATE :AFTER :DEACTIVATE) ()
  (SCREEN-ACTIVITY-HAS-CHANGED SELF NIL))

(DEFMETHOD (ESSENTIAL-ACTIVATE :BURY) () (SYSTEM-BURY SELF))

(DEFMETHOD (ESSENTIAL-ACTIVATE :STATUS) ()
  (COND ((EQ SELF SELECTED-WINDOW) ':SELECTED)
	((DO ((WINDOW SELF (SHEET-SUPERIOR WINDOW)))
	     ((NULL WINDOW) T)
	   (OR (SHEET-EXPOSED-P WINDOW) (RETURN NIL)))
	 ':EXPOSED)				;Only if really on screen
	((AND SUPERIOR (MEMQ SELF (SHEET-EXPOSED-INFERIORS SUPERIOR)))
	 ':EXPOSED-IN-SUPERIOR)			;Would be exposed if superior was
	((OR (NULL SUPERIOR) (MEMQ SELF (SHEET-INFERIORS SUPERIOR)))
	 ':DEEXPOSED)
	(T ':DEACTIVATED)))

(DEFMETHOD (ESSENTIAL-ACTIVATE :SET-STATUS) (NEW-STATUS)
  (SELECTQ NEW-STATUS
    (:SELECTED (FUNCALL-SELF ':SELECT))
    (:EXPOSED
      (FUNCALL-SELF ':EXPOSE)
      (AND (EQ SELF SELECTED-WINDOW)
	   (FUNCALL-SELF ':DESELECT NIL)))	;Don't restore-selected!
    (:EXPOSED-IN-SUPERIOR
      (OR (MEMQ SELF (SHEET-EXPOSED-INFERIORS SUPERIOR))
	  (FUNCALL-SELF ':EXPOSE))
      (AND (EQ SELF SELECTED-WINDOW)
	   (FUNCALL-SELF ':DESELECT NIL)))	;Don't restore-selected!
    (:DEEXPOSED
      (OR (MEMQ SELF (SHEET-INFERIORS SUPERIOR))
	  (FUNCALL-SELF ':ACTIVATE))
      (AND (MEMQ SELF (SHEET-EXPOSED-INFERIORS SUPERIOR))
	   (FUNCALL-SELF ':DEEXPOSE)))
    (:DEACTIVATED
      (AND (MEMQ SELF (SHEET-INFERIORS SUPERIOR))
	   (FUNCALL-SELF ':DEACTIVATE)))
    (OTHERWISE (FERROR NIL "~S not one of :DEACTIVATED, :DEEXPOSED, :EXPOSED, :SELECTED"
		           NEW-STATUS))))

(DEFUN SYSTEM-BURY (WINDOW &AUX (INHIBIT-SCHEDULING-FLAG T) SUP INFS)
  "Buries a window -- gives it the lowest priority in its priority class by putting it on the
end of active windows."
  (SETQ SUP (SHEET-SUPERIOR WINDOW))
  (DO () ((NOT (MEMQ WINDOW (SHEET-EXPOSED-INFERIORS SUP))))
    (SETQ INHIBIT-SCHEDULING-FLAG NIL)
    (FUNCALL WINDOW ':DEEXPOSE)
    (SETQ INHIBIT-SCHEDULING-FLAG T))
  (COND ((MEMQ WINDOW (SETQ INFS (SHEET-INFERIORS SUP)))
	 (SETQ INFS (DELQ WINDOW INFS))
	 (SHEET-CONSING
	   (COND (INFS (RPLACD (LAST (SETQ INFS (COPYLIST INFS))) (NCONS WINDOW)))
		 (T (SETQ INFS (NCONS WINDOW)))))
	 (SETF (SHEET-INFERIORS SUP) INFS)
	 (SETQ INHIBIT-SCHEDULING-FLAG NIL)
	 (SCREEN-CONFIGURATION-HAS-CHANGED WINDOW))))


;;; Basic selection/deselection
(DEFFLAVOR SELECT-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW POP-UP-NOTIFICATION-MIXIN)
  :GETTABLE-INSTANCE-VARIABLES
  :SETTABLE-INSTANCE-VARIABLES
  (:REQUIRED-INSTANCE-VARIABLES IO-BUFFER)
  (:DOCUMENTATION :MIXIN "Default SELECTion behaviour
Provides a :NAME-FOR-SELECTION message that gives the window's label or name, and simple
:CALL, :BREAK, and :ABORT messages.  Note that any window that can be selected is expected
to handle these messages, and should probably include this flavor somewhere."))

(DEFMETHOD (SELECT-MIXIN :NAME-FOR-SELECTION) (&AUX LABEL)
  (OR (COND ((GET-HANDLER-FOR SELF ':LABEL)
	     (SETQ LABEL (FUNCALL-SELF ':LABEL))
	     (OR (STRINGP LABEL) (SETQ LABEL (LABEL-STRING LABEL)))
	     (AND (STRING-SEARCH-NOT-CHAR #\SP LABEL) LABEL)))
      NAME))

(DEFMETHOD (SELECT-MIXIN :AFTER :DEACTIVATE) (&REST IGNORE)
  (REMOVE-FROM-PREVIOUSLY-SELECTED-WINDOWS SELF))

;;; This could simply do (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS SELF T) except
;;; this method gets run whether or not the window was already active when
;;; the :ACTIVATE message was sent.  What a drag.
;;; If process not otherwise known, default to process which is activating
;;; the window which will usually be good enough for the who-line.
(DEFMETHOD (SELECT-MIXIN :AFTER :ACTIVATE) (&REST IGNORE)
  (OR (IO-BUFFER-LAST-OUTPUT-PROCESS IO-BUFFER)
      (SETF (IO-BUFFER-LAST-OUTPUT-PROCESS IO-BUFFER) CURRENT-PROCESS))
  (LET ((W (FUNCALL-SELF ':ALIAS-FOR-SELECTED-WINDOWS)))
    (OR (EQ W SELECTED-WINDOW)
	;; Can be activating a pane relative to a frame which is not itself activated
	(DO ((SUP (SHEET-SUPERIOR W) (SHEET-SUPERIOR SUP))
	     (INF W SUP))
	    ((NULL SUP) NIL)
	  (OR (MEMQ INF (SHEET-INFERIORS SUP)) (RETURN T)))
	(DO ((I 0 (1+ I))
	     (N (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS)))
	    (( I N) (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS W T))
	  (AND (EQ (AREF PREVIOUSLY-SELECTED-WINDOWS I) W) (RETURN NIL))))))

(DEFMETHOD (SELECT-MIXIN :ALIAS-FOR-SELECTED-WINDOWS) () SELF)

(DEFMETHOD (SELECT-MIXIN :PROCESS) ()
  (IO-BUFFER-LAST-OUTPUT-PROCESS IO-BUFFER))

(DEFMETHOD (SELECT-MIXIN :SET-PROCESS) (PROC)
  (SETF (IO-BUFFER-LAST-OUTPUT-PROCESS IO-BUFFER) PROC))

(DEFMETHOD (SELECT-MIXIN :CALL) (&AUX WINDOW)
  (LET ((LAST-PROCESS (FUNCALL-SELF ':PROCESS)))
    (AND LAST-PROCESS (FUNCALL LAST-PROCESS ':ARREST-REASON ':CALL)))
  (SETQ WINDOW
	(IF (EQ (FUNCALL-SELF ':LISP-LISTENER-P) ':IDLE)		 
	    SELF
	    (KBD-DEFAULT-CALL-WINDOW SUPERIOR)))
  (SHEET-FREE-TEMPORARY-LOCKS WINDOW)
  (FUNCALL WINDOW ':SELECT))

(DEFMETHOD (SELECT-MIXIN :ARREST) (&AUX LAST-PROCESS)
  (AND (SETQ LAST-PROCESS (FUNCALL-SELF ':PROCESS))
       (FUNCALL LAST-PROCESS ':ARREST-REASON)))

(DEFMETHOD (SELECT-MIXIN :UN-ARREST) (&AUX LAST-PROCESS)
  (AND (SETQ LAST-PROCESS (FUNCALL-SELF ':PROCESS))
       (FUNCALL LAST-PROCESS ':REVOKE-ARREST-REASON)))

(DEFMETHOD (SELECT-MIXIN :SELECT) (&OPTIONAL IGNORE)
  (LET ((LAST-PROCESS (FUNCALL-SELF ':PROCESS)))
    (AND LAST-PROCESS (FUNCALL LAST-PROCESS ':REVOKE-ARREST-REASON ':CALL)))
  (SYSTEM-SELECT)
  (REMOVE-FROM-PREVIOUSLY-SELECTED-WINDOWS SELF)
  T)	;For frames and :MOUSE-SELECT

(DEFMETHOD (SELECT-MIXIN :MOUSE-SELECT) (&REST ARGS)
  "Form of select used when 'mouseing' windows.  Clears all temp locks that are on the
window, as well as failing if the window is not fully within its superior."
  (FUNCALL-SELF ':ACTIVATE)		;Maybe our size has to get adjusted first
  (COND ((SHEET-WITHIN-SHEET-P SELF SUPERIOR)
	 (SHEET-FREE-TEMPORARY-LOCKS SELF)	;Flush all temp windows that cover us
	 (LEXPR-FUNCALL-SELF ':SELECT ARGS))))

(DEFMETHOD (SELECT-MIXIN :DESELECT) (&OPTIONAL (RESTORE-SELECTED T))
  (LET ((SW SELECTED-WINDOW))
    (SYSTEM-DESELECT)
    (COND ((NEQ SELF SW))			;Don't do below unless REALLY was deselected
	  (RESTORE-SELECTED
	   (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS SELF T)
	   (SELECT-PREVIOUS-WINDOW NIL NIL NIL))
	  (T (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS SELF)))))

(DEFWRAPPER (SELECT-MIXIN :SELECT) (IGNORE . BODY)
  `(DELAYING-SCREEN-MANAGEMENT . ,BODY))

(DEFWRAPPER (SELECT-MIXIN :DESELECT) (IGNORE . BODY)
  `(DELAYING-SCREEN-MANAGEMENT . ,BODY))

(DEFMETHOD (SELECT-MIXIN :BEFORE :SELECT) (&OPTIONAL (SAVE-SELECTED T) &AUX OSW)
  (SETQ OSW SELECTED-WINDOW)
  (OR EXPOSED-P (FUNCALL-SELF ':EXPOSE T))
  (DO SHEET SUPERIOR (SHEET-SUPERIOR SHEET) (NULL SHEET)	;Really onto the screen
    (OR (SHEET-EXPOSED-P SHEET) (FUNCALL SHEET ':EXPOSE)))
  (WITHOUT-INTERRUPTS
    (AND OSW SAVE-SELECTED (NEQ SELF OSW)
	 (NEQ (FUNCALL OSW ':STATUS) ':DEACTIVATED)	;Deexposing can deactivate
	 (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS OSW))))

(DEFMETHOD (SELECT-MIXIN :AFTER :SELECT) (&REST IGNORE)
  (SETF (IO-BUFFER-LAST-OUTPUT-PROCESS IO-BUFFER) (FUNCALL-SELF ':PROCESS))
  (KBD-GET-IO-BUFFER))

(DEFMETHOD (SELECT-MIXIN :AFTER :DESELECT) (&REST IGNORE)
  (KBD-CLEAR-SELECTED-IO-BUFFER))

(DEFMETHOD (SELECT-MIXIN :BEFORE :DEEXPOSE) (&REST IGNORE)
  (FUNCALL-SELF ':DESELECT NIL))


(DECLARE-FLAVOR-INSTANCE-VARIABLES (SELECT-MIXIN)
(DEFUN SYSTEM-SELECT (&AUX (INHIBIT-SCHEDULING-FLAG T))
  "Select a window.  Make its blinkers blink."
  (DO () ((MEMQ SELF (SHEET-EXPOSED-INFERIORS SUPERIOR)))
    (SETQ INHIBIT-SCHEDULING-FLAG NIL)
    (FUNCALL-SELF ':EXPOSE T)
    (SETQ INHIBIT-SCHEDULING-FLAG T))
  (COND ((NEQ SELECTED-WINDOW SELF)
	 (AND SELECTED-WINDOW (FUNCALL SELECTED-WINDOW ':DESELECT NIL))
	 (SELECT-SHEET-BLINKERS SELF)
	 (SETQ SELECTED-WINDOW SELF)))
  T)
)

(DECLARE-FLAVOR-INSTANCE-VARIABLES (SELECT-MIXIN)
(DEFUN SYSTEM-DESELECT ()
  "Deselect a window.  Make its blinkers stay on or off as specified."
  (COND ((EQ SELF SELECTED-WINDOW)
	 (DESELECT-SHEET-BLINKERS SELF)
	 (SETQ SELECTED-WINDOW NIL))))
)

(DEFFLAVOR DONT-SELECT-WITH-MOUSE-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :MIXIN "Don't allow selection via the mouse and similar ways
Include this for windows that may be selected internally by a program, but which
will not work if just randomly selected, e.g. they do not have their own process.
They will then not show up in the Select system menu, or be gettable to in other
similar ways."))

(DEFMETHOD (DONT-SELECT-WITH-MOUSE-MIXIN :NAME-FOR-SELECTION) () NIL)


;;; Stuff for remembering a "ring buffer" of recently-selected windows
;;; This is an array whose 0'th element is the most recently selected
;;; window.  Successive elements are windows that were selected before
;;; that.  After the oldest entry, the rest of the array is NIL.  A
;;; window may only appear once in this array.  The selected-window does
;;; not appear at all, nor do deactivated windows.

(DEFVAR PREVIOUSLY-SELECTED-WINDOWS (MAKE-ARRAY PERMANENT-STORAGE-AREA 'ART-Q 20.))

(DEFUN ADD-TO-PREVIOUSLY-SELECTED-WINDOWS (WINDOW &OPTIONAL AT-END)
  (WITHOUT-INTERRUPTS
    (SETQ WINDOW (FUNCALL WINDOW ':ALIAS-FOR-SELECTED-WINDOWS))
    (AND WINDOW (REMOVE-FROM-PREVIOUSLY-SELECTED-WINDOWS WINDOW))
    (DO ((I 0 (1+ I))
	 (N (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS)))
	((OR (NULL WINDOW) (= I N))
	 (COND (WINDOW
		(SETQ PREVIOUSLY-SELECTED-WINDOWS
		      (ADJUST-ARRAY-SIZE PREVIOUSLY-SELECTED-WINDOWS (+ N 10.)))
		(ASET WINDOW PREVIOUSLY-SELECTED-WINDOWS N))))
      (LET ((TEM (AREF PREVIOUSLY-SELECTED-WINDOWS I)))
	(COND ((OR (NOT AT-END) (NULL TEM))
	       (ASET WINDOW PREVIOUSLY-SELECTED-WINDOWS I)
	       (SETQ WINDOW TEM)))))
    NIL))

(DEFUN REMOVE-FROM-PREVIOUSLY-SELECTED-WINDOWS (WINDOW)
  (WITHOUT-INTERRUPTS
    (SETQ WINDOW (FUNCALL WINDOW ':ALIAS-FOR-SELECTED-WINDOWS))
    (OR (NULL WINDOW)
	(DO ((I 0 (1+ I))
	     (N (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS)))
	    ((= I N) (NOT WINDOW))
	  (COND ((EQ (AREF PREVIOUSLY-SELECTED-WINDOWS I) WINDOW)
		 (COND ((NULL WINDOW)
			(ASET NIL PREVIOUSLY-SELECTED-WINDOWS (1- I))
			(RETURN T)))
		 (ASET NIL PREVIOUSLY-SELECTED-WINDOWS I)
		 (SETQ WINDOW NIL))
		((NULL WINDOW)
		 (ASET (AREF PREVIOUSLY-SELECTED-WINDOWS I)
		       PREVIOUSLY-SELECTED-WINDOWS (1- I))))))))

(DEFUN CHANGE-IN-PREVIOUSLY-SELECTED-WINDOWS (FROM-WINDOW TO-WINDOW)
  (WITHOUT-INTERRUPTS
    (SETQ FROM-WINDOW (FUNCALL FROM-WINDOW ':ALIAS-FOR-SELECTED-WINDOWS)
	  TO-WINDOW (FUNCALL TO-WINDOW ':ALIAS-FOR-SELECTED-WINDOWS))
    (COND ((AND (NULL FROM-WINDOW) (NULL TO-WINDOW)))
	  ((AND FROM-WINDOW (NULL TO-WINDOW))
	   (REMOVE-FROM-PREVIOUSLY-SELECTED-WINDOWS FROM-WINDOW))
	  ((NULL FROM-WINDOW)
	   ;; This shouldn't happen, but...
	   (ADD-TO-PREVIOUSLY-SELECTED-WINDOWS TO-WINDOW))
	  (T (DO ((I 0 (1+ I))
		  (N (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS)))
		 ((= I N))
	       (COND ((EQ (AREF PREVIOUSLY-SELECTED-WINDOWS I) FROM-WINDOW)
		      (ASET TO-WINDOW PREVIOUSLY-SELECTED-WINDOWS I)
		      (RETURN T))))))))

(DEFUN SELECT-PREVIOUS-WINDOW (&OPTIONAL WINDOW (MOUSE-P T) (DEFAULT-TO-LISP-LISTENER T)
					 MOUSE-SELECT)
  "Select the window that was selected before the current one.
  If WINDOW is non-NIL it tries to select that one, if it is active.
  MOUSE-P T (the default) means consider only windows selectable from the mouse.
  If no previously-selected window can be found, gets a Lisp listener,
  unless DEFAULT-TO-LISP-LISTENER is specified as NIL.
  Moves the current window to the end of the ring buffer rather than the beginning.
  Returns the window that was selected.  If MOUSE-SELECT a :MOUSE-SELECT message is
  sent rather than a :SELECT message."
  (AND WINDOW
       (SETQ WINDOW (FUNCALL WINDOW ':ALIAS-FOR-SELECTED-WINDOWS))
       (EQ (FUNCALL WINDOW ':STATUS) ':DEACTIVATED)
       (SETQ WINDOW NIL))
  (OR WINDOW
      (DOTIMES (I (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS))
	(AND (SETQ WINDOW (AREF PREVIOUSLY-SELECTED-WINDOWS I))
	     (OR (NOT MOUSE-P) (FUNCALL WINDOW ':NAME-FOR-SELECTION))
	     (RETURN WINDOW)))
      (SETQ WINDOW (AND DEFAULT-TO-LISP-LISTENER (IDLE-LISP-LISTENER))))
  (DELAYING-SCREEN-MANAGEMENT	;Avoid auto-select
    (LET ((SW SELECTED-WINDOW))
      (COND (SW (FUNCALL SW ':DESELECT NIL)
		(ADD-TO-PREVIOUSLY-SELECTED-WINDOWS SW T))))
    (COND ((AND WINDOW MOUSE-SELECT)
	   (FUNCALL WINDOW ':MOUSE-SELECT))
	  (WINDOW
	   (SHEET-FREE-TEMPORARY-LOCKS WINDOW)
	   (FUNCALL WINDOW ':SELECT))))
  WINDOW)

(DEFUN DESELECT-AND-MAYBE-BURY-WINDOW (WINDOW)
  "Deselect WINDOW and bury it if that leaves it deexposed."
  (DELAYING-SCREEN-MANAGEMENT
    (FUNCALL WINDOW ':DESELECT)
    (OR (SHEET-EXPOSED-P WINDOW) (FUNCALL WINDOW ':BURY))))

;;; Basic set-edges stuff
(DEFFLAVOR ESSENTIAL-SET-EDGES () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:METHOD-COMBINATION (:OR :BASE-FLAVOR-FIRST :VERIFY-NEW-EDGES))
  (:DOCUMENTATION :ESSENTIAL-MIXIN "Normal EDGES getting//setting messages
Provides :SET-EDGES and related messages such as :SET-SIZE, :SET-POSITION, :FULL-SCREEN,
and :CENTER-AROUND."))

(DEFMETHOD (ESSENTIAL-SET-EDGES :AFTER :INIT) (IGNORE)
  (LET ((ERROR-MESSAGE (FUNCALL-SELF ':VERIFY-NEW-EDGES X-OFFSET Y-OFFSET WIDTH HEIGHT)))
    (IF (NOT (NULL ERROR-MESSAGE))
	(FERROR NIL ERROR-MESSAGE))))

(DEFMETHOD (ESSENTIAL-SET-EDGES :SET-EDGES) (&REST ARGS) (APPLY #'SYSTEM-SET-EDGES ARGS))

(DEFMETHOD (ESSENTIAL-SET-EDGES :VERIFY-NEW-EDGES) (NL NT NW NH)
  "Verifies that the edges are ok.  This method returns NIL unless the edges do not allow
enough room for the margins, or the window is exposed and will not fit within its superior."
  (COND ((OR (< NW (+ LEFT-MARGIN-SIZE RIGHT-MARGIN-SIZE))
	     (< NH (+ TOP-MARGIN-SIZE BOTTOM-MARGIN-SIZE)))
	 "Not enough room for margins")
	((AND EXPOSED-P
	      (NOT (SHEET-BOUNDS-WITHIN-SHEET-P NL NT NW NH SUPERIOR)))
	 "Attempt to expose outside of superior")))

(DEFMETHOD (ESSENTIAL-SET-EDGES :SET-SIZE) (NEW-WIDTH NEW-HEIGHT &OPTIONAL OPTION)
  (FUNCALL-SELF ':SET-EDGES X-OFFSET Y-OFFSET
	   (+ NEW-WIDTH X-OFFSET) (+ NEW-HEIGHT Y-OFFSET)
	   OPTION))

(DEFMETHOD (ESSENTIAL-SET-EDGES :SET-INSIDE-SIZE) (NEW-WIDTH NEW-HEIGHT &OPTIONAL OPTION)
  (FUNCALL-SELF ':SET-EDGES X-OFFSET Y-OFFSET
	   (+ X-OFFSET NEW-WIDTH LEFT-MARGIN-SIZE RIGHT-MARGIN-SIZE)
	   (+ Y-OFFSET NEW-HEIGHT TOP-MARGIN-SIZE BOTTOM-MARGIN-SIZE)
	   OPTION))

(DEFMETHOD (ESSENTIAL-SET-EDGES :SET-POSITION) (NEW-X NEW-Y &OPTIONAL OPTION)
  (FUNCALL-SELF ':SET-EDGES NEW-X NEW-Y
	   (+ WIDTH NEW-X) (+ HEIGHT NEW-Y)
	   OPTION))

(DEFMETHOD (ESSENTIAL-SET-EDGES :FULL-SCREEN) (&OPTIONAL OPTION)
  (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
      (FUNCALL SUPERIOR ':INSIDE-EDGES)
    (FUNCALL-SELF ':SET-EDGES LEFT TOP RIGHT BOTTOM OPTION)))

(DEFMETHOD (ESSENTIAL-SET-EDGES :CENTER-AROUND) (X Y)
  (CENTER-WINDOW-AROUND SELF X Y))

(DEFMETHOD (ESSENTIAL-SET-EDGES :EXPOSE-NEAR) (MODE &OPTIONAL (WARP-MOUSE-P T))
  (EXPOSE-WINDOW-NEAR SELF MODE WARP-MOUSE-P))

(DEFUN CENTER-WINDOW-AROUND (WINDOW X Y &AUX (W (SHEET-WIDTH WINDOW))
					     (H (SHEET-HEIGHT WINDOW))
					     (SUPERIOR (SHEET-SUPERIOR WINDOW))
					     SH SW)
  (SETQ X (MAX (SHEET-INSIDE-LEFT SUPERIOR) (- X (// W 2)))
	Y (MAX (SHEET-INSIDE-TOP SUPERIOR) (- Y (// H 2))))
  (AND (> (+ X W) (SETQ SW (SHEET-INSIDE-RIGHT SUPERIOR)))
       (SETQ X (MAX (SHEET-INSIDE-LEFT SUPERIOR) (- SW W))))
  (AND (> (+ Y H) (SETQ SH (SHEET-INSIDE-BOTTOM SUPERIOR)))
       (SETQ Y (MAX (SHEET-INSIDE-TOP SUPERIOR) (- SH H))))
  (FUNCALL WINDOW ':SET-POSITION X Y)
  (PROG () (RETURN (+ X (// W 2)) (+ Y (// H 2)))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-SET-EDGES)
(DEFUN SYSTEM-SET-EDGES (NEW-LEFT NEW-TOP NEW-RIGHT NEW-BOTTOM &OPTIONAL OPTION
			 &AUX (NEW-WIDTH (- NEW-RIGHT NEW-LEFT))
			      (NEW-HEIGHT (- NEW-BOTTOM NEW-TOP))
			      ERROR WINDOW-TO-BE-DEEXPOSED)
  (DELAYING-SCREEN-MANAGEMENT
    (DO (DONE RESULT) (())
      (SETQ WINDOW-TO-BE-DEEXPOSED
	  (*CATCH 'SET-EDGES
	    (LOCK-SHEET (SELF)
	      (SETQ RESULT
		(COND ((SETQ ERROR (FUNCALL-SELF ':VERIFY-NEW-EDGES NEW-LEFT NEW-TOP
						 NEW-WIDTH NEW-HEIGHT))
		       ;; Can't put window there
		       (SELECTQ OPTION
			 (:VERIFY NIL)
			 (OTHERWISE
			  (FERROR NIL ERROR))))
		      ((EQ OPTION ':VERIFY)
		       ;; "Only want to know"
		       T)
		      ((AND (= NEW-WIDTH WIDTH)
			    (= NEW-HEIGHT HEIGHT)
			    (= NEW-LEFT X-OFFSET)
			    (= NEW-TOP Y-OFFSET))
		       ;;Not changing size or position, just return T (we do the verify 
		       ;; anyway in case something in the environment has made the current
		       ;; size no longer "ok", such as having the size of the
		       ;; superior change.)
		       T)
		      ((AND (= NEW-WIDTH WIDTH)
			    (= NEW-HEIGHT HEIGHT))
		       ;; Only moving the window, move it's bits behind its back
		       (LET ((CURRENT-RECTANGLE (LIST X-OFFSET Y-OFFSET
						      (+ X-OFFSET WIDTH)
						      (+ Y-OFFSET HEIGHT))))
			 (COND ((NOT EXPOSED-P)
				(SHEET-SET-DEEXPOSED-POSITION NEW-LEFT NEW-TOP)
				(LEXPR-FUNCALL #'SCREEN-AREA-HAS-CHANGED SELF
					       CURRENT-RECTANGLE)
				(SCREEN-CONFIGURATION-HAS-CHANGED SELF))
			       ((SHEET-TEMPORARY-P)
				;; For temporary windows, just deexpose and reexpose
				(LET ((SELECT-P (EQ SELF SELECTED-WINDOW)))
				  (FUNCALL-SELF ':DEEXPOSE)
				  (FUNCALL-SELF ':EXPOSE NIL NIL NEW-LEFT NEW-TOP)
				  (AND SELECT-P (FUNCALL-SELF ':SELECT))))
			       (T
				(OR (SHEET-BOUNDS-WITHIN-SHEET-P NEW-LEFT NEW-TOP
								 WIDTH HEIGHT
								 SUPERIOR)
				    (FERROR NIL
					    "Attempt to move sheet ~S outside of superior"
					    SELF))
				;; Make sure everyone under us is deexposed
				(WITHOUT-INTERRUPTS
				  (DOLIST (SISTER (SHEET-EXPOSED-INFERIORS SUPERIOR))
				    (COND ((AND (NEQ SELF SISTER)
						(SHEET-OVERLAPS-P SISTER NEW-LEFT NEW-TOP
								  WIDTH HEIGHT))
					   (*THROW 'SET-EDGES SISTER)))))
				(SHEET-SET-EXPOSED-POSITION NEW-LEFT NEW-TOP)
				(LEXPR-FUNCALL #'SCREEN-AREA-HAS-CHANGED SELF
					       CURRENT-RECTANGLE)
				(SCREEN-CONFIGURATION-HAS-CHANGED SELF)))))
		      (T
		       (LET ((CURRENT-RECTANGLE (LIST X-OFFSET Y-OFFSET
						      (+ X-OFFSET WIDTH)
						      (+ Y-OFFSET HEIGHT))))
			 (WITH-SHEET-DEEXPOSED (SELF)
			   (AND BIT-ARRAY
				(SI:PAGE-IN-ARRAY BIT-ARRAY NIL (LIST WIDTH HEIGHT)))
			   (FUNCALL-SELF ':CHANGE-OF-SIZE-OR-MARGINS
					 ':LEFT NEW-LEFT ':TOP NEW-TOP
					 ':WIDTH NEW-WIDTH ':HEIGHT NEW-HEIGHT)
			   (SHEET-FORCE-ACCESS (SELF :NO-PREPARE)
			     (FUNCALL-SELF ':REFRESH ':SIZE-CHANGED)))
			 (AND BIT-ARRAY (SI:PAGE-OUT-ARRAY BIT-ARRAY))
			 (SETQ MOUSE-RECONSIDER T)
			 (LEXPR-FUNCALL #'SCREEN-AREA-HAS-CHANGED SELF CURRENT-RECTANGLE)
			 (SCREEN-CONFIGURATION-HAS-CHANGED SELF)))))
	      (SETQ DONE T))))
      (IF DONE
	  (RETURN RESULT ERROR)
	  (FUNCALL WINDOW-TO-BE-DEEXPOSED ':DEEXPOSE)))))
)  ;End declare

;;; Expose the window next to the rectangle, to the right if it will fit
(DEFUN MOVE-WINDOW-NEAR-RECTANGLE (WINDOW LEFT TOP RIGHT BOTTOM
				   &OPTIONAL (EXPOSE-P T) (WARP-MOUSE-P T)
				   &AUX WIDTH HEIGHT SUPERIOR
					NLEFT NTOP NRIGHT NBOTTOM TEM)
  (MULTIPLE-VALUE (WIDTH HEIGHT) (FUNCALL WINDOW ':SIZE))
  (SETQ SUPERIOR (SHEET-SUPERIOR WINDOW))
  ;; Assuming window will go beside rectangle, try to center it vertically
  ;; but if that doesn't work butt it against the bottom of the superior.
  (SETQ NTOP (MIN (- (SHEET-INSIDE-BOTTOM SUPERIOR) HEIGHT)
		  (MAX (SHEET-INSIDE-TOP SUPERIOR)
		       (- (// (+ TOP BOTTOM) 2) (// HEIGHT 2))))
	NBOTTOM (+ NTOP HEIGHT))
  (COND (( (SHEET-INSIDE-RIGHT SUPERIOR) (SETQ TEM (+ RIGHT WIDTH)))
	 (SETQ NLEFT RIGHT NRIGHT TEM))
	(( (SHEET-INSIDE-LEFT SUPERIOR) (SETQ TEM (- LEFT WIDTH)))
	 (SETQ NRIGHT LEFT NLEFT TEM))
	(T  ;Not enough room on either side, center it horizontally above or below the rect
	 (SETQ NLEFT (MIN (- (SHEET-INSIDE-RIGHT SUPERIOR) WIDTH)
			  (MAX (SHEET-INSIDE-LEFT SUPERIOR)
			       (- (// (+ LEFT RIGHT) 2) (// WIDTH 2))))
	       NRIGHT (+ NLEFT WIDTH))
	 (COND (( (SHEET-INSIDE-TOP SUPERIOR) (SETQ TEM (- TOP HEIGHT)))
		(SETQ NBOTTOM TOP NTOP TEM))
	       (( (SHEET-INSIDE-BOTTOM SUPERIOR) (SETQ TEM (+ BOTTOM HEIGHT)))
		(SETQ NTOP BOTTOM NBOTTOM TEM))
	       (T (SETQ NTOP (SHEET-INSIDE-TOP SUPERIOR)
			NBOTTOM (+ NTOP HEIGHT))))))
  (FUNCALL WINDOW ':SET-EDGES NLEFT NTOP NRIGHT NBOTTOM)
  (AND EXPOSE-P (FUNCALL WINDOW ':EXPOSE))
  (AND WARP-MOUSE-P (FUNCALL WINDOW ':SET-MOUSE-POSITION (// WIDTH 2) (// HEIGHT 2))))

(DEFUN EXPOSE-WINDOW-NEAR (WINDOW MODE &OPTIONAL (WARP-MOUSE-P T) (EXPOSE-P T))
  (COND ((NOT (SHEET-EXPOSED-P WINDOW))
	 (SELECTQ (FIRST MODE)
	   (:POINT
	    (FUNCALL WINDOW ':CENTER-AROUND (SECOND MODE) (THIRD MODE)))
	   (:MOUSE
	    (MULTIPLE-VALUE-BIND (X-OFF Y-OFF)
		(SHEET-CALCULATE-OFFSETS (SHEET-SUPERIOR WINDOW) MOUSE-SHEET)
	      (MULTIPLE-VALUE-BIND (X Y)
		  (FUNCALL WINDOW ':CENTER-AROUND (- MOUSE-X X-OFF) (- MOUSE-Y Y-OFF))
		(AND WARP-MOUSE-P (MOUSE-WARP (+ X X-OFF) (+ Y Y-OFF))))))
	   (:RECTANGLE
	    (MOVE-WINDOW-NEAR-RECTANGLE WINDOW
				(SECOND MODE) (THIRD MODE) (FOURTH MODE) (FIFTH MODE)
				NIL WARP-MOUSE-P))
	   (:WINDOW
	    (LOOP FOR NEAR-WINDOW IN (CDR MODE) WITH (LEFT1 RIGHT1 TOP1 BOTTOM1 X-OFF Y-OFF)
		  DO (MULTIPLE-VALUE (LEFT1 TOP1 RIGHT1 BOTTOM1)
		       (FUNCALL NEAR-WINDOW ':EDGES))
		     (MULTIPLE-VALUE-BIND (X-OFF-1 Y-OFF-1)
			 (SHEET-CALCULATE-OFFSETS (SHEET-SUPERIOR WINDOW)
						  (SHEET-GET-SCREEN WINDOW))
		       (MULTIPLE-VALUE-BIND (X-OFF-2 Y-OFF-2)
			   (SHEET-CALCULATE-OFFSETS (SHEET-SUPERIOR NEAR-WINDOW)
						    (SHEET-GET-SCREEN NEAR-WINDOW))
			 (SETQ X-OFF (- X-OFF-1 X-OFF-2)
			       Y-OFF (- Y-OFF-1 Y-OFF-2))))
		  MINIMIZE (- LEFT1 X-OFF) INTO LEFT
		  MINIMIZE (- TOP1 Y-OFF) INTO TOP
		  MAXIMIZE (- RIGHT1 X-OFF) INTO RIGHT
		  MAXIMIZE (- BOTTOM1 Y-OFF) INTO BOTTOM
		  FINALLY (MOVE-WINDOW-NEAR-RECTANGLE WINDOW LEFT TOP RIGHT BOTTOM
						      NIL WARP-MOUSE-P)))
	   (OTHERWISE (FERROR NIL "~S invalid mode" (FIRST MODE))))
	 (AND EXPOSE-P (FUNCALL WINDOW ':EXPOSE)))))

;;;Things that hack margins (borders and labels)

;;;In order to interact correctly with adjusting the size of the margins, flavors
;;;that handle an area of the window further outside should come higher in the hierarchy,
;;;that is their pre-daemons should be called first.
;;;When redefining the window, pre-daemons for margin hackers should add in the amount
;;;they will need to the appropriate margins (this will happen in the right order).
;;;Thus to change the value of a border or label, send a :REDEFINE-MARGINS message with a
;;;:FOO property in it, and have a pre-daemon on :REDEFINE-MARGINS that calls ADJUST-MARGINS.

(DEFFLAVOR MARGIN-HACKER-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :LOWLEVEL-MIXIN "For mixins that occupy space in the margins
See the section on margins for what to do when you mix this in."))

(DEFMETHOD (MARGIN-HACKER-MIXIN :REDEFINE-MARGINS) (PLIST)
  (SETQ RESTORED-BITS-P T)
  (COND ((NOT (AND (= LEFT-MARGIN-SIZE (GET PLIST ':LEFT-MARGIN-SIZE))
		   (= TOP-MARGIN-SIZE (GET PLIST ':TOP-MARGIN-SIZE))
		   (= RIGHT-MARGIN-SIZE (GET PLIST ':RIGHT-MARGIN-SIZE))
		   (= BOTTOM-MARGIN-SIZE (GET PLIST ':BOTTOM-MARGIN-SIZE))))
	 (WITH-SHEET-DEEXPOSED (SELF)
	   (AND BIT-ARRAY (SI:PAGE-IN-ARRAY BIT-ARRAY))
	   (LET ((INSIDE-SIZE-CHANGED
		   (LEXPR-FUNCALL-SELF ':CHANGE-OF-SIZE-OR-MARGINS (CDR PLIST))))
	     (SHEET-FORCE-ACCESS (SELF :NO-PREPARE)
	       (FUNCALL-SELF ':REFRESH (IF INSIDE-SIZE-CHANGED
					   ':SIZE-CHANGED
					   ':MARGINS-ONLY))))
	   (AND BIT-ARRAY (SI:PAGE-OUT-ARRAY BIT-ARRAY))))))

;;;Adjust the margins, PARSING-MESSAGE is called on either the value of PLIST-KEYWORD
;;;in PLIST or INSTANCE-VARIABLE, it should return the new value, and the size required
;;;in the four margins.  INSTANCE-VARIABLE is then set to the new value, and the margins,
;;;either in PLIST, or the appropriate instance variables.
(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-WINDOW)
(DEFUN ADJUST-MARGINS (INSTANCE-VARIABLE PARSING-MESSAGE PLIST PLIST-KEYWORD
		       &AUX LM TM RM BM NVAL)
  (IF (NULL PLIST-KEYWORD)
      (SETQ LM LEFT-MARGIN-SIZE TM TOP-MARGIN-SIZE
	    RM RIGHT-MARGIN-SIZE BM BOTTOM-MARGIN-SIZE)
      (SETQ LM (OR (GET PLIST ':LEFT-MARGIN-SIZE) 0)
	    TM (OR (GET PLIST ':TOP-MARGIN-SIZE) 0)
	    RM (OR (GET PLIST ':RIGHT-MARGIN-SIZE) 0)
	    BM (OR (GET PLIST ':BOTTOM-MARGIN-SIZE) 0)))
  (SETQ NVAL (SYMEVAL INSTANCE-VARIABLE))
  (AND PLIST-KEYWORD (LET ((TEM (REMPROP PLIST PLIST-KEYWORD)))
		       (AND TEM (SETQ NVAL (CAR TEM)))))
  (MULTIPLE-VALUE (NVAL LM TM RM BM)
    (FUNCALL-SELF PARSING-MESSAGE NVAL LM TM RM BM))
  (IF (NULL PLIST-KEYWORD)
      (SETQ LEFT-MARGIN-SIZE LM TOP-MARGIN-SIZE TM
	    RIGHT-MARGIN-SIZE RM BOTTOM-MARGIN-SIZE BM)
      (PUTPROP PLIST LM ':LEFT-MARGIN-SIZE)
      (PUTPROP PLIST TM ':TOP-MARGIN-SIZE)
      (PUTPROP PLIST RM ':RIGHT-MARGIN-SIZE)
      (PUTPROP PLIST BM ':BOTTOM-MARGIN-SIZE))
  (SET INSTANCE-VARIABLE NVAL)))

;;;Borders
(DEFFLAVOR BORDERS-MIXIN ((BORDERS T) (BORDER-MARGIN-WIDTH 1)) (MARGIN-HACKER-MIXIN)
  (:GETTABLE-INSTANCE-VARIABLES BORDERS BORDER-MARGIN-WIDTH)
  (:INITABLE-INSTANCE-VARIABLES BORDERS BORDER-MARGIN-WIDTH)
  (:DOCUMENTATION :MIXIN "Normal BORDERS.
This flavor should provide general enough handling of the borders for most uses, see
the description of the :BORDERS init option for the format of the BORDERS instance
variable."))

(DEFMETHOD (BORDERS-MIXIN :BEFORE :INIT) (INIT-PLIST)
  (ADJUST-MARGINS 'BORDERS ':PARSE-BORDERS-SPEC INIT-PLIST NIL))

(DEFMETHOD (BORDERS-MIXIN :SET-BORDER-MARGIN-WIDTH) (NEW-WIDTH
						      &AUX (PLIST (LIST ':BORDERS BORDERS)))
  (SETQ BORDER-MARGIN-WIDTH NEW-WIDTH)
  (FUNCALL-SELF ':REDEFINE-MARGINS (LOCF PLIST)))

(DEFMETHOD (BORDERS-MIXIN :SET-BORDERS) (NEW-BORDERS
					     &AUX (PLIST (LIST ':BORDERS NEW-BORDERS)))
  (FUNCALL-SELF ':REDEFINE-MARGINS (LOCF PLIST)))

(DEFMETHOD (BORDERS-MIXIN :AFTER :REFRESH-MARGINS) ()
  (DRAW-BORDERS CHAR-ALUF))

(DEFMETHOD (BORDERS-MIXIN :BEFORE :REDEFINE-MARGINS) (PLIST)
  (ADJUST-MARGINS 'BORDERS ':PARSE-BORDERS-SPEC PLIST ':BORDERS))

(DEFMETHOD (BORDERS-MIXIN :PARSE-BORDERS-SPEC) (SPEC LM TM RM BM)
  (PARSE-BORDERS-SPEC SPEC LM TM RM BM 'DRAW-RECTANGULAR-BORDER))

;;;This handles the actual drawing of the borders
(DECLARE-FLAVOR-INSTANCE-VARIABLES (BORDERS-MIXIN)
(DEFUN DRAW-BORDERS (ALU)
  (SHEET-FORCE-ACCESS (SELF)
    (DOLIST (BORDER BORDERS)
      (AND BORDER
	   (NEQ BORDER ':ZERO)
	   (LET ((LEFT (SECOND BORDER))
		 (TOP (THIRD BORDER))
		 (RIGHT (FOURTH BORDER))
		 (BOTTOM (FIFTH BORDER)))
	     (FUNCALL (FIRST BORDER) SELF ALU
		      (IF (MINUSP LEFT) (+ LEFT WIDTH) LEFT)
		      (IF (MINUSP TOP) (+ TOP HEIGHT) TOP)
		      (IF (PLUSP RIGHT) RIGHT (+ RIGHT WIDTH))
		      (IF (PLUSP BOTTOM) BOTTOM (+ BOTTOM HEIGHT)))))))))

;;;This is called with the new border specification and the current (relative to this
;;;redefining) margins, and should return the canonical form of the border, and the four new
;;;margins.
(DECLARE-FLAVOR-INSTANCE-VARIABLES (BORDERS-MIXIN)
(DEFUN PARSE-BORDERS-SPEC (SPEC LM TM RM BM FUNCTION &OPTIONAL DEFAULT-SIZE)
  (COND ;;NIL means no borders at all
	(SPEC
	 ;;A symbol or an number means that type for each of the four, else make a copy
	 ;;a plist of (:LEFT FOO :RIGHT BAR) works too
	 (SETQ SPEC (COND ((ATOM SPEC)
			   (SETQ SPEC (LIST SPEC SPEC SPEC SPEC)))
			  ((MEMQ (CAR SPEC) '(:LEFT :RIGHT :TOP :BOTTOM))
			   (DO ((NSPEC (IF (ATOM BORDERS)
					   (LIST BORDERS BORDERS BORDERS BORDERS)
					   (APPEND BORDERS NIL)))
				(SPEC SPEC (CDDR SPEC)))
			       ((NULL SPEC) NSPEC)
			     (SETF (NTH (FIND-POSITION-IN-LIST (CAR SPEC)
							       '(:LEFT :RIGHT :TOP :BOTTOM))
					NSPEC)
				   (CADR SPEC))))
			  (T
			   (APPEND SPEC NIL))))
	 (DO ((SPEC SPEC (CDR SPEC))
	      (ITEM))
	     ((NULL SPEC))
	   (COND ((OR (NULL (SETQ ITEM (CAR SPEC)))
		      (EQ ITEM ':ZERO)))
		 ;;A number means that width of the default function
		 ((NUMBERP ITEM)
		  (SETF (CAR SPEC) (CONS FUNCTION ITEM)))
		 ;;A symbol means that function and its default width
		 ((SYMBOLP ITEM)
		  (AND (EQ ITEM T) (SETQ ITEM FUNCTION))
		  (SETF (CAR SPEC) (CONS ITEM (OR DEFAULT-SIZE
						  (GET ITEM 'DEFAULT-BORDER-SIZE)))))))
	 (DO ((SPEC SPEC (CDR SPEC))
	      (TYPES '(:LEFT :TOP :RIGHT :BOTTOM) (CDR TYPES))
	      (TYPE)
	      (ITEM)
	      (WIDTH))
	     ((NULL SPEC))
	   ;;A cons of a symbol and a number is the CAR function with the CDR width
	   (AND (SETQ ITEM (CAR SPEC)) (LISTP ITEM) (SETQ WIDTH (CDR ITEM))
		(IF (ATOM WIDTH)
		    (SETF (CDR ITEM) (LIST (IF (EQ (SETQ TYPE (CAR TYPES)) ':RIGHT) WIDTH 0)
					   (IF (EQ TYPE ':BOTTOM) WIDTH 0)
					   (IF (EQ TYPE ':LEFT) WIDTH 0)
					   (IF (EQ TYPE ':TOP) WIDTH 0)))
		    ;;Else make entries relative
		    (SETQ TYPE (CAR TYPES))
		    (LET ((WIDTH (- (FOURTH ITEM) (SECOND ITEM)))
			  (HEIGHT (- (FIFTH ITEM) (THIRD ITEM))))
		      (SETF (SECOND ITEM) (IF (EQ TYPE ':RIGHT) WIDTH 0))
		      (SETF (THIRD ITEM) (IF (EQ TYPE ':BOTTOM) HEIGHT 0))
		      (SETF (FOURTH ITEM) (IF (EQ TYPE ':LEFT) WIDTH 0))
		      (SETF (FIFTH ITEM) (IF (EQ TYPE ':TOP) HEIGHT 0))))))
	 ;;Now adjust all non-NIL items for the current margins
	 (DO ((SPEC SPEC (CDR SPEC))
	      (TYPES '(:LEFT :TOP :RIGHT :BOTTOM) (CDR TYPES))
	      (TYPE)
	      (ITEM)
	      (WIDTH)
	      (HEIGHT))
	     ((NULL SPEC))
	   (COND ((AND (SETQ ITEM (CAR SPEC)) (LISTP ITEM))
		  (SETQ TYPE (CAR TYPES))
		  (SETQ WIDTH (ABS (- (FOURTH ITEM) (SECOND ITEM)))
			HEIGHT (ABS (- (FIFTH ITEM) (THIRD ITEM))))
		  (COND ((SELECTQ TYPE
			   ((:LEFT :RIGHT) (ZEROP WIDTH))
			   ((:TOP :BOTTOM) (ZEROP HEIGHT)))
			 (SETF (CAR SPEC) ':ZERO))
			(T ;; Order here is L R T B to give symmetry
			   (SETF (SECOND ITEM)
				 (IF (EQ TYPE ':RIGHT)
				     (- (+ (SECOND ITEM) RM))
				     (+ (SECOND ITEM) LM)))
			   (SETF (FOURTH ITEM)
				 (IF (EQ TYPE ':LEFT)
				     (+ (FOURTH ITEM) LM)
				     (- (+ (FOURTH ITEM) RM))))
			   (SETF (THIRD ITEM)
				 (IF (EQ TYPE ':BOTTOM)
				     (- (+ (THIRD ITEM) BM))
				     (+ (THIRD ITEM) TM)))
			   (SETF (FIFTH ITEM)
				 (IF (EQ TYPE ':TOP)
				     (+ (FIFTH ITEM) TM)
				     (- (+ (FIFTH ITEM) BM))))
			   (SELECTQ TYPE
			     (:LEFT (SETQ LM (+ LM WIDTH)))
			     (:TOP (SETQ TM (+ TM HEIGHT)))
			     (:RIGHT (SETQ RM (+ RM WIDTH)))
			     (:BOTTOM (SETQ BM (+ BM HEIGHT)))))))))
	 ;;Now account for the extra margin
	 (AND (FIRST SPEC) (SETQ LM (+ LM BORDER-MARGIN-WIDTH)))
	 (AND (SECOND SPEC) (SETQ TM (+ TM BORDER-MARGIN-WIDTH)))
	 (AND (THIRD SPEC) (SETQ RM (+ RM BORDER-MARGIN-WIDTH)))
	 (AND (FOURTH SPEC) (SETQ BM (+ BM BORDER-MARGIN-WIDTH)))))
  (PROG () (RETURN SPEC LM TM RM BM))))

(DEFPROP DRAW-RECTANGULAR-BORDER 1 DEFAULT-BORDER-SIZE)
(DEFUN DRAW-RECTANGULAR-BORDER (WINDOW ALU LEFT TOP RIGHT BOTTOM)
  (%DRAW-RECTANGLE (- RIGHT LEFT) (- BOTTOM TOP) LEFT TOP ALU WINDOW))

;;;Labels
(DEFSTRUCT (ESSENTIAL-LABEL-MIXIN :LIST (:CONSTRUCTOR NIL))
  LABEL-LEFT					;Coordinates of the label, all relative to the
  LABEL-TOP					;edges of the window
  LABEL-RIGHT
  LABEL-BOTTOM)

(DEFFLAVOR ESSENTIAL-LABEL-MIXIN ((LABEL T)) (MARGIN-HACKER-MIXIN)
  (:GETTABLE-INSTANCE-VARIABLES LABEL)
  (:INITABLE-INSTANCE-VARIABLES LABEL)
  (:REQUIRED-METHODS :PARSE-LABEL-SPEC :DRAW-LABEL)
  (:DOCUMENTATION :LOWLEVEL-MIXIN "Lowlevel LABEL handling
This flavor probably isn't any good without some other label mixin.  See LABEL-MIXIN
for the normal label handler."))

(DEFFLAVOR WINDOW-WITH-ESSENTIAL-LABEL () (STREAM-MIXIN BORDERS-MIXIN ESSENTIAL-LABEL-MIXIN
						 SELECT-MIXIN MINIMUM-WINDOW)
  (:DOCUMENTATION :COMBINATION "Simple window for special label handling
Mix this with a special type of label mixin to get the simplest usable case of that mixin."))

(DEFMETHOD (ESSENTIAL-LABEL-MIXIN :LABEL-SIZE) ()
  (PROG ()
    (IF LABEL (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
		  (COMPUTE-LABEL-POSITION)
		(RETURN (- RIGHT LEFT) (- BOTTOM TOP)))
	      (RETURN 0 0))))

(DEFMETHOD (ESSENTIAL-LABEL-MIXIN :SET-LABEL) (NEW-LABEL
					       &AUX (PLIST (LIST ':LABEL NEW-LABEL)))
  (FUNCALL-SELF ':REDEFINE-MARGINS (LOCF PLIST))
  (COND (RESTORED-BITS-P
	 (ERASE-LABEL)		;This has the right dimensions, even though it is the new label, because it occupies the same margin space.
	 (DRAW-LABEL))))

(DEFMETHOD (ESSENTIAL-LABEL-MIXIN :BEFORE :INIT) (INIT-PLIST)
  (ADJUST-MARGINS 'LABEL ':PARSE-LABEL-SPEC INIT-PLIST NIL))

(DEFMETHOD (ESSENTIAL-LABEL-MIXIN :AFTER :REFRESH-MARGINS) ()
  (DRAW-LABEL))

(DEFMETHOD (ESSENTIAL-LABEL-MIXIN :BEFORE :REDEFINE-MARGINS) (PLIST)
  (ADJUST-MARGINS 'LABEL ':PARSE-LABEL-SPEC PLIST ':LABEL))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-LABEL-MIXIN)
(DEFUN ERASE-LABEL (&REST IGNORE)
  (AND LABEL
       (SHEET-FORCE-ACCESS (SELF)
	 (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
	     (COMPUTE-LABEL-POSITION)
	   (%DRAW-RECTANGLE (- RIGHT LEFT) (- BOTTOM TOP) LEFT TOP ERASE-ALUF SELF))))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-LABEL-MIXIN)
(DEFUN DRAW-LABEL (&REST IGNORE)
  (AND LABEL
       (SHEET-FORCE-ACCESS (SELF)
	 (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
	     (COMPUTE-LABEL-POSITION)
	   (FUNCALL-SELF ':DRAW-LABEL LABEL LEFT TOP RIGHT BOTTOM))))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-LABEL-MIXIN)
(DEFUN COMPUTE-LABEL-POSITION (&AUX LEFT TOP RIGHT BOTTOM)
  (SETQ LEFT (LABEL-LEFT LABEL) TOP (LABEL-TOP LABEL)
	RIGHT (LABEL-RIGHT LABEL) BOTTOM (LABEL-BOTTOM LABEL))
  (SETQ BOTTOM (- BOTTOM TOP))			;Really height
  (AND (MINUSP TOP) (SETQ TOP (+ HEIGHT TOP)))
  (PROG () (RETURN (IF (MINUSP LEFT) (+ WIDTH LEFT) LEFT) TOP
		   (IF (PLUSP RIGHT) RIGHT (+ WIDTH RIGHT)) (+ TOP BOTTOM)))))

;;;This designed to be a subroutine of :PARSE-LABEL-SPEC messages, it makes the label
;;;into a list, onto which other things can then be added.
(DECLARE-FLAVOR-INSTANCE-VARIABLES (ESSENTIAL-LABEL-MIXIN)
(DEFUN PARSE-LABEL-SPEC (SPEC LM TM RM BM &OPTIONAL (HEIGHT NIL HEIGHT-P) TOP-P)
  (OR HEIGHT (SETQ HEIGHT (FONT-CHAR-HEIGHT (SCREEN-DEFAULT-FONT (SHEET-GET-SCREEN SELF)))))
  (COND (SPEC
	 (SETQ TOP-P (COND ((MEMQ SPEC '(:TOP :BOTTOM))
			    (EQ SPEC ':TOP))
			   ((AND (LISTP SPEC) (LABEL-TOP SPEC))
			    (NOT (MINUSP (LABEL-TOP SPEC))))
			   (T
			    TOP-P)))
	 (SETQ SPEC (IF (LISTP SPEC) (APPEND SPEC NIL) (MAKE-LIST NIL 4)))
	 (LET ((BOTTOM (LABEL-BOTTOM SPEC)) (TOP (LABEL-TOP SPEC)))
	   (AND BOTTOM TOP (NOT HEIGHT-P) (SETQ HEIGHT (- BOTTOM TOP))))
	 (SETF (LABEL-LEFT SPEC) LM)
	 (SETF (LABEL-RIGHT SPEC) (- RM))
	 (LET ((TOP (IF TOP-P TM (- (+ BM HEIGHT)))))
	   (SETF (LABEL-TOP SPEC) TOP)
	   (SETF (LABEL-BOTTOM SPEC) (+ TOP HEIGHT)))
	 (IF TOP-P (SETQ TM (LABEL-BOTTOM SPEC)) (SETQ BM (- (LABEL-TOP SPEC))))))
  (PROG () (RETURN SPEC LM TM RM BM))))

(DEFSTRUCT (LABEL-MIXIN :LIST (:INCLUDE ESSENTIAL-LABEL-MIXIN) (:CONSTRUCTOR NIL)
			(:SIZE-SYMBOL LABEL-DEFSTRUCT-SIZE))
  LABEL-FONT
  LABEL-STRING)

(DEFFLAVOR LABEL-MIXIN () (ESSENTIAL-LABEL-MIXIN)
  (:DOCUMENTATION :MIXIN "Normal LABEL handling.
This is the usual type of label a window will want, it provides for an arbitrary string
in an arbitrary font."))

(DEFMETHOD (LABEL-MIXIN :AFTER :INIT) (IGNORE)
  (AND LABEL (OR (LABEL-STRING LABEL) (SETF (LABEL-STRING LABEL) NAME))))

(DEFMETHOD (LABEL-MIXIN :PARSE-LABEL-SPEC) (SPEC LM TM RM BM &OPTIONAL TOP-P &AUX FONT NSPEC)
  (COND (SPEC
	 (AND (LISTP SPEC) (MEMQ (CAR SPEC) '(:STRING :FONT :TOP :BOTTOM))
	      (DO ((LIST SPEC (CDR LIST))
		   (STRING NIL))
		  ((NULL LIST)
		   (SETQ SPEC (LIST NIL NIL NIL NIL FONT STRING)))
		(SELECTQ (CAR LIST)
		  (:STRING (SETQ STRING (CADR LIST)
				 LIST (CDR LIST)))
		  (:FONT (SETQ FONT (CADR LIST)
			       LIST (CDR LIST)))
		  (:TOP (SETQ TOP-P T))
		  (:BOTTOM (SETQ TOP-P NIL))
		  (OTHERWISE (FERROR NIL "~S is not a recognized keyword" (CAR LIST))))))
	 (SETQ FONT (OR (AND (EQ (TYPEP SPEC) 'FONT) (PROG1 SPEC (SETQ SPEC T)))
			(AND (LISTP SPEC) (LABEL-FONT SPEC))
			(SCREEN-DEFAULT-FONT (SHEET-GET-SCREEN SELF))))
	 (SETQ FONT (FUNCALL (SHEET-GET-SCREEN SELF) ':PARSE-FONT-DESCRIPTOR FONT))
	 (AND (LISTP SPEC) (LABEL-TOP SPEC) (SETQ TOP-P (NOT (MINUSP (LABEL-TOP SPEC)))))
	 (MULTIPLE-VALUE (NSPEC LM TM RM BM)
	   (PARSE-LABEL-SPEC SPEC LM TM RM BM (FONT-CHAR-HEIGHT FONT) TOP-P))
	 (LET ((TEM (- LABEL-DEFSTRUCT-SIZE (LENGTH NSPEC))))
	   (AND (> TEM 0) (RPLACD (LAST NSPEC) (MAKE-LIST NIL TEM))))
	 (SETF (LABEL-FONT NSPEC) FONT)
	 (OR (LABEL-STRING NSPEC)
	     (SETF (LABEL-STRING NSPEC) (COND ((STRINGP SPEC) SPEC)
					      ((AND (LISTP SPEC) (LABEL-STRING SPEC))
					       (LABEL-STRING SPEC))
					      ((NEQ SPEC T) (STRING SPEC))
					      (T NAME))))
	 (SETQ SPEC NSPEC)))
  (PROG () (RETURN SPEC LM TM RM BM)))

(DEFMETHOD (LABEL-MIXIN :DRAW-LABEL) (SPEC LEFT TOP RIGHT BOTTOM)
  BOTTOM
  (AND SPEC
       (SHEET-STRING-OUT-EXPLICIT SELF (LABEL-STRING SPEC) LEFT TOP RIGHT
				  (LABEL-FONT SPEC) CHAR-ALUF)))

(DEFMETHOD (LABEL-MIXIN :LABEL-SIZE) ()
  (PROG ()
    (IF LABEL (RETURN (SHEET-STRING-LENGTH SELF (LABEL-STRING LABEL) 0 NIL NIL
					   (LABEL-FONT LABEL))
		      (- (LABEL-BOTTOM LABEL) (LABEL-TOP LABEL)))
	      (RETURN 0 0))))

(DEFMETHOD (LABEL-MIXIN :AFTER :CHANGE-OF-DEFAULT-FONT) (OLD-FONT NEW-FONT)
  (COND ((AND LABEL (EQ (LABEL-FONT LABEL) OLD-FONT))
	 (SETF (LABEL-FONT LABEL) NEW-FONT)
	 (FUNCALL-SELF ':SET-LABEL LABEL))))

(DEFFLAVOR DELAYED-REDISPLAY-LABEL-MIXIN ((LABEL-NEEDS-UPDATING NIL)) ()
  (:INCLUDED-FLAVORS LABEL-MIXIN)
  (:OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES LABEL-NEEDS-UPDATING)
  (:DOCUMENTATION :MIXIN "Delays the setting of the label until a normal redisplay loop.
Send a :DELAYED-SET-LABEL to cause the label to be changed when a :UPDATE-LABEL message
is sent.  This is especially useful for things with suppressed redisplay for typeahead,
where the user's typein may change the label several times, and where the label wants to
change along with the rest of the window."))

(DEFMETHOD (DELAYED-REDISPLAY-LABEL-MIXIN :DELAYED-SET-LABEL) (NEW-LABEL)
  (SETQ LABEL-NEEDS-UPDATING NEW-LABEL))

(DEFMETHOD (DELAYED-REDISPLAY-LABEL-MIXIN :UPDATE-LABEL) ()
  (COND (LABEL-NEEDS-UPDATING
	 (FUNCALL-SELF ':SET-LABEL LABEL-NEEDS-UPDATING)
	 (SETQ LABEL-NEEDS-UPDATING NIL))))

(DEFFLAVOR TOP-LABEL-MIXIN () (LABEL-MIXIN)
  (:DOCUMENTATION :MIXIN "Label positioned at the top
If the label is specified only as a string or defaults to the name of the window, it
will be at the top of the window."))

(DEFMETHOD (TOP-LABEL-MIXIN :PARSE-LABEL-SPEC) (SPEC LM TM RM BM)
  (FUNCALL #'(:METHOD LABEL-MIXIN :PARSE-LABEL-SPEC) ':PARSE-LABEL-SPEC SPEC LM TM RM BM T))

(DEFFLAVOR TOP-BOX-LABEL-MIXIN () (LABEL-MIXIN)
  (:DOCUMENTATION :MIXIN "Label at the top, with a line underneath
If the label is a string or defaults to the name, it is at the top.
When combined with BORDERS-MIXIN, the label will be surrounded by a box."))

(DEFMETHOD (TOP-BOX-LABEL-MIXIN :PARSE-LABEL-SPEC) (SPEC LM TM RM BM)
  (MULTIPLE-VALUE (SPEC LM TM RM BM)
    (FUNCALL #'(:METHOD LABEL-MIXIN :PARSE-LABEL-SPEC) ':PARSE-LABEL-SPEC
	     SPEC LM TM RM BM T))
  (AND SPEC (SETQ TM (1+ TM)))
  (PROG () (RETURN SPEC LM TM RM BM)))

(DEFMETHOD (TOP-BOX-LABEL-MIXIN :AFTER :DRAW-LABEL) (SPEC LEFT TOP RIGHT BOTTOM)
  SPEC TOP
  (SHEET-FORCE-ACCESS (SELF)
    (%DRAW-RECTANGLE (- RIGHT LEFT) 1 LEFT (1- BOTTOM) CHAR-ALUF SELF)))

(DEFFLAVOR BOTTOM-BOX-LABEL-MIXIN () (LABEL-MIXIN)
  (:DOCUMENTATION :MIXIN "Label at the bottom, with a line above.
If the label is a string or defaults to the name, it is at the bottom.
When combined with BORDERS-MIXIN, the label will be surrounded by a box."))

(DEFMETHOD (BOTTOM-BOX-LABEL-MIXIN :PARSE-LABEL-SPEC) (SPEC LM TM RM BM)
  (MULTIPLE-VALUE (SPEC LM TM RM BM)
    (FUNCALL #'(:METHOD LABEL-MIXIN :PARSE-LABEL-SPEC) ':PARSE-LABEL-SPEC SPEC LM TM RM BM))
  (AND SPEC (SETQ BM (+ 2 BM)))
  (PROG () (RETURN SPEC LM TM RM BM)))

(DEFMETHOD (BOTTOM-BOX-LABEL-MIXIN :AFTER :DRAW-LABEL) (SPEC LEFT TOP RIGHT BOTTOM)
  SPEC BOTTOM
  (SHEET-FORCE-ACCESS (SELF)
    (%DRAW-RECTANGLE (- RIGHT LEFT) 1 LEFT (1- TOP) CHAR-ALUF SELF)))

;;; Flavor that allows you to change the name of the window, and 
;;; if the label is the same as the name, changes the label, too.
(DEFFLAVOR CHANGEABLE-NAME-MIXIN () ()
  (:INCLUDED-FLAVORS LABEL-MIXIN)
  (:DOCUMENTATION :MIXIN "Allows setting of name via :SET-NAME
Also changes the label if it happens to be the same."))

(DEFMETHOD (CHANGEABLE-NAME-MIXIN :NAME) () NAME)

(DEFMETHOD (CHANGEABLE-NAME-MIXIN :SET-NAME) (NEW-NAME)
  (LET ((LABEL-EQUALS-NAME (AND LABEL (EQ (LABEL-STRING LABEL) NAME))))
    (SETQ NAME NEW-NAME)
    (COND (LABEL-EQUALS-NAME
	   (SETF (LABEL-STRING LABEL) NEW-NAME)
	   (SHEET-FORCE-ACCESS (SELF T)
	     (ERASE-LABEL)
	     (DRAW-LABEL))))))

(DEFUN LOWEST-SHEET-UNDER-POINT (SHEET X Y &OPTIONAL OPERATION (ACTIVE-CONDITION ':ACTIVE))
  "Return the sheet lowest in the sheet hierarchy which contains the given point."
  ;; Trace down to find the lowest sheet under the point
  (DO-NAMED FOO
      ((X X (- X (SHEET-X SHEET)))
       (Y Y (- Y (SHEET-Y SHEET))))
      (NIL)
    (DO ((INFERIORS (IF (EQ ACTIVE-CONDITION ':EXPOSED) (SHEET-EXPOSED-INFERIORS SHEET)
							(SHEET-INFERIORS SHEET))
		    (CDR INFERIORS))
	 (INFERIOR))
	((NULL INFERIORS)
	 (RETURN-FROM FOO))
      (SETQ INFERIOR (CAR INFERIORS))
      (COND ((AND (NOT (SHEET-INVISIBLE-TO-MOUSE-P INFERIOR))
		  ( X (SHEET-X INFERIOR)) ( Y (SHEET-Y INFERIOR))
		  (< X (+ (SHEET-X INFERIOR) (SHEET-WIDTH INFERIOR)))
		  (< Y (+ (SHEET-Y INFERIOR) (SHEET-HEIGHT INFERIOR)))
		  (SELECTQ ACTIVE-CONDITION
		    (:ACTIVE (OR (SHEET-EXPOSED-P INFERIOR)
				 (FUNCALL INFERIOR ':SCREEN-MANAGE-DEEXPOSED-VISIBILITY)))
		    (:EXPOSED (NOT (SHEET-OUTPUT-HELD-P INFERIOR)))
		    (OTHERWISE T)))
	     (SETQ SHEET INFERIOR)
	     (RETURN T)))))
  (IF (NULL OPERATION) SHEET
      ;; Now trace back up until we find someone to handle the message
      (DO SHEET SHEET (SHEET-SUPERIOR SHEET) (NULL SHEET)
	(AND (GET-HANDLER-FOR SHEET OPERATION)
	     (RETURN SHEET)))))

(DEFUN IDLE-LISP-LISTENER (&OPTIONAL (SUPERIOR DEFAULT-SCREEN)
			   &AUX LL (FULL-SCREEN (MULTIPLE-VALUE-LIST
						  (FUNCALL SUPERIOR ':INSIDE-SIZE))))
  "Find a Lisp Listener that's not in use, and is the full size of the specified
superior.   Creates one if none is available."
  (SETQ LL (DOLIST (I (SHEET-INFERIORS SUPERIOR))
	     (AND (EQ (FUNCALL I ':LISP-LISTENER-P) ':IDLE)
		  (EQUAL FULL-SCREEN (MULTIPLE-VALUE-LIST (FUNCALL I ':SIZE)))
		  (RETURN I))))
  (OR LL (MAKE-WINDOW 'LISP-LISTENER ':SUPERIOR SUPERIOR)))

(DEFFLAVOR TEMPORARY-WINDOW-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :LOWLEVEL-MIXIN "Windows that save bits underneath and lock when exposed
Causes the temporary-bit-array instance variable to get set, which makes sheet exposure
behave appropriately."))

(DEFMETHOD (TEMPORARY-WINDOW-MIXIN :AFTER :INIT) (IGNORE)
  (OR (AND (BOUNDP 'TEMPORARY-BIT-ARRAY) TEMPORARY-BIT-ARRAY)
      ;; T means will get created when needed
      (SETQ TEMPORARY-BIT-ARRAY T)))

(DEFUN WINDOW-PUSH (WINDOW NEW-TYPE &REST INIT-PAIRS
			            &AUX NEW-WINDOW INIT-PLIST STATUS)
  (SETQ INIT-PAIRS (COPYLIST INIT-PAIRS))	;There should be a comment here saying why
  (SETQ INIT-PLIST (LOCF INIT-PAIRS))
  (LOCK-SHEET (WINDOW)
    (SETQ STATUS (FUNCALL WINDOW ':STATUS))
    ;; Window we are "pushing" gets deactivated
    (DELAYING-SCREEN-MANAGEMENT
      (PUTPROP INIT-PLIST (SHEET-SUPERIOR WINDOW) ':SUPERIOR)
      (PUTPROP INIT-PLIST (SHEET-X-OFFSET WINDOW) ':LEFT)
      (PUTPROP INIT-PLIST (SHEET-Y-OFFSET WINDOW) ':TOP)
      (PUTPROP INIT-PLIST (SHEET-HEIGHT WINDOW) ':HEIGHT)
      (PUTPROP INIT-PLIST (SHEET-WIDTH WINDOW) ':WIDTH)
      (AND (SI:FLAVOR-ALLOWS-INIT-KEYWORD-P NEW-TYPE ':PROCESS)
	   (GET-HANDLER-FOR WINDOW ':PROCESS)
	   (PUTPROP INIT-PLIST (FUNCALL WINDOW ':PROCESS) ':PROCESS))
      (SETQ NEW-WINDOW (LEXPR-FUNCALL #'MAKE-WINDOW NEW-TYPE (CAR INIT-PLIST)))
      (CHANGE-IN-PREVIOUSLY-SELECTED-WINDOWS WINDOW NEW-WINDOW)
      (FUNCALL WINDOW ':DEACTIVATE)
      (SCREEN-CONFIGURATION-HAS-CHANGED WINDOW)
      (FUNCALL NEW-WINDOW ':SET-STATUS STATUS)	;Activate, expose, or select
      (SCREEN-CONFIGURATION-HAS-CHANGED NEW-WINDOW))
    NEW-WINDOW))

(DEFUN WINDOW-POP (OLD-WINDOW WINDOW)
  (LOCK-SHEET (WINDOW)
    (DELAYING-SCREEN-MANAGEMENT
      ;; Put back most of the sheet
      (LET ((STATUS (FUNCALL WINDOW ':STATUS))
	    (SUPERIOR (SHEET-SUPERIOR WINDOW))
	    (X (SHEET-X-OFFSET WINDOW))
	    (Y (SHEET-Y-OFFSET WINDOW))
	    (W (SHEET-WIDTH WINDOW))
	    (H (SHEET-HEIGHT WINDOW)))
	(CHANGE-IN-PREVIOUSLY-SELECTED-WINDOWS WINDOW OLD-WINDOW)
	(FUNCALL WINDOW ':DEACTIVATE)
	(FUNCALL OLD-WINDOW ':SET-SUPERIOR SUPERIOR)
	(COND ((AND (FUNCALL OLD-WINDOW ':SET-SIZE W H ':VERIFY)
		    (SHEET-BOUNDS-WITHIN-SHEET-P X Y W H SUPERIOR))
	       ;; Legal to set new edges, do it
	       (FUNCALL OLD-WINDOW ':SET-POSITION X Y)
	       (FUNCALL OLD-WINDOW ':SET-SIZE W H)))
	(FUNCALL OLD-WINDOW ':SET-STATUS STATUS)))))

(DEFFLAVOR FULL-SCREEN-HACK-MIXIN ((OLD-BORDERS NIL) (OLD-LABEL NIL)) ()
  (:INCLUDED-FLAVORS LABEL-MIXIN BORDERS-MIXIN)
  (:DOCUMENTATION :MIXIN "Has borders and labels only when not the full size of the screen
For windows like the initial lisp listener which frequently occupy the whole screen and
are immediately recognizable."))

;;;This unfortunately has to redefine the sheet, since the width and height are not known
;;;at (:BEFORE :INIT) time.
(DEFMETHOD (FULL-SCREEN-HACK-MIXIN :AFTER :INIT) (IGNORE)
  (FULL-SCREEN-HACK X-OFFSET Y-OFFSET WIDTH HEIGHT))

(DEFMETHOD (FULL-SCREEN-HACK-MIXIN :BEFORE :CHANGE-OF-SIZE-OR-MARGINS) (&REST OPTIONS
								  &AUX (PLIST (LOCF OPTIONS)))
  (SHEET-FORCE-ACCESS (SELF)
    (ERASE-MARGINS))				;Insure that old margins get erased
  (AND (GET PLIST ':LEFT)
       (FULL-SCREEN-HACK (GET PLIST ':LEFT) (GET PLIST ':TOP) (GET PLIST ':WIDTH)
			 (GET PLIST ':HEIGHT))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (FULL-SCREEN-HACK-MIXIN)
(DEFUN FULL-SCREEN-HACK (LEFT TOP WID HEI)
  (COND ((AND (= LEFT (SHEET-INSIDE-LEFT SUPERIOR))
	      (= TOP (SHEET-INSIDE-TOP SUPERIOR))
	      (= WID (SHEET-INSIDE-WIDTH SUPERIOR))
	      (= HEI (SHEET-INSIDE-HEIGHT SUPERIOR)))
	 (COND ((AND LABEL (NULL OLD-LABEL))
		(SETQ OLD-LABEL LABEL)
		(FUNCALL-SELF ':SET-LABEL NIL)))
	 (COND ((AND BORDERS (NULL OLD-BORDERS))
		(SETQ OLD-BORDERS BORDERS)
		(FUNCALL-SELF ':SET-BORDERS NIL))))
	(T
	 (COND ((AND OLD-BORDERS (NULL BORDERS))
		(FUNCALL-SELF ':SET-BORDERS OLD-BORDERS)
		(SETQ OLD-BORDERS NIL)))
	 (COND ((AND OLD-LABEL (NULL LABEL))
		(FUNCALL-SELF ':SET-LABEL OLD-LABEL)
		(SETQ OLD-LABEL NIL)))))))

(DEFFLAVOR PROCESS-MIXIN ((PROCESS NIL)) ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:GETTABLE-INSTANCE-VARIABLES PROCESS)
  (:INITABLE-INSTANCE-VARIABLES PROCESS)
  (:DOCUMENTATION :MIXIN "For windows with a particular process associated with them
The process can be specified as a list of the function and arguments to make-stack-group.
When the window is selected, the who line is updated for the state of the process.
When the window is exposed or selected, if the process is flushed, it gets reset and
can run again.  The process gets a RUN-REASON of the window itself, but doesn't get
it until the window is first exposed or selected.  It is mostly
ok for the PROCESS to be NIL even when this flavor is included."))

;;; This is explicit to ensure shadowing
(DEFMETHOD (PROCESS-MIXIN :PROCESS) () PROCESS)

(DEFMETHOD (PROCESS-MIXIN :AFTER :INIT) (IGNORE)
  (AND (LISTP PROCESS)
       (LET ((PRESET PROCESS))
	 (SETQ PROCESS (LEXPR-FUNCALL #'MAKE-PROCESS NAME (CDR PRESET)))
	 (PROCESS-PRESET PROCESS (CAR PRESET) SELF))))

;;; *** This is a horrible crock.  If the "program system" is ever implemented,
;;; *** this should be flushed and replaced by the concept that selecting a program
;;; *** does something appropriate to its processes.
;;; I dont know if this is really the right thing
(DEFMETHOD (PROCESS-MIXIN :BEFORE :EXPOSE) MAYBE-RESET-PROCESS)
(DEFMETHOD (PROCESS-MIXIN :BEFORE :SELECT) MAYBE-RESET-PROCESS)
(DECLARE-FLAVOR-INSTANCE-VARIABLES (PROCESS-MIXIN)
(DEFUN MAYBE-RESET-PROCESS (MESSAGE &REST IGNORE)
  (COND ((OR (EQ MESSAGE ':SELECT)
	     (LOOP FOR SUP = SUPERIOR THEN (SHEET-SUPERIOR SUP) UNTIL (NULL SUP)
		   ALWAYS (SHEET-EXPOSED-P SUP)))
	 ;; Only touch the process if the window is going to become visible.  This
	 ;; makes many of the processes in the initial cold-load not have run reasons
	 ;; until you first select their window.  This makes booting faster (pages less).
	 ;; Also this is necessary to make the editor work:
	 ;; What was happening was that when the editor created its first
	 ;; pane and exposed it within its deactivated frame, the editor's process was
	 ;; being prematurely started up when it didn't even have all its instance
	 ;; variables yet, never mind enough editor environment set up.  The editor
	 ;; process would thus immediately get an error, which would later be reset
	 ;; asynchronously, leaving a second-level error handler around forever.
	 (COND ((TYPEP PROCESS 'SI:PROCESS)
		;; If we really have a process (not just NIL or something),
		;; Reset the process if it is flushed, then make sure it has a run reason.
		(IF (EQ (PROCESS-WAIT-FUNCTION PROCESS) #'FALSE)
		    (FUNCALL PROCESS ':RESET))
		(FUNCALL PROCESS ':RUN-REASON SELF)))))))

;Don't kill the process until all methods
;and wrappers have run first.  This is because we might be
;executing inside the process that belongs to the window,
;and we don't want to go away before finishing.
(DEFWRAPPER (PROCESS-MIXIN :KILL) (() . BODY)
  `(PROGN ,@BODY
	  (AND PROCESS
	       (FUNCALL PROCESS ':KILL))))

(DEFFLAVOR LISTENER-MIXIN-INTERNAL () (PROCESS-MIXIN)
  (:DOCUMENTATION :SPECIAL-PURPOSE "An actual LISP window
Includes a process that will run the lisp top level read-eval-print loop.
Use this rather than LISTENER-MIXIN when you want to be invisible to the SYSTEM L key."))

(DEFMETHOD (LISTENER-MIXIN-INTERNAL :BEFORE :INIT) (IGNORE)
  (OR PROCESS (SETQ PROCESS '(SI:LISP-TOP-LEVEL1 :REGULAR-PDL-SIZE 40000
						 :SPECIAL-PDL-SIZE 4000))))

(DEFFLAVOR LISTENER-MIXIN () (LISTENER-MIXIN-INTERNAL)
  (:DOCUMENTATION :SPECIAL-PURPOSE "An actual LISP window
Includes a process that will run the lisp top level read-eval-print loop.
Use this when you want to be visible to the SYSTEM L key."))


(DEFFLAVOR LISP-INTERACTOR () (NOTIFICATION-MIXIN LISTENER-MIXIN-INTERNAL WINDOW)
  (:DEFAULT-INIT-PLIST :SAVE-BITS T)
  (:DOCUMENTATION :COMBINATION "LISP window, but not LISP-LISTENER-P"))


(DEFFLAVOR LISP-LISTENER () (NOTIFICATION-MIXIN LISTENER-MIXIN FULL-SCREEN-HACK-MIXIN WINDOW)
  (:DEFAULT-INIT-PLIST :SAVE-BITS T)
  (:DOCUMENTATION :COMBINATION "Normal LISP window"))

(DEFMETHOD (LISP-LISTENER :LISP-LISTENER-P) ()
  (IF (SYMEVAL-IN-STACK-GROUP 'SI:LISP-TOP-LEVEL-INSIDE-EVAL (PROCESS-STACK-GROUP PROCESS))
      ':BUSY
      ':IDLE))

;;; There are occasions when a window gets automatically created.  Unfortunately,
;;; in this case it is not known what size the user wants the window to be.
;;; It is fairly inconvenient to change the size of the window by hand.
(DEFFLAVOR AUTOMATICALLY-CREATED-WINDOW-MIXIN ((HAVE-EDGES NIL)) ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :MIXIN
"arranges for a window to ask what size it should be when it gets selected for the first time
The new edges will be specified with the mouse the same way as Create in the system menu"))

(DEFMETHOD (AUTOMATICALLY-CREATED-WINDOW-MIXIN :BEFORE :SELECT) (&REST IGNORE)
  (OR HAVE-EDGES
      (LEXPR-FUNCALL-SELF ':SET-EDGES
			  (MULTIPLE-VALUE-LIST
			    (MOUSE-SPECIFY-RECTANGLE X-OFFSET Y-OFFSET
						     (+ X-OFFSET WIDTH) (+ Y-OFFSET HEIGHT)
						     SUPERIOR))))
  (SETQ HAVE-EDGES T))

(DEFFLAVOR AUTOMATICALLY-CREATED-LISP-LISTENER ()
  (AUTOMATICALLY-CREATED-WINDOW-MIXIN LISP-LISTENER)
  (:DOCUMENTATION :COMBINATION))

(DEFFLAVOR POP-UP-TEXT-WINDOW () (TEMPORARY-WINDOW-MIXIN WINDOW)
  (:DOCUMENTATION :COMBINATION "A simple temporary window for stream type output
Useful for things like [ESC] F or qsend, which just want a tv type stream that will not
disturb things underneath."))

(DEFFLAVOR TRUNCATING-POP-UP-TEXT-WINDOW () (TEMPORARY-WINDOW-MIXIN TRUNCATING-WINDOW)
  (:DOCUMENTATION :COMBINATION "A pop up window what truncates lines"))

(DEFFLAVOR RESET-ON-OUTPUT-HOLD-FLAG-MIXIN () ()
  (:DEFAULT-INIT-PLIST :DEEXPOSED-TYPEOUT-ACTION '(:RESET-ON-OUTPUT-HOLD-FLAG)))

(DEFMETHOD (RESET-ON-OUTPUT-HOLD-FLAG-MIXIN :RESET-ON-OUTPUT-HOLD-FLAG) ()
  (FUNCALL CURRENT-PROCESS ':RESET ':ALWAYS))

(DEFFLAVOR TRUNCATING-POP-UP-TEXT-WINDOW-WITH-RESET ()
	   (RESET-ON-OUTPUT-HOLD-FLAG-MIXIN TRUNCATING-POP-UP-TEXT-WINDOW))

;;; This mixin is useful for those windows that are created during the world-load.
;;; It is disconcerting when you suddenly see them appearing after you reshape
;;; some window.  This mixin causes them to be invisible and immune to autoexposure.
;;; They don't appear on the screen until you explicitly ask for them.  However, they
;;; are still active and appear on the Select menu.
(DEFFLAVOR INITIALLY-INVISIBLE-MIXIN () ()
  (:DEFAULT-INIT-PLIST :PRIORITY -2))

(DEFMETHOD (INITIALLY-INVISIBLE-MIXIN :BEFORE :EXPOSE) (&REST IGNORE)
  (FUNCALL-SELF ':SET-PRIORITY NIL))


;;; Some notification stuff

(DEFFLAVOR NOTIFICATION-MIXIN () ()
  (:REQUIRED-METHODS :PROCESS)
  (:INCLUDED-FLAVORS STREAM-MIXIN ESSENTIAL-WINDOW)
  (:DOCUMENTATION :MIXIN "Prints notifications on itself when selected.
A window which can easily accomodate unsolicited typeout, such as a Lisp listener,
uses this mixin to cause notifications to be printed on it when it is selected.
The user's attention is assumed to be at the cursor of the selected window.
This mixin also interacts with the rubout-handler of STREAM-MIXIN."))

;;; Note: this does not try to do anything smart with the prompt, because doing
;;; that right requires resolving some hairy issues which simply are not worth it.
(DEFMETHOD (NOTIFICATION-MIXIN :PRINT-NOTIFICATION) (TIME STRING WINDOW-OF-INTEREST)
  WINDOW-OF-INTEREST ;ignored
  (LET ((RUBOUT-X NIL) (RUBOUT-Y NIL)	;Cursorpos of start of current rubout-handler input
	PROCESS SG)
    (LOCK-SHEET (SELF)
      (WITHOUT-INTERRUPTS
	(AND (SETQ PROCESS (FUNCALL-SELF ':PROCESS))
	     (SETQ SG (FUNCALL PROCESS ':STACK-GROUP))
	     (SYMEVAL-IN-STACK-GROUP 'RUBOUT-HANDLER-INSIDE SG)
	     (SETQ RUBOUT-X (SYMEVAL-IN-STACK-GROUP 'RUBOUT-HANDLER-STARTING-X SG)
		   RUBOUT-Y (SYMEVAL-IN-STACK-GROUP 'RUBOUT-HANDLER-STARTING-Y SG))))
      ;; If the process is in the rubout-handler, back up over the echoed input and erase it.
      (COND (RUBOUT-X (FUNCALL-SELF ':SET-CURSORPOS RUBOUT-X RUBOUT-Y)
		      (FUNCALL-SELF ':CLEAR-EOL)))
      (FUNCALL-SELF ':FRESH-LINE)
      (FUNCALL-SELF ':BEEP)
      (FUNCALL-SELF ':TYO #/[)
      (TIME:PRINT-BRIEF-UNIVERSAL-TIME TIME SELF)
      (FUNCALL-SELF ':TYO #\SP)
      (FUNCALL-SELF ':STRING-OUT STRING)
      (FUNCALL-SELF ':TYO #/])
      (FUNCALL-SELF ':TYO #\CR)
      ;; Reprint rubout-handler buffer if necessary, and change the rubout-handler's
      ;; starting cursorpos
      (COND (RUBOUT-X (MULTIPLE-VALUE-BIND (X Y) (FUNCALL-SELF ':READ-CURSORPOS)
			(WITHOUT-INTERRUPTS
			  (EH:REBIND-IN-STACK-GROUP 'RUBOUT-HANDLER-STARTING-X X SG)
			  (EH:REBIND-IN-STACK-GROUP 'RUBOUT-HANDLER-STARTING-Y Y SG))
			(FUNCALL-SELF ':STRING-OUT RUBOUT-HANDLER-BUFFER)))))))

(DEFFLAVOR POP-UP-NOTIFICATION-MIXIN () ()
  (:INCLUDED-FLAVORS ESSENTIAL-WINDOW)
  (:DOCUMENTATION :MIXIN "Pops up a window for notifications.
This is the default sort of notify, it pops up a small window with the notify message
in it.  See the NOTIFICATION-MIXIN for an alternative behaviour."))

(DEFWINDOW-RESOURCE POP-UP-NOTIFICATION-WINDOW ()
	:MAKE-WINDOW (POP-UP-NOTIFICATION-WINDOW)
	:REUSABLE-WHEN :DEACTIVATED
	:INITIAL-COPIES 0)	;No initial copies, would bomb during system loading

(DEFMETHOD (POP-UP-NOTIFICATION-MIXIN :PRINT-NOTIFICATION) (TIME STRING WINDOW-OF-INTEREST)
  ;; Now we must spawn a process and return.  See comments in CAREFUL-NOTIFY.
  (PROCESS-RUN-FUNCTION "Notify"
    #'(LAMBDA (TIME STRING WINDOW-OF-INTEREST SLF START-TIME NOTE-WINDOW)
	(FUNCALL NOTE-WINDOW ':SET-WINDOW-OF-INTEREST WINDOW-OF-INTEREST)
		;Above sets up for mouse click.  Caller has already set up for Terminal-0-S
	(FUNCALL NOTE-WINDOW ':SET-LABEL (FORMAT NIL "Notification: ~A" SLF))
	(MULTIPLE-VALUE-BIND (X Y) (SHEET-CALCULATE-OFFSETS SLF (SHEET-SUPERIOR NOTE-WINDOW))
	  (FUNCALL NOTE-WINDOW ':CENTER-AROUND (+ X (// (SHEET-WIDTH SLF) 2))
					       (+ Y (// (SHEET-HEIGHT SLF) 2))))
	;If window gets deexposed while we're typing out, typically because
	;user types Terminal-0-S before we finish cranking out our message, punt.
	(*CATCH ':DEEXPOSE
	  (CONDITION-BIND ((OUTPUT-ON-DEEXPOSED-SHEET
			     #'(LAMBDA (&REST IGNORE) (*THROW  ':DEEXPOSE NIL))))
	    (LET ((OSW SELECTED-WINDOW))		;Almost certainly SLF
	      (FUNCALL NOTE-WINDOW ':SELECT)	;Exposes blank with homed cursor
	      (TIME:PRINT-BRIEF-UNIVERSAL-TIME TIME NOTE-WINDOW)
	      (FUNCALL NOTE-WINDOW ':TYO #\SP)
	      (FUNCALL NOTE-WINDOW ':STRING-OUT STRING)
	      (FUNCALL NOTE-WINDOW ':TYO #\CR)
	      (FINISH-UNEXPECTED-SELECT START-TIME OSW)) ;By now user has seen what's up
	    (FUNCALL NOTE-WINDOW ':CLEAR-INPUT)	;Flush typeahead before inviting typein
	    (IF WINDOW-OF-INTEREST
		(FORMAT NOTE-WINDOW
			"Select ~A by typing Terminal-0-S or by clicking the mouse here,~@
			 or type any character to get rid of this notification."
			WINDOW-OF-INTEREST)
		(FUNCALL NOTE-WINDOW ':STRING-OUT
			 "Type any character to get rid of this notification."))
	    (FUNCALL NOTE-WINDOW ':TYI)))
	(FUNCALL NOTE-WINDOW ':DEACTIVATE))
    TIME STRING WINDOW-OF-INTEREST SELF
    (START-UNEXPECTED-SELECT)
    (ALLOCATE-RESOURCE 'POP-UP-NOTIFICATION-WINDOW (SHEET-GET-SCREEN SELF))))

;;; These two functions are for unexpected pop-up selectable windows
;;; They give the user a chance to get his typing straightened out

(DEFVAR UNEXPECTED-SELECT-DELAY 180.)	;Give user 3 seconds to notice beep and stop typing

;Beep, return time to be passed back in to FINISH-UNEXPECTED-SELECT
(DEFUN START-UNEXPECTED-SELECT ()
  (BEEP)
  (TIME))

;Sleep until enough time has passed, then snarf typeahead into old-selected-window
;which is no longer selected-window because by now the new thing has been exposed
(DEFUN FINISH-UNEXPECTED-SELECT (START-TIME OLD-SELECTED-WINDOW &AUX BUF)
  (PROCESS-WAIT "Sleep" #'(LAMBDA (START-TIME) (> (TIME-DIFFERENCE (TIME) START-TIME)
						  UNEXPECTED-SELECT-DELAY))
			START-TIME)
  (WITHOUT-INTERRUPTS
    (AND OLD-SELECTED-WINDOW
	 (SETQ BUF (FUNCALL OLD-SELECTED-WINDOW ':IO-BUFFER))
	 (KBD-SNARF-INPUT BUF))))

(DEFFLAVOR POP-UP-NOTIFICATION-WINDOW
  ((WINDOW-OF-INTEREST NIL))
  (POP-UP-TEXT-WINDOW)
  (:SETTABLE-INSTANCE-VARIABLES WINDOW-OF-INTEREST)
  (:GETTABLE-INSTANCE-VARIABLES WINDOW-OF-INTEREST)
  (:DEFAULT-INIT-PLIST :SAVE-BITS NIL  ;Thus will not come up with old garbage contents
		       :CHARACTER-HEIGHT 5	;5 lines.  Width is full width of sup.
		       :DEEXPOSED-TYPEOUT-ACTION ':ERROR)
  (:DOCUMENTATION :SPECIAL-PURPOSE "Pops down and selects window of interest when clicked on
One of these is created when a notify message is sent to a normal window, it pops up, prints
the notification, and when it is selected with the mouse, pops back down and exposes the
window that got the error, which for background processes will be a slightly larger
pop-up type window."))

;;; When clicked on, always send a :MOUSE-SELECT message, even if already selected
;;; so that WINDOW-OF-INTEREST will get selected.
(DEFMETHOD (POP-UP-NOTIFICATION-WINDOW :MOUSE-CLICK) (BUTTON IGNORE IGNORE)
  (COND ((= BUTTON #\MOUSE-1-1)
	 (MOUSE-SELECT SELF)
	 T)))

(DEFMETHOD (POP-UP-NOTIFICATION-WINDOW :MOUSE-SELECT) (&REST ARGS)
  "If selected with the mouse, then deexpose us and really select the guy that we are
notifying about."
  (FUNCALL-SELF ':DEEXPOSE)			;This will also deactivate us
  (AND WINDOW-OF-INTEREST
       (LEXPR-FUNCALL WINDOW-OF-INTEREST ':MOUSE-SELECT ARGS)))

;This wakes up the process which is sitting around waiting for the user
;to type something to flush the notification window.  It will deactivate us.
(DEFMETHOD (POP-UP-NOTIFICATION-WINDOW :AFTER :DEEXPOSE) (&REST IGNORE)
  (FUNCALL-SELF ':FORCE-KBD-INPUT ':DEEXPOSE))

;While a notification window is up, additional notifications are printed on it.
;I guess I don't need to reprint the self-documentation.
(DEFMETHOD (POP-UP-NOTIFICATION-WINDOW :PRINT-NOTIFICATION) (TIME STRING WINDOW-OF-INTEREST)
  WINDOW-OF-INTEREST ;ignored
  (FUNCALL-SELF ':FRESH-LINE)
  (FUNCALL-SELF ':BEEP)
  (TIME:PRINT-BRIEF-UNIVERSAL-TIME TIME SELF)
  (FUNCALL-SELF ':TYO #\SP)
  (FUNCALL-SELF ':STRING-OUT STRING)
  (FUNCALL-SELF ':TYO #\CR))

;;; Resource to supply reasonably sized bit arrays.  This is especially useful
;;; for window-bind type windows that don't want to go through the overhead of
;;; creating a new bit array every time they get invoked
(DEFRESOURCE BIT-ARRAYS (&OPTIONAL (WIDTH (SHEET-WIDTH DEFAULT-SCREEN))
				   (HEIGHT (SHEET-HEIGHT DEFAULT-SCREEN)))
  :CONSTRUCTOR (MAKE-ARRAY (LIST WIDTH HEIGHT) ':TYPE 'ART-1B)
  :INITIAL-COPIES 0)

(DEFUN AWAIT-WINDOW-EXPOSURE ()
  "To be called by functions like ED.
   If you want to await the re-exposure of the Lisp listener after activating
   some other window, call this.  Usually it does nothing, but if the TERMINAL-IO
   window is an auto-exposing window, if you didn't call this you would get into
   a loop where two windows were fighting for exposure, each de-exposing the other.
   If that would happen this function causes a wait until TERMINAL-IO is exposed."
  (AND (TYPEP TERMINAL-IO 'SHEET)
       (NEQ (SHEET-DEEXPOSED-TYPEOUT-ACTION TERMINAL-IO) ':NORMAL)
       (PROCESS-WAIT "Await exposure" #'CAR (LOCF (SHEET-EXPOSED-P TERMINAL-IO))))
  T)