(FILECREATED "25-Sep-86 23:29:17" {ERIS}<TEDIT>TEDITMENU.;25 220757
changes to: (VARS TEDITMENUCOMS)
previous date: "24-Sep-86 18:12:15" {ERIS}<TEDIT>TEDITMENU.;24)
(* "
Copyright (c) 1983, 1984, 1985, 1986 by John Sybalsky & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TEDITMENUCOMS)
(RPAQQ TEDITMENUCOMS
[(FILES ICONW)
(FILES TEDITDECLS)
[COMS (* Simple Menu Button support)
(FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN
MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME
MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT
MBUTTON.NEXT.FIELD.AS.NUMBER MBUTTON.NEXT.FIELD.AS.TEXT MBUTTON.NEXT.FIELD.AS.ATOM
MBUTTON.SET.FIELD MBUTTON.SET.NEXT.FIELD MBUTTON.SET.NEXT.BUTTON.STATE
TEDITMENU.STREAM \TEDITMENU.SELSCREENER)
(GLOBALVARS MBUTTONIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT))
(ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN]
[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)
(FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN
MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS
MB.NWAYBUTTON.ADDITEM)
(GLOBALVARS NWAYBUTTONIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT))
(ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN]
[COMS (* Two-state, toggling menu buttons.)
(FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN
\TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT
\TEXTMENU.SET.TOGGLE)
(GLOBALVARS \TOGGLEIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT))
(ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN]
[COMS (* Margin Setting and display)
(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.DOTTED.LEFTTAB \TEDIT.DOTTED.CENTERTAB \TEDIT.DOTTED.RIGHTTAB
\TEDIT.DOTTED.DECIMALTAB TEDIT.EXTENDEDRIGHTMARK)
(GLOBALVARS MARGINBARIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT))
(ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN]
(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
\TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN)
(FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS
\TEDIT.APPLY.CHARLOOKS \TEDIT.APPLY.OLINE \TEDIT.SHOW.CHARLOOKS
\TEDIT.NEUTRALIZE.CHARLOOKS \TEDIT.FILL.IN.CHARLOOKS.MENU
\TEDIT.NEUTRALIZE.CHARLOOKS.MENU \TEDIT.PARSE.CHARLOOKS.MENU \TEDIT.APPLY.SLOPE
\TEDIT.APPLY.STRIKEOUT \TEDIT.APPLY.ULINE)
(FNS \TEDITPARAMENU.CREATE \TEDIT.EXPANDEDPARA.MENU \TEDIT.APPLY.PARALOOKS
\TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS)
(FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING
TEDIT.UNPARSE.PAGEFORMAT)
(COMS (* Initialization Code)
(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU
TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC
TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU)
(FNS \TEDIT.MENU.INIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\TEDIT.MENU.INIT)
(\TEDITMENU.CREATE)
(\TEDIT.CHARLOOKSMENU.CREATE)
(\TEDITPARAMENU.CREATE)
(\TEDITPAGEMENU.CREATE]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(FILESLOAD ICONW)
(FILESLOAD TEDITDECLS)
(* Simple Menu Button support)
(DEFINEQ
(MB.BUTTONEVENTINFN
[LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM) (* jds "19-Jul-84 16:36")
(* 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
((IMAGEOBJPROP OBJ (QUOTE MENUBUTTON.SELECTED))
(* This button is still active from an earlier hit.
Don't let it be selected again.)
(RETURN (QUOTE DON'T)))
((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 "11-Jun-86 12:30")
(* Display the innards of a menu
button)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (* Going to the display.
Use the cached bitmap version of the
button)
[PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
(X (DSPXPOSITION NIL STREAM))
(Y (DSPYPOSITION NIL STREAM)))
[SETQ BITMAP (COND
((IMAGEOBJPROP OBJ (QUOTE BITCACHE)))
(T (MB.SETIMAGE OBJ)
(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])
(PROG (BITMAP DS (FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
(TEXT (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
OLOOKS) (* Going to some output image stream.
Use the actual text.)
(SETQ OLOOKS (DSPFONT (FONTCOPY FONT (QUOTE DEVICE)
STREAM)
STREAM)) (* Change to the font for this menu
button.)
(PRIN1 TEXT STREAM) (* Print the button text)
(DSPFONT OLOOKS STREAM) (* And put the font back as it was.)
])
(MB.SETIMAGE
[LAMBDA (OBJ) (* jds "23-Aug-84 13:22")
(PROG ((MBFONT (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
(MBTEXT (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
BOX BITMAP DS)
(SETQ BOX (create IMAGEBOX
XSIZE ←(STRINGWIDTH MBTEXT MBFONT)
YSIZE ←(FONTPROP MBFONT (QUOTE HEIGHT))
YDESC ←(FONTPROP MBFONT (QUOTE DESCENT))
XKERN ← 0))
(SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX)
(fetch YSIZE of BOX)))
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
BITMAP)
(IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
BOX)
(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])
(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 STREAM CURX RIGHTMARGIN) (* jds "30-Aug-84 11:24")
(* Tell the size of a menu button)
(PROG ((FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
BOX)
[COND
((DISPLAYSTREAMP STREAM) (* We're formatting for the DISPLAY)
)
[(EQ (QUOTE INTERPRESS)
(IMAGESTREAMTYPE STREAM))
(SETQ FONT (FONTCOPY FONT (QUOTE DEVICE)
(QUOTE INTERPRESS]
((EQ (QUOTE PRESS)
(IMAGESTREAMTYPE STREAM))
(SETQ FONT (FONTCOPY FONT (QUOTE DEVICE)
(QUOTE PRESS]
(SETQ BOX (create IMAGEBOX
XSIZE ←(STRINGWIDTH (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
FONT)
YSIZE ←(FONTPROP FONT (QUOTE HEIGHT))
YDESC ←(FONTPROP FONT (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 "23-Aug-84 13:22")
(* Create a MENU BUTTON image object, and fill in its
image and function-hook fields)
(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) (* The function to be called when the button is pushed)
(IMAGEOBJPROP OBJ (QUOTE MBTEXT)
MBTEXT) (* The text displayed in the button)
(IMAGEOBJPROP OBJ (QUOTE MBFONT)
MBFONT) (* The font that text appears in)
(MB.SETIMAGE OBJ) (* Set up the image for the button, so we don't create
it repeatedly.)
(RETURN OBJ])
(MBUTTON.CHANGENAME
[LAMBDA (TEXTOBJ OBJ NEWNAME) (* jds "23-Aug-84 13:26")
(* Change the text that appears in a button, and
redisplay the button if it's visible)
(PROG (BOX BITMAP DS)
(IMAGEOBJPROP OBJ (QUOTE MBTEXT)
NEWNAME)
(MB.SETIMAGE OBJ)
(TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
(MBUTTON.FIND.BUTTON
[LAMBDA (LABEL TEXTSTREAM CH#) (* gbn "27-Sep-84 02:13")
(* "27-Sep-84 00:52" gbn)
(* * returns the piece no containing the imageobj with MBTEXT prop LABEL)
(PROG [(LABELATOM (MKATOM LABEL))
OBJ STARTPCNO (PCTB (fetch PCTB of (TEXTOBJ TEXTSTREAM]
(SETQ STARTPCNO (COND
(CH# (\CHTOPCNO CH# PCTB))
(T \FirstPieceOffset)))
(RETURN (for PCNO PC from STARTPCNO to (\EDITELT PCTB \PCTBLastPieceOffset) by
\EltsPerPiece
do [SETQ OBJ (fetch POBJ of (SETQ PC (\EDITELT PCTB (ADD1 PCNO]
(COND
([AND OBJ (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
(RETURN PCNO])
(MBUTTON.FIND.NEXT.BUTTON
[LAMBDA (TEXTOBJ CH#) (* jds "28-Aug-84 09:16")
(* 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? 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# DON'TFIX) (* jds " 5-Aug-85 17:44")
(* 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, 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 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)))
(COND
((NOT DON'TFIX)
(\FIXSEL SCRATCHSEL TEXTOBJ)))
(RETURN SCRATCHSEL])
(MBUTTON.INIT
[LAMBDA NIL (* jds "12-Feb-85 14:32")
(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)
(QUOTE TEditMenuButton])
(MBUTTON.NEXT.FIELD.AS.NUMBER
[LAMBDA (TEXTOBJ CH#) (* jds " 5-Aug-85 17:44")
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T)
(NUMBERP (MKATOM (TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ])
(MBUTTON.NEXT.FIELD.AS.TEXT
[LAMBDA (TEXTOBJ CH#) (* jds " 5-Aug-85 17:45")
(* * Find the next fill-in field in the menu after CH#, and return its contents as a string.)
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T)
(TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ])
(MBUTTON.NEXT.FIELD.AS.ATOM
[LAMBDA (TEXTOBJ CH#) (* jds " 5-Aug-85 17:44")
(* Find the next fill-in field, and return its contents
as an atom. If the field is empty, return NIL.)
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (* Move to the next fill-in blank.)
(PROG [(STR (TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ]
(COND
((ZEROP (NCHARS STR)) (* The field is empty.)
(RETURN NIL))
(T (* It's non-empty. Convert the string to an atom.)
(RETURN (MKATOM STR])
(MBUTTON.SET.FIELD
[LAMBDA (TEXTSTREAM FIELD VALUE) (* gbn "27-Sep-84 02:03")
(* Makes the contents of the field with name FIELD be
VALUE.)
(PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
PCTB OBJ SAVED.SEL FIELD.SEL PCNO)
(SETQ PCTB (fetch PCTB of TEXTOBJ))
(SETQ PCNO (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM))
(COND
(PCNO (SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (\EDITELT PCTB PCNO)))
(* select the field following this button.)
(COND
(FIELD.SEL (* there are contents to set for this button)
(\FIXSEL FIELD.SEL TEXTOBJ)
(TEDIT.SETSEL TEXTSTREAM (fetch CH# of FIELD.SEL)
(fetch DCH of FIELD.SEL)
(fetch POINT of FIELD.SEL)
T)
(TEDIT.INSERT TEXTSTREAM (MKSTRING VALUE])
(MBUTTON.SET.NEXT.FIELD
[LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* jds "21-May-85 14:04")
(* 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.)
])
(MBUTTON.SET.NEXT.BUTTON.STATE
[LAMBDA (TEXTOBJ STARTINGCH NEWSTATE) (* jds "31-Jul-85 22:09")
(* * Find the next menu button in the document, and set its state to NEWSTATE. Return 1 + the CH# of the button, for
further searchers)
(PROG* ((NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ STARTINGCH))
(BUTTON (CAR NEXTB)))
(IMAGEOBJPROP BUTTON (QUOTE STATE)
NEWSTATE)
(RETURN (ADD1 (CDR NEXTB])
(TEDITMENU.STREAM
[LAMBDA (TEXTSTREAM) (* jds "13-Aug-84 14:10")
(* returns the textstream of the teditmenu attached to
this stream if any)
(PROG (MENUW (MAINWINDOW (\TEDIT.MAINW TEXTSTREAM)))
[SETQ MENUW (for W in (ATTACHEDWINDOWS MAINWINDOW)
thereis (AND (WINDOWPROP W (QUOTE TEDITMENU))
(EQUAL (WINDOWPROP W (QUOTE TITLE))
"TEdit Menu"]
(RETURN (COND
(MENUW (TEXTSTREAM MENUW])
(\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
(GLOBALVARS MBUTTONIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MBUTTON.INIT)
(ADDTOVAR IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN))
)
(* Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD)
(DEFINEQ
(MB.CREATE.THREESTATEBUTTON
[LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* jds "24-Sep-86 00:49")
(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 STATECHANGEFN)
STATECHANGEFN)
(IMAGEOBJPROP OBJ (QUOTE STATE)
(OR INITSTATE (QUOTE NEUTRAL)))
(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 "30-Aug-84 13:53")
(* 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 STATE))
(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 "30-Aug-84 13:54")
(PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
(IMAGEBOX OBJ DS]
(COND
(ON (SELECTQ (IMAGEOBJPROP OBJ (QUOTE STATE))
(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 STATE))
(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) (* gbn "25-Sep-84 00:47")
(* MBFN for TEdit default menu item buttons.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(STATECHANGEFN (IMAGEOBJPROP OBJ (QUOTE STATECHANGEFN)))
OFILE CH NEWSTATE)
(SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ (QUOTE STATE))
(OFF (QUOTE ON))
(ON (QUOTE NEUTRAL))
(NEUTRAL (QUOTE OFF))
(QUOTE ON)))
(if STATECHANGEFN
then (* apply the user supplied state change fn if she
supplied one)
(APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ)))
(IMAGEOBJPROP OBJ (QUOTE STATE)
NEWSTATE)
(replace ONFLG of SEL with NIL])
(THREESTATE.INIT
[LAMBDA NIL (* jds
" 9-Feb-86 15:17")
(* Initialize the
IMAGEFNS for 3-state
menu button IMAGEOBJs)
(SETQ THREESTATEIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.THREESTATE.DISPLAY)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
(FUNCTION MB.GETFN)
(FUNCTION MB.COPYFN)
(FUNCTION MB.BUTTONEVENTINFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(FUNCTION MB.THREESTATE.WHENOPERATEDFN)
(QUOTE NILL)
(QUOTE 3StateMenuButton])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(THREESTATE.INIT)
)
(* One-of-N Menu button sets)
(DEFINEQ
(MB.CREATE.NWAYBUTTON
[LAMBDA (BUTTONS FONT CHANGESTATEFN INITSTATE MAXITEMS/LINE)
(* gbn "24-Sep-84 15:31")
(PROG ((OBJECT (IMAGEOBJCREATE NIL NWAYBUTTONIMAGEFNS))
HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS TWIDTHS)
(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))
(* We always need at least one button's width)
(IMAGEOBJPROP OBJECT (QUOTE MINHEIGHT)
(IPLUS HEIGHT 2)) (* And at least one button's height)
[IMAGEOBJPROP OBJECT (QUOTE MAXWIDTH)
(COND
[MAXITEMS/LINE (SETQ TWIDTHS (SORT (COPY WIDTHS)))
(IPLUS (CAR TWIDTHS)
(for WIDTH in (CDR TWIDTHS) as I from 1
to (SUB1 MAXITEMS/LINE) sum (IPLUS WIDTH SPACING]
(T (IPLUS (CAR WIDTHS)
(for WIDTH in (CDR WIDTHS) sum (IPLUS WIDTH SPACING]
(* At most, we're as wide as the N widest buttons put
together)
(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)
INITSTATE)
(IMAGEOBJPROP OBJECT (QUOTE SELECTEDBUTTON)
NIL)
(IMAGEOBJPROP OBJECT (QUOTE SIDEEFFECTFNS)
SIDEEFFECTFNS)
(IMAGEOBJPROP OBJECT (QUOTE DESCENT)
DESCENT)
(IMAGEOBJPROP OBJECT (QUOTE MBFONT)
FONT)
(IMAGEOBJPROP OBJECT (QUOTE MAXITEMS/LINE)
MAXITEMS/LINE)
(RETURN OBJECT])
(MB.NB.DISPLAYFN
[LAMBDA (OBJ STREAM MODE) (* jds "28-Aug-84 15:07")
(* 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 " 6-Sep-84 14:19")
(* Tell the size of an n-way menu)
(PROG ((OLDBOX (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)))
BOX
(MAXITEMS/LINE (IMAGEOBJPROP OBJ (QUOTE MAXITEMS/LINE)))
(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
((AND (IGEQ SLACK MAXWIDTH)
(NOT MAXITEMS/LINE)) (* 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 MAXITEMS/LINE))
[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
" 9-Feb-86 15:17")
(SETQ NWAYBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NB.DISPLAYFN)
(FUNCTION MB.NB.SIZEFN)
(FUNCTION MB.PUTFN)
(FUNCTION MB.GETFN)
(FUNCTION MB.COPYFN)
(FUNCTION MB.NWAYBUTTON.SELFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(FUNCTION MB.NB.WHENOPERATEDFN)
(QUOTE NILL)
(QUOTE NWayButton])
(MB.NB.PACKITEMS
[LAMBDA (WIDTH ITEMWIDTHS SPACING MAXITEMS/LINE) (* jds "24-Oct-84 17:42")
(* * 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)
(CURLINEITEMS 0)
ITEM)
(while ITEMWIDTHS
do (SETQ ITEM (pop ITEMWIDTHS))
(COND
((OR [ILESSP WIDTH (IPLUS CURX ITEM (COND
(CURLINE SPACING)
(T 0]
(AND MAXITEMS/LINE (IGEQ CURLINEITEMS MAXITEMS/LINE)))
(* Time for a new line)
(SETQ LINES (NCONC1 LINES (CONS CURX CURLINE)))
(* Add to our list of lines so far)
(SETQ CURLINE NIL) (* Empty the line accumulator)
(SETQ CURLINEITEMS 0) (* reset the line item count)
(SETQ CURX 0)))
(AND CURLINE (add CURX SPACING))
(SETQ CURLINE (NCONC1 CURLINE CURX))
(add CURX ITEM)
(add CURLINEITEMS 1))
[AND CURLINE (SETQ LINES (NCONC1 LINES (CONS CURX CURLINE]
(* Capture the last partial line, if there is one.)
(RETURN LINES])
(MB.NWAYBUTTON.ADDITEM
[LAMBDA (OBJECT NEWBUTTON) (* jds "11-Jul-85 12:44")
(* Given an existing n-way choice menu button, add
another choice to the list)
(PROG ([BUTTONS (CONS NEWBUTTON (IMAGEOBJPROP OBJECT (QUOTE BUTTONS]
HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS FONT)
(SETQ FONT (IMAGEOBJPROP OBJECT (QUOTE MBFONT)))
(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 SELECTEDBUTTON)
NIL)
(IMAGEOBJPROP OBJECT (QUOTE SIDEEFFECTFNS)
SIDEEFFECTFNS)
(IMAGEOBJPROP OBJECT (QUOTE DESCENT)
DESCENT)
(RETURN OBJECT])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NWAYBUTTONIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(NWAYBUTTON.INIT)
(ADDTOVAR IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN))
)
(* Two-state, toggling menu buttons.)
(DEFINEQ
(\TEXTMENU.TOGGLE.CREATE
[LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* gbn "24-Sep-84 14:45")
(* Creates a TOGGLE menu button, that can turn off and
on alternately.)
(PROG ((OBJ (IMAGEOBJCREATE NIL \TOGGLEIMAGEFNS))
(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 \TEXTMENU.TOGGLEFN))
(IMAGEOBJPROP OBJ (QUOTE STATECHANGEFN)
STATECHANGEFN) (* a function to be called on finalization of selection
of this button to provide for user side-effects)
(IMAGEOBJPROP OBJ (QUOTE STATE)
(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])
(\TEXTMENU.TOGGLE.DISPLAY
[LAMBDA (OBJ STREAM MODE) (* gbn "27-Sep-84 01:23")
(* "27-Sep-84 01:11" gbn)
(* Display the innards of a menu toggle)
(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
([type? BITMAP (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 STATE))
(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. Just display it regular.)
)
(ERROR "Invalid state in toggle button " OBJ])
(\TEXTMENU.TOGGLE.SHOWSELFN
[LAMBDA (OBJ SEL ON DS) (* jds " 6-Mar-85 14:56")
(PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
(IMAGEBOX OBJ DS]
(COND
(ON (SELECTQ (IMAGEOBJPROP OBJ (QUOTE STATE))
(ON
(* Switch from ON to (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))))
(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 NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX)
(fetch YSIZE of IMAGEBOX)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
NIL))
((fetch SET of SEL)
(SELECTQ (IMAGEOBJPROP OBJ (QUOTE STATE))
(ON (* Switch from OFF 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))
NIL])
(\TEXTMENU.TOGGLE.WHENOPERATEDFN
[LAMBDA (OBJ DS OPERATION SEL) (* jds "17-Aug-84 15:09")
(* Handle operations on a three-state button)
(SELECTQ OPERATION
(HIGHLIGHTED (* It is being hilighted)
(\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL T DS))
(UNHIGHLIGHTED (* And being de-hilighted)
(\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL NIL DS))
(SELECTED (* It's being selected)
(\TEXTMENU.TOGGLEFN 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])
(\TEXTMENU.TOGGLEFN
[LAMBDA (OBJ SEL W) (* jds "22-Mar-85 18:30")
(* MBFN for TOGGLE buttons--cycle back and forthe
betwen states.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(STATECHANGEFN (IMAGEOBJPROP OBJ (QUOTE STATECHANGEFN)))
OFILE CH NEWSTATE)
(SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ (QUOTE STATE))
(OFF (QUOTE ON))
(ON (QUOTE OFF))
(QUOTE ON)))
(COND
(STATECHANGEFN (* apply the user supplied state change fn if he
supplied one)
(APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ)
SEL)))
(IMAGEOBJPROP OBJ (QUOTE STATE)
NEWSTATE)
(replace ONFLG of SEL with NIL])
(\TEXTMENU.TOGGLE.INIT
[LAMBDA NIL (* jds
" 9-Feb-86 15:18")
(SETQ \TOGGLEIMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEXTMENU.TOGGLE.DISPLAY)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
(FUNCTION MB.GETFN)
(FUNCTION MB.COPYFN)
(FUNCTION MB.BUTTONEVENTINFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(FUNCTION \TEXTMENU.TOGGLE.WHENOPERATEDFN)
(QUOTE NILL)
(QUOTE ToggleButton])
(\TEXTMENU.SET.TOGGLE
[LAMBDA (TEXT VALUE TEXTSTREAM) (* jds "18-Jul-85 13:35")
(* * finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state to VALUE)
(PROG ((PCNO (MBUTTON.FIND.BUTTON TEXT TEXTSTREAM))
OBJ PC)
(COND
((NOT PCNO)
(ERROR TEXT " was not found as a button.")))
[SETQ OBJ (fetch POBJ of (SETQ PC (\EDITELT (fetch PCTB of (TEXTOBJ TEXTSTREAM))
(ADD1 PCNO]
(IMAGEOBJPROP OBJ (QUOTE STATE)
VALUE)
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
(QUOTE JUNK))
(for WINDOW inside (fetch \WINDOW of (TEXTOBJ TEXTSTREAM)) do (\TEDIT.REPAINTFN WINDOW))
(RETURN VALUE])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TOGGLEIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\TEXTMENU.TOGGLE.INIT)
(ADDTOVAR IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN))
)
(* Margin Setting and display)
(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 "20-Mar-85 11:23")
(* 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)
(COND
((EQ TABS (QUOTE NEUTRAL)) (* All tabs have been neutralized.
Just lay down a grey pattern over them.)
(DSPFILL (create REGION
LEFT ← 2
BOTTOM ← 1
HEIGHT ← 8
WIDTH ←(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL W))
4))
EDITGRAY
(QUOTE REPLACE)
W))
(T (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 " 7-Jan-85 17:52")
(* Create an instance of the margin-setting ruler for
TEdit's use.)
(PROG ((BOX (create IMAGEBOX
XSIZE ← 1008
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)) (* Create an IMAGEOBJ, containing an instance of the
record to hold margin and tab info)
(SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX)
(fetch YSIZE of BOX)))
(* A cache for the ruler's screen image)
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
BITMAP)
(SETQ DS (DSPCREATE BITMAP)) (* And a displaystream for modifying that image)
(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)))
(* Fill in the cache with the original value This does the time-consuming part of drawing the ticks on the ruler and
such, which would make drawing it on the fly unbearable.)
(IMAGEOBJPROP OBJ (QUOTE NEEDSUPDATE)
T) (* And tell the display function that it needs to be
updated when first displayed.
Which is the faster part.)
(RETURN OBJ])
(MB.MARGINBAR.SELFN
[LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* jds "20-Mar-85 12:19")
(* 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 (COND
((LISTP (fetch MARTABS of OBJDATUM))
(* Only scale the tabs if there are any, and they're
not neutralized.)
(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 ←(IDIFFERENCE (MSCALE (ABS L1)
UNIT)
2)
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 ←(IDIFFERENCE (MSCALE (ABS LN)
UNIT)
2)
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]
[(OR (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)
(AND (ZEROP (IABS (FIXR R)))
(INSIDE? (create REGION
LEFT ←(IDIFFERENCE (IMIN (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
((EQ (fetch MARTABS of OBJDATUM)
(QUOTE NEUTRAL)) (* The tabs used to be NEUTRAL.
Clear the tab region, and start afresh.)
(replace MARTABS of OBJDATUM with NIL)
(* So we don't come this way again.)
(DSPFILL (create REGION
LEFT ← 2
BOTTOM ← 1
HEIGHT ← 8
WIDTH ←(IDIFFERENCE (fetch WIDTH
of (DSPCLIPPINGREGION NIL W))
4))
WHITESHADE
(QUOTE REPLACE)
W) (* Make the tab region look non-neutral, too, so that
tabs look OK on it.)
))
(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 " 5-Sep-84 14:10")
(PROG ((BOX (create IMAGEBOX
XSIZE ← 1008
YSIZE ← 62
YDESC ← 0
XKERN ← 4)))
(IMAGEOBJPROP OBJ (QUOTE BOUNDBOX)
BOX)
(RETURN BOX])
(MB.MARGINBAR.DISPLAYFN
[LAMBDA (OBJ STREAM MODE) (* jds " 7-Jan-85 17:54")
(* 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)))
(* Create a cache bitmap)
(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)
(OR WASON (IMAGEOBJPROP OBJ (QUOTE NEEDSUPDATE)
NIL))
(fetch WIDTH of (DSPCLIPPINGREGION NIL STREAM)))
(* Update the image, if it needs it)
(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-Mar-85 17:36")
(* 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))
(DOTTEDLEFT (* Decimal aligned tab)
(BITBLT \TEDIT.DOTTED.LEFTTAB 0 0 W (IDIFFERENCE TABX 7)
1 NIL NIL (QUOTE INPUT)
MODE))
(DOTTEDCENTERED (* Decimal aligned tab)
(BITBLT \TEDIT.DOTTED.CENTERTAB 0 0 W (IDIFFERENCE TABX 7)
1 NIL NIL (QUOTE INPUT)
MODE))
(DOTTEDRIGHT (* Decimal aligned tab)
(BITBLT \TEDIT.DOTTED.RIGHTTAB 0 0 W (IDIFFERENCE TABX 7)
1 NIL NIL (QUOTE INPUT)
MODE))
(DOTTEDDECIMAL (* Decimal aligned tab)
(BITBLT \TEDIT.DOTTED.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 "22-Mar-85 17:55")
(* 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 DOTTEDBUTTON)
(SETQ STATE (IMAGEOBJPROP OBJ (QUOTE STATE))) (* Find out roughly what kind of TAB this is to be.)
[SETQ STATE (U-CASE (COND
((LISTP STATE)
(CAR STATE))
(T STATE] (* Make sure it's upper case, and an atom.)
(SETQ DOTTEDBUTTON (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)))
(* Find out if this is to be a tab with a dotted
leader.)
[COND
((EQ (IMAGEOBJPROP DOTTEDBUTTON (QUOTE STATE))
(QUOTE ON)) (* Yes. Make this a DOTTEDxxx tab.)
(SETQ STATE (PACK* (QUOTE DOTTED)
STATE]
(TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO FNARG)
(* Now run thru the rest of the document until we find the margin bar. Replace the tab type of that margin bar with
the new type.)
(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# STATE])
(MARGINBAR.INIT
[LAMBDA NIL (* jds
" 9-Feb-86 15:18")
(SETQ MARGINBARIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.MARGINBAR.DISPLAYFN)
(FUNCTION MB.MARGINBAR.SIZEFN)
(FUNCTION MB.MARGINBAR.PUTFN)
(FUNCTION MB.MARGINBAR.GETFN)
(FUNCTION MB.COPYFN)
(FUNCTION MB.MARGINBAR.SELFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE MarginRuler])
)
(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@@"
"@CH@"
"@CH@"
"@@@@")
(RPAQ \TEDIT.DOTTED.LEFTTAB (READBITMAP))
(16 8
"@@H@"
"@@H@"
"@AL@"
"@BJ@"
"@@H@"
"CFH@"
"CFOH"
"@@@@")
(RPAQ \TEDIT.DOTTED.CENTERTAB (READBITMAP))
(16 8
"@@A@"
"@@A@"
"@@CH"
"@@ED"
"@@A@"
"CFA@"
"CFGL"
"@@@@")
(RPAQ \TEDIT.DOTTED.RIGHTTAB (READBITMAP))
(16 8
"@@@D"
"@@@D"
"@@@N"
"@@AE"
"@@@D"
"CF@D"
"CFGL"
"@@@@")
(RPAQ \TEDIT.DOTTED.DECIMALTAB (READBITMAP))
(16 8
"@@@D"
"@@@D"
"@@@N"
"@@AE"
"@@@D"
"@MHN"
"@MHN"
"@@@@")
(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
(GLOBALVARS MARGINBARIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MARGINBAR.INIT)
(ADDTOVAR IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN))
)
(* Text menu creation and support)
(DEFINEQ
(\TEXTMENU.START
[LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* jds " 8-May-85 19:18")
(* 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 (EQUAL (OR TITLE "TEdit Menu")
(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 ←(OR HEIGHT 133)))
(T WREG)))
(OR TITLE "TEdit Menu")))
(WINDOWADDPROP MENUW (QUOTE CLOSEFN)
(QUOTE TEXTMENU.CLOSEFN))
(WINDOWADDPROP MENUW (QUOTE AFTERCLOSEFN)
(QUOTE TEXTMENU.AFTERCLOSEFN))
(WINDOWPROP MENUW (QUOTE TEDITMENU)
(OR TITLE "TEdit Menu")) (* 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 (LIST (QUOTE TITLEMENUFN)
(QUOTE DON'T)
(QUOTE PROMPTWINDOW)
(fetch PROMPTWINDOW of (TEXTOBJ MAINWINDOW]
(AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW (QUOTE PROCESS])
(\TEXTMENU.DOC.CREATE
[LAMBDA (MENUDESC MENUPROPS) (* jds "24-Sep-86 00:51")
(* 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 NIL NIL (OR MENUPROPS (QUOTE (FONT (MODERN 10]
(bind (CH# ← 1)
OBJ for DESC in MENUDESC
do (SELECTQ (CAR DESC)
(* (* This is a comment within a menu
description -- Ignore it.))
(MB.BUTTON (* A menu button -- hitting it calls a
function)
(TEDIT.INSERT.OBJECT (MBUTTON.CREATE (MKATOM (fetch (MB.BUTTON MBLABEL
)
of DESC))
(fetch (MB.BUTTON MBBUTTONEVENTFN)
of DESC)
(fetch (MB.BUTTON MBFONT) of DESC))
MENUTEXT CH#)
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED OFF))
CH# 1)
(add CH# 1))
(MB.3STATE (* 3-state button; hitting it changes
state among ON, OFF, and NEUTRAL.)
(TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON
(MKATOM (fetch (MB.3STATE MBLABEL) of DESC))
(fetch (MB.3STATE MBFONT) of DESC)
(fetch (MB.3STATE MBCHANGESTATEFN) of DESC)
(fetch (MB.3STATE MBINITSTATE) of DESC))
MENUTEXT CH#)
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED OFF))
CH# 1)
(add CH# 1))
(MB.TOGGLE (* TOGGLE button; hitting it switches
between ON and OFF.)
(TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE
(MKATOM (fetch (MB.TOGGLE MBTEXT) of DESC))
(fetch (MB.TOGGLE MBFONT) of DESC)
(fetch (MB.TOGGLE MBCHANGESTATEFN) of DESC)
(fetch (MB.TOGGLE MBINITSTATE) of DESC))
MENUTEXT CH#)
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED OFF))
CH# 1)
(add CH# 1))
(MB.NWAY (* N-way buttons; choosing one turns
the others off.)
(SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS) of DESC)
(fetch (MB.NWAY MBFONT) of DESC)
(fetch (MB.NWAY MBCHANGESTATEFN) of DESC)
(fetch (MB.NWAY MBINITSTATE) of DESC)
(fetch (MB.NWAY MBMAXITEMSPERLINE) of DESC)))
(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))
(MB.MARGINBAR (* Margin ruler for TEdit formatting)
(TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -.5 -.5 -.5 NIL 12)
MENUTEXT CH#)
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED OFF))
CH# 1)
(add CH# 1))
(MB.TEXT (* Arbitrary text, which will be
protected from the user.)
(TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC)
CH#)
[AND (fetch (MB.TEXT MBFONT) of DESC)
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(LIST (QUOTE MBFONT)
(fetch (MB.TEXT MBFONT) of DESC))
CH#
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC]
(TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED ON))
CH#
(NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))
(add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))))
(MB.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
((fetch (MB.INSERT MBINITENTRY) of DESC)
(* There is an initial entry to be
made. Make it)
[COND
((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of DESC))
(* It is an imageobj.)
(TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY)
of DESC)
MENUTEXT
(IPLUS CH# 3)))
(T (* It's regular text.)
(TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT
MBINITENTRY)
of DESC))
(IPLUS CH# 3]
[TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
(QUOTE (PROTECTED OFF SELECTPOINT OFF))
(IPLUS CH# 3)
(NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY)
of DESC]
(add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY) of DESC]
(add CH# 4))
(\ILLEGAL.ARG DESC)))
(replace MENUFLG of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T)
(* Remember that this is a menu)
[COND
(CH#1 (* We actually inserted some text, so
it makes sense to put up a selection)
(push (fetch EDITPROPS of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT))
(LIST (QUOTE SEL)
CH#1] (* And where the first selection
should be.)
(RETURN MENUTEXT])
(TEXTMENU.CLOSEFN
[LAMBDA (W) (* jds "11-Jul-85 12:44")
(* CLOSE a TEdit menu window: Detach the menu, then
reshape the remaining windows to take up the remaining
space)
(PROG ((MAINW (WINDOWPROP W (QUOTE MAINWINDOW)))
TEXTOBJ HEIGHT OHEIGHT OBOTTOM WBOTTOM WINDOWS)
(DETACHWINDOW W) (* So detach this window.)
[COND
((IGREATERP (FLENGTH (ATTACHEDWINDOWS MAINW))
1)
[SETQ OHEIGHT (fetch HEIGHT of (WINDOWPROP W (QUOTE REGION]
[SETQ OBOTTOM (fetch BOTTOM of (WINDOWPROP W (QUOTE REGION]
(CLOSEW W)
[SETQ WINDOWS (SORT (ATTACHEDWINDOWS MAINW)
(FUNCTION (LAMBDA (WW)
(fetch BOTTOM of (WINDOWPROP WW (QUOTE REGION]
(for WW in WINDOWS when (IGEQ [SETQ WBOTTOM (fetch BOTTOM of (WINDOWPROP WW
(QUOTE REGION]
OBOTTOM)
do (MOVEW WW (fetch LEFT of (WINDOWPROP WW (QUOTE REGION)))
(IDIFFERENCE WBOTTOM OHEIGHT]
(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 (* gbn "27-Sep-84 01:04")
(* Creates the TEdit Expanded Menu)
(SETQ TEDIT.EXPANDED.MENU (\TEXTMENU.DOC.CREATE TEDIT.EXPANDEDMENU.SPEC])
(\TEDIT.EXPANDED.MENU
[LAMBDA (STREAM) (* gbn "27-Sep-84 01:17")
(* "27-Sep-84 01:04" gbn)
(PROG (CHARMENUTEXTSTREAM)
(\TEXTMENU.START (SETQ CHARMENUTEXTSTREAM (COPYTEXTSTREAM TEDIT.EXPANDED.MENU T))
(\TEDIT.PRIMARYW (TEXTOBJ STREAM))
"TEdit Menu" 75)
(if (OR (TEXTPROP STREAM (QUOTE CLEARGET))
(TEXTPROP STREAM (QUOTE CLEARPUT)))
then (* initialise the button)
(\TEXTMENU.SET.TOGGLE "Unformatted" (QUOTE ON)
CHARMENUTEXTSTREAM])
(MB.DEFAULTBUTTON.FN
[LAMBDA (OBJ SEL W) (* jds " 7-May-85 15:36")
(* MBFN for TEdit default menu item buttons.)
(PROG* ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(MAINSEL (fetch SEL of MAINTEXT))
OFILE CH PROC)
(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])
(\TEDITMENU.RECORD.UNFORMATTED
[LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* jds " 7-Feb-85 09:44")
(PROG ((FLG (COND
((EQ NEWSTATE (QUOTE ON))
T)
(T NIL)))
(TEXTOBJ (TEXTOBJ TEXTSTREAM)))
(TEXTPROP TEXTOBJ (QUOTE UNFORMATTEDPUT/GET)
FLG])
(MB.DEFAULTBUTTON.ACTIONFN
[LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* jds "14-Jun-85 13:51")
(* MBFN for TEdit default menu item buttons.)
(PROG (OFILE CH #COPIES PRINTHOST PRINTOPTIONS #SIDES MSG)
[ERSETQ
(RESETLST [RESETSAVE (\TEDIT.MARKACTIVE MAINTEXT)
(QUOTE (AND (\TEDIT.MARKINACTIVE OLDVALUE]
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
(QUOTE (AND (\TEDIT.MARKINACTIVE OLDVALUE]
[RESETSAVE (PROG1 OBJ (IMAGEOBJPROP OBJ (QUOTE MENUBUTTON.SELECTED)
T))
(QUOTE (AND (IMAGEOBJPROP OLDVALUE (QUOTE MENUBUTTON.SELECTED)
NIL]
(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 (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(fetch CH# of SEL]
(COND
(OFILE (* Only try this if he really typed a file name)
(TEDIT.PUT MAINTEXT OFILE NIL (TEXTPROP TEXTOBJ (QUOTE
UNFORMATTEDPUT/GET]
[Get [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(fetch CH# of SEL]
(COND
(OFILE (* Only try this if he really typed a file name)
(TEDIT.GET MAINTEXT OFILE (TEXTPROP TEXTOBJ (QUOTE
UNFORMATTEDPUT/GET]
[Include [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(fetch CH# of SEL]
(COND
(OFILE (TEDIT.INCLUDE MAINTEXT 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 (ADD1 (CADR CH)))
[replace DCH of MAINSEL
with (ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
(replace POINT of MAINSEL with (QUOTE RIGHT))
(replace CARETLOOKS of MAINTEXT with (
\TEDIT.GET.INSERT.CHARLOOKS MAINTEXT MAINSEL)) (* Set the caret looks to match those of the new
selection)
(TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL)
(* And never pending a deletion.)
(\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]
(CONFIRM? (EQ (QUOTE ON)
(IMAGEOBJPROP
[CAR (MBUTTON.FIND.NEXT.BUTTON
TEXTOBJ
(fetch CHLIM
of (fetch SCRATCHSEL
of TEXTOBJ]
(QUOTE STATE]
(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
CONFIRM?]
[Quit (* He wants to QUIT the edit.)
(COND
((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXT)
T)
(replace EDITFINISHEDFLG of TEXTOBJ with T]
(Page% Layout (* Page layout menu)
(\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T)
(\TEDIT.PRIMARYW MAINTEXT)
"Page Layout Menu" 150))
(Para% Looks (* Page layout menu)
(\TEDIT.EXPANDEDPARA.MENU MAINTEXT))
(Char% Looks (* Page layout menu)
(\TEDIT.EXPANDEDCHARLOOKS.MENU MAINTEXT))
[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 (ADD1 (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 (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(fetch CH# of SEL]
(COND
((NOT PRINTHOST) (* If he didn't specify a particular host, defer to his
defaults.)
(TEDIT.PROMPTPRINT MAINTEXT "Using default print server.")))
[SETQ #COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ
(fetch CH#
of (fetch SCRATCHSEL
of TEXTOBJ]
(* Grab the field that specifies number of copies.)
[COND
(#COPIES (SETQ PRINTOPTIONS (LIST (QUOTE #COPIES)
#COPIES]
(SETQ #SIDES
(SELECTQ (IMAGEOBJPROP [CAR (MBUTTON.FIND.NEXT.BUTTON
TEXTOBJ
(fetch CHLIM
of (fetch SCRATCHSEL
of TEXTOBJ]
(QUOTE STATE))
(One% Side 1)
(Duplex 2)
NIL))
[COND
(#SIDES (push PRINTOPTIONS #SIDES)
(push PRINTOPTIONS (QUOTE #SIDES]
[SETQ MSG (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(fetch CH#
of (fetch SCRATCHSEL
of TEXTOBJ]
[COND
(MSG (push PRINTOPTIONS MSG)
(push PRINTOPTIONS (QUOTE MESSAGE]
(TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST PRINTOPTIONS))
(ERROR]
(replace SET of SEL with T) (* Now turn the menu button highlighting off.)
(replace ONFLG of SEL with T)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL) (* And forget that anything is selected.)
])
)
(DEFINEQ
(\TEDIT.CHARLOOKSMENU.CREATE
[LAMBDA NIL (* jds "20-Mar-85 12:34")
(* Creates the TEdit Expanded Menu)
(SETQ TEDIT.CHARLOOKS.MENU (\TEXTMENU.DOC.CREATE (APPEND (LIST (create MB.BUTTON
MBLABEL ←(QUOTE APPLY)
MBBUTTONEVENTFN ←(QUOTE
\TEDIT.APPLY.CHARLOOKS))
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ←(QUOTE SHOW)
MBBUTTONEVENTFN ←(QUOTE
\TEDIT.SHOW.CHARLOOKS))
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ←(QUOTE NEUTRAL)
MBBUTTONEVENTFN ←(QUOTE
\TEDIT.NEUTRALIZE.CHARLOOKS))
(create MB.TEXT
MBSTRING ← "
"))
TEDIT.CHARLOOKSMENU.SPEC])
(\TEDIT.EXPANDEDCHARLOOKS.MENU
[LAMBDA (STREAM) (* gbn "26-Sep-84 19:13")
(\TEXTMENU.START (COPYTEXTSTREAM TEDIT.CHARLOOKS.MENU T)
(\TEDIT.PRIMARYW STREAM)
"Character Looks Menu" 85])
(\TEDIT.APPLY.BOLDNESS
[LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:55")
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(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 "20-Mar-85 12:29")
(* 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 CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip over the SHOW button)
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* And over the NEUTRAL button.)
(SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ CH#))
(* Now Parse the menu, to give us a looks spec.)
(TEDIT.LOOKS MAINTEXT NEWLOOKS (fetch CH# of (fetch SEL of MAINTEXT))
(fetch DCH of (fetch SEL of MAINTEXT)))
(* Make the change in looks)
(\SHOWSEL SEL NIL NIL) (* And turn off the APPLY button.)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE PROCESS))) (* Leave him typing in the real document)
])
(\TEDIT.APPLY.OLINE
[LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56")
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (CONS (QUOTE OVERLINE)
(CONS (QUOTE ON)
NEWLOOKS)))
(OFF (CONS (QUOTE OVERLINE)
(CONS (QUOTE OFF)
NEWLOOKS)))
NEWLOOKS])
(\TEDIT.SHOW.CHARLOOKS
[LAMBDA (OBJ SEL W) (* jds "20-Mar-85 12:29")
(* 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)
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip over the NEUTRAL button.)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL)
(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)) (* Get the looks for those characters.)
(\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# NEWLOOKS)
(* Fill in the menu blanks with that info)
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* And update the screen image.)
])
(\TEDIT.NEUTRALIZE.CHARLOOKS
[LAMBDA (OBJ SEL W) (* jds "20-Mar-85 12:33")
(* Handle the NEUTRAL button on a character looks menu.
Sets all the menu settings neutral.)
(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)
(\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* Fill in the menu blanks with that info)
(TEDIT.UPDATE.SCREEN TEXTOBJ) (* And update the screen image.)
])
(\TEDIT.FILL.IN.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH# NEWLOOKS) (* jds "24-Dec-84 13:37")
(* Given a TEXTOBJ describing a charlooks menu, the CH# of the start of the charlooks menu, and a set of looks, fill
in the menu fields.)
(PROG (PC SCRATCHSEL OFILE CH NEXTB BUTTON TEXT OFFSET)
(SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKS NIL NIL))
(* Make sure the charlooks are in the proper internal
format, so this fn can be called from every reasonable
place.)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[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 STATE)
(QUOTE ON)))
(T (* Must reset it.)
(IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(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 [COND
((AND (type? FONTCLASS (fetch CLFONT of NEWLOOKS))
(NEQ (fetch FONTCLASSNAME of (fetch CLFONT of NEWLOOKS))
(QUOTE DEFAULTFONT)))
(CONCAT (fetch FONTCLASSNAME of (fetch CLFONT of NEWLOOKS))
(QUOTE -CLASS)))
((FONTP (fetch CLFONT of NEWLOOKS))
(FONTPROP (fetch CLFONT of NEWLOOKS)
(QUOTE FAMILY]
(U-CASE ITEM))
(IMAGEOBJPROP BUTTON (QUOTE STATE)
ITEM)
(RETURN)))
finally (* This font wasn't found in the list.
Add it.)
[MB.NWAYBUTTON.ADDITEM BUTTON (COND
((type? FONTCLASS (fetch CLFONT of NEWLOOKS))
(PACK* (fetch FONTCLASSNAME
of (fetch CLFONT of NEWLOOKS))
(QUOTE -class)))
((FONTP (fetch CLFONT of NEWLOOKS))
(FONTPROP (fetch CLFONT of NEWLOOKS)
(QUOTE FAMILY]
(* Add this family to the list of items)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(U-CASE (FONTPROP (fetch CLFONT of NEWLOOKS)
(QUOTE FAMILY]
(* Now find which text button was "on")
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
NIL) (* Clean out the "other font" field)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(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 CH# (ADD1 (fetch CH# of SCRATCHSEL])
(\TEDIT.NEUTRALIZE.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH#) (* jds "20-Mar-85 12:36")
(* Set all the fields in the CHARLOOKS menu specified
by TEXTOBJ, starting at CH# to neutral values.)
(PROG (PC SCRATCHSEL OFILE CH NEXTB BUTTON TEXT OFFSET)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[for PROP in (QUOTE (BOLD ITAL ULINE STRIKE OLINE))
do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(QUOTE NEUTRAL))
(SETQ CH# (ADD1 (CDR NEXTB]
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(* Get to the start of the text.)
(SETQ BUTTON (CAR NEXTB))
(IMAGEOBJPROP BUTTON (QUOTE STATE)
NIL) (* Now find which text button was "on")
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
NIL) (* Clean out the "other font" field)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL) (* 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)) (* Remember the offset value for later)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
NIL)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
NIL) (* 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 CH# (ADD1 (fetch CH# of SCRATCHSEL])
(\TEDIT.PARSE.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH#) (* jds "24-Dec-84 13:28")
(* MBFN for TEdit default menu item buttons.)
(PROG (SCRATCHSEL CH NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT OFFSET)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[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.)
(COND
([SETQ TEXT (MBUTTON.NEXT.FIELD.AS.ATOM TEXTOBJ (ADD1 (CDR NEXTB]
(* He wants some font not on the list.
Add it to the list.)
(SETQ NEWLOOKS (CONS (QUOTE FAMILY)
(CONS (U-CASE TEXT)
NEWLOOKS)))
(COND
([NOT (FMEMB (U-CASE TEXT)
(U-CASE (IMAGEOBJPROP BUTTON (QUOTE BUTTONS]
(* This font name isn't in the list already;
add it.)
(MB.NWAYBUTTON.ADDITEM BUTTON TEXT)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
TEXT))
(T [IMAGEOBJPROP BUTTON (QUOTE STATE)
(for NAME in (IMAGEOBJPROP BUTTON (QUOTE
BUTTONS))
suchthat (EQ (U-CASE TEXT)
(U-CASE NAME]
(* Select the newly-specified font.)
))
(TEDIT.DELETE TEXTOBJ SCRATCHSEL)
(* Delete the new font's name from the fill-in field.)
(TEDIT.OBJECT.CHANGED TEXTOBJ BUTTON))
(T (* He didn't specify a font.
Complain but keep on.)
(TEDIT.PROMPTPRINT TEXTOBJ
"'Other' font not specified; no change made."
T]
(COND
((STRPOS (QUOTE -class)
(IMAGEOBJPROP BUTTON (QUOTE STATE)))
(* It's a font class. Grab the name and evaluate it.)
(SETQ NEWLOOKS
(CONS (QUOTE FONT)
(CONS [EVAL (MKATOM (SUBSTRING (IMAGEOBJPROP BUTTON (QUOTE STATE))
1
(SUB1 (STRPOS (QUOTE -class)
(IMAGEOBJPROP
BUTTON
(QUOTE STATE]
NEWLOOKS)))
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#))
(T (SETQ NEWLOOKS (CONS (QUOTE FAMILY)
(CONS (U-CASE (IMAGEOBJPROP BUTTON (QUOTE STATE)))
NEWLOOKS)))
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
(* Skip over the "other text" fill-in.)
] (* Now find which text button was "on")
[SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* 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)
(RETURN NEWLOOKS])
(\TEDIT.APPLY.SLOPE
[LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56")
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (CONS (QUOTE SLOPE)
(CONS (QUOTE ITALIC)
NEWLOOKS)))
(OFF (CONS (QUOTE SLOPE)
(CONS (QUOTE REGULAR)
NEWLOOKS)))
NEWLOOKS])
(\TEDIT.APPLY.STRIKEOUT
[LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56")
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (CONS (QUOTE STRIKEOUT)
(CONS (QUOTE ON)
NEWLOOKS)))
(OFF (CONS (QUOTE STRIKEOUT)
(CONS (QUOTE OFF)
NEWLOOKS)))
NEWLOOKS])
(\TEDIT.APPLY.ULINE
[LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56")
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (CONS (QUOTE UNDERLINE)
(CONS (QUOTE ON)
NEWLOOKS)))
(OFF (CONS (QUOTE UNDERLINE)
(CONS (QUOTE OFF)
NEWLOOKS)))
NEWLOOKS])
)
(DEFINEQ
(\TEDITPARAMENU.CREATE
[LAMBDA NIL (* jds " 2-Aug-84 15:32")
(* Creates the TEdit Expanded Paragraph Menu)
(SETQ TEDIT.EXPANDEDPARA.MENU (\TEXTMENU.DOC.CREATE TEDIT.PARAMENU.SPEC])
(\TEDIT.EXPANDEDPARA.MENU
[LAMBDA (STREAM) (* jds " 5-Sep-84 14:26")
(\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDEDPARA.MENU T)
(\TEDIT.PRIMARYW (TEXTOBJ STREAM))
"Paragraph-Looks Menu" 154])
(\TEDIT.APPLY.PARALOOKS
[LAMBDA (OBJ SEL W) (* jds "24-Sep-86 00:36")
(* 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 PARATYPE SPECIALX SPECIALY)
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip the SHOW button)
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* and the NEUTRAL 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 the JUSTIFICATION button:
Left/Right/Centered/Justified)
(SETQ BUTTON (CAR NEXTB))
[COND
((AND (SETQ QUAD (IMAGEOBJPROP BUTTON (QUOTE STATE)))
(NEQ QUAD (QUOTE OFF))) (* A justification was specified)
(SETQ NEWLOOKS (CONS (QUOTE QUAD)
(CONS (U-CASE (MKATOM QUAD))
NEWLOOKS]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(* Go to the "Page Heading" button)
(SETQ BUTTON (CAR NEXTB))
[COND
((EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE ON)) (* This paragraph IS a page heading.)
(SETQ NEWLOOKS (CONS (QUOTE TYPE)
(CONS (QUOTE PAGEHEADING)
NEWLOOKS))) (* Tell him that it's a heading.)
(SETQ NEWLOOKS (CONS (QUOTE SUBTYPE)
(CONS [MKATOM (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
(ADD1 (CDR NEXTB]
NEWLOOKS))) (* And say what kind.)
)
((EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE OFF)) (* This paragraph IS NOT a page
heading.)
(SETQ NEWLOOKS (CONS (QUOTE TYPE)
(CONS NIL NEWLOOKS))) (* Tell him that it's NOT a heading.)
(SETQ NEWLOOKS (CONS (QUOTE SUBTYPE)
(CONS NIL NEWLOOKS)))
(MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB)))
(* And say what kind.)
)
(T (* No change specified.
Skip over the heading-type fill-in.)
(MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB]
[COND
((SETQ LINELEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (fetch CH# of SCRATCHSEL)))
(* Get any line leading)
(SETQ NEWLOOKS (CONS (QUOTE LINELEADING)
(CONS LINELEAD NEWLOOKS]
[COND
([SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* Get any paragraph leading)
(SETQ NEWLOOKS (CONS (QUOTE PARALEADING)
(CONS PARALEAD NEWLOOKS]
[COND
([SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* Get any special X position for the
paragraph)
(SETQ NEWLOOKS (CONS (QUOTE SPECIALX)
(CONS (FIXR (TIMES 12 SPECIALX))
NEWLOOKS]
[COND
([SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* Get special Y positioning for the
paragraph)
(SETQ NEWLOOKS (CONS (QUOTE SPECIALY)
(CONS (FIXR (TIMES 12 SPECIALY))
NEWLOOKS]
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
(SETQ BUTTON (CAR NEXTB))
[COND
[(EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE ON)) (* This paragraph starts on a new page
(or col or box, as apprpopriate))
(SETQ NEWLOOKS (CONS (QUOTE NEWPAGEBEFORE)
(CONS T NEWLOOKS]
((EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE OFF)) (* This paragraph IS NOT a page
heading.)
(SETQ NEWLOOKS (CONS (QUOTE NEWPAGEBEFORE)
(CONS NIL NEWLOOKS]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(SETQ BUTTON (CAR NEXTB))
[COND
[(EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE ON)) (* The next paragraph starts on a new
page....)
(SETQ NEWLOOKS (CONS (QUOTE NEWPAGEAFTER)
(CONS T NEWLOOKS]
((EQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(QUOTE OFF)) (* The next paragraph DOESN'T START on
a new page....)
(SETQ NEWLOOKS (CONS (QUOTE NEWPAGEAFTER)
(CONS NIL NEWLOOKS]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(SETQ BUTTON (CAR NEXTB))
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (push NEWLOOKS T)
(push NEWLOOKS (QUOTE HARDCOPY)))
(OFF (push NEWLOOKS NIL)
(push NEWLOOKS (QUOTE HARDCOPY)))
NIL)
(* * THE VARIOUS KINDS OF KEEP PROPERTIES
(ONLY HEADING-KEEP FOR NOW THO))
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(SETQ BUTTON (CAR NEXTB))
(SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(ON (push NEWLOOKS (QUOTE ON))
(push NEWLOOKS (QUOTE HEADINGKEEP)))
(OFF (push NEWLOOKS (QUOTE OFF))
(push NEWLOOKS (QUOTE HEADINGKEEP)))
NIL)
(* * THE DEFAULT TAB WIDTH)
(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]
[COND
((NEQ (fetch MARTABS of BUTTONDATA)
(QUOTE NEUTRAL)) (* If the tab settings are neutral,
don't change anything.)
(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.PARALOOKS
[LAMBDA (OBJ SEL W) (* jds "24-Sep-86 01:49")
(* Fill in the PARAGRAPH LOOKS menu
from the para looks for a selected
character)
(PROG* ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
(SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
FMTSPEC BUTTON NEXTB ARB BUTTONDATA)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL)
(COND
((ZEROP (fetch TEXTLEN of MAINTEXT)) (* If there is no text to take the
formatting from, don't bother)
(RETURN)))
[SETQ FMTSPEC (fetch PPARALOOKS of (\CHTOPC [IMAX 1 (IMIN (fetch TEXTLEN of MAINTEXT)
(fetch CH#
of (fetch SEL of MAINTEXT]
(fetch PCTB of MAINTEXT]
(* Get to the start of the text.)
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip the NEUTRAL button.)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(* Grab the justification button)
(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")
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(* Find the "Page Heading" button)
(SETQ BUTTON (CAR NEXTB))
(COND
((EQ (fetch FMTPARATYPE of FMTSPEC)
(QUOTE PAGEHEADING)) (* This IS a page heading.
Turn the button ON and set the heading
type field)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE ON))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(fetch FMTPARASUBTYPE of FMTSPEC)))
(T (* This isn't a page heading;
make sure the type field is empty.)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE OFF))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL)))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(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))
(QUOTIENT (FIXR (IQUOTIENT (OR (fetch FMTSPECIALX of FMTSPEC)
0)
3))
4))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(QUOTIENT (FIXR (IQUOTIENT (OR (fetch FMTSPECIALY of FMTSPEC)
0)
3))
4))
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(SETQ BUTTON (CAR NEXTB))
[COND
((fetch FMTNEWPAGEBEFORE of FMTSPEC)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE ON)) (* This para starts on a new page)
)
(T (IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE OFF]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(SETQ BUTTON (CAR NEXTB))
[COND
((fetch FMTNEWPAGEAFTER of FMTSPEC)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE ON)) (* This para starts on a new page)
)
(T (IMAGEOBJPROP BUTTON (QUOTE STATE)
(QUOTE OFF]
(* * HARDCOPY-DISPLAY MODE)
[SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (CDR NEXTB))
(COND
((fetch FMTHARDCOPY of FMTSPEC)
(* This para is to be formatted for
hardcopy on the display)
(QUOTE ON))
(T (QUOTE OFF]
(* * HEADING KEEP)
[SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (COND
((fetch FMTHEADINGKEEP
of FMTSPEC)
(* This para is to be formatted for
hardcopy on the display)
(QUOTE ON))
(T (QUOTE OFF]
(* * DEFAULT TAB WIDTH)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB (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.NEUTRALIZE.PARALOOKS.MENU
[LAMBDA (OBJ SEL W) (* jds "31-Jul-85 22:28")
(* Set all the fields of a PARAGRAPH LOOKS menu to
neutral settings.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(CH# (ADD1 (fetch CH# of SEL)))
SCRATCHSEL FMTSPEC BUTTON NEXTB ARB BUTTONDATA)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ)) (* Get to the start of the text.)
(SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ CH# (QUOTE NIL)))
(* Neutralize the justification N-Way button)
(SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (QUOTE NEUTRAL)))
(* Find the "Page Heading" button)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL) (* Update the LINE LEADING field)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL) (* Update the PARA LEADING field)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
NIL)
(SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(QUOTE NEUTRAL)))
(* New page before)
(SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (QUOTE NEUTRAL)))
(* New page after)
(SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (QUOTE NEUTRAL)))
(* Hardcopy formatting mode)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) (* 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 (COND
((ILESSP (fetch MARL1 of BUTTONDATA)
0)
(fetch MARL1 of BUTTONDATA))
(T (IMIN -.5 (IMINUS (fetch MARL1 of BUTTONDATA]
[replace MARLN of BUTTONDATA with (COND
((ILESSP (fetch MARLN of BUTTONDATA)
0)
(fetch MARLN of BUTTONDATA))
(T (IMIN -.5 (IMINUS (fetch MARLN of BUTTONDATA]
[replace MARR of BUTTONDATA with (COND
((ILESSP (fetch MARR of BUTTONDATA)
0)
(fetch MARR of BUTTONDATA))
((ZEROP (fetch MARR of BUTTONDATA))
(IMINUS (IQUOTIENT (IDIFFERENCE (fetch WRIGHT
of TEXTOBJ)
20)
12)))
(T (IMIN -.5 (IMINUS (fetch MARR of BUTTONDATA]
(replace MARTABS of BUTTONDATA with (QUOTE NEUTRAL))
(\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.RECORD.TABLEADERS
[LAMBDA (BUTTON NEWSTATE TEXTSTREAM SEL) (* jds "11-Jul-85 12:49")
(* Toggle the dotted-leader state of the margin bar
tab-setter. This is called when the user hits the
"dotted leader" toggle button in the menu)
(PROG* [(FLG (COND
((EQ NEWSTATE (QUOTE ON))
T)
(T NIL)))
(TEXTOBJ (TEXTOBJ TEXTSTREAM))
(MARGINBAR (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SEL]
(replace MARTABTYPE of (IMAGEOBJPROP MARGINBAR (QUOTE OBJECTDATUM))
with (SELECTQ (OR (fetch MARTABTYPE of (IMAGEOBJPROP MARGINBAR (QUOTE OBJECTDATUM)))
(QUOTE LEFT))
(LEFT (QUOTE DOTTEDLEFT))
(DOTTEDLEFT (QUOTE LEFT))
(CENTERED (QUOTE DOTTEDCENTERED))
(DOTTEDCENTERED (QUOTE CENTERED))
(RIGHT (QUOTE DOTTEDRIGHT))
(DOTTEDRIGHT (QUOTE RIGHT))
(DECIMAL (QUOTE DOTTEDDECIMAL))
(DOTTEDDECIMAL (QUOTE DECIMAL))
(SHOULDNT])
)
(DEFINEQ
(\TEDIT.SHOW.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* jds "24-Sep-86 17:54")
(* Take a document's page formatting,
and display it in the menu.)
(PROG* ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
(SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
(OLDUPDATEFLG (fetch TXTDON'TUPDATE of TEXTOBJ))
NEWLOOKS NEXTB BUTTON PAGEID OPAGEFRAMES FIRST REST PFONT HEADING HEADINGS PAGEPROPS
STARTINGPAGE# PAPERSIZE) (* ;;
"Start by turning off the selection--and leaving it off afterward.")
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL) (* ;;
"What kind of page are we looking at the specs for?")
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ BUTTON (CAR NEXTB))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(First%(&Default%)
(SETQ PAGEID (QUOTE FIRST)))
(Other% Left (SETQ PAGEID (QUOTE LEFT)))
(Other% Right (SETQ PAGEID (QUOTE RIGHT)))
(PROGN (TEDIT.PROMPTPRINT MAINTEXT "First specify which kind of page you want to see."
T)
(RETURN))) (* ;;
"Now mark the menu for NO SCREEN UPDATES during the button-setting process.")
(replace TXTDON'TUPDATE of TEXTOBJ with T) (* ;;
"Now replace the button values, fill-in fields, etc.")
(SETQ OPAGEFRAMES (OR (fetch TXTPAGEFRAMES of MAINTEXT)
TEDIT.PAGE.FRAMES))
[COND
((LISTP OPAGEFRAMES) (* No problem, this is already just a
list of first-recto-verso frames)
)
(T (* This is probably a parsed-up
version of the thing.
Fix it to a list.)
(COND
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of OPAGEFRAMES)
(QUOTE SEQUENCE))
(SETQ FIRST (CAR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES)))
(SETQ REST (CADR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES)))
(COND
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REST)
(QUOTE ALTERNATE))
(SETQ OPAGEFRAMES (CONS FIRST (fetch (PAGEREGION REGIONSUBBOXES)
of REST]
(T (SETQ OPAGEFRAMES NIL]
(T (SETQ OPAGEFRAMES NIL]
(COND
((NOT OPAGEFRAMES) (* If the formatting isn't in our
simplified 3-way format, punt out of
this.)
(TEDIT.PROMPTPRINT MAINTEXT "Format too complex to edit." T)
(RETURN)))
(SELECTQ PAGEID
(FIRST (SETQ NEWLOOKS (CAR OPAGEFRAMES)))
(LEFT (SETQ NEWLOOKS (CADR OPAGEFRAMES))
(SETQ PAPERSIZE (LISTGET [CAR (FLAST (TEDIT.UNPARSE.PAGEFORMAT (CAR OPAGEFRAMES)
(QUOTE PICAS]
(QUOTE PAPERSIZE))))
(RIGHT (SETQ NEWLOOKS (CADDR OPAGEFRAMES))
(SETQ PAPERSIZE (LISTGET [CAR (FLAST (TEDIT.UNPARSE.PAGEFORMAT (CAR OPAGEFRAMES
)
(QUOTE PICAS]
(QUOTE PAPERSIZE))))
NIL)
(SETQ NEWLOOKS (TEDIT.UNPARSE.PAGEFORMAT NEWLOOKS (QUOTE PICAS)))
(SETQ PAGEPROPS (CAR (FLAST NEWLOOKS)))
[COND
((EQ PAGEID (QUOTE FIRST))
(SETQ PAPERSIZE (LISTGET PAGEPROPS (QUOTE PAPERSIZE]
(SETQ CH# (ADD1 (CDR NEXTB))) (* Move past the kind-of-page button)
(SETQ STARTINGPAGE# (LISTGET PAGEPROPS (QUOTE STARTINGPAGE#)))
(* Grab a potential starting page
number.)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# STARTINGPAGE#)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(OR PAPERSIZE (QUOTE Letter)))
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
[IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(COND
((LISTGET PAGEPROPS (QUOTE LANDSCAPE?))
(QUOTE ON))
(T (QUOTE OFF] (* Tell whether the page is to be
landscape or not.)
(SETQ FOLIOINFO (LISTGET PAGEPROPS (QUOTE FOLIOINFO)))
(* Page number fomratting info)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
[IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE)
(COND
((pop NEWLOOKS)
(QUOTE Yes))
(T (QUOTE No]
(SETQ BUTTON (CAR NEXTB))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
(pop NEWLOOKS)) (* Page # X location)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Page # Y location)
(SETQ PFONT (pop NEWLOOKS)) (* Skip the font info for now.)
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ BUTTON (CAR NEXTB))
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(SELECTQ (pop FOLIOINFO)
(ARABIC 123)
(LOWERROMAN (QUOTE xiv))
(UPPERROMAN (QUOTE XIV))
123)) (* The format for the page number)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ BUTTON (CAR NEXTB)) (* How to align the page number)
(IMAGEOBJPROP BUTTON (QUOTE STATE)
(SELECTQ (pop NEWLOOKS)
(LEFT (QUOTE Left))
(RIGHT (QUOTE Right))
(CENTERED (QUOTE Centered))
(QUOTE Centered)))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# (pop FOLIOINFO))
(* The text to surround the page
number)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop FOLIOINFO))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Left Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Right Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Top margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Bottom Margin)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* # of columns)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Column width)
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
(pop NEWLOOKS)) (* Intercolumn spacing)
(SETQ HEADINGS (pop NEWLOOKS))
(for HEADING# from 1 to 4 do (SETQ HEADING (pop HEADINGS))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of
SCRATCHSEL
))
(pop HEADING))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of
SCRATCHSEL
))
(pop HEADING))
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch CH# of
SCRATCHSEL
))
(pop HEADING)))
(\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL))
PFONT) (* The font for the page numbers to
appear in.)
(\SHOWSEL SCRATCHSEL NIL NIL)
(replace SET of SCRATCHSEL with NIL)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (fetch TEXTLEN of TEXTOBJ))
(* ;;
"Now turn screen updating back to its old value, and update the screen.")
(replace TXTDON'TUPDATE of TEXTOBJ with OLDUPDATEFLG)
(TEDIT.UPDATE.SCREEN TEXTOBJ])
(\TEDITPAGEMENU.CREATE
[LAMBDA NIL (* gbn " 8-Oct-84 18:25")
(* Creates the TEdit Expanded Menu)
(SETQ TEDIT.EXPANDED.PAGEMENU (\TEXTMENU.DOC.CREATE (APPEND TEDIT.PAGEMENU.SPEC
TEDIT.MENUDIVIDER.SPEC
[LIST (create MB.TEXT
MBSTRING ←
"Character Looks for Page Numbers: "
MBFONT ←(FONTCREATE
(QUOTE HELVETICA)
10
(QUOTE BOLD]
TEDIT.CHARLOOKSMENU.SPEC])
(\TEDIT.APPLY.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* jds " 9-Jan-86 14:25")
(* * Change the page formatting for this document)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
SCRATCHSEL NEXTB BUTTON OPAGEFRAMES PAGEID PX PY LEFT BOTTOM TOP RIGHT ALIGNMENT PAGENOS
COLS COLWIDTH INTERCOL PFONT NPAGEFORMAT HEADINGTYPE HEADINGX HEADINGY HEADINGS
HEADINGINVALID STARTINGPAGE# FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT PAGEOPTIONS
NFPAGEFORMAT PAPERSIZE LANDSCAPE?)
(SETQ SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* Skip the SHOW button.)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(First%(&Default%) (SETQ PAGEID (QUOTE FIRST)))
(Other% Left (SETQ PAGEID (QUOTE LEFT)))
(Other% Right (SETQ PAGEID (QUOTE RIGHT)))
(PROGN (TEDIT.PROMPTPRINT MAINTEXT "Set KIND OF PAGE before APPLYing." T)
(RETURN))) (* Find which page, for later.)
(SETQ STARTINGPAGE# (AND (EQ PAGEID (QUOTE FIRST))
(MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#)))
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ PAPERSIZE (OR (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(QUOTE Letter))) (* Get the size of paper this is to be formatted for)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ LANDSCAPE? (EQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(QUOTE ON))) (* Decide if this kind of page is to be printed
landscape....)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(SETQ CH# (ADD1 (CDR NEXTB)))
(SELECTQ (IMAGEOBJPROP (CAR NEXTB)
(QUOTE STATE))
(No (SETQ PAGENOS NIL))
(Yes (SETQ PAGENOS T))
NIL) (* Find about page numbers)
(SETQ PX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))
[SETQ PY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[COND
(PAGENOS (* If he wants page numbers, make sure he said WHERE
to put them.)
(COND
((AND PX PY))
(T (TEDIT.PROMPTPRINT MAINTEXT
"Please set the X and Y location for page numbers before APPLYing."
T)
(TEDIT.PROMPTFLASH MAINTEXT)
(RETURN]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* Get to the numbering-format button)
(SETQ BUTTON (CAR NEXTB))
(SETQ FOLIOFORMAT (SELECTQ (IMAGEOBJPROP BUTTON (QUOTE STATE))
(123 (* arabic numbers)
(QUOTE ARABIC))
(xiv (* lower-case roman numerals)
(QUOTE LOWERROMAN))
(XIV (* Upper-case roman numerals)
(QUOTE UPPERROMAN))
(QUOTE ARABIC)))
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB]
(* Get to the number alignment button)
(SETQ BUTTON (CAR NEXTB))
[SETQ ALIGNMENT (U-CASE (IMAGEOBJPROP BUTTON (QUOTE STATE]
(* PX PY PFONT ALIGNMENT)
(* Margins: LEFT, RIGHT, TOP, BOTTOM)
(SETQ CH# (ADD1 (CDR NEXTB)))
(SETQ FOLIOPRETEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ CH#))
[SETQ FOLIOPOSTTEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (fetch CH#
of SCRATCHSEL]
(* * Now get the margins on the paper)
[SETQ LEFT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ RIGHT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of
SCRATCHSEL]
[SETQ TOP (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
[SETQ BOTTOM (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH# of
SCRATCHSEL]
(COND
[(SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH#
of SCRATCHSEL]
(T (TEDIT.PROMPTPRINT MAINTEXT "Please specify how many columns there should be." T)
(TEDIT.PROMPTFLASH MAINTEXT)))
[SETQ COLWIDTH (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH#
of SCRATCHSEL]
[SETQ INTERCOL (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch CH#
of SCRATCHSEL]
(* Col count, width, spacing)
(SETQ HEADINGS (for HEADING# from 1 to 8
when [PROG1 [SETQ HEADINGTYPE
(MBUTTON.NEXT.FIELD.AS.ATOM TEXTOBJ
(ADD1 (fetch
CH#
of
SCRATCHSEL]
[SETQ HEADINGX (MBUTTON.NEXT.FIELD.AS.NUMBER
TEXTOBJ
(ADD1 (fetch CH# of SCRATCHSEL]
(SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER
TEXTOBJ
(ADD1 (fetch CH# of SCRATCHSEL]
collect (COND
((AND HEADINGX HEADINGY))
(T (TEDIT.PROMPTPRINT MAINTEXT (CONCAT
"You need to say WHERE "
HEADINGTYPE
" headings go.")
T)
(TEDIT.PROMPTFLASH MAINTEXT)
(SETQ HEADINGINVALID T)))
(LIST HEADINGTYPE HEADINGX HEADINGY)))
(COND
(HEADINGINVALID (* Headings invalid.)
(RETURN)))
[SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch CH# of SCRATCHSEL]
(* * Glom all the oddball options (starting page, folio format &c) together)
(SETQ PAGEOPTIONS (AND STARTINGPAGE# (LIST (QUOTE STARTINGPAGE#)
STARTINGPAGE#)))
(push PAGEOPTIONS (LIST FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT))
(push PAGEOPTIONS (QUOTE FOLIOINFO))
[COND
(LANDSCAPE? (* The pages are to be printed landscape.
Remember that fact.)
(push PAGEOPTIONS T)
(push PAGEOPTIONS (QUOTE LANDSCAPE?]
(SETQ NPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT
(AND (NEQ ALIGNMENT (QUOTE OFF))
ALIGNMENT)
LEFT RIGHT TOP BOTTOM COLS COLWIDTH
INTERCOL HEADINGS (QUOTE PICAS)
PAGEOPTIONS PAPERSIZE))
(SETQ OPAGEFRAMES (fetch TXTPAGEFRAMES of MAINTEXT))
[COND
((NOT (LISTP OPAGEFRAMES))
(COND
((EQ PAGEID (QUOTE FIRST)) (* Setting the first page sets them all)
(SETQ PAGEOPTIONS (COPY PAGEOPTIONS))
(LISTPUT PAGEOPTIONS (QUOTE STARTINGPAGE#)
NIL) (* Starting page nubmer makes no sense on other than
first pages.)
(SETQ NFPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT
(AND (NEQ ALIGNMENT
(QUOTE OFF))
ALIGNMENT)
LEFT RIGHT TOP BOTTOM COLS
COLWIDTH INTERCOL HEADINGS
(QUOTE PICAS)
PAGEOPTIONS PAPERSIZE))
(SETQ OPAGEFRAMES (LIST NPAGEFORMAT NFPAGEFORMAT NFPAGEFORMAT)))
(T (* Otherwise, start from the default page layout)
(SETQ OPAGEFRAMES (COPY TEDIT.PAGE.FRAMES]
(SELECTQ PAGEID
(FIRST (RPLACA OPAGEFRAMES NPAGEFORMAT))
(LEFT (RPLACA (CDR OPAGEFRAMES)
NPAGEFORMAT))
(RIGHT (RPLACA (CDDR OPAGEFRAMES)
NPAGEFORMAT))
NIL)
(TEDIT.PAGEFORMAT MAINTEXT OPAGEFRAMES)
(replace \DIRTY of MAINTEXT with T) (* Mark the document as having changed.)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE PROCESS])
(TEDIT.UNPARSE.PAGEFORMAT
[LAMBDA (PAGEREGION UNITS) (* jds "12-Jul-85 13:56")
(PROG ((REGIONS (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION))
PX PY PFONT PQUAD PINFO LEFT RIGHT TOP BOTTOM (COLS 0)
COLWIDTH
(INTERCOL 0)
SPECS PAGENOS OLDRIGHT SCALEFACTOR HEADINGS)
[for REGION in REGIONS do (COND
((EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION)
(QUOTE FOLIO))
(SETQ PAGENOS T)
(SETQ PX (fetch LEFT of (fetch REGIONSPEC of REGION)))
(SETQ PY (fetch BOTTOM of (fetch REGIONSPEC of REGION)))
(SETQ SPECS (fetch REGIONLOCALINFO of REGION))
(SETQ PFONT (LISTGET SPECS (QUOTE CHARLOOKS)))
[SETQ PQUAD (CADR (LISTGET SPECS (QUOTE PARALOOKS]
(SELECTQ PQUAD
(LEFT)
(RIGHT (SETQ PX (IPLUS PX 288)))
(CENTERED (SETQ PX (IPLUS PX 144)))
NIL))
[(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION)
(QUOTE HEADING))
(SETQ HEADINGS (NCONC1 HEADINGS
(LIST (LISTGET (fetch REGIONLOCALINFO
of REGION)
(QUOTE HEADINGTYPE))
(fetch LEFT
of (fetch REGIONSPEC
of REGION))
(fetch BOTTOM
of (fetch REGIONSPEC
of REGION]
(T (add COLS 1)
(SETQ COLWIDTH (fetch WIDTH of (fetch REGIONSPEC
of REGION)))
[SETQ RIGHT (IDIFFERENCE 612
(ADD1 (fetch RIGHT
of (fetch REGIONSPEC
of REGION]
(COND
((EQ OLDRIGHT T))
(OLDRIGHT (SETQ INTERCOL
(IDIFFERENCE (fetch LEFT
of (fetch REGIONSPEC
of REGION))
OLDRIGHT))
(SETQ OLDRIGHT T))
(T (SETQ OLDRIGHT (fetch RIGHT
of (fetch REGIONSPEC of REGION)))
(SETQ LEFT (fetch LEFT of (fetch REGIONSPEC
of REGION)))
[SETQ TOP (IDIFFERENCE 792
(fetch PTOP
of (fetch REGIONSPEC
of REGION]
(SETQ BOTTOM (fetch BOTTOM
of (fetch REGIONSPEC of REGION]
(SELECTQ UNITS
((POINTS NIL) (* If units are in printers points, the default, do no
scaling)
)
(PICAS (* The units are in picas--12pts per.
Scale all values.)
(SETQ SCALEFACTOR .12))
(INCHES (* The units are in inches, at 72.27pts per.
Set the scale factor)
(SETQ SCALEFACTOR .7227))
[CM (* Units are in CM, at 72.27/2.54pts per.)
(SETQ SCALEFACTOR (CONSTANT (FQUOTIENT .7227 2.54]
(\ILLEGAL.ARG UNITS))
[COND
(SCALEFACTOR (* We need to do the scaling.)
(AND PX (SETQ PX (FQUOTIENT (FIXR (FQUOTIENT PX SCALEFACTOR))
100)))
(AND PY (SETQ PY (FQUOTIENT (FIXR (FQUOTIENT PY SCALEFACTOR))
100)))
(AND LEFT (SETQ LEFT (FQUOTIENT (FIXR (FQUOTIENT LEFT SCALEFACTOR))
100)))
(AND RIGHT (SETQ RIGHT (FQUOTIENT (FIXR (FQUOTIENT RIGHT SCALEFACTOR))
100)))
(AND TOP (SETQ TOP (FQUOTIENT (FIXR (FQUOTIENT TOP SCALEFACTOR))
100)))
(AND BOTTOM (SETQ BOTTOM (FQUOTIENT (FIXR (FQUOTIENT BOTTOM SCALEFACTOR))
100)))
(AND COLWIDTH (SETQ COLWIDTH (FQUOTIENT (FIXR (FQUOTIENT COLWIDTH
SCALEFACTOR))
100)))
(AND INTERCOL (SETQ INTERCOL (FQUOTIENT (FIXR (FQUOTIENT INTERCOL
SCALEFACTOR))
100)))
(SETQ HEADINGS (for HDG in HEADINGS
collect (LIST (CAR HDG)
(FQUOTIENT (FIXR (FQUOTIENT (CADR HDG)
SCALEFACTOR))
100)
(FQUOTIENT (FIXR (FQUOTIENT (CADDR HDG)
SCALEFACTOR))
100]
(RETURN (LIST PAGENOS PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL
HEADINGS (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION])
)
(* Initialization Code)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU TEDIT.MENUDIVIDER.SPEC
TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC
TEDIT.EXPANDED.PAGEMENU)
)
(DEFINEQ
(\TEDIT.MENU.INIT
[LAMBDA NIL (* jds "24-Sep-86 00:52")
(* * Initialize the descriptions for all TEdit menus)
(* * Divides between the main page layout menu and page-# font submenu)
(SETQ TEDIT.MENUDIVIDER.SPEC (LIST (create MB.TEXT
MBSTRING ← "
")))
(* * The principal expanded menu)
(SETQ TEDIT.EXPANDEDMENU.SPEC (LIST (create MB.BUTTON
MBLABEL ← "Quit")
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Page Layout")
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Char Looks")
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Para Looks")
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "All")
(create MB.TEXT
MBSTRING ← " ")
(create MB.TOGGLE
MBTEXT ← "Unformatted"
MBCHANGESTATEFN ← (FUNCTION
\TEDITMENU.RECORD.UNFORMATTED))
(create MB.TEXT
MBSTRING ← "
")
(create MB.BUTTON
MBLABEL ← "Get")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Put")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Include")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
")
(create MB.BUTTON
MBLABEL ← "Find")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← "Substitute")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " for")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " ")
(create MB.TOGGLE
MBTEXT ← "Confirm")
(create MB.TEXT
MBSTRING ← "
")
(create MB.BUTTON
MBLABEL ← "Hardcopy")
(create MB.TEXT
MBSTRING ← " server:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " copies:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Print ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (One% Side Duplex))
MBMAXITEMSPERLINE ← 5)
(create MB.TEXT
MBSTRING ← " Message/Phone#:")
(create MB.INSERT)))
(* * The character-looks (font, etc.) menu)
(SETQ TEDIT.CHARLOOKSMENU.SPEC (LIST (create MB.TEXT
MBSTRING ← "Props: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.3STATE
MBLABEL ← (QUOTE Bold))
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← (QUOTE Italic))
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← (QUOTE Underline))
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← (QUOTE StrikeThru))
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← (QUOTE Overbar))
(create MB.TEXT
MBSTRING ← "
")
(create MB.NWAY
MBBUTTONS ←
(QUOTE (TimesRoman Helvetica Gacha Modern Classic
Terminal Other))
MBMAXITEMSPERLINE ← 5)
(create MB.TEXT
MBSTRING ← "other font:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Size: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (Normal Superscript Subscript)))
(create MB.TEXT
MBSTRING ← " distance: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)))
(* * The paragraph-formatting menu (margins, etc.))
(SETQ TEDIT.PARAMENU.SPEC (LIST (create MB.BUTTON
MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (FUNCTION \TEDIT.APPLY.PARALOOKS))
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (FUNCTION \TEDIT.SHOW.PARALOOKS))
(create MB.TEXT
MBSTRING ← " ")
(create MB.BUTTON
MBLABEL ← (QUOTE NEUTRAL)
MBBUTTONEVENTFN ← (FUNCTION
\TEDIT.NEUTRALIZE.PARALOOKS.MENU))
(create MB.TEXT
MBSTRING ← "
")
(create MB.NWAY
MBBUTTONS ← (QUOTE (Left Right Centered Justified)))
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← "Page Heading")
(create MB.TEXT
MBSTRING ← " type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
Line leading:"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "pts Para Leading:"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "pts Special Locn: X"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "picas, Y"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "picas
New Page: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.3STATE
MBLABEL ← "Before")
(create MB.TEXT
MBSTRING ← " ")
(create MB.3STATE
MBLABEL ← "After")
(create MB.TEXT
MBSTRING ← " Display mode: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.3STATE
MBLABEL ← "Hardcopy")
(create MB.TEXT
MBSTRING ← " Keep: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.3STATE
MBLABEL ← "Heading")
(create MB.TEXT
MBSTRING ← "
Tab Type: "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
[create MB.NWAY
MBBUTTONS ← (QUOTE ((Left \TEDIT.TABTYPE.SET)
(Right \TEDIT.TABTYPE.SET)
(Centered \TEDIT.TABTYPE.SET)
(Decimal \TEDIT.TABTYPE.SET]
(create MB.TEXT
MBSTRING ← " ")
(create MB.TOGGLE
MBTEXT ← "Dotted Leader"
MBCHANGESTATEFN ← (FUNCTION \TEDIT.RECORD.TABLEADERS))
(create MB.TEXT
MBSTRING ← " Default Tab Size:"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8))
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
")
(create MB.MARGINBAR)
(create MB.TEXT
MBSTRING ← "
")))
(* * Page-layout menu for columns, page headings, page numbers, etc.)
(SETQ TEDIT.PAGEMENU.SPEC (APPEND (LIST (create MB.BUTTON
MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (QUOTE
\TEDIT.APPLY.PAGEFORMATTING
))
(create MB.TEXT
MBSTRING ← " "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(create MB.BUTTON
MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (QUOTE
\TEDIT.SHOW.PAGEFORMATTING
))
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "For page: ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (First%(&Default%) Other% Left
Other% Right)))
(create MB.TEXT
MBSTRING ← "
Starting Page #: ")
(create MB.INSERT
MBINITENTRY ← 1)
(create MB.TEXT
MBSTRING ← " Paper Size: ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (Letter Legal A4))
MBINITSTATE ← (QUOTE Letter))
(create MB.TEXT
MBSTRING ← " ")
(create MB.TOGGLE
MBTEXT ← "Landscape")
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Page numbers: ")
(create MB.TEXT
MBSTRING ← " "
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(create MB.NWAY
MBBUTTONS ← (QUOTE (No Yes))
MBINITSTATE ← (QUOTE Yes))
(create MB.TEXT
MBSTRING ← " ")
(create MB.TEXT
MBSTRING ← "X: ")
(create MB.INSERT
MBINITENTRY ← 25.5)
(create MB.TEXT
MBSTRING ← " ")
(create MB.TEXT
MBSTRING ← "Y: ")
(create MB.INSERT
MBINITENTRY ← 3)
(create MB.TEXT
MBSTRING ← " Format: ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (123 xiv XIV))
MBINITSTATE ← (QUOTE 123))
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Alignment: ")
(create MB.NWAY
MBBUTTONS ← (QUOTE (Left Centered Right))
MBINITSTATE ← (QUOTE Centered))
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← " Text before number: ")
(create MB.INSERT
MBINITENTRY ← "")
(create MB.TEXT
MBSTRING ← " Text after number: ")
(create MB.INSERT
MBINITENTRY ← "")
(create MB.TEXT
MBSTRING ← "
"))
(LIST (create MB.TEXT
MBSTRING ← "Margins: Left")
(create MB.INSERT
MBINITENTRY ← 6)
(create MB.TEXT
MBSTRING ← " Right")
(create MB.INSERT
MBINITENTRY ← 6)
(create MB.TEXT
MBSTRING ← " Top")
(create MB.INSERT
MBINITENTRY ← 6)
(create MB.TEXT
MBSTRING ← " Bottom")
(create MB.INSERT
MBINITENTRY ← 6)
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Columns: ")
(create MB.INSERT
MBINITENTRY ← 1)
(create MB.TEXT
MBSTRING ← " Col Width: ")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Space between cols: ")
(create MB.INSERT
MBINITENTRY ← 1)
(create MB.TEXT
MBSTRING ← "
")
(create MB.TEXT
MBSTRING ← "Page Headings:"
MBFONT ← (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(create MB.TEXT
MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← "
Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Heading Type:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " X:")
(create MB.INSERT)
(create MB.TEXT
MBSTRING ← " Y:")
(create MB.INSERT])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\TEDIT.MENU.INIT)
(\TEDITMENU.CREATE)
(\TEDIT.CHARLOOKSMENU.CREATE)
(\TEDITPARAMENU.CREATE)
(\TEDITPAGEMENU.CREATE)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TEDITMENU COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5507 27879 (MB.BUTTONEVENTINFN 5517 . 6680) (MB.DISPLAY 6682 . 9240) (MB.SETIMAGE 9242
. 10120) (MB.SELFN 10122 . 11169) (MB.SIZEFN 11171 . 12112) (MB.WHENOPERATEDFN 12114 . 12432) (
MB.COPYFN 12434 . 12871) (MB.GETFN 12873 . 13480) (MB.PUTFN 13482 . 14089) (MB.SHOWSELFN 14091 . 14831
) (MBUTTON.CREATE 14833 . 15931) (MBUTTON.CHANGENAME 15933 . 16375) (MBUTTON.FIND.BUTTON 16377 . 17263
) (MBUTTON.FIND.NEXT.BUTTON 17265 . 18422) (MBUTTON.FIND.NEXT.FIELD 18424 . 21086) (MBUTTON.INIT 21088
. 21655) (MBUTTON.NEXT.FIELD.AS.NUMBER 21657 . 21971) (MBUTTON.NEXT.FIELD.AS.TEXT 21973 . 22368) (
MBUTTON.NEXT.FIELD.AS.ATOM 22370 . 23198) (MBUTTON.SET.FIELD 23200 . 24288) (MBUTTON.SET.NEXT.FIELD
24290 . 25435) (MBUTTON.SET.NEXT.BUTTON.STATE 25437 . 25945) (TEDITMENU.STREAM 25947 . 26523) (
\TEDITMENU.SELSCREENER 26525 . 27877)) (28171 37288 (MB.CREATE.THREESTATEBUTTON 28181 . 29538) (
MB.THREESTATE.DISPLAY 29540 . 31786) (MB.THREESTATE.SHOWSELFN 31788 . 34033) (
MB.THREESTATE.WHENOPERATEDFN 34035 . 35044) (MB.THREESTATEBUTTON.FN 35046 . 35988) (THREESTATE.INIT
35990 . 37286)) (37379 54136 (MB.CREATE.NWAYBUTTON 37389 . 40839) (MB.NB.DISPLAYFN 40841 . 42824) (
MB.NB.WHENOPERATEDFN 42826 . 43642) (MB.NB.SIZEFN 43644 . 46640) (MB.NWAYBUTTON.SELFN 46642 . 48199) (
MB.NWAYMENU.NEWBUTTON 48201 . 48842) (NWAYBUTTON.INIT 48844 . 49831) (MB.NB.PACKITEMS 49833 . 51370) (
MB.NWAYBUTTON.ADDITEM 51372 . 54134)) (54378 63586 (\TEXTMENU.TOGGLE.CREATE 54388 . 55972) (
\TEXTMENU.TOGGLE.DISPLAY 55974 . 58176) (\TEXTMENU.TOGGLE.SHOWSELFN 58178 . 59822) (
\TEXTMENU.TOGGLE.WHENOPERATEDFN 59824 . 60842) (\TEXTMENU.TOGGLEFN 60844 . 61779) (
\TEXTMENU.TOGGLE.INIT 61781 . 62750) (\TEXTMENU.SET.TOGGLE 62752 . 63584)) (63826 90575 (
DRAWMARGINSCALE 63836 . 66075) (MARGINBAR 66077 . 71506) (MARGINBAR.CREATE 71508 . 73886) (
MB.MARGINBAR.SELFN 73888 . 81625) (MB.MARGINBAR.SIZEFN 81627 . 81915) (MB.MARGINBAR.DISPLAYFN 81917 .
84220) (MDESCALE 84222 . 84635) (MSCALE 84637 . 84901) (MB.MARGINBAR.SHOWTAB 84903 . 86865) (
MB.MARGINBAR.TABTRACK 86867 . 87748) (\TEDIT.TABTYPE.SET 87750 . 89536) (MARGINBAR.INIT 89538 . 90573)
) (91921 106579 (\TEXTMENU.START 91931 . 94192) (\TEXTMENU.DOC.CREATE 94194 . 104848) (
TEXTMENU.CLOSEFN 104850 . 106577)) (107039 118854 (\TEDITMENU.CREATE 107049 . 107349) (
\TEDIT.EXPANDED.MENU 107351 . 108061) (MB.DEFAULTBUTTON.FN 108063 . 110662) (
\TEDITMENU.RECORD.UNFORMATTED 110664 . 110999) (MB.DEFAULTBUTTON.ACTIONFN 111001 . 118852)) (118855
139110 (\TEDIT.CHARLOOKSMENU.CREATE 118865 . 119855) (\TEDIT.EXPANDEDCHARLOOKS.MENU 119857 . 120122) (
\TEDIT.APPLY.BOLDNESS 120124 . 120463) (\TEDIT.APPLY.CHARLOOKS 120465 . 122071) (\TEDIT.APPLY.OLINE
122073 . 122408) (\TEDIT.SHOW.CHARLOOKS 122410 . 123774) (\TEDIT.NEUTRALIZE.CHARLOOKS 123776 . 124655)
(\TEDIT.FILL.IN.CHARLOOKS.MENU 124657 . 129941) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 129943 . 132099) (
\TEDIT.PARSE.CHARLOOKS.MENU 132101 . 138087) (\TEDIT.APPLY.SLOPE 138089 . 138426) (
\TEDIT.APPLY.STRIKEOUT 138428 . 138769) (\TEDIT.APPLY.ULINE 138771 . 139108)) (139111 165705 (
\TEDITPARAMENU.CREATE 139121 . 139431) (\TEDIT.EXPANDEDPARA.MENU 139433 . 139699) (
\TEDIT.APPLY.PARALOOKS 139701 . 151106) (\TEDIT.SHOW.PARALOOKS 151108 . 160296) (
\TEDIT.NEUTRALIZE.PARALOOKS.MENU 160298 . 164510) (\TEDIT.RECORD.TABLEADERS 164512 . 165703)) (165706
191738 (\TEDIT.SHOW.PAGEFORMATTING 165716 . 177274) (\TEDITPAGEMENU.CREATE 177276 . 177882) (
\TEDIT.APPLY.PAGEFORMATTING 177884 . 187022) (TEDIT.UNPARSE.PAGEFORMAT 187024 . 191736)) (192038
220363 (\TEDIT.MENU.INIT 192048 . 220361)))))
STOP