(FILECREATED " 3-Jan-84 13:24:32" {PHYLUM}<LISPCORE>SOURCES>DEDIT.;15 84251
changes to: (FNS RESETDEDIT)
previous date: " 4-NOV-83 18:44:28" {PHYLUM}<LISPCORE>SOURCES>DEDIT.;13)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT DEDITCOMS)
(RPAQQ DEDITCOMS [(FNS DF DV DP DC EF EV EP EDITPROP EDITMODE DEDITIT)
(FNS DEDITL DEDITL0 DEDITTTYFN)
(FNS DEDITAfter DEDITBefore DEDITDelete DEDITReplace DEDITSwitch DEDITBI DEDITBO DEDITLI
DEDITLO DEDITRI DEDITRO DEDITUndo UNDOCHOOSE DEDITFind DEDITSwap DEDITCenter DEDITCopy
DEDITReprint DEDITCEdit DEDITEdit DEDITDatatype DEDITEditCom DEDITARGS DEDITBreak
DEDITEval DEDITExit)
(FNS SETPTRTO DEDITCONS DEDITZAPCAR DEDITZAPCDR DEDITZAPNODE DEDITZAPBOTH DEDITFZAP
DEDITZAPCLISP DEDITZAPCHANGES DEDITNCONC DUNDOEDITL DUNDOEDITCOM DUNDOEDITCOM1)
(FNS BSELECT DEDITUSER SELECTKEYS DEDITREADLINE SHADEIFNOTBUF DEDITBUTTONFN
DEDITWINDOWENTRYFN DEDITRIGHTBUTTONFN SELECTELEMENT SELECTREAD SELECTTREE SEARCHMAP
WITHINME ONAPARENP SELECTDONE INWINDOW FINDLCA DOMINATE?)
(FNS POPSELECTION PUSHSELECTION NXTSELECTION TOPSELECTION SWITCHANDSHADE SHADESELECTION
SHADESELECTION1 SHADESELECTION2 PUSHEDITCHAIN MAKESELCHAIN PUSHINTOBUF DUMMYMAPENTRY
FLIPSELS FLIPSELSIN FIXUPSEL NEWSELFOR)
(FNS ACTIVEEDITW FINDEDITW GETEDITW MAKEEDITW NAMEOFEDITW PURGEW MAKECPOSBE SAMEEDITW
TOPEDITW UNDEDITW WHICHEDITW ZORCHEDITW)
(FNS BUFSELP EDITWINDOWP GETLEFT GETMEBP INTAILOF TAILOF DOTTEDEND GETME4 GETSELMAP DEARME
DPCDRSEL GETDPME GETEBUF GETEDITCHAIN GETMAP GETMAP? PURGEMAP PURGEDP SUBSELOF
SETDEDITMAP TAKEDOWN)
(FNS DEDITRESHAPEFN DEDITSCROLLFN DEDITREPAINTFN)
(FNS SETEDITMENU CACHEDEDITCOMS DEFDEDITCOM FINDEDITCOM READEDITMENU SHADEMENUENTRY
DEDITMENURESTORE)
(FNS RESETDEDIT DEDITDATE DEDITMARKASCHANGED)
(FNS DEDITResetTypeComs DEDITTYPEDCOM)
(FNS COPYCONS MAPENTRYP THELIST)
(FNS CANT)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS STACK)
(MACROS EDITBLOCKCALL))
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS)
(GLOBALVARS \DEDITTYPECOMS DEditTypedCom DEDITTTBL DEDITRDTBL)
(ALISTS (DEDITTYPEINCOMS F S Z))
(PROP VARTYPE DEDITTYPEINCOMS)
(SPECVARS ATM EDITCHANGES EDITHIST LASTAIL UNDOLST UNDOLST1)
(ADDVARS (DT.EDITMACROS))
(INITVARS (DEditLinger T))
(CONSTANTS (LINETHICKNESS 2)
(PRIMSHADE 65535)
(SECSHADE 3598)
(SWITCHSHADE (LOGXOR PRIMSHADE SECSHADE))
(READSHADE 23130)
(CHANGEDSHADE 8840))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
DSPRINTDEF NEWPRINTDEF))
(DECLARE: DONTEVAL@COMPILE DOCOPY (FILES DSPRINTDEF NEWPRINTDEF))
(P (AND (GETD (QUOTE RESETDEDIT))
(RESETDEDIT)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA EP EV EF DC DP DV DF)
(NLAML)
(LAMA CANT])
(DEFINEQ
(DF
[NLAMBDA FN (* bas: "21-MAR-83 20:19")
(DEDITIT (QUOTE EDITF)
FN
(QUOTE DISPLAY])
(DV
[NLAMBDA VAR (* bas: "21-MAR-83 20:20")
(DEDITIT (QUOTE EDITV)
VAR
(QUOTE DISPLAY])
(DP
[NLAMBDA ATOM (* bas: "22-MAR-83 04:41")
(DEDITIT (QUOTE EDITPROP)
(MKLIST ATOM)
(QUOTE DISPLAY])
(DC
[NLAMBDA FILE (* bas: "21-MAR-83 20:43")
(* Edits commands of file FILE)
(DEDITIT (QUOTE EDITV)
(if (HASDEF (SETQ FILE (OR (CAR (LISTP FILE))
FILE))
(QUOTE FILE)
NIL T)
then (FILECOMS FILE)
else (ERROR FILE "is not a loaded file" T))
(QUOTE DISPLAY])
(EF
[NLAMBDA FN (* bas: "21-MAR-83 20:19")
(DEDITIT (QUOTE EDITF)
FN
(QUOTE TELETYPE])
(EV
[NLAMBDA VAR (* bas: "21-MAR-83 20:20")
(DEDITIT (QUOTE EDITV)
VAR
(QUOTE TELETYPE])
(EP
[NLAMBDA ATOM (* bas: "22-MAR-83 04:40")
(DEDITIT (QUOTE EDITPROP)
(MKLIST ATOM)
(QUOTE TELETYPE])
(EDITPROP
[LAMBDA (NAME PROP) (* bas: "21-MAR-83 20:29")
(if PROP
then (EDITDEF (LIST NAME PROP)
(QUOTE PROPS))
else (APPLY (QUOTE EDITP)
NAME])
(EDITMODE
[LAMBDA (NEWMODE) (* bas: "18-MAR-83 15:01")
(PROG [(OLDMODE (if (EQP (GETD (QUOTE EDITL))
(GETD (QUOTE DEDITL)))
then (QUOTE DISPLAY)
else (QUOTE TELETYPE]
(AND (EQ NEWMODE (QUOTE STANDARD))
(SETQ NEWMODE (QUOTE TELETYPE))) (* Obselete terminology)
(AND NEWMODE (NEQ NEWMODE OLDMODE)
(/PUTD (QUOTE EDITL)
(GETD (SELECTQ NEWMODE
(TELETYPE (QUOTE NORMAL/EDITL))
(DISPLAY (QUOTE DEDITL))
(\ILLEGAL.ARG NEWMODE)))
T))
(RETURN OLDMODE])
(DEDITIT
[LAMBDA (EFN EARGS EMODE) (* bas: "21-MAR-83 20:38")
(RESETFORM (EDITMODE EMODE)
(APPLY EFN EARGS])
)
(DEFINEQ
(DEDITL
[LAMBDA (L COMS ATM MESS EDITCHANGES) (* bas: "19-JUN-83 23:58")
(* Value is edit push-down list L.
EDITCHANGES is used for destructively marking whether
the edit made any changes.)
(RESETLST (RESETSAVE \DEDITSELECTIONS (create STACK))
(if COMS
then (RESETSAVE EDITMACROS (CONS (QUOTE (TTY: NIL (E (DEDITTTYFN ATM TYPE)
T)))
EDITMACROS))
(NORMAL/EDITL L COMS ATM MESS EDITCHANGES)
else (AND MESS (printout PROMPTWINDOW .TAB0 0 MESS T))
(PROG [MARKLST UNDOLST UNDOLST0 UNDOLST1 UNFIND LASTAIL TMP
(EXPR (CAR (LAST L]
(* EXPR is the top level expression. L is usually a list of only one element, i.e. you usually start editing at
the top, but not necessarily, since editl can be called directly.)
(if [OR (EQ EXPR (GETPROP (QUOTE EDIT)
(QUOTE LASTVALUE)))
[AND ATM (EQ EXPR (SETQ TMP (GETPROP ATM (QUOTE EDIT-SAVE]
(SOME (CAR LISPXHISTORY)
(FUNCTION (LAMBDA (X)
(EQ EXPR (SETQ TMP (CADR (MEMB (QUOTE EDIT)
X]
then
(* First clause is old method of always saving last call on editor property list. Second clause searches history
list for a call to editor corresponding to this expression.)
(SETQ MARKLST (CADR TMP))
(SETQ UNDOLST (CADDR TMP))
(if (CAR UNDOLST)
then (* Don't want to block it twice.)
(push UNDOLST NIL))
(SETQ UNDOLST0 UNDOLST)
(* Marks UNDOLST as of this entry to editor, so UNDO of
this entire EDIT session won't go too far back.)
(SETQ UNFIND (CDDDR TMP)))
(if (PROG1 (DEDITL0 EXPR (GETEDITW ATM (AND (BOUNDP (QUOTE TYPE))
TYPE)))
(* Even if some error occurs, still want to move undo
information to LISPXHISTORY.)
[if UNDOLST1
then (push UNDOLST (CONS T (CONS \DEDITSELECTIONS UNDOLST1]
(AND LISPXHIST (NEQ UNDOLST UNDOLST0)
(UNDOSAVE (LIST (QUOTE DUNDOEDITL)
\DEDITSELECTIONS UNDOLST UNDOLST0)
LISPXHIST))
(* Makes entire DEDITL undoable.)
)
then (* Normal OK exit)
(AND ATM (LITATOM ATM)
(REMPROP ATM (QUOTE EDIT-SAVE)))
[SETQ TMP (CONS EXPR (CONS MARKLST (CONS UNDOLST (LIST EXPR]
(PUTPROP (QUOTE EDIT)
(QUOTE LASTVALUE)
TMP)
(if LISPXHIST
then (NCONC LISPXHIST (LIST (QUOTE EDIT)
TMP)))
else (ERROR!)))
L])
(DEDITL0
[LAMBDA (EXPR EDS SEL) (* bas: "21-MAR-83 19:43")
(* DEDITL0 should only be called while under DEDITL or DEDITTTYFN since the global states of the edit are all
bound there. Note that individual calls to DEDITL0 are not undoable, because structure changes are saved on
UNDOLST1 and only moved to UNDOLST at the end of each command. DEDITL finally moves UNDOLST to LISPXHISTORY.)
(RESETSAVE NIL (LIST (QUOTE SETCURSOR)
(CURSOR WAITINGCURSOR)))
(if [PROG ((PM (GETMAP? EDS)))
(RETURN (AND PM (EQ EXPR (CAR (fetch TAIL of PM]
then (TOTOPW EDS) (* It may otherwise remain closed)
else (SETDEDITMAP EDS (LIST EXPR)))
(AND SEL (PUSHEDITCHAIN SEL)) (* Following ERSETQ to prevent UNDOLST lossage due to
↑E)
(ERSETQ (bind EDITHIST COM ACT SS
do (until (SETQ COM (BSELECT EDS)))
(SETQ SS \DEDITSELECTIONS) (* Save selection stack)
(SETQ ACT (CDR COM)) (* Unpack CONS from READEDITMENU)
(SETQ COM (CAR COM))
(if EDITHISTORY
then (if (PROG1 (AND ATM (NOT EDITHIST))
(* First time thru)
(EDITBLOCKCALL EDITSAVE COM)
(* Sets EDITHIST)
)
then (LISPXPUT (QUOTE *FIRSTPRINT*)
(LIST (QUOTE EDITL2)
ATM T)
NIL EDITHIST)))
(SETQ UNDOLST1 NIL) (* Holds any changes from execution of this command.)
(if (PROG1 (ERSETQ (if (LITATOM ACT)
then (APPLY* ACT)
else (EVAL ACT)))
[if UNDOLST1
then (REPPCHANGES UNDOLST1)
(push UNDOLST (SETQ UNDOLST1 (CONS COM (CONS SS UNDOLST1]
(if EDITHIST
then (* Set in EDITSAVE.)
(RPLACA EDITHIST UNDOLST1)))
else (* Restore selections)
(SETQ \DEDITSELECTIONS SS)) (* Only way out is a RETFROM via one of the exit fns)
])
(DEDITTTYFN
[LAMBDA (NAME TYPE) (* bas: " 7-AUG-83 16:38")
(* Provides DEDIT interface to TTY: commands from under
standard editor)
(DECLARE (USEDFREE L LASTAIL)) (* From EDITL0)
(PROG [UNDOLST TEM (TE (CAR (LAST L]
[RESETLST (* The RESETLST is for DEDITL0;
the binding of UNDOLST1 protects the containing EDIT;
TEM=T unless DEDITL0 was STOPed)
(PROG (UNDOLST1)
(SETQ TEM (DEDITL0 TE (GETEDITW NAME TYPE)
L]
(AND UNDOLST (push UNDOLST1 (CONS (QUOTE GROUPED)
UNDOLST)))
(if TEM
then [SETQ L (OR (AND (SUBSELOF TE (TOPSELECTION T))
(GETEDITCHAIN (TOPSELECTION T)))
(for I on L thereis (AND (SUBSELOF TE (CAR I))
(SETQ LASTAIL (CAR I]
(* Reset edit chain only if current selection still
points to some part of the expression being edited)
elseif [EVALV (QUOTE COMS)
(SETQ TEM (STKPOS (QUOTE EDITL0]
then (RETEVAL TEM (QUOTE (ERROR!))
T)
else (SHOULDNT])
)
(DEFINEQ
(DEDITAfter
[LAMBDA NIL (* bas: "17-MAR-83 22:15")
(PROG ([NU (COPY (CAR (POPSELECTION]
(TGT (POPSELECTION)))
(DEDITZAPCDR TGT (PUSHSELECTION (if (DPCDRSEL TGT)
then (DEDITCONS (CDR TGT)
NU TGT)
else (DEDITCONS NU (CDR TGT)
TGT])
(DEDITBefore
[LAMBDA NIL (* bas: "16-MAR-83 12:40")
(PROG ((SRC (POPSELECTION))
(TGT (POPSELECTION)))
(PUSHSELECTION (SETPTRTO TGT (DEDITCONS (COPY (CAR SRC))
(if (DPCDRSEL TGT)
then (CDR TGT)
else TGT)
TGT])
(DEDITDelete
[LAMBDA NIL (* bas: "16-MAR-83 11:51")
(* Deletes top elt from structure.
Pushes it back on into the buffer)
(PROG ((S (POPSELECTION)))
[PUSHINTOBUF (LIST (COPY (CAR S] (* Copy keeps structure in buffer separate from that on
undolst, which may later get inserted back)
(SETPTRTO S (if (DPCDRSEL S)
then NIL
else (CDR S])
(DEDITReplace
[LAMBDA NIL (* bas: " 5-JUL-83 23:50")
(PROG ((SRC (POPSELECTION))
(TGT (TOPSELECTION)))
(DEDITZAPCAR TGT (SUBST (CAR TGT)
(OR EDITEMBEDTOKEN (CONSTANT (PACK NIL)))
(CAR SRC])
(DEDITSwitch
[LAMBDA NIL (* bas: "16-MAR-83 21:05")
(PROG ((A (TOPSELECTION))
(B (NXTSELECTION)))
(if (OR (DOMINATE? A B)
(DOMINATE? B A))
then (CANT "Switch into oneself"))
(DEDITZAPCAR A (PROG1 (CAR B)
(DEDITZAPCAR B (CAR A])
(DEDITBI
[LAMBDA NIL (* bas: "16-MAR-83 11:51")
(PROG ((A (POPSELECTION))
(B (POPSELECTION))
C)
(if (TAILOF B A)
elseif (TAILOF A B)
then (SETQ A (PROG1 B (SETQ B A)))
else (CANT "Not brothers!"))
(if (DPCDRSEL B)
else (SETQ C (CDR B)) (* Done in this order in case A=B)
(DEDITZAPCDR B NIL))
(DEDITZAPBOTH A (COPYCONS A)
C)
(PUSHSELECTION A])
(DEDITBO
[LAMBDA NIL (* bas: "16-MAR-83 21:01")
(PROG ((TGT (POPSELECTION)))
(AND (CDR TGT)
(DEDITNCONC TGT (CDR TGT)))
(SETPTRTO TGT (CAR TGT])
(DEDITLI
[LAMBDA NIL (* bas: " 2-MAR-83 11:33")
(PROG ((A (TOPSELECTION)))
(DEDITZAPBOTH A (COPYCONS A])
(DEDITLO
[LAMBDA NIL (* bas: " 2-MAR-83 11:34")
(PROG ((A (TOPSELECTION)))
(DEDITZAPNODE A (THELIST (CAR A])
(DEDITRI
[LAMBDA NIL (* bas: " 2-MAR-83 12:03")
(PROG (B (A (POPSELECTION)))
[SETQ B (fetch TAIL of (GETMEBP (GETME4 A T]
(DEDITNCONC B (CDR B))
(DEDITZAPCDR B (CDR A))
(DEDITZAPCDR A NIL)
(PUSHSELECTION B])
(DEDITRO
[LAMBDA NIL (* bas: " 2-MAR-83 11:34")
(PROG ((A (TOPSELECTION)))
(DEDITNCONC A (CDR A))
(DEDITZAPCDR A NIL])
(DEDITUndo
[LAMBDA (END) (* bas: "20-AUG-82 11:31")
(bind FLG for LST on UNDOLST unless (SELECTQ (CAAR LST)
((NIL !Undo UnBlock)
T)
(Undo END)
NIL)
do (DUNDOEDITCOM (CAR LST)
T)
(OR END (RETURN))
(SETQ FLG T)
repeatuntil (OR (EQ END (CAR LST))
(NULL (CAR LST)))
finally (OR FLG (CANT (if (CDR LST)
then "Undo blocked"
else "Nothing saved"])
(UNDOCHOOSE
[LAMBDA (THRUP) (* bas: "20-AUG-82 12:10")
(PROG (C)
(OR UNDOLST (CANT "Nothing to Undo"))
(OR [SETQ C (RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (create MENU
ITEMS ←(APPEND
(for I in UNDOLST
collect (LIST (OR (CAR I)
(PACK* "* " (CADR I)
" *"))
(LIST (QUOTE QUOTE)
I)))
(LIST (LIST (QUOTE **TOP**)
NIL)))
TITLE ←(if THRUP
then "Undo Thru"
else "Undo One")
CENTERFLG ← T]
(RETURN))
(if THRUP
then (DEDITUndo C)
else (DUNDOEDITCOM C T])
(DEDITFind
[LAMBDA NIL (* bas: " 2-MAR-83 11:35")
(PROG (LASTAIL L TGT UNFIND (COM (QUOTE Find)))
(DECLARE (SPECVARS L UNFIND COM))
(SETQ L (GETEDITCHAIN (POPSELECTION))) (* Sets LASTAIL)
(SETQ TGT (CAR (TOPSELECTION)))
(if [ERSETQ (RESETVARS (UPFINDFLG)
(EDIT4F TGT (QUOTE N]
then (PUSHEDITCHAIN L LASTAIL)
else (CANT TGT "Not found"])
(DEDITSwap
[LAMBDA NIL (* bas: "24-MAR-83 15:57")
(replace TOPELT of \DEDITSELECTIONS with (PROG1 (NXTSELECTION)
(replace NXTELT of \DEDITSELECTIONS
with (TOPSELECTION])
(DEDITCenter
[LAMBDA (NOTIFVIS) (* bas: "30-MAR-83 22:18")
(PROG ((A (GETME4 (TOPSELECTION)))
AW)
(OR A (RETURN))
(SETQ AW (WFROMDS (fetch PDSP of A)))
(AND NOTIFVIS (IGREATERP (fetch STARTY of A)
(WYOFFSET NIL AW))
[ILESSP (fetch STOPY of A)
(IPLUS (WYOFFSET NIL AW)
(WINDOWPROP AW (QUOTE HEIGHT]
(RETURN))
(SCROLLBYREPAINTFN AW 0 (IDIFFERENCE (IPLUS (WYOFFSET NIL AW)
(IQUOTIENT (IDIFFERENCE (WINDOWPROP
AW
(QUOTE HEIGHT))
(IDIFFERENCE
(fetch STARTY
of A)
(fetch STOPY
of A)))
2))
(fetch STOPY of A])
(DEDITCopy
[LAMBDA NIL (* bas: " 2-MAR-83 11:37")
(PUSHINTOBUF (LIST (COPY (CAR (TOPSELECTION])
(DEDITReprint
[LAMBDA NIL (* bas: " 2-MAR-83 11:37")
(REPP (GETME4 (TOPSELECTION)
T])
(DEDITCEdit
[LAMBDA (E) (* bvm: " 4-NOV-83 18:22")
(COND
((FGETD (QUOTE TTYINEDIT))
(PROG [(V (TTYINEDIT E (GETEBUF NIL]
(COND
((CDR V) (* Replaced one expression with many)
(SETQ V (LIST V)))
(T V))
(OR (BUFSELP (GETME4 (TOPSELECTION)))
(BUFSELP (GETME4 (NXTSELECTION T)))
(SETDEDITMAP (GETEBUF T)
(COPY V)))
(RETURN V)))
(T (CANT "TTYIN not loaded"])
(DEDITEdit
[LAMBDA (EDITOR EDITEE) (* bvm: " 4-NOV-83 18:24")
(RESETLST (RESETSAVE (SETCURSOR DEFAULTCURSOR)
(LIST (QUOTE SETCURSOR)
WAITINGCURSOR))
(PROG ((S (CAR (TOPSELECTION)))
A)
(SELECTQ EDITEE
[(Def NIL)
(COND
((AND (NLISTP S)
(NOT (LITATOM S)))
(DEDITDatatype S))
((AND (for old (S ←(POPSELECTION)) by (CAR S) while (LISTP S)
finally (RETURN (LITATOM S)))
(SETQ A (TYPESOF S NIL NIL (QUOTE ?)))
(SETQ A (SELECT.ATOM.ASPECT S NIL A)))
(RESETSAVE (EDITMODE EDITOR))
(* User can refuse all SELECT.ATOM.ASPECT choices)
(EDITDEF S A (QUOTE ?)))
(T (CANT "No editable aspect"]
[Form (AND [SETQ S (APPLY* (COND
((EQ EDITOR (QUOTE TTYIn))
(QUOTE DEDITCEdit))
(T (RESETSAVE (EDITMODE EDITOR))
(QUOTE EDITE)))
(LIST (COPY S]
(DEDITZAPCAR (TOPSELECTION)
(CAR S]
(SHOULDNT])
(DEDITDatatype
[LAMBDA (obj) (* bvm: " 4-NOV-83 18:43")
(PROG ((DTMAC (FASSOC (TYPENAME obj)
DT.EDITMACROS))
newObj source installSourceFn changedFlg)
(DECLARE (SPECVARS changedFlg))
(OR DTMAC (RETURN (INSPECT obj)))
(* CADR is a function which gets a list structure source for the datatype. CADDR is a function which installs the
source back in the dataType. It is called when the source has been changed in the editing.)
(COND
((NULL (SETQ source (APPLY* (CADR DTMAC)
obj))) (* If this fn returns NIL, we assume it has done any
desired editing itself)
(RETURN)))
(SETQ installSourceFn (CADDR DTMAC))
LP [SETQ source (EDITE source NIL obj (TYPENAME obj)
(FUNCTION (LAMBDA NIL
(SETQ changedFlg T]
[COND
((NOT changedFlg)
(RETURN))
((NLSETQ (SETQ newObj (OR (APPLY* installSourceFn obj source)
obj)))
(RETURN (DEDITZAPCAR (TOPSELECTION)
newObj]
(PROMPTPRINT "Error in datatype edit source")
(GO LP))
(DEDITReprint])
(DEDITEditCom
[LAMBDA (C) (* bas: "30-MAR-83 20:55")
[OR C (SETQ C (CAR (POPSELECTION]
(PROG (TYPE ATM EDITCHANGES LASTAIL LASTP1 LASTP2 TSM SCR (TS (POPSELECTION)))
(DECLARE (SPECVARS TYPE ATM EDITCHANGES LASTAIL LASTP1 LASTP2))
(* For DEDITL and EDITL0)
[if (SETQ TSM (GETME4 TS))
then (if (SETQ SCR (WINDOWPROP (fetch PDSP of TSM)
(QUOTE DEDITWHOAMI)))
then (SETQ ATM (CAR SCR))
(SETQ TYPE (CADR SCR)))
(SETQ EDITCHANGES (WINDOWPROP (fetch PDSP of TSM)
(QUOTE DEDITCHANGES]
(PUSHEDITCHAIN (EDITL0 (GETEDITCHAIN TS)
(MKLIST C])
(DEDITARGS
[LAMBDA (F) (* bas: "30-MAR-83 16:14")
(SETQ F (OR F (TOPSELECTION)))
(while (LISTP F) do (SETQ F (CAR F)))
(PUSHINTOBUF (LIST (CONS F (COPY (OR [AND (LITATOM F)
(CAR (NLSETQ (SMARTARGLIST F T]
(QUOTE (not a function])
(DEDITBreak
[LAMBDA NIL (* bas: " 7-MAR-83 12:01")
(PROG (WHO AMP CARFORM (A (POPSELECTION)))
(SETQ AMP (GETME4 A))
[SETQ WHO (AND AMP (WINDOWPROP (fetch PDSP of AMP)
(QUOTE DEDITWHOAMI]
(* * WT packs on BREAKINCHAR to these atoms and UNBREAK wont work without them)
(DEDITZAPCAR A (LIST (QUOTE BREAK1)
(CAR A)
T
(LIST (PACK* (CAR WHO)
BREAKINCHAR)
(PACK* (QUOTE around)
BREAKINCHAR)
(PACK* (SETQ CARFORM (OR (NLISTP (CAR A))
(CAAR A)))
BREAKINCHAR))
NIL))
(OR [if AMP
then (AND (fetch BP of AMP)
(FMEMB (CAAR (fetch TAIL of (fetch BP of AMP)))
NOBREAKS)
(PROMPTPRINT "Break installed inside a NOBREAKS"))
(if (EQ (CADR WHO)
(QUOTE FNS))
then (/PUTPROP (CAR WHO)
(QUOTE BROKEN-IN)
T)
(/PUTPROP (CAR WHO)
(QUOTE BRKINFO)
(LIST (LIST (LIST (QUOTE AROUND)
CARFORM)
NIL NIL)))
(/SET (QUOTE BROKENFNS)
(CONS (CAR WHO)
BROKENFNS]
(PROMPTPRINT "Break installed, but not recorded"])
(DEDITEval
[LAMBDA NIL (* bas: "25-MAR-83 16:23")
(PROG [(S (CAR (POPSELECTION]
(PUSHINTOBUF (if (LITATOM S)
then (LIST (EVALV S))
elseif (ERSETQ (LISPXEVAL S NIL))
else (LIST (QUOTE NOBIND])
(DEDITExit
[LAMBDA (STOPFLG) (* bas: " 9-OCT-82 17:24")
(AND EDITHIST ATM (NOT STOPFLG)
(LISPXPUT (QUOTE *PRINT*)
(LIST (QUOTE EDITL2)
ATM)
NIL EDITHIST)) (* Hoaky stuff for the edit history list)
(RETFROM (QUOTE DEDITL0)
(NOT STOPFLG)
T])
)
(DEFINEQ
(SETPTRTO
[LAMBDA (X Y) (* bas: "16-MAR-83 13:23")
(PROG ((XM (GETME4 X T))
BK TEM)
(if [SETQ TEM (GETLEFT XM (SETQ BK (GETMEBP XM]
then (DEDITZAPCDR TEM Y)
elseif (fetch BP of BK)
then (DEDITZAPCAR BK Y)
elseif (NLISTP Y)
then (CANT "Delete last list element")
else (DEDITZAPBOTH X (CAR Y)
(if (EQ X (CDR Y))
then (RPLNODE2 Y X)
else (CDR Y)))
(SETQ Y X))
(RETURN Y])
(DEDITCONS
[LAMBDA (A D BROTHER) (* bas: "25-MAR-83 17:12")
(fetch TAIL of (DUMMYMAPENTRY (CONS A D)
(GETMEBP (OR (GETME4 BROTHER)
(CANT "Invalid target"])
(DEDITZAPCAR
[LAMBDA (M A) (* bas: " 2-MAR-83 15:38")
(DEDITZAPBOTH M A (CDR (OR (LISTP M)
(fetch TAIL of M])
(DEDITZAPCDR
[LAMBDA (M D) (* bas: "25-JUL-82 16:23")
(DEDITZAPBOTH M (CAR (OR (LISTP M)
(fetch TAIL of M)))
D])
(DEDITZAPNODE
[LAMBDA (M C) (* bas: "27-JUL-81 04:48")
(DEDITZAPBOTH M (CAR C)
(CDR C])
(DEDITZAPBOTH
[LAMBDA (CC A D ENT) (* bas: "30-MAR-83 23:17")
(* ALL edit changes go through this function.)
(if (SETQ ENT (if (type? DEDITMAP CC)
then (PROG1 CC (SETQ CC (fetch TAIL of CC)))
else (GETME4 CC)))
then (if (fetch BP of ENT)
elseif (BUFSELP ENT)
elseif (AND (EQ D (CDR CC))
(LISTP (CAR CC))
(LISTP A))
then (* Ideally should check that CC cannot be reached from A
b/c in this case this trick is not valid)
(SETQ D (CDR A))
(SETQ A (CAR A))
(SETQ CC (CAR CC))
else (CANT "Alter top"))
[if (DPCDRSEL ENT)
then [SETQ CC (LAST (fetch SELEXP of (fetch BP of ENT]
(* Real CONS)
(SETQ D (if (NEQ A (CDR CC))
then A
else D))
(SETQ A (CAR CC))
(PROG ((V (DOTTEDEND D)))
(if V
then (DEDITFZAP (fetch TAIL of ENT)
V V)
else (PUTHASH (fetch TAIL of (fetch BP of ENT))
NIL \DEDITDPHASH)
(PUTHASH (fetch TAIL of ENT)
NIL \DEDITMEHASH]
(AND EDITSMASHUSERFN (APPLY* EDITSMASHUSERFN CC (GETEDITCHAIN ENT)))
[if (DEDITFZAP CC A D)
then [PROG [(TEM (CDR (WINDOWPROP (fetch PDSP of ENT)
(QUOTE DEDITCHANGES]
(* Undoably smashes EDITCHANGES from call in which
change is being made, unless already set)
(OR (NOT TEM)
(CAR TEM)
(DEDITFZAP TEM T (CDR TEM]
(AND CHANGESARRAY (DEDITZAPCHANGES ENT))
(* A smashed cell is always changed)
(for (E ← ENT) by (fetch BP of E) while E do (DEDITZAPCLISP (fetch SELEXP
of E]
else (AND EDITSMASHUSERFN (APPLY* EDITSMASHUSERFN CC (LIST CC)))
(DEDITFZAP CC A D])
(DEDITFZAP
[LAMBDA (CC A D) (* bas: "30-MAR-83 23:16")
(* Smashes cons CC and makes UNDOLST entry but uses no other context. Used for making changes to editor structures
sauch as the undo list itself)
(PROG ((OA (CAR CC))
(OD (CDR CC))) (* Dont smash EQ values. Slow b/c of refcnts and
clutters up UNDOLST)
(RETURN (AND (if (EQ D OD)
then (AND (NEQ A OA)
(FRPLACA CC A))
elseif (EQ A OA)
then (FRPLACD CC D)
else (RPLNODE CC A D))
(push UNDOLST1 (CONS CC (CONS OA OD])
(DEDITZAPCLISP
[LAMBDA (CC) (* bas: "30-MAR-83 23:01")
(* Deletes CLISP translation. Not made part of the edit event, because of the possibility of the user performing
two changes, and then undoing the first, which would then restore the translation, even though it no longer
corresponds to the untranslated and changed CLISP.)
(if (NLISTP CC)
elseif (AND CLISPTRANFLG (EQ CLISPTRANFLG (CAR CC)))
then (if (LISTP (CDDR CC))
then (/RPLNODE2 CC (CDDR CC))
else (* CLISP% used to translate an atom e.g. QLISP does
this.)
(SHOULDNT))
elseif (AND CLISPARRAY (GETHASH CC CLISPARRAY))
then (/PUTHASH CC NIL CLISPARRAY])
(DEDITZAPCHANGES
[LAMBDA (ME) (* bas: "18-OCT-81 22:29")
(if (for (I ← ME) by (fetch BP of I) while I never (GETHASH (fetch TAIL of I)
CHANGESARRAY))
then [push UNDOLST1 (CONS (QUOTE LISPXHIST)
(LIST (LIST (QUOTE /PUTHASH)
(fetch TAIL of ME)
(GETHASH (fetch TAIL of ME)
CHANGESARRAY)
CHANGESARRAY]
(* Done this way for efficiency rather than going
through editcom1 since we know what to undosave.)
(PUTHASH (fetch TAIL of ME)
ATM CHANGESARRAY])
(DEDITNCONC
[LAMBDA (X Y) (* bas: " 2-MAR-83 11:41")
(DEDITZAPCDR (LAST (THELIST (CAR X)))
Y])
(DUNDOEDITL
[LAMBDA (SS ULST ULST0) (* bas: "24-MAR-82 12:06")
(PROG (UNDOLST1 WAI)
(for X on ULST until (EQ X ULST0) do (DUNDOEDITCOM (CAR X)) when (CAR X))
(OR UNDOLST1 (SHOULDNT)) (* Must have some changes to undo)
[bind TMP for I in ULST when [for J in (CDDDR I) thereis (SETQ TMP (WHICHEDITW
(CAR J]
do (AND (SETQ TMP (WINDOWPROP TMP (QUOTE DEDITWHOAMI)))
(MARKASCHANGED (CAR TMP)
(CADR TMP]
(DEDITFZAP ULST (CAR ULST0)
(CDR ULST0)) (* So undo can be UNDOne.)
(if LISPXHIST
then (UNDOSAVE [LIST (QUOTE DUNDOEDITL)
SS
(LIST (CONS T (CONS SS UNDOLST1]
LISPXHIST])
(DUNDOEDITCOM
[LAMBDA (X FLG) (* bas: "21-MAR-83 19:43")
(* If FLG is T, name of command is printed.)
(if (NLISTP X)
then (CANT "Garbage on DEDIT UNDO list")
(* Used to elseif (AND (CADR X) (NOT (SAMEEXPR MAP (fetch TOPELT of (CADR X))))) then (* The saved
\DEDITSELECTIONS was not from the edit expression) (CANT "UNDO on different expression"))
elseif (CAR X)
then (DUNDOEDITCOM1 X) (* else has been undone before, dont UNDO it again.)
)
(if FLG
then (SETQ \DEDITSELECTIONS (CADR X))
(printout PROMPTWINDOW T (OR (CAR X)
"Already")
" undone."))
(DEDITFZAP X NIL (COPYCONS X)) (* Marks X so UNDO will skip it in future.
UNDOing this UNDO will unmark it)
T])
(DUNDOEDITCOM1
[LAMBDA (C) (* bas: "21-MAR-83 19:43")
(* Takes a single entry on UNDOLST, i.e. list of the form (command-name \DEDITSELECTIONS . UNDOLST1) and maps down
the UNDOLST1 portion performing the corresonding DEDITSMASHes.)
(for X in (CDDR C) do (SELECTQ (CAR X)
(GROUPED (* Used by TTY: command, which must add entire UNDOLST
from subordinate call to EDITL0 to its own UNDOLST1.)
(for X in (CDR X) do (DUNDOEDITCOM1 X)))
(LISPXHIST (EDITBLOCKCALL EDITCOM1 (CDR X)))
(DEDITZAPNODE (CAR X)
(CDR X])
)
(DEFINEQ
(BSELECT
[LAMBDA (CDS) (* bvm: " 4-NOV-83 17:54")
(* Does selections until a command is given)
(RESETFORM (DEDITUSER (WFROMDS CDS))
(CAR (ERSETQ (bind TMP MENUMOVED REG
do (OR (WINDOWP \DEDITMNUW)
(SETEDITMENU CDS))
(COND
((NOT (TTY.PROCESSP))
(WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
(THIS.PROCESS))
(* Allow the menu window to also respond to tty
switching)
(PROCESS.PREPARE.FOR.INPUT CDS)))
(GETMOUSESTATE)
[COND
[(EQ MENUMOVED (SETQ MENUMOVED (KEYDOWNP (QUOTE TAB]
(MENUMOVED [OR REG (SETQ REG (WINDOWPROP \DEDITMNUW (QUOTE REGION]
[MOVEW \DEDITMNUW (IMIN (ADD1 LASTMOUSEX)
(IDIFFERENCE
SCREENWIDTH
(fetch (REGION WIDTH)
of REG)))
(IMAX 0 (IMIN (IDIFFERENCE LASTMOUSEY
(WINDOWPROP
\DEDITMNUW
(QUOTE YOFFSET)))
(IDIFFERENCE SCREENHEIGHT
(fetch (REGION
HEIGHT)
of REG]
(OR (\SYSBUFP)
(DISMISS 24Q))
(* Wait til TAB read)
(CLEARBUF T))
(T (MOVEW \DEDITMNUW (WINDOWPROP \DEDITMNUW (QUOTE HOME]
(AND [SETQ TMP (OR (AND (\SYSBUFP)
(SELECTKEYS))
(AND (INWINDOW (TOTOPW \DEDITMNUW))
(READEDITMENU]
(RETURN TMP))
(\BACKGROUND])
(DEDITUSER
[LAMBDA (DS) (* bas: "24-MAR-83 15:04")
(PROG1 (if DS
then NIL
elseif (TOPEDITW))
(if (SETQ \DEDITALLOWSELS (WINDOWP DS))
then (TOTOPW DS)
(SETEDITMENU DS))
(AND \DEDITSELECTIONS (FLIPSELS))
(SETCURSOR (if DS
then DEFAULTCURSOR
else WAITINGCURSOR])
(SELECTKEYS
[LAMBDA NIL (* bvm: "25-OCT-83 18:47")
(CAR (ERSETQ (RESETLST (RESETSAVE (TTYDISPLAYSTREAM (GETEBUF NIL)))
(* GETEBUF of NIL returns an inactive window.)
(RESETSAVE \DEDITALLOWSELS NIL)
(RESETSAVE NIL (LIST (QUOTE SETREADTABLE)
(SETREADTABLE DEDITRDTBL T)
T))
(RESETSAVE (SETTERMTABLE DEDITTTBL))
(PROG ((LINE (DEDITREADLINE)))
(RETURN (COND
((EQ DEditTypedCom (CAR (LISTP LINE)))
(DEDITTYPEDCOM (CDR LINE)))
(T (SHADEIFNOTBUF (NXTSELECTION T)
SECSHADE)
(* Push shading)
(SHADEIFNOTBUF (TOPSELECTION T)
SWITCHSHADE)
(SHADESELECTION (SETDEDITMAP (GETEBUF T)
(PUSHSELECTION
(LIST LINE)))
PRIMSHADE)
NIL])
(DEDITREADLINE
[LAMBDA (ASLIST) (* bvm: " 4-NOV-83 15:43")
(* Read a line of input from T. This is like the grunge that goes on inside of LISPX, figuring out where the line
ends...)
(PROG ((FIRSTITEM (APPLY* LISPXREADFN T T))
CH LINE)
(RETURN (COND
((AND (LISTP FIRSTITEM)
(OR (EQ (CAR FIRSTITEM)
DEditTypedCom)
(SYNTAXP (SETQ CH (CHCON1 (LASTC T)))
(QUOTE RIGHTPAREN)
T)
(SYNTAXP CH (QUOTE RIGHTBRACKET)
T)))
(* A list is the first thing typed. Usually, there is no more, but you could get a list from an "atomic" form if
it had a read macro that turned it into a list)
(COND
(ASLIST (LIST FIRSTITEM))
(T FIRSTITEM)))
((OR (CDR (SETQ LINE (READLINE T (LIST FIRSTITEM)
T)))
ASLIST) (* There was more, so return whole list)
LINE)
(T (* Single atom)
FIRSTITEM])
(SHADEIFNOTBUF
[LAMBDA (X TXT) (* bas: "13-MAR-83 19:59")
(AND X (SETQ X (GETSELMAP X))
(NOT (BUFSELP X))
(SHADESELECTION X TXT])
(DEDITBUTTONFN
[LAMBDA (W) (* bas: "18-MAR-83 16:50")
(TOTOPW W) (* Bring it up, if nothing else)
(AND (EDITWINDOWP W)
(if (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
then (SELECTREAD W)
elseif \DEDITALLOWSELS
then (SELECTELEMENT W])
(DEDITWINDOWENTRYFN
[LAMBDA (W) (* bvm: "25-OCT-83 16:12")
(* Invoked when button goes down in W when we are not the tty process. If shift is down, do shift selection
without changing tty; else do the normal thing)
(TOTOPW W) (* Bring it up, if nothing else)
(COND
([AND (EDITWINDOWP W)
(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT]
(SELECTREAD W))
(T (GIVE.TTY.PROCESS W])
(DEDITRIGHTBUTTONFN
[LAMBDA (W) (* bas: "21-MAR-83 11:18")
(if (AND (EDITWINDOWP W)
(INWINDOW W)
\DEDITALLOWSELS)
then (SELECTTREE)
else (DOWINDOWCOM W])
(SELECTELEMENT
[LAMBDA (DS) (* bas: "24-MAR-83 16:01")
(bind N M (TE ←(GETSELMAP (TOPSELECTION T)))
(NE ←(GETSELMAP (NXTSELECTION T))) until (SELECTDONE DS)
do (AND (SETQ M (SEARCHMAP DS))
(LASTMOUSESTATE MIDDLE)
(SETQ M (fetch BP of M)))
(if (EQ M N)
else (if (AND N M)
else (SHADESELECTION NE SECSHADE) (* Virtual push/pop)
(SHADESELECTION TE SWITCHSHADE))
(SHADESELECTION N PRIMSHADE)
(SHADESELECTION M PRIMSHADE)
(SETQ N M))
finally (AND M (PUSHSELECTION (fetch TAIL of M])
(SELECTREAD
[LAMBDA (DS) (* rmk: "25-OCT-83 20:14")
(bind M N while (KEYDOWNP (QUOTE LSHIFT)) do (until (SELECTDONE DS)
do (AND (SETQ M (SEARCHMAP DS))
(LASTMOUSESTATE MIDDLE)
(SETQ M (fetch BP of M)))
(if (AND N M)
then (if (EQ M N)
else (SHADESELECTION N READSHADE)
(SHADESELECTION M READSHADE))
else (SHADESELECTION (OR N M)
READSHADE))
(SETQ N M))
finally (if M
then (SHADESELECTION M READSHADE)
(BKSYSBUF (fetch SELEXP of M)
T)
(OR (LISTP (fetch SELEXP of M))
(BKSYSCHARCODE (CHARCODE SPACE])
(SELECTTREE
[LAMBDA NIL (* bas: " 2-MAR-83 11:38")
(bind N DS (OT ←(GETME4 (TOPSELECTION)
T))
first (SETQ DS (fetch PDSP of OT)) until (SELECTDONE DS)
do (SWITCHANDSHADE (if (SETQ N (SEARCHMAP DS))
then (FINDLCA OT N)
else OT])
(SEARCHMAP
[LAMBDA (PDS) (* bas: "17-MAR-83 13:00")
(PROG (L S (E (GETMAP PDS))
(LX (LASTMOUSEX PDS))
(LY (LASTMOUSEY PDS)))
[while E until (AND (WITHINME E LX LY)
(OR [NOT (SETQ L (LISTP (fetch SELEXP of (SETQ S E]
(ONAPARENP E LX LY)))
do (* The until clause is true if either E covers mouse and
has no descendents or we're on a paren)
(SETQ E (GETME4 L S)) (* Either pending tail or embedded descendents to
search)
(if (AND E (fetch PURGED of E))
then (REPP S)
(SETQ E (GETME4 (fetch TAIL of S)
T))
(SETQ S (fetch BP of E))
(SETQ L (CDR (fetch TAIL of E)))
else (SETQ L (CDR (LISTP L]
(RETURN E])
(WITHINME
[LAMBDA (E X Y) (* bas: "30-MAR-83 14:24")
(PROG [(FA (FONTPROP (fetch FNT of E)
(QUOTE ASCENT)))
(FD (FONTPROP (fetch FNT of E)
(QUOTE DESCENT]
(RETURN (if (IGREATERP Y (IPLUS FA (fetch STARTY of E)))
then NIL
elseif (IGEQ Y (IDIFFERENCE (fetch STARTY of E)
FD))
then [AND (IGEQ X (fetch STARTX of E))
(OR (ILESSP X (fetch STOPX of E))
(NEQ (fetch STARTY of E)
(fetch STOPY of E]
elseif (ILESSP Y (IDIFFERENCE (fetch STOPY of E)
FD))
then NIL
elseif (IGREATERP Y (IPLUS FA (fetch STOPY of E)))
else (ILESSP X (fetch STOPX of E])
(ONAPARENP
[LAMBDA (E X Y) (* bas: "30-MAR-83 14:24")
(PROG ((EF (fetch FNT of E)))
(RETURN (OR [AND (ILESSP X (fetch LPEND of E))
(IGEQ Y (IDIFFERENCE (fetch STARTY of E)
(FONTPROP EF (QUOTE DESCENT]
(AND (IGEQ X (fetch RPSTART of E))
(ILESSP Y (IPLUS (fetch STOPY of E)
(FONTPROP EF (QUOTE ASCENT])
(SELECTDONE
[LAMBDA (PDS) (* bas: "28-JUL-82 22:42")
(OR (MOUSESTATE UP)
(NOT (INWINDOW PDS])
(INWINDOW
[LAMBDA (DS) (* bas: "27-AUG-82 12:38")
(INSIDE? (DSPCLIPPINGREGION NIL DS)
(LASTMOUSEX DS)
(LASTMOUSEY DS])
(FINDLCA
[LAMBDA (S1 S2) (* bas: "25-APR-81 17:09")
(while S1 until (DOMINATE? S1 S2) do (SETQ S1 (fetch BP of S1)) finally (RETURN S1])
(DOMINATE?
[LAMBDA (SUP SUB) (* bas: " 7-AUG-83 15:49")
(OR (EQ SUP SUB)
(PROG [(S1 (OR (MAPENTRYP SUP)
(GETME4 SUP)))
(S2 (OR (MAPENTRYP SUB)
(GETME4 SUB]
(RETURN (if S2
then (for old S2 by (fetch BP of S2) while S2 thereis (EQ S1 S2))
else (for I on (CAR (LISTP SUP)) thereis (DOMINATE? I SUB])
)
(DEFINEQ
(POPSELECTION
[LAMBDA NIL (* bas: "21-MAR-83 19:43")
(PROG1 (TOPSELECTION)
(pop \DEDITSELECTIONS])
(PUSHSELECTION
[LAMBDA (S) (* bas: "21-MAR-83 19:43")
(push \DEDITSELECTIONS S)
S])
(NXTSELECTION
[LAMBDA (NOERR) (* bas: "24-MAR-83 15:52")
(OR (fetch NXTELT of \DEDITSELECTIONS)
(AND (NOT NOERR)
(CANT "No second selection"])
(TOPSELECTION
[LAMBDA (NOERR) (* bas: "24-MAR-83 15:52")
(OR (fetch TOPELT of \DEDITSELECTIONS)
(AND (NOT NOERR)
(CANT "Too few selections"])
(SWITCHANDSHADE
[LAMBDA (NU) (* bas: "24-MAR-83 16:02")
(* Like a POP/PUSH sequence but no CONS)
(if (EQ (fetch TAIL of NU)
(TOPSELECTION T))
else (SHADESELECTION (GETME4 (TOPSELECTION T)
T)
PRIMSHADE)
(replace TOPELT of \DEDITSELECTIONS with (fetch TAIL of NU))
(SHADESELECTION NU PRIMSHADE])
(SHADESELECTION
[LAMBDA (S SHADE) (* bas: " 2-MAR-83 13:31")
(AND S (SHADESELECTION1 S SHADE])
(SHADESELECTION1
[LAMBDA (S TXT) (* bas: "30-MAR-83 14:31")
(if (EQ (fetch STARTY of S)
(fetch STOPY of S))
then (* This way mainly for efficiency)
(SHADESELECTION2 S (fetch STARTY of S)
(fetch STARTX of S)
(fetch STOPX of S)
TXT)
elseif (LISTP (CAR (fetch TAIL of S)))
then (PROG NIL
(SHADESELECTION2 S (fetch STARTY of S)
(fetch STARTX of S)
(fetch LPEND of S)
TXT)
(for E on (CAR (fetch TAIL of S)) do (SHADESELECTION1 (GETME4 E S)
TXT)
finally (if E
then (* Dotted pair)
(SHADESELECTION1 (GETME4 E S)
TXT)))
(SHADESELECTION2 S (fetch STOPY of S)
(fetch RPSTART of S)
(fetch STOPX of S)
TXT))
else (for I from (fetch STARTY of S) by (IMINUS (FONTPROP (fetch FNT of S)
(QUOTE HEIGHT)))
to (fetch STOPY of S) do (SHADESELECTION2 S I (if (EQ I (fetch STARTY of S))
then (fetch STARTX of S)
else (DSPLEFTMARGIN NIL
(fetch PDSP
of S)))
(if (EQ I (fetch STOPY of S))
then (fetch STOPX of S)
else (DSPRIGHTMARGIN NIL
(fetch PDSP
of S)))
TXT])
(SHADESELECTION2
[LAMBDA (S CY SX EX SHADE) (* bas: "13-JUL-82 10:02")
(BITBLT NIL NIL NIL (fetch PDSP of S)
SX
(IDIFFERENCE CY (ADD1 LINETHICKNESS))
(IDIFFERENCE EX SX)
LINETHICKNESS
(QUOTE TEXTURE)
(QUOTE INVERT)
SHADE])
(PUSHEDITCHAIN
[LAMBDA (C) (* bas: "30-MAR-83 22:19")
[PUSHSELECTION (PROG ((X (MAKESELCHAIN C)))
(RETURN (if (MAPENTRYP X)
then (fetch TAIL of X)
else C]
(DEDITCenter T])
(MAKESELCHAIN
[LAMBDA (LST) (* bas: "30-MAR-83 23:34")
(* Makes dummy map entries until the whole chain is linked into an extant map. This is necessary so subsequent
commands from a Multiple can find their way around)
(if (CDR (THELIST LST))
then [PROG [(TMP (OR (FMEMB (CAR LST)
(CADR LST))
(TAILP (CAR LST)
(CADR LST))
[AND (NLISTP (CAR LST))
(EQ (CAR LST)
(DOTTEDEND (CADR LST]
(CANT "Inconsistent EDIT chain"]
(RETURN (OR (GETME4 TMP)
(DUMMYMAPENTRY TMP (MAKESELCHAIN (CDR LST]
else (PROG [(Y (GETME4 (CAR LST]
(RETURN (AND (MAPENTRYP Y)
(GETMEBP Y])
(PUSHINTOBUF
[LAMBDA (V) (* bas: " 4-MAR-83 12:23")
(AND V (PUSHSELECTION V])
(DUMMYMAPENTRY
[LAMBDA (E B) (* bas: "21-MAR-83 19:58")
(PUTHASH E (create DEDITMAP
TAIL ←(OR (LISTP E)
(GETHASH (fetch TAIL of B)
\DEDITDPHASH)
(PUTHASH (fetch TAIL of B)
(CONS E E)
\DEDITDPHASH))
BP ← B
PDSP ←(fetch PDSP of B))
\DEDITMEHASH])
(FLIPSELS
[LAMBDA NIL (* bas: "24-MAR-83 16:02")
(* Turns selections on or off across possible movement)
(PROG [(TM (FIXUPSEL (TOPSELECTION T]
(SHADESELECTION TM PRIMSHADE)
(SHADESELECTION (FIXUPSEL (NXTSELECTION T)
(BUFSELP TM))
SECSHADE])
(FLIPSELSIN
[LAMBDA (DS) (* bas: "24-MAR-83 16:03")
(* Turns selections on or off across possible movement)
(SETQ DS (WINDOWPROP DS (QUOTE DSP)))
(PROG (S)
(AND (SETQ S (GETSELMAP (TOPSELECTION T)))
(EQ DS (fetch PDSP of S))
(SHADESELECTION S PRIMSHADE))
(AND (SETQ S (GETSELMAP (NXTSELECTION T)))
(EQ DS (fetch PDSP of S))
(SHADESELECTION S SECSHADE])
(FIXUPSEL
[LAMBDA (X BUFBUSY) (* bas: "13-MAR-83 20:18")
(* Returns a new selection if X is not OK)
(AND X (PROG ((TMP (GETME4 X)))
(AND TMP (if (PURGEDP TMP)
then (* Perhaps the whole window has been ZORCHed.
Try again if you can reestablish the EDITEXPR)
(AND (NOT (GETMAP? (fetch PDSP of TMP)))
(GETMAP (fetch PDSP of TMP))
(RETURN (FIXUPSEL X BUFBUSY)))
else (RETURN TMP)))
(AND (NOT BUFBUSY)
(RETURN (SETDEDITMAP (GETEBUF T)
(NEWSELFOR X])
(NEWSELFOR
[LAMBDA (X) (* bas: "24-MAR-83 16:03")
(PROG ((Y (CONS (COPY (CAR X))
NIL)))
(if (EQ X (TOPSELECTION T))
then (replace TOPELT of \DEDITSELECTIONS with Y)
elseif (EQ X (NXTSELECTION T))
then (replace NXTELT of \DEDITSELECTIONS with Y)
else (SHOULDNT))
(RETURN Y])
)
(DEFINEQ
(ACTIVEEDITW
[LAMBDA (W ONFLG) (* bvm: "25-OCT-83 16:19")
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(AND ONFLG (QUOTE DEDITBUTTONFN)))
[WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(COND
(ONFLG (QUOTE DEDITRIGHTBUTTONFN))
(T (QUOTE DOWINDOWCOM]
(WINDOWPROP W (QUOTE RESHAPEFN)
(AND ONFLG (QUOTE DEDITRESHAPEFN)))
(WINDOWPROP W (QUOTE REPAINTFN)
(AND ONFLG (QUOTE DEDITREPAINTFN)))
(WINDOWPROP W (QUOTE SCROLLFN)
(AND ONFLG (QUOTE DEDITSCROLLFN)))
(WINDOWPROP W (QUOTE PROCESS)
(AND ONFLG (THIS.PROCESS))) (* So that bugging in this window can switch tty to us)
(WINDOWPROP W (QUOTE WINDOWENTRYFN)
(AND ONFLG (FUNCTION DEDITWINDOWENTRYFN)))
(DSPSCROLL (COND
(ONFLG (QUOTE OFF))
(T T))
(WINDOWPROP W (QUOTE DSP))) (* Buffer can get this turned on)
W])
(FINDEDITW
[LAMBDA (NAME TYPE) (* bas: "18-MAR-83 15:25")
(for I in \DEDITWINDOWS thereis (SAMEEDITW I NAME TYPE])
(GETEDITW
[LAMBDA (ATM TYPE) (* bas: "18-MAR-83 15:25")
(SELECTQ TYPE
(NIL (OR ATM (SETQ ATM (CONCAT " "))) (* A unique, but invisible tag)
(SETQQ TYPE expression))
(PROP (SETQQ TYPE FNS))
NIL)
(PROG [(W (OR (FINDEDITW ATM TYPE)
(MAKEEDITW ATM TYPE]
(RESETSAVE \DEDITWINDOWS (CONS W \DEDITWINDOWS))
(RESETSAVE NIL (LIST (QUOTE UNDEDITW)
\DEDITWINDOWS))
(RETURN (WINDOWPROP W (QUOTE DSP])
(MAKEEDITW
[LAMBDA (NAME TYP) (* bas: "18-MAR-83 14:26")
(ACTIVEEDITW (PROG [(W (if (TOPEDITW)
then (WINDOWPROP (TOPEDITW)
(QUOTE DEDITCACHED))
else (WINDOWP DEditWindow]
(DECLARE (USEDFREE EDITCHANGES))
(AND (if (NOT W)
then (SETQ W (CREATEW NIL (NAMEOFEDITW NAME TYP)))
elseif (NOT (SAMEEDITW W NAME TYP))
then (WINDOWPROP W (QUOTE TITLE)
(NAMEOFEDITW NAME TYP))
T)
(WINDOWPROP W (QUOTE DEDITWHOAMI)
(LIST NAME TYP)))
(WINDOWPROP W (QUOTE DEDITCHANGES)
EDITCHANGES) (* Associates changes with changed structure)
(RETURN W))
T])
(NAMEOFEDITW
[LAMBDA (NAME TYPE) (* bas: "30-MAR-83 18:41")
(CONCAT "DEdit of " (SELECTQ TYPE
(FNS "function")
(PROPS (if (CADR (LISTP NAME))
then (PROG1 (CONCAT (CADR NAME)
" property of ")
(SETQ NAME (CAR NAME)))
else "property list of"))
(VARS (if (AND (STREQUAL (SUBSTRING NAME -4 -1)
"COMS")
(HASDEF (SUBSTRING NAME 1 -5)
(QUOTE FILE)))
then (PROG1 "filecoms for file" (SETQ NAME
(SUBSTRING NAME 1 -5)))
else "variable"))
TYPE)
" " NAME])
(PURGEW
[LAMBDA (W DONTCLR) (* bas: "21-MAR-83 19:48")
(PROG [(WDS (if (WINDOWP W)
then (WINDOWPROP W (QUOTE DSP))
else (PROG1 W (SETQ W (WFROMDS W]
[if (EQ W DEditWindow)
then (CLRHASH \DEDITMEHASH)
(CLRHASH \DEDITDPHASH)
else (MAPHASH \DEDITMEHASH (FUNCTION (LAMBDA (X Y)
(AND (EQ WDS (fetch PDSP of X))
(PUTHASH Y NIL \DEDITMEHASH]
(WINDOWPROP W (QUOTE EDITEXPR)
NIL)
(if DONTCLR
else (DSPTEXTURE WHITESHADE W)
(DSPFONT (CADR DEFAULTFONT)
W) (* Font first to get CLEARW right)
(CLEARW W)
(MAKECPOSBE NIL 62000 W)))
W])
(MAKECPOSBE
[LAMBDA (X Y DS) (* bas: "17-MAR-83 18:48")
(PROG ((DX (if (FIXP X)
then (IDIFFERENCE X (DSPXPOSITION NIL DS))
else 0))
(DY (if (FIXP Y)
then (IDIFFERENCE Y (DSPYPOSITION NIL DS))
else 0)))
(WXOFFSET (IMINUS DX)
DS)
(WYOFFSET (IMINUS DY)
DS)
(RELMOVETO DX DY DS])
(SAMEEDITW
[LAMBDA (W NAME TYPE) (* bas: "15-FEB-82 18:16")
(PROG [(TMP (WINDOWPROP W (QUOTE DEDITWHOAMI]
(RETURN (AND TMP (EQ NAME (CAR TMP))
(EQ TYPE (CADR TMP])
(TOPEDITW
[LAMBDA NIL (* bas: "18-MAR-83 15:25")
(CAR \DEDITWINDOWS])
(UNDEDITW
[LAMBDA (WDS) (* bvm: " 4-NOV-83 17:56")
(* Desensitizes DEDIT windows and removes surplus ones)
(COND
(\DEDITMNUW (WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
NIL)
(CLOSEW \DEDITMNUW)))
(PROG [(W (WFROMDS (OR (CAR (LISTP WDS))
(SHOULDNT]
(COND
([AND \DEDITBUFW (EQ \DEDITBUFW (WINDOWPROP W (QUOTE EDITBUF]
(TAKEDOWN \DEDITBUFW)
(SETQ \DEDITBUFW NIL)))
(DECLARE (USEDFREE DEditLinger))
[COND
((EQ WDS \DEDITWINDOWS)
(SETQ \DEDITWINDOWS (CDR WDS)))
(T (for I on WDS when (EQ WDS (CDR I)) do (RETURN (RPLACD I (CDDR I)))
finally (SHOULDNT "DEDITDSPS tangled"]
(COND
[(CDR WDS)
(COND
((FMEMB W (CDR WDS)))
(T (WINDOWPROP W (QUOTE DEDITCACHED)
NIL) (* Discard my cache; cache me on next)
(WINDOWPROP (CADR WDS)
(QUOTE DEDITCACHED)
W)
(SETQ \DEDITBUFW (WINDOWPROP (CADR WDS)
(QUOTE EDITBUF)))
(TAKEDOWN W]
(T (AND RESETSTATE (CADR (WINDOWPROP W (QUOTE DEDITCHANGES)
NIL))
(ZORCHEDITW W))
(OR (WINDOWP DEditWindow)
(SETQ DEditWindow W))
(OR DEditLinger (CLOSEW W])
(WHICHEDITW
[LAMBDA (CC) (* bas: " 4-FEB-83 15:45")
(bind SCR for TMP from (GETME4 CC) by (fetch BP of TMP) while TMP
do (AND (SETQ SCR (EDITWINDOWP (fetch PDSP of TMP)))
(RETURN SCR])
(ZORCHEDITW
[LAMBDA (W) (* bas: " 5-FEB-83 19:03")
(AND W (PURGEMAP (GETMAP? W))
(ACTIVEWP (WFROMDS W))
(PROGN (DSPTEXTURE CHANGEDSHADE W)
(DSPFILL NIL CHANGEDSHADE (QUOTE PAINT)
W])
)
(DEFINEQ
(BUFSELP
[LAMBDA (E) (* bas: "21-MAR-83 19:53")
(AND E \DEDITBUFW (EQ (fetch PDSP of E)
(WINDOWPROP \DEDITBUFW (QUOTE DSP])
(EDITWINDOWP
[LAMBDA (W) (* rmk: " 1-SEP-83 11:23")
(AND (OR (WINDOWP W)
(DISPLAYSTREAMP W))
(WINDOWPROP W (QUOTE EDITEXPR))
(WINDOWPROP W (QUOTE DSP])
(GETLEFT
[LAMBDA (SEL BK) (* bas: "16-MAR-83 09:45")
(AND (OR BK (SETQ BK (fetch BP of SEL)))
(for I on (fetch SELEXP of BK) when (if (LISTP (CDR I))
then (EQ (CDR I)
(fetch TAIL of SEL))
elseif (CDR I)
then (EQ (CDR I)
(fetch SELEXP of SEL))
else NIL)
do (RETURN (GETME4 I])
(GETMEBP
[LAMBDA (E) (* bas: "13-OCT-81 16:21")
(OR (fetch BP of E)
(CANT "At top"])
(INTAILOF
[LAMBDA (M F) (* bas: "21-MAR-83 19:58")
(if (type? DEDITMAP M)
then (AND (EQ F (fetch BP of M))
(INTAILOF (fetch TAIL of M)
F))
elseif (LISTP M)
then [OR (TAILP M (fetch SELEXP of F))
(AND (CDR (LISTP M))
(NLISTP (CDR M))
(EQ M (GETHASH (fetch TAIL of F)
\DEDITDPHASH]
elseif M
then (EQ M (DOTTEDEND (fetch SELEXP of F])
(TAILOF
[LAMBDA (A B) (* bas: "16-MAR-83 12:22")
(OR (TAILP A B)
(AND (SETQ A (DPCDRSEL A))
(TAILP B (fetch SELEXP of (fetch BP of A])
(DOTTEDEND
[LAMBDA (C) (* bas: "16-MAR-83 21:32")
(if (LISTP C)
then (CDR (LAST C))
else C])
(GETME4
[LAMBDA (C B) (* bas: "30-MAR-83 16:19")
(AND C
(OR (GETHASH C \DEDITMEHASH)
(SELECTQ B
(NIL NIL)
(T (SHOULDNT "No MapEntry"))
(PROGN (OR [INTAILOF C (OR (MAPENTRYP B)
(SETQ B (GETME4 B T]
(SHOULDNT "Invalid BP"))
(if (NLISTP C)
then (GETDPME B)
elseif [MAPENTRYP (MAPHASH \DEDITMEHASH
(FUNCTION (LAMBDA (X Y)
(AND (EQ B (fetch BP of X))
(EQUAL C Y)
(PROGN (PUTHASH Y NIL \DEDITMEHASH)
(replace TAIL of X
with C)
(PUTHASH C X \DEDITMEHASH)
(RETFROM (QUOTE MAPHASH)
X]
else (DEARME B])
(GETSELMAP
[LAMBDA (X) (* bas: "13-MAR-83 19:59")
(* Gets ME iff it is unpurged ie visible for a
SHADESELECTIOn etc)
(AND X (SETQ X (GETME4 X))
(NOT (fetch PURGED of X))
X])
(DEARME
[LAMBDA (B) (* bas: " 7-MAR-83 22:49")
(REPP B)
(for (SP ←(REALSTKNTH -1 (QUOTE GETME4))) by (STKPOS (STKNAME SP)
-1
(STKNTH -1 SP SP)
SP)
while SP when (EQ B (STKARG 1 SP)) do (RETEVAL SP [CONS (STKNAME SP)
(CONS (GETME4 (fetch TAIL
of B)
T)
(CDR (STKARGS SP]
T)
finally (RETURN (GETME4 (fetch TAIL of B)
T])
(DPCDRSEL
[LAMBDA (ME) (* bas: "21-MAR-83 19:58")
(AND [OR (type? DEDITMAP ME)
(AND (CDR (LISTP ME))
(NLISTP (CDR ME))
(SETQ ME (GETME4 ME]
(fetch BP of ME)
(EQ ME (GETDPME (fetch BP of ME)))
ME])
(GETDPME
[LAMBDA (B) (* bas: "21-MAR-83 19:48")
(GETME4 (GETHASH (fetch TAIL of B)
\DEDITDPHASH)
T])
(GETEBUF
[LAMBDA (ACTP) (* bas: "21-MAR-83 19:53")
(PROG ((REG (WINDOWPROP (TOPEDITW)
(QUOTE REGION)))
(EBW (WINDOWPROP (TOPEDITW)
(QUOTE EDITBUF)))
TR X Y W H)
(SETQ X (fetch LEFT of REG))
(SETQ W (fetch WIDTH of REG))
(SETQ H 72)
(AND \DEDITBUFW (NEQ EBW \DEDITBUFW)
(CLOSEW \DEDITBUFW))
(if (NOT EBW)
then (SETQ \DEDITBUFW (CREATEW (create REGION
LEFT ← X
BOTTOM ←(IDIFFERENCE (fetch BOTTOM of REG)
H)
WIDTH ← W
HEIGHT ← H)
"Edit buffer"))
(WINDOWPROP (TOPEDITW)
(QUOTE EDITBUF)
\DEDITBUFW)
elseif (PROGN (PURGEW (SETQ \DEDITBUFW EBW))
(SETQ TR (WINDOWPROP \DEDITBUFW (QUOTE REGION)))
[SETQ Y (IDIFFERENCE (fetch BOTTOM of REG)
(SETQ H (fetch HEIGHT of TR]
(NEQ W (fetch WIDTH of TR)))
then (* No DEdit specific reshaping will happen b/c window
has been purged)
(SHAPEW \DEDITBUFW
(create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H))
elseif (NEQ X (fetch LEFT of TR))
then (MOVEW \DEDITBUFW (create POSITION
XCOORD ← X
YCOORD ← Y))
(OPENW \DEDITBUFW)
else (OPENW \DEDITBUFW))
(RETURN (WINDOWPROP (ACTIVEEDITW \DEDITBUFW ACTP)
(QUOTE DSP])
(GETEDITCHAIN
[LAMBDA (E) (* bas: "30-MAR-83 21:45")
(DECLARE (USEDFREE LASTAIL))
(if (LISTP E)
then (SETQ LASTAIL E)
(SETQ E (OR (GETME4 E)
E))
elseif (type? DEDITMAP E)
then (SETQ LASTAIL (fetch TAIL of E))
elseif E
then (SHOULDNT))
(OR (LISTP E)
(for (I ← E) by (fetch BP of I) while I collect (fetch SELEXP of I])
(GETMAP
[LAMBDA (DS) (* bas: "14-MAY-82 16:02")
(OR (GETMAP? DS)
(SETDEDITMAP DS (WINDOWPROP DS (QUOTE EDITEXPR])
(GETMAP?
[LAMBDA (W) (* bas: " 9-MAR-83 16:39")
(PROG [(WM (GETME4 (WINDOWPROP W (QUOTE EDITEXPR]
(AND WM (NOT (PURGEDP WM))
(RETURN WM])
(PURGEMAP
[LAMBDA (M) (* bas: "11-MAR-83 14:52")
(if M
then (replace PURGED of M with (QUOTE PURGED)) (* Mark as dead))
M])
(PURGEDP
[LAMBDA (M) (* bas: "30-MAR-83 16:19")
(* This is unfortunately an expensive operation as some edit operations can cut a cons out of the structure being
edited without that being obvious at the time it happens. The only way therefore to be sure that a ME really is
valid is to chase its BPs all the way out to the top.)
(OR (fetch PURGED of M)
(AND [OR (NEQ M (GETME4 (fetch TAIL of M)))
(AND (fetch BP of M)
(OR (NOT (INTAILOF M (fetch BP of M)))
(PURGEDP (fetch BP of M]
(PURGEMAP M])
(SUBSELOF
[LAMBDA (TOP SUB) (* bas: " 7-AUG-83 16:46")
(for (S2 ←(GETME4 SUB)) by (fetch BP of S2) while S2 until (fetch PURGED of S2)
thereis (EQ TOP (fetch SELEXP of S2])
(SETDEDITMAP
[LAMBDA (DW V) (* bas: "24-MAR-83 14:31")
(PURGEW DW) (* Remove EDITEXPR and reset window)
[SETQ V (DEPRINTDEF (OR (LISTP V)
(LIST V))
(DSPLEFTMARGIN NIL DW)
(QUOTE DEFAULTFONT)
(WINDOWPROP DW (QUOTE DSP]
(WINDOWPROP DW (QUOTE EDITEXPR)
(fetch TAIL of V))
[WINDOWPROP DW (QUOTE EXTENT)
(create REGION
LEFT ← 0
BOTTOM ←(LOWPT V)
WIDTH ←(WINDOWPROP DW (QUOTE WIDTH))
HEIGHT ←(ADD1 (IDIFFERENCE (HIPT V)
(LOWPT V]
V])
(TAKEDOWN
[LAMBDA (WDS) (* bas: "11-NOV-82 19:38")
(PURGEW WDS T)
(CLOSEW WDS])
)
(DEFINEQ
(DEDITRESHAPEFN
[LAMBDA (W X1 X2) (* bas: "24-MAR-83 15:34")
(AND (EDITWINDOWP W)
(RESETFORM (CURSOR WAITINGCURSOR)
(SETDEDITMAP W (WINDOWPROP W (QUOTE EDITEXPR)))
(AND (EQ W (TOPEDITW))
(SETEDITMENU W))
(FLIPSELSIN W])
(DEDITSCROLLFN
[LAMBDA (W DX DY CFLG) (* bas: "24-MAR-83 15:37")
(FLIPSELSIN W)
(SCROLLBYREPAINTFN W DX DY CFLG)
(FLIPSELSIN W])
(DEDITREPAINTFN
[LAMBDA (WDS R) (* bas: " 5-FEB-83 18:16")
(REFRESHIF WDS (fetch PTOP of R)
(fetch BOTTOM of R])
)
(DEFINEQ
(SETEDITMENU
[LAMBDA (EW) (* bas: "24-MAR-83 13:58")
(DECLARE (GLOBALVARS \DEDITCOMS))
(PROG ((ER (WINDOWPROP EW (QUOTE REGION)))
[MR (AND (WINDOWP \DEDITMNUW)
(WINDOWPROP \DEDITMNUW (QUOTE REGION]
X Y H W IMAGE)
(* The WINDOWP check on \DEDITMNUW is b/c it can be a displaystream if user interrupts out of READEDITMENU in
which case it must be rebuilt b/c of possible undone inversions)
(if MR
then (SETQ W (fetch WIDTH of MR))
(SETQ H (fetch HEIGHT of MR))
else (SETQ IMAGE (CACHEDEDITCOMS \DEDITCOMS))
(SETQ W (ITIMES 2 (SUB1 WBorder)))
(SETQ H (IPLUS (fetch BITMAPHEIGHT of IMAGE)
(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
W))
(SETQ W (IPLUS (fetch BITMAPWIDTH of IMAGE)
W)))
(SETQ X (IMIN (fetch RIGHT of ER)
(IDIFFERENCE SCREENWIDTH W)))
(SETQ Y (IMAX (IDIFFERENCE (IMIN SCREENHEIGHT (fetch PTOP of ER))
H)
0))
(if MR
then (if (OR (NEQ X (fetch LEFT of MR))
(NEQ Y (fetch BOTTOM of MR)))
then (PROG ((P (create POSITION
XCOORD ← X
YCOORD ← Y)))
(MOVEW \DEDITMNUW P)
(WINDOWPROP \DEDITMNUW (QUOTE HOME)
P)))
(OPENW \DEDITMNUW)
else [PROG ((NUR (create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H)))
(SETQ \DEDITMNUW (if (DISPLAYSTREAMP \DEDITMNUW)
then (PROG1 (WFROMDS \DEDITMNUW)
(SHAPEW \DEDITMNUW NUR))
else (CREATEW NUR (QUOTE EditOps]
(BITBLT IMAGE 1 1 \DEDITMNUW 0 0 W H (QUOTE INPUT)
(QUOTE REPLACE)) (* The 1,1 removes the menu border)
(WINDOWPROP \DEDITMNUW (QUOTE ITEMHEIGHT)
(FONTPROP MENUFONT (QUOTE HEIGHT)))
(WINDOWPROP \DEDITMNUW (QUOTE YOFFSET)
(IQUOTIENT H 2))
(WINDOWPROP \DEDITMNUW (QUOTE HOME)
(create POSITION
XCOORD ← X
YCOORD ← Y))
(WINDOWPROP \DEDITMNUW (QUOTE REPAINTFN)
(QUOTE DEDITMENURESTORE)))
(RETURN \DEDITMNUW])
(CACHEDEDITCOMS
[LAMBDA (CL) (* bas: "21-MAR-83 19:57")
(* Caches info from \DEDITCOMS into arrays in INVERSE
order for convenience of READEDITMENU)
(DECLARE (GLOBALVARS EDITMENU\COMS EDITMENU\SUBS))
(SETQ EDITMENU\COMS (ARRAY (LENGTH CL)
NIL NIL 0))
(SETQ EDITMENU\SUBS (ARRAY (ARRAYSIZE EDITMENU\COMS)
NIL NIL 0))
[for I in CL as J from (SUB1 (ARRAYSIZE EDITMENU\COMS)) by -1
do (SETA EDITMENU\COMS J (CONS (CAR I)
(CADR I)))
(SETA EDITMENU\SUBS J (AND (CDDR I)
(create MENU
ITEMS ←[for Q in (CDDR I)
collect (LIST (CAR Q)
(LIST (QUOTE QUOTE)
(CONS (CAR Q)
(CADR Q]
CENTERFLG ← T
MENUOFFSET ←(create POSITION
XCOORD ← -1
YCOORD ←(IQUOTIENT
(ITIMES (FONTPROP MENUFONT
(QUOTE HEIGHT))
(LENGTH (CDDR I)))
2]
(CHECK/MENU/IMAGE (create MENU
ITEMS ← CL
CENTERFLG ← T])
(DEFDEDITCOM
[LAMBDA (COM FORM SUP BEFORE) (* bas: "21-MAR-83 19:57")
(DECLARE (GLOBALVARS \DEDITCOMS))
(SETQ \DEDITCOMS (CONS NIL \DEDITCOMS)) (* Finesse empty list case)
(PROG1 (PROG (CDEF AC SC)
[AND SUP (SETQ SC (CDADR (OR (LISTP (FINDEDITCOM SUP \DEDITCOMS))
(RETURN]
(if (SETQ AC (FINDEDITCOM COM (OR SC \DEDITCOMS)))
then (* Delete old entry)
(/RPLACD AC (CDDR AC)))
(SETQ CDEF (LIST COM (SELECTQ FORM
(NIL (RETURN))
(T (PACK* (QUOTE DEDIT)
COM))
FORM)))
(AND BEFORE (SETQ AC (FINDEDITCOM BEFORE (OR SC \DEDITCOMS)
T)))
(if AC
then (/RPLACD AC (CONS CDEF (CDR AC)))
else (/NCONC (OR SC \DEDITCOMS)
(LIST CDEF)))
(RETURN CDEF))
(SETQ \DEDITCOMS (CDR \DEDITCOMS))
(SETQ \DEDITMNUW NIL])
(FINDEDITCOM
[LAMBDA (C L EFLG) (* bas: "19-NOV-82 15:28")
(for I on L thereis (OR (EQUAL C (CAR (CADR I)))
(AND EFLG (NOT (CDR I])
(READEDITMENU
[LAMBDA NIL (* bas: "21-MAR-83 19:54")
(DECLARE (GLOBALVARS EDITMENU\COMS EDITMENU\SUBS))
(bind OTHERS N OLDN ISDOWN EMDS (VLF ←(WINDOWPROP \DEDITMNUW (QUOTE ITEMHEIGHT)))
first (PROGN [SETQ \DEDITMNUW (SETQ EMDS (WINDOWPROP \DEDITMNUW (QUOTE DSP]
(* Clear menu to protect against ↑E)
)
eachtime (GETMOUSESTATE) while [AND (EQ \DEDITMNUW EMDS)
(NOT (READP T))
[OR (INWINDOW EMDS)
(AND OTHERS (KEYDOWNP (QUOTE CTRL]
(OR (NOT N)
(if (KEYDOWNP (QUOTE CTRL))
then (PROG1 (push OTHERS (CONS OLDN N))
(SETQ N NIL]
when (INWINDOW EMDS)
do (SETQ N (IQUOTIENT (LASTMOUSEY EMDS)
VLF)) (* Index from bottom)
(if (EQ N OLDN)
then (\BACKGROUND) (* Nothing going on)
else [OR (FASSOC OLDN OTHERS)
(SHADEMENUENTRY OLDN EMDS VLF (if (EQ ISDOWN OLDN)
then (QUOTE FILL)
else (QUOTE BOX]
(OR (FASSOC N OTHERS)
(SHADEMENUENTRY N EMDS VLF (QUOTE BOX)))
(SETQ OLDN N))
(SETQ N (if (LASTMOUSESTATE (NOT UP))
then (OR (EQ ISDOWN N)
(SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW)))
(SETQ ISDOWN N)
[AND (LASTMOUSESTATE (NOT RED))
(ELT EDITMENU\SUBS N)
(OR (MENU (ELT EDITMENU\SUBS N))
(PROG1 (SETQ ISDOWN NIL)
(SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW]
elseif ISDOWN
then (SETQ ISDOWN NIL)
(ELT EDITMENU\COMS N)))
finally [OR (FASSOC OLDN OTHERS)
(SHADEMENUENTRY OLDN EMDS VLF (if (OR N ISDOWN)
then (QUOTE FILL)
else (QUOTE BOX]
(for I in OTHERS do (SHADEMENUENTRY (CAR I)
EMDS VLF (QUOTE FILL)))
[AND N OLDN (WINDOWPROP EMDS (QUOTE YOFFSET)
(ITIMES VLF (ADD1 OLDN]
(SETQ \DEDITMNUW (if \DEDITMNUW
then (WFROMDS EMDS)
else EMDS)) (* Exited cleanly, restore global)
(RETURN (if OTHERS
then [AND N (bind CS XS for I in (CONS (CONS OLDN N)
OTHERS)
do (push CS (CADR I))
[push XS (OR (LISTP (CDDR I))
(LIST (CDDR I]
finally (RETURN (CONS CS (CONS (QUOTE PROGN)
XS]
else N])
(SHADEMENUENTRY
[LAMBDA (V EMDS DLF BOXFLG) (* bas: "28-OCT-82 18:28")
(AND V (SELECTQ BOXFLG
(FILL (BITBLT NIL NIL NIL EMDS 0 (ITIMES V DLF)
1000 DLF (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
(HOLLOW (BITBLT NIL NIL NIL EMDS 1 (ADD1 (ITIMES V DLF))
(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL EMDS))
2)
(IDIFFERENCE DLF 2)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
(BOX (* FILL then HOLLOW)
(BITBLT NIL NIL NIL EMDS 0 (ITIMES V DLF)
1000 DLF (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(BITBLT NIL NIL NIL EMDS 1 (ADD1 (ITIMES V DLF))
(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL EMDS))
2)
(IDIFFERENCE DLF 2)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE))
(SHOULDNT])
(DEDITMENURESTORE
[LAMBDA (W R) (* bas: "24-MAR-83 14:04")
(* If \DEDITMNUW is a display stream it is considered to have flaky contents and will be regenerated.
If we are under a READEDITMENU, \DEDITMNUW is ALREADY a display steam, so we set it to NIL to signal READEDITMENU
not to restore it.)
(SETQ \DEDITMNUW (if (EQ \DEDITMNUW W)
then (WINDOWPROP W (QUOTE DSP))
else NIL])
)
(DEFINEQ
(RESETDEDIT
[LAMBDA NIL (* rmk: " 3-Jan-84 13:15")
(DECLARE (GLOBALVARS \DEDITCOMS))
[PROGN (MOVD? (QUOTE MARKASCHANGED)
(QUOTE NORMAL/MARKASCHANGED))
(MOVD (QUOTE DEDITMARKASCHANGED)
(QUOTE MARKASCHANGED))
(MOVD? (QUOTE EDITDATE)
(QUOTE NORMAL\EDITDATE))
(MOVD (QUOTE DEDITDATE)
(QUOTE EDITDATE))
(MOVD? (QUOTE EDITL)
(QUOTE NORMAL/EDITL))
(EDITMODE (COND
((BOUNDP (QUOTE DEditMode))
DEditMode)
(T (QUOTE DISPLAY]
(PROGN (for I in (CONS DEditWindow (LISTP \DEDITWINDOWS)) when (WINDOWP I) do (CLOSEW I))
(SETQ DEditWindow NIL) (* Initialize DEDIT globals)
(SETQ \DEDITWINDOWS NIL)
(SETQ \DEDITALLOWSELS NIL)
(SETQ \DEDITSELECTIONS NIL)
(SETQ \DEDITBUFW NIL)
(SETQ \DEDITMNUW NIL)
(SETQ \DEDITMEHASH (HASHARRAY 255))
(SETQ \DEDITDPHASH (HASHARRAY 255))
(SETQ \DEDITCOMS NIL)
(DEDITResetTypeComs)) (* Rest of code sets initial DEDIT commands)
(for I in (QUOTE (After Before Delete Replace Switch Undo Find Swap Reprint Edit EditCom Break
Eval Exit))
do (DEFDEDITCOM I T))
(PROGN (DEFDEDITCOM "( )" (QUOTE DEDITBI)
NIL
(QUOTE Undo))
(for I in (QUOTE (("( ) in" DEDITBI)
("( in" DEDITLI)
(") in" DEDITRI)))
do (DEFDEDITCOM (CAR I)
(CADR I)
"( )")))
(PROGN (DEFDEDITCOM "( ) out" (QUOTE DEDITBO)
NIL
(QUOTE Undo))
(for I in (QUOTE (("( ) out" DEDITBO)
("( out" DEDITLO)
(") out" DEDITRO)))
do (DEFDEDITCOM (CAR I)
(CADR I)
"( ) out")))
(PROGN (DEFDEDITCOM (QUOTE Undo)
T
(QUOTE Undo))
(DEFDEDITCOM (QUOTE !Undo)
(QUOTE (DEDITUndo T))
(QUOTE Undo))
(DEFDEDITCOM (QUOTE ?Undo)
(QUOTE (UNDOCHOOSE))
(QUOTE Undo))
(DEFDEDITCOM (QUOTE &Undo)
(QUOTE (UNDOCHOOSE T))
(QUOTE Undo)))
(PROGN (DEFDEDITCOM (QUOTE Center)
T
(QUOTE Swap))
(DEFDEDITCOM (QUOTE Clear)
(QUOTE (SETQ \DEDITSELECTIONS NIL))
(QUOTE Swap))
(DEFDEDITCOM (QUOTE Copy)
T
(QUOTE Swap))
(DEFDEDITCOM (QUOTE Pop)
(QUOTE (POPSELECTION))
(QUOTE Swap))
(DEFDEDITCOM (QUOTE Swap)
T
(QUOTE Swap)))
[for I in (QUOTE (DEdit TTYEdit TTYIn))
do (for J in (QUOTE (Def Form)) do (DEFDEDITCOM (PACK* I " " J)
(LIST (QUOTE DEDITEdit)
(SELECTQ I
(DEdit (QUOTE (QUOTE DISPLAY)))
(TTYEdit (QUOTE (QUOTE TELETYPE)
))
(KWOTE I))
(KWOTE J))
(QUOTE Edit]
[PROGN (DEFDEDITCOM (QUOTE ?=)
(QUOTE DEDITARGS)
(QUOTE EditCom))
(for I in (QUOTE (GETD CL DW REPACK CAP LOWER RAISE)) do (DEFDEDITCOM I
(LIST (QUOTE
DEDITEditCom)
(KWOTE I))
(QUOTE EditCom]
(PROGN (DEFDEDITCOM (QUOTE OK)
(QUOTE DEDITExit)
(QUOTE Exit))
(DEFDEDITCOM (QUOTE STOP)
(QUOTE (DEDITExit T))
(QUOTE Exit)))
T])
(DEDITDATE
[LAMBDA (OLDATE INITLS) (* bas: " 5-FEB-83 19:36")
(PROG1 (NORMAL\EDITDATE OLDATE INITLS)
(PROG (ODM W)
(AND (SETQ ODM (GETME4 (LISTP OLDATE)))
(SETQ ODM (fetch BP of ODM))
[ACTIVEWP (SETQ W (WFROMDS (fetch PDSP of ODM]
(GETMAP? W)
(REPP ODM])
(DEDITMARKASCHANGED
[LAMBDA (NAME TYPE REASON) (* bas: "18-MAR-83 15:25")
(PROG1 (NORMAL/MARKASCHANGED NAME TYPE REASON)
(* MARKASCHANGED is called after DEDITL exits. Hence a scan of the \DEDITWINDOWS chain finds all active DEDITs
excluding the one just exited. The separate test on DEditWindow discriminates between exit from topmost DEDIT and
other changes to the top level window)
(ZORCHEDITW (if (FINDEDITW NAME TYPE)
else (AND (WINDOWP DEditWindow)
(SAMEEDITW DEditWindow NAME TYPE)
(NOT (CADR (WINDOWPROP DEditWindow (QUOTE DEDITCHANGES)
NIL)))
DEditWindow])
)
(DEFINEQ
(DEDITResetTypeComs
[LAMBDA NIL (* bvm: "25-OCT-83 18:31")
(SETQ DEditTypedCom "TypedCom")
(SETQ DEDITTTBL (COPYTERMTABLE NIL))
(SETQ DEDITRDTBL (COPYREADTABLE T))
(bind CH for TRIPLE in DEDITTYPEINCOMS
do [SETQ CH (IPLUS (CHCON1 (CAR TRIPLE))
(IDIFFERENCE (CHARCODE ↑A)
(CHARCODE A]
(ECHOCONTROL CH (QUOTE IGNORE)
DEDITTTBL)
(SETSYNTAX CH [BQUOTE (MACRO FIRST IMMEDIATE (LAMBDA (F R)
(CONS DEditTypedCom (QUOTE , (CADR TRIPLE]
DEDITRDTBL])
(DEDITTYPEDCOM
[LAMBDA (NAME) (* bvm: "25-OCT-83 18:30")
(for TRIPLE in DEDITTYPEINCOMS when (EQ (CADR TRIPLE)
NAME)
do (printout T NAME ": ")
(RETURN (CONS NAME (CONS (CADDR TRIPLE)
(DEDITREADLINE T])
)
(DEFINEQ
(COPYCONS
[LAMBDA (C) (* bas: "22-FEB-82 14:20")
(CONS (CAR C)
(CDR C])
(MAPENTRYP
[LAMBDA (V) (* bas: "21-MAR-83 19:58")
(AND (type? DEDITMAP V)
V])
(THELIST
[LAMBDA (X) (* bas: "21-JUL-82 18:11")
(OR (LISTP X)
(CANT "Not a list!"])
)
(DEFINEQ
(CANT
[LAMBDA NMSGS (* bas: " 9-AUG-82 12:14")
(* Report error by flashing window)
(DSPRESET PROMPTWINDOW)
(printout PROMPTWINDOW T "Cant:")
(for I to NMSGS do (printout PROMPTWINDOW , (ARG NMSGS I)))
(DSPFILL NIL BLACKSHADE (QUOTE INVERT)
PROMPTWINDOW)
(DISMISS 100)
(DSPFILL NIL BLACKSHADE (QUOTE INVERT)
PROMPTWINDOW)
(ERROR!])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD STACK (TOPELT NXTELT)
(CREATE NIL))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS EDITBLOCKCALL MACRO (F (CONS (PACK* (QUOTE \EDITBLOCK/)
(CAR F))
(CDR F))))
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DEDITTYPECOMS DEditTypedCom DEDITTTBL DEDITRDTBL)
)
(ADDTOVAR DEDITTYPEINCOMS (F Find [NLAMBDA (TGT)
(PUSHSELECTION (LIST TGT))
(DEDITSwap)
(DEDITFind])
[S Substitute (NLAMBDA (OLD NEW)
(DEDITEditCom (LIST (QUOTE R)
OLD NEW]
(Z EditCom [NLAMBDA EC (DEDITEditCom EC]))
(PUTPROPS DEDITTYPEINCOMS VARTYPE ALIST)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS ATM EDITCHANGES EDITHIST LASTAIL UNDOLST UNDOLST1)
)
(ADDTOVAR DT.EDITMACROS )
(RPAQ? DEditLinger T)
(DECLARE: EVAL@COMPILE
(RPAQQ LINETHICKNESS 2)
(RPAQQ PRIMSHADE 65535)
(RPAQQ SECSHADE 3598)
(RPAQ SWITCHSHADE (LOGXOR PRIMSHADE SECSHADE))
(RPAQQ READSHADE 23130)
(RPAQQ CHANGEDSHADE 8840)
(CONSTANTS (LINETHICKNESS 2)
(PRIMSHADE 65535)
(SECSHADE 3598)
(SWITCHSHADE (LOGXOR PRIMSHADE SECSHADE))
(READSHADE 23130)
(CHANGEDSHADE 8840))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
DSPRINTDEF NEWPRINTDEF)
)
(DECLARE: DONTEVAL@COMPILE DOCOPY
(FILESLOAD DSPRINTDEF NEWPRINTDEF)
)
(AND (GETD (QUOTE RESETDEDIT))
(RESETDEDIT))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA EP EV EF DC DP DV DF)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CANT)
)
(PUTPROPS DEDIT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2920 5414 (DF 2930 . 3092) (DV 3094 . 3257) (DP 3259 . 3435) (DC 3437 . 3867) (EF 3869
. 4032) (EV 4034 . 4198) (EP 4200 . 4377) (EDITPROP 4379 . 4607) (EDITMODE 4609 . 5243) (DEDITIT 5245
. 5412)) (5415 12082 (DEDITL 5425 . 8393) (DEDITL0 8395 . 10698) (DEDITTTYFN 10700 . 12080)) (12083
25060 (DEDITAfter 12093 . 12481) (DEDITBefore 12483 . 12840) (DEDITDelete 12842 . 13412) (DEDITReplace
13414 . 13702) (DEDITSwitch 13704 . 14067) (DEDITBI 14069 . 14643) (DEDITBO 14645 . 14890) (DEDITLI
14892 . 15079) (DEDITLO 15081 . 15272) (DEDITRI 15274 . 15628) (DEDITRO 15630 . 15841) (DEDITUndo
15843 . 16374) (UNDOCHOOSE 16376 . 17118) (DEDITFind 17120 . 17633) (DEDITSwap 17635 . 17920) (
DEDITCenter 17922 . 18733) (DEDITCopy 18735 . 18899) (DEDITReprint 18901 . 19059) (DEDITCEdit 19061 .
19614) (DEDITEdit 19616 . 20760) (DEDITDatatype 20762 . 21974) (DEDITEditCom 21976 . 22771) (DEDITARGS
22773 . 23104) (DEDITBreak 23106 . 24397) (DEDITEval 24399 . 24699) (DEDITExit 24701 . 25058)) (25061
33686 (SETPTRTO 25071 . 25659) (DEDITCONS 25661 . 25909) (DEDITZAPCAR 25911 . 26101) (DEDITZAPCDR
26103 . 26298) (DEDITZAPNODE 26300 . 26454) (DEDITZAPBOTH 26456 . 28725) (DEDITFZAP 28727 . 29407) (
DEDITZAPCLISP 29409 . 30239) (DEDITZAPCHANGES 30241 . 30970) (DEDITNCONC 30972 . 31136) (DUNDOEDITL
31138 . 32008) (DUNDOEDITCOM 32010 . 32984) (DUNDOEDITCOM1 32986 . 33684)) (33687 44465 (BSELECT 33697
. 35382) (DEDITUSER 35384 . 35795) (SELECTKEYS 35797 . 36816) (DEDITREADLINE 36818 . 37895) (
SHADEIFNOTBUF 37897 . 38099) (DEDITBUTTONFN 38101 . 38511) (DEDITWINDOWENTRYFN 38513 . 39063) (
DEDITRIGHTBUTTONFN 39065 . 39322) (SELECTELEMENT 39324 . 40023) (SELECTREAD 40025 . 40829) (SELECTTREE
40831 . 41216) (SEARCHMAP 41218 . 42154) (WITHINME 42156 . 42974) (ONAPARENP 42976 . 43422) (
SELECTDONE 43424 . 43581) (INWINDOW 43583 . 43773) (FINDLCA 43775 . 43996) (DOMINATE? 43998 . 44463))
(44466 51707 (POPSELECTION 44476 . 44647) (PUSHSELECTION 44649 . 44801) (NXTSELECTION 44803 . 45021) (
TOPSELECTION 45023 . 45240) (SWITCHANDSHADE 45242 . 45748) (SHADESELECTION 45750 . 45903) (
SHADESELECTION1 45905 . 47577) (SHADESELECTION2 47579 . 47890) (PUSHEDITCHAIN 47892 . 48191) (
MAKESELCHAIN 48193 . 48983) (PUSHINTOBUF 48985 . 49127) (DUMMYMAPENTRY 49129 . 49524) (FLIPSELS 49526
. 49953) (FLIPSELSIN 49955 . 50528) (FIXUPSEL 50530 . 51267) (NEWSELFOR 51269 . 51705)) (51708 58220
(ACTIVEEDITW 51718 . 52617) (FINDEDITW 52619 . 52802) (GETEDITW 52804 . 53337) (MAKEEDITW 53339 .
54110) (NAMEOFEDITW 54112 . 54732) (PURGEW 54734 . 55492) (MAKECPOSBE 55494 . 55911) (SAMEEDITW 55913
. 56146) (TOPEDITW 56148 . 56278) (UNDEDITW 56280 . 57646) (WHICHEDITW 57648 . 57955) (ZORCHEDITW
57957 . 58218)) (58221 66797 (BUFSELP 58231 . 58428) (EDITWINDOWP 58430 . 58652) (GETLEFT 58654 .
59120) (GETMEBP 59122 . 59280) (INTAILOF 59282 . 59802) (TAILOF 59804 . 60024) (DOTTEDEND 60026 .
60198) (GETME4 60200 . 60992) (GETSELMAP 60994 . 61326) (DEARME 61328 . 61869) (DPCDRSEL 61871 . 62175
) (GETDPME 62177 . 62362) (GETEBUF 62364 . 63963) (GETEDITCHAIN 63965 . 64453) (GETMAP 64455 . 64637)
(GETMAP? 64639 . 64863) (PURGEMAP 64865 . 65084) (PURGEDP 65086 . 65754) (SUBSELOF 65756 . 66038) (
SETDEDITMAP 66040 . 66647) (TAKEDOWN 66649 . 66795)) (66798 67519 (DEDITRESHAPEFN 66808 . 67126) (
DEDITSCROLLFN 67128 . 67322) (DEDITREPAINTFN 67324 . 67517)) (67520 76171 (SETEDITMENU 67530 . 69777)
(CACHEDEDITCOMS 69779 . 70966) (DEFDEDITCOM 70968 . 71966) (FINDEDITCOM 71968 . 72172) (READEDITMENU
72174 . 74740) (SHADEMENUENTRY 74742 . 75675) (DEDITMENURESTORE 75677 . 76169)) (76172 80535 (
RESETDEDIT 76182 . 79454) (DEDITDATE 79456 . 79829) (DEDITMARKASCHANGED 79831 . 80533)) (80536 81439 (
DEDITResetTypeComs 80546 . 81126) (DEDITTYPEDCOM 81128 . 81437)) (81440 81884 (COPYCONS 81450 . 81585)
(MAPENTRYP 81587 . 81731) (THELIST 81733 . 81882)) (81885 82407 (CANT 81895 . 82405)))))
STOP