;;; -*- mode:lisp; package: tv; base: 8; -*- ;;;

;;;  MULTLINE

;;;  This file contains code to implement   multiline menu items in menus.
;;;
;;; Hacked 15 August 1985 Richard Mark Soley for Lambda port



;;;  ****************************************************************
;;;  Necessary Loads, Constants, Declarations.
;;;  ****************************************************************

#+franz (declare (macros t))                 ; Allow macros




;;;  ****************************************************************
;;;  Internal Macros, Structure Definitions, FLAVOR definitions.
;;;  ****************************************************************

(defflavor multiline-item-mixin
	()
	()
  (:required-flavors basic-menu))

(defflavor momentary-multiline-menu
	()
	(multiline-item-mixin momentary-menu))


(defflavor left-multiline-item-mixin
	()
	()
  (:required-flavors multiline-item-mixin))

(defflavor momentary-left-multiline-menu
	()
	(left-multiline-item-mixin multiline-item-mixin momentary-menu))




;;;  ****************************************************************
;;;  User Accessible Code
;;;  ****************************************************************




;;;  ****************************************************************
;;;  Internal Code
;;;  ****************************************************************


;(defwrapper (multiline-item-mixin :set-label)
;	    (label &body body)
;  `(progn ,@body
;	  (send self ':menu-compute-geometry t)))

(defmethod (multiline-item-mixin :after :set-label)
	   (&rest ignore)
  (send self ':menu-compute-geometry t))

;;;  The only difference between this and the original is that here we
;;; compute the  MAXIMUM x excursion, instead of the final one.  This
;;; is important when the string extends over multiple lines.
(DEFMETHOD (multiline-item-mixin :MENU-ITEM-STRING-WIDTH) (ITEM &OPTIONAL STOP-X)
  (MULTIPLE-VALUE-BIND (STRING FONT)
      (MENU-ITEM-STRING ITEM)
    (multiple-value-bind (nil nil max)
	(FUNCALL-SELF ':STRING-LENGTH STRING 0 NIL STOP-X FONT)
      max)))

;;; this works by computing the number of lines in the string (1+ number
;;; of return characters) and returning the product of lines and font-height.
;;;  It's not perfect, but should be close.
(defmethod (multiline-item-mixin :menu-item-string-height) (item &optional stop-x)
  (MULTIPLE-VALUE-BIND (STRING FONT)
      (MENU-ITEM-STRING ITEM)
    font stop-x ; These aren't used.
    (* (1+ (loop for char from 0 to (1- (string-length string))
		 count (= (aref string char) #\return)))
       line-height)))				;(+ 2 (font-raster-height font))

(defmethod (multiline-item-mixin :menu-max-width) (ilist)
  (loop for item in ilist
	maximize (send self ':menu-item-string-width item)))

(defmethod (multiline-item-mixin :menu-max-height) (ilist)
  (loop for item in ilist
	maximize (send self ':menu-item-string-height item)))

#+LMI (defvar set-edges-mode nil)

(DEFMETHOD (multiline-item-mixin :MENU-COMPUTE-GEOMETRY)
	      (DRAW-P &OPTIONAL INSIDE-WIDTH INSIDE-HEIGHT)
  "This function is called whenever something related to the geometry changes.  The menu
is redrawn if DRAW-P is T."
  (COND ((INSTANCE-VARIABLE-BOUNDP ITEM-LIST)  ;Do nothing if item-list not specified yet
	 ;; Get the new N-ROWS and so forth.
	 (SETQ TOP-ROW 0
	       ROW-HEIGHT (send self ':menu-max-height item-list))
	 (MULTIPLE-VALUE (COLUMNS SCREEN-ROWS INSIDE-WIDTH INSIDE-HEIGHT)
	   (send self ':MENU-DEDUCE-PARAMETERS NIL NIL INSIDE-WIDTH INSIDE-HEIGHT NIL NIL))
	 ;; Recompute the row map
	 (MULTIPLE-VALUE (ROW-MAP TOTAL-ROWS)
	   (send self ':MENU-COMPUTE-ROW-MAP INSIDE-WIDTH))
	 (FUNCALL-SELF ':NEW-SCROLL-POSITION TOP-ROW)
	 (SETQ COLUMN-WIDTH
	       (AND (NOT (GEOMETRY-FILL-P GEOMETRY))
		    (// (+ INSIDE-WIDTH MENU-INTERCOLUMN-SPACING) COLUMNS)))
	 (COND ((AND (= INSIDE-HEIGHT (SHEET-INSIDE-HEIGHT))
		     (= INSIDE-WIDTH (SHEET-INSIDE-WIDTH)))
		(AND DRAW-P
		     (SHEET-FORCE-ACCESS (SELF :NO-PREPARE)
		       (FUNCALL-SELF ':MENU-DRAW))))
	       ((send self ':SET-INSIDE-SIZE INSIDE-WIDTH INSIDE-HEIGHT ':VERIFY)
		;; Room to do this in current place.
		(LET-GLOBALLY ((SET-EDGES-MODE T))
		  (send self ':SET-INSIDE-SIZE INSIDE-WIDTH INSIDE-HEIGHT)))
	       (T
		;; Else try to be approximately in the same place
		(LET ((CX (+ X-OFFSET (// WIDTH 2)))
		      (CY (+ Y-OFFSET (// HEIGHT 2))))
		  (WITH-SHEET-DEEXPOSED (SELF)
		    (LET-GLOBALLY ((SET-EDGES-MODE T))
		      (FUNCALL-SELF ':SET-INSIDE-SIZE INSIDE-WIDTH INSIDE-HEIGHT))
		    (CENTER-WINDOW-AROUND SELF CX CY)))))))
  NIL)

(DEFMETHOD (multiline-item-mixin :MOUSE-MOVES) (X Y
				      &AUX ITEM ITEMS ROW XREL BLINKER BLX (BLWIDTH 0)
				           COLN STOP-ITEM
					   (FILL-P (GEOMETRY-FILL-P GEOMETRY)))
  (MOUSE-SET-BLINKER-CURSORPOS)
  (SETQ ROW (// (- Y (SHEET-INSIDE-TOP)) ROW-HEIGHT)
	XREL (- X (SHEET-INSIDE-LEFT))
	BLINKER (CAR BLINKER-LIST))
  (COND ((AND ( XREL 0)	;If inside the menu
	      (< X (SHEET-INSIDE-RIGHT))
	      ( Y (SHEET-INSIDE-TOP))
	      (< Y (SHEET-INSIDE-BOTTOM)))
	 ;;If mouse is past the last displayed row, blink item on that row.
	 (AND (OR (>= (+ TOP-ROW ROW) TOTAL-ROWS) (>= ROW SCREEN-ROWS))
	      (SETQ ROW (1- (MIN SCREEN-ROWS (- TOTAL-ROWS TOP-ROW)))))
	 (IF (MINUSP ROW) (SETQ ITEMS NIL STOP-ITEM NIL)	;No items visible
	     (SETQ ITEMS (AREF ROW-MAP (+ TOP-ROW ROW))
		   STOP-ITEM (AREF ROW-MAP (+ TOP-ROW ROW 1))))
	 (COND (FILL-P				;Fill mode, cogitate
		(SETQ BLX 0)
		(DO ((L ITEMS (CDR L))
		     (ITM) (OITM NIL ITM)
		     (X 0 (+ X
			     (SETQ BLWIDTH (send self ':MENU-ITEM-STRING-WIDTH ITM))
			     MENU-INTERWORD-SPACING)))
		    ((OR (NULL L)
			 (> X XREL))	    ;If this string crosses the mouse, it's the one
		     (SETQ ITEM OITM
			   BLX (1- BLX)
			   BLWIDTH (+ BLWIDTH 1)))
		  (AND (EQ L STOP-ITEM)
		       ;; The next item on next line -- punt
		       (RETURN NIL))
		  (SETQ ITM (CAR L)
			BLX X)))
	       (T				;Columnated, find which column
		(SETQ COLN (// XREL COLUMN-WIDTH))	;Column selected
		(SETQ ITEM (CAR (NTHCDR COLN ITEMS)))	;This may be NIL
		(SETQ BLWIDTH (1+ (send self ':MENU-ITEM-STRING-WIDTH ITEM COLUMN-WIDTH)))
		(SETQ BLX (+ (* COLN COLUMN-WIDTH)	;Start of column
			     -1
			     (MAX 0 (// (- COLUMN-WIDTH	;Centering
					   MENU-INTERCOLUMN-SPACING
					   BLWIDTH)
					2))))))))
  ;; If this item is non-selectable, don't select it.
  (AND (NOT (ATOM ITEM)) (NOT (ATOM (CDR ITEM))) (NOT (ATOM (CDDR ITEM)))
       (EQ (CADR ITEM) ':NO-SELECT)
       (SETQ ITEM NIL))
  ;; Now make the blinker be where and what we have just found it should be.
  (BLINKER-SET-VISIBILITY BLINKER (NOT (NULL ITEM)))
  (SETQ CURRENT-ITEM ITEM)
  (COND (ITEM
	 (FUNCALL BLINKER ':SET-SIZE-AND-CURSORPOS 
		  BLWIDTH row-height ;;;; (+ (FONT-CHAR-HEIGHT (AREF FONT-MAP 0)) 2)
		  BLX (1- (* ROW ROW-HEIGHT))))))

(DEFMETHOD (multiline-item-mixin :MENU-DRAW) (&AUX (FILL-P (GEOMETRY-FILL-P GEOMETRY)))
  ;; Make sure the mouse knows we're changing
  (AND EXPOSED-P (MOUSE-WAKEUP))
  (PREPARE-SHEET (SELF)
    (FUNCALL-SELF ':CLEAR-SCREEN)
    (DO ((ROW TOP-ROW (1+ ROW))
	 (Y-POS 0 (+ Y-POS ROW-HEIGHT))
	 (LIM (MIN TOTAL-ROWS (+ TOP-ROW SCREEN-ROWS))))
	(( ROW LIM))
      (DO ((ITEMS (AREF ROW-MAP ROW) (CDR ITEMS))
	   (END-ITEM-LIST (AREF ROW-MAP (1+ ROW)))
	   (STR) (FONT) (FLAG)
	   (X-POS 0))
	  ((EQ ITEMS END-ITEM-LIST))
	 (MULTIPLE-VALUE (STR FONT)
	   (MENU-ITEM-STRING (CAR ITEMS)))
	 (UNWIND-PROTECT
	   (PROGN
	     (AND (SETQ FLAG (AND (NEQ FONT CURRENT-FONT) CURRENT-FONT))
		  (FUNCALL-SELF ':SET-CURRENT-FONT FONT))
	     (COND (FILL-P			;Filled, put string followed by spacing
		    (FUNCALL-SELF ':SET-CURSORPOS X-POS Y-POS)
		    (FUNCALL-SELF ':STRING-OUT STR)
		    (SETQ X-POS (+ (FUNCALL-SELF ':READ-CURSORPOS) MENU-INTERWORD-SPACING)))
		   (T				;Columnated, center text within column
		    (loop for substring in (get-substrings str)
			  for i from 0 by line-height
			  do (send self ':display-centered-string substring
				   x-pos
				   (- (+ X-POS COLUMN-WIDTH)
				      MENU-INTERCOLUMN-SPACING)
				   (+ y-pos i))
			  finally (setq x-pos (+ x-pos column-width))))))
	   (AND FLAG (FUNCALL-SELF ':SET-CURRENT-FONT FLAG)))))))

;;;  This function returns the list of strings that form the lines in
;;; a multiline item string.
;;;  For example, (get-substrings "FOO<return>BAR") --> ("FOO" "BAR")
(defun get-substrings (string)
  (loop with ptr1 = 0
	for ptr2 = (string-search-char #\return string ptr1)
	collect (substring string ptr1 (if ptr2 ptr2))
	until (null ptr2)
	do (setq ptr1 (1+ ptr2))))


;;;  ****************************************************************
;;;  The following have to be defined to eliminate DEFUN-METHODS.
;;;  ****************************************************************

(DEFMETHOD (multiline-item-mixin :AFTER :INIT) (INIT-PLIST)
  (SETF (BLINKER-VISIBILITY (CAR BLINKER-LIST)) NIL)
  (if (and (instance-variable-boundp item-list) item-list)
      (menu-compute-font-map item-list))
  (send self ':MENU-COMPUTE-GEOMETRY nil)
  (FUNCALL-SELF ':SET-SAVE-BITS (GET INIT-PLIST ':MENU-SAVE-BITS)))

(DEFMETHOD (multiline-item-mixin :AFTER :CHANGE-OF-SIZE-OR-MARGINS) (&REST IGNORE)
  (COND ((EQ SET-EDGES-MODE T))  ;Recursive call, caller will take care of it
	((EQ SET-EDGES-MODE ':USER)
	 ;; Some sort of explicit setting of edges -- make the new size sticky
	 (SETF (GEOMETRY-INSIDE-WIDTH GEOMETRY) (SHEET-INSIDE-WIDTH))
	 (SETF (GEOMETRY-INSIDE-HEIGHT GEOMETRY) (SHEET-INSIDE-HEIGHT))
	 (send self ':MENU-COMPUTE-GEOMETRY NIL))
	((EQ SET-EDGES-MODE NIL)
	 (send self ':MENU-COMPUTE-GEOMETRY NIL))
	(T
	 ;; Some change other than by user or margins or compute geometry -- recompute
	 ;; geometry, use current size, but don't make it sticky.
	 ;; E.g. :MOVE-NEAR-WINDOW
	 (send self ':MENU-COMPUTE-GEOMETRY NIL (SHEET-INSIDE-WIDTH) (SHEET-INSIDE-HEIGHT)))))

(DEFMETHOD (multiline-item-mixin :SET-ITEM-LIST) (NEW-ITEM-LIST)
  (SETQ ITEM-LIST NEW-ITEM-LIST
	LAST-ITEM NIL
	CURRENT-ITEM NIL)
  (send self ':SET-FONT-MAP (MENU-COMPUTE-FONT-MAP NEW-ITEM-LIST))
  #+LMI (setq geometry (list 1 nil nil nil nil nil))
  #+LMI (send self ':MENU-COMPUTE-GEOMETRY nil)
  (send self ':MENU-COMPUTE-GEOMETRY T)		;Recompute parameters, and redraw menu
  NEW-ITEM-LIST)

#+Symbolics
(defmacro local-compute-font-map (item-list font) `(menu-compute-font-map ,item-list ,font))

