(FILECREATED "23-Mar-85 16:25:04" {PHYLUM}<STANSBURY>STYLESHEET>JAZZ>STYLESHEET.;4 29659
changes to: (FNS STYLESHEET.CHANGE.FILL)
previous date: "22-Mar-85 14:41:29" {PHYLUM}<STANSBURY>STYLESHEET>JAZZ>STYLESHEET.;3)
(* Copyright (c) 1983, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT STYLESHEETCOMS)
(RPAQQ STYLESHEETCOMS [(DECLARE: (LOCALVARS . T))
(* * Public entry)
(FNS CREATE.STYLE STYLESHEETP STYLE.PROP STYLESHEET STYLESHEET.IMAGEHEIGHT
STYLESHEET.IMAGEWIDTH)
(* * Private routines.)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS STYLEBLOCK))
(INITRECORDS STYLEBLOCK)
(FNS STYLESHEET.CHANGE.FILL STYLESHEET.CHANGE.ITEMS
STYLESHEET.CHANGE.SELECTIONS STYLESHEET.CHANGE.TITLES STYLESHEET.MENUITEM)
(FNS STYLESHEET.SETUP STYLESHEET.WAIT.TILL.DONE STYLESHEET.GET.SELECTIONS
STYLESHEET.CLEANUP)
(FNS STYLESHEET.WHENSELECTEDFN STYLESHEET.CLEAR.WHENSELECTEDFN
STYLESHEET.DONE.FN)
(FNS STYLESHEET.ITEM.HEIGHT STYLESHEET.ITEM.WIDTH)
(FNS STYLESHEET.CREATE.WINDOW STYLESHEET.FILL.IN.WINDOW STYLESHEET.ADD.MENU
STYLESHEET.SHADE.SELECTIONS)
(FNS STYLESHEET.AT.LOAD)
(P (STYLESHEET.AT.LOAD))
(GLOBALVARS STYLESHEET.DONE.MENU STYLESHEET.SELECTED.SHADE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA STYLE.PROP CREATE.STYLE])
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(* * Public entry)
(DEFINEQ
(CREATE.STYLE
[LAMBDA STYLE (* hts: "21-Mar-85 14:14")
(* * Stylesheet constructor.)
(LET* [(PLIST (for I to STYLE collect (ARG STYLE I)))
(ITEMS (LISTP (LISTGET PLIST (QUOTE ITEMS]
(if ITEMS
then (LET ((STYLESHEET (LIST (QUOTE STYLESHEET)
(QUOTE ITEMS)
ITEMS)))
(for PROP on PLIST by (CDDR PROP) do (STYLE.PROP STYLESHEET (CAR PROP)
(CADR PROP)))
STYLESHEET)
else NIL])
(STYLESHEETP
[LAMBDA (THING) (* hts: "22-Mar-85 13:00")
(* * Tells whether THING is probably a stylesheet.)
(AND (LISTP THING)
(EQ (CAR THING)
(QUOTE STYLESHEET))
(LISTP (LISTGET (CDR THING)
(QUOTE ITEMS])
(STYLE.PROP
[LAMBDA PROPSTUFF (* hts: "22-Mar-85 13:22")
(* * Get or put a "field" of a stylesheet. Works externally the same way as WINDOWPROP. A stylesheet is represented
as the cons of the atom STYLESHEET and a plist containing all the requisite data.)
(OR (EQ PROPSTUFF 2)
(EQ PROPSTUFF 3)
(\ILLEGAL.ARG))
(LET ((STYLESHEET (ARG PROPSTUFF 1)))
(OR (STYLESHEETP STYLESHEET)
(\ILLEGAL.ARG STYLESHEET))
(LET [(PROP (MKATOM (ARG PROPSTUFF 2]
(if (EQ PROPSTUFF 2)
then (LISTGET (CDR STYLESHEET)
PROP)
else (LET ((OLDVAL (LISTGET (CDR STYLESHEET)
PROP))
(NEWVAL (ARG PROPSTUFF 3)))
(LISTPUT (CDR STYLESHEET)
PROP NEWVAL)
(* * Certain stylesheet properties are normalized and collected into a list of "styleblocks", one for each item.
Styleblocks make it easier later on to handle the information for each item. Styleblocks store the items themselves,
selections, fill information, titles, and CLEAR-ALL submenus (if any).)
(SELECTQ (ARG PROPSTUFF 2)
(ITEMS (STYLESHEET.CHANGE.ITEMS STYLESHEET NEWVAL))
(NEED.NOT.FILL.IN (STYLESHEET.CHANGE.FILL STYLESHEET NEWVAL))
(SELECTIONS (STYLESHEET.CHANGE.SELECTIONS STYLESHEET NEWVAL))
(ITEM.TITLES (STYLESHEET.CHANGE.TITLES STYLESHEET NEWVAL))
NIL)
OLDVAL])
(STYLESHEET
[LAMBDA (STYLE) (* hts: "22-Mar-85 14:40")
(* * Creates a window, lays out the menus in it, and waits for BACKGROUND to notify it that the the user has made
all his selections and hit the DONE button. Then removes the window and returns the selections the user made.)
(OR (STYLESHEETP STYLE)
(\ILLEGAL.ARG STYLE))
(LET ((OLD.WHENSELECTEDFNS (STYLESHEET.SETUP STYLE) (* Hold onto old WHENSELECTEDFNs so that they can be
restored on exit.)
)
(W (STYLESHEET.CREATE.WINDOW STYLE) (* Lay out stylesheet of appropriate size and fill it
in.)
))
(* * Wait until the user has filled everything in he needs to, and has hit the DONE button.)
(STYLESHEET.WAIT.TILL.DONE W STYLE)
(* * Clean things up and return user's selections.)
(PROG1 (if (EQ (WINDOWPROP W (QUOTE HOW)
NIL)
(QUOTE ABORT))
then (* user selected ABORT)
NIL
else (STYLESHEET.GET.SELECTIONS STYLE))
(STYLESHEET.CLEANUP W STYLE OLD.WHENSELECTEDFNS])
(STYLESHEET.IMAGEHEIGHT
[LAMBDA (STYLESHEET) (* hts: "22-Mar-85 13:01")
(* * Tells how high in pixels the given stylesheet would be if it were displayed.)
(HEIGHTIFWINDOW (bind THIS.ONE (BIG ← 0)
(TITLEFONT ←(STYLE.PROP STYLESHEET (QUOTE ITEM.TITLE.FONT))) for BLOCK
in (CONS STYLESHEET.DONE.MENU (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS)))
do (if (IGREATERP (SETQ THIS.ONE (STYLESHEET.ITEM.HEIGHT BLOCK TITLEFONT))
BIG)
then (SETQ BIG THIS.ONE))
finally (RETURN BIG))
(STYLE.PROP STYLESHEET (QUOTE TITLE])
(STYLESHEET.IMAGEWIDTH
[LAMBDA (STYLESHEET) (* hts: "22-Mar-85 13:01")
(* * returns the width in pixels this entire stylesheet would take up on the screen were it displayed.)
(WIDTHIFWINDOW (LET [(BLOCKS (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS]
(IPLUS (bind (TITLEFONT ←(STYLE.PROP STYLESHEET (QUOTE ITEM.TITLE.FONT)))
for BLOCK in (CONS STYLESHEET.DONE.MENU BLOCKS)
sum (STYLESHEET.ITEM.WIDTH BLOCK TITLEFONT))
(ITIMES 2 (LENGTH BLOCKS])
)
(* * Private routines.)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE STYLEBLOCK (TITLE MENU SUBMENU FILL SELECTIONS))
]
(/DECLAREDATATYPE (QUOTE STYLEBLOCK)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((STYLEBLOCK 0 POINTER)
(STYLEBLOCK 2 POINTER)
(STYLEBLOCK 4 POINTER)
(STYLEBLOCK 6 POINTER)
(STYLEBLOCK 8 POINTER)))
(QUOTE 10))
)
(/DECLAREDATATYPE (QUOTE STYLEBLOCK)
(QUOTE (POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((STYLEBLOCK 0 POINTER)
(STYLEBLOCK 2 POINTER)
(STYLEBLOCK 4 POINTER)
(STYLEBLOCK 6 POINTER)
(STYLEBLOCK 8 POINTER)))
(QUOTE 10))
(DEFINEQ
(STYLESHEET.CHANGE.FILL
[LAMBDA (STYLESHEET NEWFILL BLOCKS) (* hts: "23-Mar-85 16:22")
(* * Modifies the given stylesheet to reflect new menu fill information. Must be called either when the fill info
changes or when the styleblock list must be rebuilt (since fill info is cached in styleblocks). Note that it calls
STYLESHEET.CHANGE.SELECTIONS, since changing the fill to or from MULTI requires changing the format in which
selections are represented.)
(* * Fill in defaulted arguments.)
[OR NEWFILL (SETQ NEWFILL (STYLE.PROP STYLESHEET (QUOTE NEED.NOT.FILL.IN]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS]
(* * update fill info in styleblocks.)
[for BLOCK in BLOCKS as N from 1
do (LET ((FILL (if (LISTP NEWFILL)
then (CAR (FNTH NEWFILL N))
else NEWFILL)))
(* * Record new fill type. Note if new fill type is just a single atom rather than a list, that atom applies to all
items in the stylesheet.)
(replace (STYLEBLOCK FILL) of BLOCK with FILL)
(* * Build ALL-CLEAR submenu if necessary: Menus that need not have any selections are always equipped with a CLEAR
button in the submenu (not strictly necessary, since pressing a selected item on such a menu will deselect that
item; but it serves as a simple visual aid to the user to tell him he need not make any selections in this menu);
menus that can have multiple selections are equipped with an ALL button in the submenu (same reason as for the CLEAR
button); and other menus have no submenu.)
(replace (STYLEBLOCK SUBMENU) of BLOCK
with (SELECTQ FILL
(MULTI (create MENU
ITEMS ←(QUOTE (ALL CLEAR))
WHENSELECTEDFN ←(FUNCTION STYLESHEET.CLEAR.WHENSELECTEDFN)
MENUUSERDATA ←(fetch (STYLEBLOCK MENU) of BLOCK)))
(T (create MENU
ITEMS ←(QUOTE (CLEAR))
WHENSELECTEDFN ←(FUNCTION STYLESHEET.CLEAR.WHENSELECTEDFN)
MENUUSERDATA ←(fetch (STYLEBLOCK MENU) of BLOCK)))
(NIL NIL)
(\ILLEGAL.ARG NEWFILL]
(* * Build mapping from submenus to styleblocks, which will enable the WHENSELECTEDFN of the submenu to get hold of
the corresponding styleblock to modify its selections as necessary.)
(STYLE.PROP STYLESHEET (QUOTE \SUBMENU.TO.BLOCK)
(for BLOCK in BLOCKS bind SUBMENU when (SETQ SUBMENU (fetch (STYLEBLOCK SUBMENU)
of BLOCK))
collect (CONS SUBMENU BLOCK)))
(* * Change selection format: MULTI requires a list of selections, T or NIL require a single selection.)
(STYLESHEET.CHANGE.SELECTIONS STYLESHEET NIL BLOCKS])
(STYLESHEET.CHANGE.ITEMS
[LAMBDA (STYLESHEET NEWITEMS) (* hts: "22-Mar-85 13:35")
(* * Rebuilds all the styleblocks. Should be called whenever the user changes the items of a stylesheet.)
(LET [(BLOCKS (for MENU in NEWITEMS collect (create STYLEBLOCK
MENU ← MENU]
(STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS)
BLOCKS)
(* * Build mapping from menus to styleblocks. This will allow the menus' WHENSELECTEDFN to get hold of the
appropriate styleblock to change its selection information.)
(STYLE.PROP STYLESHEET (QUOTE \MENU.TO.BLOCK)
(for BLOCK in BLOCKS collect (CONS (fetch (STYLEBLOCK MENU) of BLOCK)
BLOCK)))
(* * Fill in fill info and selections (STYLESHEET.CHANGE.FILL calls STYLESHEET.CHANGE.SELECTIONS))
(STYLESHEET.CHANGE.FILL STYLESHEET NIL BLOCKS)
(* * Fill in item titles.)
(STYLESHEET.CHANGE.TITLES STYLESHEET NIL BLOCKS])
(STYLESHEET.CHANGE.SELECTIONS
[LAMBDA (STYLESHEET NEWSELECTIONS BLOCKS) (* hts: "22-Mar-85 13:45")
(* * Records new default selections in the styleblocks.)
(* * Fill in defaulted arguments.)
[OR NEWSELECTIONS (SETQ NEWSELECTIONS (STYLE.PROP STYLESHEET (QUOTE SELECTIONS]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS]
(* * Normalize selections and stick them into styleblocks. Selections must be normalized in two ways: abbreviations
for a menu item must be replaced by the entire menu item; and items with fill = MULTI should have a list of
selections, but other items should have just a single selection (or NIL))
(for BLOCK in BLOCKS as N from 1
do (replace (STYLEBLOCK SELECTIONS) of BLOCK
with (LET [(MENU (fetch (STYLEBLOCK MENU) of BLOCK))
(SELECTIONS (CAR (FNTH NEWSELECTIONS N]
(SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(MULTI (SETQ SELECTIONS (MKLIST SELECTIONS))
(for MULTISEL
in [LET [(FULL.SELECTIONS (for SUBSEL in SELECTIONS
collect (STYLESHEET.MENUITEM
SUBSEL MENU]
(if (for SUBSEL in FULL.SELECTIONS always SUBSEL)
then FULL.SELECTIONS
else (LIST (STYLESHEET.MENUITEM SELECTIONS MENU]
when MULTISEL collect MULTISEL))
((T NIL)
(STYLESHEET.MENUITEM SELECTIONS MENU))
(SHOULDNT])
(STYLESHEET.CHANGE.TITLES
[LAMBDA (STYLESHEET NEWTITLES BLOCKS) (* hts: "22-Mar-85 13:49")
(* * Fills in item titles in styleblocks)
(* * FIll in defaulted args.)
[OR NEWTITLES (SETQ NEWTITLES (STYLE.PROP STYLESHEET (QUOTE ITEM.TITLES]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS]
(* * Fill in titles in styleblocks. ((CAR (FNTH xxx)) stuff ensures that if the title list is too short, titles in
leftover styleblocks will be NILLed apropriately.))
(for BLOCK in BLOCKS as N from 1 do (replace (STYLEBLOCK TITLE) of BLOCK
with (CAR (FNTH NEWTITLES N])
(STYLESHEET.MENUITEM
[LAMBDA (SELECTION MENU) (* hts: "22-Mar-85 13:50")
(* * Finds the full menu item corresponding to the given abbreviation.)
(for MENUITEM in (fetch (MENU ITEMS) of MENU) thereis (OR (EQUAL MENUITEM SELECTION)
(STREQUAL (MKSTRING MENUITEM)
(MKSTRING SELECTION))
(AND (LISTP MENUITEM)
(STREQUAL (MKSTRING (CAR MENUITEM))
(MKSTRING SELECTION])
)
(DEFINEQ
(STYLESHEET.SETUP
[LAMBDA (STYLESHEET) (* hts: "22-Mar-85 14:05")
(* * Changes the WHENSELECTEDFNs of all the menus to be the appropriate one for stylesheet menus, and returns the
old WHENSELECTEDFNs. Also NILLs the SHADEDITEMS of each menu, since STYLESHEET.SHADE.SELECTIONS depends on the
validity of this field. (ADDMENU should really do it -- submit AR.))
(for BLOCK in (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS))
collect (LET ((MENU (fetch (STYLEBLOCK MENU) of BLOCK)))
(PROG1 (fetch (MENU WHENSELECTEDFN) of MENU)
(replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION
STYLESHEET.WHENSELECTEDFN))
(replace (MENU SHADEDITEMS) of MENU with NIL])
(STYLESHEET.WAIT.TILL.DONE
[LAMBDA (W STYLESHEET) (* hts: "21-Mar-85 18:39")
(* * Wait until the user has filled everything in he needs to, and has hit the DONE button.)
(* * make sure there is a mouse process running.)
(SPAWN.MOUSE)
(bind QUIT.TYPE
do
(* * keep the window on top to bring the users attention to it and to keep it from being covered.)
(TOTOPW W)
(WINDOWPROP W (QUOTE HOW)
NIL)
(WINDOWPROP W (QUOTE DONE)
(CREATE.EVENT (QUOTE DONE)))
(AWAIT.EVENT (WINDOWPROP W (QUOTE DONE))
1000)
repeatuntil (if (SETQ QUIT.TYPE (WINDOWPROP W (QUOTE HOW)))
then (* if not this was a timeout to bring the window back
to the top.)
[if (EQ QUIT.TYPE (QUOTE ABORT))
then (* user selected the abort button.)
T
else (* wait until the user hits the "done" button AND all
menus have been selected from.)
(for BLOCK in (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS))
always (OR (fetch (STYLEBLOCK FILL) of BLOCK)
(fetch (STYLEBLOCK SELECTIONS) of BLOCK]
else NIL])
(STYLESHEET.GET.SELECTIONS
[LAMBDA (STYLESHEET) (* hts: "22-Mar-85 14:09")
(* * Gathers up the selections the user made, and records them as the new default selections for the stylesheet, so
that if it is reused (and the default selections are not changed in between), the user will see his last
selections.)
(LET [(SELECTIONS (for BLOCK in (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS))
collect (LET ((SEL (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(MULTI (for SUBSEL in SEL
collect (if (AND (LISTP SUBSEL)
(LISTP (CDR SUBSEL)))
then (CADR SUBSEL)
else SUBSEL)))
((T NIL)
(if (AND (LISTP SEL)
(LISTP (CDR SEL)))
then (CADR SEL)
else SEL))
(SHOULDNT]
(STYLE.PROP STYLESHEET (QUOTE SELECTIONS)
SELECTIONS)
SELECTIONS])
(STYLESHEET.CLEANUP
[LAMBDA (W STYLESHEET OLD.WHENSELECTEDFNS) (* hts: "22-Mar-85 14:10")
(* * cleans up the WHENSELECTEDFNs in a stylesheet. And closes its window.)
(for I in (STYLE.PROP STYLESHEET (QUOTE ITEMS)) as W in OLD.WHENSELECTEDFNS
do
(* * Restore the old WHENSELECTEDFNs and MENUUSERDATAs.)
(replace WHENSELECTEDFN of I with W))
(* * Get rid of the stylesheet window)
(CLOSEW W])
)
(DEFINEQ
(STYLESHEET.WHENSELECTEDFN
[LAMBDA (ELEMENT MENU BUTTON) (* hts: "22-Mar-85 14:11")
(* * Special whenselectedfn for menus inside stylesheets. Permanently shades the selected item and records the new
selection.)
(LET* ([BLOCK (CDR (FASSOC MENU (STYLE.PROP (WINDOWPROP (WFROMMENU MENU)
(QUOTE STYLESHEET))
(QUOTE \MENU.TO.BLOCK]
(SELECTIONS (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(* * Modify recorded selections.)
(replace (STYLEBLOCK SELECTIONS) of BLOCK with (SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(T
(* * Can have 0 or 1 selection. If selected same one twice, undo the selection, else change selection.)
(if (EQ ELEMENT SELECTIONS)
then NIL
else ELEMENT))
(MULTI
(* * Can have any number of selection. If made same selection twice, remove it; else add it to the list of
selections so far.)
(if (FMEMB ELEMENT SELECTIONS)
then (REMOVE ELEMENT
SELECTIONS)
else (CONS ELEMENT SELECTIONS))
)
(NIL
(* * Must have exactly one selection. Change the current selection.)
ELEMENT)
(SHOULDNT)))
(* * Display new selections.)
(STYLESHEET.SHADE.SELECTIONS BLOCK])
(STYLESHEET.CLEAR.WHENSELECTEDFN
[LAMBDA (ELEMENT CLEAR.MENU BUTTON) (* hts: "22-Mar-85 14:14")
(* * WHENSELECTEDFN for the ALL-CLEAR submenus. Finds the styleblock corresponding to this submenu.
If the user punched CLEAR, deselects all items in that styleblock's menu; if the user punched ALL, selects all the
items in the menu. Changes shading to reflect new selections.)
(LET [(BLOCK (CDR (FASSOC CLEAR.MENU (STYLE.PROP (WINDOWPROP (WFROMMENU CLEAR.MENU)
(QUOTE STYLESHEET))
(QUOTE \SUBMENU.TO.BLOCK]
(replace (STYLEBLOCK SELECTIONS) of BLOCK
with (SELECTQ ELEMENT
(CLEAR NIL)
(ALL (for MENUITEM in (fetch (MENU ITEMS) of (fetch (STYLEBLOCK MENU)
of BLOCK))
collect MENUITEM))
NIL))
(STYLESHEET.SHADE.SELECTIONS BLOCK])
(STYLESHEET.DONE.FN
[LAMBDA (ITEM M BUTTON) (* hts: "21-Mar-85 16:39")
(* * WHENSELECTEDFN for the DONE-ABORT-RESET menu.)
(LET ((W (WFROMMENU M)))
(SELECTQ ITEM
[(DONE ABORT)
(* * Done selecting from this stylesheet. Notify calling process.)
(WINDOWPROP W (QUOTE HOW)
ITEM)
(NOTIFY.EVENT (WINDOWPROP W (QUOTE DONE]
[RESET (LET [(STYLESHEET (WINDOWPROP W (QUOTE STYLESHEET]
(* * Restore the original selections.)
(STYLE.PROP STYLESHEET (QUOTE SELECTIONS)
(STYLE.PROP STYLESHEET (QUOTE SELECTIONS)))
(* * Shade the original selections.)
(for BLOCK in (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS))
do (STYLESHEET.SHADE.SELECTIONS BLOCK]
NIL])
)
(DEFINEQ
(STYLESHEET.ITEM.HEIGHT
[LAMBDA (BLOCK TITLEFONT) (* hts: "20-Mar-85 19:50")
(* * Returns the height in pixels the given block would occupy in a stylesheet.)
(PLUS (if (fetch (STYLEBLOCK TITLE) of BLOCK)
then (PLUS 2 (FONTHEIGHT TITLEFONT))
else 0)
(fetch (MENU IMAGEHEIGHT) of (fetch (STYLEBLOCK MENU) of BLOCK))
(LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (PLUS 2 (fetch (MENU IMAGEHEIGHT) of SUBMENU))
else 0])
(STYLESHEET.ITEM.WIDTH
[LAMBDA (BLOCK TITLEFONT) (* hts: "20-Mar-85 19:59")
(* * returns the width in piexels that the given block would occupy were it printed in a stylesheet.)
(MAX (LET ((TITLE (fetch (STYLEBLOCK TITLE) of BLOCK)))
(if TITLE
then (STRINGWIDTH TITLE TITLEFONT)
else 0))
(fetch (MENU IMAGEWIDTH) of (fetch (STYLEBLOCK MENU) of BLOCK))
(LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (fetch (MENU IMAGEWIDTH) of SUBMENU)
else 0])
)
(DEFINEQ
(STYLESHEET.CREATE.WINDOW
[LAMBDA (STYLESHEET) (* hts: "22-Mar-85 14:18")
(* * Lay out stylesheet window of appropriate size and fill it in.)
(LET ((POS (STYLE.PROP STYLESHEET (QUOTE POSITION)))
(TITLE (STYLE.PROP STYLESHEET (QUOTE TITLE)))
(HEIGHT (STYLESHEET.IMAGEHEIGHT STYLESHEET))
(WIDTH (STYLESHEET.IMAGEWIDTH STYLESHEET)))
(* * If position for stylesheet is not provided, prompt for it.)
(if (NULL POS)
then (SETQ POS (GETBOXPOSITION WIDTH HEIGHT)))
(* * Ensure that stylesheet is on the screen.)
[replace XCOORD of POS with (MAX 1 (MIN (fetch XCOORD of POS)
(IDIFFERENCE SCREENWIDTH WIDTH]
[replace YCOORD of POS with (MAX 1 (MIN (fetch YCOORD of POS)
(IDIFFERENCE SCREENHEIGHT HEIGHT]
(* * Lay out a window big enough to fit all the items.)
(LET ((W (CREATEW (CREATEREGION (fetch XCOORD of POS)
(fetch YCOORD of POS)
WIDTH HEIGHT)
TITLE)))
(* * Save the stylesheet on its window, where it can be accessed by the WHENSELECTEDFNS etc. running in a different
process.)
(WINDOWPROP W (QUOTE STYLESHEET)
STYLESHEET)
(* * Give the window a REPAINTFN so it can be redisplayed properly.)
(WINDOWPROP W (QUOTE REPAINTFN)
(FUNCTION STYLESHEET.FILL.IN.WINDOW))
(* * Fill in the window.)
(REDISPLAYW W)
W])
(STYLESHEET.FILL.IN.WINDOW
[LAMBDA (W) (* hts: "22-Mar-85 14:21")
(* * Put items into stylesheet and shade default menu selections.)
(for M in (WINDOWPROP W (QUOTE MENU)) do (DELETEMENU M NIL W))
(LET [(STYLESHEET (WINDOWPROP W (QUOTE STYLESHEET]
(bind (TITLEFONT ←(STYLE.PROP STYLESHEET (QUOTE ITEM.TITLE.FONT)))
(HEIGHT ←(WINDOWPROP W (QUOTE HEIGHT)))
(XOFFSET ← 0)
WIDTH for BLOCK in (APPEND (STYLE.PROP STYLESHEET (QUOTE \STYLE.BLOCKS))
(LIST STYLESHEET.DONE.MENU))
do (SETQ WIDTH (STYLESHEET.ITEM.WIDTH BLOCK TITLEFONT))
(STYLESHEET.ADD.MENU BLOCK W XOFFSET HEIGHT WIDTH TITLEFONT)
(SETQ XOFFSET (PLUS XOFFSET WIDTH 2])
(STYLESHEET.ADD.MENU
[LAMBDA (BLOCK W XOFFSET HEIGHT WIDTH TITLEFONT) (* hts: "22-Mar-85 14:24")
(* * Adds the current styleblock (title, menu, and submenu) to the stylesheet. XOFFSET determines the placement of
left boundary of the styleblock. HEIGHT and WIDTH bound the styleblock above and to the right.
Centers the pieces of the styleblock within this box.)
(LET ((TOP HEIGHT))
(* * Title stuff)
[LET ((TITLE (fetch (STYLEBLOCK TITLE) of BLOCK)))
(if TITLE
then (MOVETO (IPLUS XOFFSET (IQUOTIENT (DIFFERENCE WIDTH (STRINGWIDTH TITLE TITLEFONT))
2))
[DIFFERENCE TOP (DIFFERENCE (FONTPROP TITLEFONT (QUOTE HEIGHT))
(FONTPROP TITLEFONT (QUOTE DESCENT]
W)
(printout W .FONT TITLEFONT TITLE)
(SETQ TOP (DIFFERENCE TOP (PLUS (FONTHEIGHT TITLEFONT)
2]
(* * Stick the menu on the stylesheet window.)
[LET ((MENU (fetch (STYLEBLOCK MENU) of BLOCK)))
[ADDMENU MENU W (create POSITION
XCOORD ←(IPLUS XOFFSET (IQUOTIENT (DIFFERENCE WIDTH
(fetch (MENU IMAGEWIDTH)
of MENU))
2))
YCOORD ←(IDIFFERENCE TOP (fetch IMAGEHEIGHT of MENU]
(SETQ TOP (DIFFERENCE TOP (PLUS (fetch IMAGEHEIGHT of MENU)
2]
(* * Shade in selections.)
(STYLESHEET.SHADE.SELECTIONS BLOCK)
(* * Add clear/all menu at bottom of this item.)
[LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (ADDMENU SUBMENU W (create POSITION
XCOORD ←(IPLUS XOFFSET (IQUOTIENT
(DIFFERENCE WIDTH (fetch (MENU
IMAGEWIDTH)
of SUBMENU))
2))
YCOORD ←(IDIFFERENCE TOP (fetch IMAGEHEIGHT of SUBMENU]
NIL])
(STYLESHEET.SHADE.SELECTIONS
[LAMBDA (BLOCK) (* hts: "22-Mar-85 14:26")
(* * Updates the selections shaded on the screen to reflect those recorded internally for the specified Makes use of
the SHADEDITEMS field of the menu to tell what has already been shaded. Format of SHADEDITEMS is an alist mapping
the number of the menu item onto its shade.)
(LET* ((MENU (fetch (STYLEBLOCK MENU) of BLOCK))
(SHADEDITEMS (fetch (MENU SHADEDITEMS) of MENU))
(SELECTIONS (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(if (NEQ (fetch (STYLEBLOCK FILL) of BLOCK)
(QUOTE MULTI))
then (SETQ SELECTIONS (LIST SELECTIONS)))
(for MENUITEM in (fetch (MENU ITEMS) of MENU) as ITEMNUMBER from 1
do (LET* [(SELECTED (FMEMB MENUITEM SELECTIONS))
(SHADENTRY (FASSOC ITEMNUMBER SHADEDITEMS))
(SHADED (AND (LISTP SHADENTRY)
(NEQ (CDR SHADENTRY)
0]
(if (AND SHADED (NOT SELECTED))
then (SHADEITEM MENUITEM MENU WHITESHADE)
elseif (AND SELECTED (NOT SHADED))
then (SHADEITEM MENUITEM MENU STYLESHEET.SELECTED.SHADE])
)
(DEFINEQ
(STYLESHEET.AT.LOAD
[LAMBDA NIL (* hts: "22-Mar-85 14:27")
(* * Sets up global variables for the stylesheet package.)
[SETQ STYLESHEET.DONE.MENU (create STYLEBLOCK
MENU ←(create MENU
ITEMS ←(QUOTE (DONE RESET ABORT))
WHENSELECTEDFN ←(FUNCTION STYLESHEET.DONE.FN]
(SETQ STYLESHEET.SELECTED.SHADE BLACKSHADE])
)
(STYLESHEET.AT.LOAD)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS STYLESHEET.DONE.MENU STYLESHEET.SELECTED.SHADE)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA STYLE.PROP CREATE.STYLE)
)
(PUTPROPS STYLESHEET COPYRIGHT ("Xerox Corporation" 1983 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1585 6628 (CREATE.STYLE 1595 . 2184) (STYLESHEETP 2186 . 2515) (STYLE.PROP 2517 . 4024)
(STYLESHEET 4026 . 5302) (STYLESHEET.IMAGEHEIGHT 5304 . 6019) (STYLESHEET.IMAGEWIDTH 6021 . 6626)) (
7296 14298 (STYLESHEET.CHANGE.FILL 7306 . 10258) (STYLESHEET.CHANGE.ITEMS 10260 . 11329) (
STYLESHEET.CHANGE.SELECTIONS 11331 . 12978) (STYLESHEET.CHANGE.TITLES 12980 . 13740) (
STYLESHEET.MENUITEM 13742 . 14296)) (14299 18263 (STYLESHEET.SETUP 14309 . 15163) (
STYLESHEET.WAIT.TILL.DONE 15165 . 16613) (STYLESHEET.GET.SELECTIONS 16615 . 17729) (STYLESHEET.CLEANUP
17731 . 18261)) (18264 21682 (STYLESHEET.WHENSELECTEDFN 18274 . 19810) (
STYLESHEET.CLEAR.WHENSELECTEDFN 19812 . 20773) (STYLESHEET.DONE.FN 20775 . 21680)) (21683 22983 (
STYLESHEET.ITEM.HEIGHT 21693 . 22322) (STYLESHEET.ITEM.WIDTH 22324 . 22981)) (22984 28841 (
STYLESHEET.CREATE.WINDOW 22994 . 24645) (STYLESHEET.FILL.IN.WINDOW 24647 . 25501) (STYLESHEET.ADD.MENU
25503 . 27517) (STYLESHEET.SHADE.SELECTIONS 27519 . 28839)) (28842 29300 (STYLESHEET.AT.LOAD 28852 .
29298)))))
STOP