(FILECREATED " 7-Sep-85 23:17:28" {DSK}<LISPFILES>FM>FREEMENU.;42 86787
changes to: (FNS \FM.BUTTONEVENTFN \FM.CGETITEMPROP)
previous date: " 6-Sep-85 16:34:04" {DSK}<LISPFILES>FM>FREEMENU.;41)
(PRETTYCOMPRINT FREEMENUCOMS)
(RPAQQ FREEMENUCOMS [(COMS (* USER INTERFACE FUNCTIONS)
(FNS FM.MAKEMENU FM.FORMATMENU FM.REDISPLAYITEM FM.REDISPLAYMENU FM.EDITP
FM.FIXSHAPE FM.ITEMPROP FM.READSTATE FM.SHADEITEM FM.SHADEITEMBM
FM.EDITITEM FM.WHICHITEM FM.ITEMFROMID FM.CHANGELABEL FM.CHANGESTATE))
(COMS (* CREATION OF FREEMENUS)
(MACROS \FM.ITEMWIDTH \FM.ITEMHEIGHT)
(FNS \FM.FORMATMENUROW \FM.READITEMS \FM.CREATEITEM \FM.CREATEW \FM.GETBITMAP
\FM.READUSERDATA \FM.GROUPNWAYITEMS \FM.SETUPMENU \FM.SETUPWINDOW)
[CONSTANTS (\FM.ITEM-TYPES (QUOTE (MOMENTARY TOGGLE 3STATE NWAY SUBNWAY NCHOOSE EDIT
EDITSTART TITLE)))
(\FM.DESCRIPTION-PROPS (QUOTE (TYPE LABEL NAME STATE FONT BITMAP REGION
MESSAGE USERDATA ITEMPTR SYSDOWNFN
SYSMOVEDFN SYSSELECTEDFN DOWNFN HELDFN
MOVEDFN SELECTEDFN ITEMS ITEMFONT
MAXWIDTH EDITSTOPFLG LEFT BOTTOM]
(RECORDS FREEMENUITEM))
(COMS (* FREEMENU WINDOWS)
(FNS \FM.CLOSEFN \FM.RESHAPEFN \FM.INITCORNERSFN \FM.WINDOWTOOSMALL \FM.SCROLLINGOFF))
(COMS (* MOUSE FUNCTIONS)
(MACROS \FM.CHECKREGION)
(FNS \FM.BUTTONEVENTFN \FM.RIGHTBUTTONFN \FM.MENUHANDLER \FM.DOSELECTION))
(COMS (* ITEM SUPPORT FUNCTIONS)
(MACROS FM.ITEMPROP \FM.INSUREFM)
(FNS \FM.GETITEMPROP \FM.PUTITEMPROP \FM.CGETITEMPROP \FM.CPUTITEMPROP
\FM.HIGHLIGHTITEM \FM.HIGHLIGHTITEMBM))
(COMS (* MOMENTARY ITEM FUNCTIONS)
(FNS \FM.MOMENTARY-SETUP \FM.MOMENTARY-SELECTEDFN))
(COMS (* TOGGLE ITEM FUNCTIONS)
(FNS \FM.TOGGLE-SETUP \FM.TOGGLE-SELECTEDFN))
(COMS (* 3STATE ITEM FUNCTIONS)
(FNS \FM.3STATE-SETUP \FM.3STATE-DOWNFN \FM.3STATE-SELECTEDFN \FM.3STATE-CHANGESTATE))
(COMS (* NWAY ITEM FUNCTIONS)
(FNS \FM.NWAY-SETUP \FM.NWAY-DOWNFN \FM.NWAY-MOVEDFN \FM.NWAY-SELECTEDFN))
(COMS (* NCHOOSE ITEM FUNCTIONS)
(FNS \FM.NCHOOSE-SETUP \FM.NCHOOSE-SELECTEDFN \FM.NCHOOSE-CHANGESTATE))
(COMS (* EDIT ITEMS)
(CONSTANTS (\FM.EDIT-RIGHTENDSPACE 5)
(\FM.EDIT-BLOCKSIZE 50))
(VARS (\FM.EDIT-TTBL))
(MACROS \FM.EDIT-MAXWIDTH \FM.EDIT-SCROLLAMOUNT)
(FNS \FM.EDIT-SETUP \FM.EDIT-SETUPTTBL \FM.EDIT-ITEM \FM.EDIT-BACKUP \FM.EDIT-INSERT
\FM.EDIT-DELETE \FM.EDIT-GETPOINTERINFO \FM.EDIT-MOVECARET \FM.EDIT-STRDELETE
\FM.EDIT-STRINSERT \FM.EDIT-UPDATEAFTERDELETE))
(COMS (* EDITSTART ITEM FUNCTIONS)
(FNS \FM.EDITSTART-SETUP \FM.EDITSTART-SELECTEDFN))
(COMS (* TITLE ITEM FUNCTIONS)
(FNS \FM.TITLE-SETUP))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML \FM.DOSELECTION)
(LAMA FM.ITEMPROP])
(* USER INTERFACE FUNCTIONS)
(DEFINEQ
(FM.MAKEMENU
[LAMBDA (DESCRIPTION) (* jow "28-Aug-85 17:47")
(LET* ((INTERIOR (CREATEREGION 0 0 0 0))
(STREAM (DSPCREATE))
(ITEMS (\FM.READITEMS DESCRIPTION INTERIOR STREAM))
(WINDOW (\FM.CREATEW INTERIOR DESCRIPTION)))
(\FM.SETUPMENU WINDOW ITEMS STREAM)
(\FM.SETUPWINDOW WINDOW)
WINDOW])
(FM.FORMATMENU
[LAMBDA (DESCRIPTION MINX MINY) (* jow "29-Aug-85 23:45")
(* used to automatically format a freemenu from a row and order description. DESCRIPTION is a list of rows, each row
a list of item descriptions. Reverse the rows, then build from bottom up. Use \FM.FORMATMENUROW to add LEFT and
BOTTOM specs to each item in a row, then remove concept of rows, then make the menu.)
(OR MINX (SETQ MINX 10))
(OR MINY (SETQ MINY 2))
(LET ((DESC (COPY (REVERSE DESCRIPTION)))
(BOTTOM 0)
(INTERIOR (CREATEREGION 0 0 0 0))
(STREAM (DSPCREATE))
LEFT ITEMS HEIGHT WINDOW)
(for ROW in DESC when (NEQ (CAR ROW)
(QUOTE WINDOWPROPS))
do (SETQ LEFT 0)
(SETQ HEIGHT (\FM.FORMATMENUROW ROW))
(add BOTTOM HEIGHT MINY))
(SETQ DESC (REVERSE DESC))
(SETQ DESC (for ROW in DESC when (NEQ (CAR ROW)
(QUOTE WINDOWPROPS))
join ROW)) (* remove rows)
(SETQ ITEMS (\FM.READITEMS DESC INTERIOR STREAM))
(SETQ WINDOW (\FM.CREATEW INTERIOR DESCRIPTION)) (* read props from original description, cuz got
trashed by formatting)
(\FM.SETUPMENU WINDOW ITEMS STREAM)
(\FM.SETUPWINDOW WINDOW)
WINDOW])
(FM.REDISPLAYITEM
[LAMBDA (ITEM WINDOW) (* jow " 5-Sep-85 15:54")
(* blast ITEM's bitmap into WINDOW clipped to ITEM's
region)
(SETQ ITEM (\FM.INSUREFM ITEM))
(if (OPENWP WINDOW)
then (BITBLT (FM.ITEMPROP ITEM (QUOTE BITMAP))
0 0 WINDOW (fetch (REGION LEFT) of (FM.ITEMPROP ITEM (QUOTE REGION)))
(fetch (REGION BOTTOM) of (FM.ITEMPROP ITEM (QUOTE REGION)))
(fetch (REGION WIDTH) of (FM.ITEMPROP ITEM (QUOTE REGION])
(FM.REDISPLAYMENU
[LAMBDA (WINDOW) (* jow "29-Aug-85 23:44")
(if (OPENWP WINDOW)
then (for ITEM in (WINDOWPROP WINDOW (QUOTE FM.ITEMS)) do (FM.REDISPLAYITEM ITEM WINDOW])
(FM.EDITP
[LAMBDA (WINDOW) (* jow " 5-Sep-85 23:24")
(WINDOWPROP WINDOW (QUOTE FM.EDITITEM])
(FM.FIXSHAPE
[LAMBDA (WINDOW ALWAYSFLG) (* jow "22-Aug-85 11:40")
(* programmer way of reshaping a freemenu window to its full extent. If window is too small, it will be reshaped,
without moving the lower left corner. If window is too big, it will only be reshaped if ALWAYSFLG is T.)
(if (OR (\FM.WINDOWTOOSMALL WINDOW)
ALWAYSFLG)
then (SHAPEW WINDOW (CREATEREGION (fetch (REGION LEFT) of (WINDOWPROP WINDOW (QUOTE REGION)))
(fetch (REGION BOTTOM) of (WINDOWPROP WINDOW (QUOTE REGION))
)
(WIDTHIFWINDOW (fetch (REGION WIDTH)
of (WINDOWPROP WINDOW (QUOTE EXTENT)))
(WINDOWPROP WINDOW (QUOTE BORDER)))
(HEIGHTIFWINDOW (fetch (REGION HEIGHT)
of (WINDOWPROP WINDOW (QUOTE EXTENT)))
(WINDOWPROP WINDOW (QUOTE TITLE))
(WINDOWPROP WINDOW (QUOTE BORDER])
(FM.ITEMPROP
[LAMBDA ARGPTR (* jow " 6-Aug-85 09:50")
(COND
((NOT (type? FREEMENUITEM (ARG ARGPTR 1)))
(\ILLEGAL.ARG (ARG ARGPTR 1)))
((IGREATERP ARGPTR 2)
(\FM.PUTITEMPROP (ARG ARGPTR 1)
(ARG ARGPTR 2)
(ARG ARGPTR 3)))
((EQ ARGPTR 2)
(\FM.GETITEMPROP (ARG ARGPTR 1)
(ARG ARGPTR 2)))
(T (\ILLEGAL.ARG NIL])
(FM.READSTATE
[LAMBDA (WINDOW) (* jow "29-Aug-85 14:00")
(* programmer interface: goes through all items. returns a prop list format of item id / current state for any state
items in the menu (toggle, 3state, nway, nchoose, edit.) The current state is the value of the STATE field, or for
edit items, the object. Don't include in state list if STATE is NIL.)
(for ITEM in (WINDOWPROP WINDOW (QUOTE FM.ITEMS))
join (SELECTQ (FM.ITEMPROP ITEM (QUOTE TYPE))
[(TOGGLE 3STATE NCHOOSE)
(IF (FM.ITEMPROP ITEM (QUOTE STATE))
THEN (LIST (OR (FM.ITEMPROP ITEM (QUOTE ID))
(FM.ITEMPROP ITEM (QUOTE LABEL)))
(FM.ITEMPROP ITEM (QUOTE STATE]
[NWAY (IF (FM.ITEMPROP ITEM (QUOTE STATE))
THEN (LIST (FM.ITEMPROP ITEM (QUOTE ID))
(FM.ITEMPROP ITEM (QUOTE STATE]
[EDIT (LIST (FM.ITEMPROP ITEM (QUOTE ID))
(FM.ITEMPROP ITEM (QUOTE LABEL]
NIL])
(FM.SHADEITEM
[LAMBDA (ITEM WINDOW SHADE) (* jow " 5-Sep-85 15:59")
(* paint SHADE on top of ITEM on the screen. Don't touch its saved bitmap. If SHADE is a bitmap, xor it onto the
screen.)
(SETQ ITEM (\FM.INSUREFM ITEM))
(if (OPENWP WINDOW)
then (if (BITMAPP SHADE)
then (BITBLT SHADE NIL NIL WINDOW (fetch (REGION LEFT) of (FM.ITEMPROP ITEM
(QUOTE REGION)
))
(fetch (REGION BOTTOM) of (FM.ITEMPROP ITEM (QUOTE REGION)))
NIL NIL (QUOTE SOURCE)
(QUOTE INVERT))
else (BLTSHADE SHADE WINDOW NIL NIL NIL NIL (QUOTE PAINT)
(FM.ITEMPROP ITEM (QUOTE REGION])
(FM.SHADEITEMBM
[LAMBDA (ITEM SHADE) (* jow " 5-Sep-85 23:34")
(* shade an item's bitmap. for 3state items also shade
the saved bitmap)
(SETQ ITEM (\FM.INSUREFM ITEM))
(if (BITMAPP SHADE)
then (BITBLT SHADE 0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
0 0 NIL NIL (QUOTE SOURCE)
(QUOTE INVERT))
else (BLTSHADE SHADE (FM.ITEMPROP ITEM (QUOTE BITMAP))
NIL NIL NIL NIL (QUOTE PAINT)))
(if (EQ (FM.ITEMPROP ITEM (QUOTE TYPE))
(QUOTE 3STATE))
then (if (BITMAPP SHADE)
then (BITBLT SHADE 0 0 (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 NIL NIL (QUOTE SOURCE)
(QUOTE INVERT))
else (BLTSHADE SHADE (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
NIL NIL NIL NIL (QUOTE PAINT])
(FM.EDITITEM
[LAMBDA (ITEM WINDOW) (* jow " 5-Sep-85 15:57")
(* start editing at beginning of item.)
(SETQ ITEM (\FM.INSUREFM ITEM))
(IF (OPENWP WINDOW)
THEN (\FM.EDIT-ITEM ITEM WINDOW NIL T])
(FM.WHICHITEM
[LAMBDA (WINDOW POSorX Y) (* jow "29-Aug-85 12:49")
(* user interface to CHECKREGION. Return the item in WINDOW at (POSorX, Y) If WINDOW is NIL, use the window the
cursor is in, and the cursor position in that window)
(OR WINDOW (SETQ WINDOW (WHICHW)))
(COND
((POSITIONP POSorX)
(\FM.CHECKREGION WINDOW (fetch (POSITION XCOORD) of POSorX)
(fetch (POSITION YCOORD) of POSorX)))
(POSorX (\FM.CHECKREGION WINDOW POSorX Y))
(T (\FM.CHECKREGION WINDOW (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW])
(FM.ITEMFROMID
[LAMBDA (WINDOW ID) (* jow "29-Aug-85 12:51")
(* search for an item with the ID field ID or else the
LABEL field ID)
(for ITEM in (WINDOWPROP WINDOW (QUOTE FM.ITEMS)) thereis (OR (EQ ID (FM.ITEMPROP ITEM
(QUOTE ID)))
(EQ ID (FM.ITEMPROP ITEM
(QUOTE LABEL])
(FM.CHANGELABEL
[LAMBDA (ITEM WINDOW NEWLABEL) (* jow " 5-Sep-85 15:58")
(* user interface to change the label of an item, and
redisplay that item.)
(SETQ ITEM (\FM.INSUREFM ITEM))
(OR (WINDOWP WINDOW)
(\ILLEGAL.ARG WINDOW))
(OR (OR (ATOM NEWLABEL)
(STRINGP NEWLABEL)
(BITMAPP NEWLABEL))
(\ILLEGAL.ARG NEWLABEL))
(LET [(FONT (FM.ITEMPROP ITEM (QUOTE FONT)))
(STREAM (WINDOWPROP WINDOW (QUOTE FM.STREAM]
(if (OPENWP WINDOW)
then (* clear old region)
(DSPFILL (FM.ITEMPROP ITEM (QUOTE REGION))
WHITESHADE NIL WINDOW))
(FM.ITEMPROP ITEM (QUOTE LABEL)
NEWLABEL)
(FM.ITEMPROP ITEM (QUOTE REGION)
(CREATEREGION (fetch (REGION LEFT) of (FM.ITEMPROP ITEM (QUOTE REGION)))
(fetch (REGION BOTTOM) of (FM.ITEMPROP ITEM (QUOTE REGION)))
(\FM.ITEMWIDTH NEWLABEL FONT)
(\FM.ITEMHEIGHT NEWLABEL FONT)))
[FM.ITEMPROP ITEM (QUOTE BITMAP)
(\FM.GETBITMAP STREAM NEWLABEL FONT NIL NIL (FM.ITEMPROP ITEM (QUOTE BITMAP]
(SELECTQ (FM.ITEMPROP ITEM (QUOTE TYPE))
(TOGGLE (if (FM.ITEMPROP ITEM (QUOTE STATE))
then (\FM.HIGHLIGHTITEMBM ITEM)))
(3STATE [FM.ITEMPROP ITEM (QUOTE SAVEDBM)
(BITMAPCOPY (FM.ITEMPROP ITEM (QUOTE BITMAP]
(\FM.3STATE-CHANGESTATE ITEM (FM.ITEMPROP ITEM (QUOTE STATE))
STREAM))
[NWAY (LET [(BOSS (if (FM.ITEMPROP ITEM (QUOTE GROUP.BOSS))
then ITEM
else (FM.ITEMPROP ITEM (QUOTE ITEMPTR]
(if [AND (FM.ITEMPROP BOSS (QUOTE STATE))
(EQ ITEM (FM.ITEMPROP ITEM (QUOTE ITEMPTR]
then (\FM.HIGHLIGHTITEMBM ITEM)
(FM.ITEMPROP BOSS (QUOTE STATE)
NEWLABEL]
(NCHOOSE (FM.ITEMPROP ITEM (QUOTE TAILPTR)
(IPLUS (\FM.ITEMWIDTH NEWLABEL FONT)
(CHARWIDTH (CHARCODE SPACE)
FONT)))
(\FM.NCHOOSE-CHANGESTATE ITEM (FM.ITEMPROP ITEM (QUOTE STATE))
STREAM))
[EDIT (replace (REGION WIDTH) of (FM.ITEMPROP ITEM (QUOTE REGION))
with (IPLUS \FM.EDIT-RIGHTENDSPACE (fetch (REGION WIDTH)
of (FM.ITEMPROP ITEM (QUOTE REGION]
NIL)
(EXTENDREGION (WINDOWPROP WINDOW (QUOTE EXTENT))
(FM.ITEMPROP ITEM (QUOTE REGION)))
(if (\FM.WINDOWTOOSMALL WINDOW)
then (WINDOWPROP WINDOW (QUOTE SCROLLFN)
(QUOTE SCROLLBYREPAINTFN)))
(if (OPENWP WINDOW)
then (FM.REDISPLAYITEM ITEM WINDOW])
(FM.CHANGESTATE
[LAMBDA (ITEM WINDOW NEWSTATE) (* jow " 5-Sep-85 15:58")
(* user interface to force a state change.)
(SETQ ITEM (\FM.INSUREFM ITEM))
(SELECTQ (FM.ITEMPROP ITEM (QUOTE TYPE))
(TOGGLE (PROG1 (\FM.TOGGLE-SELECTEDFN ITEM)
(FM.REDISPLAYITEM ITEM WINDOW)))
(3STATE (PROG1 (\FM.3STATE-CHANGESTATE ITEM NEWSTATE (WINDOWPROP WINDOW (QUOTE FM.STREAM)
))
(FM.REDISPLAYITEM ITEM WINDOW)))
(NWAY (PROG1 (if NEWSTATE
then (\FM.NWAY-SELECTEDFN ITEM WINDOW (QUOTE (MIDDLE)))
else (\FM.NWAY-SELECTEDFN ITEM WINDOW NIL))
(FM.REDISPLAYMENU WINDOW)))
[NCHOOSE (if [FMEMB NEWSTATE (fetch (MENU ITEMS) of (FM.ITEMPROP ITEM (QUOTE ITEMS]
then (PROG1 (if (OPENWP WINDOW)
then (DSPFILL (FM.ITEMPROP ITEM (QUOTE REGION))
WHITESHADE NIL WINDOW))
(\FM.NCHOOSE-CHANGESTATE ITEM NEWSTATE (WINDOWPROP
WINDOW
(QUOTE FM.STREAM)))
(FM.REDISPLAYITEM ITEM WINDOW]
(EDIT (if (AND (NOT (FM.EDITP WINDOW))
(OR (ATOM NEWSTATE)
(STRINGP NEWSTATE)))
then (FM.CHANGELABEL ITEM WINDOW NEWSTATE)))
NIL])
)
(* CREATION OF FREEMENUS)
(DECLARE: EVAL@COMPILE
[PUTPROPS \FM.ITEMWIDTH MACRO ((LABEL FONT)
(if (BITMAPP LABEL)
then
(BITMAPWIDTH LABEL)
else
(STRINGWIDTH LABEL FONT]
[PUTPROPS \FM.ITEMHEIGHT MACRO ((LABEL FONT)
(if (BITMAPP LABEL)
then
(BITMAPHEIGHT LABEL)
else
(FONTPROP FONT (QUOTE HEIGHT]
)
(DEFINEQ
(\FM.FORMATMENUROW
[LAMBDA (ROW) (* jow " 5-Sep-85 12:03")
(* called by FM.FORMATMENU to add LEFT and BOTTOM specs to a list of items, starting at LEFT and BOTTOM.
Do the necessary error checking to determine formatting info. Return the height of the tallest item in the row.
Dynamically reference LEFT, BOTTOM, and MINX, declared by the caller.)
(bind LABEL FONT WIDTH NCHOOSEFONT (HEIGHT ← 0) for ITEM in ROW
do (SETQ LABEL (LISTGET ITEM (QUOTE LABEL)))
[SETQ FONT (APPLY* (QUOTE FONTCREATE)
(LISTGET ITEM (QUOTE FONT]
(if (NOT (OR (AND LABEL (ATOM LABEL))
(STRINGP LABEL)
(BITMAPP LABEL)))
then (ERROR "Invalid LABEL. Atom, string, or bitmap expected:" ITEM))
[SELECTQ (LISTGET ITEM (QUOTE TYPE))
[NCHOOSE (* check and setup nchoose specifics)
(if [NOT (AND (LISTGET ITEM (QUOTE ITEMS))
(for I in (LISTGET ITEM (QUOTE ITEMS))
always (OR (ATOM I)
(STRINGP I)
(BITMAPP I]
then (ERROR
"Invalid ITEMS. List of atoms, strings, or bitmaps expected:"
ITEM))
[SETQ NCHOOSEFONT (APPLY* (QUOTE FONTCREATE)
(LISTGET ITEM (QUOTE ITEMFONT]
[SETQ WIDTH (IPLUS (\FM.ITEMWIDTH LABEL FONT)
(CHARWIDTH (CHARCODE SPACE)
FONT)
(for I in (LISTGET ITEM (QUOTE ITEMS))
largest (\FM.ITEMWIDTH I NCHOOSEFONT)
finally (RETURN $$EXTREME]
(SETQ HEIGHT (IMAX HEIGHT (FONTPROP FONT (QUOTE HEIGHT))
(for I in (LISTGET ITEM (QUOTE ITEMS))
largest (\FM.ITEMHEIGHT I NCHOOSEFONT)
finally (RETURN $$EXTREME]
[EDIT (* for edit items check MAXWIDTH prop)
(if (BITMAPP LABEL)
then (ERROR "Edit items must be strings or atoms." ITEM))
(if [AND (LISTGET ITEM (QUOTE MAXWIDTH))
(NOT (FIXP (LISTGET ITEM (QUOTE MAXWIDTH]
then (ERROR "Invalid MAXWIDTH. Fixp expected:" DESCRIPTION))
(SETQ WIDTH (OR (LISTGET ITEM (QUOTE MAXWIDTH))
(\FM.ITEMWIDTH LABEL FONT)))
(SETQ HEIGHT (IMAX HEIGHT (\FM.ITEMHEIGHT LABEL FONT]
(PROGN (SETQ WIDTH (\FM.ITEMWIDTH LABEL FONT))
(SETQ HEIGHT (IMAX HEIGHT (\FM.ITEMHEIGHT LABEL FONT]
(LISTPUT ITEM (QUOTE LEFT)
LEFT)
(LISTPUT ITEM (QUOTE BOTTOM)
BOTTOM)
(add LEFT WIDTH MINX)
finally (RETURN HEIGHT])
(\FM.READITEMS
[LAMBDA (DESCRIPTION INTERIOR STREAM) (* jow " 2-Sep-85 17:29")
(* Read the description, collecting each item If an item's type is not specified use MOMENTARY Return a list of all
the items created. INTERIOR is a region that is extended as necessary to include all the items.)
(for ID ITEM in DESCRIPTION when (NEQ (CAR ID)
(QUOTE WINDOWPROPS))
collect (SETQ ITEM (\FM.CREATEITEM ID STREAM))
(APPLY* (PACK* "\FM." (FM.ITEMPROP ITEM (QUOTE TYPE))
"-SETUP")
ITEM ID INTERIOR STREAM)
(\FM.READUSERDATA ITEM ID)
(EXTENDREGION INTERIOR (FM.ITEMPROP ITEM (QUOTE REGION)))
ITEM])
(\FM.CREATEITEM
[LAMBDA (DESCRIPTION STREAM) (* jow " 4-Sep-85 16:36")
(* Do the necessary error checking on the item
description, and return a freemenu item initialized
with the general item stuff.)
(LET [(LABEL (LISTGET DESCRIPTION (QUOTE LABEL)))
(TYPE (OR (LISTGET DESCRIPTION (QUOTE TYPE))
(QUOTE MOMENTARY)))
(FONT (APPLY (FUNCTION FONTCREATE)
(LISTGET DESCRIPTION (QUOTE FONT]
(if (NOT (OR (AND LABEL (ATOM LABEL))
(STRINGP LABEL)
(BITMAPP LABEL)))
then (ERROR "Invalid LABEL. Atom, string, or bitmap expected:" DESCRIPTION))
(if [NOT (AND (FIXP (LISTGET DESCRIPTION (QUOTE LEFT)))
(FIXP (LISTGET DESCRIPTION (QUOTE BOTTOM]
then (ERROR "Invalid LEFT or BOTTOM. Fixp expected:" DESCRIPTION))
(if (NOT (FMEMB TYPE \FM.ITEM-TYPES))
then (ERROR "Invalid TYPE:" DESCRIPTION))
(create FREEMENUITEM
TYPE ← TYPE
LABEL ← LABEL
ID ←(LISTGET DESCRIPTION (QUOTE ID))
FONT ← FONT
BITMAP ←(\FM.GETBITMAP STREAM LABEL FONT)
REGION ←(CREATEREGION (LISTGET DESCRIPTION (QUOTE LEFT))
(LISTGET DESCRIPTION (QUOTE BOTTOM))
(\FM.ITEMWIDTH LABEL FONT)
(\FM.ITEMHEIGHT LABEL FONT))
DOWNFN ←(OR (LISTGET DESCRIPTION (QUOTE DOWNFN))
(FUNCTION NILL))
HELDFN ←(OR (LISTGET DESCRIPTION (QUOTE HELDFN))
(FUNCTION NILL))
MOVEDFN ←(OR (LISTGET DESCRIPTION (QUOTE MOVEDFN))
(FUNCTION NILL))
SELECTEDFN ←(OR (LISTGET DESCRIPTION (QUOTE SELECTEDFN))
(FUNCTION NILL])
(\FM.CREATEW
[LAMBDA (INTERIOR DESCRIPTION) (* jow "31-Aug-85 10:58")
(* create a window from interior region and window
props on description.)
(LET [(WINDOWPROPS (CDR (ASSOC (QUOTE WINDOWPROPS)
DESCRIPTION]
(CREATEW [CREATEREGION (OR (LISTGET WINDOWPROPS (QUOTE LEFT))
0)
(OR (LISTGET WINDOWPROPS (QUOTE BOTTOM))
0)
(WIDTHIFWINDOW (fetch (REGION WIDTH) of INTERIOR)
(LISTGET WINDOWPROPS (QUOTE BORDER)))
(HEIGHTIFWINDOW (fetch (REGION HEIGHT) of INTERIOR)
(LISTGET WINDOWPROPS (QUOTE TITLE))
(LISTGET WINDOWPROPS (QUOTE BORDER]
(LISTGET WINDOWPROPS (QUOTE TITLE))
(LISTGET WINDOWPROPS (QUOTE BORDER))
T])
(\FM.GETBITMAP
[LAMBDA (STREAM LABEL FONT WIDTH HEIGHT BITMAP) (* jow " 5-Sep-85 14:35")
(* make bitmaps out of atoms, strings. WIDTH and HEIGHT specify minimum dimensions for the bitmap.
If BITMAP is a bitmap, it will be reused if it is big enough.)
(SETQ WIDTH (IMAX (OR WIDTH 0)
(\FM.ITEMWIDTH LABEL FONT)))
(SETQ HEIGHT (IMAX (OR HEIGHT 0)
(\FM.ITEMHEIGHT LABEL FONT)))
(if (AND (BITMAPP BITMAP)
(ILEQ WIDTH (BITMAPWIDTH BITMAP))
(ILEQ HEIGHT (BITMAPHEIGHT BITMAP)))
then (BLTSHADE WHITESHADE BITMAP)
else (SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT)))
(if (BITMAPP LABEL)
then (BITBLT LABEL 0 0 BITMAP 0 0)
else (DSPDESTINATION BITMAP STREAM)
(DSPFONT FONT STREAM) (* force back to defaultfont if not given)
(DSPXPOSITION 0 STREAM)
(DSPYPOSITION (FONTPROP FONT (QUOTE DESCENT))
STREAM)
(PRIN1 LABEL STREAM))
BITMAP])
(\FM.READUSERDATA
[LAMBDA (ITEM DESCRIPTION) (* jow "22-Jul-85 17:34")
(* scans DESCRIPTION for user props.
Add any prop/value pairs found to ITEM.)
(for X on DESCRIPTION by (CDDR X) do (if (NOT (MEMB (CAR X)
\FM.DESCRIPTION-PROPS))
then (FM.ITEMPROP ITEM (CAR X)
(CADR X])
(\FM.GROUPNWAYITEMS
[LAMBDA (ITEMS) (* jow "31-Aug-85 11:19")
(* called after reading items. go through list of items and group together nway items by logical group id.
Make each item in group point to first item in group.)
(for ITEM GROUPS BOSS in ITEMS when (EQ (FM.ITEMPROP ITEM (QUOTE TYPE))
(QUOTE NWAY))
do (if (SETQ BOSS (ASSOC (FM.ITEMPROP ITEM (QUOTE ID))
GROUPS))
then (* group exists)
(FM.ITEMPROP ITEM (QUOTE ITEMPTR)
(CDR BOSS))
[if (EQ (FM.ITEMPROP ITEM (QUOTE SELECTEDFN))
(FUNCTION NILL))
then (FM.ITEMPROP ITEM (QUOTE SELECTEDFN)
(FM.ITEMPROP (CDR BOSS)
(QUOTE SELECTEDFN]
else (* this is the first of the group: add to GROUPS)
[if GROUPS
then (ATTACH (CONS (FM.ITEMPROP ITEM (QUOTE ID))
ITEM)
GROUPS)
else (SETQ GROUPS (LIST (CONS (FM.ITEMPROP ITEM (QUOTE ID))
ITEM]
(FM.ITEMPROP ITEM (QUOTE GROUP.BOSS)
T) (* boss must point to itself at start)
(FM.ITEMPROP ITEM (QUOTE ITEMPTR)
ITEM])
(\FM.SETUPMENU
[LAMBDA (WINDOW ITEMS STREAM) (* jow "29-Aug-85 15:49")
(* setup windowprops for freemenu, and sort items
structure.)
(\FM.GROUPNWAYITEMS ITEMS)
(WINDOWPROP WINDOW (QUOTE FM.ITEMS)
ITEMS)
(WINDOWPROP WINDOW (QUOTE FM.STREAM)
STREAM])
(\FM.SETUPWINDOW
[LAMBDA (WINDOW) (* jow "29-Aug-85 22:36")
(* setup the window for the freemenu.)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \FM.BUTTONEVENTFN))
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(QUOTE \FM.RIGHTBUTTONFN))
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
(QUOTE FM.REDISPLAYMENU))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(QUOTE \FM.RESHAPEFN))
(WINDOWPROP WINDOW (QUOTE INITCORNERSFN)
(QUOTE \FM.INITCORNERSFN))
(WINDOWPROP WINDOW (QUOTE OPENFN)
(QUOTE FM.REDISPLAYMENU))
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(QUOTE \FM.CLOSEFN))
(WINDOWPROP WINDOW (QUOTE SHRINKFN)
(QUOTE \FM.CLOSEFN))
[WINDOWPROP WINDOW (QUOTE EXTENT)
(CREATEREGION 0 0 (WINDOWPROP WINDOW (QUOTE WIDTH))
(WINDOWPROP WINDOW (QUOTE HEIGHT]
(WINDOWPROP WINDOW (QUOTE FM.BUSY)
NIL])
)
(DECLARE: EVAL@COMPILE
(RPAQQ \FM.ITEM-TYPES (MOMENTARY TOGGLE 3STATE NWAY SUBNWAY NCHOOSE EDIT EDITSTART TITLE))
(RPAQQ \FM.DESCRIPTION-PROPS (TYPE LABEL NAME STATE FONT BITMAP REGION MESSAGE USERDATA ITEMPTR
SYSDOWNFN SYSMOVEDFN SYSSELECTEDFN DOWNFN HELDFN MOVEDFN
SELECTEDFN ITEMS ITEMFONT MAXWIDTH EDITSTOPFLG LEFT BOTTOM))
[CONSTANTS (\FM.ITEM-TYPES (QUOTE (MOMENTARY TOGGLE 3STATE NWAY SUBNWAY NCHOOSE EDIT EDITSTART TITLE))
)
(\FM.DESCRIPTION-PROPS (QUOTE (TYPE LABEL NAME STATE FONT BITMAP REGION MESSAGE USERDATA
ITEMPTR SYSDOWNFN SYSMOVEDFN SYSSELECTEDFN DOWNFN
HELDFN MOVEDFN SELECTEDFN ITEMS ITEMFONT MAXWIDTH
EDITSTOPFLG LEFT BOTTOM]
)
[DECLARE: EVAL@COMPILE
(DATATYPE FREEMENUITEM (TYPE LABEL ID STATE FONT BITMAP REGION MESSAGE USERDATA ITEMPTR SYSDOWNFN
SYSMOVEDFN SYSSELECTEDFN DOWNFN HELDFN MOVEDFN SELECTEDFN)
USERDATA ←(LIST NIL)
SYSDOWNFN ←(FUNCTION NILL)
SYSMOVEDFN ←(FUNCTION NILL)
SYSSELECTEDFN ←(FUNCTION NILL))
]
(/DECLAREDATATYPE (QUOTE FREEMENUITEM)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((FREEMENUITEM 0 POINTER)
(FREEMENUITEM 2 POINTER)
(FREEMENUITEM 4 POINTER)
(FREEMENUITEM 6 POINTER)
(FREEMENUITEM 8 POINTER)
(FREEMENUITEM 10 POINTER)
(FREEMENUITEM 12 POINTER)
(FREEMENUITEM 14 POINTER)
(FREEMENUITEM 16 POINTER)
(FREEMENUITEM 18 POINTER)
(FREEMENUITEM 20 POINTER)
(FREEMENUITEM 22 POINTER)
(FREEMENUITEM 24 POINTER)
(FREEMENUITEM 26 POINTER)
(FREEMENUITEM 28 POINTER)
(FREEMENUITEM 30 POINTER)
(FREEMENUITEM 32 POINTER)))
(QUOTE 34))
(* FREEMENU WINDOWS)
(DEFINEQ
(\FM.CLOSEFN
[LAMBDA (WINDOW) (* jow " 2-Sep-85 17:19")
(if (FM.EDITP WINDOW)
then (QUOTE DON'T])
(\FM.RESHAPEFN
[LAMBDA (WINDOW) (* jow "29-Aug-85 13:13")
(* called after reshaping to redisplay and check if
need to scroll.)
(if (\FM.WINDOWTOOSMALL WINDOW)
then (WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
else (\FM.SCROLLINGOFF WINDOW))
(FM.REDISPLAYMENU WINDOW])
(\FM.INITCORNERSFN
[LAMBDA (WINDOW) (* jow "14-Aug-85 10:37")
(* called by SHAPEW to provide the initial corners of the reshape ghost box, in the form (x1 y1 x2 y2), where 1 is
fixed and 2 is tracked. respond with the freemenus full extent, leaving left, bottom as they are.)
(LET [[LEFT (fetch (REGION LEFT) of (WINDOWPROP WINDOW (QUOTE REGION]
(BOTTOM (fetch (REGION BOTTOM) of (WINDOWPROP WINDOW (QUOTE REGION]
(LIST LEFT BOTTOM [IPLUS LEFT (WIDTHIFWINDOW (fetch (REGION WIDTH)
of (WINDOWPROP WINDOW (QUOTE EXTENT)))
(WINDOWPROP WINDOW (QUOTE BORDER]
(IPLUS BOTTOM (HEIGHTIFWINDOW (fetch (REGION HEIGHT) of (WINDOWPROP WINDOW
(QUOTE EXTENT)))
(WINDOWPROP WINDOW (QUOTE TITLE))
(WINDOWPROP WINDOW (QUOTE BORDER])
(\FM.WINDOWTOOSMALL
[LAMBDA (WINDOW) (* jow "12-Jul-85 12:57")
(* called after reshaping: checks to see if WINDOW
region is too small for it's FREEMENU extent)
(OR [ILESSP (WINDOWPROP WINDOW (QUOTE WIDTH))
(fetch (REGION WIDTH) of (WINDOWPROP WINDOW (QUOTE EXTENT]
(ILESSP (WINDOWPROP WINDOW (QUOTE HEIGHT))
(fetch (REGION HEIGHT) of (WINDOWPROP WINDOW (QUOTE EXTENT])
(\FM.SCROLLINGOFF
[LAMBDA (WINDOW) (* jow "22-Aug-85 12:22")
(* called after reshaping WINDOW;
turn scrolling off; resets XOFFSET and YOFFSET to
unscroll window Clipping region set back to copy of
full extent.)
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
NIL)
(DSPXOFFSET [IPLUS (WINDOWPROP WINDOW (QUOTE BORDER))
(fetch (REGION LEFT) of (WINDOWPROP WINDOW (QUOTE REGION]
WINDOW)
(DSPYOFFSET [IPLUS (WINDOWPROP WINDOW (QUOTE BORDER))
(fetch (REGION BOTTOM) of (WINDOWPROP WINDOW (QUOTE REGION]
WINDOW)
(DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP WINDOW (QUOTE WIDTH))
(WINDOWPROP WINDOW (QUOTE HEIGHT)))
WINDOW])
)
(* MOUSE FUNCTIONS)
(DECLARE: EVAL@COMPILE
[PUTPROPS \FM.CHECKREGION MACRO ((WINDOW X Y)
(for ITEM in (WINDOWPROP WINDOW (QUOTE FM.ITEMS))
thereis
(AND (IGREATERP Y (fetch (FREEMENUITEM REGION BOTTOM)
of ITEM))
(IGREATERP X (fetch (FREEMENUITEM REGION LEFT)
of ITEM))
(ILESSP X (IPLUS (fetch (FREEMENUITEM REGION LEFT)
of ITEM)
(fetch (FREEMENUITEM REGION WIDTH)
of ITEM)))
(ILESSP Y (IPLUS (fetch (FREEMENUITEM REGION BOTTOM)
of ITEM)
(fetch (FREEMENUITEM REGION HEIGHT)
of ITEM]
)
(DEFINEQ
(\FM.BUTTONEVENTFN
[LAMBDA (WINDOW) (* jow " 7-Sep-85 23:11")
(TOTOPW WINDOW)
(if (AND (NOT (WINDOWPROP WINDOW (QUOTE FM.BUSY)))
(LASTMOUSESTATE (NOT UP)))
then (* ignore button up events and events when menu is
editing)
(\FM.MENUHANDLER WINDOW])
(\FM.RIGHTBUTTONFN
[LAMBDA (WINDOW) (* jow " 5-Sep-85 23:19")
(* Pop up the window command menu, unless the event occured on the item being edited, in which case ignore, because
editor will take care of it.)
(if [OR (NOT (WINDOWPROP WINDOW (QUOTE FM.EDITITEM)))
(NEQ (\FM.CHECKREGION WINDOW (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW))
(WINDOWPROP WINDOW (QUOTE FM.EDITITEM]
then (DOWINDOWCOM WINDOW])
(\FM.MENUHANDLER
[LAMBDA (WINDOW) (* jow " 6-Sep-85 11:34")
(repeatuntil (MOUSESTATE UP) bind (TIMER ←(SETUPTIMER 0))
ITEM LASTITEM BUTTONS PROMPTFLG
do (SETQ BUTTONS (DECODEBUTTONS))
(SETQ LASTITEM ITEM)
(SETQ ITEM (\FM.CHECKREGION WINDOW (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW)))
(if ITEM
then (COND
((NOT LASTITEM) (* moved on new item)
(APPLY* (FM.ITEMPROP ITEM (QUOTE SYSDOWNFN))
ITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP ITEM (QUOTE DOWNFN))
ITEM WINDOW BUTTONS)
(SETUPTIMER MENUHELDWAIT TIMER)
(SETQ PROMPTFLG T))
((NEQ LASTITEM ITEM) (* jump between items without dead interval.
call last mouseoff, and new mousedown)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE SYSMOVEDFN))
LASTITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE MOVEDFN))
LASTITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP ITEM (QUOTE SYSDOWNFN))
ITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP ITEM (QUOTE DOWNFN))
ITEM WINDOW BUTTONS)
(SETUPTIMER MENUHELDWAIT TIMER)
(SETQ PROMPTFLG T))
((AND PROMPTFLG (TIMEREXPIRED? TIMER))
(* held on item long enough)
(PRINTOUT PROMPTWINDOW T (FM.ITEMPROP ITEM (QUOTE MESSAGE)))
(SETQ PROMPTFLG NIL)))
(APPLY* (FM.ITEMPROP ITEM (QUOTE HELDFN))
ITEM WINDOW BUTTONS)
elseif LASTITEM
then (* moved off item)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE SYSMOVEDFN))
LASTITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE MOVEDFN))
LASTITEM WINDOW BUTTONS))
finally (SETQ LASTITEM ITEM)
(SETQ ITEM (\FM.CHECKREGION WINDOW (LASTMOUSEX WINDOW)
(LASTMOUSEY WINDOW)))
(if LASTITEM
then (COND
((NEQ LASTITEM ITEM) (* moved off item)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE SYSMOVEDFN))
LASTITEM WINDOW BUTTONS)
(APPLY* (FM.ITEMPROP LASTITEM (QUOTE MOVEDFN))
LASTITEM WINDOW BUTTONS))
(ITEM (ADD.PROCESS (BQUOTE (\FM.DOSELECTION , ITEM , WINDOW , BUTTONS))
(QUOTE NAME)
(QUOTE FREEMENU])
(\FM.DOSELECTION
[NLAMBDA (ITEM WINDOW BUTTONS) (* jow " 5-Sep-85 15:12")
(* called when an item gets selected to do its
whenselectedfns.)
(RESETLST (RESETSAVE NIL (LIST (QUOTE WINDOWPROP)
WINDOW
(QUOTE FM.BUSY)
NIL))
(WINDOWPROP WINDOW (QUOTE FM.BUSY)
T)
(APPLY* (FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN))
ITEM WINDOW BUTTONS)
(BLOCK)
(APPLY* (FM.ITEMPROP ITEM (QUOTE SELECTEDFN))
ITEM WINDOW BUTTONS])
)
(* ITEM SUPPORT FUNCTIONS)
(DECLARE: EVAL@COMPILE
[PUTPROPS FM.ITEMPROP MACRO (ARGS (COND ((NEQ (CAADR ARGS)
(QUOTE QUOTE))
(QUOTE IGNOREMACRO))
((CDDR ARGS)
(\FM.CPUTITEMPROP (CAR ARGS)
(CADR ARGS)
(CADDR ARGS)))
((CDR ARGS)
(\FM.CGETITEMPROP (CAR ARGS)
(CADR ARGS]
[PUTPROPS \FM.INSUREFM MACRO ((ITEM)
(if (type? FREEMENUITEM ITEM)
then ITEM else (\ILLEGAL.ARG ITEM]
)
(DEFINEQ
(\FM.GETITEMPROP
[LAMBDA (ITEM PROP) (* jow "29-Aug-85 13:23")
(SELECTQ PROP
(TYPE (fetch (FREEMENUITEM TYPE) of ITEM))
(LABEL (fetch (FREEMENUITEM LABEL) of ITEM))
(ID (fetch (FREEMENUITEM ID) of ITEM))
(STATE (fetch (FREEMENUITEM STATE) of ITEM))
(FONT (fetch (FREEMENUITEM FONT) of ITEM))
(BITMAP (fetch (FREEMENUITEM BITMAP) of ITEM))
(REGION (fetch (FREEMENUITEM REGION) of ITEM))
(MESSAGE (fetch (FREEMENUITEM MESSAGE) of ITEM))
(USERDATA (fetch (FREEMENUITEM USERDATA) of ITEM))
(ITEMPTR (fetch (FREEMENUITEM ITEMPTR) of ITEM))
(SYSDOWNFN (fetch (FREEMENUITEM SYSDOWNFN) of ITEM))
(SYSMOVEDFN (fetch (FREEMENUITEM SYSMOVEDFN) of ITEM))
(SYSSELECTEDFN (fetch (FREEMENUITEM SYSSELECTEDFN) of ITEM))
(DOWNFN (fetch (FREEMENUITEM DOWNFN) of ITEM))
(HELDFN (fetch (FREEMENUITEM HELDFN) of ITEM))
(MOVEDFN (fetch (FREEMENUITEM MOVEDFN) of ITEM))
(SELECTEDFN (fetch (FREEMENUITEM SELECTEDFN) of ITEM))
(LISTGET (fetch (FREEMENUITEM USERDATA) of ITEM)
PROP])
(\FM.PUTITEMPROP
[LAMBDA (ITEM PROP VALUE) (* jow "29-Aug-85 13:29")
(* store new value in item field)
(SELECTQ PROP
(TYPE (ERROR "Can't change the TYPE of an item" VALUE))
(LABEL (PROG1 (fetch (FREEMENUITEM LABEL) of ITEM)
(replace (FREEMENUITEM LABEL) of ITEM with VALUE)))
(ID (PROG1 (fetch (FREEMENUITEM ID) of ITEM)
(replace (FREEMENUITEM ID) of ITEM with VALUE)))
(STATE (PROG1 (fetch (FREEMENUITEM STATE) of ITEM)
(replace (FREEMENUITEM STATE) of ITEM with VALUE)))
(FONT (PROG1 (fetch (FREEMENUITEM FONT) of ITEM)
(replace (FREEMENUITEM FONT) of ITEM with VALUE)))
(BITMAP (PROG1 (fetch (FREEMENUITEM BITMAP) of ITEM)
(replace (FREEMENUITEM BITMAP) of ITEM with VALUE)))
(REGION (PROG1 (fetch (FREEMENUITEM REGION) of ITEM)
(replace (FREEMENUITEM REGION) of ITEM with VALUE)))
(MESSAGE (PROG1 (fetch (FREEMENUITEM MESSAGE) of ITEM)
(replace (FREEMENUITEM MESSAGE) of ITEM with VALUE)))
(USERDATA (ERROR "Can't change the USERDATA of an item" VALUE))
(ITEMPTR (PROG1 (fetch (FREEMENUITEM ITEMPTR) of ITEM)
(replace (FREEMENUITEM ITEMPTR) of ITEM with VALUE)))
(SYSDOWNFN (PROG1 (fetch (FREEMENUITEM SYSDOWNFN) of ITEM)
(replace (FREEMENUITEM SYSDOWNFN) of ITEM with VALUE)))
(SYSMOVEDFN (PROG1 (fetch (FREEMENUITEM SYSMOVEDFN) of ITEM)
(replace (FREEMENUITEM SYSMOVEDFN) of ITEM with VALUE)))
(SYSSELECTEDFN (PROG1 (fetch (FREEMENUITEM SYSSELECTEDFN) of ITEM)
(replace (FREEMENUITEM SYSSELECTEDFN) of ITEM with VALUE)))
(DOWNFN (PROG1 (fetch (FREEMENUITEM DOWNFN) of ITEM)
(replace (FREEMENUITEM DOWNFN) of ITEM with VALUE)))
(HELDFN (PROG1 (fetch (FREEMENUITEM HELDFN) of ITEM)
(replace (FREEMENUITEM HELDFN) of ITEM with VALUE)))
(MOVEDFN (PROG1 (fetch (FREEMENUITEM MOVEDFN) of ITEM)
(replace (FREEMENUITEM MOVEDFN) of ITEM with VALUE)))
(SELECTEDFN (PROG1 (fetch (FREEMENUITEM SELECTEDFN) of ITEM)
(replace (FREEMENUITEM SELECTEDFN) of ITEM with VALUE)))
(PROG1 (LISTGET (fetch (FREEMENUITEM USERDATA) of ITEM)
PROP)
(LISTPUT (fetch (FREEMENUITEM USERDATA) of ITEM)
PROP VALUE])
(\FM.CGETITEMPROP
[LAMBDA (ITEM PROP) (* jow " 6-Sep-85 16:32")
(* macro dispatch function for FM.ITEMPROP. ITEM is bound to the name of the item to be visited, and PROP is bound
to the expression (QUOTE <FIELDNAME>). This function returns the appropriate fetchfield expression to be compiled.
IF THE FREEMENUITEM RECORD IS CHANGED,THIS FUNCTION MUST BE CHANGED ACCORDINGLY)
(SELECTQ (CADR PROP)
[TYPE (BQUOTE (FETCH (FREEMENUITEM TYPE) OF (\FM.INSUREFM , ITEM]
[LABEL (BQUOTE (FETCH (FREEMENUITEM LABEL) OF (\FM.INSUREFM , ITEM]
[ID (BQUOTE (FETCH (FREEMENUITEM ID) OF (\FM.INSUREFM , ITEM]
[STATE (BQUOTE (FETCH (FREEMENUITEM STATE) OF (\FM.INSUREFM , ITEM]
[FONT (BQUOTE (FETCH (FREEMENUITEM FONT) OF (\FM.INSUREFM , ITEM]
[BITMAP (BQUOTE (FETCH (FREEMENUITEM BITMAP) OF (\FM.INSUREFM , ITEM]
[REGION (BQUOTE (FETCH (FREEMENUITEM REGION) OF (\FM.INSUREFM , ITEM]
[MESSAGE (BQUOTE (FETCH (FREEMENUITEM MESSAGE) OF (\FM.INSUREFM , ITEM]
[USERDATA (BQUOTE (FETCH (FREEMENUITEM USERDATA) OF (\FM.INSUREFM , ITEM]
[ITEMPTR (BQUOTE (FETCH (FREEMENUITEM ITEMPTR) OF (\FM.INSUREFM , ITEM]
[SYSDOWNFN (BQUOTE (FETCH (FREEMENUITEM SYSDOWNFN) OF (\FM.INSUREFM , ITEM]
[SYSMOVEDFN (BQUOTE (FETCH (FREEMENUITEM SYSMOVEDFN) OF (\FM.INSUREFM , ITEM]
[SYSSELECTEDFN (BQUOTE (FETCH (FREEMENUITEM SYSSELECTEDFN) OF (\FM.INSUREFM , ITEM]
[DOWNFN (BQUOTE (FETCH (FREEMENUITEM DOWNFN) OF (\FM.INSUREFM , ITEM]
[HELDFN (BQUOTE (FETCH (FREEMENUITEM HELDFN) OF (\FM.INSUREFM , ITEM]
[MOVEDFN (BQUOTE (FETCH (FREEMENUITEM MOVEDFN) OF (\FM.INSUREFM , ITEM]
[SELECTEDFN (BQUOTE (FETCH (FREEMENUITEM SELECTEDFN) OF (\FM.INSUREFM , ITEM]
(BQUOTE (LISTGET (FETCH (FREEMENUITEM USERDATA) OF (\FM.INSUREFM , ITEM))
(QUOTE , (CADR PROP])
(\FM.CPUTITEMPROP
[LAMBDA (ITEM PROP VALUE) (* jow " 6-Sep-85 03:45")
(* macro dispatch function for FM.ITEMPROP. ITEM is bound to the name of the item to be visited, PROP is bound to
the expression ((QUOTE <FIELDNAME>) , and VALUE is bound to the expression to be evaluated at run time to yield the
newvalue.) This function returns the appropriate prog1 expression to be compiled, which will return the old value,
and set the new value of an item prop. IF THE FREEMENUITEM RECORD IS CHANGED,THIS FUNCTION MUST BE CHANGED
ACCORDINGLY)
(SELECTQ (CADR PROP)
(TYPE (ERROR "FreeMenuItem property TYPE not settable" (LIST (QUOTE FM.ITEMPROP)
ITEM PROP VALUE)))
[LABEL (BQUOTE (PROG1 (FETCH (FREEMENUITEM LABEL) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM LABEL) OF , ITEM WITH , VALUE]
[ID (BQUOTE (PROG1 (FETCH (FREEMENUITEM ID) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM ID) OF , ITEM WITH , VALUE]
[STATE (BQUOTE (PROG1 (FETCH (FREEMENUITEM STATE) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM STATE) OF , ITEM WITH , VALUE]
[FONT (BQUOTE (PROG1 (FETCH (FREEMENUITEM FONT) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM FONT) OF , ITEM WITH , VALUE]
[BITMAP (BQUOTE (PROG1 (FETCH (FREEMENUITEM BITMAP) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM BITMAP) OF , ITEM WITH , VALUE]
[REGION (BQUOTE (PROG1 (FETCH (FREEMENUITEM REGION) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM REGION) OF , ITEM WITH , VALUE]
[MESSAGE (BQUOTE (PROG1 (FETCH (FREEMENUITEM MESSAGE) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM MESSAGE) OF , ITEM WITH , VALUE]
(USERDATA (ERROR "FreeMenuItem property USERDATA not settable" (LIST (QUOTE FM.ITEMPROP)
ITEM PROP VALUE)))
[ITEMPTR (BQUOTE (PROG1 (FETCH (FREEMENUITEM ITEMPTR) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM ITEMPTR) OF , ITEM WITH , VALUE]
[SYSDOWNFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM SYSDOWNFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM SYSDOWNFN) OF , ITEM WITH , VALUE]
[SYSMOVEDFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM SYSMOVEDFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM SYSMOVEDFN) OF , ITEM
WITH , VALUE]
[SYSSELECTEDFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM SYSSELECTEDFN)
OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM SYSSELECTEDFN) OF , ITEM
WITH , VALUE]
[DOWNFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM DOWNFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM DOWNFN) OF , ITEM WITH , VALUE]
[HELDFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM HELDFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM HELDFN) OF , ITEM WITH , VALUE]
[MOVEDFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM MOVEDFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM MOVEDFN) OF , ITEM WITH , VALUE]
[SELECTEDFN (BQUOTE (PROG1 (FETCH (FREEMENUITEM SELECTEDFN) OF (\FM.INSUREFM , ITEM))
(REPLACE (FREEMENUITEM SELECTEDFN) OF , ITEM
WITH , VALUE]
(BQUOTE (PROG1 (LISTGET (FETCH (FREEMENUITEM USERDATA) OF (\FM.INSUREFM , ITEM))
(QUOTE , (CADR PROP)))
(LISTPUT (FETCH (FREEMENUITEM USERDATA) OF , ITEM)
(QUOTE , (CADR PROP))
, VALUE])
(\FM.HIGHLIGHTITEM
[LAMBDA (ITEM WINDOW) (* jow " 2-Sep-85 12:21")
(* highlight an item on the screen by inverting)
(if (OPENWP WINDOW)
then (BLTSHADE BLACKSHADE WINDOW NIL NIL NIL NIL (QUOTE INVERT)
(FM.ITEMPROP ITEM (QUOTE REGION])
(\FM.HIGHLIGHTITEMBM
[LAMBDA (ITEM) (* jow "12-Aug-85 12:57")
(* highlights an items cached bitmap by inverting it)
(BLTSHADE BLACKSHADE (FM.ITEMPROP ITEM (QUOTE BITMAP))
NIL NIL NIL NIL (QUOTE INVERT])
)
(* MOMENTARY ITEM FUNCTIONS)
(DEFINEQ
(\FM.MOMENTARY-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 5-Sep-85 15:16")
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will select this item when you release the button."))
(FM.ITEMPROP ITEM (QUOTE SYSDOWNFN)
(FUNCTION \FM.HIGHLIGHTITEM))
(FM.ITEMPROP ITEM (QUOTE SYSMOVEDFN)
(FUNCTION \FM.HIGHLIGHTITEM))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.MOMENTARY-SELECTEDFN])
(\FM.MOMENTARY-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 5-Sep-85 15:23")
(* setup unhighlighting on the way out by puttin in a
resetsave. we know we got called from \fm.doselection,
which RESETLISTs.)
(RESETSAVE NIL (LIST (QUOTE FM.REDISPLAYITEM)
ITEM WINDOW])
)
(* TOGGLE ITEM FUNCTIONS)
(DEFINEQ
(\FM.TOGGLE-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 3-Sep-85 15:49")
(* toggle items initial state NIL)
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will toggle this item when you release the button."))
(FM.ITEMPROP ITEM (QUOTE SYSDOWNFN)
(FUNCTION \FM.HIGHLIGHTITEM))
(FM.ITEMPROP ITEM (QUOTE SYSMOVEDFN)
(FUNCTION \FM.HIGHLIGHTITEM)) (* movedfn same as selectedfn for momentary)
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.TOGGLE-SELECTEDFN))
(IF (LISTGET DESCRIPTION (QUOTE STATE))
THEN (\FM.TOGGLE-SELECTEDFN ITEM])
(\FM.TOGGLE-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:49")
(* changes state of toggle, and saves state bitmap)
(\FM.HIGHLIGHTITEMBM ITEM) (* highlight bitmap to reflect new state)
(if (FM.ITEMPROP ITEM (QUOTE STATE))
then (FM.ITEMPROP ITEM (QUOTE STATE)
NIL)
else (FM.ITEMPROP ITEM (QUOTE STATE)
T])
)
(* 3STATE ITEM FUNCTIONS)
(DEFINEQ
(\FM.3STATE-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 4-Sep-85 15:09")
(* second pass of 3state creation.
get a copy of the neutral item bitmap for state change
purposes.)
[FM.ITEMPROP ITEM (QUOTE SAVEDBM)
(BITMAPCOPY (FM.ITEMPROP ITEM (QUOTE BITMAP]
(FM.ITEMPROP ITEM (QUOTE STATE)
(QUOTE NEUTRAL))
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will change item to this state when you release the button."))
(FM.ITEMPROP ITEM (QUOTE SYSDOWNFN)
(FUNCTION \FM.3STATE-DOWNFN))
(FM.ITEMPROP ITEM (QUOTE SYSMOVEDFN)
(FUNCTION FM.REDISPLAYITEM))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.3STATE-SELECTEDFN))
(if (MEMB (QUOTE STATE)
DESCRIPTION)
then (\FM.3STATE-CHANGESTATE ITEM (LISTGET DESCRIPTION (QUOTE STATE))
STREAM])
(\FM.3STATE-DOWNFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:41")
(* called when mouse down over 3state item.
rotates the state of ITEM on the screen.
The order is NEUTRAL -
T -
NIL)
(if (EQ (FM.ITEMPROP ITEM (QUOTE STATE))
(QUOTE NEUTRAL))
then (* neutral to on: inverse item in window)
(\FM.HIGHLIGHTITEM ITEM WINDOW)
elseif (FM.ITEMPROP ITEM (QUOTE STATE))
then (* on to off: get savedbm, then draw line on window)
(LET* ((REGION (FM.ITEMPROP ITEM (QUOTE REGION)))
(X1 (fetch (REGION LEFT) of REGION))
(Y1 (fetch (REGION BOTTOM) of REGION))
(X2 (IPLUS X1 (fetch (REGION WIDTH) of REGION)
-1))
(Y2 (IPLUS Y1 (fetch (REGION HEIGHT) of REGION)
-2)))
(BITBLT (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 WINDOW (fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION))
(DRAWLINE X1 Y1 X2 Y2 2 (QUOTE REPLACE)
WINDOW))
else (* off to neutral: get savedbm)
(BITBLT (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 WINDOW (fetch (REGION LEFT) of (FM.ITEMPROP ITEM (QUOTE REGION)))
(fetch (REGION BOTTOM) of (FM.ITEMPROP ITEM (QUOTE REGION])
(\FM.3STATE-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:41")
(* called when 3state item selected.
rotates the state of ITEM and its bitmap.
The order is NEUTRAL -
T -
NIL)
(LET [(STREAM (WINDOWPROP WINDOW (QUOTE FM.STREAM]
(SELECTQ (FM.ITEMPROP ITEM (QUOTE STATE))
(NEUTRAL (* neutral to on:)
(\FM.3STATE-CHANGESTATE ITEM T STREAM))
(T (* on to off:)
(\FM.3STATE-CHANGESTATE ITEM NIL STREAM))
(NIL (* off to neutral:)
(\FM.3STATE-CHANGESTATE ITEM (QUOTE NEUTRAL)
STREAM))
NIL])
(\FM.3STATE-CHANGESTATE
[LAMBDA (ITEM NEWSTATE STREAM) (* jow " 2-Sep-85 17:59")
(SELECTQ NEWSTATE
(T (* to on: inverse item saved bitmap)
(BITBLT (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
0 0 NIL NIL (QUOTE INVERT))
(FM.ITEMPROP ITEM (QUOTE STATE)
T))
(NIL (* to off: get savedbm, then draw line on it)
(BITBLT (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
0 0)
(DSPDESTINATION (FM.ITEMPROP ITEM (QUOTE BITMAP))
STREAM)
(DRAWLINE 0 0 [SUB1 (BITMAPWIDTH (FM.ITEMPROP ITEM (QUOTE BITMAP]
(IDIFFERENCE (BITMAPHEIGHT (FM.ITEMPROP ITEM (QUOTE BITMAP)))
2)
2
(QUOTE REPLACE)
STREAM)
(FM.ITEMPROP ITEM (QUOTE STATE)
NIL))
(NEUTRAL (* to neutral: just copy savedbm)
(BITBLT (FM.ITEMPROP ITEM (QUOTE SAVEDBM))
0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
0 0)
(FM.ITEMPROP ITEM (QUOTE STATE)
(QUOTE NEUTRAL)))
NIL])
)
(* NWAY ITEM FUNCTIONS)
(DEFINEQ
(\FM.NWAY-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow "29-Aug-85 13:34")
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will select this item from the group"))
(FM.ITEMPROP ITEM (QUOTE SYSDOWNFN)
(FUNCTION \FM.NWAY-DOWNFN))
(FM.ITEMPROP ITEM (QUOTE SYSMOVEDFN)
(FUNCTION \FM.NWAY-MOVEDFN))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.NWAY-SELECTEDFN])
(\FM.NWAY-DOWNFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:44")
(* if middle button: show group with no item selected.
else show group with this item selected)
(LET [(BOSS (if (FM.ITEMPROP ITEM (QUOTE GROUP.BOSS))
then ITEM
else (FM.ITEMPROP ITEM (QUOTE ITEMPTR]
(if (FM.ITEMPROP BOSS (QUOTE STATE))
then (* an item is currently selected: unhighlight it)
(\FM.HIGHLIGHTITEM (FM.ITEMPROP BOSS (QUOTE ITEMPTR))
WINDOW))
(if (NEQ (CAR BUTTONS)
(QUOTE MIDDLE))
then (\FM.HIGHLIGHTITEM ITEM WINDOW])
(\FM.NWAY-MOVEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:45")
(* redisplay the currently selected item, and if not
middle button, also unhighlight this item.)
(LET [(BOSS (if (FM.ITEMPROP ITEM (QUOTE GROUP.BOSS))
then ITEM
else (FM.ITEMPROP ITEM (QUOTE ITEMPTR]
(if (FM.ITEMPROP BOSS (QUOTE STATE))
then (* there is an item currently selected to redisplay)
(FM.REDISPLAYITEM (FM.ITEMPROP BOSS (QUOTE ITEMPTR))
WINDOW))
(if (NEQ (CAR BUTTONS)
(QUOTE MIDDLE))
then (FM.REDISPLAYITEM ITEM WINDOW])
(\FM.NWAY-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:45")
(* if the current state is not NIL, then the currently selected item's bitmap is unhighlighted.
This item becomes the currently selected one, and it's bitmap is highlighted.)
(LET [(BOSS (if (FM.ITEMPROP ITEM (QUOTE GROUP.BOSS))
then ITEM
else (FM.ITEMPROP ITEM (QUOTE ITEMPTR]
(if (NEQ (CAR BUTTONS)
(QUOTE MIDDLE))
then (* new item selected)
[if (FM.ITEMPROP BOSS (QUOTE STATE))
then (\FM.HIGHLIGHTITEMBM (FM.ITEMPROP BOSS (QUOTE ITEMPTR]
(\FM.HIGHLIGHTITEMBM ITEM)
(FM.ITEMPROP BOSS (QUOTE ITEMPTR)
ITEM) (* make boss point to this item)
(FM.ITEMPROP BOSS (QUOTE STATE)
(FM.ITEMPROP ITEM (QUOTE LABEL)))
else (* group unselected)
(if (FM.ITEMPROP BOSS (QUOTE STATE))
then (\FM.HIGHLIGHTITEMBM (FM.ITEMPROP BOSS (QUOTE ITEMPTR)))
(FM.ITEMPROP BOSS (QUOTE STATE)
NIL])
)
(* NCHOOSE ITEM FUNCTIONS)
(DEFINEQ
(\FM.NCHOOSE-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 5-Sep-85 10:32")
(* Here the bitmap for the item is calculated, large enough to hold the largest of the n sub items.
The TAILPTR is calculated and saved to point to the beginning of the value part of the item.
The item's state is initialized to the first of the sub items. The region is calculated to fit the item in its
current state. The subitems list is replaced with a menu of those items. Finally the window size is recalculated to
accomodate this new item.)
(LET* [(LABEL (FM.ITEMPROP ITEM (QUOTE LABEL)))
(FONT (FM.ITEMPROP ITEM (QUOTE FONT)))
(ITEMS (LISTGET DESCRIPTION (QUOTE ITEMS)))
[ITEMFONT (APPLY (FUNCTION FONTCREATE)
(LISTGET DESCRIPTION (QUOTE ITEMFONT]
(STATE (OR (LISTGET DESCRIPTION (QUOTE STATE))
(CAR ITEMS)))
(BIGWIDTH (IMAX (for I in ITEMS largest (\FM.ITEMWIDTH I ITEMFONT) finally (RETURN
$$EXTREME))
(\FM.ITEMWIDTH STATE ITEMFONT)))
(BIGHEIGHT (IMAX (for I in ITEMS largest (\FM.ITEMHEIGHT I ITEMFONT) finally (RETURN
$$EXTREME))
(\FM.ITEMHEIGHT STATE ITEMFONT]
(if [NOT (AND ITEMS (for I in ITEMS always (OR (ATOM I)
(STRINGP I)
(BITMAPP I]
then (ERROR "Invalid ITEMS: List of atoms, strings, or bitmaps expected:" DESCRIPTION))
(FM.ITEMPROP ITEM (QUOTE ITEMFONT)
ITEMFONT)
(FM.ITEMPROP ITEM (QUOTE BITMAP)
(\FM.GETBITMAP STREAM LABEL FONT (IPLUS (\FM.ITEMWIDTH LABEL FONT)
(CHARWIDTH (CHARCODE SPACE)
FONT)
BIGWIDTH)
BIGHEIGHT)) (* GETBITMAP leaves STREAM pointing to BITMAP.)
(FM.ITEMPROP ITEM (QUOTE STATE)
STATE)
(FM.ITEMPROP ITEM (QUOTE TAILPTR)
(IPLUS (\FM.ITEMWIDTH LABEL FONT)
(CHARWIDTH (CHARCODE SPACE)
FONT)))
(if (BITMAPP STATE)
then (BITBLT STATE 0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
(FM.ITEMPROP ITEM (QUOTE TAILPTR))
0)
else (DSPXPOSITION (FM.ITEMPROP ITEM (QUOTE TAILPTR))
STREAM)
(DSPYPOSITION (FONTPROP ITEMFONT (QUOTE DESCENT))
STREAM)
(DSPFONT ITEMFONT STREAM)
(PRIN1 STATE STREAM))
(replace (REGION WIDTH) of (FM.ITEMPROP ITEM (QUOTE REGION))
with (IPLUS (FM.ITEMPROP ITEM (QUOTE TAILPTR))
(\FM.ITEMWIDTH STATE ITEMFONT)))
(replace (REGION HEIGHT) of (FM.ITEMPROP ITEM (QUOTE REGION))
with (IMAX (FONTPROP FONT (QUOTE HEIGHT))
(\FM.ITEMHEIGHT STATE ITEMFONT)))
(EXTENDREGION INTERIOR (CREATEREGION (fetch (REGION LEFT) of (FM.ITEMPROP ITEM
(QUOTE REGION)))
0
(BITMAPWIDTH (FM.ITEMPROP ITEM (QUOTE BITMAP)))
0))
(FM.ITEMPROP ITEM (QUOTE ITEMS)
(create MENU
ITEMS ← ITEMS
CENTERFLG ← T
MENUFONT ← ITEMFONT
TITLE ←(OR (LISTGET DESCRIPTION (QUOTE ITEMTITLE))
LABEL)))
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will let you select a value from a pop up menu."))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.NCHOOSE-SELECTEDFN])
(\FM.NCHOOSE-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 5-Sep-85 10:26")
(* pop up the subitems menu.
if an item is selected, change the state, and
redisplay)
(LET [(CHOICE (MENU (FM.ITEMPROP ITEM (QUOTE ITEMS]
(if CHOICE
then (if (OPENWP WINDOW)
then (DSPFILL (FM.ITEMPROP ITEM (QUOTE REGION))
WHITESHADE NIL WINDOW))
(\FM.NCHOOSE-CHANGESTATE ITEM CHOICE (WINDOWPROP WINDOW (QUOTE FM.STREAM)))
(FM.REDISPLAYITEM ITEM WINDOW])
(\FM.NCHOOSE-CHANGESTATE
[LAMBDA (ITEM NEWSTATE STREAM) (* jow " 4-Sep-85 17:08")
(* make NEWSTATE the current state, then redisplay the
item to update the screen.)
(LET [(ITEMFONT (FM.ITEMPROP ITEM (QUOTE ITEMFONT)))
(REGION (FM.ITEMPROP ITEM (QUOTE REGION] (* setup display stream to update item bitmap)
(BLTSHADE WHITESHADE (FM.ITEMPROP ITEM (QUOTE BITMAP))
(FM.ITEMPROP ITEM (QUOTE TAILPTR))
0)
(if (BITMAPP NEWSTATE)
then (BITBLT NEWSTATE 0 0 (FM.ITEMPROP ITEM (QUOTE BITMAP))
(FM.ITEMPROP ITEM (QUOTE TAILPTR))
0)
else (DSPDESTINATION (FM.ITEMPROP ITEM (QUOTE BITMAP))
STREAM)
(DSPXPOSITION (FM.ITEMPROP ITEM (QUOTE TAILPTR))
STREAM)
(DSPYPOSITION (FONTPROP ITEMFONT (QUOTE DESCENT))
STREAM)
(DSPFONT ITEMFONT STREAM)
(PRIN1 NEWSTATE STREAM)) (* recalculate region for new choice)
(replace (REGION WIDTH) of REGION with (IPLUS (FM.ITEMPROP ITEM (QUOTE TAILPTR))
(\FM.ITEMWIDTH NEWSTATE ITEMFONT)))
(replace (REGION HEIGHT) of REGION with (IMAX (FONTPROP (FM.ITEMPROP ITEM (QUOTE FONT))
(QUOTE HEIGHT))
(\FM.ITEMHEIGHT NEWSTATE ITEMFONT)))
(FM.ITEMPROP ITEM (QUOTE STATE)
NEWSTATE])
)
(* EDIT ITEMS)
(DECLARE: EVAL@COMPILE
(RPAQQ \FM.EDIT-RIGHTENDSPACE 5)
(RPAQQ \FM.EDIT-BLOCKSIZE 50)
(CONSTANTS (\FM.EDIT-RIGHTENDSPACE 5)
(\FM.EDIT-BLOCKSIZE 50))
)
(RPAQQ \FM.EDIT-TTBL NIL)
(DECLARE: EVAL@COMPILE
[PUTPROPS \FM.EDIT-MAXWIDTH MACRO (NIL (OR (FM.ITEMPROP EDITITEM (QUOTE MAXWIDTH))
(IDIFFERENCE (WINDOWPROP WINDOW (QUOTE WIDTH))
LEFT]
(PUTPROPS \FM.EDIT-SCROLLAMOUNT MACRO (NIL (IQUOTIENT (WINDOWPROP WINDOW (QUOTE WIDTH))
2)))
)
(DEFINEQ
(\FM.EDIT-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 5-Sep-85 12:00")
(* second pass of creating edit item. must setup bitmap and region fields, and save maxwidth and editstopflg fields.
Create bitmap maxwidth + rightendspace bits wide, to ensure always have white space at end of real string in
bitmap.)
(if (BITMAPP (FM.ITEMPROP ITEM (QUOTE LABEL)))
then (ERROR "Edit items must be strings or atoms." DESCRIPTION))
(OR \FM.EDIT-TTBL (\FM.EDIT-SETUPTTBL)) (* since have edit item, setup term table)
[if (LISTGET DESCRIPTION (QUOTE EDITSTOPFLG))
then (FM.ITEMPROP ITEM (QUOTE EDITSTOPFLG)
(LISTGET DESCRIPTION (QUOTE EDITSTOPFLG]
[if (LISTGET DESCRIPTION (QUOTE MAXWIDTH))
then (FM.ITEMPROP ITEM (QUOTE MAXWIDTH)
(LISTGET DESCRIPTION (QUOTE MAXWIDTH)))
(IF [NOT (FIXP (FM.ITEMPROP ITEM (QUOTE MAXWIDTH]
THEN (ERROR "Invalid MAXWIDTH. Fixp expected:" DESCRIPTION))
(if (IGREATERP (IPLUS (STRINGWIDTH (FM.ITEMPROP ITEM (QUOTE LABEL)))
\FM.EDIT-RIGHTENDSPACE)
(FM.ITEMPROP ITEM (QUOTE MAXWIDTH)))
then (ERROR "LABEL won't fit in MAXWIDTH" ITEM))
(* maxwidth implies stop there.)
(FM.ITEMPROP ITEM (QUOTE EDITSTOPFLG)
T) (* create bitmap of max possible size)
(FM.ITEMPROP ITEM (QUOTE BITMAP)
(\FM.GETBITMAP STREAM (FM.ITEMPROP ITEM (QUOTE LABEL))
(FM.ITEMPROP ITEM (QUOTE FONT))
(IPLUS (FM.ITEMPROP ITEM (QUOTE MAXWIDTH))
\FM.EDIT-RIGHTENDSPACE)))
(EXTENDREGION INTERIOR (CREATEREGION (fetch (REGION LEFT) of (FM.ITEMPROP ITEM
(QUOTE REGION))
)
0
(FM.ITEMPROP ITEM (QUOTE MAXWIDTH))
0))
else (* since variable max size, create bitmap of size of
initial string, but at least \FM.EDITBLOCKSIZE bits
wide.)
(FM.ITEMPROP ITEM (QUOTE BITMAP)
(\FM.GETBITMAP STREAM (FM.ITEMPROP ITEM (QUOTE LABEL))
(FM.ITEMPROP ITEM (QUOTE FONT))
(IMAX (IPLUS (STRINGWIDTH (FM.ITEMPROP ITEM (QUOTE LABEL))
(FM.ITEMPROP ITEM (QUOTE FONT)))
\FM.EDIT-RIGHTENDSPACE)
\FM.EDIT-BLOCKSIZE]
(* increase region after string to allow mousing at end
of string)
(replace (REGION WIDTH) of (FM.ITEMPROP ITEM (QUOTE REGION))
with (IPLUS (fetch (REGION WIDTH) of (FM.ITEMPROP ITEM (QUOTE REGION)))
\FM.EDIT-RIGHTENDSPACE))
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will start editing at this position."))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.EDIT-ITEM])
(\FM.EDIT-SETUPTTBL
[LAMBDA NIL (* jow "11-Aug-85 21:38")
(* creates a new term table in \FM.TTBL with no line
buffering or control character echoing.)
(SETQ \FM.EDIT-TTBL (COPYTERMTABLE))
(CONTROL T \FM.EDIT-TTBL)
(ECHOMODE NIL \FM.EDIT-TTBL)
(for CC from 0 to 31 do (ECHOCONTROL CC (QUOTE IGNORE)
\FM.EDIT-TTBL])
(\FM.EDIT-ITEM
[LAMBDA (EDITITEM WINDOW BUTTONS STARTFLG) (* jow " 3-Sep-85 15:42")
(* called when an edit item gets selected. If STARTFLG is T, start editing the item at the beginning, rather than at
the current mouse position.)
(LET ((FONT (FM.ITEMPROP EDITITEM (QUOTE FONT)))
(BITMAP (FM.ITEMPROP EDITITEM (QUOTE BITMAP)))
(REGION (FM.ITEMPROP EDITITEM (QUOTE REGION)))
[LEFT (fetch (REGION LEFT) of (FM.ITEMPROP EDITITEM (QUOTE REGION]
(EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
(EDITSTOPFLG (FM.ITEMPROP EDITITEM (QUOTE EDITSTOPFLG)))
(STREAM (WINDOWPROP WINDOW (QUOTE FM.STREAM)))
CHCODE CHARWIDTH STRINGPTR TAILPTR MOUSEX MOUSEY ITEM NEWWIDTH POINTER)
(* setup edit pointer info)
[SETQ POINTER (if STARTFLG
then (CONS 1 0)
else (\FM.EDIT-GETPOINTERINFO (FM.ITEMPROP EDITITEM (QUOTE LABEL))
FONT REGION (LASTMOUSEX WINDOW]
(SETQ STRINGPTR (CAR POINTER))
(SETQ TAILPTR (CDR POINTER)) (* setup window x and y position, so caret it right
place)
(DSPXPOSITION (IPLUS (fetch (REGION LEFT) of REGION)
(CDR POINTER))
WINDOW)
(DSPYPOSITION (IPLUS (fetch (REGION BOTTOM) of REGION)
(FONTPROP FONT (QUOTE DESCENT)))
WINDOW) (* setup edit stream, used for printing inserted
characters to the bitmap)
(DSPDESTINATION (FM.ITEMPROP EDITITEM (QUOTE BITMAP))
STREAM)
(DSPXPOSITION (CDR POINTER)
STREAM)
(DSPYPOSITION (FONTPROP FONT (QUOTE DESCENT))
STREAM)
(DSPFONT FONT STREAM)
(TTY.PROCESS (THIS.PROCESS))
(RESETLST (RESETSAVE (CURSOR T)) (* setup system)
(RESETSAVE (TTYDISPLAYSTREAM WINDOW))
(RESETSAVE (SETTERMTABLE \FM.EDIT-TTBL))
(RESETSAVE NIL (LIST (QUOTE WINDOWPROP)
WINDOW
(QUOTE FM.EDITITEM)
NIL))
(WINDOWPROP WINDOW (QUOTE FM.EDITITEM)
EDITITEM)
(do (* wait for mouse event or key struck.
while waiting, call tty fns to make caret flash, etc,)
(until (OR (MOUSESTATE (NOT UP))
(READP))
do (\TTYBACKGROUND)) (* wait for event)
(if (LASTMOUSESTATE (NOT UP))
then (SETQ BUTTONS (DECODEBUTTONS))
(SETQ MOUSEX (LASTMOUSEX WINDOW))
(SETQ MOUSEY (LASTMOUSEY WINDOW))
(SETQ ITEM (\FM.CHECKREGION WINDOW MOUSEX MOUSEY))
[if (EQ (CAR BUTTONS)
(QUOTE RIGHT))
then (if (EQ ITEM EDITITEM)
then (\FM.EDIT-DELETE)
else (* let right buttonfn run)
(BLOCK))
else (COND
((EQ ITEM EDITITEM)
(\FM.EDIT-MOVECARET))
(ITEM (\CARET.DOWN)
(\FM.MENUHANDLER WINDOW)
(RETURN))
(T (* let other button events run)
(BLOCK]
else (SETQ CHCODE (\GETKEY))
(SELCHARQ CHCODE
((CR ↑X)
(RETURN))
((↑A BS DEL) (* backup char,)
(\FM.EDIT-BACKUP))
(↑W (* delete word)
NIL)
(\FM.EDIT-INSERT])
(\FM.EDIT-BACKUP
[LAMBDA NIL (* jow "22-Aug-85 13:18")
(* backup 1 character, if possible)
(if (IGREATERP STRINGPTR 1)
then (SETQ STRINGPTR (SUB1 STRINGPTR))
(SETQ CHARWIDTH (CHARWIDTH (NTHCHARCODE (FM.ITEMPROP EDITITEM (QUOTE LABEL))
STRINGPTR)
FONT))
(RELMOVETO (MINUS CHARWIDTH)
0 WINDOW)
(RELMOVETO (MINUS CHARWIDTH)
0 STREAM)
(if (ILESSP (DSPXPOSITION NIL WINDOW)
(fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL WINDOW)))
then (SCROLLW WINDOW (\FM.EDIT-SCROLLAMOUNT)
0) (* about to backup off window: scroll.)
)
(BITBLT BITMAP TAILPTR 0 BITMAP (IDIFFERENCE TAILPTR CHARWIDTH)
0)
(replace (REGION WIDTH) of REGION with (IDIFFERENCE (fetch (REGION WIDTH) of REGION)
CHARWIDTH))
(\FM.EDIT-UPDATEAFTERDELETE)
(FM.ITEMPROP EDITITEM (QUOTE LABEL)
(\FM.EDIT-STRDELETE (FM.ITEMPROP EDITITEM (QUOTE LABEL))
STRINGPTR STRINGPTR))
(SETQ TAILPTR (IDIFFERENCE TAILPTR CHARWIDTH])
(\FM.EDIT-INSERT
[LAMBDA NIL (* jow " 2-Sep-85 17:24")
(* insert a single character, CHARCODE into the string)
(if (AND (IGEQ CHCODE (CHARCODE SPACE))
(ILESSP CHCODE (CHARCODE DEL)))
then (* have good char to insert)
(SETQ CHARWIDTH (CHARWIDTH CHCODE FONT))
(SETQ NEWWIDTH (IPLUS (fetch (REGION WIDTH) of REGION)
CHARWIDTH))
(if (OR (NOT EDITSTOPFLG)
(ILESSP NEWWIDTH (\FM.EDIT-MAXWIDTH)))
then (* i am going to insert)
(RELMOVETO CHARWIDTH 0 WINDOW)
(if [IGREATERP (DSPXPOSITION NIL WINDOW)
(IPLUS (fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL WINDOW))
(fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW]
then (* about to type off window: scroll back.)
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
(SCROLLW WINDOW (MINUS (\FM.EDIT-SCROLLAMOUNT))
0))
(if (IGREATERP (IPLUS LEFT NEWWIDTH)
(WINDOWPROP WINDOW (QUOTE WIDTH)))
then (* pushed text off edge of window.
turn on scrolling)
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN)))
(if (IGREATERP NEWWIDTH (BITMAPWIDTH BITMAP))
then (* current bitmap too small, make new one)
(FM.ITEMPROP EDITITEM (QUOTE BITMAP)
(BITMAPCREATE (IPLUS (BITMAPWIDTH BITMAP)
\FM.EDIT-BLOCKSIZE)
(BITMAPHEIGHT BITMAP)))
(BITBLT BITMAP 0 0 (FM.ITEMPROP EDITITEM (QUOTE BITMAP))
0 0)
(SETQ BITMAP (FM.ITEMPROP EDITITEM (QUOTE BITMAP)))
(DSPDESTINATION BITMAP STREAM))
(\CARET.DOWN) (* now insert character into bitmap)
(BITBLT BITMAP TAILPTR 0 BITMAP (IPLUS TAILPTR CHARWIDTH)
0)
(PRIN1 (CHARACTER CHCODE)
STREAM)
(replace (REGION WIDTH) of REGION with NEWWIDTH)
(FM.REDISPLAYITEM EDITITEM WINDOW)
(FM.ITEMPROP EDITITEM (QUOTE LABEL)
(\FM.EDIT-STRINSERT (FM.ITEMPROP EDITITEM (QUOTE LABEL))
(CHARACTER CHCODE)
STRINGPTR))
(EXTENDREGION EXTENT REGION)
(SETQ STRINGPTR (ADD1 STRINGPTR))
(SETQ TAILPTR (IPLUS TAILPTR CHARWIDTH])
(\FM.EDIT-DELETE
[LAMBDA NIL (* jow " 2-Sep-85 17:25")
(* Called when a right button event occurs in ITEM's region, while it is being edited. Delete the substring of the
items string starting at the current position, and ending at the position of MOUSEX, inclusive.)
(while (MOUSESTATE (NOT UP))
bind (BOTTOM ←(fetch (REGION BOTTOM) of REGION))
(HEIGHT ←(FONTPROP FONT (QUOTE HEIGHT)))
POINTER OLDPOINTER PIVOT END
first (SETQ PIVOT (IPLUS LEFT TAILPTR))
(\CARET.DOWN)
eachtime (SETQ MOUSEX (LASTMOUSEX WINDOW))
(SETQ MOUSEY (LASTMOUSEY WINDOW))
do (if (INSIDEP REGION MOUSEX MOUSEY)
then (SETQ OLDPOINTER POINTER)
(SETQ POINTER (\FM.EDIT-GETPOINTERINFO (FM.ITEMPROP EDITITEM (QUOTE LABEL))
FONT REGION MOUSEX))
[if (NOT (EQUAL POINTER OLDPOINTER))
then (SETQ END (IPLUS LEFT (CDR POINTER)))
(FM.REDISPLAYITEM EDITITEM WINDOW)
(if (IGREATERP END PIVOT)
then (* highlight from pivot to end)
(BLTSHADE BLACKSHADE WINDOW PIVOT BOTTOM (IDIFFERENCE END PIVOT)
HEIGHT
(QUOTE INVERT))
else (* highlight from end to pivot)
(BLTSHADE BLACKSHADE WINDOW END BOTTOM (IDIFFERENCE PIVOT END)
HEIGHT
(QUOTE INVERT]
else (FM.REDISPLAYITEM EDITITEM WINDOW))
finally (if (AND (INSIDEP REGION MOUSEX MOUSEY)
(NEQ (CAR POINTER)
STRINGPTR))
then (if (IGREATERP END PIVOT)
then (* from current to right: pointers and xpositions
remain the same)
(BITBLT BITMAP (CDR POINTER)
0 BITMAP TAILPTR 0)
[FM.ITEMPROP EDITITEM (QUOTE LABEL)
(\FM.EDIT-STRDELETE (FM.ITEMPROP EDITITEM (QUOTE LABEL))
STRINGPTR
(SUB1 (CAR POINTER]
else (* from current to left:)
(BITBLT BITMAP TAILPTR 0 BITMAP (CDR POINTER)
0)
(FM.ITEMPROP EDITITEM (QUOTE LABEL)
(\FM.EDIT-STRDELETE (FM.ITEMPROP EDITITEM (QUOTE LABEL))
(CAR POINTER)
(SUB1 STRINGPTR)))
(SETQ STRINGPTR (CAR POINTER))
(SETQ TAILPTR (CDR POINTER))
(DSPXPOSITION END WINDOW)
(DSPXPOSITION (CDR POINTER)
STREAM))
(replace (REGION WIDTH) of REGION with (IPLUS (STRINGWIDTH
(FM.ITEMPROP EDITITEM
(QUOTE LABEL))
FONT)
\FM.EDIT-RIGHTENDSPACE))
(\FM.EDIT-UPDATEAFTERDELETE])
(\FM.EDIT-GETPOINTERINFO
[LAMBDA (STRING FONT REGION MOUSEX) (* jow " 1-Aug-85 12:19")
(* calculate string pointer and tail pointer from mouse location within string. Assume mousex in window coordinates,
not REGION coordinates. Return as dotted pair (stringptr . tailptr) -- Each character is sensitive 3 bits to the
left to allow for mousing between chars)
(SETQ MOUSEX (IDIFFERENCE MOUSEX (fetch (REGION LEFT) of REGION)))
(LET ((PTR))
(for N (WIDTH ← -3) from 1 to (NCHARS STRING)
do (SETQ WIDTH (IPLUS WIDTH (CHARWIDTH (NTHCHARCODE STRING N)
FONT)))
(if (IGREATERP WIDTH MOUSEX)
then (SETQ PTR N)
(RETURN)))
(if PTR
then (* mouse at PTR in string)
(CONS PTR (STRINGWIDTH (OR (SUBSTRING STRING 1 (SUB1 PTR))
"")
FONT))
else (* mouse at end of string)
(CONS (ADD1 (NCHARS STRING))
(STRINGWIDTH STRING FONT])
(\FM.EDIT-MOVECARET
[LAMBDA NIL (* jow "22-Aug-85 12:43")
(* mouse event has occured at MOUSEX in ITEM's region
while editing. Move the edit caret to that position)
(SETQ POINTER (\FM.EDIT-GETPOINTERINFO (FM.ITEMPROP EDITITEM (QUOTE LABEL))
FONT REGION MOUSEX))
(DSPXPOSITION (IPLUS LEFT (CDR POINTER))
WINDOW) (* move caret)
(SETQ STRINGPTR (CAR POINTER)) (* update edit pointers)
(SETQ TAILPTR (CDR POINTER))
(DSPXPOSITION (CDR POINTER)
STREAM])
(\FM.EDIT-STRDELETE
[LAMBDA (STRING N M) (* jow "17-Jul-85 00:29")
(* delete from characters N through M of STRING.
no bounds checks are made on N and M.
returns a new string)
(CONCAT (OR (SUBSTRING STRING 1 (SUB1 N))
"")
(OR (SUBSTRING STRING (ADD1 M)
(NCHARS STRING))
""])
(\FM.EDIT-STRINSERT
[LAMBDA (STRING CHAR N) (* jow "17-Jul-85 00:40")
(* return new string with CHAR inserted as new
character at position N. just appends CHAR if N is 1
greater than nchars)
(CONCAT (OR (SUBSTRING STRING 1 (SUB1 N))
"")
CHAR
(OR (SUBSTRING STRING N (NCHARS STRING))
""])
(\FM.EDIT-UPDATEAFTERDELETE
[LAMBDA NIL (* jow " 2-Sep-85 17:25")
(* called to update the screen after a delete has
occured.)
(\CARET.DOWN)
(FM.REDISPLAYITEM EDITITEM WINDOW) (* whiteout to rightmargin)
(BLTSHADE WHITESHADE WINDOW (IPLUS (fetch (REGION LEFT) of REGION)
(fetch (REGION WIDTH) of REGION))
(fetch (REGION BOTTOM) of REGION)
(IDIFFERENCE (\FM.EDIT-MAXWIDTH)
(fetch (REGION WIDTH) of REGION))
(FONTPROP FONT (QUOTE HEIGHT])
)
(* EDITSTART ITEM FUNCTIONS)
(DEFINEQ
(\FM.EDITSTART-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow " 2-Sep-85 18:54")
(* Put the list of ITEMS into the ITEMPTR field of this
editstart item.)
(FM.ITEMPROP ITEM (QUOTE ITEMPTR)
(LISTGET DESCRIPTION (QUOTE ITEMS)))
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
"Will start editing the associated items."))
(FM.ITEMPROP ITEM (QUOTE SYSSELECTEDFN)
(FUNCTION \FM.EDITSTART-SELECTEDFN])
(\FM.EDITSTART-SELECTEDFN
[LAMBDA (ITEM WINDOW BUTTONS) (* jow " 3-Sep-85 15:59")
(* start editing at the beginning of each of the items
in the ITEMPTR list.)
(for ID EDITITEM in (FM.ITEMPROP ITEM (QUOTE ITEMPTR)) WHEN (TYPE? FREEMENUITEM
(SETQ EDITITEM
(FM.ITEMFROMID WINDOW ID)))
do (if [AND (WINDOWPROP WINDOW (QUOTE SCROLLFN))
(NOT (SUBREGIONP (DSPCLIPPINGREGION NIL WINDOW)
(FM.ITEMPROP EDITITEM (QUOTE REGION]
then (* window is scrolling and not all of edititem is
visible: ensure that left of item is in window)
(SCROLLW WINDOW [FQUOTIENT (fetch (REGION LEFT) of (FM.ITEMPROP EDITITEM
(QUOTE REGION)))
(fetch (REGION WIDTH) of (WINDOWPROP WINDOW
(QUOTE EXTENT]
0))
(\FM.EDIT-ITEM EDITITEM WINDOW BUTTONS T])
)
(* TITLE ITEM FUNCTIONS)
(DEFINEQ
(\FM.TITLE-SETUP
[LAMBDA (ITEM DESCRIPTION INTERIOR STREAM) (* jow "31-Aug-85 10:05")
(FM.ITEMPROP ITEM (QUOTE MESSAGE)
(OR (LISTGET DESCRIPTION (QUOTE MESSAGE))
""])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML \FM.DOSELECTION)
(ADDTOVAR LAMA FM.ITEMPROP)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (2950 16280 (FM.MAKEMENU 2960 . 3362) (FM.FORMATMENU 3364 . 4843) (FM.REDISPLAYITEM 4845
. 5495) (FM.REDISPLAYMENU 5497 . 5760) (FM.EDITP 5762 . 5918) (FM.FIXSHAPE 5920 . 6941) (FM.ITEMPROP
6943 . 7410) (FM.READSTATE 7412 . 8552) (FM.SHADEITEM 8554 . 9342) (FM.SHADEITEMBM 9344 . 10333) (
FM.EDITITEM 10335 . 10668) (FM.WHICHITEM 10670 . 11339) (FM.ITEMFROMID 11341 . 11837) (FM.CHANGELABEL
11839 . 14836) (FM.CHANGESTATE 14838 . 16278)) (16658 27653 (\FM.FORMATMENUROW 16668 . 19533) (
\FM.READITEMS 19535 . 20314) (\FM.CREATEITEM 20316 . 22233) (\FM.CREATEW 22235 . 23152) (\FM.GETBITMAP
23154 . 24251) (\FM.READUSERDATA 24253 . 24736) (\FM.GROUPNWAYITEMS 24738 . 26165) (\FM.SETUPMENU
26167 . 26572) (\FM.SETUPWINDOW 26574 . 27651)) (29485 32625 (\FM.CLOSEFN 29495 . 29661) (
\FM.RESHAPEFN 29663 . 30140) (\FM.INITCORNERSFN 30142 . 31118) (\FM.WINDOWTOOSMALL 31120 . 31691) (
\FM.SCROLLINGOFF 31693 . 32623)) (33219 37547 (\FM.BUTTONEVENTFN 33229 . 33653) (\FM.RIGHTBUTTONFN
33655 . 34196) (\FM.MENUHANDLER 34198 . 36892) (\FM.DOSELECTION 36894 . 37545)) (38009 48812 (
\FM.GETITEMPROP 38019 . 39297) (\FM.PUTITEMPROP 39299 . 42027) (\FM.CGETITEMPROP 42029 . 44174) (
\FM.CPUTITEMPROP 44176 . 48071) (\FM.HIGHLIGHTITEM 48073 . 48460) (\FM.HIGHLIGHTITEMBM 48462 . 48810))
(48850 49838 (\FM.MOMENTARY-SETUP 48860 . 49407) (\FM.MOMENTARY-SELECTEDFN 49409 . 49836)) (49873
51211 (\FM.TOGGLE-SETUP 49883 . 50687) (\FM.TOGGLE-SELECTEDFN 50689 . 51209)) (51246 56260 (
\FM.3STATE-SETUP 51256 . 52343) (\FM.3STATE-DOWNFN 52345 . 54022) (\FM.3STATE-SELECTEDFN 54024 . 54910
) (\FM.3STATE-CHANGESTATE 54912 . 56258)) (56293 59736 (\FM.NWAY-SETUP 56303 . 56823) (\FM.NWAY-DOWNFN
56825 . 57636) (\FM.NWAY-MOVEDFN 57638 . 58452) (\FM.NWAY-SELECTEDFN 58454 . 59734)) (59772 65780 (
\FM.NCHOOSE-SETUP 59782 . 63521) (\FM.NCHOOSE-SELECTEDFN 63523 . 64196) (\FM.NCHOOSE-CHANGESTATE 64198
. 65778)) (66284 84543 (\FM.EDIT-SETUP 66294 . 69556) (\FM.EDIT-SETUPTTBL 69558 . 70073) (
\FM.EDIT-ITEM 70075 . 73795) (\FM.EDIT-BACKUP 73797 . 75110) (\FM.EDIT-INSERT 75112 . 77966) (
\FM.EDIT-DELETE 77968 . 80945) (\FM.EDIT-GETPOINTERINFO 80947 . 82133) (\FM.EDIT-MOVECARET 82135 .
82878) (\FM.EDIT-STRDELETE 82880 . 83350) (\FM.EDIT-STRINSERT 83352 . 83829) (
\FM.EDIT-UPDATEAFTERDELETE 83831 . 84541)) (84581 86335 (\FM.EDITSTART-SETUP 84591 . 85205) (
\FM.EDITSTART-SELECTEDFN 85207 . 86333)) (86369 86607 (\FM.TITLE-SETUP 86379 . 86605)))))
STOP