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

(DEFUNP MOUSE-SET-SHEET-THEN-CALL (SHEET FUNCTION &REST ARGS
				   &AUX (OLD-MOUSE-SHEET MOUSE-SHEET))
  (UNWIND-PROTECT
    (PROGN
      (AND (NEQ MOUSE-SHEET SHEET)
	   (MOUSE-SET-SHEET SHEET))
      (APPLY FUNCTION ARGS))
    (AND (NEQ MOUSE-SHEET OLD-MOUSE-SHEET)
	 (MOUSE-SET-SHEET OLD-MOUSE-SHEET))))

(DEFUN MOUSE-SPECIFY-RECTANGLE-SET-SHEET (&OPTIONAL LEFT TOP RIGHT BOTTOM (SHEET MOUSE-SHEET)
					            (MINIMUM-WIDTH 0) (MINIMUM-HEIGHT 0)
						    ABORTABLE)
  (MOUSE-SET-SHEET-THEN-CALL SHEET #'MOUSE-SPECIFY-RECTANGLE LEFT TOP RIGHT BOTTOM SHEET
			     MINIMUM-WIDTH MINIMUM-HEIGHT ABORTABLE))

(DEFUN MOUSE-SPECIFY-RECTANGLE (&OPTIONAL LEFT TOP RIGHT BOTTOM (SHEET MOUSE-SHEET)
					  (MINIMUM-WIDTH 0) (MINIMUM-HEIGHT 0) ABORTABLE
				&AUX LEFT1 TOP1 WIDTH HEIGHT BUTTON ABORT)
"Call this and get back a rectangle as four values: left, top, right, bottom.
The user uses the mouse to specify the rectangle.  The left button puts
a corner down, the right button puts it down at the nearest 'good' place,
the middle button aborts if that is possible.
Specifying a rectangle of zero or negative size instead gives the full screen.
Our arguments are where to start the corners out:
The upper left corner goes at LEFT and TOP, or where the mouse is if they are NIL;
the lower right corner goes near the other one by default, unless all
four args are present, in which case it starts off so as to make a rectangle
congruent to the one specified by the arguments.
If ABORTABLE is T, this can return NIL.
SHEET specifies the area within which we are allowed to act."
  (AND (EQ CURRENT-PROCESS MOUSE-PROCESS)
       (FERROR NIL "MOUSE-SPECIFY-RECTANGLE cannot be called in the mouse process"))
  (OR (SHEET-ME-OR-MY-KID-P SHEET MOUSE-SHEET)
      (FERROR NIL
	"MOUSE-SPECIFY-RECTANGLE attempted on ~S which is not inferior of MOUSE-SHEET"
	SHEET))
  (WITH-MOUSE-GRABBED
    (DO () (NIL)
      (MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 0 0 ':ON
				    ':SET-CHARACTER 21)
      (MOUSE-WARP (OR LEFT MOUSE-X) (OR TOP MOUSE-Y))
      (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION
	    (IF ABORTABLE
		"Select upper left corner of rectangle.  Middle aborts.  Right is smart."
		"Select upper left corner of rectangle.  Right is smart."))
      ;; In case this was called in response to a mouse click, wait for
      ;; the buttons to be released.
      (PROCESS-WAIT "Release Button" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
      (PROCESS-WAIT "Button" #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
      (SETQ BUTTON MOUSE-LAST-BUTTONS)
      (PROCESS-WAIT "Release Button" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
      ;; The first click determines the upper left corner.
      (AND ABORTABLE (BIT-TEST 2 BUTTON) (RETURN (SETQ ABORT T)))
      (MULTIPLE-VALUE (LEFT1 TOP1)
	(MOUSE-SPECIFIED-POINT SHEET MOUSE-X MOUSE-Y (BIT-TEST 4 BUTTON) NIL))
      ;; Set up the mouse for finding the lower right corner.
      (MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 12. 12. ':ON
				    ':SET-CHARACTER 22)
      (COND ((AND LEFT TOP RIGHT BOTTOM)
	     (MOUSE-WARP (+ LEFT1 (- RIGHT LEFT)) (+ TOP1 (- BOTTOM TOP))))
	    (T (MOUSE-WARP (+ MOUSE-X 20.) (+ MOUSE-Y 20.))))
      (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION
	    (IF ABORTABLE
		"Select lower right corner of rectangle.  Middle aborts.  Right is smart."
		"Select lower right corner of rectangle.  Right is smart."))
      ;; Leave the auxiliary blinker behind to continue to show the first corner.
      (LET ((MOUSE-RECTANGLE-BLINKER (MOUSE-GET-BLINKER ':RECTANGLE-BLINKER)))
	(UNWIND-PROTECT
	  (PROGN
	    (BLINKER-SET-CURSORPOS MOUSE-RECTANGLE-BLINKER LEFT1 TOP1)
	    (BLINKER-SET-VISIBILITY MOUSE-RECTANGLE-BLINKER T)
	    ;; The next click fixes the lower right corner.
	    (PROCESS-WAIT "Button" #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
	    (SETQ BUTTON MOUSE-LAST-BUTTONS))
	  (BLINKER-SET-VISIBILITY MOUSE-RECTANGLE-BLINKER NIL)))
      (MOUSE-STANDARD-BLINKER)
      (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION NIL)
      (AND ABORTABLE (BIT-TEST 2 BUTTON) (RETURN (SETQ ABORT T)))
      (MULTIPLE-VALUE-BIND (X Y)
	  (MOUSE-SPECIFIED-POINT SHEET (1+ MOUSE-X) (1+ MOUSE-Y) (BIT-TEST 4 BUTTON) T)
	(SETQ WIDTH (- X LEFT1)
	      HEIGHT (- Y TOP1)))
      (COND ((AND (PLUSP WIDTH) (PLUSP HEIGHT))
	     (MULTIPLE-VALUE-BIND (XOFF YOFF)
		 (SHEET-CALCULATE-OFFSETS SHEET MOUSE-SHEET)
	       (SETQ LEFT1 (- LEFT1 XOFF)
		     TOP1 (- TOP1 YOFF)))
	     (IF (OR (< WIDTH MINIMUM-WIDTH) (< HEIGHT MINIMUM-HEIGHT)
		     (MINUSP LEFT1) (MINUSP TOP1)
		     (> (+ LEFT1 WIDTH) (SHEET-WIDTH SHEET))
		     (> (+ TOP1 HEIGHT) (SHEET-HEIGHT SHEET)))
		 (BEEP)
		 (RETURN NIL)))
	    (T (SETQ LEFT1 (SHEET-INSIDE-LEFT SHEET)
		     TOP1 (SHEET-INSIDE-TOP SHEET)
		     WIDTH (SHEET-INSIDE-WIDTH SHEET)
		     HEIGHT (SHEET-INSIDE-HEIGHT SHEET))
	       (RETURN NIL)))))
  (PROG () (OR ABORT (RETURN LEFT1 TOP1 (+ LEFT1 WIDTH) (+ TOP1 HEIGHT)))))

(DEFUN MOUSE-SPECIFIED-POINT (SHEET X Y MAGICP LOWER-RIGHT)
  (DECLARE (SPECIAL X1 X2 Y1 Y2 Z MULT))
  (AND MAGICP
       (LET ((X1 X) (Y1 Y) (X2 X) (Y2 Y) (Z SHEET) (MULT (IF LOWER-RIGHT 1 -1)))
	 (MAP-OVER-EXPOSED-SHEET
	   #'(LAMBDA (SH)
	       (MULTIPLE-VALUE-BIND (XO YO) (SHEET-CALCULATE-OFFSETS SH Z)
		 (LET ((X3 XO) (X4 (+ XO (SHEET-WIDTH SH)))
		       (Y3 YO) (Y4 (+ YO (SHEET-HEIGHT SH))))
		   (AND (SUITABLY-CLOSE (* (- X3 X1) MULT)) (SETQ X2 X3))
		   (AND (SUITABLY-CLOSE (* (- X4 X1) MULT)) (SETQ X2 X4))
		   (AND (SUITABLY-CLOSE (* (- Y3 Y1) MULT)) (SETQ Y2 Y3))
		   (AND (SUITABLY-CLOSE (* (- Y4 Y1) MULT)) (SETQ Y2 Y4)))))
	   SHEET)
	 (SETQ X (MIN (MAX X2 (SHEET-INSIDE-LEFT SHEET)) (SHEET-INSIDE-RIGHT SHEET))
	       Y (MIN (MAX Y2 (SHEET-INSIDE-TOP SHEET)) (SHEET-INSIDE-BOTTOM SHEET)))))
  (PROG () (RETURN X Y)))

;; 40 is 4 character-widths
(DEFUN SUITABLY-CLOSE (DELTA)
  (AND (PLUSP DELTA) (< DELTA 40)))

;;; Put a window someplace using the mouse
(DEFUN MOUSE-SET-WINDOW-SIZE (WINDOW &OPTIONAL (MOVE-P T) &AUX LEFT TOP RIGHT BOTTOM ERROR)
  (DECLARE (RETURN-LIST LEFT TOP RIGHT BOTTOM))
  (MULTIPLE-VALUE (LEFT TOP)
    (SHEET-CALCULATE-OFFSETS WINDOW MOUSE-SHEET))
  (SETQ RIGHT (+ LEFT (SHEET-WIDTH WINDOW))
	BOTTOM (+ TOP (SHEET-HEIGHT WINDOW)))
  (DO () (())
    (MULTIPLE-VALUE (LEFT TOP RIGHT BOTTOM)
      (MOUSE-SPECIFY-RECTANGLE LEFT TOP RIGHT BOTTOM (SHEET-SUPERIOR WINDOW) 0 0 T))
    (COND ((NULL LEFT)				;Aborted
	   (BEEP)				;Leave it where it is
	   (SETQ MOVE-P NIL)
	   (MULTIPLE-VALUE (LEFT TOP RIGHT BOTTOM) (FUNCALL WINDOW ':EDGES))
	   (RETURN))
	  ((NULL (MULTIPLE-VALUE (NIL ERROR)
		   (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT BOTTOM ':VERIFY)))
	   (BEEP)
	   (POP-UP-FORMAT "Illegal edges for ~S:~%~A" WINDOW ERROR)) ;Edges no good, try again
	  (T (RETURN))))			;Good
  (AND MOVE-P (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT BOTTOM))
  (PROG () (RETURN LEFT TOP RIGHT BOTTOM)))


(DEFFLAVOR MOUSE-BOX-BLINKER () (MOUSE-BLINKER-MIXIN BOX-BLINKER))
(DEFFLAVOR MOUSE-BOX-STAY-INSIDE-BLINKER ()
	   (MOUSE-BLINKER-MIXIN STAY-INSIDE-BLINKER-MIXIN BOX-BLINKER))
(COMPILE-FLAVOR-METHODS MOUSE-BOX-BLINKER MOUSE-BOX-STAY-INSIDE-BLINKER)
(MOUSE-DEFINE-BLINKER-TYPE ':BOX-BLINKER
			   #'(LAMBDA (SCREEN)
			       (DEFINE-BLINKER SCREEN 'MOUSE-BOX-BLINKER
				 ':VISIBILITY NIL)))
(MOUSE-DEFINE-BLINKER-TYPE ':BOX-STAY-INSIDE-BLINKER
			   #'(LAMBDA (SCREEN)
			       (DEFINE-BLINKER SCREEN 'MOUSE-BOX-STAY-INSIDE-BLINKER
				 ':VISIBILITY NIL)))

;;; Move a window around using the mouse
;;; If MOVE-P is NIL move just an outline of it and return where it would have moved to
;;; Return values are the position X, Y, or NIL if the middle button is clicked to abort.
(DEFUN MOUSE-SET-WINDOW-POSITION (WINDOW &OPTIONAL (MOVE-P T)
					 &AUX (SUPERIOR (SHEET-SUPERIOR WINDOW))
				      (X (SHEET-X WINDOW))
				      (Y (SHEET-Y WINDOW))
				      XOFF YOFF BD)
  (DECLARE (RETURN-LIST X Y))
  (OR (SHEET-ME-OR-MY-KID-P WINDOW MOUSE-SHEET)
      (FERROR NIL "Attempt to set position of ~S, which is not inferior to MOUSE-SHEET"
	      WINDOW))
  (MULTIPLE-VALUE (XOFF YOFF)
    (SHEET-CALCULATE-OFFSETS SUPERIOR MOUSE-SHEET))
  (PROG MOUSE-SET-WINDOW-POSITION ()	;because multiple values not passed by UNWIND-PROTECT
    (WITH-MOUSE-GRABBED
      (WITHOUT-INTERRUPTS
	      (MOUSE-SET-BLINKER-DEFINITION ':BOX-STAY-INSIDE-BLINKER 0 0 NIL
					    ':SET-SIZE (SHEET-WIDTH WINDOW)
						       (SHEET-HEIGHT WINDOW))
	      (MOUSE-WARP (+ X XOFF) (+ Y YOFF)))
      (BLINKER-SET-VISIBILITY MOUSE-BLINKER T)
      (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION
	    "Left button selects position of window.  Middle aborts.")
      (DO () (NIL)
	;; In case this was called in response to a mouse click, wait for
	;; the buttons to be released.
	(PROCESS-WAIT "Release Button" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
	(PROCESS-WAIT "Button" #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
	(SETQ BD MOUSE-LAST-BUTTONS)
	(MULTIPLE-VALUE (X Y) (FUNCALL MOUSE-BLINKER ':READ-CURSORPOS))
	(COND ((ZEROP BD))
	      ((BIT-TEST 2 BD) (RETURN-FROM MOUSE-SET-WINDOW-POSITION NIL))
	      ((FUNCALL WINDOW ':SET-POSITION X Y ':VERIFY)
	       (BLINKER-SET-VISIBILITY MOUSE-BLINKER NIL)
	       (IF MOVE-P (FUNCALL WINDOW ':SET-POSITION X Y))
	       (RETURN-FROM MOUSE-SET-WINDOW-POSITION X Y))
	      (T (BEEP)))))))			;Illegal position

(DEFUN EXPAND-WINDOW (WINDOW &OPTIONAL (MOVE-P T))
  (DECLARE (RETURN-LIST LEFT TOP RIGHT BOTTOM))
  (LET ((X-OFFSET (SHEET-X-OFFSET WINDOW))
	(Y-OFFSET (SHEET-Y-OFFSET WINDOW)))
    (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
	(EXPAND-RECTANGULAR-AREA 
	  (SHEET-SUPERIOR WINDOW)	
	  X-OFFSET
	  Y-OFFSET
	  (+ X-OFFSET (SHEET-WIDTH WINDOW))
	  (+ Y-OFFSET (SHEET-HEIGHT WINDOW)))
      (AND MOVE-P (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT BOTTOM))
      (VALUES LEFT TOP RIGHT BOTTOM))))

;;; Given a superior window, and a rectangle within that window, return
;;; the boundaries of a new rectangle that includes the old rectangle
;;; and is expanded as much as possible without overlapping any exposed
;;; inferiors of the superior window.  If the IGNORED-WINDOW argument
;;; is present, it means that we should ignore the presence of this window.
(DEFUN EXPAND-RECTANGULAR-AREA (SUPERIOR LEFT TOP RIGHT BOTTOM &OPTIONAL IGNORED-WINDOW)
  (DECLARE (RETURN-LIST MAX-LEFT MAX-TOP MAX-RIGHT MAX-BOTTOM))
  (LET ((SIBLINGS (SHEET-EXPOSED-INFERIORS SUPERIOR))
	(MAX-LEFT (SHEET-INSIDE-LEFT SUPERIOR))
	(MAX-RIGHT (SHEET-INSIDE-RIGHT SUPERIOR))
	(MAX-TOP (SHEET-INSIDE-TOP SUPERIOR))
	(MAX-BOTTOM (SHEET-INSIDE-BOTTOM SUPERIOR)))
    ;;Expand to the left and right
    (DOLIST (W SIBLINGS)
      (COND ((OR (NULL IGNORED-WINDOW) (NEQ W IGNORED-WINDOW))
	     (AND (SHEET-OVERLAPS-EDGES-P W MAX-LEFT TOP LEFT BOTTOM)
		  (SETQ MAX-LEFT (+ (SHEET-X-OFFSET W) (SHEET-WIDTH W))))
	     (AND (SHEET-OVERLAPS-EDGES-P W RIGHT TOP MAX-RIGHT BOTTOM)
		  (SETQ MAX-RIGHT (SHEET-X-OFFSET W))))))
    ;;Expand to the top and bottom
    (DOLIST (W SIBLINGS)
      (COND ((OR (NULL IGNORED-WINDOW) (NEQ W IGNORED-WINDOW))
	     (AND (SHEET-OVERLAPS-EDGES-P W MAX-LEFT MAX-TOP MAX-RIGHT TOP)
		  (SETQ MAX-TOP (+ (SHEET-Y-OFFSET W) (SHEET-HEIGHT W))))
	     (AND (SHEET-OVERLAPS-EDGES-P W MAX-LEFT BOTTOM MAX-RIGHT MAX-BOTTOM)
		  (SETQ MAX-BOTTOM (SHEET-Y-OFFSET W))))))
    (VALUES MAX-LEFT MAX-TOP MAX-RIGHT MAX-BOTTOM)))


;;;The hairy window whitespace reclaimer
(DEFSTRUCT (EXPAND-WINDOWS-ITEM :LIST (:CONSTRUCTOR NIL))
  EXPAND-WINDOWS-WINDOW
  EXPAND-WINDOWS-LEFT
  EXPAND-WINDOWS-TOP
  EXPAND-WINDOWS-RIGHT
  EXPAND-WINDOWS-BOTTOM
  EXPAND-WINDOWS-LEFT-TOP-WINNERS
  EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS
  EXPAND-WINDOWS-MAX-LEFT-TOP
  EXPAND-WINDOWS-MAX-RIGHT-BOTTOM)

(DEFUN EXPAND-WINDOWS (TOP-WINDOW &AUX WINDOW-LIST)
  (SETQ WINDOW-LIST (MAPCAR #'(LAMBDA (W &AUX LEFT TOP)
				(LIST W
				      (SETQ LEFT (SHEET-X-OFFSET W))
				      (SETQ TOP (SHEET-Y-OFFSET W))
				      (+ LEFT (SHEET-WIDTH W))
				      (+ TOP (SHEET-HEIGHT W))
				      NIL NIL NIL NIL))
			    (SHEET-EXPOSED-INFERIORS TOP-WINDOW)))
  (EXPAND-WINDOWS-LEFT-AND-RIGHT TOP-WINDOW WINDOW-LIST)
  (EXPAND-WINDOWS-TOP-AND-BOTTOM TOP-WINDOW WINDOW-LIST)
  ;;Now we are ready to set all the edges
  (DELAYING-SCREEN-MANAGEMENT
    (DOLIST (ITEM WINDOW-LIST)
      (FUNCALL (EXPAND-WINDOWS-WINDOW ITEM) ':SET-EDGES
	       (EXPAND-WINDOWS-LEFT ITEM) (EXPAND-WINDOWS-TOP ITEM)
	       (EXPAND-WINDOWS-RIGHT ITEM) (EXPAND-WINDOWS-BOTTOM ITEM)))))

;;;Expand the lefts and rights
(DEFUN EXPAND-WINDOWS-LEFT-AND-RIGHT (TOP-WINDOW WINDOW-LIST)
  (DO ((L WINDOW-LIST (CDR L))
       (ITEM)
       (SUPERIOR-INSIDE-LEFT (SHEET-INSIDE-LEFT TOP-WINDOW))
       (SUPERIOR-INSIDE-RIGHT (SHEET-INSIDE-RIGHT TOP-WINDOW)))
      ((NULL L))
    (SETQ ITEM (CAR L))
    (DO ((L WINDOW-LIST (CDR L))
	 (NITEM)
	 (LEFT (EXPAND-WINDOWS-LEFT ITEM))
	 (TOP (EXPAND-WINDOWS-TOP ITEM))
	 (RIGHT (EXPAND-WINDOWS-RIGHT ITEM))
	 (BOTTOM (EXPAND-WINDOWS-BOTTOM ITEM))
	 (MAX-LEFT SUPERIOR-INSIDE-LEFT)
	 (MAX-RIGHT SUPERIOR-INSIDE-RIGHT)
	 (LEFT-WINNERS)
	 (RIGHT-WINNERS)
	 (NITEM-LEFT)
	 (NITEM-RIGHT))
	((NULL L)
	 (SETF (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM) LEFT-WINNERS)
	 (SETF (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM) RIGHT-WINNERS)
	 (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM) MAX-LEFT)
	 (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM) MAX-RIGHT))
      (OR (EQ ITEM (SETQ NITEM (CAR L)))		;For all other windows
	  (> TOP (EXPAND-WINDOWS-BOTTOM NITEM))		;Which share some space on y
	  (< BOTTOM (EXPAND-WINDOWS-TOP NITEM))
	  (COND (( LEFT (SETQ NITEM-RIGHT (EXPAND-WINDOWS-RIGHT NITEM)))
		 (AND ( NITEM-RIGHT MAX-LEFT)
		      (IF (= NITEM-RIGHT MAX-LEFT)	;More than one window along the edge
			  (PUSH NITEM LEFT-WINNERS)
			  (SETQ MAX-LEFT NITEM-RIGHT
				LEFT-WINNERS (LIST NITEM)))))
		(( RIGHT (SETQ NITEM-LEFT (EXPAND-WINDOWS-LEFT NITEM)))
		 (AND ( NITEM-LEFT MAX-RIGHT)
		      (IF (= NITEM-LEFT MAX-RIGHT)
			  (PUSH NITEM RIGHT-WINNERS)
			  (SETQ MAX-RIGHT NITEM-LEFT
				RIGHT-WINNERS (LIST NITEM)))))))))
  (DOLIST (ITEM WINDOW-LIST)
    (LET ((WINDOW (EXPAND-WINDOWS-WINDOW ITEM))
	  (LEFT (EXPAND-WINDOWS-LEFT ITEM))
	  (TOP (EXPAND-WINDOWS-TOP ITEM))
	  (RIGHT (EXPAND-WINDOWS-RIGHT ITEM))
	  (BOTTOM (EXPAND-WINDOWS-BOTTOM ITEM))
	  (MAX-LEFT (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM))
	  (MAX-RIGHT (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM))
	  (LEFT-WINNERS (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM))
	  (RIGHT-WINNERS (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM)))
      (AND ( MAX-LEFT LEFT)				;If not already adjacent
	   (LET ((WINNERS-MAX-RIGHT (AND LEFT-WINNERS
					 (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM
					   (CAR LEFT-WINNERS))))
		 (LEFT-MIDDLE (+ MAX-LEFT (// (- LEFT MAX-LEFT) 2))))
	     (AND WINNERS-MAX-RIGHT (SETQ LEFT-MIDDLE (MIN LEFT-MIDDLE WINNERS-MAX-RIGHT)))
	     (IF (NOT (FUNCALL WINDOW ':SET-EDGES LEFT-MIDDLE TOP RIGHT BOTTOM ':VERIFY))
		 ;;This window will not move, get as many of the others as will allow
		 (DOLIST (LEFT-WINNER LEFT-WINNERS)
		   (AND (FUNCALL (EXPAND-WINDOWS-WINDOW LEFT-WINNER) ':SET-EDGES
				 (EXPAND-WINDOWS-LEFT LEFT-WINNER)
				 (EXPAND-WINDOWS-TOP LEFT-WINNER)
				 WINNERS-MAX-RIGHT
				 (EXPAND-WINDOWS-BOTTOM LEFT-WINNER)
				 ':VERIFY)
			(SET-EXPAND-WINDOWS-RIGHT LEFT-WINNER WINNERS-MAX-RIGHT)))
		 ;;Otherwise expand this window left
		 (IF (AND (OR (NULL LEFT-WINNERS)	;If no windows to the left,
			      (DOLIST (LEFT-WINNER LEFT-WINNERS)	;or some won't budge
				(OR (FUNCALL (EXPAND-WINDOWS-WINDOW LEFT-WINNER) ':SET-EDGES
					     (EXPAND-WINDOWS-LEFT LEFT-WINNER)
					     (EXPAND-WINDOWS-TOP LEFT-WINNER)
					     LEFT-MIDDLE
					     (EXPAND-WINDOWS-BOTTOM LEFT-WINNER)
					     ':VERIFY)
				    (RETURN T))))
			  (FUNCALL WINDOW ':SET-EDGES MAX-LEFT TOP RIGHT BOTTOM ':VERIFY))
		     ;;Go all the way left
		     (SET-EXPAND-WINDOWS-LEFT ITEM (SETQ LEFT MAX-LEFT))
		     ;;Share with winners
		     (SET-EXPAND-WINDOWS-LEFT ITEM (SETQ LEFT LEFT-MIDDLE))
		     (DOLIST (LEFT-WINNER LEFT-WINNERS)
		       (SET-EXPAND-WINDOWS-RIGHT LEFT-WINNER LEFT-MIDDLE))))))
      (AND ( MAX-RIGHT RIGHT)
	   (LET ((WINNERS-MAX-LEFT (AND RIGHT-WINNERS
					(EXPAND-WINDOWS-MAX-LEFT-TOP (CAR RIGHT-WINNERS))))
		 (RIGHT-MIDDLE (- MAX-RIGHT (// (- MAX-RIGHT RIGHT) 2))))
	     (AND WINNERS-MAX-LEFT (SETQ RIGHT-MIDDLE (MAX RIGHT-MIDDLE WINNERS-MAX-LEFT)))
	     (IF (NOT (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT-MIDDLE BOTTOM ':VERIFY))
		 (DOLIST (RIGHT-WINNER RIGHT-WINNERS)
		   (AND (FUNCALL (EXPAND-WINDOWS-WINDOW RIGHT-WINNER) ':SET-EDGES
				 WINNERS-MAX-LEFT
				 (EXPAND-WINDOWS-TOP RIGHT-WINNER)
				 (EXPAND-WINDOWS-RIGHT RIGHT-WINNER)
				 (EXPAND-WINDOWS-BOTTOM RIGHT-WINNER)
				 ':VERIFY)
			(SET-EXPAND-WINDOWS-LEFT RIGHT-WINNER WINNERS-MAX-LEFT)))
		 (IF (AND (OR (NULL RIGHT-WINNERS)
			      (DOLIST (RIGHT-WINNER RIGHT-WINNERS)
				(OR (FUNCALL (EXPAND-WINDOWS-WINDOW RIGHT-WINNER)
					     ':SET-EDGES
					     RIGHT-MIDDLE
					     (EXPAND-WINDOWS-TOP RIGHT-WINNER)
					     (EXPAND-WINDOWS-RIGHT RIGHT-WINNER)
					     (EXPAND-WINDOWS-BOTTOM RIGHT-WINNER)
					     ':VERIFY)
				    (RETURN T))))
			  (FUNCALL WINDOW ':SET-EDGES LEFT TOP MAX-RIGHT BOTTOM ':VERIFY))
		     (SET-EXPAND-WINDOWS-RIGHT ITEM (SETQ RIGHT MAX-RIGHT))
		     (SET-EXPAND-WINDOWS-RIGHT ITEM (SETQ RIGHT RIGHT-MIDDLE))
		     (DOLIST (RIGHT-WINNER RIGHT-WINNERS)
		       (SET-EXPAND-WINDOWS-LEFT RIGHT-WINNER RIGHT-MIDDLE)))))))))

(DEFUN SET-EXPAND-WINDOWS-LEFT (ITEM VAL)
  (SETF (EXPAND-WINDOWS-LEFT ITEM) VAL)
  (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM) VAL)
  (DOLIST (WINNER (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM))
    (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM WINNER)
	  (MIN VAL (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM WINNER)))))

(DEFUN SET-EXPAND-WINDOWS-RIGHT (ITEM VAL)
  (SETF (EXPAND-WINDOWS-RIGHT ITEM) VAL)
  (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM) VAL)
  (DOLIST (WINNER (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM))
    (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP WINNER)
	  (MAX VAL (EXPAND-WINDOWS-MAX-LEFT-TOP WINNER)))))

(DEFUN EXPAND-WINDOWS-TOP-AND-BOTTOM (TOP-WINDOW WINDOW-LIST)
  (DO ((L WINDOW-LIST (CDR L))
       (ITEM)
       (SUPERIOR-INSIDE-TOP (SHEET-INSIDE-TOP TOP-WINDOW))
       (SUPERIOR-INSIDE-BOTTOM (SHEET-INSIDE-BOTTOM TOP-WINDOW)))
      ((NULL L))
    (SETQ ITEM (CAR L))
    (DO ((L WINDOW-LIST (CDR L))
	 (NITEM)
	 (LEFT (EXPAND-WINDOWS-LEFT ITEM))
	 (TOP (EXPAND-WINDOWS-TOP ITEM))
	 (RIGHT (EXPAND-WINDOWS-RIGHT ITEM))
	 (BOTTOM (EXPAND-WINDOWS-BOTTOM ITEM))
	 (MAX-TOP SUPERIOR-INSIDE-TOP)
	 (MAX-BOTTOM SUPERIOR-INSIDE-BOTTOM)
	 (TOP-WINNERS)
	 (BOTTOM-WINNERS)
	 (NITEM-TOP)
	 (NITEM-BOTTOM))
	((NULL L)
	 (SETF (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM) TOP-WINNERS)
	 (SETF (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM) BOTTOM-WINNERS)
	 (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM) MAX-TOP)
	 (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM) MAX-BOTTOM))
      (OR (EQ ITEM (SETQ NITEM (CAR L)))		;For all other windows
	  (> LEFT (EXPAND-WINDOWS-RIGHT NITEM))		;Which share some space on y
	  (< RIGHT (EXPAND-WINDOWS-LEFT NITEM))
	  (COND (( TOP (SETQ NITEM-BOTTOM (EXPAND-WINDOWS-BOTTOM NITEM)))
		 (AND ( NITEM-BOTTOM MAX-TOP)
		      (IF (= NITEM-BOTTOM MAX-TOP)	;More than one window along the edge
			  (PUSH NITEM TOP-WINNERS)
			  (SETQ MAX-TOP NITEM-BOTTOM
				TOP-WINNERS (LIST NITEM)))))
		(( BOTTOM (SETQ NITEM-TOP (EXPAND-WINDOWS-TOP NITEM)))
		 (AND ( NITEM-TOP MAX-BOTTOM)
		      (IF (= NITEM-TOP MAX-BOTTOM)
			  (PUSH NITEM BOTTOM-WINNERS)
			  (SETQ MAX-BOTTOM NITEM-TOP
				BOTTOM-WINNERS (LIST NITEM)))))))))
  (DOLIST (ITEM WINDOW-LIST)
    (LET ((WINDOW (EXPAND-WINDOWS-WINDOW ITEM))
	  (LEFT (EXPAND-WINDOWS-LEFT ITEM))
	  (TOP (EXPAND-WINDOWS-TOP ITEM))
	  (RIGHT (EXPAND-WINDOWS-RIGHT ITEM))
	  (BOTTOM (EXPAND-WINDOWS-BOTTOM ITEM))
	  (MAX-TOP (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM))
	  (MAX-BOTTOM (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM))
	  (TOP-WINNERS (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM))
	  (BOTTOM-WINNERS (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM)))
      (AND ( MAX-TOP TOP)				;If not already adjacent
	   (LET ((WINNERS-MAX-BOTTOM (AND TOP-WINNERS
					  (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM
					    (CAR TOP-WINNERS))))
		 (TOP-MIDDLE (+ MAX-TOP (// (- TOP MAX-TOP) 2))))
	     (AND WINNERS-MAX-BOTTOM (SETQ TOP-MIDDLE (MIN TOP-MIDDLE WINNERS-MAX-BOTTOM)))
	     (IF (NOT (FUNCALL WINDOW ':SET-EDGES LEFT TOP-MIDDLE RIGHT BOTTOM ':VERIFY))
		 ;;This window will not move, get as many of the others as will allow
		 (DOLIST (TOP-WINNER TOP-WINNERS)
		   (AND (FUNCALL (EXPAND-WINDOWS-WINDOW TOP-WINNER) ':SET-EDGES
				 (EXPAND-WINDOWS-LEFT TOP-WINNER)
				 (EXPAND-WINDOWS-TOP TOP-WINNER)
				 (EXPAND-WINDOWS-RIGHT TOP-WINNER)
				 WINNERS-MAX-BOTTOM
				 ':VERIFY)
			(SET-EXPAND-WINDOWS-BOTTOM TOP-WINNER WINNERS-MAX-BOTTOM)))
		 ;;Otherwise expand this window top
		 (IF (AND (OR (NULL TOP-WINNERS)	;If no windows to the top,
			      (DOLIST (TOP-WINNER TOP-WINNERS)	;or some won't budge
				(OR (FUNCALL (EXPAND-WINDOWS-WINDOW TOP-WINNER) ':SET-EDGES
					     (EXPAND-WINDOWS-LEFT TOP-WINNER)
					     (EXPAND-WINDOWS-TOP TOP-WINNER)
					     (EXPAND-WINDOWS-RIGHT TOP-WINNER)
					     TOP-MIDDLE
					     ':VERIFY)
				    (RETURN T))))
			  (FUNCALL WINDOW ':SET-EDGES LEFT MAX-TOP RIGHT BOTTOM ':VERIFY))
		     ;;Go all the way top
		     (SET-EXPAND-WINDOWS-TOP ITEM (SETQ TOP MAX-TOP))
		     ;;Share with winners
		     (SET-EXPAND-WINDOWS-TOP ITEM (SETQ TOP TOP-MIDDLE))
		     (DOLIST (TOP-WINNER TOP-WINNERS)
		       (SET-EXPAND-WINDOWS-BOTTOM TOP-WINNER TOP-MIDDLE))))))
      (AND ( MAX-BOTTOM BOTTOM)
	   (LET ((WINNERS-MAX-TOP (AND BOTTOM-WINNERS
					(EXPAND-WINDOWS-MAX-LEFT-TOP (CAR BOTTOM-WINNERS))))
		 (BOTTOM-MIDDLE (- MAX-BOTTOM (// (- MAX-BOTTOM BOTTOM) 2))))
	     (AND WINNERS-MAX-TOP (SETQ BOTTOM-MIDDLE (MAX BOTTOM-MIDDLE WINNERS-MAX-TOP)))
	     (IF (NOT (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT BOTTOM-MIDDLE ':VERIFY))
		 (DOLIST (BOTTOM-WINNER BOTTOM-WINNERS)
		   (AND (FUNCALL (EXPAND-WINDOWS-WINDOW BOTTOM-WINNER) ':SET-EDGES
				 (EXPAND-WINDOWS-LEFT BOTTOM-WINNER)
				 WINNERS-MAX-TOP
				 (EXPAND-WINDOWS-RIGHT BOTTOM-WINNER)
				 (EXPAND-WINDOWS-BOTTOM BOTTOM-WINNER)
				 ':VERIFY)
			(SET-EXPAND-WINDOWS-TOP BOTTOM-WINNER WINNERS-MAX-TOP)))
		 (IF (AND (OR (NULL BOTTOM-WINNERS)
			      (DOLIST (BOTTOM-WINNER BOTTOM-WINNERS)
				(OR (FUNCALL (EXPAND-WINDOWS-WINDOW BOTTOM-WINNER)
					     ':SET-EDGES
					     (EXPAND-WINDOWS-LEFT BOTTOM-WINNER)
					     BOTTOM-MIDDLE
					     (EXPAND-WINDOWS-RIGHT BOTTOM-WINNER)
					     (EXPAND-WINDOWS-BOTTOM BOTTOM-WINNER)
					     ':VERIFY)
				    (RETURN T))))
			  (FUNCALL WINDOW ':SET-EDGES LEFT TOP RIGHT MAX-BOTTOM ':VERIFY))
		     (SET-EXPAND-WINDOWS-BOTTOM ITEM (SETQ BOTTOM MAX-BOTTOM))
		     (SET-EXPAND-WINDOWS-BOTTOM ITEM (SETQ BOTTOM BOTTOM-MIDDLE))
		     (DOLIST (BOTTOM-WINNER BOTTOM-WINNERS)
		       (SET-EXPAND-WINDOWS-TOP BOTTOM-WINNER BOTTOM-MIDDLE)))))))))

(DEFUN SET-EXPAND-WINDOWS-TOP (ITEM VAL)
  (SETF (EXPAND-WINDOWS-TOP ITEM) VAL)
  (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP ITEM) VAL)
  (DOLIST (WINNER (EXPAND-WINDOWS-LEFT-TOP-WINNERS ITEM))
    (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM WINNER)
	  (MIN VAL (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM WINNER)))))

(DEFUN SET-EXPAND-WINDOWS-BOTTOM (ITEM VAL)
  (SETF (EXPAND-WINDOWS-BOTTOM ITEM) VAL)
  (SETF (EXPAND-WINDOWS-MAX-RIGHT-BOTTOM ITEM) VAL)
  (DOLIST (WINNER (EXPAND-WINDOWS-RIGHT-BOTTOM-WINNERS ITEM))
    (SETF (EXPAND-WINDOWS-MAX-LEFT-TOP WINNER)
	  (MAX VAL (EXPAND-WINDOWS-MAX-LEFT-TOP WINNER)))))

(DEFVAR SCREEN-EDITOR-ITEM-LIST
	'(("Bury" :VALUE SEC-BURY
	   :DOCUMENTATION "Point at a window and put it underneath all other windows.")
	  ("Expose" :VALUE SEC-EXPOSE
	   :DOCUMENTATION "Point at a window and expose it.")
	  ("Expose (menu)" :VALUE SEC-EXPOSE-MENU
	   :DOCUMENTATION 
   "Choose a window (from a menu) and expose it.  This can get at more windows than Expose.")
	  ("Create" :VALUE SEC-CREATE
	   :DOCUMENTATION
  "Choose a flavor of window (from a menu) and corners, and create a window of that flavor.")
	  ("Create (expand)" :VALUE SEC-CREATE-EXPAND
	   :DOCUMENTATION "Create followed by Expand Window.")
	  ("Kill" :VALUE SEC-KILL
	   :DOCUMENTATION "Point at a window and kill it.  Asks for confirmation.")
	  ("Exit" :VALUE SEC-QUIT
	   :DOCUMENTATION "Leave the screen editor.")
	  ("Undo" :VALUE SEC-UNDO
	   :DOCUMENTATION "Undo the last screen editor command.  Can't undo Create or Kill.")
	  ("Move window" :VALUE SEC-MOVE-WINDOW
	   :DOCUMENTATION "Point at a window and move it.")
	  ("Reshape" :VALUE SEC-RESHAPE
	   :DOCUMENTATION "Point at a window, and specify new corners for it.")
	  ("Move multiple" :VALUE SEC-MULTIPLE-MOVE
	   :DOCUMENTATION "Choose a group of edges and corners and move them as a unit.")
	  ("Move single" :VALUE SEC-SINGLE-MOVE
	   :DOCUMENTATION "Point at an edge or corner and move it.")
	  ("Expand window" :VALUE SEC-EXPAND-WINDOW
	   :DOCUMENTATION 
"Point at a window and change its size so it fills as much empty space around it as possible."
	   )
	  ("Expand all" :VALUE SEC-EXPAND-ALL
	   :DOCUMENTATION
	   "Change the size of all windows to fill as much empty space as possible.")
	  ("Attributes" :VALUE SEC-ATTRIBUTES
	   :DOCUMENTATION
	   "Edit the attributes of a specified window.")))

(DEFWINDOW-RESOURCE SCREEN-EDITOR-MENU ()
	:MAKE-WINDOW (DYNAMIC-POP-UP-MENU :ITEM-LIST-POINTER 'SCREEN-EDITOR-ITEM-LIST
					  :SAVE-BITS T)
	:REUSABLE-WHEN :DEEXPOSED)

(DEFVAR SCREEN-EDITOR-MENU)
(DEFVAR SCREEN-EDITOR-PREVIOUS-ALIST)

;;; The actual screen editor
;;; The WINDOW-EDGE-ALIST is in sheet visibility order and has elements
;;;	(window exposed-p left top right bottom)
;;; :BURY in exposed-p is a special kludge to make burying to deexposed windows work
;;; Only problem with this is that undoing a bury of a de-exposed window does not work;
;;; we do not have window operations to do things like bring a window to the top
;;; of the de-exposed ones.

;;; Commands work by modifying this alist and the command loop here does the
;;; actual side-effects, allowing for undoing.
(DEFUN EDIT-SCREEN (TOP-SHEET &AUX WINDOW-EDGE-ALIST SCREEN-EDITOR-PREVIOUS-ALIST
				   (OLD-MOUSE-SHEET MOUSE-SHEET)
				   (OLD-SELECTED-WINDOW SELECTED-WINDOW))
  (USING-RESOURCE (SCREEN-EDITOR-MENU SCREEN-EDITOR-MENU TOP-SHEET)
   (UNWIND-PROTECT
    (*CATCH 'EXIT-SCREEN-EDITOR
     (LET-GLOBALLY ((WHO-LINE-PROCESS CURRENT-PROCESS))
      (MOUSE-SET-SHEET TOP-SHEET)
      (DO ((COMMAND)
	   (NEW-ALIST 'FIRST))
	 (NIL)
       (EXPOSE-WINDOW-NEAR SCREEN-EDITOR-MENU '(:MOUSE))
       (IF (SETQ COMMAND (FUNCALL SCREEN-EDITOR-MENU ':CHOOSE))
	   (DELAYING-SCREEN-MANAGEMENT
	     (FUNCALL SCREEN-EDITOR-MENU ':DEACTIVATE)
	     ;; Now, just before executing the command, pick up the state of the screen
	     ;; We defer it until now so that we see the results of screen management
	     ;; and of things done to the screen by other processes.
	     ;; Also save the state before the previous command for Undo
	     (OR (EQ NEW-ALIST 'ABORT)
		 (SETQ SCREEN-EDITOR-PREVIOUS-ALIST WINDOW-EDGE-ALIST))
	     (SETQ WINDOW-EDGE-ALIST (GET-WINDOW-EDGE-ALIST TOP-SHEET))
	     (AND (EQ NEW-ALIST 'FIRST)
		  (SETQ SCREEN-EDITOR-PREVIOUS-ALIST WINDOW-EDGE-ALIST))
	     (SETQ NEW-ALIST (FUNCALL COMMAND TOP-SHEET WINDOW-EDGE-ALIST))
	     (COND ((NEQ NEW-ALIST 'ABORT)	;Don't change history if command aborted
		    (DOLIST (NEW NEW-ALIST)
		      (LET ((OLD (ASSQ (CAR NEW) WINDOW-EDGE-ALIST)))
			(OR (EQUAL (CDDR OLD) (CDDR NEW))	;Edges not the same?
			    (MULTIPLE-VALUE-BIND (WIN LOSE)
				(FUNCALL (FIRST NEW) ':SET-EDGES (THIRD NEW) (FOURTH NEW)
					 (FIFTH NEW) (SIXTH NEW) ':VERIFY)
			      (IF WIN (LEXPR-FUNCALL (CAR NEW) ':SET-EDGES (CDDR NEW))
				  (BEEP)
				  (POP-UP-FORMAT "Illegal edges for ~S:~%~A"
						 (CAR NEW) LOSE))))
			;; Try to fix exposure and ordering of de-exposed sheets.
			;; This may not be quite right, e.g. if undoing an expose
			;; because the window will go in the wrong place in the
			;; de-exposed sheets, and Undo twice will not be a no-op.
			;; It will just have to do for now though.
			(COND ((EQ (CADR NEW) T)
			       (OR (CADR OLD) (FUNCALL (CAR NEW) ':EXPOSE)))
			      ((EQ (CADR NEW) ':BURY)
			       (FUNCALL (CAR NEW) ':BURY)))))
		    ;; Doing the buries in a second pass makes the
		    ;; above-mentioned inaccuracy less
		    (DOLIST (NEW NEW-ALIST)
		      (AND (NOT (CADR NEW)) (SHEET-EXPOSED-P (CAR NEW))
			   (FUNCALL (CAR NEW) ':BURY))))))
	      ))))
    (MOUSE-SET-SHEET OLD-MOUSE-SHEET)))
  (IF (SCREEN-EDITOR-SHOULD-RESELECT OLD-SELECTED-WINDOW)
      (FUNCALL OLD-SELECTED-WINDOW ':SELECT)
      (FUNCALL TOP-SHEET ':SCREEN-MANAGE-AUTOEXPOSE-INFERIORS)))

(DEFUN GET-WINDOW-EDGE-ALIST (TOP-SHEET &AUX WINDOW-EDGE-ALIST TEM)
  (DOLIST (SHEET (SHEET-INFERIORS TOP-SHEET))
    (AND (OR (SETQ TEM (SHEET-EXPOSED-P SHEET))
	     (FUNCALL SHEET ':SCREEN-MANAGE-DEEXPOSED-VISIBILITY))
	 (PUSH (LIST* SHEET TEM (MULTIPLE-VALUE-LIST (FUNCALL SHEET ':EDGES)))
	       WINDOW-EDGE-ALIST)))
  (NREVERSE WINDOW-EDGE-ALIST))

(DEFUN SCREEN-EDITOR-SHOULD-RESELECT (W)
  (AND W
       (DO ((W W (SHEET-SUPERIOR W)))
	   ((NULL W) T)
	 (OR (SHEET-EXPOSED-P W)
	     (RETURN NIL)))))

(DEFUN SCREEN-EDITOR-FIND-SCREEN-TO-EDIT (BOTTOM-WINDOW &AUX LIST)
  (DO SHEET BOTTOM-WINDOW (SHEET-SUPERIOR SHEET) (NULL SHEET)
      (IF (SHEET-EXPOSED-P SHEET)
	  (IF (TYPEP SHEET 'BASIC-FRAME) (PUSH SHEET LIST))
	  (SETQ LIST NIL)))
  ;; LIST is now all the frames under the mouse that are VISIBLE!
  (IF (NULL LIST) MOUSE-SHEET
      (OR (MEMQ MOUSE-SHEET LIST) (PUSH MOUSE-SHEET LIST))
      (MENU-CHOOSE
	(MAPCAR #'(LAMBDA (W) (CONS (OR (AND (GET-HANDLER-FOR W ':NAME-FOR-SELECTION)
					     (FUNCALL W ':NAME-FOR-SELECTION))
					(SHEET-NAME W))
				    W))
		LIST)
	"Edit which screen or frame:")))

;;; This is like SUBST but uses EQ rather than EQUAL and only copies what it has to.
(DEFUN SUBSTQ (NEW OLD SEXP)
  (COND ((EQ OLD SEXP) NEW)
	((ATOM SEXP) SEXP)
	(T (LET ((NCAR (SUBSTQ NEW OLD (CAR SEXP)))
		 (NCDR (SUBSTQ NEW OLD (CDR SEXP))))
	     (IF (AND (EQ (CAR SEXP) NCAR) (EQ (CDR SEXP) NCDR)) SEXP (CONS NCAR NCDR))))))

;;; The screen editor commands and their friends; called with the top-sheet and edge-alist
;;; as arguments, they return the new edge alist.
(DEFUN SEC-QUIT (IGNORE IGNORE)
  (*THROW 'EXIT-SCREEN-EDITOR T))

(DEFUN SEC-UNDO (IGNORE IGNORE)
  SCREEN-EDITOR-PREVIOUS-ALIST)

(DEFUN SEC-BURY (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			"Bury window" "Choose a window to bury.  Middle aborts."))
	 (SETQ WINDOW-EDGE-ALIST (NREVERSE (XCONS (DELQ WINDOW (REVERSE WINDOW-EDGE-ALIST))
						  (SETQ WINDOW (COPYLIST WINDOW)))))
	 (SETF (SECOND WINDOW) ':BURY)
	 WINDOW-EDGE-ALIST)
	(T 'ABORT)))

;This is not really undoable, in that the window cannot be "unkilled"
(DEFUN SEC-KILL (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((AND (SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			     "Kill window" "Choose a window to be killed.  Middle aborts."))
	      (MOUSE-Y-OR-N-P (FORMAT NIL "Kill ~A" (SHEET-NAME (CAR WINDOW)))))
	 (FUNCALL (CAR WINDOW) ':KILL)
	 (SETQ WINDOW-EDGE-ALIST (REMQ WINDOW WINDOW-EDGE-ALIST))
	 WINDOW-EDGE-ALIST)
	(T 'ABORT)))

;;; Undoing this won't kill this window, just bury it
(DEFUN SEC-CREATE (SUP WINDOW-EDGE-ALIST)
  (IF (SYSTEM-MENU-CREATE-WINDOW SUP)
      WINDOW-EDGE-ALIST
      'ABORT))

;;; Undoing this won't kill this window, just bury it
(DEFUN SEC-CREATE-EXPAND (SUP WINDOW-EDGE-ALIST)
  (IF (SYSTEM-MENU-CREATE-WINDOW SUP 'EXPAND)
      WINDOW-EDGE-ALIST
      'ABORT))

(DEFUN SEC-EXPOSE (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			"Expose window"
			"Choose a window to be exposed.  Middle aborts."))
	 (SETQ WINDOW-EDGE-ALIST (REMQ WINDOW WINDOW-EDGE-ALIST))
	 (PUSH (SETQ WINDOW (COPYLIST WINDOW)) WINDOW-EDGE-ALIST)
	 (SETF (SECOND WINDOW) T)
	 WINDOW-EDGE-ALIST)
	(T 'ABORT)))

(DEFUN SEC-EXPOSE-MENU (TOP-SHEET WINDOW-EDGE-ALIST &AUX WINDOW ELEM)
  (LET ((LIST (MAPCAN #'(LAMBDA (W)
			  (AND (NOT (MEMQ W (SHEET-EXPOSED-INFERIORS TOP-SHEET)))
			       (NCONS (CONS (OR (AND (GET-HANDLER-FOR
						       W ':NAME-FOR-SELECTION)
						     (FUNCALL W
							      ':NAME-FOR-SELECTION))
						(SHEET-NAME W))
					    W))))
		      (SHEET-INFERIORS TOP-SHEET))))
    (COND ((NULL LIST)
	   (BEEP)
	   (POP-UP-MESSAGE "Error: there are no windows to be exposed.")
	   'ABORT)
	  ((SETQ WINDOW (MENU-CHOOSE LIST "Expose:"))
	   (COND ((SETQ ELEM (ASSQ WINDOW WINDOW-EDGE-ALIST))
		  (SETQ WINDOW-EDGE-ALIST (REMQ ELEM WINDOW-EDGE-ALIST))
		  (SETQ ELEM (COPYLIST ELEM))
		  (SETF (SECOND ELEM) T))
		 (T
		  (SETQ ELEM (LIST* WINDOW T (MULTIPLE-VALUE-LIST
					       (FUNCALL WINDOW ':EDGES))))))
	   (PUSH ELEM WINDOW-EDGE-ALIST)
	   WINDOW-EDGE-ALIST)
	  (T 'ABORT))))

(DEFUN SEC-MOVE-WINDOW (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			"Move window" "Choose a window to be moved.  Middle aborts."))
	 (MULTIPLE-VALUE-BIND (X Y)
	     (MOUSE-SET-WINDOW-POSITION (CAR WINDOW) NIL)
	   (IF X
	       (SETQ WINDOW-EDGE-ALIST (SUBSTQ (LIST (CAR WINDOW) (CADR WINDOW) X Y
						     (+ X (SHEET-WIDTH (CAR WINDOW)))
						     (+ Y (SHEET-HEIGHT (CAR WINDOW))))
					       WINDOW WINDOW-EDGE-ALIST))
	       'ABORT)))
	(T 'ABORT)))

(DEFUN SEC-RESHAPE (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			"Reshape window" "Choose a window to be reshaped.  Middle aborts."))
	 (SETQ WINDOW-EDGE-ALIST
	       (SUBSTQ (LIST* (CAR WINDOW) (CADR WINDOW)
			      (MULTIPLE-VALUE-LIST (MOUSE-SET-WINDOW-SIZE (CAR WINDOW) NIL)))
		       WINDOW WINDOW-EDGE-ALIST))
	 WINDOW-EDGE-ALIST)
	(T 'ABORT)))

(DEFUN SEC-EXPAND-WINDOW (IGNORE WINDOW-EDGE-ALIST &AUX WINDOW)
  (COND ((SETQ WINDOW (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
			"Expand window" "Choose a window to expand.  Middle aborts."))
	 (SETQ WINDOW-EDGE-ALIST
	       (SUBSTQ (LIST* (CAR WINDOW) (CADR WINDOW)
			      (MULTIPLE-VALUE-LIST (EXPAND-WINDOW (CAR WINDOW) NIL)))
		       WINDOW WINDOW-EDGE-ALIST))
	 WINDOW-EDGE-ALIST)
	(T 'ABORT)))

(DEFUN SEC-EXPAND-ALL (TOP-WINDOW WINDOW-EDGE-ALIST &AUX WINDOW-LIST)
  (SETQ WINDOW-LIST (DO ((L WINDOW-EDGE-ALIST (CDR L))
			 (LIST NIL))
			((NULL L) (NREVERSE LIST))
		      (AND (CADAR L)	;Exposed
			   (PUSH (CONS (CAAR L) (APPEND (CDDAR L) (MAKE-LIST NIL 4))) LIST))))
  (EXPAND-WINDOWS-LEFT-AND-RIGHT TOP-WINDOW WINDOW-LIST)
  (EXPAND-WINDOWS-TOP-AND-BOTTOM TOP-WINDOW WINDOW-LIST)
  (NCONC (MAPCAR #'(LAMBDA (ITEM)
		     (LIST (EXPAND-WINDOWS-WINDOW ITEM) T
			   (EXPAND-WINDOWS-LEFT ITEM) (EXPAND-WINDOWS-TOP ITEM)
			   (EXPAND-WINDOWS-RIGHT ITEM) (EXPAND-WINDOWS-BOTTOM ITEM)))
		 WINDOW-LIST)
	 (DO L WINDOW-EDGE-ALIST (CDR L) (NULL L)	;All the de-exposed guys
	     (AND (NULL (CADAR L)) (RETURN L)))))

;Clicking a button other than the left-hand one is the way to punt
;NIL for CHAR means use the default, which you should use unless there
;is a good reason to have a different blinker.
(DEFUN SCREEN-EDITOR-FIND-WINDOW (WINDOW-EDGE-ALIST CHAR PROMPT DOC &AUX X Y WINDOW)
  (OR CHAR (SETQ CHAR 24))  ;Default is the bombsight
  (WITH-MOUSE-GRABBED
    (PROCESS-WAIT "Button up" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
    (MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 0 0 ':ON
				  ':SET-CHARACTER CHAR)
    (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION DOC)
    (PROCESS-WAIT PROMPT #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
    (SETQ X MOUSE-X Y MOUSE-Y)
    (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION NIL)
    (AND (BIT-TEST 1 MOUSE-LAST-BUTTONS)
	 (DOLIST (W WINDOW-EDGE-ALIST)
	   (AND ( X (THIRD W)) ( Y (FOURTH W))
		(< X (FIFTH W)) (< Y (SIXTH W))
		(RETURN (SETQ WINDOW W))))))
  WINDOW)

;;; Get a point within the mouse-sheet from the user.  CHAR is the
;;; character to use; NIL means use the default, which you should use
;;; unless there is a good reason to have a different blinker.
(DEFUN SCREEN-EDITOR-FIND-POINT (CHAR PROMPT DOC &AUX X Y)
  (OR CHAR (SETQ CHAR 24))			;Is this a good default?
  (WITH-MOUSE-GRABBED
    (PROCESS-WAIT "Button up" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
    (MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 0 0 ':ON
				  ':SET-CHARACTER CHAR)
    (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION DOC)
    (PROCESS-WAIT PROMPT #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
    (IF (BIT-TEST 1 MOUSE-LAST-BUTTONS)
	(SETQ X MOUSE-X Y MOUSE-Y)))
  (VALUES X Y))

;;; This should return edges if happy or NIL if unhappy.
(DEFUN MOUSE-SPECIFY-EXPAND (SUPERIOR)
  (MULTIPLE-VALUE-BIND (X Y)
      (SCREEN-EDITOR-FIND-POINT NIL
				"Button" "Choose a point to expand around.  Middle aborts.")
    (COND ((NULL X) NIL)
	  (T (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
		 (EXPAND-RECTANGULAR-AREA SUPERIOR X Y X Y
					  (EXPOSED-INFERIOR-CONTAINING-POINT SUPERIOR X Y))
	       (IF (OR ( RIGHT LEFT)
		       ( BOTTOM TOP))
		   ;; No expansion, return NIL.
		   NIL
		   ;; Worked OK, return the new edges.
		   (VALUES LEFT TOP RIGHT BOTTOM)))))))
  
;;; X, Y are coordinates in SUPERIOR.  If any of SUPERIOR's exposed inferiors
;;; contains X, Y, return it.  Else return NIL.
(DEFUN EXPOSED-INFERIOR-CONTAINING-POINT (SUPERIOR X Y)
  (DOLIST (W (SHEET-EXPOSED-INFERIORS SUPERIOR))
    (IF (SHEET-CONTAINS-SHEET-POINT-P W SUPERIOR X Y)
	(RETURN W))))

;;; Attribute command.

(DEFUN SEC-ATTRIBUTES (IGNORE WINDOW-EDGE-ALIST)
  (LET ((WINDOW
	 (SCREEN-EDITOR-FIND-WINDOW WINDOW-EDGE-ALIST NIL
	     "Attributes" "Choose a window to edit the attributes of.  Middle aborts.")))
    (COND ((NULL WINDOW)
	   'ABORT)
	  (T
	   (SCREEN-EDITOR-EDIT-ATTRIBUTES (CAR WINDOW))
	   WINDOW-EDGE-ALIST))))

(DEFUN MAKE-ATTRIBUTES-LIST (WINDOW BORDERS-P LABEL-P NAME-P)
  `((CURRENT-FONT-VALUE "Current font"
			:DOCUMENTATION
			"Set the current font to one of the fonts in the font map."
			:ASSOC
			,(LOOP FOR FONT BEING THE ARRAY-ELEMENTS
			       OF (FUNCALL WINDOW ':FONT-MAP)
			       WHEN (AND (NOT (NULL FONT))
					 (NOT (MEMBER FONT FONT-LIST)))
			       COLLECT (CONS (FONT-NAME FONT) FONT) INTO ANSWER
			       AND COLLECT FONT INTO FONT-LIST
			       FINALLY (RETURN ANSWER)))
    (MORE-P-VALUE "More processing enabled"
		  :DOCUMENTATION
	  "Enable typing **MORE** and waiting for typein when there is too much typeout."
		  :ASSOC (("Yes" . T) ("No" . NIL)))
    (REVERSE-VIDEO-P "Reverse video"
		     :DOCUMENTATION
		     "Use white characters on a black background in this window."
		     :ASSOC (("Yes" . T) ("No" . NIL)))
    (VSP "Vertical spacing"
	 :DOCUMENTATION
	 "The number of pixels between successive lines of printed text"
	 :NUMBER)
    (IN-ACTION "Deexposed typein action"
	       :DOCUMENTATION
	       "What to do if input is attempted while this window is deexposed."
	       :ASSOC (("Wait until exposed" . :NORMAL) ("Notify user" . :NOTIFY)))
    (OUT-ACTION "Deexposed typeout action"
		:DOCUMENTATION
		"What to do if output is attempted while this window is deexposed."
		:ASSOC (("Wait until exposed" . :NORMAL)
			("Notify user" . :NOTIFY)
			("Let it happen" . :PERMIT)
			("Signal error" . :ERROR)
			("Other" . :OTHER)))
    (OTHER-OUT-ACTION "(/"Other/" value of above)"
		      :DOCUMENTATION
		      "If /"Deexposed typeout action/" is Other, use this form instead."
		      :SEXP)
    (CHAR-ALU-FCN "ALU function for drawing"
		  :DOCUMENTATION
		  "The ALU function for drawing characters and graphics."
		  :ASSOC (("Ones" . ,ALU-IOR) ("Zeroes" . ,ALU-ANDCA)
			  ("Complement" . ,ALU-XOR)))
    (ERASE-ALU-FCN "ALU function for erasing"
		  :DOCUMENTATION
		  "The ALU function for erasing pieces of the window."
		  :ASSOC (("Ones" . ,ALU-IOR) ("Zeroes" . ,ALU-ANDCA)
			  ("Complement" . ,ALU-XOR)))
    (PRIORITY-VALUE "Screen manager priority"
	       :DOCUMENTATION
	       "Set screen manager priority.  NIL is the usual thing."
	       :SEXP)
    (SAVE-BITS-VALUE "Save bits"
		     :DOCUMENTATION
		     "Should the contents of the window be saved away when the window is deexposed?"
		     :ASSOC (("Yes" . T) ("No" . NIL)))
    ,@(COND (NAME-P
	     `((LABEL-OR-NAME "Name of window"
			      :DOCUMENTATION "Set the name of the window"
			      :STRING)))
	    (LABEL-P
	     `((LABEL-OR-NAME "Label"
			      :DOCUMENTATION "Set the label of the window"
			      :STRING))))
    ,@(COND (BORDERS-P
	     `((BORDERS-SPEC "Width of borders"
			     :DOCUMENTATION "Set the widths of the borders"
			     :NUMBER)
	       (BORDER-MARGIN-WIDTH-VALUE
		"Width of border margins"
		:DOCUMENTATION "Set the width of the margin in between the borders and the window contents"
		:NUMBER))))))

(DEFUN SCREEN-EDITOR-EDIT-ATTRIBUTES (WINDOW)
  (LOCAL-DECLARE ((SPECIAL BORDER-MARGIN-WIDTH-VALUE CURRENT-FONT-VALUE MORE-P-VALUE 
			   REVERSE-VIDEO-P BORDERS-SPEC LABEL-OR-NAME VSP IN-ACTION
			   CHAR-ALU-FCN ERASE-ALU-FCN PRIORITY-VALUE SAVE-BITS-VALUE
			   OUT-ACTION OTHER-OUT-ACTION))
    (LET ((BORDERS-P (TYPEP WINDOW 'TV:BORDERS-MIXIN))
	  (LABEL-P (TYPEP WINDOW 'TV:LABEL-MIXIN))
	  (NAME-P (TYPEP WINDOW 'TV:CHANGEABLE-NAME-MIXIN)))
      (LET* ((CURRENT-FONT-VALUE (FUNCALL WINDOW ':CURRENT-FONT))
	     (OLD-CURRENT-FONT-VALUE CURRENT-FONT-VALUE)
	     (MORE-P-VALUE (FUNCALL WINDOW ':MORE-P))
	     (OLD-MORE-P-VALUE MORE-P-VALUE)
	     (REVERSE-VIDEO-P (FUNCALL WINDOW ':REVERSE-VIDEO-P))
	     (OLD-REVERSE-VIDEO-P REVERSE-VIDEO-P)
	     (VSP (FUNCALL WINDOW ':VSP))
	     (OLD-VSP VSP)
	     (IN-ACTION (FUNCALL WINDOW ':DEEXPOSED-TYPEIN-ACTION))
	     (OLD-IN-ACTION IN-ACTION)
	     (OUT-ACTION (FUNCALL WINDOW ':DEEXPOSED-TYPEOUT-ACTION))
	     (OLD-OUT-ACTION OUT-ACTION)
	     (OTHER-OUT-ACTION)
	     (OLD-OTHER-OUT-ACTION)
	     (CHAR-ALU-FCN (FUNCALL WINDOW ':CHAR-ALUF))
	     (OLD-CHAR-ALU-FCN CHAR-ALU-FCN)
	     (ERASE-ALU-FCN (FUNCALL WINDOW ':ERASE-ALUF))
	     (OLD-ERASE-ALU-FCN ERASE-ALU-FCN)
	     (PRIORITY-VALUE (FUNCALL WINDOW ':PRIORITY))
	     (OLD-PRIORITY-VALUE PRIORITY-VALUE)
	     (SAVE-BITS-VALUE (FUNCALL WINDOW ':SAVE-BITS))
	     (OLD-SAVE-BITS-VALUE SAVE-BITS-VALUE)
	     (LABEL-OR-NAME (COND (NAME-P (FUNCALL WINDOW ':NAME))
				  (LABEL-P (FUNCALL WINDOW ':LABEL))))
	     (OLD-LABEL-OR-NAME LABEL-OR-NAME)
	     (BORDERS-SPEC (IF BORDERS-P (FUNCALL WINDOW ':BORDERS)))
	     (OLD-BORDERS-SPEC BORDERS-SPEC)
	     (BORDER-MARGIN-WIDTH-VALUE (IF BORDERS-P (FUNCALL WINDOW ':BORDER-MARGIN-WIDTH)))
	     (OLD-BORDER-MARGIN-WIDTH-VALUE BORDER-MARGIN-WIDTH-VALUE))
	(IF (LISTP BORDERS-SPEC)		;********************
	    (SETQ BORDERS-SPEC (- (FOURTH (FIRST BORDERS-SPEC))
				  (SECOND (FIRST BORDERS-SPEC)))))
	(IF (LISTP LABEL-OR-NAME)
	    (SETQ LABEL-OR-NAME (SIXTH LABEL-OR-NAME)))
	(COND ((NOT (SYMBOLP OUT-ACTION))
	       (SETQ OTHER-OUT-ACTION OUT-ACTION
		     OLD-OTHER-OUT-ACTION OTHER-OUT-ACTION
		     OUT-ACTION ':OTHER
		     OLD-OUT-ACTION OUT-ACTION)))
	(MULTIPLE-VALUE-BIND (NIL ABORT-P)
	    (*CATCH 'ABORT-EDIT
	      (CHOOSE-VARIABLE-VALUES
	       (MAKE-ATTRIBUTES-LIST WINDOW BORDERS-P LABEL-P NAME-P)
	       ':LABEL (FORMAT NIL "Edit window attributes of ~A." WINDOW)
	       ':MARGIN-CHOICES '("Done" ("Abort" (*THROW 'ABORT-EDIT NIL)))
	       ':FUNCTION 'ATTRIBUTE-EDITOR-HOOK))
	  (COND (ABORT-P
		 (BEEP))
		(T
		 (IF (NEQ CURRENT-FONT-VALUE OLD-CURRENT-FONT-VALUE)
		     (FUNCALL WINDOW ':SET-CURRENT-FONT CURRENT-FONT-VALUE))
		 (IF (NEQ MORE-P-VALUE OLD-MORE-P-VALUE)
		     (FUNCALL WINDOW ':SET-MORE-P MORE-P-VALUE))
		 (IF (NEQ REVERSE-VIDEO-P OLD-REVERSE-VIDEO-P)
		     (FUNCALL WINDOW ':SET-REVERSE-VIDEO-P REVERSE-VIDEO-P))
		 (IF (NEQ VSP OLD-VSP)
		     (FUNCALL WINDOW ':SET-VSP VSP))
		 (IF (NEQ IN-ACTION OLD-IN-ACTION)
		     (FUNCALL WINDOW ':SET-DEEXPOSED-TYPEIN-ACTION IN-ACTION))
		 (COND ((NEQ OUT-ACTION OLD-OUT-ACTION)
			(FUNCALL WINDOW ':SET-DEEXPOSED-TYPEOUT-ACTION
				 (IF (EQ OUT-ACTION ':OTHER)
				     OTHER-OUT-ACTION
				     OUT-ACTION)))
		       ((AND (EQ OUT-ACTION ':OTHER)
			     (NEQ OTHER-OUT-ACTION OLD-OTHER-OUT-ACTION))
			(FUNCALL WINDOW ':SET-DEEXPOSED-TYPEOUT-ACTION OTHER-OUT-ACTION)))
		 (IF (NEQ CHAR-ALU-FCN OLD-CHAR-ALU-FCN)
		     (FUNCALL WINDOW ':SET-CHAR-ALUF CHAR-ALU-FCN))
		 (IF (NEQ ERASE-ALU-FCN OLD-ERASE-ALU-FCN)
		     (FUNCALL WINDOW ':SET-ERASE-ALUF ERASE-ALU-FCN))
		 (IF (NEQ PRIORITY-VALUE OLD-PRIORITY-VALUE)
		     (FUNCALL WINDOW ':SET-PRIORITY PRIORITY-VALUE))
		 (IF (NEQ SAVE-BITS-VALUE OLD-SAVE-BITS-VALUE)
		     (FUNCALL WINDOW ':SET-SAVE-BITS SAVE-BITS-VALUE))
		 (IF (NEQ LABEL-OR-NAME OLD-LABEL-OR-NAME)
		     (COND (NAME-P (FUNCALL WINDOW ':SET-NAME LABEL-OR-NAME))
			   (LABEL-P (FUNCALL WINDOW ':SET-LABEL LABEL-OR-NAME))))
		 (COND (BORDERS-P
			(IF (NEQ BORDERS-SPEC OLD-BORDERS-SPEC)
			    (FUNCALL WINDOW ':SET-BORDERS BORDERS-SPEC))
			(IF (NEQ BORDER-MARGIN-WIDTH-VALUE OLD-BORDER-MARGIN-WIDTH-VALUE)
			    (FUNCALL WINDOW ':SET-BORDER-MARGIN-WIDTH
				     BORDER-MARGIN-WIDTH-VALUE))
			)))))))))

(DEFUN ATTRIBUTE-EDITOR-HOOK (WINDOW VARIABLE OLD-VALUE NEW-VALUE)
  OLD-VALUE ;unused
  (LOCAL-DECLARE ((SPECIAL CHAR-ALU-FCN ERASE-ALU-FCN OTHER-OUT-ACTION))
    (COND ((EQ VARIABLE 'REVERSE-VIDEO-P)
	   (COND (NEW-VALUE
		  (SETQ CHAR-ALU-FCN ALU-ANDCA
			ERASE-ALU-FCN ALU-IOR))
		 (T
		  (SETQ CHAR-ALU-FCN ALU-IOR
			ERASE-ALU-FCN ALU-ANDCA)))
	   (FUNCALL WINDOW ':REFRESH)
	   T)
	  ((AND (EQ VARIABLE 'OUT-ACTION) (NEQ NEW-VALUE ':OTHER))
	   (SETQ OTHER-OUT-ACTION NIL)
	   (FUNCALL WINDOW ':REFRESH)
	   T)
	  (T NIL))))

;;; Hairy movement commands
(DEFFLAVOR FOLLOWING-ARROW-BLINKER
	(X-ORIGIN Y-ORIGIN
	 TRI-WIDTH TRI-HEIGHT
	 RECT-WIDTH RECT-HEIGHT
	 STATE)
	(BLINKER)
  (:INITABLE-INSTANCE-VARIABLES X-ORIGIN Y-ORIGIN TRI-WIDTH TRI-HEIGHT
				RECT-WIDTH RECT-HEIGHT))

(DEFMETHOD (FOLLOWING-ARROW-BLINKER :BEFORE :INIT) (IGNORE)
  (SETQ STATE (MAKE-LIST NIL 12.)))

(DEFUN MAKE-FOLLOWING-ARROW-BLINKER (SHEET X-ORIGIN Y-ORIGIN TRI-WIDTH TRI-HEIGHT
					   RECT-WIDTH RECT-HEIGHT
				     &REST OPTIONS)
  (LEXPR-FUNCALL #'MAKE-BLINKER SHEET 'FOLLOWING-ARROW-BLINKER
		 ':X-ORIGIN X-ORIGIN ':Y-ORIGIN Y-ORIGIN
		 ':TRI-WIDTH TRI-WIDTH ':TRI-HEIGHT TRI-HEIGHT
		 ':RECT-WIDTH RECT-WIDTH ':RECT-HEIGHT RECT-HEIGHT
		 OPTIONS))

(DEFMETHOD (FOLLOWING-ARROW-BLINKER :SIZE) ()
  (PROG () (RETURN (MAX TRI-WIDTH RECT-WIDTH)
		   (+ TRI-HEIGHT RECT-HEIGHT))))

(DEFUN SET-FOLLOWING-ARROW-BLINKER-ORIGIN (BLINKER X-ORIGIN Y-ORIGIN)
  (FUNCALL BLINKER ':SET-ORIGIN X-ORIGIN Y-ORIGIN))					   

(DEFMETHOD (FOLLOWING-ARROW-BLINKER :SET-ORIGIN) (NX-ORIGIN NY-ORIGIN)
  (WITHOUT-INTERRUPTS
    (OPEN-BLINKER SELF)
    (SETQ X-ORIGIN NX-ORIGIN Y-ORIGIN NY-ORIGIN)))

(DEFMETHOD (FOLLOWING-ARROW-BLINKER :BLINK) (&AUX X0 Y0 X2 Y2 X3 Y3 X4 Y4 X5 Y5 X6 Y6 X7 Y7)
  (COND ((NOT PHASE)
	 ;;Making it visible, recompute the parameters
	 (LET (DX DY LEN)
	   (SETQ X0 (OR X-ORIGIN X-POS))
	   (SETQ Y0 (OR Y-ORIGIN Y-POS))
	   (SETQ DX (- X-POS X0)
		 DY (- Y-POS Y0)
		 LEN (ISQRT (+ (* DX DX) (* DY DY))))
	   (AND (ZEROP LEN)			;Right on top of where it's pointing
		(COND ((NULL X-ORIGIN)		;Straight up
		       (SETQ DY 1 LEN 1))
		      ((NULL Y-ORIGIN)		;Straight left
		       (SETQ DX 1 LEN 1))
		      (T (SETQ DX 1 DY 1 LEN 1))))	;Top-left corner
	   (SETQ X4 (+ X-POS (// (* DX TRI-HEIGHT) LEN))
		 Y4 (+ Y-POS (// (* DY TRI-HEIGHT) LEN))
		 X6 (+ X-POS (// (* DX (+ TRI-HEIGHT RECT-HEIGHT)) LEN))
		 Y6 (+ Y-POS (// (* DY (+ TRI-HEIGHT RECT-HEIGHT)) LEN)))
	   (LET ((DX1 (// (* TRI-WIDTH DY) LEN))
		 (DY1 (// (* TRI-WIDTH DX) LEN)))
	     (SETQ X2 (- X4 DX1)
		   Y2 (+ Y4 DY1)
		   X3 (+ X4 DX1)
		   Y3 (- Y4 DY1)))
	   (LET ((DX1 (// (* RECT-WIDTH DY) LEN))
		 (DY1 (// (* RECT-WIDTH DX) LEN)))
	     (SETQ X5 (+ X4 DX1)
		   Y5 (- Y4 DY1)
		   X4 (- X4 DX1)
		   Y4 (+ Y4 DY1))
	     (SETQ X7 (+ X6 DX1)
		   Y7 (- Y6 DY1)
		   X6 (- X6 DX1)
		   Y6 (+ Y6 DY1))))
	 (SETF (NTH 0 STATE) X2)
	 (SETF (NTH 1 STATE) Y2)
	 (SETF (NTH 2 STATE) X3)
	 (SETF (NTH 3 STATE) Y3)
	 (SETF (NTH 4 STATE) X4)
	 (SETF (NTH 5 STATE) Y4)
	 (SETF (NTH 6 STATE) X5)
	 (SETF (NTH 7 STATE) Y5)
	 (SETF (NTH 10 STATE) X6)
	 (SETF (NTH 11 STATE) Y6)
	 (SETF (NTH 12 STATE) X7)
	 (SETF (NTH 13 STATE) Y7))
	(T
	 ;;Erasing it, use old parameters
	 (SETQ X2 (NTH 0 STATE))
	 (SETQ Y2 (NTH 1 STATE))
	 (SETQ X3 (NTH 2 STATE))
	 (SETQ Y3 (NTH 3 STATE))
	 (SETQ X4 (NTH 4 STATE))
	 (SETQ Y4 (NTH 5 STATE))
	 (SETQ X5 (NTH 6 STATE))
	 (SETQ Y5 (NTH 7 STATE))
	 (SETQ X6 (NTH 10 STATE))
	 (SETQ Y6 (NTH 11 STATE))
	 (SETQ X7 (NTH 12 STATE))
	 (SETQ Y7 (NTH 13 STATE))))
  (%DRAW-TRIANGLE X-POS Y-POS X2 Y2 X4 Y4 ALU-XOR SHEET)
  (%DRAW-TRIANGLE X-POS Y-POS X4 Y4 X6 Y6 ALU-XOR SHEET)
  (%DRAW-TRIANGLE X-POS Y-POS X6 Y6 X7 Y7 ALU-XOR SHEET)
  (%DRAW-TRIANGLE X-POS Y-POS X7 Y7 X5 Y5 ALU-XOR SHEET)
  (%DRAW-TRIANGLE X-POS Y-POS X5 Y5 X3 Y3 ALU-XOR SHEET))

(DEFFLAVOR MOUSE-FOLLOWING-ARROW-BLINKER () (MOUSE-BLINKER-MIXIN FOLLOWING-ARROW-BLINKER))
(COMPILE-FLAVOR-METHODS MOUSE-FOLLOWING-ARROW-BLINKER)
(MOUSE-DEFINE-BLINKER-TYPE ':FOLLOWING-ARROW
			   #'(LAMBDA (SCREEN)
			       (DEFINE-BLINKER SCREEN 'MOUSE-FOLLOWING-ARROW-BLINKER
				  ':X-ORIGIN 0 ':Y-ORIGIN 0
				  ':TRI-WIDTH 12 ':TRI-HEIGHT 24 ':RECT-WIDTH 4
				  ':RECT-HEIGHT 40 ':VISIBILITY NIL)))

(DEFUN FIND-EDGE-OR-CORNER (WINDOW-EDGE-ALIST DOC-INSIDE DOC-OUTSIDE)
  (PROG KLUDGE ()
    (WITH-MOUSE-GRABBED
     ;; Initialize mouse blinker to small X
     (MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 3 3 ':ON ':SET-CHARACTER 7)
     (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION DOC-OUTSIDE)
     (DO ((MODE ':OUT)
	  (X0) (Y0)
	  (OLD-X MOUSE-LAST-X MOUSE-LAST-X)	;Don't use MOUSE-X, it changes too fast, so
	  (OLD-Y MOUSE-LAST-Y MOUSE-LAST-Y)	;this process runs too much and slows down
	  (WINDOW-AND-EDGES)			;the tracking of the following arrow
	  (NEW-WINDOW-AND-EDGES)
	  (NEW-MODE))
	 (NIL)
       (COND ((SETQ NEW-WINDOW-AND-EDGES (DOLIST (WINDOW-AND-EDGES WINDOW-EDGE-ALIST)
					   (AND ( OLD-X (THIRD WINDOW-AND-EDGES))
						( OLD-Y (FOURTH WINDOW-AND-EDGES))
						(< OLD-X (FIFTH WINDOW-AND-EDGES))
						(< OLD-Y (SIXTH WINDOW-AND-EDGES))
						(RETURN WINDOW-AND-EDGES))))
	      (AND (EQ MODE ':OUT)
		   (WITHOUT-INTERRUPTS
		     (MOUSE-SET-BLINKER ':FOLLOWING-ARROW)
		     (MOUSE-WAKEUP)
		     (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION DOC-INSIDE)))
	      (LET ((LEFT (THIRD NEW-WINDOW-AND-EDGES))
		    (TOP (FOURTH NEW-WINDOW-AND-EDGES))
		    (RIGHT (FIFTH NEW-WINDOW-AND-EDGES))
		    (BOTTOM (SIXTH NEW-WINDOW-AND-EDGES)))
		(LET (LEFT-P TOP-P LEFT-RIGHT-CORNER-P TOP-BOTTOM-CORNER-P)
		  (LET ((ONE-THIRD (// (- RIGHT LEFT) 3)))
		    (SETQ LEFT-RIGHT-CORNER-P
			  (IF (SETQ LEFT-P (< OLD-X (// (+ LEFT RIGHT) 2)))
			      (< OLD-X (+ LEFT ONE-THIRD))
			      (> OLD-X (- RIGHT ONE-THIRD)))))
		  (LET ((ONE-THIRD (// (- BOTTOM TOP) 3)))
		    (SETQ TOP-BOTTOM-CORNER-P
			  (IF (SETQ TOP-P (< OLD-Y (// (+ TOP BOTTOM) 2)))
			      (< OLD-Y (+ TOP ONE-THIRD))
			      (> OLD-Y (- BOTTOM ONE-THIRD)))))
		  (IF (AND LEFT-RIGHT-CORNER-P TOP-BOTTOM-CORNER-P)
		      (SETQ NEW-MODE (IF LEFT-P (IF TOP-P ':TOP-LEFT ':BOTTOM-LEFT)
					 (IF TOP-P ':TOP-RIGHT ':BOTTOM-RIGHT)))
		      (LET ((DX (// (* 100. (IF LEFT-P (- OLD-X LEFT) (- RIGHT OLD-X)))
				    (- RIGHT LEFT)))
			    (DY (// (* 100. (IF TOP-P (- OLD-Y TOP) (- BOTTOM OLD-Y)))
				    (- BOTTOM TOP))))
			(SETQ NEW-MODE (IF (< DX DY) (IF LEFT-P ':LEFT ':RIGHT)
					   (IF TOP-P ':TOP ':BOTTOM))))))
		(COND ((OR (NEQ NEW-WINDOW-AND-EDGES WINDOW-AND-EDGES)
			   (NEQ NEW-MODE MODE))
		       (SETQ X0 (COND ((MEMQ NEW-MODE '(:LEFT :TOP-LEFT :BOTTOM-LEFT))
				       LEFT)
				      ((MEMQ NEW-MODE '(:RIGHT :TOP-RIGHT
							       :BOTTOM-RIGHT))
				       RIGHT)
				      (T
				       NIL)))
		       (SETQ Y0 (COND ((MEMQ NEW-MODE '(:TOP :TOP-LEFT :TOP-RIGHT))
				       TOP)
				      ((MEMQ NEW-MODE '(:BOTTOM :BOTTOM-LEFT
								:BOTTOM-RIGHT))
				       BOTTOM)
				      (T
				       NIL)))
		       (FUNCALL MOUSE-BLINKER ':SET-ORIGIN X0 Y0)
		       (BLINKER-SET-VISIBILITY MOUSE-BLINKER T)
		       (SETQ MODE NEW-MODE
			     WINDOW-AND-EDGES NEW-WINDOW-AND-EDGES)))))
	     ((NEQ MODE ':OUT)			;Not already out
	      (SETQ MODE ':OUT)
	      (WITHOUT-INTERRUPTS
		(MOUSE-SET-BLINKER-DEFINITION ':CHARACTER 3 3 ':ON
					      ':SET-CHARACTER 7)	;Small X
		(MOUSE-WAKEUP)
		(SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION DOC-OUTSIDE))))
       (PROCESS-WAIT "Pick something"
		     #'(LAMBDA (OLD-X OLD-Y)
			 (OR (NOT (ZEROP MOUSE-LAST-BUTTONS))
			     ( MOUSE-LAST-X OLD-X)
			     ( MOUSE-LAST-Y OLD-Y)))
		     OLD-X OLD-Y)
       (OR (ZEROP MOUSE-LAST-BUTTONS)
	   (RETURN-FROM KLUDGE WINDOW-AND-EDGES MODE))))))

;;; Display a set of filled in rectangles
(DEFFLAVOR MULTIPLE-RECTANGLE-BLINKER
	((RECTANGLE-LIST))
	(BLINKER)
  (:INITABLE-INSTANCE-VARIABLES RECTANGLE-LIST))

(DEFMETHOD (MULTIPLE-RECTANGLE-BLINKER :SET-RECTANGLE-LIST) (NEW-RECTANGLE-LIST)
  (WITHOUT-INTERRUPTS
    (OPEN-BLINKER SELF)
    (SETQ RECTANGLE-LIST NEW-RECTANGLE-LIST)))

(DEFMETHOD (MULTIPLE-RECTANGLE-BLINKER :SIZE) ()
  (DO ((RECTS RECTANGLE-LIST (CDR RECTS))
       (RECT)
       (MIN-X0 0) (MIN-Y0 0)
       (MAX-X1 0) (MAX-Y1 0))
      ((NULL RECTS)
       (PROG () (RETURN (- MAX-X1 MIN-X0) (- MAX-Y1 MIN-Y0))))
    (SETQ RECT (CAR RECTS))
    (SETQ MIN-X0 (MIN MIN-X0 (FIRST RECT))
	  MIN-Y0 (MIN MIN-Y0 (SECOND RECT)))
    (SETQ MAX-X1 (MAX MAX-X1 (+ (FIRST RECT) (THIRD RECT)))
	  MAX-Y1 (MAX MAX-Y1 (+ (SECOND RECT) (FOURTH RECT))))))

(DEFMETHOD (MULTIPLE-RECTANGLE-BLINKER :BLINK) ()
  (DOLIST (RECT RECTANGLE-LIST)
    (%DRAW-RECTANGLE-CLIPPED (THIRD RECT) (FOURTH RECT)
			     (+ X-POS (FIRST RECT)) (+ Y-POS (SECOND RECT))
			     ALU-XOR SHEET)))

;;; Rectangle merger, makes an XORable set
(DEFUN ADD-RECT (LIST X Y WIDTH HEIGHT &AUX (RIGHT (+ X WIDTH)) (BOTTOM (+ Y HEIGHT)))
  (DO ((RLIST LIST (CDR RLIST))
       (RECT)
       (RBOTTOM)
       (RRIGHT))
      (NIL)
    (COND ((OR (NULL RLIST)			;If above all others, just add this one
	       (< BOTTOM (SECOND (SETQ RECT (CAR RLIST)))))
	   (PUSH (LIST X Y WIDTH HEIGHT) LIST)
	   (RETURN)))
    (COND ((< Y (SECOND RECT))			;Handle part above all others
	   (COND ((AND (= X (FIRST RECT)) (= WIDTH (THIRD RECT)))
		  (SETF (FOURTH RECT) (- (+ (SECOND RECT) (FOURTH RECT)) Y))
		  (SETF (SECOND RECT) Y)
		  (SETQ Y (+ Y (FOURTH RECT))))
		 (T
		  (PUSH (LIST X Y WIDTH (- (SECOND RECT) Y)) LIST)
		  (SETQ Y (SECOND RECT))))
	   (OR (PLUSP (SETQ HEIGHT (- BOTTOM Y))) (RETURN))))
    (COND ((> Y (SETQ RBOTTOM (+ (SECOND RECT) (FOURTH RECT)))))
	  ((= Y RBOTTOM)			;Can extend to the bottom
	   (COND ((AND (= X (FIRST RECT)) (= WIDTH (THIRD RECT)))
		  (SETF (FOURTH RECT) (- BOTTOM (SECOND RECT)))
		  (RETURN))))
	  (T					;Consider part that overlaps this rectangle
	   (COND ((NOT (OR (< RIGHT (FIRST RECT))
			   (> X (SETQ RRIGHT (+ (FIRST RECT) (THIRD RECT))))))
		  (COND ((OR (< X (FIRST RECT)) (> RIGHT RRIGHT))
			 (COND ((> Y (SECOND RECT))	;Fragment the top
				(PUSH (LIST (FIRST RECT) (SECOND RECT) (THIRD RECT)
					    (- Y (SECOND RECT)))
				      LIST)
				(SETF (SECOND RECT) Y)
				(SETF (FOURTH RECT) (- RBOTTOM Y))))
			 (COND ((< BOTTOM RBOTTOM)	;Fragment the bottom
				(PUSH (LIST (FIRST RECT) BOTTOM (THIRD RECT)
					    (- RBOTTOM BOTTOM))
				      LIST)
				(SETF (FOURTH RECT) (- Y (SECOND RECT)))))))
		  (SETF (FIRST RECT) (MIN X (FIRST RECT)))
		  (SETF (THIRD RECT) (- (MAX RIGHT RRIGHT) (FIRST RECT)))
		  (SETQ Y RBOTTOM)
		  (OR (PLUSP (SETQ HEIGHT (- BOTTOM Y))) (RETURN)))))))
  LIST)

(DEFVAR CORNER-LENGTH 100)			;The length of displayed corners
(DEFVAR EDGE-WIDTH 8)				;The width of displayed edges
		;This width has to be more than twice the width of any borders
		;the user might be trying to move, or it looks really confusing
		;due to the XOR.

;;; Add just the corner of a window
(DEFUN ADD-CORNER (LIST LEFT-P TOP-P LEFT TOP RIGHT BOTTOM)
  (SETQ LIST (ADD-RECT LIST (IF LEFT-P LEFT (- RIGHT CORNER-LENGTH))
		       (IF TOP-P TOP (- BOTTOM EDGE-WIDTH))
		       CORNER-LENGTH EDGE-WIDTH))
  (ADD-RECT LIST (IF LEFT-P LEFT (- RIGHT EDGE-WIDTH))
	    (IF TOP-P TOP (- BOTTOM CORNER-LENGTH))
	    EDGE-WIDTH CORNER-LENGTH))

;;; Add a window's corners or edge to the movement list
;;; ON-P means only turn things on, not off
(DEFUN ADD-MOVING-WINDOW (WINDOW-AND-EDGES EDGE-OR-CORNER WINDOW-MOVEMENT-ALIST
			  &OPTIONAL ON-P &AUX EDGES)
  (OR (SETQ EDGES (ASSQ WINDOW-AND-EDGES WINDOW-MOVEMENT-ALIST))
      (PUSH (SETQ EDGES (LIST WINDOW-AND-EDGES NIL NIL NIL NIL))
	    WINDOW-MOVEMENT-ALIST))
  (SELECTQ EDGE-OR-CORNER
    (:LEFT
     (SETF (SECOND EDGES) (SETQ ON-P (OR (NOT (SECOND EDGES)) ON-P))))
    (:TOP
     (SETF (THIRD EDGES) (SETQ ON-P (OR (NOT (THIRD EDGES)) ON-P))))
    (:RIGHT
     (SETF (FOURTH EDGES) (SETQ ON-P (OR (NOT (FOURTH EDGES)) ON-P))))
    (:BOTTOM
     (SETF (FIFTH EDGES) (SETQ ON-P (OR (NOT (FIFTH EDGES)) ON-P))))
    (:TOP-LEFT
     (SETF (THIRD EDGES) (SETQ ON-P (OR (NOT (AND (SECOND EDGES) (THIRD EDGES))) ON-P)))
     (SETF (SECOND EDGES) ON-P))
    (:TOP-RIGHT
     (SETF (FOURTH EDGES) (SETQ ON-P (OR (NOT (AND (THIRD EDGES) (FOURTH EDGES))) ON-P)))
     (SETF (THIRD EDGES) ON-P))
    (:BOTTOM-LEFT
     (SETF (FIFTH EDGES) (SETQ ON-P (OR (NOT (AND (SECOND EDGES) (FIFTH EDGES))) ON-P)))
     (SETF (SECOND EDGES) ON-P))
    (:BOTTOM-RIGHT
     (SETF (FIFTH EDGES) (SETQ ON-P (OR (NOT (AND (FOURTH EDGES) (FIFTH EDGES))) ON-P)))
     (SETF (FOURTH EDGES) ON-P))
    (:OTHERWISE
     (FERROR NIL "~S invalid edge//corner descriptor." EDGE-OR-CORNER)))
  (PROG () (RETURN WINDOW-MOVEMENT-ALIST ON-P)))

;;; Return the corner or edge of a window associated with another
;;; This could somehow take frames into account, i have no idea how though
(DEFUN ASSOCIATED-CORNER-OR-EDGE (WINDOW-AND-EDGES CORNER-OR-EDGE OTHER-WINDOW-AND-EDGES
				  &AUX LEFT TOP RIGHT BOTTOM
				       OLEFT OTOP ORIGHT OBOTTOM)
  (SETQ LEFT (THIRD WINDOW-AND-EDGES)
	TOP (FOURTH WINDOW-AND-EDGES)
	RIGHT (FIFTH WINDOW-AND-EDGES)
	BOTTOM (SIXTH WINDOW-AND-EDGES)
	OLEFT (THIRD OTHER-WINDOW-AND-EDGES)
	OTOP (FOURTH OTHER-WINDOW-AND-EDGES)
	ORIGHT (FIFTH OTHER-WINDOW-AND-EDGES)
	OBOTTOM (SIXTH OTHER-WINDOW-AND-EDGES))
  (AND (NEQ WINDOW-AND-EDGES OTHER-WINDOW-AND-EDGES)
       (SELECTQ CORNER-OR-EDGE
	 (:LEFT (AND (= LEFT ORIGHT) ( TOP OTOP) ( BOTTOM OBOTTOM) ':RIGHT))
	 (:TOP (AND (= TOP OBOTTOM) ( LEFT OLEFT) ( RIGHT ORIGHT) ':BOTTOM))
	 (:RIGHT (AND (= RIGHT OLEFT) ( TOP OTOP) ( BOTTOM OBOTTOM) ':LEFT))
	 (:BOTTOM (AND (= BOTTOM OTOP) ( LEFT OLEFT) ( RIGHT ORIGHT) ':TOP))
	 (:TOP-LEFT
	  (COND ((= LEFT OLEFT) (AND (= TOP OBOTTOM) ':BOTTOM-LEFT))
		(( LEFT ORIGHT) NIL)
		((= TOP OTOP) ':TOP-RIGHT)
		((= TOP OBOTTOM) ':BOTTOM-RIGHT)))
	 (:TOP-RIGHT
	  (COND ((= RIGHT ORIGHT) (AND (= TOP OBOTTOM) ':BOTTOM-RIGHT))
		(( RIGHT OLEFT) NIL)
		((= TOP OTOP) ':TOP-LEFT)
		((= TOP OBOTTOM) ':BOTTOM-LEFT)))
	 (:BOTTOM-LEFT
	  (COND ((= LEFT OLEFT) (AND (= BOTTOM OTOP) ':TOP-LEFT))
		(( LEFT ORIGHT) NIL)
		((= BOTTOM OBOTTOM) ':BOTTOM-RIGHT)
		((= BOTTOM OTOP) ':TOP-RIGHT)))
	 (:BOTTOM-RIGHT
	  (COND ((= RIGHT ORIGHT) (AND (= BOTTOM OTOP) ':TOP-RIGHT))
		(( RIGHT OLEFT) NIL)
		((= BOTTOM OBOTTOM) ':BOTTOM-LEFT)
		((= BOTTOM OTOP) ':TOP-LEFT))))))

;;; Make the rectangle list for a given list of window movements
(DEFUN CONSTRUCT-MOVEMENT-RECTANGLE-LIST (WINDOW-MOVEMENT-ALIST)
  (DO ((ALIST WINDOW-MOVEMENT-ALIST (CDR ALIST))
       (WINDOW-AND-MOVING-EDGES)
       (LIST NIL)
       (LEFT) (TOP)
       (RIGHT) (BOTTOM))
      ((NULL ALIST)
       LIST)
    (SETQ WINDOW-AND-MOVING-EDGES (CAR ALIST))
    (SETQ LEFT (THIRD (FIRST WINDOW-AND-MOVING-EDGES))
	  TOP (FOURTH (FIRST WINDOW-AND-MOVING-EDGES))
	  RIGHT (FIFTH (FIRST WINDOW-AND-MOVING-EDGES))
	  BOTTOM (SIXTH (FIRST WINDOW-AND-MOVING-EDGES)))
    ;; If there is just one corner, light it up as a corner
    (IF (MEMBER (CDR WINDOW-AND-MOVING-EDGES)
		'((T T NIL NIL) (NIL T T NIL) (NIL NIL T T) (T NIL NIL T)))
	(SETQ LIST (ADD-CORNER LIST
			       (SECOND WINDOW-AND-MOVING-EDGES)
			       (THIRD WINDOW-AND-MOVING-EDGES)
			       LEFT TOP RIGHT BOTTOM))
	(AND (SECOND WINDOW-AND-MOVING-EDGES)	;Left
	     (SETQ LIST (ADD-RECT LIST LEFT TOP EDGE-WIDTH (- BOTTOM TOP))))
	(AND (THIRD WINDOW-AND-MOVING-EDGES)	;Top
	     (SETQ LIST (ADD-RECT LIST LEFT TOP (- RIGHT LEFT) EDGE-WIDTH)))
	(AND (FOURTH WINDOW-AND-MOVING-EDGES)	;Right
	     (SETQ LIST (ADD-RECT LIST (- RIGHT EDGE-WIDTH) TOP EDGE-WIDTH (- BOTTOM TOP))))
	(AND (FIFTH WINDOW-AND-MOVING-EDGES)	;Bottom
	     (SETQ LIST (ADD-RECT LIST LEFT (- BOTTOM EDGE-WIDTH) (- RIGHT LEFT)
				  EDGE-WIDTH))))))

(DEFVAR MULTIPLE-MOVE-BLINKER)
(DEFVAR MULTIPLE-MOVE-RELEASE-TIME 60.)		;1 second hold-down to start moving things
(DEFFLAVOR MOUSE-MULTIPLE-RECTANGLE-BLINKER
	()
	(MOUSE-BLINKER-MIXIN MULTIPLE-RECTANGLE-BLINKER))

(COMPILE-FLAVOR-METHODS MOUSE-MULTIPLE-RECTANGLE-BLINKER)
(MOUSE-DEFINE-BLINKER-TYPE ':MULTIPLE-RECTANGLE
			   #'(LAMBDA (SCREEN)
			       (DEFINE-BLINKER SCREEN 'MOUSE-MULTIPLE-RECTANGLE-BLINKER
						  ':RECTANGLE-LIST NIL ':VISIBILITY NIL
						  ':FOLLOW-P NIL ':X-POS 0 ':Y-POS 0)))

;;; Screen editor multiple moving command
(DEFUN SEC-MULTIPLE-MOVE (TOP-SHEET WINDOW-EDGE-ALIST)
  (INITIALIZE-MULTIPLE-MOVE-BLINKER TOP-SHEET)
  (PROCESS-WAIT "Button up" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
  (WITH-MOUSE-GRABBED
   (UNWIND-PROTECT
    (DO-NAMED ABORT
	((MOVEMENT-LIST NIL)
	 (WINDOW-AND-EDGES) (CORNER-OR-EDGE)
	 (ON-P) (RECTANGLE-LIST))
	(NIL)
      (MULTIPLE-VALUE (WINDOW-AND-EDGES CORNER-OR-EDGE)
	(FIND-EDGE-OR-CORNER WINDOW-EDGE-ALIST
	  "Choose edge or corner.  Middle aborts.  Long click starts moving."
"Move inside a window to choose an edge or corner.  Middle aborts.  Long click starts moving."
         ))
      (AND (BIT-TEST 2 MOUSE-LAST-BUTTONS)	;Middle button aborts
	   (RETURN-FROM ABORT))
      (COND ((EQ CORNER-OR-EDGE ':OUT))		;Click while not pointing at anything
	    ((BIT-TEST 1 MOUSE-LAST-BUTTONS)	;Left button changes things
	     (MULTIPLE-VALUE (MOVEMENT-LIST ON-P)
	       (ADD-MOVING-WINDOW WINDOW-AND-EDGES CORNER-OR-EDGE MOVEMENT-LIST))
	     ;; If we turned things on, also turn on the associated things
	     (AND ON-P
		  (DOLIST (OTHER-WINDOW-AND-EDGES WINDOW-EDGE-ALIST)
		    (LET ((ASSOCIATED-CORNER-OR-EDGE (ASSOCIATED-CORNER-OR-EDGE
						       WINDOW-AND-EDGES CORNER-OR-EDGE
						       OTHER-WINDOW-AND-EDGES)))
		      (AND ASSOCIATED-CORNER-OR-EDGE
			   (SETQ MOVEMENT-LIST (ADD-MOVING-WINDOW OTHER-WINDOW-AND-EDGES
								  ASSOCIATED-CORNER-OR-EDGE
								  MOVEMENT-LIST T))))))
	     (SETQ RECTANGLE-LIST (CONSTRUCT-MOVEMENT-RECTANGLE-LIST MOVEMENT-LIST))
	     (FUNCALL MULTIPLE-MOVE-BLINKER ':SET-RECTANGLE-LIST RECTANGLE-LIST)
	     (PROCESS-WAIT "Button"
			   #'(LAMBDA (TIME)
			       (OR (ZEROP MOUSE-LAST-BUTTONS)
				   (> (TIME-DIFFERENCE (TIME) TIME)
				      MULTIPLE-MOVE-RELEASE-TIME)))
			   (TIME))))
      (COND ((NOT (ZEROP MOUSE-LAST-BUTTONS))	;Still held down (Left or Right)?
	     (AND MOVEMENT-LIST			;Could be nothing to move
		  (SETQ WINDOW-EDGE-ALIST (DO-MULTIPLE-MOVE TOP-SHEET WINDOW-EDGE-ALIST
							    RECTANGLE-LIST MOVEMENT-LIST)))
	     (RETURN T))))
    (BLINKER-SET-VISIBILITY MULTIPLE-MOVE-BLINKER NIL)))
  WINDOW-EDGE-ALIST)

(DEFUN GET-MOVEMENT-DELTA (&AUX (STARTING-X MOUSE-X) (STARTING-Y MOUSE-Y))
  (PROCESS-WAIT "Release" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
  (PROCESS-WAIT "Moving" #'(LAMBDA () (NOT (ZEROP MOUSE-LAST-BUTTONS))))
  (PROG () (RETURN (- MOUSE-X STARTING-X) (- MOUSE-Y STARTING-Y))))

;;; Make an absolute rectangle list relative to its upper-left corner for moving with mouse
(DEFUN RELATIVE-RECTANGLE-LIST (LIST &AUX (MIN-X 177777) (MIN-Y 177777))
  (DOLIST (RECT LIST)
    (SETQ MIN-X (MIN MIN-X (FIRST RECT))
	  MIN-Y (MIN MIN-Y (SECOND RECT))))
  (DOLIST (RECT LIST)
    (SETF (FIRST RECT) (- (FIRST RECT) MIN-X))
    (SETF (SECOND RECT) (- (SECOND RECT) MIN-Y)))
  (PROG () (RETURN MIN-X MIN-Y LIST)))

(DEFUN INITIALIZE-MULTIPLE-MOVE-BLINKER (TOP-SHEET)
  (LET ((BL (MOUSE-GET-BLINKER ':MULTIPLE-RECTANGLE TOP-SHEET)))
    (FUNCALL BL ':SET-RECTANGLE-LIST NIL)
    (FUNCALL BL ':SET-CURSORPOS 0 0)
    (FUNCALL BL ':SET-VISIBILITY T)
    (SETQ MULTIPLE-MOVE-BLINKER BL)))

(DEFUN DO-MULTIPLE-MOVE (TOP-SHEET WINDOW-EDGE-ALIST RECTANGLE-LIST MOVEMENT-LIST)
  (WITH-MOUSE-GRABBED
    (WITHOUT-INTERRUPTS				;Don't spastically appear at the top left,
      (OPEN-BLINKER MULTIPLE-MOVE-BLINKER)	; and open while destructively modifying
      (MULTIPLE-VALUE-BIND (X Y L)		; the blinker's RECTANGLE-LIST.
	  (RELATIVE-RECTANGLE-LIST RECTANGLE-LIST)
	(MOUSE-SET-BLINKER-DEFINITION ':MULTIPLE-RECTANGLE 0 0 T ':SET-RECTANGLE-LIST L)
	(MOUSE-WARP X Y)))
    (SETQ WHO-LINE-MOUSE-GRABBED-DOCUMENTATION "Move edges and corners.  Middle aborts.")
    (DO ((MIN-X (SHEET-INSIDE-LEFT TOP-SHEET))
	 (MAX-X (SHEET-INSIDE-RIGHT TOP-SHEET))
	 (MIN-Y (SHEET-INSIDE-TOP TOP-SHEET))
	 (MAX-Y (SHEET-INSIDE-BOTTOM TOP-SHEET))
	 (NEW-EDGE-ALIST)
	 (DELTA-X) (DELTA-Y))
	(NIL)
      (SETQ NEW-EDGE-ALIST WINDOW-EDGE-ALIST)
      (MULTIPLE-VALUE (DELTA-X DELTA-Y)
	(GET-MOVEMENT-DELTA))
      (IF (BIT-TEST 2 MOUSE-LAST-BUTTONS)	;Middle aborts
	  (RETURN NIL)
	  (IF (DOLIST (MOVE MOVEMENT-LIST)
		(LET ((NEW-EDGES (COPYLIST (CAR MOVE))))
		  (AND (SECOND MOVE)
		       (LET ((NEW-LEFT (+ (THIRD NEW-EDGES) DELTA-X)))
			 (AND (OR (< NEW-LEFT MIN-X) ( NEW-LEFT MAX-X))
			      (RETURN T))
			 (SETF (THIRD NEW-EDGES) NEW-LEFT)))
		  (AND (THIRD MOVE)
		       (LET ((NEW-TOP (+ (FOURTH NEW-EDGES) DELTA-Y)))
			 (AND (OR (< NEW-TOP MIN-Y) ( NEW-TOP MAX-Y))
			      (RETURN T))
			 (SETF (FOURTH NEW-EDGES) NEW-TOP)))
		  (AND (FOURTH MOVE)
		       (LET ((NEW-RIGHT (+ (FIFTH NEW-EDGES) DELTA-X)))
			 (AND (OR (< NEW-RIGHT MIN-X) ( NEW-RIGHT MAX-X))
			      (RETURN T))
			 (SETF (FIFTH NEW-EDGES) NEW-RIGHT)))
		  (AND (FIFTH MOVE)
		       (LET ((NEW-BOTTOM (+ (SIXTH NEW-EDGES) DELTA-Y)))
			 (AND (OR (< NEW-BOTTOM MIN-Y) ( NEW-BOTTOM MAX-Y))
			      (RETURN T))
			 (SETF (SIXTH NEW-EDGES) NEW-BOTTOM)))
		  (SETQ NEW-EDGE-ALIST (SUBSTQ NEW-EDGES (CAR MOVE) NEW-EDGE-ALIST))))
	      (BEEP)				;Something off the screen
	      (SETQ WINDOW-EDGE-ALIST NEW-EDGE-ALIST)		     
	      (RETURN T)))))
  WINDOW-EDGE-ALIST)

(DEFUN SEC-SINGLE-MOVE (TOP-SHEET WINDOW-EDGE-ALIST)
  (INITIALIZE-MULTIPLE-MOVE-BLINKER TOP-SHEET)
  (PROCESS-WAIT "Button up" #'(LAMBDA () (ZEROP MOUSE-LAST-BUTTONS)))
  (WITH-MOUSE-GRABBED
   (UNWIND-PROTECT
     (MULTIPLE-VALUE-BIND (WINDOW-AND-EDGES CORNER-OR-EDGE)
	 (FIND-EDGE-OR-CORNER WINDOW-EDGE-ALIST
	   "Choose an edge or corner.  Middle aborts."
	   "Move inside a window to choose an edge or corner.  Middle aborts.")
       (COND ((NOT (BIT-TEST 6 MOUSE-LAST-BUTTONS))	;Middle or right aborts
	      (LET* ((MOVEMENT-LIST (ADD-MOVING-WINDOW WINDOW-AND-EDGES CORNER-OR-EDGE NIL))
		     (RECTANGLE-LIST (CONSTRUCT-MOVEMENT-RECTANGLE-LIST MOVEMENT-LIST)))
		(SETQ WINDOW-EDGE-ALIST (DO-MULTIPLE-MOVE TOP-SHEET WINDOW-EDGE-ALIST
							  RECTANGLE-LIST MOVEMENT-LIST))))))
    (BLINKER-SET-VISIBILITY MULTIPLE-MOVE-BLINKER NIL)))
  WINDOW-EDGE-ALIST)

(COMPILE-FLAVOR-METHODS MOUSE-FOLLOWING-ARROW-BLINKER MOUSE-BOX-BLINKER)