(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