(FILECREATED "15-DEC-83 22:24:12" {IVY}<BOBROW>LISP>MENUPATCH.;7
 17820  

      changes to:  (VARS MENUPATCHCOMS)
		   (FNS DEFAULTWHENSELECTEDFN PROCESS.MENU CLOSE.PROCESS.MENU WAKE.MY.PROCESS 
			NESTED.MENU NESTED.MENU.HANDLER NESTED.SUBMENU)

      previous date: "13-DEC-83 21:34:46" {IVY}<BOBROW>LISP>MENUPATCH.;4)


(PRETTYCOMPRINT MENUPATCHCOMS)

(RPAQQ MENUPATCHCOMS
 ((* Nested Menus which pop up when one moves right)
		      (FNS CLOSE.PROCESS.MENU DEFAULTSUBITEMFN DEFAULTWHENSELECTEDFN GETMENUPROP 
			   NESTED.MENU NESTED.MENU.HANDLER NESTED.SUBMENU NESTED.SUBMENU.POS 
			   PROCESS.MENU PUTMENUPROP WAKE.MY.PROCESS \INVERTITEM)
		      (MACROS MENU.HELDSTATE.RESET)
		      (RECORDS MENU)))



(* Nested Menus which pop up when one moves right)


(DEFINEQ

(CLOSE.PROCESS.MENU

  [LAMBDA (WINDOW)                                           (* dgb: "15-DEC-83 19:18")

    (WAKE.PROCESS (WINDOWPROP WINDOW (QUOTE MENUPROCESS))
		  T])

(DEFAULTSUBITEMFN

  [LAMBDA (MENU ITEM)                                        (* dgb: "13-DEC-83 17:56")

                                                             (* default subitemfn for menus.

							     Checks the fourth element of the item.)

    (AND (LISTP ITEM)
	 (LISTP (CADDDR ITEM])

(DEFAULTWHENSELECTEDFN

  [LAMBDA (ITEM FROMMENU BUTTON)                             (* dgb: "15-DEC-83 20:24")

                                                             (* default Menu handler)

    (COND
      [(LISTP ITEM)
	(COND
	  ((CAR (LISTP (CDR ITEM)))
	    (STKEVAL (OR (STKPOS (QUOTE MENU))
			 (STKPOS (QUOTE MENUBUTTONFN))
			 -1)
		     (CADR ITEM)
		     T))
	  (T (CAR ITEM]
      (T ITEM])

(GETMENUPROP

  [LAMBDA (MENU PROPERTY)                                    (* dgb: "13-DEC-83 17:50")

    (LISTGET (fetch
 (MENU MENUUSERDATA) of
 MENU)
	     PROPERTY])

(NESTED.MENU

  [LAMBDA (MENU POSITION NESTEDFLG)                          (* dgb: "13-DEC-83 19:00")

    (DECLARE
 (LOCALVARS . T))                                (* puts a menu on the screen and waits for the user to 

							     select one of the items)

    (OR (TYPENAMEP MENU (QUOTE MENU))
	(\ILLEGAL.ARG MENU))
    (PROG (IMAGE MX MY)                                      (* make sure the image is a window)

          (CHECK/MENU/IMAGE MENU T)
          (SETQ IMAGE (fetch
 (MENU IMAGE) of
 MENU))
          (COND
	    ((AND (OR POSITION (SETQ POSITION (fetch
 (MENU MENUPOSITION) of
 MENU)))
		  (FIXP (fetch
 XCOORD of
 POSITION))
		  (FIXP (fetch
 YCOORD of
 POSITION)))
	      (SETQ MX (fetch
 XCOORD of
 POSITION))
	      (SETQ MY (fetch
 YCOORD of
 POSITION)))
	    (T (GETMOUSESTATE)
	       (SETQ MX LASTMOUSEX)
	       (SETQ MY LASTMOUSEY)))
          [SETQ MX (IDIFFERENCE MX (fetch
 XCOORD of
 (fetch
 MENUOFFSET of
 MENU]
          [SETQ MY (IDIFFERENCE MY (fetch
 YCOORD of
 (fetch
 MENUOFFSET of
 MENU]
                                                             (* Adjust the position so that the menu will be entirely

							     on the screen.)

          (PROGN                                             (* do left margin first so that if the menu is wider 

							     than the screen, the left most part of it will be shown)

		 (SETQ MX (IMAX (IMIN MX (IDIFFERENCE SCREENWIDTH (fetch
 (MENU IMAGEWIDTH)
								     of
 MENU)))
				0)))
          [PROGN                                             (* do the bottom margin first so that the top of the 

							     menu will show if the menu is higher than the a screen)

		 (SETQ MY (IMIN (IMAX MY 0)
				(IDIFFERENCE SCREENHEIGHT (fetch
 (MENU IMAGEHEIGHT) of
 MENU]
          (MOVEW IMAGE (create
 POSITION
			       XCOORD ← MX
			       YCOORD ← MY))
          (SETQ MX (RESETLST (RESETSAVE (OPENW IMAGE)
					(LIST (QUOTE CLOSEW)
					      IMAGE))
			     (until
 (MOUSESTATE (OR LEFT RIGHT MIDDLE)) do
 
                                                             (* Wait for a mouse button)
)
			     (NESTED.MENU.HANDLER
 MENU (WINDOWPROP IMAGE (QUOTE DSP))
						  MX MY NESTEDFLG)))
                                                             (* evaluate menu form after image has been taken down.)

          (RETURN (COND
		    (NESTEDFLG MX)
		    (T (DOSELECTEDITEM MENU (CAR MX)
				       (CDR MX])

(NESTED.MENU.HANDLER

  [LAMBDA (MENU DSP MX MY NESTEDFLG)                         (* dgb: "15-DEC-83 09:01")

                                                             (* handles details of watching mouse for menus.)

    (bind
 ITEM SUBITEMS SUBMENURESULT OLDBOXX OLDBOXY BOXX BOXY HELDSTATE (MOVEDLEFT ← "NESTED")
	  (LASTBUTTONSTATE ← LASTMOUSEBUTTONS)
	  (MGRIDSPEC ←(fetch
 (MENU MENUGRID) of
 MENU))
	  (HOLDBEGTIME ←(CLOCK 0))
	  (HELDFN ←(fetch
 (MENU WHENHELDFN) of
 MENU)) until
 (MOUSESTATE UP)
       do
 [[COND
	     [(AND (STRICTLY/BETWEEN (SETQ BOXX (GRIDXCOORD (LASTMOUSEX DSP)
							    MGRIDSPEC))
				     -1
				     (fetch
 (MENU MENUCOLUMNS) of
 MENU))
		   (STRICTLY/BETWEEN (SETQ BOXY (GRIDYCOORD (LASTMOUSEY DSP)
							    MGRIDSPEC))
				     -1
				     (fetch
 (MENU MENUROWS) of
 MENU)))
                                                             (* BOXX and BOXY hold the number of the box pointed at.)

	       (COND
		 ((OR (NEQ BOXX OLDBOXX)
		      (NEQ BOXY OLDBOXY))                    (* selected item has changed.)

                                                             (* uninvert old item if there was one.)

		   [COND
		     (OLDBOXX (\INVERTITEM
 OLDBOXX OLDBOXY MENU DSP)
			      (MENU.HELDSTATE.RESET OLDBOXX OLDBOXY))
		     (T (SETQ HOLDBEGTIME (CLOCK0 HOLDBEGTIME]
                                                             (* invert new item)

		   (\INVERTITEM
 BOXX BOXY MENU DSP)
		   (SETQ OLDBOXX BOXX)
		   (SETQ OLDBOXY BOXY))
		 ((AND HELDFN (NULL HELDSTATE)
		       (IGREATERP (CLOCKDIFFERENCE HOLDBEGTIME)
				  MENUHELDWAIT))             (* same button in same region for MENUHELDWAIT 

							     milliseconds.)

		   (APPLY* HELDFN (GETMENUITEM MENU OLDBOXX OLDBOXY)
			   MENU
			   (\FDECODE/BUTTON LASTBUTTONSTATE))
		   (SETQ HELDSTATE T]
	     (T                                              (* cursor moved outside of the menu.)

		(COND
		  (OLDBOXX                                   (* OLDBOXX denotes item inverted.)

			   (COND
			     ((AND (IGREATERP BOXX 0)
				   (SETQ ITEM (GETMENUITEM MENU OLDBOXX OLDBOXY))
				   (SETQ SUBITEMS (APPLY* (OR (fetch
 (MENU SUBITEMFN) of
 MENU)
							      (FUNCTION DEFAULTSUBITEMFN))
							  MENU ITEM)))
                                                             (* There are subitems to be displayed)

			       (SETQ SUBMENURESULT (NESTED.MENU
 (NESTED.SUBMENU
 MENU SUBITEMS)
								(NESTED.SUBMENU.POS
 MENU ITEM MX MY)
								T))
			       (COND
				 ((NEQ SUBMENURESULT MOVEDLEFT)
                                                             (* selected something from submenu)

				   (\INVERTITEM
 OLDBOXX OLDBOXY MENU DSP)
				   (MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
				   (SETQ OLDBOXX)
				   (GO OUT)))
			       (SETQ SUBMENURESULT NIL)))
			   (\INVERTITEM
 OLDBOXX OLDBOXY MENU DSP)
			   (MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)
			   (SETQ OLDBOXX)))                  (* if this is a nested call and the cursor rolled out to

							     the left, return the special pointer.)

		(AND NESTEDFLG (IGREATERP 0 BOXX)
		     (RETURN MOVEDLEFT]
	   (COND
	     ((NEQ LASTBUTTONSTATE (SETQ LASTBUTTONSTATE LASTMOUSEBUTTONS))
                                                             (* reset held timer)

	       (MENU.HELDSTATE.RESET OLDBOXX OLDBOXX]
       finally
                                               (* turn off inverse image. and call whenunheldfn is 

							     necessary.)

	       OUT
	       [COND
		 (OLDBOXX [SELECTQ (fetch
 (MENU CHANGEOFFSETFLG) of
 MENU)
				   ((Y NIL))
				   (replace
 (POSITION XCOORD) of
 (fetch
 (MENU MENUOFFSET)
								    of
 MENU)
				      with
 (IDIFFERENCE (LASTMOUSEX DSP)
							(fetch
 (REGION LEFT) of
 MGRIDSPEC]
			  (SELECTQ (fetch
 (MENU CHANGEOFFSETFLG) of
 MENU)
				   ((X NIL))
				   (replace
 (POSITION YCOORD) of
 (fetch
 (MENU MENUOFFSET)
								    of
 MENU)
				      with
 (IDIFFERENCE (LASTMOUSEY DSP)
							(fetch
 (REGION BOTTOM) of
 MGRIDSPEC]
	       (COND
		 (OLDBOXX (\INVERTITEM
 OLDBOXX OLDBOXY MENU DSP)
			  (MENU.HELDSTATE.RESET OLDBOXX OLDBOXY)))
                                                             (* if called for, change the menu offset so the menu 

							     will come up in the same place relative to the cursor 

							     next time.)

	       (RETURN (COND
			 (SUBMENURESULT)
			 (OLDBOXX (SETQ ITEM (GETMENUITEM MENU OLDBOXX OLDBOXY))
				  (CONS ITEM (\FDECODE/BUTTON LASTBUTTONSTATE])

(NESTED.SUBMENU

  [LAMBDA (MENU SUBITEMS)                                    (* dgb: "15-DEC-83 08:24")

                                                             (* computes and returns the nested submenu for SUBITEMS.

							     It maintains a cache on the MENUUSERDATA)

    (PROG [SUBMENU (SUBMENULST (GETMENUPROP
 MENU (QUOTE SUBMENUS]
          [COND
	    ([NULL (SETQ SUBMENU (CDR (FASSOC SUBITEMS SUBMENULST]
                                                             (* Cache submenu on user data)

	      (PUTMENUPROP
 MENU (QUOTE SUBMENUS)
			   (CONS [CONS SUBITEMS (SETQ SUBMENU
					 (create
 MENU
						 ITEMS ← SUBITEMS
						 MENUOFFSET ←(create
 POSITION
								     XCOORD ← 1
								     YCOORD ← 5)
						 CHANGEOFFSETFLG ←(QUOTE Y)
						 CENTERFLG ←(fetch
 (MENU CENTERFLG) of
 MENU)
						 MENUFONT ←(fetch
 (MENU MENUFONT) of
 MENU)
						 MENUBORDERSIZE ←(fetch
 (MENU MENUBORDERSIZE)
								    of
 MENU)
						 MENUOUTLINESIZE ←(fetch
 (MENU MENUOUTLINESIZE)
								     of
 MENU)
						 WHENHELDFN ←(fetch
 (MENU WHENHELDFN) of
 MENU)
						 WHENUNHELDFN ←(fetch
 (MENU WHENUNHELDFN)
								  of
 MENU)
						 SUBITEMFN ←(fetch
 (MENU SUBITEMFN) of
 MENU]
				 SUBMENULST]
          (RETURN SUBMENU])

(NESTED.SUBMENU.POS

  [LAMBDA (IMENU ITEM MX MY)                                 (* dgb: "13-DEC-83 18:49")

                                                             (* return the position of a nested submenu should have.)

    (PROG (ITEMNUMBER (ITEMS (fetch
 (MENU ITEMS) of
 IMENU))
		      (GRIDSPEC (fetch
 (MENU MENUGRID) of
 IMENU))
		      (BORDER (fetch
 (MENU MENUBORDERSIZE) of
 IMENU)))
          [SETQ ITEMNUMBER (IDIFFERENCE (LENGTH ITEMS)
					(LENGTH (OR (FMEMB ITEM ITEMS)
						    (for
 ITEMTAIL on
 ITEMS
						       when
 (EQ (CAAR ITEMTAIL)
								ITEM)
						       do
 (RETURN ITEMTAIL))
						    (RETURN]
          (RETURN (create
 POSITION
			  XCOORD ←(IPLUS MX (fetch
 (REGION LEFT) of
 GRIDSPEC)
					 (ITIMES (IREMAINDER ITEMNUMBER (fetch
 (MENU MENUCOLUMNS)
									   of
 IMENU))
						 (fetch
 (REGION WIDTH) of
 GRIDSPEC))
					 (IDIFFERENCE (fetch
 (REGION WIDTH) of
 GRIDSPEC)
						      (ITIMES 2 BORDER)))
			  YCOORD ←(IPLUS MY (ITIMES -2 BORDER)
					 (fetch
 (REGION BOTTOM) of
 GRIDSPEC)
					 (ITIMES [SUB1 (IDIFFERENCE (fetch
 (MENU MENUROWS)
								       of
 IMENU)
								    (IQUOTIENT ITEMNUMBER
									       (fetch
 (MENU 
										      MENUCOLUMNS)
										  of
 IMENU]
						 (fetch
 (REGION HEIGHT) of
 GRIDSPEC])

(PROCESS.MENU

  [LAMBDA (MENU POSITION)                                    (* dgb: "15-DEC-83 19:20")

    (DECLARE
 (LOCALVARS . T))                                (* puts a menu on the screen and waits for the user to 

							     select one of the items)

    (OR (TYPENAMEP MENU (QUOTE MENU))
	(\ILLEGAL.ARG MENU))
    (PROG (IMAGE MX MY)                                      (* make sure the image is a window)

          (CHECK/MENU/IMAGE MENU T)
          (SETQ IMAGE (fetch
 (MENU IMAGE) of
 MENU))
          (COND
	    ((AND (OR POSITION (SETQ POSITION (fetch
 (MENU MENUPOSITION) of
 MENU)))
		  (FIXP (fetch
 XCOORD of
 POSITION))
		  (FIXP (fetch
 YCOORD of
 POSITION)))
	      (SETQ MX (fetch
 XCOORD of
 POSITION))
	      (SETQ MY (fetch
 YCOORD of
 POSITION)))
	    (T (GETMOUSESTATE)
	       (SETQ MX LASTMOUSEX)
	       (SETQ MY LASTMOUSEY)))
          [SETQ MX (IDIFFERENCE MX (fetch
 XCOORD of
 (fetch
 MENUOFFSET of
 MENU]
          [SETQ MY (IDIFFERENCE MY (fetch
 YCOORD of
 (fetch
 MENUOFFSET of
 MENU]
                                                             (* Adjust the position so that the menu will be entirely

							     on the screen.)

          (PROGN                                             (* do left margin first so that if the menu is wider 

							     than the screen, the left most part of it will be shown)

		 (SETQ MX (IMAX (IMIN MX (IDIFFERENCE SCREENWIDTH (fetch
 (MENU IMAGEWIDTH)
								     of
 MENU)))
				0)))
          [PROGN                                             (* do the bottom margin first so that the top of the 

							     menu will show if the menu is higher than the a screen)

		 (SETQ MY (IMIN (IMAX MY 0)
				(IDIFFERENCE SCREENHEIGHT (fetch
 (MENU IMAGEHEIGHT) of
 MENU]
          (MOVEW IMAGE (create
 POSITION
			       XCOORD ← MX
			       YCOORD ← MY))
          [SETQ MX (RESETLST (RESETSAVE (OPENW IMAGE)
					(LIST (QUOTE CLOSEW)
					      IMAGE))
			     (PROG (MVAL)
			           (WINDOWPROP IMAGE (QUOTE MENUPROCESS)
					       (THIS.PROCESS))
			           (WINDOWPROP IMAGE (QUOTE CLOSEFN)
					       (QUOTE CLOSE.PROCESS.MENU))
			           (WINDOWPROP IMAGE (QUOTE BUTTONEVENTFN)
					       (QUOTE WAKE.MY.PROCESS))
			       LP  (OR (NEQ T (SETQ MVAL (BLOCK T)))
				       (RETURN NIL))
			           (GETMOUSESTATE)           (* IF mouse state is up, then someone came into the 

							     window with the mouse down. Ignore it.)

			           (OR (MOUSESTATE (OR LEFT RIGHT MIDDLE))
				       (GO LP))              (* MVAL will be NIL only if the user clicked up outside 

							     the window)

			           (OR (SETQ MVAL (NESTED.MENU.HANDLER
 MENU (WINDOWPROP IMAGE
											(QUOTE DSP))
								       MX MY))
				       (GO LP))
			           (RETURN MVAL]             (* evaluate menu form after image has been taken down.)

          (RETURN (DOSELECTEDITEM MENU (CAR MX)
				  (CDR MX])

(PUTMENUPROP

  [LAMBDA (MENU PROPERTY VALUE)                              (* dgb: "13-DEC-83 17:52")

    (PROG ((NOWDATA (fetch
 (MENU MENUUSERDATA) of
 MENU)))
          [COND
	    (NOWDATA (LISTPUT NOWDATA PROPERTY VALUE))
	    (T (replace
 (MENU MENUUSERDATA) of
 MENU with
 (LIST PROPERTY VALUE]
          (RETURN VALUE])

(WAKE.MY.PROCESS

  [LAMBDA (WINDOW)                                           (* dgb: "15-DEC-83 19:09")

    (WAKE.PROCESS (WINDOWPROP WINDOW (QUOTE MENUPROCESS))
		  "ABC"])

(\INVERTITEM

  [LAMBDA (COLUMN ROW MENU DSP)                              (* dgb: "13-DEC-83 18:06")

                                                             (* inverts an item in a menu displayed in DSP.)

    (SHADEGRIDBOX COLUMN ROW BLACKSHADE (QUOTE INVERT)
		  (fetch
 (MENU MENUGRID) of
 MENU)
		  (fetch
 (MENU MENUBORDERSIZE) of
 MENU)
		  DSP])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS MENU.HELDSTATE.RESET MACRO
 ((BX BY)
				      [COND
					(HELDSTATE (COND
						     ((SETQ HELDSTATE (fetch
 (MENU WHENUNHELDFN)
									 of
 MENU))
						       (APPLY* HELDSTATE (GETMENUITEM MENU BX BY)
							       MENU
							       (\FDECODE/BUTTON LASTBUTTONSTATE))
						       (SETQ HELDSTATE NIL]
				      (SETQ HOLDBEGTIME (CLOCK0 HOLDBEGTIME))))
)
[DECLARE: EVAL@COMPILE 

(DATATYPE MENU
 (IMAGE SAVEIMAGE ITEMS MENUROWS MENUCOLUMNS MENUGRID CENTERFLG CHANGEOFFSETFLG 
		      MENUFONT TITLE MENUOFFSET WHENSELECTEDFN MENUBORDERSIZE MENUOUTLINESIZE 
		      WHENHELDFN MENUPOSITION WHENUNHELDFN MENUUSERDATA)
	  MENUGRID ←(create
 REGION
			    LEFT ← 0
			    BOTTOM ← 0)
	  WHENHELDFN ←(QUOTE DEFAULTMENUHELDFN)
	  WHENUNHELDFN ←(QUOTE CLRPROMPT)
	  [ACCESSFNS ((ITEMWIDTH (fetch
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID) of
 DATUM))
				 (replace
 (REGION WIDTH) of
 (fetch
 (MENU MENUGRID) of
 DATUM)
				    with
 NEWVALUE))
		      (ITEMHEIGHT (fetch
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID) of
 DATUM))
				  (replace
 (REGION HEIGHT) of
 (fetch
 (MENU MENUGRID) of
 DATUM)
				     with
 NEWVALUE))
		      (IMAGEWIDTH (fetch
 (BITMAP BITMAPWIDTH) of
 (CHECK/MENU/IMAGE DATUM)))
		      (IMAGEHEIGHT (fetch
 (BITMAP BITMAPHEIGHT) of
 (CHECK/MENU/IMAGE DATUM)))
		      (MENUREGIONLEFT (IDIFFERENCE (fetch
 (REGION LEFT) of
 (fetch
 (MENU MENUGRID)
									      of
 DATUM))
						   (fetch
 MENUOUTLINESIZE of
 DATUM)))
		      (MENUREGIONBOTTOM (IDIFFERENCE (fetch
 (REGION BOTTOM)
							of
 (fetch
 (MENU MENUGRID) of
 DATUM))
						     (fetch
 MENUOUTLINESIZE of
 DATUM)))
		      (SUBITEMFN (GETMENUPROP DATUM (QUOTE SUBITEMFN))
				 (PUTMENUPROP DATUM (QUOTE SUBITEMFN)
					      NEWVALUE])
]
(/DECLAREDATATYPE (QUOTE MENU)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER 
				  POINTER)))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (775 15710 (CLOSE.PROCESS.MENU 785 . 966) (DEFAULTSUBITEMFN 968 . 1280) (
DEFAULTWHENSELECTEDFN 1282 . 1701) (GETMENUPROP 1703 . 1885) (NESTED.MENU 1887 . 4417) (
NESTED.MENU.HANDLER 4419 . 9058) (NESTED.SUBMENU 9060 . 10371) (NESTED.SUBMENU.POS 10373 . 11748) (
PROCESS.MENU 11750 . 14792) (PUTMENUPROP 14794 . 15142) (WAKE.MY.PROCESS 15144 . 15326) (\INVERTITEM 
15328 . 15708)))))
STOP