(FILECREATED "23-SEP-83 18:24:58" {PHYLUM}<LISPUSERS>MENUEDWINDOW.;6 20020
changes to: (FNS MENUEDWINDOWCLOSEFN)
previous date: "12-APR-83 14:46:51" {PHYLUM}<LISPUSERS>MENUEDWINDOW.;5)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT MENUEDWINDOWCOMS)
(RPAQQ MENUEDWINDOWCOMS ((* This file contains a set of functions that allow the user to treate a
main window and an associated menu as a single unit. The pair can be
MOVED RESHAPED CLOSED etc. as if it was a single entity. The menu can be
position above, below or on either side of the main window. The user has
the option of specifying the location and size of the main window.
Various heuristics are applied to make sure that the result is large
enoght to display the menu and window titles)
(FNS MAKEMENUEDWINDOW MOVEMENUWINDOW RESHAPEMENUEDWINDOW
GETREGIONFORMENUEDWINDOW MAKEMENUWINDOW MENUEDWINDOWTOTOPFN
MENUEDWINDOWCLOSEFN MENUEDWINDOWOPENFN)))
(* This file contains a set of functions that allow the user to treate a main window and an
associated menu as a single unit. The pair can be MOVED RESHAPED CLOSED etc. as if it was a
single entity. The menu can be position above, below or on either side of the main window. The
user has the option of specifying the location and size of the main window. Various heuristics
are applied to make sure that the result is large enoght to display the menu and window titles)
(DEFINEQ
(MAKEMENUEDWINDOW
[LAMBDA (MENU WINDOWTITLE LOCATION WINDOWSPEC MENUWINDOWTITLE FONT)
(* rrb " 8-APR-83 17:10")
(* This function is used to create a MAIN window MENU pair. MENU specifty the menu content and may be a menu, a
simple list or in A-list format. WINDOWTITLE is a string specifying a title for the main window.
LOCATION specifies the placement of the window.. (TOP BOTTOM LEFT RIGHT) WINDOWSPECT may be a REGION or an
EXISTING WINDOW. If it is NIL, a new window will be created. MENUWINDOWTITLE is a string specifying a title for
the menu window. FONT specifies the font to be used in the menu.)
(PROG (WINDOW ITEMS REGION #OFITEMS/ROW MINWIDTH MINHEIGHT MINITEMWIDTH ROWS COLUMNS)
[COND
((NULL LOCATION) (* Default LOCATION is TOP)
(SETQ LOCATION (QUOTE TOP]
[COND
((NULL FONT) (* Default font is HEVETICA10 in BOLD)
(SETQ FONT (FONTCREATE (QUOTE (HELVETICA 10 BOLD]
[COND
[(LISTP MENU)
(SETQ ITEMS MENU)
(SETQ ROWS (if (FMEMB LOCATION (QUOTE (TOP BOTTOM)))
then 1
else (LENGTH ITEMS]
(T (SETQ MENU (create MENU copying MENU))
(SETQ ITEMS (fetch ITEMS of MENU))
(SETQ MENUWINDOWTITLE (fetch TITLE of MENU))
(SETQ ROWS (if (fetch MENUROWS of MENU)
else (replace MENUROWS of MENU with (if (FMEMB LOCATION
(QUOTE (TOP BOTTOM)))
then 1
else (LENGTH ITEMS]
(CLRPROMPT) (* The minimum item width is the width of the longest
element of the menu)
(SETQ #OFITEMS/ROW (IQUOTIENT (IPLUS (SUB1 ROWS)
(LENGTH ITEMS))
ROWS))
(SETQ MINITEMWIDTH (IPLUS (APPLY (QUOTE IMAX)
(for X in ITEMS collect (STRINGWIDTH (COND
((LISTP X)
(CAR X))
(T X))
FONT)))
(STRINGWIDTH " " FONT)))
(* The minimum width of the window takes into account
the contents of the menu an titles)
(SETQ MINWIDTH (IPLUS (STRINGWIDTH WINDOWTITLE (DSPFONT NIL WindowTitleDisplayStream))
(STRINGWIDTH " " WindowTitleDisplayStream)))
[if (FMEMB LOCATION (QUOTE (TOP BOTTOM)))
then (SETQ MINWIDTH (IMAX (ITIMES MINITEMWIDTH #OFITEMS/ROW)
MINWIDTH
(IPLUS (STRINGWIDTH MENUWINDOWTITLE (DSPFONT NIL
WindowTitleDisplayStream))
(STRINGWIDTH " " WindowTitleDisplayStream]
(* The window must be tall enough to hold the title)
[SETQ MINHEIGHT (IPLUS 4 (ITIMES ROWS (FONTHEIGHT (DSPFONT NIL WindowTitleDisplayStream]
(* Columns and rowas are set depending on the location
of the window)
(* The window may be specified by the user. A region or an existing window may be supplied by the caller.
In any case the size may have to be adjusted so that titles and and menu fit)
[SETQ WINDOW (COND
((NULL WINDOWSPEC)
(printout PROMPTWINDOW "Specify a region for " (if WINDOWTITLE
else "the window"))
(SETQ REGION (GETREGION MINWIDTH MINHEIGHT NIL (FUNCTION GETREGIONFORMENUEDWINDOW)
(LIST #OFITEMS/ROW MINWIDTH)))
(CREATEW REGION WINDOWTITLE))
((REGIONP WINDOWSPEC)
(SETQ REGION WINDOWSPEC)
(COND
((LESSP (fetch HEIGHT of REGION)
MINHEIGHT)
(REPLACE HEIGHT OF REGION WITH MINHEIGHT)))
(COND
((LESSP (fetch WIDTH of REGION)
MINWIDTH)
(REPLACE WIDTH OF REGION WITH MINWIDTH)))
(replace WIDTH of REGION with (IPLUS (ITIMES (IQUOTIENT (fetch WIDTH of REGION)
#OFITEMS/ROW)
#OFITEMS/ROW)
2))
(CREATEW REGION WINDOWTITLE))
((WINDOWP WINDOWSPEC)
(CLOSEW WINDOWSPEC)
(SETQ REGION (WINDOWPROP WINDOWSPEC (QUOTE REGION)))
(COND
((LESSP (fetch HEIGHT of REGION)
MINHEIGHT)
(REPLACE HEIGHT OF REGION WITH MINHEIGHT)))
(COND
((LESSP (fetch WIDTH of REGION)
MINWIDTH)
(replace WIDTH of REGION with MINWIDTH)))
(replace WIDTH of REGION with (IPLUS (ITIMES (IQUOTIENT (fetch WIDTH of REGION)
#OFITEMS/ROW)
#OFITEMS/ROW)
2))
(SHAPEW WINDOWSPEC REGION)
(COND
(WINDOWTITLE (WINDOWPROP WINDOWSPEC (QUOTE TITLE)
WINDOWTITLE)))
(OPENW WINDOWSPEC)
WINDOWSPEC)
((SHOULDNT] (* If the menu is on the side continue the title bar
even if the menu has no title)
(COND
((AND (NULL MENUWINDOWTITLE)
(MEMBER LOCATION (QUOTE (LEFT RIGHT)))
(WINDOWPROP WINDOW (QUOTE TITLE)))
(SETQ MENUWINDOWTITLE " "))) (* Now set up the menu)
(COND
((LISTP MENU)
(SELECTQ LOCATION
((TOP BOTTOM)
(SETQ COLUMNS #OFITEMS/ROW)
(SETQ ROWS 1))
((RIGHT LEFT)
(SETQ COLUMNS 1)
(SETQ ROWS #OFITEMS/ROW))
(SHOULDNT))
(SETQ MENU
(create MENU
MENUFONT ← FONT
ITEMS ← ITEMS
MENUCOLUMNS ← COLUMNS
MENUROWS ← ROWS
CENTERFLG ← T
TITLE ← MENUWINDOWTITLE)))
(T (if MENUWINDOWTITLE
then (replace TITLE of MENU with MENUWINDOWTITLE))
(UPDATE/MENU/IMAGE MENU)))
(CLRPROMPT) (* if the menu is horizontal adjuest the ITEMWIDTH parm
of the menu)
(COND
((MEMBER LOCATION (QUOTE (TOP BOTTOM)))
(replace ITEMWIDTH of MENU with (IQUOTIENT (fetch (REGION WIDTH)
of (WINDOWPROP WINDOW (QUOTE REGION)))
#OFITEMS/ROW))
(UPDATE/MENU/IMAGE MENU))) (* Now build the menu window)
(MAKEMENUWINDOW WINDOW MENU LOCATION) (* Window properties are added to the main window so
that operations like MOVE and RESHAPE can take the menu
window into account)
(WINDOWPROP WINDOW (QUOTE NEWREGIONFN)
(FUNCTION GETREGIONFORMENUEDWINDOW))
(WINDOWPROP WINDOW (QUOTE MINWIDTH)
MINWIDTH)
(WINDOWPROP WINDOW (QUOTE MENUPOSITION)
LOCATION)
(WINDOWPROP WINDOW (QUOTE AFTERMOVEFN)
(FUNCTION MOVEMENUWINDOW))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION RESHAPEMENUEDWINDOW))
(WINDOWPROP WINDOW (QUOTE TOTOPFN)
(FUNCTION MENUEDWINDOWTOTOPFN))
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION MENUEDWINDOWCLOSEFN))
(WINDOWPROP WINDOW (QUOTE OPENFN)
(FUNCTION MENUEDWINDOWOPENFN))
[WINDOWPROP WINDOW (QUOTE SHRINKFN)
(FUNCTION (LAMBDA (W)
(SETQ W (WINDOWPROP W (QUOTE MENUWINDOW)))
(WINDOWPROP W (QUOTE CLOSEFN)
NIL)
(CLOSEW W)
(WINDOWPROP W (QUOTE CLOSEFN)
(QUOTE DON'T]
[WINDOWPROP WINDOW (QUOTE EXPANDFN)
(FUNCTION (LAMBDA (W)
(SETQ W (WINDOWPROP W (QUOTE MENUWINDOW)))
(WINDOWPROP W (QUOTE OPENFN)
NIL)
(OPENW W)
(WINDOWPROP W (QUOTE OPENFN)
(QUOTE DON'T]
NIL (RETURN WINDOW])
(MOVEMENUWINDOW
[LAMBDA (WINDOW) (* SDG " 4-FEB-83 09:52")
(* This function is called whenever the main window is
moved. It repositions the associated menuwindow)
(PROG (MENUWINDOW LOCATIONFORMENU MENUFORWINDOW)
(SETQ MENUWINDOW (WINDOWPROP WINDOW (QUOTE MENUWINDOW)))
(SETQ MENUFORWINDOW (WINDOWPROP WINDOW (QUOTE WINDOWMENU)))
(* The location of the menu depends on its position with
respect to the main window)
(SETQ LOCATIONFORMENU (SELECTQ (WINDOWPROP WINDOW (QUOTE MENUPOSITION))
[TOP (create POSITION
XCOORD ←(fetch LEFT of (WINDOWPROP
WINDOW
(QUOTE REGION)))
YCOORD ←(fetch PTOP of (WINDOWPROP
WINDOW
(QUOTE REGION]
[BOTTOM (create POSITION
XCOORD ←(fetch LEFT
of (WINDOWPROP WINDOW
(QUOTE REGION)))
YCOORD ←(IDIFFERENCE
(fetch BOTTOM of (WINDOWPROP WINDOW
(QUOTE REGION)
))
(fetch IMAGEHEIGHT of MENUFORWINDOW]
[LEFT (create POSITION
XCOORD ←(IDIFFERENCE
(fetch LEFT of (WINDOWPROP WINDOW
(QUOTE REGION)))
(fetch IMAGEWIDTH of MENUFORWINDOW))
YCOORD ←(IDIFFERENCE
(fetch TOP of (WINDOWPROP WINDOW
(QUOTE REGION)))
(fetch IMAGEHEIGHT of MENUFORWINDOW]
[RIGHT (create POSITION
XCOORD ←(fetch RIGHT
of (WINDOWPROP WINDOW
(QUOTE REGION)))
YCOORD ←(IDIFFERENCE
(fetch TOP of (WINDOWPROP WINDOW
(QUOTE REGION)))
(fetch IMAGEHEIGHT of MENUFORWINDOW]
(SHOULDNT)))
(WINDOWPROP MENUWINDOW (QUOTE MOVEFN)
NIL) (* Now the menu can be moved into the correct position)
(MOVEW MENUWINDOW LOCATIONFORMENU)
(WINDOWPROP MENUWINDOW (QUOTE MOVEFN)
(QUOTE DON'T])
(RESHAPEMENUEDWINDOW
[LAMBDA (WINDOW) (* rrb " 8-APR-83 16:36")
(* This function takes care of size adjustments whenever the main window is reshaped. The size of the window is
constrained so that the menu and titles will fit properly)
(PROG (MENUWINDOW MENU POSITION WINDOWMENU)
(SETQ WINDOWMENU (WINDOWPROP WINDOW (QUOTE WINDOWMENU)))
(SETQ MENUWINDOW (WINDOWPROP WINDOW (QUOTE MENUWINDOW)))
(WINDOWPROP MENUWINDOW (QUOTE CLOSEFN)
NIL)
(SETQ POSITION (WINDOWPROP WINDOW (QUOTE MENUPOSITION)))
(CLOSEW MENUWINDOW) (* Since the size of the window has changed it will be
necessary to adjust the menu image if the menu is
horizontal)
(COND
((MEMBER POSITION (QUOTE (TOP BOTTOM)))
(replace ITEMWIDTH of WINDOWMENU with (IQUOTIENT (fetch (REGION WIDTH)
of (WINDOWPROP WINDOW (QUOTE REGION)
))
(fetch MENUCOLUMNS of WINDOWMENU)))
(UPDATE/MENU/IMAGE WINDOWMENU))) (* Now the ne menu window can be constructed)
(MAKEMENUWINDOW WINDOW (WINDOWPROP WINDOW (QUOTE WINDOWMENU))
POSITION])
(GETREGIONFORMENUEDWINDOW
[LAMBDA (FIXEDPOINT MOVINGPOINT NEWREGIONFNARG) (* SDG " 4-FEB-83 12:28")
(* This function is called whenever a new region for the window is needed. It constrains the size of the window so
that the menu and/or titles will fit)
(COND
((NULL MOVINGPOINT) (* This is true only the first time the function is
called)
FIXEDPOINT)
(T (PROG (#OFMENUITEMS MENUWIDTH XDELTA XADJ)
(* The NEWREGIONFNARG can be either a window or a list consisting of the number of items in the menu and the
minimum width of the window neede to hold the menu an titles)
(COND
[(WINDOWP NEWREGIONFNARG)
[SETQ #OFMENUITEMS (LENGTH (fetch ITEMS of (WINDOWPROP NEWREGIONFNARG
(QUOTE WINDOWMENU]
(SETQ MENUWIDTH (WINDOWPROP NEWREGIONFNARG (QUOTE MINWIDTH]
((LISTP NEWREGIONFNARG)
(SETQ #OFMENUITEMS (CAR NEWREGIONFNARG))
(SETQ MENUWIDTH (CADR NEWREGIONFNARG)))
(T (SHOULDNT)))
(SETQ XDELTA (IDIFFERENCE (fetch (POSITION XCOORD) of MOVINGPOINT)
(fetch (POSITION XCOORD) of FIXEDPOINT)))
[SETQ MENUWIDTH (COND
((LESSP XDELTA 0)
(SETQ XADJ -2)
(COND
((LESSP (MINUS XDELTA)
MENUWIDTH)
(MINUS MENUWIDTH))
(T XDELTA)))
(T (SETQ XADJ 2)
(COND
((LESSP XDELTA MENUWIDTH)
MENUWIDTH)
(T XDELTA]
(SETQ MENUWIDTH (IPLUS (ITIMES (IQUOTIENT MENUWIDTH #OFMENUITEMS)
#OFMENUITEMS)
XADJ)) (* The adjusted XCOORD can now be inserted)
(replace (POSITION XCOORD) of MOVINGPOINT with (IPLUS MENUWIDTH (fetch (POSITION
XCOORD)
of FIXEDPOINT)))
(RETURN MOVINGPOINT])
(MAKEMENUWINDOW
[LAMBDA (MAINWINDOW MENUFORWINDOW LOCATION) (* SDG " 4-FEB-83 11:31")
(* edited: "26-JAN-83 12:09")
(* This function is called to create the menu window)
(PROG (MENUWINDOW MENUPOSITION) (* First set up a position for the window based on the
position of the main window and the relative location of
the menu)
(SETQ MENUPOSITION (SELECTQ LOCATION
[TOP (create POSITION
XCOORD ←(fetch LEFT of (WINDOWPROP MAINWINDOW
(QUOTE REGION)))
YCOORD ←(fetch PTOP of (WINDOWPROP MAINWINDOW
(QUOTE REGION]
[BOTTOM (create POSITION
XCOORD ←(fetch LEFT of (WINDOWPROP
MAINWINDOW
(QUOTE REGION)))
YCOORD ←(IDIFFERENCE
(fetch BOTTOM of (WINDOWPROP MAINWINDOW
(QUOTE REGION)))
(fetch IMAGEHEIGHT of MENUFORWINDOW]
(RIGHT (create POSITION
XCOORD ←(fetch RIGHT of (WINDOWPROP
MAINWINDOW
(QUOTE REGION)))
YCOORD ←(IPLUS
(IDIFFERENCE (fetch TOP
of (WINDOWPROP MAINWINDOW
(QUOTE REGION)))
(fetch IMAGEHEIGHT of
MENUFORWINDOW))
1)))
(LEFT (create POSITION
XCOORD ←(IDIFFERENCE (fetch LEFT
of (WINDOWPROP
MAINWINDOW
(QUOTE REGION)))
(fetch IMAGEWIDTH
of MENUFORWINDOW))
YCOORD ←(IPLUS (IDIFFERENCE
(fetch TOP
of (WINDOWPROP MAINWINDOW
(QUOTE REGION))
)
(fetch IMAGEHEIGHT of
MENUFORWINDOW))
1)))
(SHOULDNT))) (* Now make the menu window)
(SETQ MENUWINDOW (ADDMENU MENUFORWINDOW NIL MENUPOSITION))
(* Now save each other's window *)
(WINDOWPROP MAINWINDOW (QUOTE WINDOWMENU)
MENUFORWINDOW) (* Other window properties are added so that operation
selectable with the mouse like MOVE and RESHAPE will
happen as expected)
(WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW)
MAINWINDOW)
(WINDOWPROP MAINWINDOW (QUOTE MENUWINDOW)
MENUWINDOW)
(WINDOWPROP MENUWINDOW (QUOTE TOTOPFN)
(FUNCTION MENUEDWINDOWTOTOPFN))
(WINDOWPROP MENUWINDOW (QUOTE CLOSEFN)
(QUOTE DON'T))
(WINDOWPROP MENUWINDOW (QUOTE OPENFN)
(QUOTE DON'T))
(WINDOWPROP MENUWINDOW (QUOTE MOVEFN)
(QUOTE DON'T))
(* This hack caues a right mouse button hit on this window to do what a right button hit on the main window would
do)
[WINDOWPROP MENUWINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION (LAMBDA (W)
(DOWINDOWCOM (WINDOWPROP W (QUOTE MAINWINDOW]
(WINDOWPROP MAINWINDOW (QUOTE MENULENGTH)
(LENGTH (fetch (MENU ITEMS) of MENUFORWINDOW)))
(WINDOWPROP MENUWINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T))
(RETURN MENUWINDOW])
(MENUEDWINDOWTOTOPFN
[LAMBDA (WINDOW) (* SDG " 4-FEB-83 10:14")
(* This function causes both the main and menu window to
be visible when either is selected)
(PROG (W)
[SETQ W (OR (WINDOWPROP WINDOW (QUOTE MAINWINDOW))
(WINDOWPROP WINDOW (QUOTE MENUWINDOW]
(COND
((WINDOWP W)
(TOTOPW W T])
(MENUEDWINDOWCLOSEFN
[LAMBDA (MAINW) (* rrb "23-SEP-83 16:14")
(* closefn for a menued window.
Closes the menu window and sets its own openfn to
reestablish the link and open the menu.)
(PROG [(MENUWINDOW (WINDOWPROP MAINW (QUOTE MENUWINDOW]
(* remove the DON'T from the menu window so it will close. I'm not sure why the DON'T was there in the first
place- rrb.)
(WINDOWPROP MENUWINDOW (QUOTE CLOSEFN)
NIL) (* break link back to this window.)
(WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW)
NIL)
(CLOSEW MENUWINDOW])
(MENUEDWINDOWOPENFN
[LAMBDA (MAINW) (* M.Yonke "12-APR-83 14:44")
(* open function for menued windows.
Opens and reestablishes the link from the menu window to
the main window.)
(PROG [(MENUWINDOW (WINDOWPROP MAINW (QUOTE MENUWINDOW]
(WINDOWPROP MENUWINDOW (QUOTE OPENFN)
NIL)
(OPENW MENUWINDOW)
(WINDOWPROP MENUWINDOW (QUOTE OPENFN)
(QUOTE DON'T))
(WINDOWPROP MENUWINDOW (QUOTE MAINWINDOW)
MAINW])
)
(PUTPROPS MENUEDWINDOW COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1500 19937 (MAKEMENUEDWINDOW 1510 . 9167) (MOVEMENUWINDOW 9169 . 11424) (
RESHAPEMENUEDWINDOW 11426 . 12738) (GETREGIONFORMENUEDWINDOW 12740 . 14595) (MAKEMENUWINDOW 14597 .
18069) (MENUEDWINDOWTOTOPFN 18071 . 18536) (MENUEDWINDOWCLOSEFN 18538 . 19313) (MENUEDWINDOWOPENFN
19315 . 19935)))))
STOP