(FILECREATED "24-May-84 16:19:48" {DSK}TEDITMENU.;13 101576 

      changes to:  (FNS MB.DISPLAY MB.SIZEFN MBUTTON.CREATE MB.CREATE.THREESTATEBUTTON 
			MARGINBAR.CREATE MB.MARGINBAR.DISPLAYFN MB.THREESTATE.DISPLAY)

      previous date: "24-May-84 11:25:40" {DSK}TEDITMENU.;11)


(PRETTYCOMPRINT TEDITMENUCOMS)

(RPAQQ TEDITMENUCOMS [(FILES ICONW TEXTOFD TEDITLOOKS IMAGEOBJ)
	[COMS (* Simple Menu Button support)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MBUTTON))
	      (INITRECORDS MBUTTON)
	      (FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN MB.COPYFN 
		   MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.FIND.NEXT.BUTTON 
		   MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT MBUTTON.NEXT.FIELD.AS.NUMBER 
		   MB.DEFAULTBUTTON.ACTIONFN MBUTTON.NEXT.FIELD.AS.TEXT MBUTTON.SET.NEXT.FIELD 
		   \TEDITMENU.SELSCREENER)
	      (GLOBALVARS MBUTTONIMAGEFNS)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT]
	[COMS (* Three-state (ON-OFF-NEUTRAL)
		 menu buttons, for, e.g., character properties like BOLD)
	      (FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN 
		   MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT]
	[COMS (* One-of-N Menu button sets)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS NWAYBUTTON))
	      (INITRECORDS NWAYBUTTON)
	      (FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN 
		   MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS)
	      (GLOBALVARS NWAYBUTTONIMAGEFNS)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT]
	[COMS (* Full menu inside an object support)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MENUOBJ))
	      (INITRECORDS MENUOBJ)
	      (FNS MENUOBJ.INIT MB.CREATE.FULLMENU MB.FULLMENU.DISPLAYFN MB.FULLMENU.SELFINALFN 
		   MB.FULLMENU.SELFN MB.FULLMENU.SHOWSELFN MB.FULLMENU.SIZEFN MB.BLTMENUIMAGE)
	      (GLOBALVARS FULLMENUIMAGEFNS)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (MENUOBJ.INIT]
	[COMS (* Margin Setting and display)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MARGINBAR))
	      (INITRECORDS MARGINBAR)
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TAB))
	      (FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN 
		   MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK 
		   \TEDIT.TABTYPE.SET MARGINBAR.INIT)
	      (BITMAPS \TEDIT.LEFTTAB \TEDIT.CENTERTAB \TEDIT.RIGHTTAB \TEDIT.DECIMALTAB 
		       TEDIT.EXTENDEDRIGHTMARK)
	      (GLOBALVARS MARGINBARIMAGEFNS)
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT]
	(COMS (* Text menu creation and support)
	      (FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN)
	      (BITMAPS TEXTMENUICON TEXTMENUICONMASK))
	[COMS (* TEdit-specific support)
	      (FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN \TEDIT.APPLY.BOLDNESS 
		   \TEDIT.APPLY.CHARLOOKS \TEDIT.APPLY.OLINE \TEDIT.APPLY.PARALOOKS 
		   \TEDIT.SHOW.CHARLOOKS \TEDIT.SHOW.PARALOOKS \TEDIT.APPLY.SLOPE 
		   \TEDIT.APPLY.STRIKEOUT \TEDIT.APPLY.ULINE)
	      (GLOBALVARS TEDIT.EXPANDED.MENU)
	      [DECLARE: DONTEVAL@LOAD DOCOPY (P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU
								    (LIST "Expanded Menu"
									  (QUOTE (QUOTE 
									     \TEDIT.EXPANDED.MENU]
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (SETQ TEDIT.EXPANDED.MENU (\TEDITMENU.CREATE]
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA])
(FILESLOAD ICONW TEXTOFD TEDITLOOKS IMAGEOBJ)



(* Simple Menu Button support)

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD MBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM)
				(OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
					(QUOTE MB.DISPLAY))
				    (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
					(QUOTE MB.THREESTATE.DISPLAY])
]
)
(DEFINEQ

(MB.BUTTONEVENTINFN
  [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM)    (* jds " 2-May-84 17:32")
                                                             (* There was a buttn event inside a menu button.
							     Make sure that the button gets turned OFF when the mouse
							     moves outside it.)
    (PROG [(OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX]
          (replace SELKIND of SEL with (QUOTE VOLATILE))
          (COND
	    ((AND (IGEQ RELX 0)
		  (IGEQ RELY 0)
		  (ILEQ RELX (fetch XSIZE of OBJBOX))
		  (ILEQ RELY (fetch YSIZE of OBJBOX)))       (* We're really inside the thing.
							     Return an indication that we're to be left alone.)
	      (RETURN T))
	    (T                                               (* He's moved outside the button.
							     Don't permit the selection.)
	       (RETURN (QUOTE DON'T])

(MB.DISPLAY
  [LAMBDA (OBJ STREAM MODE)                                  (* jds "24-May-84 16:00")
                                                             (* Display the innards of a menu button)
    (PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
		  (X (DSPXPOSITION NIL STREAM))
		  (Y (DSPYPOSITION NIL STREAM)))
          (SETQ BITMAP (IMAGEOBJPROP OBJ (QUOTE BITCACHE)))
          [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX]
                                                             (* Display the button's image)
          (COND
	    ((EQ (IMAGEOBJPROP OBJ (QUOTE STATE))
		 (QUOTE ON))                                 (* If the button is ON, mark it so.)
	      (BITBLT NIL 0 0 STREAM X Y (fetch XSIZE of OBJBOX)
		      (fetch YSIZE of OBJBOX)
		      (QUOTE TEXTURE)
		      (QUOTE INVERT)
		      BLACKSHADE])

(MB.SELFN
  [LAMBDA (OBJ SEL W FN)                                     (* jds " 4-May-84 15:16")
                                                             (* Calls a menu-button's associated function, then turns
							     off the highlighting of the menu button.)
    (PROG [(TSEL (create SELECTION))
	   (BUTTONFN (OR FN (IMAGEOBJPROP OBJ (QUOTE MBFN]
          (\COPYSEL SEL TSEL)                                (* Save the selection that points to the menu button.)
          (replace SELKIND of SEL with (QUOTE CHAR))
          (replace SET of SEL with NIL)
          (replace ONFLG of SEL with NIL)                    (* Call the button's function)
          (COND
	    ((NEQ (AND BUTTONFN (APPLY* BUTTONFN OBJ SEL W))
		  (QUOTE DON'T))                             (* If the button fn left the selection alone,)
	      (\FIXSEL TSEL (fetch \TEXTOBJ of TSEL))
	      (\SHOWSEL TSEL NIL NIL)))                      (* Turn off the button hilite)
      ])

(MB.SIZEFN
  [LAMBDA (OBJ)                                              (* jds "24-May-84 15:57")
                                                             (* Tell the size of a menu button)
    (PROG ((BOX (create IMAGEBOX
			XSIZE ←(STRINGWIDTH (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
					    (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
			YSIZE ←(FONTPROP (IMAGEOBJPROP OBJ (QUOTE MBFONT))
					 (QUOTE HEIGHT))
			YDESC ←(FONTPROP (IMAGEOBJPROP OBJ (QUOTE MBFONT))
					 (QUOTE DESCENT))
			XKERN ← 0)))
          (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
			BOX)
          (RETURN BOX])

(MB.WHENOPERATEDFN
  [LAMBDA (OBJ DS OPERATION SEL)                             (* jds " 7-Feb-84 14:20")
    (SELECTQ OPERATION
	     (HIGHLIGHTED (MB.SHOWSELFN OBJ SEL T DS))
	     (UNHIGHLIGHTED (MB.SHOWSELFN OBJ SEL NIL DS))
	     (SELECTED (MB.SELFN OBJ SEL DS))
	     (DESELECTED)
	     NIL])

(MB.COPYFN
  [LAMBDA (OBJ)                                              (* jds "23-May-84 11:32")
                                                             (* Copy a menu button object.)
    (create IMAGEOBJ
	    OBJECTDATUM ←(COPY (fetch (IMAGEOBJ OBJECTDATUM) of OBJ))
	    IMAGEOBJPLIST ←(COPY (fetch (IMAGEOBJ IMAGEOBJPLIST) of OBJ))
	    IMAGEOBJFNS ←(fetch (IMAGEOBJ IMAGEOBJFNS) of OBJ])

(MB.GETFN
  [LAMBDA (OBJ FILE)                                         (* jds " 1-May-84 11:58")
                                                             (* READ a menu button from a file.)
    (PROG [(TEXT (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
	   (MBFN (IMAGEOBJPROP OBJ (QUOTE MBFN)))
	   (FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT]
          (\STRINGOUT FILE TEXT)
          (\ATMOUT FILE MBFN)
          (\ATMOUT FILE (FONTPROP FONT (QUOTE FAMILY)))
          (\SMALLPOUT FILE (FONTPROP FONT (QUOTE SIZE)))
          (for ATTR in (FONTPROP FONT (QUOTE FACE)) do (\ATMOUT FILE ATTR])

(MB.PUTFN
  [LAMBDA (OBJ FILE)                                         (* jds " 1-May-84 11:58")
                                                             (* READ a menu button from a file.)
    (PROG [(TEXT (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
	   (MBFN (IMAGEOBJPROP OBJ (QUOTE MBFN)))
	   (FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT]
          (\STRINGOUT FILE TEXT)
          (\ATMOUT FILE MBFN)
          (\ATMOUT FILE (FONTPROP FONT (QUOTE FAMILY)))
          (\SMALLPOUT FILE (FONTPROP FONT (QUOTE SIZE)))
          (for ATTR in (FONTPROP FONT (QUOTE FACE)) do (\ATMOUT FILE ATTR])

(MB.SHOWSELFN
  [LAMBDA (OBJ SEL ON DS)                                    (* jds " 8-Feb-84 10:33")
    (PROG [(OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX]
          (OR (IMAGEOBJPROP OBJ (QUOTE BITCACHE))
	      (MB.DISPLAY OBJ))                              (* MAKE SURE THE DISPLAY FORM EXISTS)
          (BITBLT (IMAGEOBJPROP OBJ (QUOTE BITCACHE))
		  0 0 DS 0 0 (fetch XSIZE of OBJBOX)
		  (fetch YSIZE of OBJBOX)
		  (QUOTE INPUT)
		  (QUOTE REPLACE))
          (COND
	    ((OR ON (EQ (IMAGEOBJPROP OBJ (QUOTE STATE))
			(QUOTE ON)))
	      (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of OBJBOX)
		      (fetch YSIZE of OBJBOX)
		      (QUOTE TEXTURE)
		      (QUOTE INVERT)
		      BLACKSHADE])

(MBUTTON.CREATE
  [LAMBDA (MBTEXT MBFN MBFONT IMAGEFNS)                      (* jds "24-May-84 16:14")
    (PROG ((OBJ (IMAGEOBJCREATE NIL (OR IMAGEFNS MBUTTONIMAGEFNS)))
	   (BOX (create IMAGEBOX
			XSIZE ←(STRINGWIDTH MBTEXT MBFONT)
			YSIZE ←(FONTPROP MBFONT (QUOTE HEIGHT))
			YDESC ←(FONTPROP MBFONT (QUOTE DESCENT))
			XKERN ← 0))
	   BITMAP DS)
          (IMAGEOBJPROP OBJ (QUOTE MBFN)
			MBFN)
          (IMAGEOBJPROP OBJ (QUOTE MBTEXT)
			MBTEXT)
          (IMAGEOBJPROP OBJ (QUOTE MBFONT)
			MBFONT)
          (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
			BOX)
          (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX)
				     (fetch YSIZE of BOX)))
          (IMAGEOBJPROP OBJ (QUOTE BITCACHE)
			BITMAP)
          (SETQ DS (DSPCREATE BITMAP))
          (DSPXOFFSET 0 DS)
          (DSPYOFFSET 0 DS)
          (DSPFONT MBFONT DS)
          (MOVETO 0 (FONTPROP MBFONT (QUOTE DESCENT))
		  DS)
          (PRIN1 MBTEXT DS)
          (RETURN OBJ])

(MBUTTON.FIND.NEXT.BUTTON
  [LAMBDA (TEXTOBJ CH#)                                      (* jds "11-Apr-84 17:52")
                                                             (* Finds the next instance of an OBJECT which looks like
							     a menu button, 3-state button, or menuobj.
							     If none is found, return NIL)
    (PROG [(PCTB (fetch PCTB of TEXTOBJ))
	   (PCNO (\CHTOPCNO CH# (fetch PCTB of TEXTOBJ]
          (RETURN (bind PC OBJ for PC# from (ADD1 PCNO) to (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset))
		     by \EltsPerPiece
		     do                                      (* Loo thru the piece table, looking for pieces with 
							     objects in them)
			(SETQ PC (\EDITELT PCTB PC#))
			(SETQ OBJ (fetch POBJ of PC))
			(COND
			  ((AND OBJ (OR (type? MBUTTON OBJ)
					(type? MENUOBJ OBJ)
					(type? MARGINBAR OBJ)
					(type? NWAYBUTTON OBJ)))
                                                             (* Which are some kind of menu-buttonish object)
			    (RETURN (CONS OBJ (\EDITELT PCTB (SUB1 PC#])

(MBUTTON.FIND.NEXT.FIELD
  [LAMBDA (TEXTOBJ CH#)                                      (* jds "17-May-84 11:06")

          (* Starting from CH#, find the next fill-in area (usually surrounded by a {-} pair), and select any text it 
	  contains. Returns the TEXTOBJ's SCRATCHSEL with the text selected. (If no insert point is found, returns NIL.))


    (PROG ((PCTB (fetch PCTB of TEXTOBJ))
	   (SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
	   CH1 PCNO PCNO1 PC CH LEN (DEPTH 0))
          (COND
	    ((IGREATERP CH# (fetch TEXTLEN of TEXTOBJ))      (* Can't look past the end of the document)
	      (RETURN NIL)))
          (SETQ PCNO (\CHTOPCNO CH# PCTB))
          (SETQ PC (\EDITELT PCTB (ADD1 PCNO)))
          (for old PCNO from PCNO by \EltsPerPiece while PC
	     do                                              (* Look thru the pieces for one which starts a 
							     user-fill-in area)
		(COND
		  ((fetch CLSELHERE of (fetch PLOOKS of PC))
                                                             (* Found it, so return)
		    (RETURN)))
		(SETQ PC (fetch NEXTPIECE of PC)))
          (COND
	    (PC                                              (* We found a starting point for a type-in field)
		(SETQ CH1 (\EDITELT PCTB (IPLUS PCNO \EltsPerPiece)))
                                                             (* Remember the starting character number)
		(SETQ PC (fetch NEXTPIECE of PC))
		(for old PCNO from (IPLUS PCNO \EltsPerPiece) by \EltsPerPiece while PC
		   do (COND
			((fetch CLPROTECTED of (fetch PLOOKS of PC))
			  (RETURN)))
		      (SETQ PC (fetch NEXTPIECE of PC)))
		(SETQ LEN (IDIFFERENCE (\EDITELT PCTB PCNO)
				       CH1))
		(replace CH# of SCRATCHSEL with CH1)
		[replace CHLIM of SCRATCHSEL with (IPLUS CH1 (IMAX 0 (SUB1 LEN]
		(replace DCH of SCRATCHSEL with LEN)
		(replace SELOBJ of SCRATCHSEL with NIL)
		(replace POINT of SCRATCHSEL with (QUOTE LEFT))
                                                             (* So if it's used, it'll be in the correct spot.)
		(replace SELKIND of SCRATCHSEL with (QUOTE CHAR)))
	    (T                                               (* No fill-in blank found, so return an indication.)
	       (RETURN NIL)))
          (\FIXSEL SCRATCHSEL TEXTOBJ)
          (RETURN SCRATCHSEL])

(MBUTTON.INIT
  [LAMBDA NIL                                                (* jds "23-May-84 11:39")
    (SETQ MBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAY)
					  (FUNCTION MB.SIZEFN)
					  (FUNCTION MB.PUTFN)
					  (FUNCTION MB.GETFN)
					  (QUOTE MB.COPYFN)
					  (FUNCTION MB.BUTTONEVENTINFN)
					  (QUOTE NILL)
					  (QUOTE NILL)
					  (QUOTE NILL)
					  (QUOTE NILL)
					  (QUOTE NILL)
					  (FUNCTION MB.WHENOPERATEDFN)
					  (QUOTE NIL])

(MBUTTON.NEXT.FIELD.AS.NUMBER
  [LAMBDA (TEXTOBJ CH#)                                      (* jds "29-SEP-83 18:00")
    (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
    (FIXP (MKATOM (TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
				       (fetch SCRATCHSEL of TEXTOBJ])

(MB.DEFAULTBUTTON.ACTIONFN
  [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL)               (* jds "21-May-84 17:01")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG (OFILE CH #COPIES PRINTHOST)
          [ERSETQ (RESETLST [RESETSAVE (\TEDIT.MARKACTIVE MAINTEXT)
				       (QUOTE (AND (\TEDIT.MARKINACTIVE OLDVALUE]
			    (replace EDITOPACTIVE of MAINTEXT with (OR (IMAGEOBJPROP OBJ
										     (QUOTE MBTEXT))
								       T))
                                                             (* So we can tell the guy WHAT op is active.)
			    (SELECTQ (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
				     [Put (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
										  (fetch CH#
										     of SEL)))
					  (COND
					    ((ZEROP (NCHARS OFILE))
                                                             (* NOTHING--HE HIT DEL.)
					      )
					    (OFILE (TEDIT.PUT MAINTEXT (MKATOM OFILE]
				     [Get (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
										  (fetch CH#
										     of SEL)))
					  (COND
					    ((ZEROP (NCHARS OFILE))
                                                             (* NOTHING--HE HIT DEL.)
					      )
					    (OFILE (TEDIT.GET MAINTEXT (MKATOM OFILE]
				     [Include (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
										      (fetch CH#
											 of SEL)))
					      (COND
						((ZEROP (NCHARS OFILE))
                                                             (* NOTHING--HE HIT DEL.)
						  )
						(T (TEDIT.INCLUDE MAINTEXT (MKATOM OFILE]
				     [Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
										   (fetch CH#
										      of SEL)))
					   (COND
					     ((ZEROP (NCHARS OFILE))
                                                             (* NOTHING--HE HIT DEL.)
					       )
					     (OFILE          (* There's something to do. Go do it.)
						    (TEDIT.PROMPTPRINT MAINTEXT "Searching..." T)
						    [SETQ CH
						      (CAR (ERSETQ (TEDIT.FIND MAINTEXT OFILE NIL NIL 
									       T]
						    (COND
						      (CH    (* We found the target text.)
							  (TEDIT.PROMPTPRINT MAINTEXT "Done.")
							  (\SHOWSEL MAINSEL NIL NIL)
							  (replace CH# of MAINSEL
							     with (CAR CH))
                                                             (* Set up SELECTION to be the found text)
							  (replace CHLIM of MAINSEL
							     with (CADR CH))
							  [replace DCH of MAINSEL
							     with (ADD1 (IDIFFERENCE (CADR CH)
										     (CAR CH]
							  (replace POINT of MAINSEL
							     with (QUOTE RIGHT))
                                                             (* And never pending a deletion.)
							  (TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL)
							  (\FIXSEL MAINSEL MAINTEXT)
							  (TEDIT.NORMALIZECARET MAINTEXT MAINSEL)
							  (\SHOWSEL MAINSEL NIL T))
						      (T (TEDIT.PROMPTPRINT MAINTEXT "(Not found)"]
				     [Substitute (PROG [(REPLACEMENT (MBUTTON.NEXT.FIELD.AS.TEXT
								       TEXTOBJ
								       (fetch CH# of SEL)))
							(PATTERN (MBUTTON.NEXT.FIELD.AS.TEXT
								   TEXTOBJ
								   (fetch CHLIM
								      of (fetch SCRATCHSEL
									    of TEXTOBJ]
						       (COND
							 ((ZEROP (NCHARS PATTERN))
                                                             (* NOTHING--HE HIT DEL.)
							   )
							 (PATTERN 
                                                             (* There's something to do. Go do it.)
								  (RESETLST (RESETSAVE (CURSOR 
										    WAITINGCURSOR))
									    (TEDIT.SUBSTITUTE
									      (fetch STREAMHINT
										 of MAINTEXT)
									      PATTERN REPLACEMENT NIL]
				     [Quit                   (* He wants to QUIT the edit.)
					   (COND
					     ((\TEDIT.QUIT (fetch \WINDOW of MAINTEXT)
							   T)
					       (replace EDITFINISHEDFLG of TEXTOBJ with T]
				     (CloseMenu              (* He wants this expanded menu turned off.)
						(TEDIT.QUIT TEXTOBJ)
						(DISMISS 20))
				     [All                    (* Select the entire document.)
					  (COND
					    ((NOT (ZEROP (fetch TEXTLEN of MAINTEXT)))
					      (\SHOWSEL MAINSEL NIL NIL)
					      (TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL)
					      (replace CH# of MAINSEL with 1)
					      (replace CHLIM of MAINSEL with (fetch TEXTLEN
										of MAINTEXT))
					      (replace DCH of MAINSEL with (fetch TEXTLEN
									      of MAINTEXT))
					      (replace POINT of MAINSEL with (QUOTE LEFT))
					      (replace SET of MAINSEL with T)
					      (\FIXSEL MAINSEL MAINTEXT)
					      (\SHOWSEL MAINSEL NIL T]
				     (Hardcopy (SETQ PRINTHOST (MBUTTON.NEXT.FIELD.AS.TEXT
						   TEXTOBJ
						   (fetch CH# of SEL)))
					       (COND
						 ((ZEROP (NCHARS PRINTHOST))
                                                             (* If he didn't specify a particular host, defer to his 
							     defaults.)
						   (TEDIT.PROMPTPRINT MAINTEXT 
								    "Using default print server.")
						   (SETQ PRINTHOST NIL)))
					       [SETQ #COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER
						   TEXTOBJ
						   (fetch CH# of (fetch SCRATCHSEL of TEXTOBJ]
					       (TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST #COPIES)
					       )
				     (ERROR]
          (replace SET of SEL with T)
          (replace ONFLG of SEL with T)
          (\SHOWSEL SEL NIL NIL)
          (replace SET of SEL with NIL])

(MBUTTON.NEXT.FIELD.AS.TEXT
  [LAMBDA (TEXTOBJ CH#)                                      (* jds "25-AUG-83 09:32")
    (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
    (TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
			 (fetch SCRATCHSEL of TEXTOBJ])

(MBUTTON.SET.NEXT.FIELD
  [LAMBDA (TEXTOBJ CH# NEWVALUE)                             (* jds "17-May-84 14:02")
                                                             (* SET the text content of the next fill-in field in 
							     this document to be NEWVALUE)
    (PROG ((SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ)))
          (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)              (* Find the next menu fill-in field)
          (\FIXSEL SCRATCHSEL TEXTOBJ)                       (* Fix up the SELECTION that describes its contents, so 
							     we've got the right screen coordinates &c)
          (OR (ZEROP (fetch DCH of SCRATCHSEL))
	      (\TEDIT.DELETE SCRATCHSEL TEXTOBJ T))          (* If there is text in that fill-in, delete it to make 
							     room for ours)
          (COND
	    (NEWVALUE                                        (* Only insert something if there IS something to 
							     insert.)
		      (TEDIT.\INSERT (MKSTRING NEWVALUE)
				     SCRATCHSEL TEXTOBJ)))   (* Then fill it with out new value.)
      ])

(\TEDITMENU.SELSCREENER
  [LAMBDA (TEXTOBJ SEL SELECTMODE FINAL?)                    (* jds "21-May-84 16:52")
                                                             (* Called to screen potential selections in the TEdit 
							     menu window; if an edit op is in progress, no selection 
							     will be permitted.-)
    (PROG ((MAINW (WINDOWPROP (fetch \WINDOW of TEXTOBJ)
			      (QUOTE MAINWINDOW)))
	   MAINTEXT)
          (SETQ MAINTEXT (WINDOWPROP MAINW (QUOTE TEXTOBJ)))
          (COND
	    ((AND (EQ (fetch CH# of SEL)
		      (fetch CH# of TEDIT.SCRATCHSELECTION))
		  (EQ (fetch DCH of SEL)
		      (fetch DCH of TEDIT.SCRATCHSELECTION))
		  (fetch EDITOPACTIVE of MAINTEXT))
	      (\COPYSEL SEL TEDIT.SCRATCHSELECTION)
	      (RETURN (QUOTE DON'T)))
	    ((EQ (fetch EDITOPACTIVE of MAINTEXT)
		 T)
	      (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T)
	      (RETURN (QUOTE DON'T)))
	    ((fetch EDITOPACTIVE of MAINTEXT)
	      (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (fetch EDITOPACTIVE of MAINTEXT)
						 " in progress; please wait.")
				 T)
	      (\COPYSEL SEL TEDIT.SCRATCHSELECTION)
	      (RETURN (QUOTE DON'T])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS MBUTTONIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(MBUTTON.INIT)
)



(* Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD)

(DEFINEQ

(MB.CREATE.THREESTATEBUTTON
  [LAMBDA (TEXT FONT INITSTATE)                              (* jds "24-May-84 16:17")
    (PROG ((OBJ (IMAGEOBJCREATE NIL THREESTATEIMAGEFNS))
	   (BOX (create IMAGEBOX
			XSIZE ←(STRINGWIDTH TEXT FONT)
			YSIZE ←(FONTPROP FONT (QUOTE HEIGHT))
			YDESC ←(FONTPROP FONT (QUOTE DESCENT))
			XKERN ← 0))
	   DS BITMAP X Y)
          (SETQ X (fetch XSIZE of BOX))
          (SETQ Y (fetch YSIZE of BOX))
          (IMAGEOBJPROP OBJ (QUOTE MBTEXT)
			TEXT)
          (IMAGEOBJPROP OBJ (QUOTE MBFONT)
			FONT)
          (IMAGEOBJPROP OBJ (QUOTE MBFN)
			(QUOTE MB.THREESTATEBUTTON.FN))
          (IMAGEOBJPROP OBJ (QUOTE THREESTATE)
			(OR INITSTATE (QUOTE OFF)))
          (SETQ BITMAP (BITMAPCREATE X Y))
          (IMAGEOBJPROP OBJ (QUOTE BITCACHE)
			BITMAP)
          (SETQ DS (DSPCREATE BITMAP))
          (DSPXOFFSET 0 DS)
          (DSPYOFFSET 0 DS)
          (DSPFONT FONT DS)
          (MOVETO 0 (FONTPROP FONT (QUOTE DESCENT))
		  DS)
          (PRIN1 (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
		 DS)
          (RETURN OBJ])

(MB.THREESTATE.DISPLAY
  [LAMBDA (OBJ STREAM MODE)                                  (* jds "24-May-84 15:31")
                                                             (* Display the innards of a menu button)
    (PROG (DS (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
	      (FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
	      (CURX (DSPXPOSITION NIL STREAM))
	      (CURY (DSPYPOSITION NIL STREAM))
	      BITMAP X Y)
          (OR OBJBOX (SETQ OBJBOX (MB.SIZEFN OBJ STREAM)))   (* Make sure the size is set.)
          (SETQ X (fetch XSIZE of OBJBOX))
          (SETQ Y (fetch YSIZE of OBJBOX))
          (COND
	    ((SETQ BITMAP (IMAGEOBJPROP OBJ (QUOTE BITCACHE)))
                                                             (* The image bitmap exists already.
							     Use it.)
	      )
	    (T                                               (* Need to create an image for this object.)
	       (SETQ BITMAP (BITMAPCREATE X Y))
	       (IMAGEOBJPROP OBJ (QUOTE BITCACHE)
			     BITMAP)
	       (SETQ DS (DSPCREATE BITMAP))
	       (DSPXOFFSET 0 DS)
	       (DSPYOFFSET 0 DS)
	       (DSPFONT FONT DS)
	       (MOVETO 0 (FONTPROP FONT (QUOTE DESCENT))
		       DS)
	       (PRIN1 (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
		      DS)))
          (BITBLT BITMAP 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
		  X Y (QUOTE INPUT)
		  (QUOTE PAINT))
          (SELECTQ (IMAGEOBJPROP OBJ (QUOTE THREESTATE))
		   (ON                                       (* The button is ON. Display it as white text on black 
							     background)
		       (BITBLT NIL 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
			       X Y (QUOTE TEXTURE)
			       (QUOTE INVERT)
			       BLACKSHADE))
		   (OFF                                      (* The button is OFF. Mark it with a diagonal line thru 
							     it.)
			(DRAWLINE CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
				  (SUB1 (IPLUS CURX X))
				  (SUB1 (IPLUS (IDIFFERENCE CURY (fetch YDESC of OBJBOX))
					       Y))
				  1
				  (QUOTE PAINT)
				  STREAM))
		   (NEUTRAL                                  (* The button is neutral. Just display it regular.)
			    )
		   NIL])

(MB.THREESTATE.SHOWSELFN
  [LAMBDA (OBJ SEL ON DS)                                    (* jds "22-Feb-84 17:26")
    (PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
			 (IMAGEBOX OBJ DS]
          (COND
	    (ON (SELECTQ (IMAGEOBJPROP OBJ (QUOTE THREESTATE))
			 (ON                                 (* Switch from ON to NEUTRAL)
			     (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
				     (fetch YSIZE of IMAGEBOX)
				     (QUOTE TEXTURE)
				     (QUOTE INVERT)
				     BLACKSHADE))
			 (OFF                                (* Switch from OFF to ON)
			      (BITBLT (IMAGEOBJPROP OBJ (QUOTE BITCACHE))
				      0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
				      (fetch YSIZE of IMAGEBOX)
				      (QUOTE INPUT)
				      (QUOTE REPLACE))
			      (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
				      (fetch YSIZE of IMAGEBOX)
				      (QUOTE TEXTURE)
				      (QUOTE INVERT)
				      BLACKSHADE))
			 (NEUTRAL                            (* Switch from NEUTRAL to OFF)
				  (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX))
					    (SUB1 (fetch YSIZE of IMAGEBOX))
					    1
					    (QUOTE PAINT)
					    DS))
			 NIL))
	    ((fetch SET of SEL)
	      (SELECTQ (IMAGEOBJPROP OBJ (QUOTE THREESTATE))
		       (ON                                   (* Switch from NEUTRAL to ON)
			   (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
				   (fetch YSIZE of IMAGEBOX)
				   (QUOTE TEXTURE)
				   (QUOTE INVERT)
				   BLACKSHADE))
		       (OFF                                  (* Switch from ON to OFF)
			    (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
				    (fetch YSIZE of IMAGEBOX)
				    (QUOTE TEXTURE)
				    (QUOTE INVERT)
				    BLACKSHADE)
			    (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX))
				      (SUB1 (fetch YSIZE of IMAGEBOX))
				      1
				      (QUOTE PAINT)
				      DS))
		       (NEUTRAL                              (* Switch from OFF to NEUTRAL)
				(BITBLT (IMAGEOBJPROP OBJ (QUOTE BITCACHE))
					0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
					(fetch YSIZE of IMAGEBOX)
					(QUOTE INPUT)
					(QUOTE REPLACE)))
		       NIL])

(MB.THREESTATE.WHENOPERATEDFN
  [LAMBDA (OBJ DS OPERATION SEL)                             (* jds "11-Apr-84 11:29")
                                                             (* Handle operations on a three-state button)
    (SELECTQ OPERATION
	     (HIGHLIGHTED                                    (* It is being hilighted)
			  (MB.THREESTATE.SHOWSELFN OBJ SEL T DS))
	     (UNHIGHLIGHTED                                  (* And being de-hilighted)
			    (MB.THREESTATE.SHOWSELFN OBJ SEL NIL DS))
	     (SELECTED                                       (* It's being selected)
		       (MB.THREESTATEBUTTON.FN OBJ SEL DS)   (* Run the state-changing function)
		       (replace SET of SEL with NIL)         (* And mar the selection turned off, so others can use 
							     it without trashing us)
		       (replace ONFLG of SEL with NIL)
		       (replace SET of TEDIT.SELECTION with NIL))
	     (DESELECTED)
	     NIL])

(MB.THREESTATEBUTTON.FN
  [LAMBDA (OBJ SEL W)                                        (* jds " 7-Feb-84 16:00")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   OFILE CH)
          (SELECTQ (IMAGEOBJPROP OBJ (QUOTE THREESTATE))
		   (OFF (IMAGEOBJPROP OBJ (QUOTE THREESTATE)
				      (QUOTE ON)))
		   (ON (IMAGEOBJPROP OBJ (QUOTE THREESTATE)
				     (QUOTE NEUTRAL)))
		   (NEUTRAL (IMAGEOBJPROP OBJ (QUOTE THREESTATE)
					  (QUOTE OFF)))
		   (IMAGEOBJPROP OBJ (QUOTE THREESTATE)
				 (QUOTE ON)))
          (replace ONFLG of SEL with NIL])

(THREESTATE.INIT
  [LAMBDA NIL                                                (* jds "23-May-84 11:39")
    (SETQ THREESTATEIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.THREESTATE.DISPLAY)
					     (FUNCTION MB.SIZEFN)
					     (FUNCTION MB.PUTFN)
					     (FUNCTION MB.GETFN)
					     (QUOTE MB.COPYFN)
					     (FUNCTION MB.BUTTONEVENTINFN)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (FUNCTION MB.THREESTATE.WHENOPERATEDFN)
					     (QUOTE NILL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(THREESTATE.INIT)
)



(* One-of-N Menu button sets)

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD NWAYBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM)
				   (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
				       (QUOTE MB.NB.DISPLAYFN])
]
)
(DEFINEQ

(MB.CREATE.NWAYBUTTON
  [LAMBDA (BUTTONS FONT INITSTATE)                           (* jds " 4-May-84 10:38")
    (PROG ((OBJECT (IMAGEOBJCREATE NIL NWAYBUTTONIMAGEFNS))
	   HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS)
          (SETQ FONT (OR FONT (FONTCREATE (QUOTE HELVETICA)
					  10)))
          (SETQ HEIGHT (FONTPROP FONT (QUOTE HEIGHT)))
          (SETQ DESCENT (FONTPROP FONT (QUOTE DESCENT)))
          (SETQ WIDTHS (for BUTTON in BUTTONS collect (STRINGWIDTH (COND
								     ((NLISTP BUTTON)
								       BUTTON)
								     (T (CAR BUTTON)))
								   FONT)))
          (SETQ IMAGES (for WIDTH in WIDTHS as BUTTON in BUTTONS collect (BITMAPCREATE WIDTH HEIGHT)))
          (SETQ SPACING (STRINGWIDTH "   " FONT))
          [SETQ SIDEEFFECTFNS (for BUTTON in BUTTONS collect (AND (LISTP BUTTON)
								  (CADR BUTTON]
          (SETQ DS (DSPCREATE))
          (DSPXOFFSET 0 DS)
          (DSPYOFFSET 0 DS)
          (DSPFONT FONT DS)
          (DSPRIGHTMARGIN 32000 DS)
          (for IMAGE in IMAGES as BUTTON in BUTTONS
	     do (DSPDESTINATION IMAGE DS)
		(MOVETO 0 DESCENT DS)
		(PRIN1 (COND
			 ((NLISTP BUTTON)
			   BUTTON)
			 (T (CAR BUTTON)))
		       DS))
          (IMAGEOBJPROP OBJECT (QUOTE MINWIDTH)
			(for WIDTH in WIDTHS largest WIDTH))
          (IMAGEOBJPROP OBJECT (QUOTE MINHEIGHT)
			(IPLUS HEIGHT 2))
          [IMAGEOBJPROP OBJECT (QUOTE MAXWIDTH)
			(IPLUS (CAR WIDTHS)
			       (for WIDTH in (CDR WIDTHS) sum (IPLUS WIDTH SPACING]
          (IMAGEOBJPROP OBJECT (QUOTE MAXHEIGHT)
			(ITIMES (IPLUS HEIGHT 2)
				(LENGTH BUTTONS)))
          (IMAGEOBJPROP OBJECT (QUOTE ITEMSPACE)
			SPACING)
          (IMAGEOBJPROP OBJECT (QUOTE BUTTONS)
			BUTTONS)
          (IMAGEOBJPROP OBJECT (QUOTE BUTTONIMAGES)
			IMAGES)
          (IMAGEOBJPROP OBJECT (QUOTE BUTTONHEIGHT)
			(IPLUS HEIGHT 2))
          (IMAGEOBJPROP OBJECT (QUOTE BUTTONWIDTHS)
			WIDTHS)
          (IMAGEOBJPROP OBJECT (QUOTE NBUTTONS)
			(LENGTH BUTTONS))
          (IMAGEOBJPROP OBJECT (QUOTE STATE)
			NIL)
          (IMAGEOBJPROP OBJECT (QUOTE SELECTEDBUTTON)
			NIL)
          (IMAGEOBJPROP OBJECT (QUOTE SIDEEFFECTFNS)
			SIDEEFFECTFNS)
          (IMAGEOBJPROP OBJECT (QUOTE DESCENT)
			DESCENT)
          (RETURN OBJECT])

(MB.NB.DISPLAYFN
  [LAMBDA (OBJ STREAM MODE)                                  (* jds "11-Apr-84 18:16")
                                                             (* Display the innards of a menu button)
    (PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
		  (X (DSPXPOSITION NIL STREAM))
		  (Y (DSPYPOSITION NIL STREAM))
		  (BUTTONX (IMAGEOBJPROP OBJ (QUOTE BUTTONX)))
		  (BUTTONY (IMAGEOBJPROP OBJ (QUOTE BUTTONY)))
		  (BUTTONLIST (IMAGEOBJPROP OBJ (QUOTE BUTTONS)))
		  (BUTTONIMAGES (IMAGEOBJPROP OBJ (QUOTE BUTTONIMAGES)))
		  STATE)
          [COND
	    ((SETQ BITMAP (IMAGEOBJPROP OBJ (QUOTE IMAGECACHE)))
                                                             (* The button image exists already)
	      )
	    (T                                               (* Have to make one.)
	       (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of OBJBOX)
					  (fetch YSIZE of OBJBOX)))
	       (IMAGEOBJPROP OBJ (QUOTE IMAGECACHE)
			     BITMAP)
	       (SETQ DS (DSPCREATE BITMAP))
	       (DSPXOFFSET 0 DS)
	       (DSPYOFFSET 0 DS)
	       (DSPFONT (IMAGEOBJPROP OBJ (QUOTE MBFONT))
			DS)
	       (for X in BUTTONX as Y in BUTTONY as IMAGE in BUTTONIMAGES
		  do                                         (* Display the images)
		     (BITBLT IMAGE 0 0 DS X Y NIL NIL (QUOTE INPUT)
			     (QUOTE REPLACE]
          [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX]
                                                             (* Display the button's image)
          (COND
	    ((SETQ STATE (IMAGEOBJPROP OBJ (QUOTE STATE)))   (* There's a selected button.)
	      (for BXVAL in BUTTONX as BYVAL in BUTTONY as IMAGE in BUTTONIMAGES as BUTTON
		 in BUTTONLIST when (EQ STATE BUTTON) do (BITBLT IMAGE 0 0 STREAM (IPLUS X BXVAL)
								 (IPLUS Y BYVAL)
								 NIL NIL (QUOTE INVERT)
								 (QUOTE REPLACE])

(MB.NB.WHENOPERATEDFN
  [LAMBDA (OBJ DS OPERATION SEL)                             (* jds " 4-May-84 14:59")
    (SELECTQ OPERATION
	     (HIGHLIGHTED                                    (* (MB.SHOWSELFN OBJ SEL T DS)))
	     (UNHIGHLIGHTED                                  (* (MB.SHOWSELFN OBJ SEL NIL DS)))
	     (SELECTED                                       (* There may be a side-effect to occur upon selection.)
		       [PROG ((STATE (IMAGEOBJPROP OBJ (QUOTE STATE)))
			      FN)
			     (for BUTTON in (IMAGEOBJPROP OBJ (QUOTE BUTTONS)) as SIDEFN
				in (IMAGEOBJPROP OBJ (QUOTE SIDEEFFECTFNS)) when (EQ STATE BUTTON)
				do (COND
				     (SIDEFN (MB.SELFN OBJ SEL DS SIDEFN]
		       (replace SET of SEL with NIL))
	     (DESELECTED)
	     NIL])

(MB.NB.SIZEFN
  [LAMBDA (OBJ STREAM CURX RIGHTMARGIN)                      (* jds " 4-May-84 10:38")
                                                             (* Tell the size of an n-way menu)
    (PROG ((OLDBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
	   BOX
	   (MAXWIDTH (IMAGEOBJPROP OBJ (QUOTE MAXWIDTH)))
	   (MINWIDTH (IMAGEOBJPROP OBJ (QUOTE MINWIDTH)))
	   (MAXHEIGHT (IMAGEOBJPROP OBJ (QUOTE MAXHEIGHT)))
	   (MINHEIGHT (IMAGEOBJPROP OBJ (QUOTE MINHEIGHT)))
	   (LINEHEIGHT (IMAGEOBJPROP OBJ (QUOTE LINEHEIGHT)))
	   (BUTTONHEIGHT (IMAGEOBJPROP OBJ (QUOTE BUTTONHEIGHT)))
	   (BUTTONWIDTHS (IMAGEOBJPROP OBJ (QUOTE BUTTONWIDTHS)))
	   (SPACING (IMAGEOBJPROP OBJ (QUOTE ITEMSPACE)))
	   (SLACK (IDIFFERENCE RIGHTMARGIN CURX))
	   BUTTONX BUTTONY BUTTONINFO WIDTH HEIGHT)
          [COND
	    ((IGEQ SLACK MAXWIDTH)                           (* There's space for all the items on one line.
							     Use it)
	      (SETQ WIDTH MAXWIDTH)
	      (SETQ HEIGHT MINHEIGHT)
	      [SETQ BUTTONX (bind (CURX ← 0) for ITEM in BUTTONWIDTHS collect (PROG1 CURX
										     (add CURX 
											  SPACING)
										     (add CURX ITEM]
	      (SETQ BUTTONY (for ITEM in BUTTONWIDTHS collect 0)))
	    [(ILEQ SLACK MINWIDTH)                           (* Have to stack it vertically.)
	      (SETQ WIDTH MINWIDTH)
	      (SETQ HEIGHT MAXHEIGHT)
	      (SETQ BUTTONX (for ITEM in BUTTONWIDTHS collect 0))
	      (SETQ BUTTONY (bind (CURY ←(ITIMES BUTTONHEIGHT (LENGTH BUTTONWIDTHS))) for ITEM
			       in BUTTONWIDTHS collect (add CURY (IMINUS BUTTONHEIGHT]
	    (T (SETQ BUTTONINFO (MB.NB.PACKITEMS SLACK BUTTONWIDTHS SPACING))
	       [SETQ BUTTONX (for LINE in BUTTONINFO join (COPY (CDR LINE]
	       [SETQ BUTTONY (bind (CURY ←(ITIMES BUTTONHEIGHT (LENGTH BUTTONINFO))) for LINE
				in BUTTONINFO join (PROGN (SETQ CURY (IDIFFERENCE CURY BUTTONHEIGHT))
							  (for X in (CDR LINE) collect CURY]
	       [SETQ WIDTH (CAR (for LINE in BUTTONINFO largest (CAR LINE]
	       (SETQ HEIGHT (ITIMES BUTTONHEIGHT (LENGTH BUTTONINFO]
          (COND
	    ((AND OLDBOX (IEQP WIDTH (fetch XSIZE of OLDBOX))
		  (IEQP HEIGHT (fetch YSIZE of OLDBOX)))     (* If nothing changed, don't bother reformatting.)
	      (RETURN OLDBOX))
	    (T                                               (* Otherwise invalidate the image cache)
	       (IMAGEOBJPROP OBJ (QUOTE IMAGECACHE)
			     NIL)))
          (SETQ BOX (create IMAGEBOX
			    XSIZE ← WIDTH
			    YSIZE ← HEIGHT
			    YDESC ←(IMAGEOBJPROP OBJ (QUOTE DESCENT))
			    XKERN ← 0))
          (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
			BOX)
          (IMAGEOBJPROP OBJ (QUOTE BUTTONX)
			BUTTONX)
          (IMAGEOBJPROP OBJ (QUOTE BUTTONY)
			BUTTONY)
          (RETURN BOX])

(MB.NWAYBUTTON.SELFN
  [LAMBDA (OBJ W SEL MOUSEX MOUSEY)                          (* jds " 4-May-84 14:59")
                                                             (* Selecting an NWAY button.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
	   (OLDSTATE (IMAGEOBJPROP OBJ (QUOTE STATE)))
	   (BUTTONLIST (IMAGEOBJPROP OBJ (QUOTE BUTTONS)))
	   (BUTTONX (IMAGEOBJPROP OBJ (QUOTE BUTTONX)))
	   (BUTTONIMAGES (IMAGEOBJPROP OBJ (QUOTE BUTTONIMAGES)))
	   (BUTTONY (IMAGEOBJPROP OBJ (QUOTE BUTTONY)))
	   (BUTTONWIDTHS (IMAGEOBJPROP OBJ (QUOTE BUTTONWIDTHS)))
	   (BUTTONLIST (IMAGEOBJPROP OBJ (QUOTE BUTTONLIST)))
	   (BUTTONHEIGHT (IMAGEOBJPROP OBJ (QUOTE BUTTONHEIGHT)))
	   CH STATE)
          [for BUTTON in BUTTONLIST as X in BUTTONX as Y in BUTTONY as WIDTH in BUTTONWIDTHS
	     as IMAGE in BUTTONIMAGES
	     do (COND
		  ((INSIDE? (create REGION
				    LEFT ← X
				    BOTTOM ← Y
				    WIDTH ← WIDTH
				    HEIGHT ← BUTTONHEIGHT)
			    MOUSEX MOUSEY)                   (* The mouse is pointing here.
							     Select this.)
		    (SETQ STATE BUTTON)
		    (BITBLT IMAGE 0 0 W X Y NIL NIL (QUOTE INVERT)
			    (QUOTE REPLACE)))
		  ((EQ OLDSTATE BUTTON)                      (* This was the old selection 
							     (and it's different, too). Unselect it)
		    (BITBLT IMAGE 0 0 W X Y NIL NIL (QUOTE INPUT)
			    (QUOTE REPLACE]
          (IMAGEOBJPROP OBJ (QUOTE STATE)
			STATE)
          (RETURN T])

(MB.NWAYMENU.NEWBUTTON
  [LAMBDA (TEXTOBJ CH# OLDBUTTON NEWBUTTON)                  (* jds " 8-Feb-84 19:41")
                                                             (* Given a hook on an existing button, and an insertion 
							     point, insert a new button)
    (PROG ((ARBITRATOR (IMAGEOBJPROP OLDBUTTON (QUOTE ARBITRATOR)))
	   BUTTON)
          (IMAGEOBJPROP BUTTON (QUOTE ARBITRATOR)
			ARBITRATOR)
          (TEDIT.INSERT.OBJECT BUTTON TEXTOBJ CH#)
          (TEDIT.INSERT TEXTOBJ "  " (ADD1 CH#))
          (TEDIT.LOOKS TEXTOBJ (QUOTE (PROTECTED ON))
		       (ADD1 CH#)
		       2)
          (RETURN BUTTON])

(NWAYBUTTON.INIT
  [LAMBDA (BUTTONS FONT INITSTATE)                           (* jds "23-May-84 11:40")
    (SETQ NWAYBUTTONIMAGEFNS (IMAGEFNSCREATE (QUOTE MB.NB.DISPLAYFN)
					     (QUOTE MB.NB.SIZEFN)
					     (QUOTE MB.PUTFN)
					     (QUOTE MB.GETFN)
					     (QUOTE MB.COPYFN)
					     (QUOTE MB.NWAYBUTTON.SELFN)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE NILL)
					     (QUOTE MB.NB.WHENOPERATEDFN)
					     (QUOTE NILL])

(MB.NB.PACKITEMS
  [LAMBDA (WIDTH ITEMWIDTHS SPACING)                         (* jds "15-May-84 15:41")

          (* * Pack items into lines WIDTH wide. Item widths are in ITEMWIDTHS, and each pair of items on a line is 
	  separated by SPACING. Returns a list of lists, one per line packed, of the relative X starts of the items)


    (PROG ((CURX 0)
	   (LINES NIL)
	   (CURLINE NIL)
	   ITEM)
          (while ITEMWIDTHS
	     do (SETQ ITEM (pop ITEMWIDTHS))
		(COND
		  ([ILESSP WIDTH (IPLUS CURX ITEM (COND
					  (CURLINE SPACING)
					  (T 0]              (* Time for a new line)
		    (SETQ LINES (NCONC1 LINES (CONS CURX CURLINE)))
		    (SETQ CURLINE NIL)
		    (SETQ CURX 0)))
		(AND CURLINE (add CURX SPACING))
		(SETQ CURLINE (NCONC1 CURLINE CURX))
		(add CURX ITEM))
          [AND CURLINE (SETQ LINES (NCONC1 LINES (CONS CURX CURLINE]
          (RETURN LINES])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS NWAYBUTTONIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(NWAYBUTTON.INIT)
)



(* Full menu inside an object support)

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD MENUOBJ (MENU MOBJAUXINFO)
		(TYPE? (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
			   (QUOTE MB.FULLMENU.DISPLAYFN))))
]
)
(DEFINEQ

(MENUOBJ.INIT
  [LAMBDA NIL                                                (* jds "23-May-84 11:40")
    (SETQ FULLMENUIMAGEFNS (IMAGEFNSCREATE (QUOTE MB.FULLMENU.DISPLAYFN)
					   (QUOTE MB.FULLMENU.SIZEFN)
					   (QUOTE MB.PUTFN)
					   (QUOTE MB.GETFN)
					   (QUOTE MB.COPYFN)
					   (QUOTE MB.FULLMENU.SELFN)
					   (QUOTE NILL)
					   (QUOTE NILL)
					   (QUOTE NILL)
					   (QUOTE NILL)
					   (QUOTE NILL)
					   (QUOTE MB.WHENOPERATEDFN)
					   (QUOTE NIL])

(MB.CREATE.FULLMENU
  [LAMBDA (MENU FONT)                                        (* jds " 9-Feb-84 15:14")
    (PROG ((BUTTON (IMAGEOBJCREATE (COND
				     ((type? MENU MENU)
				       MENU)
				     (T (create MENU
						ITEMS ← MENU
						CENTERFLG ← T
						MENUROWS ← 1
						MENUFONT ← FONT)))
				   FULLMENUIMAGEFNS)))
          (RETURN BUTTON])

(MB.FULLMENU.DISPLAYFN
  [LAMBDA (OBJ STREAM MODE)                                  (* jds "11-Apr-84 14:09")
                                                             (* Display the innards of a menu button)
    (PROG [(MENU (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM]
          (SELECTQ (IMAGESTREAMTYPE STREAM)
		   (DISPLAY (replace LEFT of (fetch MENUGRID of MENU) with (DSPXPOSITION NIL STREAM))
			    (replace BOTTOM of (fetch MENUGRID of MENU) with (DSPYPOSITION NIL STREAM)
				     )
			    (MB.BLTMENUIMAGE MENU STREAM))
		   ((PRESS INTERPRESS)
		     (TEDIT.PROMPTPRINT TEXTOBJ "Hardcopy of MENUs not yet supported." T))
		   NIL])

(MB.FULLMENU.SELFINALFN
  [LAMBDA (OBJ SEL W)                                        (* jds "29-SEP-83 16:29")
    (replace SET of SEL with NIL)
    (replace SET of TEDIT.SELECTION with NIL])

(MB.FULLMENU.SELFN
  [LAMBDA (OBJ WINDOW SEL XOFFSET YOFFSET)                   (* jds " 9-Feb-84 15:18")
    (PROG ((MENU (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
	   (IMAGEBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
	   MENUSEL)
          (replace LEFT of (fetch MENUGRID of MENU) with 0)
          (replace BOTTOM of (fetch MENUGRID of MENU) with (IMINUS (fetch YDESC of IMAGEBOX)))
          (AND (fetch MENUUSERDATA of MENU)
	       (SHADEITEM (fetch MENUUSERDATA of MENU)
			  MENU NIL WINDOW))
          (SETQ MENUSEL (MENU.HANDLER MENU WINDOW))
          (COND
	    (MENUSEL (DOSELECTEDITEM MENU (CAR MENUSEL)
				     (CDR MENUSEL))
		     (SHADEITEM (CAR MENUSEL)
				MENU MENUSELECTSHADE WINDOW)))
          (replace MENUUSERDATA of MENU with (CAR MENUSEL))
          (IMAGEOBJPROP OBJ (QUOTE STATE)
			(CAR MENUSEL))
          (RETURN T])

(MB.FULLMENU.SHOWSELFN
  [LAMBDA (OBJ SEL ON DS)                                    (* jds "29-SEP-83 17:56")
    NIL])

(MB.FULLMENU.SIZEFN
  [LAMBDA (OBJ)                                              (* jds " 9-Feb-84 15:11")
    (create IMAGEBOX
	    XSIZE ←(fetch IMAGEWIDTH of (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
	    YSIZE ←(fetch IMAGEHEIGHT of (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
	    YDESC ← 0
	    XKERN ← 0])

(MB.BLTMENUIMAGE
  [LAMBDA (MENU WIN DONTOPEN)                                (* jds "11-Apr-84 14:09")
                                                             (* Displays a menu image at its position on DS.)
    (PROG [(SRC (COND
		  ((WINDOWP (fetch IMAGE of MENU))
		    (fetch (WINDOW SAVE) of (fetch (MENU IMAGE) of MENU)))
		  (T (fetch IMAGE of MENU]
          (BITBLT SRC NIL NIL WIN (fetch (MENU MENUREGIONLEFT) of MENU)
		  (fetch (MENU MENUREGIONBOTTOM) of MENU])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS FULLMENUIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(MENUOBJ.INIT)
)



(* Margin Setting and display)

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE)
		  [TYPE? (AND (IMAGEOBJP DATUM)
			      (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
				  (QUOTE MB.MARGINBAR.DISPLAYFN])
]
)
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD TAB (TABX . TABKIND))
]
)
(DEFINEQ

(DRAWMARGINSCALE
  [LAMBDA (W UNIT)                                           (* jds " 4-NOV-83 16:03")
    (PROG ((WREG (DSPCLIPPINGREGION NIL W))
	   (OLDOP (DSPOPERATION (QUOTE REPLACE)
				W)))
          (DSPFILL (create REGION
			   LEFT ← 0
			   BOTTOM ← 0
			   WIDTH ←(fetch WIDTH of WREG)
			   HEIGHT ← 24)
		   WHITESHADE
		   (QUOTE REPLACE)
		   W)
          (SELECT UNIT [1                                    (* Straight Points)
			  (for X from 4 by 3 to (fetch WIDTH of WREG)
			     do (COND
				  ((ZEROP (IREMAINDER (IDIFFERENCE X 4)
						      72))
				    (BITBLT NIL 0 0 W X 8 1 16 (QUOTE TEXTURE)
					    (QUOTE REPLACE)
					    BLACKSHADE)
				    (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH (IDIFFERENCE X 4))
								 1))
					    10 W)
				    (PRIN1 (IDIFFERENCE X 4)
					   W))
				  (T (BITBLT NIL 0 0 W X 20 1 4 (QUOTE TEXTURE)
					     (QUOTE REPLACE)
					     BLACKSHADE]
		  (12                                        (* Picas)
		      (for X from 4 by UNIT to (fetch WIDTH of WREG) as NOMX from 0
			 do (COND
			      ((ZEROP (IREMAINDER NOMX 6))
				(BITBLT NIL 0 0 W X 8 1 16 (QUOTE TEXTURE)
					(QUOTE REPLACE)
					BLACKSHADE)
				(MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH NOMX)
							     1))
					10 W)
				(PRIN1 NOMX W))
			      (T (BITBLT NIL 0 0 W X 20 1 4 (QUOTE TEXTURE)
					 (QUOTE REPLACE)
					 BLACKSHADE)))
			    (BITBLT NIL 0 0 W (IPLUS X 6)
				    22 1 2 (QUOTE TEXTURE)
				    (QUOTE REPLACE)
				    BLACKSHADE)))
		  NIL)
          (BITBLT NIL 0 0 W 4 23 (fetch WIDTH of WREG)
		  1
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)
          (MOVETO 0 0 W)
          (RELDRAWTO (IDIFFERENCE (fetch WIDTH of WREG)
				  2)
		     0 1 (QUOTE PAINT)
		     W)
          (RELDRAWTO 0 (IDIFFERENCE (fetch HEIGHT of WREG)
				    2)
		     1
		     (QUOTE PAINT)
		     W)
          (RELDRAWTO (IMINUS (IDIFFERENCE (fetch WIDTH of WREG)
					  2))
		     0 1 (QUOTE PAINT)
		     W)
          (RELDRAWTO 0 (IMINUS (IDIFFERENCE (fetch HEIGHT of WREG)
					    2))
		     1
		     (QUOTE PAINT)
		     W)
          (DSPOPERATION OLDOP W])

(MARGINBAR
  [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM)              (* jds "17-May-84 16:42")
                                                             (* Given a set of margins and a unit, show the margin 
							     bar properly)
    (PROG ((OLDOP (DSPOPERATION (QUOTE ERASE)
				W))
	   (SCALEDL1 (MSCALE L1 UNIT))
	   (SCALEDLN (MSCALE LN UNIT))
	   (SCALEDR (MSCALE R UNIT))
	   (FLOATINGRIGHT NIL)
	   (EXTENDEDRIGHT NIL)
	   UNSETL1 UNSETLN)
          (OR UPDATE (DRAWMARGINSCALE W UNIT))
          (DSPFONT (FONTCREATE (QUOTE GACHA)
			       10)
		   W)
          (SETQ L1 (MKSTRING (ABS L1)))
          (SETQ LN (MKSTRING (ABS LN)))
          (SETQ R (MKSTRING (ABS R)))
          [COND
	    [(ILESSP SCALEDR 4)                              (* Unset right margin. Show specially, but at its usual 
							     place.)
	      (SETQ FLOATINGRIGHT T)
	      (SETQ SCALEDR (IPLUS 4 (IDIFFERENCE 4 SCALEDR]
	    ((ILEQ SCALEDR 4)                                (* Floating right margin => marked specially)
	      (SETQ FLOATINGRIGHT T)
	      (SETQ SCALEDR RIGHTLIM))
	    ((IGREATERP SCALEDR RIGHTLIM)                    (* Not floating, so just limit it to the rightmost that 
							     can be seen.)
	      (SETQ EXTENDEDRIGHT T)
	      (SETQ SCALEDR (IDIFFERENCE RIGHTLIM 8]
          [COND
	    ((ILESSP SCALEDL1 4)                             (* Unset right FIRST LEFT margin.
							     Show specially, but at its usual place.)
	      (SETQ UNSETL1 T)
	      (SETQ SCALEDL1 (IPLUS 4 (IDIFFERENCE 4 SCALEDL1]
          [COND
	    ((ILESSP SCALEDLN 4)                             (* Unset LEFT margin. Show specially, but at its usual 
							     place.)
	      (SETQ UNSETLN T)
	      (SETQ SCALEDLN (IPLUS 4 (IDIFFERENCE 4 SCALEDLN]
          (BITBLT NIL 0 0 W 1 26 (IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL W))
					      3)
		  32
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  WHITESHADE)
          (BITBLT NIL 0 0 W SCALEDL1 42 (IDIFFERENCE SCALEDR SCALEDL1)
		  16
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)
          (BITBLT NIL 0 0 W SCALEDLN 26 (IDIFFERENCE SCALEDR SCALEDLN)
		  16
		  (QUOTE TEXTURE)
		  (QUOTE REPLACE)
		  BLACKSHADE)
          (COND
	    (UNSETL1                                         (* 1st left margin isn't set, tho it has a value.
							     Mark it neutral)
		     (BITBLT NIL 0 0 W SCALEDL1 42 (IPLUS (STRINGWIDTH L1 W)
							  2)
			     16
			     (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     EDITGRAY)
		     (DSPOPERATION (QUOTE PAINT)
				   W)
		     (MOVETO (IPLUS SCALEDL1 2)
			     44 W)
		     (PRIN1 L1 W)
		     (DSPOPERATION (QUOTE ERASE)
				   W))
	    (T (MOVETO (IPLUS SCALEDL1 2)
		       44 W)
	       (PRIN1 L1 W)))
          (COND
	    (UNSETLN                                         (* left margin isn't set, tho it has a value.
							     Mark it neutral)
		     (BITBLT NIL 0 0 W SCALEDLN 26 (IPLUS (STRINGWIDTH LN W)
							  2)
			     16
			     (QUOTE TEXTURE)
			     (QUOTE REPLACE)
			     EDITGRAY)
		     (DSPOPERATION (QUOTE PAINT)
				   W)
		     (MOVETO (IPLUS SCALEDLN 2)
			     28 W)
		     (PRIN1 LN W)
		     (DSPOPERATION (QUOTE ERASE)
				   W))
	    (T (MOVETO (IPLUS SCALEDLN 2)
		       28 W)
	       (PRIN1 LN W)))
          [COND
	    (FLOATINGRIGHT                                   (* Floating right margin is marked by a light gray 
							     marker)
			   (BITBLT NIL 0 0 W (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W)
									 2))
				   26
				   (IPLUS (STRINGWIDTH R W)
					  2)
				   32
				   (QUOTE TEXTURE)
				   (QUOTE REPLACE)
				   EDITGRAY)
			   (DSPOPERATION (QUOTE PAINT)
					 W))
	    (EXTENDEDRIGHT                                   (* A non-visible right margin is marked by two wavy 
							     lines indicating a break)
			   (BITBLT TEDIT.EXTENDEDRIGHTMARK 0 0 W SCALEDR 26 8 32 (QUOTE INPUT)
				   (QUOTE REPLACE]
          (MOVETO (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W)
					      2))
		  36 W)
          (PRIN1 R W)
          (DSPOPERATION OLDOP W)
          (DSPFILL (create REGION
			   LEFT ← 2
			   BOTTOM ← 1
			   HEIGHT ← 8
			   WIDTH ←(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL W))
					       4))
		   WHITESHADE
		   (QUOTE REPLACE)
		   W)
          (for TAB in TABS
	     do                                              (* Run thru the tabs, putting them down in place.)
		(MB.MARGINBAR.SHOWTAB W TAB UNIT (QUOTE PAINT])

(MARGINBAR.CREATE
  [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE)      (* jds "24-May-84 16:19")
    (PROG ((BOX (create IMAGEBOX
			XSIZE ← 504
			YSIZE ← 62
			YDESC ← 0
			XKERN ← 4))
	   OBJ OBJDATUM BITMAP DS)
          (SETQ OBJ
	    (IMAGEOBJCREATE (SETQ OBJDATUM
			      (create MARGINBAR
				      MARL1 ← MARL1
				      MARLN ← MARLN
				      MARR ← MARR
				      MARTABS ← MARTABS
				      MARUNIT ← MARUNIT
				      MARTABTYPE ← MARTABTYPE))
			    MARGINBARIMAGEFNS))
          (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX)
				     (fetch YSIZE of BOX)))
          (IMAGEOBJPROP OBJ (QUOTE BITCACHE)
			BITMAP)
          (SETQ DS (DSPCREATE BITMAP))
          (IMAGEOBJPROP OBJ (QUOTE DSPCACHE)
			DS)
          (DSPXOFFSET 0 DS)
          (DSPYOFFSET 0 DS)
          (DSPCLIPPINGREGION (create REGION
				     LEFT ← 0
				     BOTTOM ← 0
				     WIDTH ←(fetch XSIZE of BOX)
				     HEIGHT ←(fetch YSIZE of BOX))
			     DS)
          (MARGINBAR DS (fetch (MARGINBAR MARL1) of OBJDATUM)
		     (fetch (MARGINBAR MARLN) of OBJDATUM)
		     (fetch (MARGINBAR MARR) of OBJDATUM)
		     (fetch (MARGINBAR MARTABS) of OBJDATUM)
		     (fetch (MARGINBAR MARUNIT) of OBJDATUM)
		     NIL
		     (fetch WIDTH of (DSPCLIPPINGREGION NIL DS)))
          (RETURN OBJ])

(MB.MARGINBAR.SELFN
  [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY)   (* jds "17-May-84 17:00")
                                                             (* Let the user adjust margins and tabs using the 
							     mouse.)
    (PROG [(OBJDATUM (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
	   (IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
			 (IMAGEBOX OBJ STREAM (QUOTE DISPLAY]
          (PROG ((L1 (fetch MARL1 of OBJDATUM))
		 (LN (fetch MARLN of OBJDATUM))
		 (R (fetch MARR of OBJDATUM))
		 (TABS (fetch MARTABS of OBJDATUM))
		 [SCALEDTABS (for TAB in (fetch MARTABS of OBJDATUM)
				collect (MSCALE (fetch TABX of TAB)
						(fetch MARUNIT of OBJDATUM]
		 (UNIT (fetch MARUNIT of OBJDATUM))
		 (CLIP (create REGION
			       LEFT ← 0
			       BOTTOM ← 0
			       WIDTH ←(fetch XSIZE of IMAGEBOX)
			       HEIGHT ←(fetch YSIZE of IMAGEBOX)))
		 (RIGHTLIM (IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL SELWINDOW))
					4))
		 TAB TABX OL1 OLN OR)
	        (SETQ OL1 L1)
	        (SETQ OLN LN)
	        (SETQ OR R)
	        [COND
		  [(INSIDE? (create REGION
				    LEFT ←(MSCALE (ABS L1)
						  UNIT)
				    BOTTOM ← 42
				    WIDTH ← 16
				    HEIGHT ← 16)
			    RELX RELY)                       (* Move the 1st-line left margin.)
		    (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
				(INSIDE? CLIP (LASTMOUSEX STREAM)
					 (LASTMOUSEY STREAM)))
		       do (SETQ L1 (MAX 0 (MDESCALE (LASTMOUSEX STREAM)
						    UNIT)))
			  [COND
			    ((\TEDIT.MOUSESTATE RIGHT)       (* Right mouse button UNsets the margin.)
			      (SETQ L1 (MINUS L1]
			  (COND
			    ((NOT (EQUAL OL1 L1))
			      (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM)
			      (SETQ OL1 L1]
		  [(INSIDE? (create REGION
				    LEFT ←(MSCALE (ABS LN)
						  UNIT)
				    BOTTOM ← 26
				    WIDTH ← 16
				    HEIGHT ← 16)
			    RELX RELY)                       (* Move the skirt's left margin)
		    (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
				(INSIDE? CLIP (LASTMOUSEX STREAM)
					 (LASTMOUSEY STREAM)))
		       do (SETQ LN (MAX 0 (MDESCALE (LASTMOUSEX STREAM)
						    UNIT)))
			  [COND
			    ((\TEDIT.MOUSESTATE RIGHT)       (* Right mouse button UNsets the margin.)
			      (SETQ LN (MINUS LN]
			  (COND
			    ((NOT (EQUAL OLN LN))
			      (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM)
			      (SETQ OLN LN]
		  [(INSIDE? (create REGION
				    LEFT ←(IDIFFERENCE (IMIN (MSCALE (ABS R)
								     UNIT)
							     (fetch XSIZE of IMAGEBOX)
							     (fetch WIDTH of (DSPCLIPPINGREGION
									       NIL SELWINDOW)))
						       16)
				    BOTTOM ← 26
				    WIDTH ← 16
				    HEIGHT ← 32)
			    RELX RELY)                       (* Move the right margin)
		    (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
				(INSIDE? CLIP (LASTMOUSEX STREAM)
					 (LASTMOUSEY STREAM)))
		       do (SETQ R (MAX 0 (MDESCALE (LASTMOUSEX STREAM)
						   UNIT)))
			  [COND
			    ((\TEDIT.MOUSESTATE RIGHT)       (* Right mouse button UNsets the margin.)
			      (SETQ R (MINUS R]
			  (COND
			    ((NOT (EQUAL OR R))
			      (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM)
			      (SETQ OR R]
		  ((INSIDE? (create REGION
				    LEFT ← 0
				    BOTTOM ← 0
				    WIDTH ←(fetch WIDTH of CLIP)
				    HEIGHT ← 16)
			    RELX RELY)                       (* We're in the tab ruler region)
		    (COND
		      ((MOUSESTATE LEFT)                     (* MOVE a tab)
			[SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
				     smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
			(AND TAB (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)))
		      [(MOUSESTATE MIDDLE)                   (* ADD/CHANGE a tab)
			(COND
			  ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
					     smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
				(SETQ TABX (MSCALE (CAR TAB)
						   UNIT))
				(IGEQ (LASTMOUSEX STREAM)
				      (IDIFFERENCE TABX 2))
				(ILEQ (LASTMOUSEX STREAM)
				      (IPLUS TABX 2)))
			    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
			    (replace TABKIND of TAB with (OR (fetch MARTABTYPE of OBJDATUM)
							     (QUOTE LEFT)))
			    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
			    (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB))
			  ([OR (NOT TAB)
			       (NOT (EQP (fetch TABX of TAB)
					 (MDESCALE (LASTMOUSEX STREAM)
						   UNIT]     (* Really create a new tab)
			    [SETQ TAB (create TAB
					      TABX ←(MDESCALE (LASTMOUSEX STREAM)
							      UNIT)
					      TABKIND ←(OR (fetch MARTABTYPE of OBJDATUM)
							   (QUOTE LEFT]
			    (SETQ TABS (CONS TAB TABS))
			    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
			    (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB]
		      ((MOUSESTATE RIGHT)                    (* DELETE a tab.)
			(COND
			  ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
					     smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
				(SETQ TABX (MSCALE (CAR TAB)
						   UNIT))
				(IGEQ (LASTMOUSEX STREAM)
				      (IDIFFERENCE TABX 2))
				(ILEQ (LASTMOUSEX STREAM)
				      (IPLUS TABX 2)))
			    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
			    (SETQ TABS (LDIFFERENCE TABS (LIST TAB]
	        (replace MARL1 of OBJDATUM with L1)
	        (replace MARLN of OBJDATUM with LN)
	        (replace MARR of OBJDATUM with R)
	        (replace MARTABS of OBJDATUM with TABS)))
    T])

(MB.MARGINBAR.SIZEFN
  [LAMBDA (OBJ)                                              (* jds "22-Feb-84 15:53")
    (PROG ((BOX (create IMAGEBOX
			XSIZE ← 504
			YSIZE ← 62
			YDESC ← 0
			XKERN ← 4)))
          (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
			BOX)
          (RETURN BOX])

(MB.MARGINBAR.DISPLAYFN
  [LAMBDA (OBJ STREAM MODE)                                  (* jds "24-May-84 16:14")
                                                             (* Display the innards of a menu button)
    (PROG ((IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
			 (IMAGEBOX OBJ STREAM MODE)))
	   (OBJDATUM (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
	   BITMAP
	   (DS (DSPCREATE))
	   WASON)
          (COND
	    [[SETQ WASON (SETQ BITMAP (IMAGEOBJPROP OBJ (QUOTE BITCACHE]

          (* The marginbar existed already as an image. Don't bother re-creating it, and remember that we're allowed to 
	  MODIFY the old image instead of creating a new one.)


	      (SETQ DS (IMAGEOBJPROP OBJ (QUOTE DSPCACHE]
	    (T                                               (* Have to create an image for the margin bar)
	       (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of IMAGEBOX)
					  (fetch YSIZE of IMAGEBOX)))
	       (IMAGEOBJPROP OBJ (QUOTE BITCACHE)
			     BITMAP)
	       (SETQ DS (DSPCREATE BITMAP))
	       (IMAGEOBJPROP OBJ (QUOTE DSPCACHE)
			     DS)
	       (DSPXOFFSET 0 DS)
	       (DSPYOFFSET 0 DS)
	       (DSPCLIPPINGREGION (create REGION
					  LEFT ← 0
					  BOTTOM ← 0
					  WIDTH ←(fetch XSIZE of IMAGEBOX)
					  HEIGHT ←(fetch YSIZE of IMAGEBOX))
				  DS)))
          (MARGINBAR DS (fetch (MARGINBAR MARL1) of OBJDATUM)
		     (fetch (MARGINBAR MARLN) of OBJDATUM)
		     (fetch (MARGINBAR MARR) of OBJDATUM)
		     (fetch (MARGINBAR MARTABS) of OBJDATUM)
		     (fetch (MARGINBAR MARUNIT) of OBJDATUM)
		     WASON
		     (fetch WIDTH of (DSPCLIPPINGREGION NIL STREAM)))
          (BITBLT BITMAP 0 0 STREAM (IDIFFERENCE (DSPXPOSITION NIL STREAM)
						 4)
		  (IDIFFERENCE (DSPYPOSITION NIL STREAM)
			       (fetch YDESC of IMAGEBOX])

(MDESCALE
  [LAMBDA (VAL UNIT)                                         (* jds " 4-NOV-83 17:29")
                                                             (* Convert a value from screen offset units to marginbar
							     units)
    (COND
      ((IEQP UNIT 12)
	(QUOTIENT (IQUOTIENT (LLSH (IDIFFERENCE VAL 4)
				   1)
			     UNIT)
		  2.0))
      (T (QUOTIENT (DIFFERENCE VAL 4)
		   UNIT])

(MSCALE
  [LAMBDA (VAL UNIT)                                         (* jds " 4-NOV-83 17:31")
                                                             (* Convert from marginbar units to a screen X offset)
    (IPLUS 4 (FIXR (TIMES VAL (OR UNIT 1])

(MB.MARGINBAR.SHOWTAB
  [LAMBDA (W TAB UNIT MODE)                                  (* jds "22-NOV-83 11:25")
                                                             (* Paint/erase/otherwise display the sign for a TAB in 
							     window WINDOW, using units UNIT)
    (PROG ((TABX (MSCALE (fetch TABX of TAB)
			 UNIT)))
          (SELECTQ (fetch TABKIND of TAB)
		   (LEFT                                     (* Flush-left tab.)
			 (BITBLT \TEDIT.LEFTTAB 0 0 W (IDIFFERENCE TABX 2)
				 1 NIL NIL (QUOTE INPUT)
				 MODE))
		   (CENTERED                                 (* Centered Tab)
			     (BITBLT \TEDIT.CENTERTAB 0 0 W (IDIFFERENCE TABX 5)
				     1 NIL NIL (QUOTE INPUT)
				     MODE))
		   (RIGHT                                    (* Flush-right Tab)
			  (BITBLT \TEDIT.RIGHTTAB 0 0 W (IDIFFERENCE TABX 7)
				  1 NIL NIL (QUOTE INPUT)
				  MODE))
		   (DECIMAL                                  (* Decimal aligned tab)
			    (BITBLT \TEDIT.DECIMALTAB 0 0 W (IDIFFERENCE TABX 7)
				    1 NIL NIL (QUOTE INPUT)
				    MODE))
		   NIL])

(MB.MARGINBAR.TABTRACK
  [LAMBDA (STREAM OBJ TAB)                                   (* jds " 8-Feb-84 20:38")
                                                             (* Given that the mouse is down over a tab, track the 
							     tab as the mouse moves.)
    (PROG ((UNIT (fetch MARUNIT of OBJ))
	   (CLIP (DSPCLIPPINGREGION NIL STREAM))
	   (OLDX (MSCALE (fetch TABX of TAB)
			 (fetch MARUNIT of OBJ)))
	   X)
          (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
		      (INSIDE? CLIP (LASTMOUSEX STREAM)
			       (LASTMOUSEY STREAM)))
	     do (COND
		  ([NOT (IEQP OLDX (SETQ X (LASTMOUSEX STREAM]
		    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
		    (replace TABX of TAB with (MDESCALE X UNIT))
		    (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
		    (SETQ OLDX X])

(\TEDIT.TABTYPE.SET
  [LAMBDA (OBJ SEL W)                                        (* jds "12-Apr-84 15:42")
                                                             (* Change the kind of TAB that will be set in the 
							     succeeding marginbar.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (CH# (ADD1 (fetch CH# of SEL)))
	   STATE)
          (SETQ STATE (IMAGEOBJPROP OBJ (QUOTE STATE)))
          (TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO FNARG)
			       (COND
				 ((AND (IGREATERP CH# (CAR FNARG))
				       (fetch POBJ of PC)
				       (type? MARGINBAR (fetch POBJ of PC)))
				   (replace MARTABTYPE of (IMAGEOBJPROP (fetch POBJ of PC)
									(QUOTE OBJECTDATUM))
				      with (CDR FNARG))
				   (QUOTE STOP]
			   (CONS CH# (U-CASE (COND
					       ((LISTP STATE)
						 (CAR STATE))
					       (T STATE])

(MARGINBAR.INIT
  [LAMBDA NIL                                                (* jds "23-May-84 11:41")
    (SETQ MARGINBARIMAGEFNS (IMAGEFNSCREATE (QUOTE MB.MARGINBAR.DISPLAYFN)
					    (QUOTE MB.MARGINBAR.SIZEFN)
					    (QUOTE MB.MARGINBAR.PUTFN)
					    (QUOTE MB.MARGINBAR.GETFN)
					    (QUOTE MB.COPYFN)
					    (QUOTE MB.MARGINBAR.SELFN)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL)
					    (QUOTE NILL])
)

(RPAQ \TEDIT.LEFTTAB (READBITMAP))
(10 8
"B@@@"
"B@@@"
"G@@@"
"JH@@"
"B@@@"
"B@@@"
"CN@@"
"@@@@")

(RPAQ \TEDIT.CENTERTAB (READBITMAP))
(10 8
"@D@@"
"@D@@"
"@N@@"
"AE@@"
"@D@@"
"@D@@"
"AO@@"
"@@@@")

(RPAQ \TEDIT.RIGHTTAB (READBITMAP))
(10 8
"@A@@"
"@A@@"
"@CH@"
"@ED@"
"@A@@"
"@A@@"
"AO@@"
"@@@@")

(RPAQ \TEDIT.DECIMALTAB (READBITMAP))
(10 8
"@A@@"
"@A@@"
"@CH@"
"@ED@"
"@A@@"
"FM@@"
"FM@@"
"@@@@")

(RPAQ TEDIT.EXTENDEDRIGHTMARK (READBITMAP))
(8 32
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS MARGINBARIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(MARGINBAR.INIT)
)



(* Text menu creation and support)

(DEFINEQ

(\TEXTMENU.START
  [LAMBDA (MENU MAINWINDOW)                                  (* jds "17-May-84 13:31")
                                                             (* Create a TEdit-based menu for a given main window.)
    (PROG ([WREG (COND
		   (MAINWINDOW (WINDOWPROP MAINWINDOW (QUOTE REGION)))
		   (T (GETREGION]
	   (CH#1 NIL)
	   MENUW MENUTEXT)
          (COND
	    ((AND MAINWINDOW (WINDOWPROP MAINWINDOW (QUOTE TEDITMENU)))
                                                             (* This is a menu window. It can't have a menu, so bail 
							     out.)
	      (RETURN))
	    ([AND MAINWINDOW (for WW in (ATTACHEDWINDOWS MAINWINDOW) thereis (WINDOWPROP
									       WW
									       (QUOTE TEDITMENU]
                                                             (* If this main window already has a menu, don't add 
							     another.)
	      (RETURN)))
          (SETQ MENUW (CREATEW (SETQ WREG (COND
				   (MAINWINDOW (create REGION
						       LEFT ←(fetch (REGION LEFT) of WREG)
						       BOTTOM ←(fetch (REGION TOP) of WREG)
						       WIDTH ←(fetch (REGION WIDTH) of WREG)
						       HEIGHT ← 133))
				   (T WREG)))
			       "TEdit Menu"))
          (WINDOWADDPROP MENUW (QUOTE CLOSEFN)
			 (QUOTE TEXTMENU.CLOSEFN))
          (WINDOWPROP MENUW (QUOTE TEDITMENU)
		      T)                                     (* Mark this as a TEDIT MENU window)
          (ATTACHWINDOW MENUW MAINWINDOW (QUOTE TOP)
			(QUOTE JUSTIFY)
			(QUOTE LOCALCLOSE))
          (SETQ MENUTEXT MENU)
          (replace MENUFLG of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T)
          (TEDIT MENUTEXT MENUW NIL (QUOTE (TITLEMENUFN DON'T)))
          (AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW (QUOTE PROCESS])

(\TEXTMENU.DOC.CREATE
  [LAMBDA (MENUDESC)                                         (* jds "20-Apr-84 14:08")
                                                             (* Create the TEXTSTREAM for a menu, given a 
							     description. That stream is passed to \TEXTMENU.START to
							     get the menu up on screen)
    (PROG ((CH#1 NIL)
	   MENUW MENUTEXT)
          (SETQ MENUTEXT (OPENTEXTSTREAM "" NIL))
          (bind (CH# ← 1)
		OBJ for DESC in MENUDESC
	     do (SELECTQ (CAR DESC)                          (* (* This is a comment within a menu description -- 
							     Ignore it.))
			 (BUTTON                             (* A menu button -- hitting it calls a function)
				 (TEDIT.INSERT.OBJECT [MBUTTON.CREATE (MKATOM (CADR DESC))
								      (CADDR DESC)
								      (OR (CADDDR DESC)
									  (FONTCREATE (QUOTE 
											HELVETICA)
										      8
										      (QUOTE BOLD]
						      MENUTEXT CH#)
				 (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					      (QUOTE (PROTECTED OFF))
					      CH# 1)
				 (add CH# 1))
			 (3STATE                             (* 3-state button; hitting it changes state among ON, 
							     OFF, and NEUTRAL.)
				 (TEDIT.INSERT.OBJECT [MB.CREATE.THREESTATEBUTTON
							(MKATOM (CADR DESC))
							(OR (CADDDR DESC)
							    (FONTCREATE (QUOTE HELVETICA)
									8
									(QUOTE BOLD]
						      MENUTEXT CH#)
				 (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					      (QUOTE (PROTECTED OFF))
					      CH# 1)
				 (add CH# 1))
			 (NWAY                               (* N-way buttons; choosing one turns the others off.)
			       [SETQ OBJ (MB.CREATE.NWAYBUTTON (CADR DESC)
							       (OR (CADDDR DESC)
								   (FONTCREATE (QUOTE HELVETICA)
									       8
									       (QUOTE BOLD]
			       (TEDIT.INSERT.OBJECT OBJ MENUTEXT CH#)
			       (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					    (QUOTE (PROTECTED OFF))
					    CH# 1)
			       (add CH# 1))
			 (MENU                               (* Real menu, except the selection sticks)
			       (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC))
						    MENUTEXT CH#)
			       (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					    (QUOTE (PROTECTED OFF))
					    CH# 1)
			       (add CH# 1))
			 (MARGINBAR                          (* Margin ruler for TEdit formatting)
				    (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE 0 0 39 NIL 12)
							 MENUTEXT CH#)
				    (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
						 (QUOTE (PROTECTED OFF))
						 CH# 1)
				    (add CH# 1))
			 [TEXT                               (* Arbitrary text, which will be protected from the 
							     user.)
			       (TEDIT.INSERT MENUTEXT (CADR DESC)
					     CH#)
			       [AND (CADDR DESC)
				    (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
						 (LIST (QUOTE FONT)
						       (CADDR DESC))
						 CH#
						 (NCHARS (CADR DESC]
			       (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					    (QUOTE (PROTECTED ON))
					    CH#
					    (NCHARS (CADR DESC)))
			       (add CH# (NCHARS (CADR DESC]
			 (INSERT                             (* An insertion point, with optional text to put there)
				 (TEDIT.INSERT MENUTEXT "  {}" CH#)
				 (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					      (QUOTE (PROTECTED ON))
					      CH# 4)
				 (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
					      (QUOTE (PROTECTED ON SELECTPOINT ON))
					      (IPLUS CH# 2)
					      1)
				 (OR CH#1 (SETQ CH#1 (IPLUS CH# 3)))
				 [COND
				   ((CADR DESC)              (* There is an initial entry to be made.
							     Make it)
				     (TEDIT.INSERT MENUTEXT (CADR DESC)
						   (IPLUS CH# 3))
				     (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
						  (QUOTE (PROTECTED OFF SELECTPOINT OFF))
						  (IPLUS CH# 3)
						  (NCHARS (CADR DESC)))
				     (add CH# (NCHARS (CADR DESC]
				 (add CH# 4))
			 (\ILLEGAL.ARG DESC)))
          (replace MENUFLG of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T)
                                                             (* Remember that this is a menu)
          (replace EDITPROPS of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
	     with (AND CH#1 (LIST (QUOTE SEL)
				  CH#1)))                    (* And where the first selection should be.)
          (RETURN MENUTEXT])

(TEXTMENU.CLOSEFN
  [LAMBDA (W)                                                (* jds " 2-May-84 17:46")
                                                             (* Given the menu window, see if it's time to QUIT out 
							     of this edit process)
    (PROG ((MAINW (WINDOWPROP W (QUOTE MAINWINDOW)))
	   TEXTOBJ)
          (DETACHWINDOW W)                                   (* So detach this window.)
          (COND
	    ((SETQ TEXTOBJ (WINDOWPROP W (QUOTE TEXTOBJ)))   (* Then, if this window still has a textobj under it, 
							     kill off that edit process.)
	      (TEDIT.KILL TEXTOBJ)

          (* This has to be TEDIT.KILL to avoid problems with the TTY being handed from main back to menu, causing main 
	  never to finish off; menu would quit and hand TTY to top level window.)


	      ])
)

(RPAQ TEXTMENUICON (READBITMAP))
(16 24
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@A"
"K@@G"
"HLAI"
"HCFA"
"J@HA"
"KFKI"
"JJJA"
"JBKI"
"JBJA"
"H@KI"
"JDHA"
"KDJI"
"JLJI"
"JDJI"
"JDJI"
"H@KI"
"F@HF"
"AHIH"
"@FN@"
"@@H@")

(RPAQ TEXTMENUICONMASK (READBITMAP))
(16 24
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@A"
"O@@G"
"OLAO"
"OOGO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"GOON"
"AOOH"
"@GN@"
"@@H@")



(* TEdit-specific support)

(DEFINEQ

(\TEDITMENU.CREATE
  [LAMBDA NIL                                                (* jds "18-May-84 10:34")
                                                             (* Creates the TEdit Expanded Menu)
    (\TEXTMENU.DOC.CREATE (LIST (QUOTE (BUTTON "Quit" MB.DEFAULTBUTTON.FN))
				(QUOTE (TEXT "	"))
				(QUOTE (BUTTON "CloseMenu" MB.DEFAULTBUTTON.FN))
				(QUOTE (TEXT "	"))
				(QUOTE (BUTTON "All" MB.DEFAULTBUTTON.FN))
				(QUOTE (TEXT "
"))
				(QUOTE (BUTTON "Get" MB.DEFAULTBUTTON.FN))
				(QUOTE (INSERT))
				(QUOTE (TEXT "	"))
				(QUOTE (BUTTON "Put" MB.DEFAULTBUTTON.FN))
				(QUOTE (INSERT))
				(QUOTE (TEXT "	"))
				(QUOTE (BUTTON "Include" MB.DEFAULTBUTTON.FN))
				(QUOTE (INSERT))
				(QUOTE (TEXT "
"))
				(QUOTE (BUTTON "Find" MB.DEFAULTBUTTON.FN))
				(QUOTE (INSERT))
				(QUOTE (TEXT "	"))
				(QUOTE (BUTTON "Substitute" MB.DEFAULTBUTTON.FN))
				(QUOTE (INSERT))
				(QUOTE (TEXT "  for"))
				(QUOTE (INSERT))
				(QUOTE (TEXT "
"))
				(QUOTE (BUTTON "Hardcopy" MB.DEFAULTBUTTON.FN))
				(QUOTE (TEXT "  server:"))
				(QUOTE (INSERT))
				(QUOTE (TEXT "  copies:"))
				(QUOTE (INSERT))
				(QUOTE (TEXT "

"))
				(LIST (QUOTE TEXT)
				      "Character Looks Menu:		"
				      (FONTCREATE (QUOTE HELVETICA)
						  10
						  (QUOTE BOLD)))
				(QUOTE (BUTTON APPLY \TEDIT.APPLY.CHARLOOKS))
				(QUOTE (TEXT "   "))
				(QUOTE (BUTTON SHOW \TEDIT.SHOW.CHARLOOKS))
				(LIST (QUOTE TEXT)
				      "
Props:  "
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (3STATE Bold))
				(QUOTE (TEXT "  "))
				(QUOTE (3STATE Italic))
				(QUOTE (TEXT "  "))
				(QUOTE (3STATE Underline))
				(QUOTE (TEXT "  "))
				(QUOTE (3STATE StrikeThru))
				(QUOTE (TEXT "  "))
				(QUOTE (3STATE Overbar))
				(QUOTE (TEXT "
"))
				(QUOTE (NWAY (TimesRoman Helvetica Gacha Cream Other)))
				(QUOTE (TEXT "
"))
				(LIST (QUOTE TEXT)
				      "Size: "
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (INSERT))
				(QUOTE (TEXT "   "))
				(QUOTE (NWAY (Normal Superscript Subscript)))
				(LIST (QUOTE TEXT)
				      "  distance: "
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (INSERT))
				(QUOTE (TEXT "
"))
				(LIST (QUOTE TEXT)
				      "
Paragraph Looks Menu:			"
				      (FONTCREATE (QUOTE HELVETICA)
						  10
						  (QUOTE BOLD)))
				(QUOTE (BUTTON APPLY \TEDIT.APPLY.PARALOOKS))
				(QUOTE (TEXT "   "))
				(QUOTE (BUTTON SHOW \TEDIT.SHOW.PARALOOKS))
				(QUOTE (TEXT "
"))
				(QUOTE (NWAY (Left Right Centered Justified)))
				(LIST (QUOTE TEXT)
				      "
Line leading:"
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (INSERT))
				(LIST (QUOTE TEXT)
				      "   Paragraph Leading: "
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (INSERT))
				(LIST (QUOTE TEXT)
				      "
Tab Type:  "
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				[QUOTE (NWAY ((Left \TEDIT.TABTYPE.SET)
					      (Right \TEDIT.TABTYPE.SET)
					      (Centered \TEDIT.TABTYPE.SET)
					      (Decimal \TEDIT.TABTYPE.SET]
				(LIST (QUOTE TEXT)
				      "	Default Tab Size:"
				      (FONTCREATE (QUOTE HELVETICA)
						  8
						  (QUOTE ITALIC)))
				(QUOTE (INSERT))
				(QUOTE (TEXT "
"))
				(QUOTE (MARGINBAR))
				(QUOTE (TEXT "
"])

(\TEDIT.EXPANDED.MENU
  [LAMBDA (STREAM)                                           (* jds "31-Jan-84 14:23")
    (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.MENU T)
		     (\TEDIT.MAINW (TEXTOBJ STREAM])

(MB.DEFAULTBUTTON.FN
  [LAMBDA (OBJ SEL W)                                        (* jds "21-May-84 16:52")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				 (QUOTE TEXTOBJ)))
	   OFILE CH MAINSEL PROC)
          (SETQ MAINSEL (fetch SEL of MAINTEXT))
          (COND
	    ((EQ (fetch EDITOPACTIVE of MAINTEXT)
		 T)
	      (TEDIT.PROMPTPRINT MAINTEXT "Edit operation in progress; please wait." T)
	      (RETURN))
	    ((fetch EDITOPACTIVE of MAINTEXT)
	      (TEDIT.PROMPTPRINT MAINTEXT (CONCAT (fetch EDITOPACTIVE of MAINTEXT)
						  " operation in progress; please wait.")
				 T)
	      [AND (NEQ (fetch EDITOPACTIVE of MAINTEXT)
			(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
	      (RETURN)))
          [COND
	    ((AND (SETQ PROC (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
					 (QUOTE PROCESS)))
		  (PROCESSP PROC))                           (* THE MAIN window has a live process behind it;
							     go evaluate the button fn there.)
	      (PROCESS.EVAL PROC (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
				       OBJ SEL W TEXTOBJ MAINTEXT MAINSEL)))
	    ((AND (SETQ PROC (WINDOWPROP W (QUOTE PROCESS)))
		  (PROCESSP PROC))                           (* This window has a live process behind it;
							     go evaluate the button fn there.)
	      (PROCESS.EVAL PROC (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
				       OBJ SEL W TEXTOBJ MAINTEXT MAINSEL)))
	    (T (ADD.PROCESS (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
				  OBJ SEL W TEXTOBJ MAINTEXT MAINSEL]
          (COND
	    ((fetch EDITFINISHEDFLG of TEXTOBJ)
	      (GIVE.TTY.PROCESS W)
	      (DISMISS 20)))
          [COND
	    ((OR (fetch EDITFINISHEDFLG of TEXTOBJ)
		 (EQ (WINDOWPROP W (QUOTE PROCESS))
		     (TTY.PROCESS)))                         (* If the TEDIT MENU still has the tty, give it back to 
							     the real TEdit.)
	      (SETQ TEDIT.SELPENDING NIL)
	      (GIVE.TTY.PROCESS (WINDOWPROP W (QUOTE MAINWINDOW]
                                                             (* Tell the menu button handler not to turn off this 
							     button--it's still active and will turn itself off.)
          (RETURN (QUOTE DON'T])

(\TEDIT.APPLY.BOLDNESS
  [LAMBDA (BUTTON NEWLOOKS)                                  (* jds " 7-Feb-84 16:00")
    (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE THREESTATE))
	     (ON (CONS (QUOTE WEIGHT)
		       (CONS (QUOTE BOLD)
			     NEWLOOKS)))
	     (OFF (CONS (QUOTE WEIGHT)
			(CONS (QUOTE MEDIUM)
			      NEWLOOKS)))
	     NEWLOOKS])

(\TEDIT.APPLY.CHARLOOKS
  [LAMBDA (OBJ SEL W)                                        (* jds "17-May-84 14:06")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				 (QUOTE TEXTOBJ)))
	   (CH# (ADD1 (fetch CH# of SEL)))
	   SCRATCHSEL OFILE CH NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT OFFSET)
          (SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
          [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
                                                             (* Skip over the SHOW button)
          [for BUTTON in (QUOTE (BOLD ITALIC UNDERLINE STRIKEOUT OVERSCORE))
	     do                                              (* Set the character properties which are independent)
		(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
		(SELECTQ BUTTON
			 (BOLD (SETQ NEWLOOKS (\TEDIT.APPLY.BOLDNESS (CAR NEXTB)
								     NEWLOOKS)))
			 (ITALIC (SETQ NEWLOOKS (\TEDIT.APPLY.SLOPE (CAR NEXTB)
								    NEWLOOKS)))
			 (UNDERLINE (SETQ NEWLOOKS (\TEDIT.APPLY.ULINE (CAR NEXTB)
								       NEWLOOKS)))
			 (STRIKEOUT (SETQ NEWLOOKS (\TEDIT.APPLY.STRIKEOUT (CAR NEXTB)
									   NEWLOOKS)))
			 (OVERSCORE (SETQ NEWLOOKS (\TEDIT.APPLY.OLINE (CAR NEXTB)
								       NEWLOOKS)))
			 NIL)
		(SETQ CH# (ADD1 (CDR NEXTB]
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
                                                             (* Get to the start of the text.)
          (SETQ BUTTON (CAR NEXTB))
          [AND BUTTON (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
			       [Other                        (* Have to get and add in a new font.)
				      (AND (SETQ TEXT (MKATOM (TEDIT.GETINPUT TEXTOBJ 
									"Name of the new font:  "
									      NIL)))
					   (SETQ NEWLOOKS (CONS (QUOTE FAMILY)
								(CONS (U-CASE TEXT)
								      NEWLOOKS]
			       (SETQ NEWLOOKS (CONS (QUOTE FAMILY)
						    (CONS (U-CASE (IMAGEOBJPROP BUTTON (QUOTE STATE)))
							  NEWLOOKS]
                                                             (* Now find which text button was "on")
          (SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))
                                                             (* Read the contents of the SIZE menu field)
          [COND
	    (SIZE                                            (* He specified one. Set it.)
		  (SETQ NEWLOOKS (CONS (QUOTE SIZE)
				       (CONS SIZE NEWLOOKS]
          [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
                                                             (* Get a handle on the SUPERSCRIPT/SUBSCRIPT button)
          (SETQ BUTTON (CAR NEXTB))
          (SETQ SUPER (IMAGEOBJPROP BUTTON (QUOTE STATE)))   (* Decide which kind it is)
          [SETQ OFFSET (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (CDR NEXTB]
                                                             (* And get the offset distance, in points.)
          (SELECTQ SUPER
		   [Superscript                              (* He called for SUPERSCRIPTing.
							     Offset the characters by either the distance he gave, or
							     2 pts.)
				(SETQ NEWLOOKS (CONS (QUOTE SUPERSCRIPT)
						     (CONS (OR OFFSET 2)
							   NEWLOOKS]
		   [Subscript                                (* He called for SUBSCRIPTING.
							     Offset the characters by either the distance he gave, or
							     2 pts if he gave no distance.)
			      (SETQ NEWLOOKS (CONS (QUOTE SUBSCRIPT)
						   (CONS (OR OFFSET 2)
							 NEWLOOKS]
		   [Normal                                   (* NORMAL => Turn off all super and subscripting)
			   (SETQ NEWLOOKS (CONS (QUOTE SUPERSCRIPT)
						(CONS 0 NEWLOOKS]
		   NIL)
          (TEDIT.LOOKS MAINTEXT NEWLOOKS (fetch CH# of (fetch SEL of MAINTEXT))
		       (fetch DCH of (fetch SEL of MAINTEXT)))
          (\SHOWSEL SEL NIL NIL)
          (TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				   (QUOTE PROCESS])

(\TEDIT.APPLY.OLINE
  [LAMBDA (BUTTON NEWLOOKS)                                  (* jds " 7-Feb-84 16:00")
    (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE THREESTATE))
	     (ON (CONS (QUOTE OVERLINE)
		       (CONS (QUOTE ON)
			     NEWLOOKS)))
	     (OFF (CONS (QUOTE OVERLINE)
			(CONS (QUOTE OFF)
			      NEWLOOKS)))
	     NEWLOOKS])

(\TEDIT.APPLY.PARALOOKS
  [LAMBDA (OBJ SEL W)                                        (* jds "17-May-84 16:49")
                                                             (* Handler for the Paragraph Menu's APPLY button.
							     Collects the specs from the paragraph menu and calls 
							     TEDIT.PARALOOKS to effect the change.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				 (QUOTE TEXTOBJ)))
	   (CH# (ADD1 (fetch CH# of SEL)))
	   SCRATCHSEL QUAD OFILE CH NEWLOOKS SIZE SUPER SUB LINELEAD PARALEAD DEFAULTTAB BUTTON NEXTB 
	   BUTTONDATA L1 LN R)
          [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
                                                             (* Skip the SHOW button)
          (SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
          (SETQ NEWLOOKS NIL)                                (* The list we'll be collecting the looks changes in.)
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
                                                             (* Get to the start of the text.)
          (SETQ BUTTON (CAR NEXTB))
          [COND
	    ((SETQ QUAD (IMAGEOBJPROP BUTTON (QUOTE STATE)))
                                                             (* A justification was specified)
	      (SETQ NEWLOOKS (CONS (QUOTE QUAD)
				   (CONS (U-CASE (MKATOM QUAD))
					 NEWLOOKS]           (* Now find which text button was "on")
          [COND
	    ((SETQ LINELEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))
	      (SETQ NEWLOOKS (CONS (QUOTE LINELEADING)
				   (CONS LINELEAD NEWLOOKS]
          [COND
	    ([SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
	      (SETQ NEWLOOKS (CONS (QUOTE PARALEADING)
				   (CONS PARALEAD NEWLOOKS]
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
          (SETQ BUTTON (CAR NEXTB))
          (SETQ DEFAULTTAB (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (CDR NEXTB)))
          (while (NOT (type? MARGINBAR BUTTON))
	     do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
		(SETQ BUTTON (CAR NEXTB)))
          (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON (QUOTE OBJECTDATUM)))
          [COND
	    ((IGEQ [SETQ L1 (FIXR (TIMES (fetch MARL1 of BUTTONDATA)
					 (fetch MARUNIT of BUTTONDATA]
		   0)                                        (* The 1stleftmargin is set, and non-neutral.)
	      (SETQ NEWLOOKS (CONS (QUOTE 1STLEFTMARGIN)
				   (CONS L1 NEWLOOKS]
          [COND
	    ((IGEQ [SETQ LN (FIXR (TIMES (fetch MARLN of BUTTONDATA)
					 (fetch MARUNIT of BUTTONDATA]
		   0)                                        (* The LEFTMARGIN is set, and non-neutral.)
	      (SETQ NEWLOOKS (CONS (QUOTE LEFTMARGIN)
				   (CONS LN NEWLOOKS]
          [COND
	    ((IGEQ [SETQ R (FIXR (TIMES (fetch MARR of BUTTONDATA)
					(fetch MARUNIT of BUTTONDATA]
		   0)                                        (* The RIGHTMARGIN is set, and non-neutral.)
	      (SETQ NEWLOOKS (CONS (QUOTE RIGHTMARGIN)
				   (CONS R NEWLOOKS]
          (SETQ NEWLOOKS
	    (CONS (QUOTE TABS)
		  (CONS [CONS DEFAULTTAB (SORT (for TAB in (fetch MARTABS of BUTTONDATA)
						  collect (CONS (FIXR (TIMES (CAR TAB)
									     (fetch MARUNIT
										of BUTTONDATA)))
								(CDR TAB)))
					       (FUNCTION (LAMBDA (A B)
						   (ILEQ (CAR A)
							 (CAR B]
			NEWLOOKS)))
          (TEDIT.PARALOOKS MAINTEXT NEWLOOKS (fetch CH# of (fetch SEL of MAINTEXT))
			   (fetch DCH of (fetch SEL of MAINTEXT)))
          (\SHOWSEL SEL NIL NIL)
          (TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				   (QUOTE PROCESS])

(\TEDIT.SHOW.CHARLOOKS
  [LAMBDA (OBJ SEL W)                                        (* jds "17-May-84 14:07")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				 (QUOTE TEXTOBJ)))
	   (CH# (ADD1 (fetch CH# of SEL)))
	   PC SCRATCHSEL OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET)
          (\SHOWSEL SEL NIL NIL)
          (replace SET of SEL with NIL)
          (SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
          (SETQ PC (\CHTOPC (fetch CH# of (fetch SEL of MAINTEXT))
			    (fetch PCTB of MAINTEXT)))       (* The PIECE containing the text to describe)
          (SETQ NEWLOOKS (fetch PLOOKS of PC))
          [for PROP in (LIST (fetch CLBOLD of NEWLOOKS)
			     (fetch CLITAL of NEWLOOKS)
			     (fetch CLULINE of NEWLOOKS)
			     (fetch CLSTRIKE of NEWLOOKS)
			     (fetch CLOLINE of NEWLOOKS))
	     do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
		[COND
		  (PROP                                      (* Must set the property)
			(IMAGEOBJPROP (CAR NEXTB)
				      (QUOTE THREESTATE)
				      (QUOTE ON)))
		  (T                                         (* Must reset it.)
		     (IMAGEOBJPROP (CAR NEXTB)
				   (QUOTE THREESTATE)
				   (QUOTE OFF]
		(SETQ CH# (ADD1 (CDR NEXTB]
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
                                                             (* Get to the start of the text.)
          (SETQ BUTTON (CAR NEXTB))
          [for ITEM in (IMAGEOBJPROP BUTTON (QUOTE BUTTONS))
	     do                                              (* Loop thru the font FAMILY name button list, looking 
							     for one that matches this text's looks)
		(COND
		  ((EQ (FONTPROP (fetch CLFONT of NEWLOOKS)
				 (QUOTE FAMILY))
		       (U-CASE ITEM))
		    (IMAGEOBJPROP BUTTON (QUOTE STATE)
				  ITEM)
		    (RETURN]                                 (* Now find which text button was "on")
          (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
				  (fetch CLSIZE of NEWLOOKS))
                                                             (* Set the value in the SIZE field)
          [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
                                                             (* Move forward to the SUPERSCRIPT/SUBSCRIPT button)
          (SETQ BUTTON (CAR NEXTB))
          (SETQ OFFSET (fetch CLOFFSET of NEWLOOKS))         (* Remember the offset value for later)
          [COND
	    ((OR (NOT (fetch CLOFFSET of NEWLOOKS))
		 (ZEROP (fetch CLOFFSET of NEWLOOKS)))       (* There is no subscript or superscript.
							     Mark the text NORMAL.)
	      (IMAGEOBJPROP BUTTON (QUOTE STATE)
			    (QUOTE Normal))
	      (SETQ OFFSET NIL)                              (* Mark there as being no offset value)
	      )
	    ((ILESSP OFFSET 0)                               (* SUBSCRIPTING)
	      (IMAGEOBJPROP BUTTON (QUOTE STATE)
			    (QUOTE Subscript)))
	    ((IGREATERP OFFSET 0)                            (* SUBSCRIPTING)
	      (IMAGEOBJPROP BUTTON (QUOTE STATE)
			    (QUOTE Superscript]
          (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
				  (AND OFFSET (IABS OFFSET)))
                                                             (* Now move up to the offset distance fill-in field.)
          (\SHOWSEL SCRATCHSEL NIL NIL)
          (replace SET of SCRATCHSEL with NIL)
          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (fetch TEXTLEN of TEXTOBJ))
          (TEDIT.UPDATE.SCREEN TEXTOBJ])

(\TEDIT.SHOW.PARALOOKS
  [LAMBDA (OBJ SEL W)                                        (* jds "17-May-84 15:43")
                                                             (* MBFN for TEdit default menu item buttons.)
    (PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
	   (MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
				 (QUOTE TEXTOBJ)))
	   (CH# (ADD1 (fetch CH# of SEL)))
	   SCRATCHSEL FMTSPEC BUTTON NEXTB ARB BUTTONDATA)
          (\SHOWSEL SEL NIL NIL)
          (replace SET of SEL with NIL)
          (SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
          [SETQ FMTSPEC (fetch PPARALOOKS of (\CHTOPC [IMAX 1 (IMIN (fetch TEXTLEN of MAINTEXT)
								    (fetch CH#
								       of (fetch SEL of MAINTEXT]
						      (fetch PCTB of MAINTEXT]
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
                                                             (* Get to the start of the text.)
          (SETQ BUTTON (CAR NEXTB))
          [for ITEM in (IMAGEOBJPROP BUTTON (QUOTE BUTTONS))
	     do (COND
		  ([EQ (fetch QUAD of FMTSPEC)
		       (U-CASE (COND
				 ((LISTP ITEM)
				   (CAR ITEM))
				 (T ITEM]                    (* Turn this button on.)
		    (IMAGEOBJPROP BUTTON (QUOTE STATE)
				  ITEM)
		    (RETURN]                                 (* Now find which text button was "on")
          (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
				  (fetch LINELEAD of FMTSPEC))
                                                             (* Update the LINE LEADING field)
          (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
				  (fetch LEADBEFORE of FMTSPEC))
                                                             (* Update the PARA LEADING field)
          (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
				  (CAR (fetch TABSPEC of FMTSPEC)))
                                                             (* Update the DEFAULT TAB SPACING field)
          (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
          (SETQ BUTTON (CAR NEXTB))
          (while (NOT (type? MARGINBAR BUTTON))
	     do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
		(SETQ BUTTON (CAR NEXTB)))
          (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON (QUOTE OBJECTDATUM)))
                                                             (* (IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL))
                                                             (* Tell it to reformat itself.)
          (replace MARL1 of BUTTONDATA with (FQUOTIENT (fetch 1STLEFTMAR of FMTSPEC)
						       (fetch MARUNIT of BUTTONDATA)))
          (replace MARLN of BUTTONDATA with (FQUOTIENT (fetch LEFTMAR of FMTSPEC)
						       (fetch MARUNIT of BUTTONDATA)))
          (replace MARR of BUTTONDATA with (FQUOTIENT (fetch RIGHTMAR of FMTSPEC)
						      (fetch MARUNIT of BUTTONDATA)))
          [replace MARTABS of BUTTONDATA with (for TAB in (CDR (fetch TABSPEC of FMTSPEC))
						 collect (CONS (FQUOTIENT (CAR TAB)
									  (fetch MARUNIT
									     of BUTTONDATA))
							       (CDR TAB]
          (\SHOWSEL SCRATCHSEL NIL NIL)
          (replace SET of SCRATCHSEL with NIL)
          (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (fetch TEXTLEN of TEXTOBJ))
          (TEDIT.UPDATE.SCREEN TEXTOBJ])

(\TEDIT.APPLY.SLOPE
  [LAMBDA (BUTTON NEWLOOKS)                                  (* jds " 7-Feb-84 16:00")
    (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE THREESTATE))
	     (ON (CONS (QUOTE SLOPE)
		       (CONS (QUOTE ITALIC)
			     NEWLOOKS)))
	     (OFF (CONS (QUOTE SLOPE)
			(CONS (QUOTE REGULAR)
			      NEWLOOKS)))
	     NEWLOOKS])

(\TEDIT.APPLY.STRIKEOUT
  [LAMBDA (BUTTON NEWLOOKS)                                  (* jds " 7-Feb-84 16:00")
    (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE THREESTATE))
	     (ON (CONS (QUOTE STRIKEOUT)
		       (CONS (QUOTE ON)
			     NEWLOOKS)))
	     (OFF (CONS (QUOTE STRIKEOUT)
			(CONS (QUOTE OFF)
			      NEWLOOKS)))
	     NEWLOOKS])

(\TEDIT.APPLY.ULINE
  [LAMBDA (BUTTON NEWLOOKS)                                  (* jds " 7-Feb-84 16:00")
    (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE THREESTATE))
	     (ON (CONS (QUOTE UNDERLINE)
		       (CONS (QUOTE ON)
			     NEWLOOKS)))
	     (OFF (CONS (QUOTE UNDERLINE)
			(CONS (QUOTE OFF)
			      NEWLOOKS)))
	     NEWLOOKS])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS TEDIT.EXPANDED.MENU)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (LIST "Expanded Menu" (QUOTE (QUOTE \TEDIT.EXPANDED.MENU]
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(SETQ TEDIT.EXPANDED.MENU (\TEDITMENU.CREATE))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (3947 23999 (MB.BUTTONEVENTINFN 3957 . 4874) (MB.DISPLAY 4876 . 5793) (MB.SELFN 5795 . 
6842) (MB.SIZEFN 6844 . 7433) (MB.WHENOPERATEDFN 7435 . 7753) (MB.COPYFN 7755 . 8192) (MB.GETFN 8194
 . 8801) (MB.PUTFN 8803 . 9410) (MB.SHOWSELFN 9412 . 10152) (MBUTTON.CREATE 10154 . 11129) (
MBUTTON.FIND.NEXT.BUTTON 11131 . 12260) (MBUTTON.FIND.NEXT.FIELD 12262 . 14776) (MBUTTON.INIT 14778 . 
15250) (MBUTTON.NEXT.FIELD.AS.NUMBER 15252 . 15549) (MB.DEFAULTBUTTON.ACTIONFN 15551 . 21334) (
MBUTTON.NEXT.FIELD.AS.TEXT 21336 . 21610) (MBUTTON.SET.NEXT.FIELD 21612 . 22722) (
\TEDITMENU.SELSCREENER 22724 . 23997)) (24221 32056 (MB.CREATE.THREESTATEBUTTON 24231 . 25309) (
MB.THREESTATE.DISPLAY 25311 . 27562) (MB.THREESTATE.SHOWSELFN 27564 . 29819) (
MB.THREESTATE.WHENOPERATEDFN 29821 . 30830) (MB.THREESTATEBUTTON.FN 30832 . 31515) (THREESTATE.INIT 
31517 . 32054)) (32356 44042 (MB.CREATE.NWAYBUTTON 32366 . 34708) (MB.NB.DISPLAYFN 34710 . 36693) (
MB.NB.WHENOPERATEDFN 36695 . 37511) (MB.NB.SIZEFN 37513 . 40408) (MB.NWAYBUTTON.SELFN 40410 . 41967) (
MB.NWAYMENU.NEWBUTTON 41969 . 42610) (NWAYBUTTON.INIT 42612 . 43121) (MB.NB.PACKITEMS 43123 . 44040)) 
(44416 48149 (MENUOBJ.INIT 44426 . 44912) (MB.CREATE.FULLMENU 44914 . 45284) (MB.FULLMENU.DISPLAYFN 
45286 . 45984) (MB.FULLMENU.SELFINALFN 45986 . 46209) (MB.FULLMENU.SELFN 46211 . 47141) (
MB.FULLMENU.SHOWSELFN 47143 . 47270) (MB.FULLMENU.SIZEFN 47272 . 47606) (MB.BLTMENUIMAGE 47608 . 48147
)) (48668 69041 (DRAWMARGINSCALE 48678 . 50917) (MARGINBAR 50919 . 55488) (MARGINBAR.CREATE 55490 . 
56903) (MB.MARGINBAR.SELFN 56905 . 62707) (MB.MARGINBAR.SIZEFN 62709 . 62996) (MB.MARGINBAR.DISPLAYFN 
62998 . 64903) (MDESCALE 64905 . 65318) (MSCALE 65320 . 65584) (MB.MARGINBAR.SHOWTAB 65586 . 66697) (
MB.MARGINBAR.TABTRACK 66699 . 67580) (\TEDIT.TABTYPE.SET 67582 . 68503) (MARGINBAR.INIT 68505 . 69039)
) (69891 77219 (\TEXTMENU.START 69901 . 71734) (\TEXTMENU.DOC.CREATE 71736 . 76367) (TEXTMENU.CLOSEFN 
76369 . 77217)) (77679 101131 (\TEDITMENU.CREATE 77689 . 81093) (\TEDIT.EXPANDED.MENU 81095 . 81314) (
MB.DEFAULTBUTTON.FN 81316 . 83704) (\TEDIT.APPLY.BOLDNESS 83706 . 84050) (\TEDIT.APPLY.CHARLOOKS 84052
 . 88297) (\TEDIT.APPLY.OLINE 88299 . 88639) (\TEDIT.APPLY.PARALOOKS 88641 . 92548) (
\TEDIT.SHOW.CHARLOOKS 92550 . 96446) (\TEDIT.SHOW.PARALOOKS 96448 . 100093) (\TEDIT.APPLY.SLOPE 100095
 . 100437) (\TEDIT.APPLY.STRIKEOUT 100439 . 100785) (\TEDIT.APPLY.ULINE 100787 . 101129)))))
STOP