#+LMI
(defun local-compute-font-map (item-list font)
  (let ((fonts (menu-compute-font-map item-list)))
    (if (memq font fonts) fonts (nconc fonts (list font)))))

(DEFMETHOD (multiline-item-mixin :SET-DEFAULT-FONT) (FONT)
  (FUNCALL-SELF ':SET-FONT-MAP (local-COMPUTE-FONT-MAP ITEM-LIST FONT))
  (send self ':MENU-COMPUTE-GEOMETRY T))

(DEFMETHOD (multiline-item-mixin :SET-GEOMETRY) (&REST NEW-GEOMETRY)
  (DECLARE (ARGLIST (&OPTIONAL N-COLUMNS N-ROWS INSIDE-WIDTH INSIDE-HEIGHT
			       MAX-WIDTH MAX-HEIGHT)))
  "NIL for an argument means make it unconstrained.  T or unsupplied means leave it alone"
  (OR ( (LENGTH NEW-GEOMETRY) (LENGTH GEOMETRY))
      (FERROR NIL "Too many args to :SET-GEOMETRY"))
  (DO ((G NEW-GEOMETRY (CDR G))
       (CG GEOMETRY (CDR CG)))
      ((NULL G))
    (IF (NEQ (CAR G) T)
	(RPLACA CG (CAR G))))
  (send self ':MENU-COMPUTE-GEOMETRY T))

(DEFMETHOD (multiline-item-mixin :MENU-COMPUTE-ROW-MAP)
	   (&OPTIONAL (INSIDE-WIDTH (SHEET-INSIDE-WIDTH))
					       &AUX (MAP (MAKE-ARRAY (1+ (LENGTH ITEM-LIST))))
					       WID
					       (FILL-P (GEOMETRY-FILL-P GEOMETRY)))
  (DO ((ITEMS ITEM-LIST) (ROW 0 (1+ ROW)))
      ((NULL ITEMS)
       (VALUES (ADJUST-ARRAY-SIZE MAP (1+ ROW))  ;Last element always contains NIL
	       ROW))
    (ASET ITEMS MAP ROW)	;This is where this row starts
    (IF FILL-P		;Fill mode, we have some hairy calculation to do
	(DO ((SPACE INSIDE-WIDTH))
	    ((NULL ITEMS))
	  (SETQ WID (send self ':MENU-ITEM-STRING-WIDTH (CAR ITEMS)))
	  (COND ((> WID SPACE)	;This one won't fit, break the line
		 (AND (> WID INSIDE-WIDTH)
		      (FERROR NIL "The item /"~A/" is too wide for this fill-mode menu"
			      (CAR ITEMS)))
		 (RETURN NIL)))
	  (SETQ SPACE (- SPACE (+ WID MENU-INTERWORD-SPACING))
		ITEMS (CDR ITEMS)))
	(SETQ ITEMS (NTHCDR COLUMNS ITEMS)))))

(DEFMETHOD (multiline-item-mixin :ITEM-CURSORPOS) (ITEM &AUX (ALEN (ARRAY-LENGTH ROW-MAP)))
  (DO ((ROW (1- (MIN (+ TOP-ROW SCREEN-ROWS)	;last row on screen
		     ALEN))			;last row that exists
	    (1- ROW)))
      ((< ROW TOP-ROW) NIL)
    (AND (MEMQ ITEM (AREF ROW-MAP ROW))
	 (OR (= ROW (1- ALEN)) (NOT (MEMQ ITEM (AREF ROW-MAP (1+ ROW)))))
	 (RETURN (IF (NOT (GEOMETRY-FILL-P GEOMETRY))
		     (+ (* (FIND-POSITION-IN-LIST ITEM (AREF ROW-MAP ROW)) COLUMN-WIDTH)
			(// COLUMN-WIDTH 2))
		     (DO ((L (AREF ROW-MAP ROW) (CDR L))
			  (XSTART 0 (+ XSTART SWIDTH MENU-INTERWORD-SPACING))
			  (SWIDTH))
			 (NIL)
		       (SETQ SWIDTH (send self ':MENU-ITEM-STRING-WIDTH (CAR L)))
		       (AND (EQ (CAR L) ITEM)
			    (RETURN (+ XSTART (// SWIDTH 2))))))
		 (+ (* (- ROW TOP-ROW) ROW-HEIGHT) (// ROW-HEIGHT 2))))))

(DEFMETHOD (multiline-item-mixin :ITEM-RECTANGLE)
	   (ITEM &AUX (X 0) SWIDTH (ALEN (ARRAY-LENGTH ROW-MAP)))
  (DO ((ROW (1- (MIN (+ TOP-ROW SCREEN-ROWS)	;last row on screen
		     ALEN))			;last row that exists
	    (1- ROW)))
      ((< ROW TOP-ROW) NIL)
    (COND ((AND (MEMQ ITEM (AREF ROW-MAP ROW))
		(OR (= ROW (1- ALEN)) (NOT (MEMQ ITEM (AREF ROW-MAP (1+ ROW))))))
	   (IF (NOT (GEOMETRY-FILL-P GEOMETRY))
	       (SETQ SWIDTH (send self ':MENU-ITEM-STRING-WIDTH ITEM COLUMN-WIDTH)
		     X (+ (* (FIND-POSITION-IN-LIST ITEM (AREF ROW-MAP ROW)) COLUMN-WIDTH)
			  (// (- COLUMN-WIDTH MENU-INTERCOLUMN-SPACING SWIDTH) 2)))
	       (DOLIST (IT (AREF ROW-MAP ROW))
		 (SETQ SWIDTH (send self ':MENU-ITEM-STRING-WIDTH IT))
		 (AND (EQ IT ITEM) (RETURN))
		 (SETQ X (+ X SWIDTH MENU-INTERWORD-SPACING))))
	   (RETURN (1- X) (1- (* (- ROW TOP-ROW) ROW-HEIGHT))
		   (+ X SWIDTH 1) (1- (* (1+ (- ROW TOP-ROW)) ROW-HEIGHT)))))))

(DEFMETHOD (multiline-item-mixin :MENU-DEDUCE-PARAMETERS)
	   (N-COLUMNS N-ROWS INSIDE-WIDTH INSIDE-HEIGHT
		      MAX-WIDTH MAX-HEIGHT
		      &AUX TEM COL-WIDTH
		      (N-ITEMS (LENGTH ITEM-LIST))
		      FILL-P)
  ;; Pick up default constraints from GEOMETRY
  (SETQ N-COLUMNS (OR N-COLUMNS (GEOMETRY-N-COLUMNS GEOMETRY))
	N-ROWS (OR N-ROWS (GEOMETRY-N-ROWS GEOMETRY))
	INSIDE-WIDTH (OR INSIDE-WIDTH (GEOMETRY-INSIDE-WIDTH GEOMETRY))
	INSIDE-HEIGHT (OR INSIDE-HEIGHT (GEOMETRY-INSIDE-HEIGHT GEOMETRY))
	MAX-WIDTH (OR MAX-WIDTH (GEOMETRY-MAX-WIDTH GEOMETRY))
	MAX-HEIGHT (OR MAX-HEIGHT (GEOMETRY-MAX-HEIGHT GEOMETRY)))
  ;; If any of the arguments was :UNCONSTRAINED, that means use NIL
  ;; even if the geometry is non-NIL, whereas if an argument was NIL
  ;; that means use any constraint that is in the geometry.
  (AND (EQ N-COLUMNS ':UNCONSTRAINED) (SETQ N-COLUMNS NIL))
  (AND (EQ N-ROWS ':UNCONSTRAINED) (SETQ N-ROWS NIL))
  (AND (EQ INSIDE-WIDTH ':UNCONSTRAINED) (SETQ INSIDE-WIDTH NIL))
  (AND (EQ INSIDE-HEIGHT ':UNCONSTRAINED) (SETQ INSIDE-HEIGHT NIL))
  (AND (EQ MAX-WIDTH ':UNCONSTRAINED) (SETQ MAX-WIDTH NIL))
  (AND (EQ MAX-HEIGHT ':UNCONSTRAINED) (SETQ MAX-HEIGHT NIL))
  ;; Decide whether it is fill mode or array mode
  (AND (SETQ FILL-P (AND N-COLUMNS (ZEROP N-COLUMNS)))
       (SETQ N-COLUMNS NIL))

  ;; Realize any immediately clear implications
  (AND N-ROWS (NULL INSIDE-HEIGHT) (SETQ INSIDE-HEIGHT (* N-ROWS row-HEIGHT)))
  (AND INSIDE-HEIGHT (NULL N-ROWS) (SETQ N-ROWS (// INSIDE-HEIGHT row-HEIGHT)))
  (SETQ MAX-HEIGHT (MIN (OR INSIDE-HEIGHT MAX-HEIGHT 10000)
			(- (SHEET-INSIDE-HEIGHT SUPERIOR) TOP-MARGIN-SIZE BOTTOM-MARGIN-SIZE))
	MAX-WIDTH (MIN (OR INSIDE-WIDTH MAX-WIDTH 10000)
		       (- (SHEET-INSIDE-WIDTH SUPERIOR) LEFT-MARGIN-SIZE RIGHT-MARGIN-SIZE)))

  ;; Compute the horizontal parameters.
  (COND ((AND INSIDE-WIDTH (OR N-COLUMNS FILL-P)) )		;It's fully-determined
	(INSIDE-WIDTH		;We have the width, and it's not in fill mode, compute
	 (SETQ N-COLUMNS	; N-COLUMNS based on widest item, but always fill the space
	       (MAX (MIN (// (+ INSIDE-WIDTH MENU-INTERCOLUMN-SPACING)
			     (+ (send self ':MENU-MAX-WIDTH ITEM-LIST)
				MENU-INTERCOLUMN-SPACING))
			 (IF N-ROWS (// (+ N-ITEMS (1- N-ROWS)) N-ROWS) N-ITEMS))
		    1)))
	(N-COLUMNS  ;We don't have the width, but do know how many columns, compute width
	 (SETQ INSIDE-WIDTH (MIN (- (* (+ (send self ':MENU-MAX-WIDTH ITEM-LIST)
					  MENU-INTERCOLUMN-SPACING)
				       N-COLUMNS)
				    MENU-INTERCOLUMN-SPACING)
				 MAX-WIDTH)))
	(N-ROWS  ;We know how high, make it wide enough to come out this high
	 (IF FILL-P
	     (SETQ INSIDE-WIDTH (MIN (// (+ (MENU-FILL-WIDTH ITEM-LIST)
					    (1- N-ROWS))
					 N-ROWS)
				     MAX-WIDTH))
	     (SETQ N-COLUMNS (MAX (// (+ N-ITEMS (1- N-ROWS)) N-ROWS) 1)
		   INSIDE-WIDTH (- (* (SETQ COL-WIDTH (+ (send self ':MENU-MAX-WIDTH ITEM-LIST)
							 MENU-INTERCOLUMN-SPACING))
				      N-COLUMNS)
				   MENU-INTERCOLUMN-SPACING))))
	((NOT FILL-P) ;No geometry supplied, pick N-ROWS and N-COLUMNS to make it look nice
		      ;Use the largest number of columns which does not make the ratio
		      ;of height to width less than the Golden ratio
	 (SETQ TEM (* (SETQ COL-WIDTH (send self ':MENU-MAX-WIDTH ITEM-LIST))
                      N-ITEMS
                      row-HEIGHT)
	       COL-WIDTH (+ COL-WIDTH MENU-INTERCOLUMN-SPACING)
	       N-COLUMNS (MAX (// (ISQRT (FIX (// TEM MENU-GOLDEN-RATIO))) COL-WIDTH) 1)
	       INSIDE-WIDTH (- (* COL-WIDTH N-COLUMNS) MENU-INTERCOLUMN-SPACING)))
	(T	;No geometry supplied, and in fill mode, make it like above
	 (SETQ INSIDE-WIDTH (MAX (ISQRT (FIX (// (* (MENU-FILL-WIDTH ITEM-LIST)
						    row-HEIGHT)
						 MENU-GOLDEN-RATIO)))
				 40))))  ;Don't get zero, and don't get absurdly small

  ;; Now figure out the vertical characteristics
  (OR N-ROWS
      (SETQ N-ROWS (IF FILL-P
		       (// (+ (MENU-FILL-WIDTH ITEM-LIST) INSIDE-WIDTH -1) INSIDE-WIDTH)
		       (// (+ N-ITEMS N-COLUMNS -1) N-COLUMNS))))
  (OR INSIDE-HEIGHT (SETQ INSIDE-HEIGHT (* N-ROWS row-HEIGHT)))

  ;; If there is a label, the menu must be at least wide enough to accomodate it
  (LET ((L (FUNCALL-SELF ':SEND-IF-HANDLES ':LABEL-SIZE)))
    (AND L (SETQ INSIDE-WIDTH (MAX INSIDE-WIDTH L))))

  ;; If this came out too high or too wide, retrench
  (AND (> INSIDE-HEIGHT MAX-HEIGHT)
       (SETQ N-ROWS (// MAX-HEIGHT row-HEIGHT)
	     INSIDE-HEIGHT (* N-ROWS row-HEIGHT)))
  (COND ((> INSIDE-WIDTH MAX-WIDTH)
	 (SETQ INSIDE-WIDTH MAX-WIDTH)
	 (AND COL-WIDTH  ;If N-COLUMNS was not user-supplied, recompute it
	      (SETQ N-COLUMNS (MAX (// (+ INSIDE-WIDTH MENU-INTERCOLUMN-SPACING)
				       COL-WIDTH)
				   1)))))

  ;; At this point, INSIDE-WIDTH, INSIDE-HEIGHT, N-COLUMNS (if not FILL-P), and N-ROWS
  ;; are all valid and consistent, and not bigger than the available area,
  ;; provided that the user's original parameters were not illegally huge.

  ;; Return all the dependent parameters as multiple values
  (VALUES (IF FILL-P 0 N-COLUMNS) N-ROWS INSIDE-WIDTH INSIDE-HEIGHT))

(DEFMETHOD (multiline-item-mixin :MOVE-NEAR-WINDOW) (W)
  (MULTIPLE-VALUE-BIND (LEFT TOP RIGHT BOTTOM)
      (FUNCALL W ':EDGES)
    (MULTIPLE-VALUE-BIND (IGNORE IGNORE IGNORE NEW-HEIGHT)
	(send self ':MENU-DEDUCE-PARAMETERS NIL NIL (- RIGHT LEFT) NIL NIL NIL)
      (SETQ NEW-HEIGHT (+ NEW-HEIGHT TOP-MARGIN-SIZE BOTTOM-MARGIN-SIZE))
      ;If it won't fit below try putting it above
      (AND (> (+ BOTTOM NEW-HEIGHT)
	      (SHEET-INSIDE-BOTTOM SUPERIOR))
	   (SETQ BOTTOM (MAX (- TOP NEW-HEIGHT) 0)))
      ;Put it there
      (LET-GLOBALLY ((SET-EDGES-MODE ':MOVE-NEAR))
	(FUNCALL-SELF ':SET-EDGES LEFT BOTTOM RIGHT (+ BOTTOM NEW-HEIGHT)))
      (FUNCALL-SELF ':EXPOSE))))

;;;  ****************************************************************
;;;  Left-multiline-item-mixin
;;;  ****************************************************************

(DEFMETHOD (left-multiline-item-mixin :MENU-DRAW)
	   (&AUX (FILL-P (GEOMETRY-FILL-P GEOMETRY)))
  ;; Make sure the mouse knows we're changing
  (AND EXPOSED-P (MOUSE-WAKEUP))
  (PREPARE-SHEET (SELF)
    (FUNCALL-SELF ':CLEAR-SCREEN)
    (DO ((ROW TOP-ROW (1+ ROW))
	 (Y-POS 0 (+ Y-POS ROW-HEIGHT))
	 (LIM (MIN TOTAL-ROWS (+ TOP-ROW SCREEN-ROWS))))
	(( ROW LIM))
      (DO ((ITEMS (AREF ROW-MAP ROW) (CDR ITEMS))
	   (END-ITEM-LIST (AREF ROW-MAP (1+ ROW)))
	   (STR) (FONT) (FLAG)
	   (X-POS 0))
	  ((EQ ITEMS END-ITEM-LIST))
	 (MULTIPLE-VALUE (STR FONT)
	   (MENU-ITEM-STRING (CAR ITEMS)))
	 (UNWIND-PROTECT
	   (PROGN
	     (AND (SETQ FLAG (AND (NEQ FONT CURRENT-FONT) CURRENT-FONT))
		  (FUNCALL-SELF ':SET-CURRENT-FONT FONT))
	     (COND (FILL-P			;Filled, put string followed by spacing
		    (FUNCALL-SELF ':SET-CURSORPOS X-POS Y-POS)
		    (FUNCALL-SELF ':STRING-OUT STR)
		    (SETQ X-POS (+ (FUNCALL-SELF ':READ-CURSORPOS) MENU-INTERWORD-SPACING)))
		   (T				;Columnated, center text within column
		    (loop for substring in (get-substrings str)
			  for i from 0 by line-height
			  do (send self ':set-cursorpos x-pos (+ y-pos i))
			  do (send self ':string-out substring)
			  finally (setq x-pos (+ x-pos column-width))))))
	   (AND FLAG (FUNCALL-SELF ':SET-CURRENT-FONT FLAG)))))))

(DEFMETHOD (left-multiline-item-mixin :MOUSE-MOVES)
	   (X Y &AUX ITEM ITEMS ROW XREL BLINKER BLX (BLWIDTH 0)
	      COLN STOP-ITEM (FILL-P (GEOMETRY-FILL-P GEOMETRY)))
  (MOUSE-SET-BLINKER-CURSORPOS)
  (SETQ ROW (// (- Y (SHEET-INSIDE-TOP)) ROW-HEIGHT)
	XREL (- X (SHEET-INSIDE-LEFT))
	BLINKER (CAR BLINKER-LIST))
  (COND ((AND ( XREL 0)			;If inside the menu
	      (< X (SHEET-INSIDE-RIGHT))
	      ( Y (SHEET-INSIDE-TOP))
	      (< Y (SHEET-INSIDE-BOTTOM)))
	 ;;If mouse is past the last displayed row, blink item on that row.
	 (AND (OR (>= (+ TOP-ROW ROW) TOTAL-ROWS) (>= ROW SCREEN-ROWS))
	      (SETQ ROW (1- (MIN SCREEN-ROWS (- TOTAL-ROWS TOP-ROW)))))
	 (IF (MINUSP ROW) (SETQ ITEMS NIL STOP-ITEM NIL)	;No items visible
	     (SETQ ITEMS (AREF ROW-MAP (+ TOP-ROW ROW))
		   STOP-ITEM (AREF ROW-MAP (+ TOP-ROW ROW 1))))
	 (COND (FILL-P				;Fill mode, cogitate
		(SETQ BLX 0)
		(DO ((L ITEMS (CDR L))
		     (ITM) (OITM NIL ITM)
		     (X 0 (+ X
			     (SETQ BLWIDTH (send self ':MENU-ITEM-STRING-WIDTH ITM))
			     MENU-INTERWORD-SPACING)))
		    ((OR (NULL L)
			 (> X XREL))		;If this string crosses the mouse, it's the one
		     (SETQ ITEM OITM
			   BLX (1- BLX)
			   BLWIDTH (+ BLWIDTH 1)))
		  (AND (EQ L STOP-ITEM)
		       ;; The next item on next line -- punt
		       (RETURN NIL))
		  (SETQ ITM (CAR L)
			BLX X)))
	       (T				;Columnated, find which column
		(SETQ COLN (// XREL COLUMN-WIDTH))	;Column selected
		(SETQ ITEM (CAR (NTHCDR COLN ITEMS)))	;This may be NIL
		(SETQ BLWIDTH (1+ (send self ':MENU-ITEM-STRING-WIDTH ITEM COLUMN-WIDTH)))
		(SETQ BLX (+ (* COLN COLUMN-WIDTH)	;Start of column
			     -1))))))
  ;; If this item is non-selectable, don't select it.
  (AND (NOT (ATOM ITEM)) (NOT (ATOM (CDR ITEM))) (NOT (ATOM (CDDR ITEM)))
       (EQ (CADR ITEM) ':NO-SELECT)
       (SETQ ITEM NIL))
  ;; Now make the blinker be where and what we have just found it should be.
  (BLINKER-SET-VISIBILITY BLINKER (NOT (NULL ITEM)))
  (SETQ CURRENT-ITEM ITEM)
  (COND (ITEM
	 (FUNCALL BLINKER ':SET-SIZE-AND-CURSORPOS 
		  BLWIDTH row-height ;;;; (+ (FONT-CHAR-HEIGHT (AREF FONT-MAP 0)) 2)
		  BLX (1- (* ROW ROW-HEIGHT))))))