(FILECREATED "30-Jul-85 01:21:08" {ERIS}<LISPCORE>SOURCES>DEDIT.;16 89455
changes to: (FNS SETEDITMENU RESETDEDIT DEDITMARKASCHANGED)
(VARS DEDITCOMS)
previous date: "19-Jul-85 11:39:30" {ERIS}<LISPCORE>SOURCES>DEDIT.;13)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved. The following
program was created in 1982 but has not been published within the meaning of the copyright law, is
furnished under license, and may not be used, copied and/or disclosed except in accordance with the
terms of said license.)
(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 DEDITMOVETAILDOWN DUNDOEDITL DUNDOEDITCOM DUNDOEDITCOM1)
(FNS DEDITSLCTLP DEDITUSER DEDITTABCNTRL DEDITTABSON DEDITTABSOFF SELECTKEYS DEDITREADLINE
SHADEIFNOTBUF DEDITBUTTONFN DEDITRIGHTBUTTONFN DEDITWINDOWENTRYFN SELECTELEMENT
SELECTREAD SELECTTREE SEARCHMAP WITHINME ONAPARENP SELECTDONE INWINDOW FINDLCA DOMINATE?)
(FNS POPSELECTION PUSHSELECTION NXTSELECTION TOPSELECTION SWITCHANDSHADE SHADESELECTION
SHADESELECTION1 SHADESELECTION2 SHADEFIXER OVERLAPSELBAND PUSHEDITCHAIN MAKESELCHAIN
PUSHINTOBUF DUMMYMAPENTRY FLIPSELS FLIPSELSIN FIXUPSEL NEWSELFOR)
(FNS ACTIVEEDITW FINDEDITW GETEDITW GETDEDITDEF4 MAKEEDITW NAMEOFEDITW PURGEW MAKECPOSBE
SAMEEDITW SETUPDEDITW TOPEDITW UNDEDITW WHICHEDITW ZORCHEDITW ZORCHEDWP UNZORCHME)
(FNS BUFSELP EDITWINDOWP GETLEFT GETMEBP HASASBP TAILOF DOTTEDEND GETME4 GETSELMAP DEARME
DPCDRSEL GETDPME GETEBUF GETEDITCHAIN GETDEDITMAP GETMAP? UNPURGEDP SUBSELOF SETDEDITMAP
TAKEDOWN)
(FNS DEDITRESHAPEFN DEDITREPAINTFN)
(FNS SETEDITMENU CACHEDEDITCOMS DEFDEDITCOM FINDEDITCOM READEDITMENU SHADEMENUENTRY
DEDITMENURESTORE)
(FNS RESETDEDIT DEDITDATE DEDITMARKASCHANGED)
(FNS DEDITResetTypeComs DEDITTYPEDCOM)
(FNS COPYCONS COPYOUTCONS MAPENTRYP THELIST)
(FNS CANT)
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS UPFINDFLG)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS STACK)
(MACROS EDITBLOCKCALL OVERLAP SHIFTSELECTKEYS))
(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 (CHANGENAME (QUOTE EDITF)
(QUOTE ERROR)
(QUOTE EDITFERROR))
(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 (* lmm "14-Aug-84 19:04")
(DEDITIT (if (EQ (CADR (LISTP FN))
(QUOTE NEW))
then (QUOTE EDITFERROR)
else (QUOTE EDITF))
(NLAMBDA.ARGS FN)
(QUOTE DISPLAY])
(DV
[NLAMBDA VAR (* lmm "14-Aug-84 19:19")
(DEDITIT (QUOTE EDITV)
(NLAMBDA.ARGS VAR)
(QUOTE DISPLAY])
(DP
[NLAMBDA ATOM (* lmm "14-Aug-84 19:19")
(DEDITIT (QUOTE EDITPROP)
(NLAMBDA.ARGS ATOM)
(QUOTE DISPLAY])
(DC
[NLAMBDA FILE (* lmm " 1-Jul-85 21:48")
(* Edits commands of file FILE)
(DEDITIT (QUOTE EDITV)
(FILECOMS (OR (HASDEF (CAR (NLAMBDA.ARGS FILE))
(QUOTE FILE)
NIL T)
(ERROR FILE "is not a loaded file" T)))
(QUOTE DISPLAY])
(EF
[NLAMBDA FN (* lmm "14-Aug-84 19:11")
(DEDITIT (QUOTE EDITF)
(NLAMBDA.ARGS FN)
(QUOTE TELETYPE])
(EV
[NLAMBDA VAR (* lmm "14-Aug-84 19:11")
(DEDITIT (QUOTE EDITV)
(NLAMBDA.ARGS VAR)
(QUOTE TELETYPE])
(EP
[NLAMBDA ATOM (* lmm "14-Aug-84 19:03")
(DEDITIT (QUOTE EDITPROP)
(NLAMBDA.ARGS 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-84 21:47")
(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)
(SELECTQ NEWMODE
[TELETYPE (/PUTD (QUOTE EDITL)
(GETD (QUOTE NORMAL/EDITL)))
(/PUTD (QUOTE EDITDATE)
(GETD (QUOTE NORMAL\EDITDATE]
[DISPLAY (/PUTD (QUOTE EDITL)
(GETD (QUOTE DEDITL)))
(/PUTD (QUOTE EDITDATE)
(GETD (QUOTE DEDITDATE]
(\ILLEGAL.ARG NEWMODE)))
(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: "24-Jun-84 17:45")
(* 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 (fetch SELEXP of PM]
then (TOTOPW EDS) (* It may otherwise remain closed)
else (SETUPDEDITW EDS (LIST EXPR)))
(AND SEL (PUSHEDITCHAIN SEL)) (* ERSETQ prevents UNDOLST lossage due to ↑E)
(ERSETQ (bind EDITHIST COM ACT SS
do (until (SETQ COM (DEDITSLCTLP 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: "12-Sep-84 14:37")
(PROG ((TGT (POPSELECTION)))
(DEDITMOVETAILDOWN TGT NIL)
(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: "30-Sep-84 13:19")
(PROG (B (A (POPSELECTION)))
(OR (CDR A)
(CANT "RI at end of tail has no effect")) (* Has no effect and scrambles undo list)
[SETQ B (fetch TAIL of (GETMEBP (GETME4 A T]
(DEDITMOVETAILDOWN B (CDR A))
(DEDITZAPCDR A NIL)
(PUSHSELECTION B])
(DEDITRO
[LAMBDA NIL (* bas: "12-Sep-84 14:40")
(DEDITMOVETAILDOWN (TOPSELECTION)
NIL])
(DEDITUndo
[LAMBDA (END) (* bas: "12-Sep-84 23:54")
(bind FLG for LST on UNDOLST
do (OR FLG (SETQ FLG (CAAR LST)))
(DUNDOEDITCOM (CAR LST)
T)
repeatuntil (OR (NULL END)
(EQ END (CAR LST))
(NULL (CAR LST)))
finally (OR FLG (CANT (if (CDR LST)
then "Undo blocked"
else "Nothing saved"])
(UNDOCHOOSE
[LAMBDA (THRUP) (* bas: "22-Mar-84 23:14")
(PROG [(C (RESETFORM (CURSOR DEFAULTCURSOR)
(MENU (create MENU
ITEMS ←(APPEND (for I in UNDOLST
collect (LIST (OR (CAR I)
(PACK* "* " (CADR I)
" *"))
(KWOTE I)))
(LIST (LIST (QUOTE **TOP**)
NIL)))
TITLE ←(if THRUP
then "Undo Thru"
else "Undo One")
CENTERFLG ← T]
(if (NOT C)
elseif THRUP
then (DEDITUndo C)
else (DUNDOEDITCOM C T])
(DEDITFind
[LAMBDA NIL (* bas: " 5-Apr-84 23:21")
(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) (* Uses 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: "26-Mar-84 15:17")
(PROG [AW WO WH (A (GETME4 (TOPSELECTION]
(OR A (RETURN))
(SETQ AW (WFROMDS (fetch PDSP of A)))
(SETQ WO (WYOFFSET NIL AW))
(SETQ WH (WINDOWPROP AW (QUOTE HEIGHT)))
(AND NOTIFVIS (OVERLAPSELBAND A (IPLUS WO WH)
WO)
(RETURN)) (* Make sure the sel highlite is visible)
(RESETVARS (\DEDITSELECTIONS) (* Supress selections as they are not up and the scrollw
will otherwise take them down)
(SCROLLW AW 0 (IDIFFERENCE (IPLUS WO (IQUOTIENT (IDIFFERENCE
WH
(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) (* bas: "24-Jun-84 17:45")
(if (DEFINEDP (QUOTE TTYINEDIT))
then (PROG [V (EW (GETEBUF (TOPEDITW]
(SETQ V (TTYINEDIT E EW))
(if (CDR V)
then (* Replaced one expression with many)
(SETQ V (LIST V))
else V)
(OR (BUFSELP (GETME4 (TOPSELECTION)))
(BUFSELP (GETME4 (NXTSELECTION T)))
(SETUPDEDITW EW (COPY V)))
(RETURN V))
else (CANT "TTYIN not loaded"])
(DEDITEdit
[LAMBDA (EDITOR EDITEE) (* bas: "20-Apr-84 18:06")
(RESETLST (RESETSAVE (SETCURSOR DEFAULTCURSOR)
(LIST (QUOTE SETCURSOR)
WAITINGCURSOR))
(PROG [A (S (CAR (TOPSELECTION]
(SELECTQ EDITEE
((Def NIL)
(if (NOT (OR (LISTP S)
(LITATOM S)))
then (DEDITDatatype S)
elseif (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)))
then (RESETSAVE (EDITMODE EDITOR))
(* User can refuse all SELECT.ATOM.ASPECT choices)
(EDITDEF S A (QUOTE ?))
else (CANT "No editable aspect")))
[Form (AND [SETQ S (APPLY* (if (EQ EDITOR (QUOTE TTYIn))
then (FUNCTION DEDITCEdit)
else (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: "26-Mar-84 15:18")
(SETQ F (OR F (TOPSELECTION)))
(while (LISTP F) do (SETQ F (CAR F)))
(PUSHINTOBUF (LIST (CONS F (COPY (CAR (OR (AND (LITATOM F)
(NLSETQ (SMARTARGLIST F T)))
(QUOTE ((not a function])
(DEDITBreak
[LAMBDA NIL (* lmm " 1-JUL-84 23:33")
(PROG (WHO AMP CARFORM (A (POPSELECTION)))
(SETQ AMP (GETME4 A))
[SETQ WHO (AND AMP (WINDOWPROP (fetch PDSP of AMP)
(QUOTE DEDITWHOAMI]
(DEDITZAPCAR A (LIST (QUOTE BREAK1)
(CAR A)
T
[BREAKINCOMMENT WHO (LIST (QUOTE AROUND)
(if (NLISTP (CAR A))
then (CAR A)
else (CAAR A]
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: "19-Mar-84 09:44")
(PROG [(S (CAR (POPSELECTION)))
(SP (STKNTH 2 (QUOTE DEDITL0] (* There are various entry points.
They all call DEDITL0 after having done an ERRORSET.)
[PUSHINTOBUF (if (LITATOM S)
then (LIST (EVALV S SP))
elseif (ERSETQ (ENVAPPLY (FUNCTION LISPXEVAL)
(LIST S NIL)
SP))
else (LIST (QUOTE NOBIND]
(RELSTK SP])
(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: "12-Sep-84 16:25")
(PROG (XM BK TEM)
(if (NOT (SETQ XM (GETME4 X)))
then (CANT "Already deleted!")
elseif [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: "18-Mar-84 15:19")
(* 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 (SETQ CC (CAR CC))
(* We cant effect the dummy CONS held onto by the editor as that wont be seen by someone holding the defn
(old EDIT just took error here) Here we try to oblige by sliding down into the first cell of the defn But we have
to remove any pointers that the new CAR or CDR might have to the original cell, lest we create a cycle.)
(SETQ D (COPYOUTCONS (CDR A)
CC))
(SETQ A (COPYOUTCONS (CAR A)
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: "18-Mar-84 15:11")
(* 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])
(DEDITMOVETAILDOWN
[LAMBDA (C NUTAIL) (* bas: "12-Sep-84 14:41")
(* This moves C's current CDR to the end of the list which is its current CAR and replaces that CDR which it has
just moved with NUTAIL. Order of moves helps simplify REPP)
(DEDITZAPCDR (LAST (THELIST (CAR C)))
(PROG1 (CDR C)
(DEDITZAPCDR C NUTAIL])
(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: "12-Feb-84 21:25")
(* 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 \DSPRINTBP (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
(DEDITSLCTLP
[LAMBDA (CDS) (* bas: "20-Apr-84 12:11")
(* Does selections until a command is given)
(RESETLST (RESETSAVE (DEDITTABCNTRL T))
(RESETSAVE (DEDITUSER T))
(RESETSAVE \DEDITALLOWSELS T)
(CAR (ERSETQ (bind TMP
do (WAIT.FOR.TTY)
(SETEDITMENU (if (KEYDOWNP (QUOTE TAB))
then NIL
else CDS))
(AND (SETQ TMP (OR (AND (\SYSBUFP)
(SELECTKEYS (GETEBUF CDS)))
(READEDITMENU)))
(RETURN TMP))
(BLOCK])
(DEDITUSER
[LAMBDA (DS) (* bas: "12-Apr-84 20:17")
(FLIPSELS)
(SETCURSOR (if DS
then DEFAULTCURSOR
else WAITINGCURSOR))
(NOT DS])
(DEDITTABCNTRL
[LAMBDA (FLG) (* bas: "12-Apr-84 22:57")
(if FLG
then (DEDITTABSON (THIS.PROCESS))
else (DEDITTABSOFF (THIS.PROCESS)))
(PROCESSPROP (THIS.PROCESS)
(QUOTE TTYEXITFN)
(AND FLG (QUOTE DEDITTABSOFF)))
(PROCESSPROP (THIS.PROCESS)
(QUOTE TTYENTRYFN)
(AND FLG (QUOTE DEDITTABSON)))
(NOT FLG])
(DEDITTABSON
[LAMBDA (P1 P2) (* bas: "12-Apr-84 22:57")
(PROCESSPROP P1 (QUOTE TABACTION)
(KEYACTION (QUOTE TAB)
(QUOTE (NIL])
(DEDITTABSOFF
[LAMBDA (P1 P2) (* bas: "12-Apr-84 21:50")
(KEYACTION (QUOTE TAB)
(PROCESSPROP P1 (QUOTE TABACTION])
(SELECTKEYS
[LAMBDA (W) (* bas: "24-Jun-84 17:57")
(CAR (ERSETQ (RESETLST (RESETSAVE (TTYDISPLAYSTREAM W))
(RESETSAVE \DEDITALLOWSELS NIL)
(RESETSAVE NIL (LIST (QUOTE SETREADTABLE)
(SETREADTABLE DEDITRDTBL T)
T))
(RESETSAVE (SETTERMTABLE DEDITTTBL))
(RESETSAVE (DEDITTABCNTRL NIL))
(PROG ((LINE (DEDITREADLINE)))
(RETURN (if (EQ DEditTypedCom (CAR (LISTP LINE)))
then (DEDITTYPEDCOM (CDR LINE))
else (SHADEIFNOTBUF (NXTSELECTION T)
SECSHADE)
(* Push shading)
(SHADEIFNOTBUF (TOPSELECTION T)
SWITCHSHADE)
(SHADESELECTION (SETUPDEDITW W (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: " 1-Apr-84 15:34")
(TOTOPW W) (* Bring it up, if nothing else)
(if (SHIFTSELECTKEYS)
then (SELECTREAD W)
elseif \DEDITALLOWSELS
then (SELECTELEMENT W])
(DEDITRIGHTBUTTONFN
[LAMBDA (W) (* bas: " 1-Apr-84 15:31")
(TOTOPW W) (* Bring it up, if nothing else)
(if (AND \DEDITALLOWSELS (INWINDOW W))
then (SELECTTREE W)
else (DOWINDOWCOM W])
(DEDITWINDOWENTRYFN
[LAMBDA (W) (* bas: " 1-Apr-84 15:19")
(* Shift the tty process if not a shift select and not
currently tty proc)
(TOTOPW W) (* Bring it up, if nothing else)
(if (SHIFTSELECTKEYS)
then (SELECTREAD W)
else (GIVE.TTY.PROCESS 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) (* bas: " 1-Apr-84 13:50")
(bind M N while (SHIFTSELECTKEYS) 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)
(if (LISTP (fetch SELEXP of M))
else (BKSYSCHARCODE (CHARCODE SPACE])
(SELECTTREE
[LAMBDA (DS) (* bas: " 1-Apr-84 15:17")
(bind (OT ←(GETME4 (TOPSELECTION)
T))
until (SELECTDONE DS) do (SWITCHANDSHADE (FINDLCA OT (SEARCHMAP DS])
(SEARCHMAP
[LAMBDA (PDS) (* bas: "20-Apr-84 14:37")
(PROG (L S (E (GETDEDITMAP 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)
(* Either pending tail or embedded descendents to
search)
(if (NOT (SETQ E (GETME4 L S)))
elseif (HASASBP E S)
else (REPP S) (* Substructure has been smashed.
Reprint and start over.)
(SETQ E (GETME4 (fetch TAIL of S)
T))
(SETQ S (fetch BP of E))
(SETQ L (fetch TAIL of E)))
(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: " 1-Apr-84 15:17")
(if (NOT S2)
then S1
elseif (EQ (fetch PDSP of S1)
(fetch PDSP of S2))
then (for old S1 while S1 by (fetch BP of S1) thereis (DOMINATE? S1 S2])
(DOMINATE?
[LAMBDA (SUP SUB) (* bas: " 4-Apr-84 13:06")
(OR (EQ SUP SUB)
(PROG [(S1 (OR (MAPENTRYP SUP)
(GETME4 SUP)))
(S2 (OR (MAPENTRYP SUB)
(GETME4 SUB]
(RETURN (if (AND S1 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: " 1-Apr-84 15:29")
(* Like a POP/PUSH sequence but no CONS)
(if (OR (NOT NU)
(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: " 4-Apr-84 12:57")
(AND S (SHADESELECTION1 S (SHADEFIXER SHADE (fetch PDSP of S])
(SHADESELECTION1
[LAMBDA (S TXT) (* bas: "17-Mar-84 13:53")
(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 (fetch SELEXP of S))
then (PROG NIL
(SHADESELECTION2 S (fetch STARTY of S)
(fetch STARTX of S)
(fetch LPEND of S)
TXT)
(for E on (fetch SELEXP 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])
(SHADEFIXER
[LAMBDA (S W) (* bas: " 2-Apr-84 17:36")
(if (EQ S BLACKSHADE)
then S
else [PROG (RS LM)
(SELECTQ (LOGAND (DSPYOFFSET NIL W)
3)
(0 (RETURN))
(1 (SETQ RS 4)
(SETQ LM 15))
(2 (SETQ RS 8)
(SETQ LM 255))
(3 (SETQ RS 12)
(SETQ LM 4095))
(SHOULDNT))
(SETQ S (IPLUS (LRSH S RS)
(LLSH (LOGAND S LM)
(IDIFFERENCE 16 RS]
(PROG (RBM X)
(SETQ RBM (SELECTQ (SETQ X (LOGAND (DSPXOFFSET NIL W)
3))
(0 (RETURN S))
(1 4369)
(2 13107)
(3 30583)
(SHOULDNT)))
(RETURN (IPLUS (LRSH (LOGAND S (LOGXOR RBM BLACKSHADE))
X)
(LLSH (LOGAND S RBM)
(IDIFFERENCE 4 X])
(OVERLAPSELBAND
[LAMBDA (S H L) (* bas: "26-Mar-84 15:17")
(OVERLAP (SUB1 (fetch STARTY of S))
(IDIFFERENCE (fetch STOPY of S)
(ADD1 LINETHICKNESS))
H L])
(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: " 5-Apr-84 21:03")
(* 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)
(PROG (TMP)
(DECLARE (USEDFREE LASTAIL))
(if (CDR (THELIST LST))
then (SETQ TMP (OR [if (LISTP (CAR LST))
then (TAILP (CAR LST)
(CADR LST))
else (OR (TAILP LASTAIL (CADR LST))
(EQ (CAR LST)
(DOTTEDEND (CADR LST]
(FMEMB (CAR LST)
(CADR LST))
(CANT "Inconsistent EDIT chain")))
[RETURN (OR (GETME4 TMP)
(DUMMYMAPENTRY TMP (MAKESELCHAIN (CDR LST]
else (SETQ TMP (GETME4 (CAR LST)))
(RETURN (AND (MAPENTRYP TMP)
(GETMEBP TMP])
(PUSHINTOBUF
[LAMBDA (V) (* bas: " 4-MAR-83 12:23")
(AND V (PUSHSELECTION V])
(DUMMYMAPENTRY
[LAMBDA (E B) (* bas: "12-Sep-84 10:46")
(* Dummys are marked by having EQ startx and stopx)
(MAKEMAPENTRY (OR (LISTP E)
(MAKEDOTPTAIL E B))
B 0 0 0 0 (fetch F# of B])
(FLIPSELS
[LAMBDA NIL (* bas: "26-Mar-84 18:21")
(* Turns selections on or off across possible movement)
(PROG [(TM (FIXUPSEL (TOPSELECTION T]
(SHADESELECTION (FIXUPSEL (NXTSELECTION T)
(BUFSELP TM))
SECSHADE)
(SHADESELECTION TM PRIMSHADE])
(FLIPSELSIN
[LAMBDA (DS H L) (* bas: " 4-Apr-84 13:18")
(* Turns selections on or off across possible movement)
(SETQ DS (WINDOWPROP DS (QUOTE DSP)))
(PROG (S)
(AND (SETQ S (GETME4 (NXTSELECTION T)))
(EQ DS (fetch PDSP of S))
(OVERLAPSELBAND S H L)
(SHADESELECTION (UNPURGEDP S)
SECSHADE))
(AND (SETQ S (GETME4 (TOPSELECTION T)))
(EQ DS (fetch PDSP of S))
(OVERLAPSELBAND S H L)
(SHADESELECTION (UNPURGEDP S)
PRIMSHADE])
(FIXUPSEL
[LAMBDA (X BUFBUSY) (* bas: "24-Jun-84 17:48")
(* Returns a new selection if X is not OK)
(AND X (OR (GETSELMAP X)
(AND (PROG1 (UNZORCHME (GETME4 X))
(* GETME4 and thus the UNZORCHME only succeeds after GETSELMAP has failed if X's map has been invalidated.
Usually the result is that X should be flushed into the edit buffer. However, if X is invalid b/c the whole window
has been ZORCHed (by a background MARKASCHANGED e.g.) then we reestablish the whole window and try again)
)
(GETSELMAP X))
(AND (NOT BUFBUSY)
(SETUPDEDITW (GETEBUF (TOPEDITW))
(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) (* lmm " 9-Jul-85 16:30")
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(AND ONFLG (FUNCTION DEDITBUTTONFN)))
(WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(if ONFLG
then (FUNCTION DEDITRIGHTBUTTONFN)
else (FUNCTION DOWINDOWCOM)))
(WINDOWPROP W (QUOTE RESHAPEFN)
(AND ONFLG (FUNCTION DEDITRESHAPEFN)))
(WINDOWPROP W (QUOTE REPAINTFN)
(AND ONFLG (FUNCTION DEDITREPAINTFN)))
(WINDOWPROP W (QUOTE SCROLLFN)
(AND ONFLG (FUNCTION SCROLLBYREPAINTFN)))
(WINDOWPROP W (QUOTE PROCESS)
(THIS.PROCESS)) (* So that bugging in this window can switch tty to us)
(WINDOWPROP W (QUOTE WINDOWENTRYFN)
(if ONFLG
then (FUNCTION DEDITWINDOWENTRYFN)
else (FUNCTION GIVE.TTY.PROCESS)))
(DSPSCROLL (if ONFLG
then (QUOTE OFF)
else T)
W) (* Buffer can get this turned on)
W])
(FINDEDITW
[LAMBDA (NAME TYPE) (* bas: "12-Sep-84 22:24")
(for I in \DEDITWINDOWS thereis (SAMEEDITW I NAME TYPE])
(GETEDITW
[LAMBDA (ATM TYPE) (* bas: "12-Sep-84 22:38")
(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 NIL (LIST (QUOTE UNDEDITW)
(push \DEDITWINDOWS W)))
(RETURN (WINDOWPROP W (QUOTE DSP])
(GETDEDITDEF4
[LAMBDA (W) (* bas: "10-Mar-84 11:55")
(PROG [NAME (TYPE (WINDOWPROP W (QUOTE DEDITWHOAMI]
(RETURN (AND (SETQ NAME (CAR TYPE))
(LITATOM NAME)
(SETQ TYPE (CADR TYPE))
(NEQ TYPE (QUOTE expression))
(GETDEF NAME TYPE NIL (QUOTE (NOCOPY NOERROR])
(MAKEEDITW
[LAMBDA (NAME TYP) (* bas: "12-Sep-84 23:03")
(PROG [(W (if (TOPEDITW)
then (WINDOWPROP (TOPEDITW)
(QUOTE DEDITCACHED)
NIL)
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])
(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) (* rmk: "13-Sep-84 16:49")
(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]
[for I to (ARRAYSIZE \DEDITDSPS) when (EQ WDS (ELT \DEDITDSPS I))
do (RETURN (SETA \DEDITDSPS I (WINDOWPROP WDS (QUOTE REGION]
(WINDOWPROP W (QUOTE EDITEXPR)
NIL)
(if DONTCLR
else (DSPTEXTURE WHITESHADE W)
(DSPFONT DEFAULTFONT W) (* Font first to get CLEARW right)
(CLEARW W)
(MAKECPOSBE (DSPXPOSITION NIL W)
(CONSTANT (IDIFFERENCE MAX.SMALLP 1535))
W)))
W])
(MAKECPOSBE
[LAMBDA (X Y DS) (* bas: " 4-Apr-84 13:11")
(PROG [(DX (IDIFFERENCE X (DSPXPOSITION NIL DS)))
(DY (IDIFFERENCE Y (DSPYPOSITION NIL DS]
(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])
(SETUPDEDITW
[LAMBDA (W CONTENTS) (* bas: "24-Jun-84 17:47")
(PROG1 (SETDEDITMAP W CONTENTS)
(ACTIVEEDITW W T])
(TOPEDITW
[LAMBDA NIL (* bas: "18-MAR-83 15:25")
(CAR \DEDITWINDOWS])
(UNDEDITW
[LAMBDA (WDS) (* bas: "12-Sep-84 22:52")
(* Desensitizes DEDIT windows and removes surplus ones)
(if \DEDITMNUW
then (WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
NIL)
(CLOSEW \DEDITMNUW))
(PROG [(W (WFROMDS (OR (CAR (LISTP WDS))
(SHOULDNT]
(TAKEDOWN (WINDOWPROP W (QUOTE EDITBUF)))
(SETQ \DEDITBUFW NIL)
(DECLARE (USEDFREE DEditLinger))
(if (EQ WDS \DEDITWINDOWS)
then (SETQ \DEDITWINDOWS (CDR WDS))
else (for I on \DEDITWINDOWS when (EQ WDS (CDR I)) do (RETURN (RPLACD I (CDDR I)))
finally (SHOULDNT "DEDITDSPS tangled")))
(if \DEDITWINDOWS
then (if (FMEMB W \DEDITWINDOWS)
else (WINDOWPROP W (QUOTE DEDITCACHED)
NIL) (* Discard my cache; cache me on next)
(WINDOWPROP (TOPEDITW)
(QUOTE DEDITCACHED)
W)
(SETQ \DEDITBUFW (WINDOWPROP (TOPEDITW)
(QUOTE EDITBUF)))
(TAKEDOWN W))
else (if (AND RESETSTATE (CADR (WINDOWPROP W (QUOTE DEDITCHANGES)
NIL)))
then (ZORCHEDITW W))
(if (WINDOWP DEditWindow)
else (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) (* hdj "19-Jul-85 11:35")
(AND W [PROG ((V (GETMAP? W)))
(COND
((AND V (NOT (fetch BP of V)))
(replace BP of V with (create DEDITMAP
D# ←(fetch D# of V)))
(RETURN T]
(ACTIVEWP (WFROMDS W))
(PROGN (DSPTEXTURE CHANGEDSHADE W)
(DSPFILL NIL CHANGEDSHADE (QUOTE PAINT)
W])
(ZORCHEDWP
[LAMBDA (W) (* bas: "11-Mar-84 22:33")
(PROG [(WM (GETME4 (WINDOWPROP W (QUOTE EDITEXPR] (* ZORCHed windows have a dummy map in the BP of their
EDITEXPR's map)
(RETURN (AND WM (fetch BP of WM])
(UNZORCHME
[LAMBDA (M) (* bas: "11-Mar-84 23:15")
(AND M (PROG ((W (fetch PDSP of M)))
(if (ZORCHEDWP W)
then (RETURN (SETDEDITMAP W (LIST (GETDEDITDEF4 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"])
(HASASBP
[LAMBDA (M F) (* bas: "11-Mar-84 21:57")
(OR (TAILP (OR (LISTP M)
(SETQ M (fetch TAIL of M)))
(fetch SELEXP of F))
(AND (NLISTP (CDR M))
(EQ M (GETHASH (fetch TAIL of F)
\DEDITDPHASH])
(TAILOF
[LAMBDA (A B) (* bas: "11-Mar-84 23:31")
(OR (TAILP A B)
(AND (SETQ A (DPCDRSEL A))
(SETQ B (GETME4 B))
(EQ (fetch BP of A)
(fetch BP of B])
(DOTTEDEND
[LAMBDA (C) (* bas: "16-MAR-83 21:32")
(if (LISTP C)
then (CDR (LAST C))
else C])
(GETME4
[LAMBDA (C B) (* bas: "11-Mar-84 23:09")
(AND C
(OR (GETHASH C \DEDITMEHASH)
(SELECTQ B
(NIL NIL)
(T (SHOULDNT "No MapEntry"))
(PROGN (OR (MAPENTRYP B)
(SETQ B (GETME4 B T)))
(OR [if (LISTP C)
then (HASASBP C B)
else (EQ C (DOTTEDEND (fetch SELEXP of B]
(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: "12-Sep-84 10:40")
(* Gets ME iff it is unpurged and not a dummy ie visible
for a SHADESELECTIOn etc)
(AND (SETQ X (GETME4 X))
(NEQ (fetch STARTX of X)
(fetch STOPX of X))
(UNPURGEDP 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 (EW) (* bas: "20-Apr-84 12:21")
(PROG ((REG (WINDOWPROP EW (QUOTE REGION)))
(EBW (WINDOWPROP EW (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 EW (QUOTE EDITBUF)
\DEDITBUFW)
elseif (PROGN (SETQ \DEDITBUFW EBW)
(PURGEW (ACTIVEEDITW EBW NIL))
(SETQ TR (WINDOWPROP EBW (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 is
inactive)
(SHAPEW EBW
(create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H))
elseif (NEQ X (fetch LEFT of TR))
then (MOVEW EBW X Y)
(OPENW EBW)
else (OPENW EBW)))
(WINDOWPROP \DEDITBUFW (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])
(GETDEDITMAP
[LAMBDA (DS) (* bas: "11-Mar-84 23:15")
(OR (GETMAP? DS)
(SETDEDITMAP DS (if (ZORCHEDWP DS)
then (LIST (GETDEDITDEF4 DS))
else (WINDOWPROP DS (QUOTE EDITEXPR])
(GETMAP?
[LAMBDA (W) (* bas: " 8-Mar-84 14:38")
(GETSELMAP (WINDOWPROP W (QUOTE EDITEXPR])
(UNPURGEDP
[LAMBDA (M) (* bas: "11-Mar-84 23:09")
(* 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.)
(AND (EQ M (GETME4 (fetch TAIL of M)))
[OR (NOT (fetch BP of M))
(AND (HASASBP M (fetch BP of M))
(UNPURGEDP (fetch BP of M]
M])
(SUBSELOF
[LAMBDA (TOP SUB) (* bas: " 8-Mar-84 14:11")
(for (S2 ←(GETSELMAP SUB)) by (fetch BP of S2) while S2 thereis (EQ TOP (fetch SELEXP
of S2])
(SETDEDITMAP
[LAMBDA (DW V) (* bas: "24-Jun-84 17:33")
(PURGEW DW) (* Remove EDITEXPR and reset window)
[SETQ V (DEPRINTDEF (MKLIST V)
(DSPLEFTMARGIN NIL DW)
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: " 4-Apr-84 13:27")
(if WDS
then (PURGEW WDS T)
(CLOSEW WDS])
)
(DEFINEQ
(DEDITRESHAPEFN
[LAMBDA (W X1 X2) (* bas: " 4-Apr-84 13:12")
(AND (EDITWINDOWP W)
(RESETFORM (CURSOR WAITINGCURSOR)
(SETDEDITMAP W (WINDOWPROP W (QUOTE EDITEXPR)))
(FLIPSELSIN W (IPLUS (WYOFFSET NIL W)
(WINDOWPROP W (QUOTE HEIGHT)))
(WYOFFSET NIL W])
(DEDITREPAINTFN
[LAMBDA (WDS R) (* bas: "10-Mar-84 13:02")
(PROG ((H (fetch PTOP of R))
(L (fetch BOTTOM of R)))
(REFRESHIF WDS H L)
(FLIPSELSIN WDS H L])
)
(DEFINEQ
(SETEDITMENU
[LAMBDA (EW) (* lmm "30-Jul-85 01:19")
(DECLARE (GLOBALVARS \DEDITCOMS))
(PROG ([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)))
[if EW
then (PROG [(ER (WINDOWPROP EW (QUOTE REGION]
(SETQ X (fetch PRIGHT of ER))
(SETQ Y (IDIFFERENCE (fetch PTOP of ER)
H)))
else (GETMOUSESTATE)
(SETQ X (IDIFFERENCE LASTMOUSEX WBorder))
(SETQ Y (IDIFFERENCE LASTMOUSEY (WINDOWPROP \DEDITMNUW (QUOTE YOFFSET]
(SETQ X (IMIN X (IDIFFERENCE SCREENWIDTH W)))
[SETQ Y (IMAX 0 (IMIN Y (IDIFFERENCE SCREENHEIGHT H]
(if MR
then (if (AND (EQ X (fetch LEFT of MR))
(EQ Y (fetch BOTTOM of MR)))
else (MOVEW \DEDITMNUW X Y))
(TOTOPW \DEDITMNUW)
else (PROG ((NUR (create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H)))
[if (DISPLAYSTREAMP \DEDITMNUW)
then (SETQ \DEDITMNUW (WFROMDS \DEDITMNUW))
(WINDOWPROP \DEDITMNUW (QUOTE RESHAPEFN)
NIL)
(SHAPEW \DEDITMNUW NUR)
else (SETQ \DEDITMNUW (CREATEW NUR (QUOTE EditOps]
(WINDOWPROP \DEDITMNUW (QUOTE RESHAPEFN)
(QUOTE DON'T)))
(BITBLT IMAGE 1 1 \DEDITMNUW 0 0 W H (QUOTE INPUT)
(QUOTE REPLACE)) (* The 1,1 removes the menu border)
(WINDOWPROP \DEDITMNUW (QUOTE IMAGE)
IMAGE)
(WINDOWPROP \DEDITMNUW (QUOTE ITEMHEIGHT)
(FONTPROP MENUFONT (QUOTE HEIGHT)))
(WINDOWPROP \DEDITMNUW (QUOTE YOFFSET)
(IQUOTIENT H 2))
(WINDOWPROP \DEDITMNUW (QUOTE REPAINTFN)
(QUOTE DEDITMENURESTORE)))
(WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
(THIS.PROCESS)) (* Allow the menu window to also respond to tty
switching)
(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: "30-Mar-84 10:49")
(DECLARE (GLOBALVARS EDITMENU\COMS EDITMENU\SUBS))
(bind OTHERS VAL N OLDN MOUSEISDOWN MOUSEWASDOWN 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 (if (KEYDOWNP (QUOTE CTRL))
then (if VAL
then (SHADEMENUENTRY N EMDS VLF
(QUOTE HOLLOW)
OTHERS)
(push OTHERS (CONS N VAL))
(SETQ VAL NIL))
OTHERS)
(INWINDOW EMDS))
(NOT VAL))
when (INWINDOW EMDS)
do (SETQ OLDN N)
(SETQ N (IQUOTIENT (LASTMOUSEY EMDS)
VLF))
[if (AND [EQ (SETQ MOUSEWASDOWN MOUSEISDOWN)
(SETQ MOUSEISDOWN (LASTMOUSESTATE (NOT UP]
(EQ N OLDN))
then (* Nothing going on)
(OR MOUSEISDOWN (BLOCK)) (* But dont block if mouse is down lest we miss an
upclick)
else (if (EQ N OLDN)
then (SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW)
OTHERS)
else (SHADEMENUENTRY OLDN EMDS VLF MOUSEWASDOWN OTHERS)
(SHADEMENUENTRY N EMDS VLF MOUSEISDOWN OTHERS))
(if (AND (LASTMOUSESTATE MIDDLE)
(ELT EDITMENU\SUBS N))
then (* Submenu)
(SETQ VAL (MENU (ELT EDITMENU\SUBS N)))
(SETQ MOUSEISDOWN NIL)
(SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW)
OTHERS)
elseif (AND (NOT MOUSEISDOWN)
MOUSEWASDOWN N)
then (* Mouse has come up and a com is selected)
(SETQ VAL (ELT EDITMENU\COMS N]
finally (SHADEMENUENTRY N EMDS VLF MOUSEISDOWN OTHERS)
(for I on OTHERS do (SHADEMENUENTRY (CAAR I)
EMDS VLF (QUOTE FILL)
(CDR I)))
[AND VAL 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 VAL (bind CS XS for I in (CONS (CONS OLDN VAL)
OTHERS)
do (push CS (CADR I))
(push XS (MKLIST (CDDR I)))
finally (RETURN (CONS CS (CONS (QUOTE PROGN)
XS]
else VAL])
(SHADEMENUENTRY
[LAMBDA (V EMDS DLF BOXFLG OTHERS) (* bas: "22-Mar-84 22:26")
(* BOXFLG encoding: T=FILL NIL=BOX for common cases of
MOUSEDOWN controls)
(AND V (NOT (FASSOC V OTHERS))
(PROG [(D (SELECTQ BOXFLG
((FILL T)
0)
(HOLLOW 1)
((BOX NIL)
(SHADEMENUENTRY V EMDS DLF (QUOTE FILL))
1)
(SHOULDNT]
(BITBLT NIL NIL NIL EMDS D (IPLUS D (ITIMES V DLF))
(IDIFFERENCE (fetch WIDTH of (DSPCLIPPINGREGION NIL EMDS))
(IPLUS D D))
(IDIFFERENCE DLF (IPLUS D D))
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(DEDITMENURESTORE
[LAMBDA (W R) (* bas: " 5-Apr-84 19:56")
(BITBLT (WINDOWPROP W (QUOTE IMAGE))
1 1 W 0 0 NIL NIL (QUOTE INPUT)
(QUOTE REPLACE)
NIL R])
)
(DEFINEQ
(RESETDEDIT
[LAMBDA NIL (* lmm "29-Jul-85 21:17")
(DECLARE (GLOBALVARS \DEDITCOMS))
(pushnew MARKASCHANGEDFNS (FUNCTION DEDITMARKASCHANGED))
[PROGN (MOVD? (QUOTE EDITL)
(QUOTE NORMAL/EDITL))
(MOVD? (QUOTE EDITDATE)
(QUOTE NORMAL\EDITDATE))
(EDITMODE (if (BOUNDP (QUOTE DEditMode))
then DEditMode
else (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 \DEDITFONTS NIL)
(SETQ \DEDITDSPS (ARRAY 8)) (* 8 is arbitrary)
(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) (* lmm "29-Jul-85 21:11")
(* 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])
(COPYOUTCONS
[LAMBDA (C1 C2) (* bas: "18-Mar-84 15:09")
(* Returns C1 with any instances of C2 COPYCONSed out)
(if (NLISTP C1)
then C1
elseif (EQ C1 C2)
then (COPYCONS C1)
else (PROG ((CA (COPYOUTCONS (CAR C1)
C2))
(CD (COPYOUTCONS (CDR C1)
C2)))
(RETURN (if (AND (EQ CA (CAR C1))
(EQ CD (CDR C1)))
then C1
else (CONS CA CD])
(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
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS UPFINDFLG)
)
(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]
[PUTPROPS OVERLAP MACRO (OPENLAMBDA (H1 L1 H2 L2)
(NOT (OR (ILESSP H1 L2)
(ILESSP H2 L1]
[PUTPROPS SHIFTSELECTKEYS MACRO (NIL (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT))
(KEYDOWNP (QUOTE COPY]
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(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)
)
(CHANGENAME (QUOTE EDITF)
(QUOTE ERROR)
(QUOTE EDITFERROR))
(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" T 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3471 6245 (DF 3481 . 3756) (DV 3758 . 3935) (DP 3937 . 4118) (DC 4120 . 4539) (EF 4541
. 4718) (EV 4720 . 4898) (EP 4900 . 5082) (EDITPROP 5084 . 5312) (EDITMODE 5314 . 6074) (DEDITIT 6076
. 6243)) (6246 12885 (DEDITL 6256 . 9224) (DEDITL0 9226 . 11501) (DEDITTTYFN 11503 . 12883)) (12886
26045 (DEDITAfter 12896 . 13284) (DEDITBefore 13286 . 13643) (DEDITDelete 13645 . 14215) (DEDITReplace
14217 . 14505) (DEDITSwitch 14507 . 14870) (DEDITBI 14872 . 15446) (DEDITBO 15448 . 15670) (DEDITLI
15672 . 15859) (DEDITLO 15861 . 16052) (DEDITRI 16054 . 16523) (DEDITRO 16525 . 16690) (DEDITUndo
16692 . 17139) (UNDOCHOOSE 17141 . 17783) (DEDITFind 17785 . 18335) (DEDITSwap 18337 . 18622) (
DEDITCenter 18624 . 19565) (DEDITCopy 19567 . 19731) (DEDITReprint 19733 . 19891) (DEDITCEdit 19893 .
20524) (DEDITEdit 20526 . 21692) (DEDITDatatype 21694 . 22906) (DEDITEditCom 22908 . 23703) (DEDITARGS
23705 . 24042) (DEDITBreak 24044 . 25146) (DEDITEval 25148 . 25684) (DEDITExit 25686 . 26043)) (26046
35246 (SETPTRTO 26056 . 26714) (DEDITCONS 26716 . 26964) (DEDITZAPCAR 26966 . 27156) (DEDITZAPCDR
27158 . 27353) (DEDITZAPNODE 27355 . 27509) (DEDITZAPBOTH 27511 . 30031) (DEDITFZAP 30033 . 30713) (
DEDITZAPCLISP 30715 . 31545) (DEDITZAPCHANGES 31547 . 32276) (DEDITMOVETAILDOWN 32278 . 32689) (
DUNDOEDITL 32691 . 33561) (DUNDOEDITCOM 33563 . 34544) (DUNDOEDITCOM1 34546 . 35244)) (35247 45526 (
DEDITSLCTLP 35257 . 35910) (DEDITUSER 35912 . 36133) (DEDITTABCNTRL 36135 . 36545) (DEDITTABSON 36547
. 36740) (DEDITTABSOFF 36742 . 36921) (SELECTKEYS 36923 . 37823) (DEDITREADLINE 37825 . 38902) (
SHADEIFNOTBUF 38904 . 39106) (DEDITBUTTONFN 39108 . 39441) (DEDITRIGHTBUTTONFN 39443 . 39768) (
DEDITWINDOWENTRYFN 39770 . 40236) (SELECTELEMENT 40238 . 40937) (SELECTREAD 40939 . 41736) (SELECTTREE
41738 . 42008) (SEARCHMAP 42010 . 43100) (WITHINME 43102 . 43920) (ONAPARENP 43922 . 44368) (
SELECTDONE 44370 . 44527) (INWINDOW 44529 . 44719) (FINDLCA 44721 . 45048) (DOMINATE? 45050 . 45524))
(45527 54095 (POPSELECTION 45537 . 45708) (PUSHSELECTION 45710 . 45862) (NXTSELECTION 45864 . 46082) (
TOPSELECTION 46084 . 46301) (SWITCHANDSHADE 46303 . 46825) (SHADESELECTION 46827 . 47021) (
SHADESELECTION1 47023 . 48690) (SHADESELECTION2 48692 . 49003) (SHADEFIXER 49005 . 49820) (
OVERLAPSELBAND 49822 . 50066) (PUSHEDITCHAIN 50068 . 50367) (MAKESELCHAIN 50369 . 51269) (PUSHINTOBUF
51271 . 51413) (DUMMYMAPENTRY 51415 . 51741) (FLIPSELS 51743 . 52170) (FLIPSELSIN 52172 . 52861) (
FIXUPSEL 52863 . 53655) (NEWSELFOR 53657 . 54093)) (54096 62385 (ACTIVEEDITW 54106 . 55236) (FINDEDITW
55238 . 55421) (GETEDITW 55423 . 55910) (GETDEDITDEF4 55912 . 56275) (MAKEEDITW 56277 . 57035) (
NAMEOFEDITW 57037 . 57657) (PURGEW 57659 . 58740) (MAKECPOSBE 58742 . 59064) (SAMEEDITW 59066 . 59299)
(SETUPDEDITW 59301 . 59476) (TOPEDITW 59478 . 59608) (UNDEDITW 59610 . 61007) (WHICHEDITW 61009 .
61316) (ZORCHEDITW 61318 . 61802) (ZORCHEDWP 61804 . 62119) (UNZORCHME 62121 . 62383)) (62386 70484 (
BUFSELP 62396 . 62593) (EDITWINDOWP 62595 . 62817) (GETLEFT 62819 . 63285) (GETMEBP 63287 . 63445) (
HASASBP 63447 . 63750) (TAILOF 63752 . 63999) (DOTTEDEND 64001 . 64173) (GETME4 64175 . 65078) (
GETSELMAP 65080 . 65474) (DEARME 65476 . 66017) (DPCDRSEL 66019 . 66323) (GETDPME 66325 . 66510) (
GETEBUF 66512 . 67937) (GETEDITCHAIN 67939 . 68427) (GETDEDITMAP 68429 . 68702) (GETMAP? 68704 . 68859
) (UNPURGEDP 68861 . 69472) (SUBSELOF 69474 . 69729) (SETDEDITMAP 69731 . 70310) (TAKEDOWN 70312 .
70482)) (70485 71095 (DEDITRESHAPEFN 70495 . 70836) (DEDITREPAINTFN 70838 . 71093)) (71096 80155 (
SETEDITMENU 71106 . 73994) (CACHEDEDITCOMS 73996 . 75183) (DEFDEDITCOM 75185 . 76183) (FINDEDITCOM
76185 . 76389) (READEDITMENU 76391 . 79177) (SHADEMENUENTRY 79179 . 79926) (DEDITMENURESTORE 79928 .
80153)) (80156 84886 (RESETDEDIT 80166 . 83833) (DEDITDATE 83835 . 84208) (DEDITMARKASCHANGED 84210 .
84884)) (84887 85790 (DEDITResetTypeComs 84897 . 85477) (DEDITTYPEDCOM 85479 . 85788)) (85791 86790 (
COPYCONS 85801 . 85936) (COPYOUTCONS 85938 . 86491) (MAPENTRYP 86493 . 86637) (THELIST 86639 . 86788))
(86791 87313 (CANT 86801 . 87311)))))
STOP