(FILECREATED " 4-Dec-84 10:05:32" {IVY}<TEDIT>TEDITMENU.;6 142175
changes to: (FNS \TEXTMENU.DOC.CREATE)
previous date: "28-Nov-84 18:26:17" {IVY}<TEDIT>TEDITMENU.;5)
(* Copyright (c) 1983, 1984 by John Sybalsky & Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TEDITMENUCOMS)
(RPAQQ TEDITMENUCOMS [(FILES ICONW TEXTOFD TEDITLOOKS IMAGEOBJ TEDITWINDOW)
[COMS (* Simple Menu Button support)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MBUTTON))
(INITRECORDS MBUTTON)
(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
MB.DEFAULTBUTTON.ACTIONFN MBUTTON.NEXT.FIELD.AS.NUMBER MBUTTON.NEXT.FIELD.AS.TEXT
MBUTTON.NEXT.FIELD.AS.ATOM MBUTTON.SET.FIELD MBUTTON.SET.NEXT.FIELD
TEDITMENU.STREAM \TEDITMENU.RECORD.UNFORMATTED \TEDITMENU.SELSCREENER)
(GLOBALVARS MBUTTONIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT]
[COMS (* Three-state (ON-OFF-NEUTRAL)
menu buttons, for, e.g., character properties like BOLD)
(FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN
MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT]
[COMS (* One-of-N Menu button sets)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS NWAYBUTTON))
(INITRECORDS NWAYBUTTON)
(FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN
MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS
MB.NWAYBUTTON.ADDITEM)
(GLOBALVARS NWAYBUTTONIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT]
[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]
[COMS (* Margin Setting and display)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS MARGINBAR))
(INITRECORDS MARGINBAR)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TAB))
(FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN
MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK
\TEDIT.TABTYPE.SET MARGINBAR.INIT)
(BITMAPS \TEDIT.LEFTTAB \TEDIT.CENTERTAB \TEDIT.RIGHTTAB \TEDIT.DECIMALTAB
TEDIT.EXTENDEDRIGHTMARK)
(GLOBALVARS MARGINBARIMAGEFNS)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT]
(COMS (* Text menu creation and support)
(RECORDS MB.3STATE MB.BUTTON MB.INSERT MB.MARGINBAR MB.NWAY MB.TEXT MB.TOGGLE)
(FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN)
(BITMAPS TEXTMENUICON TEXTMENUICONMASK))
[COMS (* TEdit-specific support)
(FNS \TEDITMENU.CREATE \TEDIT.CHARLOOKSMENU.CREATE \TEDITPARAMENU.CREATE
\TEDIT.EXPANDEDPARA.MENU \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.EXPANDED.MENU
MB.DEFAULTBUTTON.FN \TEDIT.APPLY.BOLDNESS \TEDIT.APPLY.CHARLOOKS
\TEDIT.APPLY.OLINE \TEDIT.APPLY.PARALOOKS \TEDIT.SHOW.CHARLOOKS
\TEDIT.FILL.IN.CHARLOOKS.MENU \TEDIT.PARSE.CHARLOOKS.MENU \TEDIT.SHOW.PARALOOKS
\TEDIT.APPLY.SLOPE \TEDIT.APPLY.STRIKEOUT \TEDIT.APPLY.ULINE)
(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU
TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC
TEDIT.PARAMENU.SPEC)
[VARS (TEDIT.MENUDIVIDER.SPEC (LIST (CREATE MB.TEXT MBSTRING ← "
")))
(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 ← (QUOTE
\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)))
(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)))
(TEDIT.PARAMENU.SPEC (LIST (CREATE MB.BUTTON MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (QUOTE
\TEDIT.APPLY.PARALOOKS))
(CREATE MB.TEXT MBSTRING ← " ")
(CREATE MB.BUTTON MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.SHOW.PARALOOKS)
)
(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 ← "
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 ← " Default Tab Size:" MBFONT
← (FONTCREATE (QUOTE HELVETICA)
8))
(CREATE MB.INSERT)
(CREATE MB.TEXT MBSTRING ← "
")
(CREATE MB.MARGINBAR)
(CREATE MB.TEXT MBSTRING ← "
"]
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\TEDITMENU.CREATE)
(\TEDIT.CHARLOOKSMENU.CREATE)
(\TEDITPARAMENU.CREATE]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(FILESLOAD ICONW TEXTOFD TEDITLOOKS IMAGEOBJ TEDITWINDOW)
(* Simple Menu Button support)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD MBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM)
(OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
(QUOTE MB.DISPLAY))
(EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
(QUOTE MB.THREESTATE.DISPLAY))
(EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
(QUOTE \TEXTMENU.TOGGLE.DISPLAY])
]
)
(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 "28-Aug-84 14:50")
(* Display the innards of a menu button)
(SELECTQ MODE
[DISPLAY (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]
((PRESS INTERPRESS)
(PROG (BITMAP DS (FONT (IMAGEOBJPROP OBJ (QUOTE MBFONT)))
(TEXT (IMAGEOBJPROP OBJ (QUOTE MBTEXT)))
OLOOKS)
(SETQ OLOOKS (DSPFONT (FONTCOPY FONT (QUOTE DEVICE)
(QUOTE PRESS))
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.)
))
NIL])
(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 (if CH#
then (\CHTOPCNO CH# PCTB)
else \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]
(if [AND OBJ (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ (QUOTE MBTEXT]
then (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#) (* gbn "27-Sep-84 01:45")
(* 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 (SUB1 LEN]
(replace DCH of SCRATCHSEL with LEN)
(replace SELOBJ of SCRATCHSEL with NIL)
(replace POINT of SCRATCHSEL with (QUOTE LEFT))
(* So if it's used, it'll be in the correct spot.)
(replace SELKIND of SCRATCHSEL with (QUOTE CHAR)))
(T (* No fill-in blank found, so return an indication.)
(RETURN NIL)))
(\FIXSEL SCRATCHSEL TEXTOBJ)
(RETURN SCRATCHSEL])
(MBUTTON.INIT
[LAMBDA NIL (* jds "23-May-84 11:39")
(SETQ MBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAY)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
(FUNCTION MB.GETFN)
(QUOTE MB.COPYFN)
(FUNCTION MB.BUTTONEVENTINFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(FUNCTION MB.WHENOPERATEDFN)
(QUOTE NIL])
(MB.DEFAULTBUTTON.ACTIONFN
[LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* jds "28-Nov-84 16:29")
(* MBFN for TEdit default menu item buttons.)
(PROG (OFILE CH #COPIES PRINTHOST)
[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 (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch CH# of SEL)))
(COND
((ZEROP (NCHARS OFILE)) (* NOTHING--HE HIT DEL.)
)
(OFILE (TEDIT.PUT MAINTEXT (MKATOM OFILE]
[Get (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch CH# of SEL)))
(COND
((ZEROP (NCHARS OFILE)) (* NOTHING--HE HIT DEL.)
)
(OFILE (TEDIT.GET MAINTEXT (MKATOM OFILE]
[Include (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
(fetch CH# of SEL)))
(COND
((ZEROP (NCHARS OFILE)) (* NOTHING--HE HIT DEL.)
)
(T (TEDIT.INCLUDE MAINTEXT (MKATOM OFILE]
[Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch CH#
of SEL)))
(COND
((ZEROP (NCHARS OFILE)) (* NOTHING--HE HIT DEL.)
)
(OFILE (* There's something to do. Go do it.)
(TEDIT.PROMPTPRINT MAINTEXT "Searching..." T)
[SETQ CH (CAR (ERSETQ (TEDIT.FIND MAINTEXT OFILE NIL NIL T]
(COND
(CH (* We found the target text.)
(TEDIT.PROMPTPRINT MAINTEXT "Done.")
(\SHOWSEL MAINSEL NIL NIL)
(replace CH# of MAINSEL with (CAR CH))
(* Set up SELECTION to be the found text)
(replace CHLIM of MAINSEL with (CADR CH))
[replace DCH of MAINSEL
with (ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
(replace POINT of MAINSEL with (QUOTE RIGHT))
(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 (fetch \WINDOW of MAINTEXT)
T)
(replace EDITFINISHEDFLG of TEXTOBJ with T]
(CloseMenu (* He wants this expanded menu turned off.)
(TEDIT.QUIT TEXTOBJ)
(DISMISS 20))
(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 (fetch TEXTLEN of MAINTEXT))
(replace DCH of MAINSEL with (fetch TEXTLEN of MAINTEXT))
(replace POINT of MAINSEL with (QUOTE LEFT))
(replace SET of MAINSEL with T)
(\FIXSEL MAINSEL MAINTEXT)
(\SHOWSEL MAINSEL NIL T]
[Hardcopy (SETQ PRINTHOST (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
(fetch CH#
of SEL)))
(COND
((ZEROP (NCHARS PRINTHOST))
(* If he didn't specify a particular host, defer to his
defaults.)
(TEDIT.PROMPTPRINT MAINTEXT "Using default print server.")
(SETQ PRINTHOST NIL)))
[SETQ #COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ
(fetch CH#
of (fetch SCRATCHSEL
of TEXTOBJ]
(TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST
(AND #COPIES (NOT (ZEROP #COPIES))
(LIST (QUOTE #COPIES)
#COPIES]
(ERROR]
(replace SET of SEL with T)
(replace ONFLG of SEL with T)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL])
(MBUTTON.NEXT.FIELD.AS.NUMBER
[LAMBDA (TEXTOBJ CH#) (* jds "31-Jul-84 13:30")
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
(NUMBERP (MKATOM (TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ])
(MBUTTON.NEXT.FIELD.AS.TEXT
[LAMBDA (TEXTOBJ CH#) (* jds "25-AUG-83 09:32")
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
(TEDIT.SEL.AS.STRING (fetch STREAMHINT of TEXTOBJ)
(fetch SCRATCHSEL of TEXTOBJ])
(MBUTTON.NEXT.FIELD.AS.ATOM
[LAMBDA (TEXTOBJ CH#) (* jds "30-Aug-84 13:48")
(* 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#) (* 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))
(if PCNO
then (SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (\EDITELT PCTB PCNO)))
(* select the field following this button.)
(if FIELD.SEL
then (* 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) (* jds "17-May-84 14:02")
(* SET the text content of the next fill-in field in
this document to be NEWVALUE)
(PROG ((SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ)))
(MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) (* Find the next menu fill-in field)
(\FIXSEL SCRATCHSEL TEXTOBJ) (* Fix up the SELECTION that describes its contents, so
we've got the right screen coordinates &c)
(OR (ZEROP (fetch DCH of SCRATCHSEL))
(\TEDIT.DELETE SCRATCHSEL TEXTOBJ T)) (* If there is text in that fill-in, delete it to make
room for ours)
(COND
(NEWVALUE (* Only insert something if there IS something to
insert.)
(TEDIT.\INSERT (MKSTRING NEWVALUE)
SCRATCHSEL TEXTOBJ))) (* Then fill it with out new value.)
])
(TEDITMENU.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.RECORD.UNFORMATTED
[LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* gbn "25-Sep-84 00:38")
(PROG ((FLG (COND
((EQ NEWSTATE (QUOTE ON))
T)
(T NIL)))
(TEXTOBJ (\TEDIT.MAINW TEXTSTREAM)))
(TEXTPROP TEXTOBJ (QUOTE CLEARPUT)
FLG)
(TEXTPROP TEXTOBJ (QUOTE CLEARGET)
FLG])
(\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)
)
(* Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD)
(DEFINEQ
(MB.CREATE.THREESTATEBUTTON
[LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* gbn "24-Sep-84 15:05")
(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 OFF)))
(SETQ BITMAP (BITMAPCREATE X Y))
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
BITMAP)
(SETQ DS (DSPCREATE BITMAP))
(DSPXOFFSET 0 DS)
(DSPYOFFSET 0 DS)
(DSPFONT FONT DS)
(MOVETO 0 (FONTPROP FONT (QUOTE DESCENT))
DS)
(PRIN1 (IMAGEOBJPROP OBJ (QUOTE MBTEXT))
DS)
(RETURN OBJ])
(MB.THREESTATE.DISPLAY
[LAMBDA (OBJ STREAM MODE) (* jds "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 "23-May-84 11:39")
(SETQ THREESTATEIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.THREESTATE.DISPLAY)
(FUNCTION MB.SIZEFN)
(FUNCTION MB.PUTFN)
(FUNCTION MB.GETFN)
(QUOTE MB.COPYFN)
(FUNCTION MB.BUTTONEVENTINFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(FUNCTION MB.THREESTATE.WHENOPERATEDFN)
(QUOTE NILL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(THREESTATE.INIT)
)
(* One-of-N Menu button sets)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD NWAYBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM)
(EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
(QUOTE MB.NB.DISPLAYFN])
]
)
(DEFINEQ
(MB.CREATE.NWAYBUTTON
[LAMBDA (BUTTONS FONT 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 "23-May-84 11:40")
(SETQ NWAYBUTTONIMAGEFNS (IMAGEFNSCREATE (QUOTE MB.NB.DISPLAYFN)
(QUOTE MB.NB.SIZEFN)
(QUOTE MB.PUTFN)
(QUOTE MB.GETFN)
(QUOTE MB.COPYFN)
(QUOTE MB.NWAYBUTTON.SELFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE MB.NB.WHENOPERATEDFN)
(QUOTE NILL])
(MB.NB.PACKITEMS
[LAMBDA (WIDTH ITEMWIDTHS SPACING 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 " 6-Sep-84 13:04")
(* 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)
(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)
)
(* 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 "17-Aug-84 15:11")
(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 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 (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]
(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) (* gbn "24-Sep-84 23:01")
(* 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)))
(if STATECHANGEFN
then (* apply the user supplied state change fn if he
supplied one)
(APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ)))
(IMAGEOBJPROP OBJ (QUOTE STATE)
NEWSTATE)
(replace ONFLG of SEL with NIL])
(\TEXTMENU.TOGGLE.INIT
[LAMBDA NIL (* jds "17-Aug-84 14:59")
(SETQ \TOGGLEIMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEXTMENU.TOGGLE.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 \TEXTMENU.TOGGLE.WHENOPERATEDFN)
(QUOTE NILL])
(\TEXTMENU.SET.TOGGLE
[LAMBDA (TEXT VALUE TEXTSTREAM) (* gbn "27-Sep-84 02:19")
(* * finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state to VALUE)
(PROG ((PCNO (MBUTTON.FIND.BUTTON TEXT TEXTSTREAM))
OBJ PC)
(if (NOT PCNO)
then (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))
(\TEDIT.REPAINTFN (fetch \WINDOW of (TEXTOBJ TEXTSTREAM)))
(RETURN VALUE])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TOGGLEIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\TEXTMENU.TOGGLE.INIT)
)
(* Margin Setting and display)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE)
[TYPE? (AND (IMAGEOBJP DATUM)
(EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN))
(QUOTE MB.MARGINBAR.DISPLAYFN])
]
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD TAB (TABX . TABKIND))
]
)
(DEFINEQ
(DRAWMARGINSCALE
[LAMBDA (W UNIT) (* jds " 4-NOV-83 16:03")
(PROG ((WREG (DSPCLIPPINGREGION NIL W))
(OLDOP (DSPOPERATION (QUOTE REPLACE)
W)))
(DSPFILL (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch WIDTH of WREG)
HEIGHT ← 24)
WHITESHADE
(QUOTE REPLACE)
W)
(SELECT UNIT [1 (* Straight Points)
(for X from 4 by 3 to (fetch WIDTH of WREG)
do (COND
((ZEROP (IREMAINDER (IDIFFERENCE X 4)
72))
(BITBLT NIL 0 0 W X 8 1 16 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH (IDIFFERENCE X 4))
1))
10 W)
(PRIN1 (IDIFFERENCE X 4)
W))
(T (BITBLT NIL 0 0 W X 20 1 4 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE]
(12 (* Picas)
(for X from 4 by UNIT to (fetch WIDTH of WREG) as NOMX from 0
do (COND
((ZEROP (IREMAINDER NOMX 6))
(BITBLT NIL 0 0 W X 8 1 16 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH NOMX)
1))
10 W)
(PRIN1 NOMX W))
(T (BITBLT NIL 0 0 W X 20 1 4 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)))
(BITBLT NIL 0 0 W (IPLUS X 6)
22 1 2 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)))
NIL)
(BITBLT NIL 0 0 W 4 23 (fetch WIDTH of WREG)
1
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(MOVETO 0 0 W)
(RELDRAWTO (IDIFFERENCE (fetch WIDTH of WREG)
2)
0 1 (QUOTE PAINT)
W)
(RELDRAWTO 0 (IDIFFERENCE (fetch HEIGHT of WREG)
2)
1
(QUOTE PAINT)
W)
(RELDRAWTO (IMINUS (IDIFFERENCE (fetch WIDTH of WREG)
2))
0 1 (QUOTE PAINT)
W)
(RELDRAWTO 0 (IMINUS (IDIFFERENCE (fetch HEIGHT of WREG)
2))
1
(QUOTE PAINT)
W)
(DSPOPERATION OLDOP W])
(MARGINBAR
[LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* jds "17-May-84 16:42")
(* Given a set of margins and a unit, show the margin
bar properly)
(PROG ((OLDOP (DSPOPERATION (QUOTE ERASE)
W))
(SCALEDL1 (MSCALE L1 UNIT))
(SCALEDLN (MSCALE LN UNIT))
(SCALEDR (MSCALE R UNIT))
(FLOATINGRIGHT NIL)
(EXTENDEDRIGHT NIL)
UNSETL1 UNSETLN)
(OR UPDATE (DRAWMARGINSCALE W UNIT))
(DSPFONT (FONTCREATE (QUOTE GACHA)
10)
W)
(SETQ L1 (MKSTRING (ABS L1)))
(SETQ LN (MKSTRING (ABS LN)))
(SETQ R (MKSTRING (ABS R)))
[COND
[(ILESSP SCALEDR 4) (* Unset right margin. Show specially, but at its usual
place.)
(SETQ FLOATINGRIGHT T)
(SETQ SCALEDR (IPLUS 4 (IDIFFERENCE 4 SCALEDR]
((ILEQ SCALEDR 4) (* Floating right margin => marked specially)
(SETQ FLOATINGRIGHT T)
(SETQ SCALEDR RIGHTLIM))
((IGREATERP SCALEDR RIGHTLIM) (* Not floating, so just limit it to the rightmost that
can be seen.)
(SETQ EXTENDEDRIGHT T)
(SETQ SCALEDR (IDIFFERENCE RIGHTLIM 8]
[COND
((ILESSP SCALEDL1 4) (* Unset right FIRST LEFT margin.
Show specially, but at its usual place.)
(SETQ UNSETL1 T)
(SETQ SCALEDL1 (IPLUS 4 (IDIFFERENCE 4 SCALEDL1]
[COND
((ILESSP SCALEDLN 4) (* Unset LEFT margin. Show specially, but at its usual
place.)
(SETQ UNSETLN T)
(SETQ SCALEDLN (IPLUS 4 (IDIFFERENCE 4 SCALEDLN]
(BITBLT NIL 0 0 W 1 26 (IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL W))
3)
32
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(BITBLT NIL 0 0 W SCALEDL1 42 (IDIFFERENCE SCALEDR SCALEDL1)
16
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(BITBLT NIL 0 0 W SCALEDLN 26 (IDIFFERENCE SCALEDR SCALEDLN)
16
(QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)
(COND
(UNSETL1 (* 1st left margin isn't set, tho it has a value.
Mark it neutral)
(BITBLT NIL 0 0 W SCALEDL1 42 (IPLUS (STRINGWIDTH L1 W)
2)
16
(QUOTE TEXTURE)
(QUOTE REPLACE)
EDITGRAY)
(DSPOPERATION (QUOTE PAINT)
W)
(MOVETO (IPLUS SCALEDL1 2)
44 W)
(PRIN1 L1 W)
(DSPOPERATION (QUOTE ERASE)
W))
(T (MOVETO (IPLUS SCALEDL1 2)
44 W)
(PRIN1 L1 W)))
(COND
(UNSETLN (* left margin isn't set, tho it has a value.
Mark it neutral)
(BITBLT NIL 0 0 W SCALEDLN 26 (IPLUS (STRINGWIDTH LN W)
2)
16
(QUOTE TEXTURE)
(QUOTE REPLACE)
EDITGRAY)
(DSPOPERATION (QUOTE PAINT)
W)
(MOVETO (IPLUS SCALEDLN 2)
28 W)
(PRIN1 LN W)
(DSPOPERATION (QUOTE ERASE)
W))
(T (MOVETO (IPLUS SCALEDLN 2)
28 W)
(PRIN1 LN W)))
[COND
(FLOATINGRIGHT (* Floating right margin is marked by a light gray
marker)
(BITBLT NIL 0 0 W (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W)
2))
26
(IPLUS (STRINGWIDTH R W)
2)
32
(QUOTE TEXTURE)
(QUOTE REPLACE)
EDITGRAY)
(DSPOPERATION (QUOTE PAINT)
W))
(EXTENDEDRIGHT (* A non-visible right margin is marked by two wavy
lines indicating a break)
(BITBLT TEDIT.EXTENDEDRIGHTMARK 0 0 W SCALEDR 26 8 32 (QUOTE INPUT)
(QUOTE REPLACE]
(MOVETO (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W)
2))
36 W)
(PRIN1 R W)
(DSPOPERATION OLDOP W)
(DSPFILL (create REGION
LEFT ← 2
BOTTOM ← 1
HEIGHT ← 8
WIDTH ←(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL W))
4))
WHITESHADE
(QUOTE REPLACE)
W)
(for TAB in TABS
do (* Run thru the tabs, putting them down in place.)
(MB.MARGINBAR.SHOWTAB W TAB UNIT (QUOTE PAINT])
(MARGINBAR.CREATE
[LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* jds " 5-Sep-84 14:08")
(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))
(SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX)
(fetch YSIZE of BOX)))
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
BITMAP)
(SETQ DS (DSPCREATE BITMAP))
(IMAGEOBJPROP OBJ (QUOTE DSPCACHE)
DS)
(DSPXOFFSET 0 DS)
(DSPYOFFSET 0 DS)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch XSIZE of BOX)
HEIGHT ←(fetch YSIZE of BOX))
DS)
(MARGINBAR DS (fetch (MARGINBAR MARL1) of OBJDATUM)
(fetch (MARGINBAR MARLN) of OBJDATUM)
(fetch (MARGINBAR MARR) of OBJDATUM)
(fetch (MARGINBAR MARTABS) of OBJDATUM)
(fetch (MARGINBAR MARUNIT) of OBJDATUM)
NIL
(fetch WIDTH of (DSPCLIPPINGREGION NIL DS)))
(RETURN OBJ])
(MB.MARGINBAR.SELFN
[LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* jds "13-Aug-84 14:05")
(* Let the user adjust margins and tabs using the
mouse.)
(PROG [(OBJDATUM (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
(IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
(IMAGEBOX OBJ STREAM (QUOTE DISPLAY]
(PROG ((L1 (fetch MARL1 of OBJDATUM))
(LN (fetch MARLN of OBJDATUM))
(R (fetch MARR of OBJDATUM))
(TABS (fetch MARTABS of OBJDATUM))
[SCALEDTABS (for TAB in (fetch MARTABS of OBJDATUM)
collect (MSCALE (fetch TABX of TAB)
(fetch MARUNIT of OBJDATUM]
(UNIT (fetch MARUNIT of OBJDATUM))
(CLIP (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch XSIZE of IMAGEBOX)
HEIGHT ←(fetch YSIZE of IMAGEBOX)))
(RIGHTLIM (IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL SELWINDOW))
4))
TAB TABX OL1 OLN OR)
(SETQ OL1 L1)
(SETQ OLN LN)
(SETQ OR R)
[COND
[(INSIDE? (create REGION
LEFT ←(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]
[(INSIDE? (create REGION
LEFT ←(IDIFFERENCE (IMIN (MSCALE (ABS R)
UNIT)
(fetch XSIZE of IMAGEBOX)
(fetch WIDTH of (DSPCLIPPINGREGION
NIL SELWINDOW)))
16)
BOTTOM ← 26
WIDTH ← 16
HEIGHT ← 32)
RELX RELY) (* Move the right margin)
(while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
(INSIDE? CLIP (LASTMOUSEX STREAM)
(LASTMOUSEY STREAM)))
do (SETQ R (MAX 0 (MDESCALE (LASTMOUSEX STREAM)
UNIT)))
[COND
((\TEDIT.MOUSESTATE RIGHT) (* Right mouse button UNsets the margin.)
(SETQ R (MINUS R]
(COND
((NOT (EQUAL OR R))
(MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM)
(SETQ OR R]
((INSIDE? (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch WIDTH of CLIP)
HEIGHT ← 16)
RELX RELY) (* We're in the tab ruler region)
(COND
((MOUSESTATE LEFT) (* MOVE a tab)
[SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
(AND TAB (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)))
[(MOUSESTATE MIDDLE) (* ADD/CHANGE a tab)
(COND
((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
(SETQ TABX (MSCALE (CAR TAB)
UNIT))
(IGEQ (LASTMOUSEX STREAM)
(IDIFFERENCE TABX 2))
(ILEQ (LASTMOUSEX STREAM)
(IPLUS TABX 2)))
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
(replace TABKIND of TAB with (OR (fetch MARTABTYPE of OBJDATUM)
(QUOTE LEFT)))
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
(MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB))
([OR (NOT TAB)
(NOT (EQP (fetch TABX of TAB)
(MDESCALE (LASTMOUSEX STREAM)
UNIT] (* Really create a new tab)
[SETQ TAB (create TAB
TABX ←(MDESCALE (LASTMOUSEX STREAM)
UNIT)
TABKIND ←(OR (fetch MARTABTYPE of OBJDATUM)
(QUOTE LEFT]
(SETQ TABS (CONS TAB TABS))
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
(MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB]
((MOUSESTATE RIGHT) (* DELETE a tab.)
(COND
((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS
smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM]
(SETQ TABX (MSCALE (CAR TAB)
UNIT))
(IGEQ (LASTMOUSEX STREAM)
(IDIFFERENCE TABX 2))
(ILEQ (LASTMOUSEX STREAM)
(IPLUS TABX 2)))
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
(SETQ TABS (LDIFFERENCE TABS (LIST TAB]
(replace MARL1 of OBJDATUM with L1)
(replace MARLN of OBJDATUM with LN)
(replace MARR of OBJDATUM with R)
(replace MARTABS of OBJDATUM with TABS)))
T])
(MB.MARGINBAR.SIZEFN
[LAMBDA (OBJ) (* jds " 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 "24-May-84 16:14")
(* Display the innards of a menu button)
(PROG ((IMAGEBOX (OR (IMAGEOBJPROP OBJ (QUOTE BOUNDBOX))
(IMAGEBOX OBJ STREAM MODE)))
(OBJDATUM (IMAGEOBJPROP OBJ (QUOTE OBJECTDATUM)))
BITMAP
(DS (DSPCREATE))
WASON)
(COND
[[SETQ WASON (SETQ BITMAP (IMAGEOBJPROP OBJ (QUOTE BITCACHE]
(* The marginbar existed already as an image. Don't bother re-creating it, and remember that we're allowed to
MODIFY the old image instead of creating a new one.)
(SETQ DS (IMAGEOBJPROP OBJ (QUOTE DSPCACHE]
(T (* Have to create an image for the margin bar)
(SETQ BITMAP (BITMAPCREATE (fetch XSIZE of IMAGEBOX)
(fetch YSIZE of IMAGEBOX)))
(IMAGEOBJPROP OBJ (QUOTE BITCACHE)
BITMAP)
(SETQ DS (DSPCREATE BITMAP))
(IMAGEOBJPROP OBJ (QUOTE DSPCACHE)
DS)
(DSPXOFFSET 0 DS)
(DSPYOFFSET 0 DS)
(DSPCLIPPINGREGION (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(fetch XSIZE of IMAGEBOX)
HEIGHT ←(fetch YSIZE of IMAGEBOX))
DS)))
(MARGINBAR DS (fetch (MARGINBAR MARL1) of OBJDATUM)
(fetch (MARGINBAR MARLN) of OBJDATUM)
(fetch (MARGINBAR MARR) of OBJDATUM)
(fetch (MARGINBAR MARTABS) of OBJDATUM)
(fetch (MARGINBAR MARUNIT) of OBJDATUM)
WASON
(fetch WIDTH of (DSPCLIPPINGREGION NIL STREAM)))
(BITBLT BITMAP 0 0 STREAM (IDIFFERENCE (DSPXPOSITION NIL STREAM)
4)
(IDIFFERENCE (DSPYPOSITION NIL STREAM)
(fetch YDESC of IMAGEBOX])
(MDESCALE
[LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:29")
(* Convert a value from screen offset units to marginbar
units)
(COND
((IEQP UNIT 12)
(QUOTIENT (IQUOTIENT (LLSH (IDIFFERENCE VAL 4)
1)
UNIT)
2.0))
(T (QUOTIENT (DIFFERENCE VAL 4)
UNIT])
(MSCALE
[LAMBDA (VAL UNIT) (* jds " 4-NOV-83 17:31")
(* Convert from marginbar units to a screen X offset)
(IPLUS 4 (FIXR (TIMES VAL (OR UNIT 1])
(MB.MARGINBAR.SHOWTAB
[LAMBDA (W TAB UNIT MODE) (* jds "22-NOV-83 11:25")
(* Paint/erase/otherwise display the sign for a TAB in
window WINDOW, using units UNIT)
(PROG ((TABX (MSCALE (fetch TABX of TAB)
UNIT)))
(SELECTQ (fetch TABKIND of TAB)
(LEFT (* Flush-left tab.)
(BITBLT \TEDIT.LEFTTAB 0 0 W (IDIFFERENCE TABX 2)
1 NIL NIL (QUOTE INPUT)
MODE))
(CENTERED (* Centered Tab)
(BITBLT \TEDIT.CENTERTAB 0 0 W (IDIFFERENCE TABX 5)
1 NIL NIL (QUOTE INPUT)
MODE))
(RIGHT (* Flush-right Tab)
(BITBLT \TEDIT.RIGHTTAB 0 0 W (IDIFFERENCE TABX 7)
1 NIL NIL (QUOTE INPUT)
MODE))
(DECIMAL (* Decimal aligned tab)
(BITBLT \TEDIT.DECIMALTAB 0 0 W (IDIFFERENCE TABX 7)
1 NIL NIL (QUOTE INPUT)
MODE))
NIL])
(MB.MARGINBAR.TABTRACK
[LAMBDA (STREAM OBJ TAB) (* jds " 8-Feb-84 20:38")
(* Given that the mouse is down over a tab, track the
tab as the mouse moves.)
(PROG ((UNIT (fetch MARUNIT of OBJ))
(CLIP (DSPCLIPPINGREGION NIL STREAM))
(OLDX (MSCALE (fetch TABX of TAB)
(fetch MARUNIT of OBJ)))
X)
(while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
(INSIDE? CLIP (LASTMOUSEX STREAM)
(LASTMOUSEY STREAM)))
do (COND
([NOT (IEQP OLDX (SETQ X (LASTMOUSEX STREAM]
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE ERASE))
(replace TABX of TAB with (MDESCALE X UNIT))
(MB.MARGINBAR.SHOWTAB STREAM TAB UNIT (QUOTE PAINT))
(SETQ OLDX X])
(\TEDIT.TABTYPE.SET
[LAMBDA (OBJ SEL W) (* jds "12-Apr-84 15:42")
(* Change the kind of TAB that will be set in the
succeeding marginbar.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(CH# (ADD1 (fetch CH# of SEL)))
STATE)
(SETQ STATE (IMAGEOBJPROP OBJ (QUOTE STATE)))
(TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO FNARG)
(COND
((AND (IGREATERP CH# (CAR FNARG))
(fetch POBJ of PC)
(type? MARGINBAR (fetch POBJ of PC)))
(replace MARTABTYPE of (IMAGEOBJPROP (fetch POBJ of PC)
(QUOTE OBJECTDATUM))
with (CDR FNARG))
(QUOTE STOP]
(CONS CH# (U-CASE (COND
((LISTP STATE)
(CAR STATE))
(T STATE])
(MARGINBAR.INIT
[LAMBDA NIL (* jds "23-May-84 11:41")
(SETQ MARGINBARIMAGEFNS (IMAGEFNSCREATE (QUOTE MB.MARGINBAR.DISPLAYFN)
(QUOTE MB.MARGINBAR.SIZEFN)
(QUOTE MB.MARGINBAR.PUTFN)
(QUOTE MB.MARGINBAR.GETFN)
(QUOTE MB.COPYFN)
(QUOTE MB.MARGINBAR.SELFN)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL)
(QUOTE NILL])
)
(RPAQ \TEDIT.LEFTTAB (READBITMAP))
(10 8
"B@@@"
"B@@@"
"G@@@"
"JH@@"
"B@@@"
"B@@@"
"CN@@"
"@@@@")
(RPAQ \TEDIT.CENTERTAB (READBITMAP))
(10 8
"@D@@"
"@D@@"
"@N@@"
"AE@@"
"@D@@"
"@D@@"
"AO@@"
"@@@@")
(RPAQ \TEDIT.RIGHTTAB (READBITMAP))
(10 8
"@A@@"
"@A@@"
"@CH@"
"@ED@"
"@A@@"
"@A@@"
"AO@@"
"@@@@")
(RPAQ \TEDIT.DECIMALTAB (READBITMAP))
(10 8
"@A@@"
"@A@@"
"@CH@"
"@ED@"
"@A@@"
"FM@@"
"FM@@"
"@@@@")
(RPAQ TEDIT.EXTENDEDRIGHTMARK (READBITMAP))
(8 32
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@"
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"CC@@"
"FF@@"
"FF@@"
"FF@@"
"FF@@"
"LL@@"
"LL@@"
"LL@@"
"LL@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS MARGINBARIMAGEFNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(MARGINBAR.INIT)
)
(* Text menu creation and support)
[DECLARE: EVAL@COMPILE
(TYPERECORD MB.3STATE (MBLABEL MBFONT MBCHANGESTATEFN MBINITSTATE)
MBFONT ←(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT)
MBBUTTONEVENTFN ←(QUOTE MB.DEFAULTBUTTON.FN)
MBFONT ←(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(TYPERECORD MB.INSERT (MBINITENTRY))
(TYPERECORD MB.MARGINBAR (ignoredfield))
(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE)
MBFONT ←(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
(TYPERECORD MB.TEXT (MBSTRING MBFONT))
(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE)
MBFONT ←(FONTCREATE (QUOTE HELVETICA)
8
(QUOTE BOLD)))
]
(DEFINEQ
(\TEXTMENU.START
[LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* jds " 6-Sep-84 12:44")
(* 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))
(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) (* jds " 3-Dec-84 17:33")
(* Create the TEXTSTREAM for a menu, given a
description. That stream is passed to \TEXTMENU.START
to get the menu up on screen)
(PROG ((CH#1 NIL)
MENUW MENUTEXT)
(SETQ MENUTEXT (OPENTEXTSTREAM "" NIL))
(bind (CH# ← 1)
OBJ for DESC in MENUDESC
do (SELECTQ (CAR DESC) (* (* This is a comment within a menu description --
Ignore it.))
(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 0 0 0 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)
(replace EDITPROPS of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)
with (AND CH#1 (LIST (QUOTE SEL)
CH#1))) (* And where the first selection should be.)
(RETURN MENUTEXT])
(TEXTMENU.CLOSEFN
[LAMBDA (W) (* jds " 6-Aug-84 14:02")
(* Given the menu window, see if it's time to QUIT out
of this edit process)
(PROG ((MAINW (WINDOWPROP W (QUOTE MAINWINDOW)))
TEXTOBJ)
(DETACHWINDOW W) (* So detach this window.)
(COND
((SETQ TEXTOBJ (WINDOWPROP W (QUOTE TEXTOBJ))) (* Then, if this window still has a textobj under it,
kill off that edit process.)
(TEDIT.KILL TEXTOBJ)
(* This has to be TEDIT.KILL to avoid problems with the TTY being handed from main back to menu, causing main
never to finish off; menu would quit and hand TTY to top level window.)
])
)
(RPAQ TEXTMENUICON (READBITMAP))
(16 24
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@A"
"K@@G"
"HLAI"
"HCFA"
"J@HA"
"KFKI"
"JJJA"
"JBKI"
"JBJA"
"H@KI"
"JDHA"
"KDJI"
"JLJI"
"JDJI"
"JDJI"
"H@KI"
"F@HF"
"AHIH"
"@FN@"
"@@H@")
(RPAQ TEXTMENUICONMASK (READBITMAP))
(16 24
"@@@@"
"@@@@"
"@@@@"
"H@@@"
"L@@A"
"O@@G"
"OLAO"
"OOGO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"OOOO"
"GOON"
"AOOH"
"@GN@"
"@@H@")
(* TEdit-specific support)
(DEFINEQ
(\TEDITMENU.CREATE
[LAMBDA NIL (* gbn "27-Sep-84 01:04")
(* Creates the TEdit Expanded Menu)
(SETQ TEDIT.EXPANDED.MENU (\TEXTMENU.DOC.CREATE TEDIT.EXPANDEDMENU.SPEC])
(\TEDIT.CHARLOOKSMENU.CREATE
[LAMBDA NIL (* gbn "27-Sep-84 16:01")
(* 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 ← "
"))
TEDIT.CHARLOOKSMENU.SPEC])
(\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.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.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 "21-May-84 16:52")
(* MBFN for TEdit default menu item buttons.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
OFILE CH MAINSEL PROC)
(SETQ MAINSEL (fetch SEL of MAINTEXT))
(COND
((EQ (fetch EDITOPACTIVE of MAINTEXT)
T)
(TEDIT.PROMPTPRINT MAINTEXT "Edit operation in progress; please wait." T)
(RETURN))
((fetch EDITOPACTIVE of MAINTEXT)
(TEDIT.PROMPTPRINT MAINTEXT (CONCAT (fetch EDITOPACTIVE of MAINTEXT)
" operation in progress; please wait.")
T)
[AND (NEQ (fetch EDITOPACTIVE of MAINTEXT)
(IMAGEOBJPROP OBJ (QUOTE MBTEXT]
(RETURN)))
[COND
((AND (SETQ PROC (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE PROCESS)))
(PROCESSP PROC)) (* THE MAIN window has a live process behind it;
go evaluate the button fn there.)
(PROCESS.EVAL PROC (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXT MAINSEL)))
((AND (SETQ PROC (WINDOWPROP W (QUOTE PROCESS)))
(PROCESSP PROC)) (* This window has a live process behind it;
go evaluate the button fn there.)
(PROCESS.EVAL PROC (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXT MAINSEL)))
(T (ADD.PROCESS (LIST (QUOTE MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXT MAINSEL]
(COND
((fetch EDITFINISHEDFLG of TEXTOBJ)
(GIVE.TTY.PROCESS W)
(DISMISS 20)))
[COND
((OR (fetch EDITFINISHEDFLG of TEXTOBJ)
(EQ (WINDOWPROP W (QUOTE PROCESS))
(TTY.PROCESS))) (* If the TEDIT MENU still has the tty, give it back to
the real TEdit.)
(SETQ TEDIT.SELPENDING NIL)
(GIVE.TTY.PROCESS (WINDOWPROP W (QUOTE MAINWINDOW]
(* Tell the menu button handler not to turn off this
button--it's still active and will turn itself off.)
(RETURN (QUOTE DON'T])
(\TEDIT.APPLY.BOLDNESS
[LAMBDA (BUTTON NEWLOOKS) (* jds "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 " 2-Aug-84 10:11")
(* 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 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.APPLY.PARALOOKS
[LAMBDA (OBJ SEL W) (* jds " 5-Sep-84 14:20")
(* 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 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] (* Now find which text button was "on")
[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)) (* This paragraph IS NOT a page heading.)
(SETQ NEWLOOKS (CONS (QUOTE NEWPAGEAFTER)
(CONS NIL NEWLOOKS]
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
(SETQ BUTTON (CAR NEXTB))
(SETQ DEFAULTTAB (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (CDR NEXTB)))
(while (NOT (type? MARGINBAR BUTTON))
do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch CH# of SCRATCHSEL)))
(SETQ BUTTON (CAR NEXTB)))
(SETQ BUTTONDATA (IMAGEOBJPROP BUTTON (QUOTE OBJECTDATUM)))
[COND
((IGEQ [SETQ L1 (FIXR (TIMES (fetch MARL1 of BUTTONDATA)
(fetch MARUNIT of BUTTONDATA]
0) (* The 1stleftmargin is set, and non-neutral.)
(SETQ NEWLOOKS (CONS (QUOTE 1STLEFTMARGIN)
(CONS L1 NEWLOOKS]
[COND
((IGEQ [SETQ LN (FIXR (TIMES (fetch MARLN of BUTTONDATA)
(fetch MARUNIT of BUTTONDATA]
0) (* The LEFTMARGIN is set, and non-neutral.)
(SETQ NEWLOOKS (CONS (QUOTE LEFTMARGIN)
(CONS LN NEWLOOKS]
[COND
((IGEQ [SETQ R (FIXR (TIMES (fetch MARR of BUTTONDATA)
(fetch MARUNIT of BUTTONDATA]
0) (* The RIGHTMARGIN is set, and non-neutral.)
(SETQ NEWLOOKS (CONS (QUOTE RIGHTMARGIN)
(CONS R NEWLOOKS]
(SETQ NEWLOOKS
(CONS (QUOTE TABS)
(CONS [CONS DEFAULTTAB (SORT (for TAB in (fetch MARTABS of BUTTONDATA)
collect (CONS (FIXR (TIMES (CAR TAB)
(fetch MARUNIT
of BUTTONDATA)))
(CDR TAB)))
(FUNCTION (LAMBDA (A B)
(ILEQ (CAR A)
(CAR B]
NEWLOOKS)))
(TEDIT.PARALOOKS MAINTEXT NEWLOOKS (fetch CH# of (fetch SEL of MAINTEXT))
(fetch DCH of (fetch SEL of MAINTEXT)))
(\SHOWSEL SEL NIL NIL)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE PROCESS])
(\TEDIT.SHOW.CHARLOOKS
[LAMBDA (OBJ SEL W) (* jds " 2-Aug-84 09:37")
(* MBFN for TEdit default menu item buttons.)
(PROG ((TEXTOBJ (fetch \TEXTOBJ of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W (QUOTE MAINWINDOW))
(QUOTE TEXTOBJ)))
(CH# (ADD1 (fetch CH# of SEL)))
PC SCRATCHSEL OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET)
(\SHOWSEL SEL NIL NIL)
(replace SET of SEL with NIL)
(SETQ 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.FILL.IN.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH# NEWLOOKS) (* jds "17-Sep-84 13:57")
(* 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 (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 (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.PARSE.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH#) (* jds "17-Sep-84 14:14")
(* 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]
(PROGN (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.SHOW.PARALOOKS
[LAMBDA (OBJ SEL W) (* jds "25-Nov-84 14:00")
(* 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 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 SCRATCHSEL (fetch SCRATCHSEL of TEXTOBJ))
[SETQ FMTSPEC (fetch PPARALOOKS of (\CHTOPC [IMAX 1 (IMIN (fetch TEXTLEN of MAINTEXT)
(fetch CH#
of (fetch SEL of MAINTEXT]
(fetch PCTB of MAINTEXT]
(* Get to the start of the text.)
(SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))
(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]
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR 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.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])
)
(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)
)
(RPAQ TEDIT.MENUDIVIDER.SPEC (LIST (CREATE MB.TEXT MBSTRING ← "
")))
(RPAQ 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 ←
(QUOTE \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)))
(RPAQ 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)))
(RPAQ TEDIT.PARAMENU.SPEC (LIST (CREATE MB.BUTTON MBLABEL ← (QUOTE APPLY)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.APPLY.PARALOOKS))
(CREATE MB.TEXT MBSTRING ← " ")
(CREATE MB.BUTTON MBLABEL ← (QUOTE SHOW)
MBBUTTONEVENTFN ← (QUOTE \TEDIT.SHOW.PARALOOKS))
(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 ← "
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 ← " Default Tab Size:" MBFONT ←
(FONTCREATE (QUOTE HELVETICA)
8))
(CREATE MB.INSERT)
(CREATE MB.TEXT MBSTRING ← "
")
(CREATE MB.MARGINBAR)
(CREATE MB.TEXT MBSTRING ← "
")))
(DECLARE: DONTEVAL@LOAD DOCOPY
(\TEDITMENU.CREATE)
(\TEDIT.CHARLOOKSMENU.CREATE)
(\TEDITPARAMENU.CREATE)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TEDITMENU COPYRIGHT ("John Sybalsky & Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9697 37355 (MB.BUTTONEVENTINFN 9707 . 10870) (MB.DISPLAY 10872 . 12385) (MB.SETIMAGE
12387 . 13265) (MB.SELFN 13267 . 14314) (MB.SIZEFN 14316 . 15257) (MB.WHENOPERATEDFN 15259 . 15577) (
MB.COPYFN 15579 . 16016) (MB.GETFN 16018 . 16625) (MB.PUTFN 16627 . 17234) (MB.SHOWSELFN 17236 . 17976
) (MBUTTON.CREATE 17978 . 19076) (MBUTTON.CHANGENAME 19078 . 19520) (MBUTTON.FIND.BUTTON 19522 . 20421
) (MBUTTON.FIND.NEXT.BUTTON 20423 . 21523) (MBUTTON.FIND.NEXT.FIELD 21525 . 24151) (MBUTTON.INIT 24153
. 24625) (MB.DEFAULTBUTTON.ACTIONFN 24627 . 31529) (MBUTTON.NEXT.FIELD.AS.NUMBER 31531 . 31827) (
MBUTTON.NEXT.FIELD.AS.TEXT 31829 . 32103) (MBUTTON.NEXT.FIELD.AS.ATOM 32105 . 32898) (
MBUTTON.SET.FIELD 32900 . 33992) (MBUTTON.SET.NEXT.FIELD 33994 . 35104) (TEDITMENU.STREAM 35106 .
35682) (\TEDITMENU.RECORD.UNFORMATTED 35684 . 36078) (\TEDITMENU.SELSCREENER 36080 . 37353)) (37568
45862 (MB.CREATE.THREESTATEBUTTON 37578 . 38871) (MB.THREESTATE.DISPLAY 38873 . 41119) (
MB.THREESTATE.SHOWSELFN 41121 . 43366) (MB.THREESTATE.WHENOPERATEDFN 43368 . 44377) (
MB.THREESTATEBUTTON.FN 44379 . 45321) (THREESTATE.INIT 45323 . 45860)) (46186 62160 (
MB.CREATE.NWAYBUTTON 46196 . 49646) (MB.NB.DISPLAYFN 49648 . 51631) (MB.NB.WHENOPERATEDFN 51633 .
52449) (MB.NB.SIZEFN 52451 . 55447) (MB.NWAYBUTTON.SELFN 55449 . 57006) (MB.NWAYMENU.NEWBUTTON 57008
. 57649) (NWAYBUTTON.INIT 57651 . 58160) (MB.NB.PACKITEMS 58162 . 59699) (MB.NWAYBUTTON.ADDITEM 59701
. 62158)) (62328 71030 (\TEXTMENU.TOGGLE.CREATE 62338 . 63922) (\TEXTMENU.TOGGLE.DISPLAY 63924 .
66126) (\TEXTMENU.TOGGLE.SHOWSELFN 66128 . 67764) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 67766 . 68784) (
\TEXTMENU.TOGGLEFN 68786 . 69724) (\TEXTMENU.TOGGLE.INIT 69726 . 70236) (\TEXTMENU.SET.TOGGLE 70238 .
71028)) (71572 92017 (DRAWMARGINSCALE 71582 . 73821) (MARGINBAR 73823 . 78392) (MARGINBAR.CREATE 78394
. 79808) (MB.MARGINBAR.SELFN 79810 . 85682) (MB.MARGINBAR.SIZEFN 85684 . 85972) (
MB.MARGINBAR.DISPLAYFN 85974 . 87879) (MDESCALE 87881 . 88294) (MSCALE 88296 . 88560) (
MB.MARGINBAR.SHOWTAB 88562 . 89673) (MB.MARGINBAR.TABTRACK 89675 . 90556) (\TEDIT.TABTYPE.SET 90558 .
91479) (MARGINBAR.INIT 91481 . 92015)) (93716 103310 (\TEXTMENU.START 93726 . 95697) (
\TEXTMENU.DOC.CREATE 95699 . 102458) (TEXTMENU.CLOSEFN 102460 . 103308)) (103770 136915 (
\TEDITMENU.CREATE 103780 . 104080) (\TEDIT.CHARLOOKSMENU.CREATE 104082 . 104838) (
\TEDITPARAMENU.CREATE 104840 . 105150) (\TEDIT.EXPANDEDPARA.MENU 105152 . 105418) (
\TEDIT.EXPANDEDCHARLOOKS.MENU 105420 . 105685) (\TEDIT.EXPANDED.MENU 105687 . 106397) (
MB.DEFAULTBUTTON.FN 106399 . 108787) (\TEDIT.APPLY.BOLDNESS 108789 . 109128) (\TEDIT.APPLY.CHARLOOKS
109130 . 110480) (\TEDIT.APPLY.OLINE 110482 . 110817) (\TEDIT.APPLY.PARALOOKS 110819 . 118260) (
\TEDIT.SHOW.CHARLOOKS 118262 . 119393) (\TEDIT.FILL.IN.CHARLOOKS.MENU 119395 . 124035) (
\TEDIT.PARSE.CHARLOOKS.MENU 124037 . 129476) (\TEDIT.SHOW.PARALOOKS 129478 . 135892) (
\TEDIT.APPLY.SLOPE 135894 . 136231) (\TEDIT.APPLY.STRIKEOUT 136233 . 136574) (\TEDIT.APPLY.ULINE
136576 . 136913)))))
STOP