(FILECREATED "30-Sep-84 14:22:29" {ERIS}<LISPCORE>SOURCES>DEDIT.;9 89303
changes to: (FNS DEDITRI)
previous date: "14-Sep-84 13:48:14" {ERIS}<LISPCORE>SOURCES>DEDIT.;8)
(* Copyright (c) 1982, 1983, 1984 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 EDITFERROR)
(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)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS STACK)
(MACROS EDITBLOCKCALL OVERLAP SHIFTSELECTKEYS))
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS UPFINDFLG)
(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 "14-Aug-84 23:28")
(* Edits commands of file FILE)
(DEDITIT (QUOTE EDITV)
(if (HASDEF (SETQ FILE (CAR (NLAMBDA.ARGS FILE)))
(QUOTE FILE)
NIL T)
then (FILECOMS FILE)
else (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])
(EDITFERROR
[LAMBDA (F FLG) (* bas: "12-Sep-84 19:23")
(* FLG is the msg arg to ERROR)
(if [AND (STRINGP FLG)
(OR (DEFINEDP F)
(NOT (MOUSECONFIRM (CONCAT "No FNS defn for " F
". Do you wish to edit a dummy defn?"]
then (ERROR F FLG T)
else (EDITE [COPY (QUOTE (LAMBDA (args...) (* edited " 1-Jan-00 00:00")
(* * comment)
(PROG (vars...)
(RETURN something]
NIL F (QUOTE FNS)))
(AND (GETD F)
(if (STRINGP FLG)
then (RETFROM (QUOTE EDITF)
F)
else F])
)
(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) (* bas: "24-Jun-84 17:49")
(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)
(WINDOWPROP W (QUOTE DSP))) (* 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) (* bas: "10-Mar-84 13:35")
(AND W (PROG ((V (GETMAP? W)))
(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) (* bas: "12-Apr-84 20:36")
(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)))
(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 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 (* bas: "12-Apr-84 23:39")
(DECLARE (GLOBALVARS \DEDITCOMS))
[PROGN (MOVD? (QUOTE EDITL)
(QUOTE NORMAL/EDITL))
(MOVD? (QUOTE EDITDATE)
(QUOTE NORMAL\EDITDATE))
(MOVD? (QUOTE MARKASCHANGED)
(QUOTE NORMAL/MARKASCHANGED))
(MOVD (QUOTE DEDITMARKASCHANGED)
(QUOTE MARKASCHANGED))
(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 \DEDITFONT# NIL)
(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) (* 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])
(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
[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 DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS UPFINDFLG)
)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3418 6895 (DF 3428 . 3703) (DV 3705 . 3882) (DP 3884 . 4065) (DC 4067 . 4488) (EF 4490
. 4667) (EV 4669 . 4847) (EP 4849 . 5031) (EDITPROP 5033 . 5261) (EDITMODE 5263 . 6023) (DEDITIT 6025
. 6192) (EDITFERROR 6194 . 6893)) (6896 13535 (DEDITL 6906 . 9874) (DEDITL0 9876 . 12151) (DEDITTTYFN
12153 . 13533)) (13536 26695 (DEDITAfter 13546 . 13934) (DEDITBefore 13936 . 14293) (DEDITDelete
14295 . 14865) (DEDITReplace 14867 . 15155) (DEDITSwitch 15157 . 15520) (DEDITBI 15522 . 16096) (
DEDITBO 16098 . 16320) (DEDITLI 16322 . 16509) (DEDITLO 16511 . 16702) (DEDITRI 16704 . 17173) (
DEDITRO 17175 . 17340) (DEDITUndo 17342 . 17789) (UNDOCHOOSE 17791 . 18433) (DEDITFind 18435 . 18985)
(DEDITSwap 18987 . 19272) (DEDITCenter 19274 . 20215) (DEDITCopy 20217 . 20381) (DEDITReprint 20383 .
20541) (DEDITCEdit 20543 . 21174) (DEDITEdit 21176 . 22342) (DEDITDatatype 22344 . 23556) (
DEDITEditCom 23558 . 24353) (DEDITARGS 24355 . 24692) (DEDITBreak 24694 . 25796) (DEDITEval 25798 .
26334) (DEDITExit 26336 . 26693)) (26696 35896 (SETPTRTO 26706 . 27364) (DEDITCONS 27366 . 27614) (
DEDITZAPCAR 27616 . 27806) (DEDITZAPCDR 27808 . 28003) (DEDITZAPNODE 28005 . 28159) (DEDITZAPBOTH
28161 . 30681) (DEDITFZAP 30683 . 31363) (DEDITZAPCLISP 31365 . 32195) (DEDITZAPCHANGES 32197 . 32926)
(DEDITMOVETAILDOWN 32928 . 33339) (DUNDOEDITL 33341 . 34211) (DUNDOEDITCOM 34213 . 35194) (
DUNDOEDITCOM1 35196 . 35894)) (35897 46176 (DEDITSLCTLP 35907 . 36560) (DEDITUSER 36562 . 36783) (
DEDITTABCNTRL 36785 . 37195) (DEDITTABSON 37197 . 37390) (DEDITTABSOFF 37392 . 37571) (SELECTKEYS
37573 . 38473) (DEDITREADLINE 38475 . 39552) (SHADEIFNOTBUF 39554 . 39756) (DEDITBUTTONFN 39758 .
40091) (DEDITRIGHTBUTTONFN 40093 . 40418) (DEDITWINDOWENTRYFN 40420 . 40886) (SELECTELEMENT 40888 .
41587) (SELECTREAD 41589 . 42386) (SELECTTREE 42388 . 42658) (SEARCHMAP 42660 . 43750) (WITHINME 43752
. 44570) (ONAPARENP 44572 . 45018) (SELECTDONE 45020 . 45177) (INWINDOW 45179 . 45369) (FINDLCA 45371
. 45698) (DOMINATE? 45700 . 46174)) (46177 54745 (POPSELECTION 46187 . 46358) (PUSHSELECTION 46360 .
46512) (NXTSELECTION 46514 . 46732) (TOPSELECTION 46734 . 46951) (SWITCHANDSHADE 46953 . 47475) (
SHADESELECTION 47477 . 47671) (SHADESELECTION1 47673 . 49340) (SHADESELECTION2 49342 . 49653) (
SHADEFIXER 49655 . 50470) (OVERLAPSELBAND 50472 . 50716) (PUSHEDITCHAIN 50718 . 51017) (MAKESELCHAIN
51019 . 51919) (PUSHINTOBUF 51921 . 52063) (DUMMYMAPENTRY 52065 . 52391) (FLIPSELS 52393 . 52820) (
FLIPSELSIN 52822 . 53511) (FIXUPSEL 53513 . 54305) (NEWSELFOR 54307 . 54743)) (54746 62865 (
ACTIVEEDITW 54756 . 55771) (FINDEDITW 55773 . 55956) (GETEDITW 55958 . 56445) (GETDEDITDEF4 56447 .
56810) (MAKEEDITW 56812 . 57570) (NAMEOFEDITW 57572 . 58192) (PURGEW 58194 . 59275) (MAKECPOSBE 59277
. 59599) (SAMEEDITW 59601 . 59834) (SETUPDEDITW 59836 . 60011) (TOPEDITW 60013 . 60143) (UNDEDITW
60145 . 61542) (WHICHEDITW 61544 . 61851) (ZORCHEDITW 61853 . 62282) (ZORCHEDWP 62284 . 62599) (
UNZORCHME 62601 . 62863)) (62866 70964 (BUFSELP 62876 . 63073) (EDITWINDOWP 63075 . 63297) (GETLEFT
63299 . 63765) (GETMEBP 63767 . 63925) (HASASBP 63927 . 64230) (TAILOF 64232 . 64479) (DOTTEDEND 64481
. 64653) (GETME4 64655 . 65558) (GETSELMAP 65560 . 65954) (DEARME 65956 . 66497) (DPCDRSEL 66499 .
66803) (GETDPME 66805 . 66990) (GETEBUF 66992 . 68417) (GETEDITCHAIN 68419 . 68907) (GETDEDITMAP 68909
. 69182) (GETMAP? 69184 . 69339) (UNPURGEDP 69341 . 69952) (SUBSELOF 69954 . 70209) (SETDEDITMAP
70211 . 70790) (TAKEDOWN 70792 . 70962)) (70965 71575 (DEDITRESHAPEFN 70975 . 71316) (DEDITREPAINTFN
71318 . 71573)) (71576 80203 (SETEDITMENU 71586 . 74042) (CACHEDEDITCOMS 74044 . 75231) (DEFDEDITCOM
75233 . 76231) (FINDEDITCOM 76233 . 76437) (READEDITMENU 76439 . 79225) (SHADEMENUENTRY 79227 . 79974)
(DEDITMENURESTORE 79976 . 80201)) (80204 84655 (RESETDEDIT 80214 . 83574) (DEDITDATE 83576 . 83949) (
DEDITMARKASCHANGED 83951 . 84653)) (84656 85559 (DEDITResetTypeComs 84666 . 85246) (DEDITTYPEDCOM
85248 . 85557)) (85560 86559 (COPYCONS 85570 . 85705) (COPYOUTCONS 85707 . 86260) (MAPENTRYP 86262 .
86406) (THELIST 86408 . 86557)) (86560 87082 (CANT 86570 . 87080)))))
STOP