(FILECREATED " 4-Jun-86 18:50:50" {ERIS}<LISPCORE>SOURCES>DEDIT.;26 122255
changes to: (FNS SELECTREAD DEDITL0 ONAPARENP SHADESELECTION1 UNDEDITW GETEBUF SETEDITMENU
CACHEDEDITCOMS DEDITCEdit DEDITEdit RESETDEDIT)
(VARS DEDITCOMS)
previous date: " 7-May-86 12:23:27" {ERIS}<LISPCORE>SOURCES>DEDIT.;24)
(* Copyright (c) 1982, 1983, 1984, 1985, 1986 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
[(COMS (* "User entry to the editor")
(FNS DF DV DP DC EF EV EP EDITPROP EDITMODE DEDITIT))
(COMS (*
"Hooks between tty editor and DEDIT. We redefine EDITL to get into DEDIT from system editor calls"
)
(FNS DEDITL DEDITL0 DEDITTTYFN))
(COMS (* "Basic DEDIT menu commands")
(FNS DEDITAfter DEDITBefore DEDITDelete DEDITReplace DEDITSwitch DEDITBI DEDITBO
DEDITLI DEDITLO DEDITRI DEDITRO DEDITUndo UNDOCHOOSE DEDITFind DEDITSwap
DEDITCenter DEDITCopy DEDITReprint DEDITEditCom DEDITARGS DEDITBreak DEDITEval
DEDITExit)
(FNS DEDITEdit DEDITCEdit DEDIT.TTYinEdit DEDITDatatype)
(ADDVARS (DT.EDITMACROS)))
(COMS (* "Structure changing")
(FNS SETPTRTO DEDITCONS DEDITZAPCAR DEDITZAPCDR DEDITZAPNODE DEDITZAPBOTH DEDITFZAP
DEDITZAPCLISP DEDITZAPCHANGES DEDITMOVETAILDOWN DUNDOEDITL DUNDOEDITCOM
DUNDOEDITCOM1))
(COMS (* "Selection code. Select expressions or from the command menu")
(FNS DEDITSLCTLP DEDITUSER SELECTKEYS DODEDITTYPEDCOM DEDITREADLINE SHADEIFNOTBUF
DEDITBUTTONFN DEDITRIGHTBUTTONFN DEDITWINDOWENTRYFN SELECTELEMENT SELECTREAD
SELECTTREE SEARCHMAP WITHINME ONAPARENP SELECTDONE INWINDOW FINDLCA DOMINATE?)
(ALISTS (DEDITTYPEINCOMS F S Z))
(PROP VARTYPE DEDITTYPEINCOMS))
(COMS (* "Handling the selection stack")
(FNS POPSELECTION PUSHSELECTION NXTSELECTION TOPSELECTION SWITCHANDSHADE SHADESELECTION
SHADESELECTION1 SHADESELECTION2 OVERLAPSELBAND PUSHEDITCHAIN MAKESELCHAIN
PUSHINTOBUF DUMMYMAPENTRY FLIPSELS FLIPSELSIN FIXUPSEL NEWSELFOR))
(COMS (* "Initializing and flushing edit windows")
(FNS ACTIVEEDITW FINDEDITW GETEDITW GETDEDITDEF4 MAKEEDITW NAMEOFEDITW PURGEW
MAKECPOSBE SAMEEDITW SETUPDEDITW TOPEDITW UNDEDITW WHICHEDITW ZORCHEDITW ZORCHEDWP
UNZORCHME)
(INITVARS (DEditLinger T)))
(COMS (* "Manipulating the Edit menu")
(FNS SETEDITMENU CACHEDEDITCOMS FINDEDITCOM READEDITMENU SHADEMENUENTRY
DEDITMENURESTORE)
[VARS (*DEDIT-MENU-COMMANDS* (QUOTE ((After DEDITAfter)
(Before DEDITBefore)
(Delete DEDITDelete)
(Replace DEDITReplace)
(Switch DEDITSwitch)
("( )" DEDITBI ("( ) in" DEDITBI)
("( in" DEDITLI)
(") in" DEDITRI))
("( ) out" DEDITBO ("( ) out" DEDITBO)
("( out" DEDITLO)
(") out" DEDITRO))
(Undo DEDITUndo (Undo DEDITUndo)
(!Undo (DEDITUndo T))
(?Undo (UNDOCHOOSE))
(&Undo (UNDOCHOOSE T)))
(Find DEDITFind)
(Swap DEDITSwap (Center DEDITCenter)
(Clear (SETQ \DEDITSELECTIONS NIL))
(Copy DEDITCopy)
(Pop (POPSELECTION))
(Swap DEDITSwap))
(Reprint DEDITReprint)
[Edit DEDITEdit
[DEdit (DEDITEdit (QUOTE DISPLAY)
(QUOTE Def))
NIL
(SUBITEMS ("DEdit Def"
(DEDITEdit (QUOTE DISPLAY)
(QUOTE Def)))
("DEdit Form"
(DEDITEdit (QUOTE DISPLAY)
(QUOTE Form]
[TTYEdit (DEDITEdit (QUOTE TELETYPE)
(QUOTE Def))
NIL
(SUBITEMS ("TTYEdit Def"
(DEDITEdit (QUOTE TELETYPE
)
(QUOTE Def)))
("TTYEdit Form"
(DEDITEdit (QUOTE TELETYPE)
(QUOTE Form]
(TTYIn% Form (DEDITEdit (QUOTE
DEDIT.TTYinEdit
)
(QUOTE Form]
[EditCom DEDITEditCom (?= DEDITARGS)
(GETD (DEDITEditCom (QUOTE GETD)))
(CL (DEDITEditCom (QUOTE CL)))
(DW (DEDITEditCom (QUOTE DW)))
(REPACK (DEDITEditCom (QUOTE REPACK)))
(CAP (DEDITEditCom (QUOTE CAP)))
(LOWER (DEDITEditCom (QUOTE LOWER)))
(RAISE (DEDITEditCom (QUOTE RAISE]
(Break DEDITBreak)
(Eval DEDITEval)
(Exit DEDITExit (OK DEDITExit)
(STOP (DEDITExit T]
(GLOBALVARS *DEDIT-MENU-COMMANDS*))
(COMS (* "Maintaining deditmap entries and the edit chain")
(FNS BUFSELP EDITWINDOWP GETLEFT GETMEBP HASASBP TAILOF DOTTEDEND GETME4 GETSELMAP
DEARME DPCDRSEL GETDPME GETEBUF GETEBUFREGION GETEDITCHAIN GETDEDITMAP GETMAP?
UNPURGEDP SUBSELOF SETDEDITMAP TAKEDOWN)
(INITVARS (*DEDIT-BUFFER-HEIGHT* 60))
(GLOBALVARS *DEDIT-BUFFER-HEIGHT*))
(COMS (FNS DEDITRESHAPEFN DEDITREPAINTFN)
(FNS RESETDEDIT DEDITDATE DEDITMARKASCHANGED)
(FNS COPYCONS COPYOUTCONS MAPENTRYP THELIST)
(FNS CANT))
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS STACK)
(MACROS EDITBLOCKCALL CONTROLCODE OVERLAP SHIFTSELECTKEYS)
(CONSTANTS (LINETHICKNESS 2)
(PRIMSHADE 65535)
(SECSHADE 3598)
(SWITCHSHADE (LOGXOR PRIMSHADE SECSHADE))
(READSHADE 23130)
(CHANGEDSHADE 8840))
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS
\DEDITSELECTIONS DT.EDITMACROS UPFINDFLG)
(SPECVARS ATM EDITCHANGES EDITHIST LASTAIL UNDOLST UNDOLST1))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
DSPRINTDEF NEWPRINTDEF))
[DECLARE: DONTEVAL@LOAD 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])
(* "User entry to the editor")
(DEFINEQ
(DF
[NLAMBDA FN (* lmm "14-Aug-84 19:04")
(DEDITIT (COND
((EQ (CADR (LISTP FN))
(QUOTE NEW))
(QUOTE EDITFERROR))
(T (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")
(COND
(PROP (EDITDEF (LIST NAME PROP)
(QUOTE PROPS)))
(T (APPLY (QUOTE EDITP)
NAME])
(EDITMODE
[LAMBDA (NEWMODE) (* bas: "18-Mar-84 21:47")
(PROG [(OLDMODE (COND
((EQP (GETD (QUOTE EDITL))
(GETD (QUOTE DEDITL)))
(QUOTE DISPLAY))
(T (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])
)
(*
"Hooks between tty editor and DEDIT. We redefine EDITL to get into DEDIT from system editor calls"
)
(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))
(COND
(COMS (RESETSAVE EDITMACROS (CONS (QUOTE (TTY: NIL (E (DEDITTTYFN ATM TYPE)
T)))
EDITMACROS))
(NORMAL/EDITL L COMS ATM MESS EDITCHANGES))
(T (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.)
[COND
([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]
(* 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))
(COND
((CAR UNDOLST) (* 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]
(COND
[(PROG1 (DEDITL0 EXPR (GETEDITW ATM (AND (BOUNDP (QUOTE TYPE))
TYPE)))
(* Even if some error occurs, still
want to move undo information to
LISPXHISTORY.)
[COND
(UNDOLST1 (push UNDOLST (CONS T (CONS \DEDITSELECTIONS UNDOLST1]
(AND LISPXHIST (NEQ UNDOLST UNDOLST0)
(UNDOSAVE (LIST (QUOTE DUNDOEDITL)
\DEDITSELECTIONS UNDOLST UNDOLST0)
LISPXHIST)) (* Makes entire DEDITL undoable.)
) (* 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)
(COND
(LISPXHIST (NCONC LISPXHIST (LIST (QUOTE EDIT)
TMP]
(T (ERROR!]
L])
(DEDITL0
[LAMBDA (EXPR EDS SEL) (* bvm: "30-May-86 14:54")
(* * "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)))
[LET ((PM (GETMAP? EDS))
(ENV (DEDIT-MAKE-READER-ENV EXPR)))
(COND
([AND PM (EQ EXPR (fetch SELEXP of PM))
(EQUAL ENV (WINDOWPROP EDS (QUOTE READER-ENVIRONMENT]
(*
"Editing the same thing that's in the window now, and in the same reader environment")
(TOTOPW EDS) (* "Window might have been closed")
)
(T (WINDOWPROP EDS (QUOTE READER-ENVIRONMENT)
ENV)
(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))
[COND
(EDITHISTORY (COND
((PROG1 (AND ATM (NOT EDITHIST))
(* First time thru)
(EDITBLOCKCALL EDITSAVE COM)
(* Sets EDITHIST)
)
(LISPXPUT (QUOTE *FIRSTPRINT*)
(LIST (QUOTE EDITL2)
ATM T)
NIL EDITHIST]
(SETQ UNDOLST1 NIL) (*
"Holds any changes from execution of this command.")
(COND
[(PROG1 [ERSETQ (COND
((LITATOM ACT)
(APPLY* ACT))
(T (EVAL ACT]
[COND
(UNDOLST1 (REPPCHANGES UNDOLST1)
(push UNDOLST (SETQ UNDOLST1 (CONS COM (CONS SS UNDOLST1]
(COND
(EDITHIST (* "Set in EDITSAVE.")
(RPLACA EDITHIST UNDOLST1]
(T (* "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)))
(COND
(TEM [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)
)
([EVALV (QUOTE COMS)
(SETQ TEM (STKPOS (QUOTE EDITL0]
(RETEVAL TEM (QUOTE (ERROR!))
T))
(T (SHOULDNT])
)
(* "Basic DEDIT menu commands")
(DEFINEQ
(DEDITAfter
[LAMBDA NIL (* bas: "17-MAR-83 22:15")
(PROG ([NU (COPY (CAR (POPSELECTION]
(TGT (POPSELECTION)))
(DEDITZAPCDR TGT (PUSHSELECTION (COND
((DPCDRSEL TGT)
(DEDITCONS (CDR TGT)
NU TGT))
(T (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))
(COND
((DPCDRSEL TGT)
(CDR TGT))
(T 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 (COND
((DPCDRSEL S)
NIL)
(T (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)))
(COND
((OR (DOMINATE? A B)
(DOMINATE? B A))
(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)
(COND
((TAILOF B A))
[(TAILOF A B)
(SETQ A (PROG1 B (SETQ B A]
(T (CANT "Not brothers!")))
(COND
((DPCDRSEL B))
(T (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 (COND
((CDR LST)
"Undo blocked")
(T "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 ← (COND
(THRUP "Undo Thru")
(T "Undo One"))
CENTERFLG ← T]
(COND
((NOT C))
(THRUP (DEDITUndo C))
(T (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)))
(COND
([ERSETQ (RESETVARS (UPFINDFLG)
(EDIT4F TGT (QUOTE N]
(PUSHEDITCHAIN L) (* Uses LASTAIL)
)
(T (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])
(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)
[COND
((SETQ TSM (GETME4 TS))
[COND
((SETQ SCR (WINDOWPROP (fetch PDSP of TSM)
(QUOTE DEDITWHOAMI)))
(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)
(COND
((NLISTP (CAR A))
(CAR A))
(T (CAAR A]
NIL))
(OR [COND
(AMP (AND (fetch BP of AMP)
(FMEMB (CAAR (fetch TAIL of (fetch BP of AMP)))
NOBREAKS)
(PROMPTPRINT "Break installed inside a NOBREAKS"))
(COND
((EQ (CADR WHO)
(QUOTE FNS))
(/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 (COND
((LITATOM S)
(LIST (EVALV S SP)))
((ERSETQ (ENVAPPLY (FUNCTION LISPXEVAL)
(LIST S NIL)
SP)))
(T (LIST (QUOTE NOBIND]
(RELSTK SP])
(DEDITExit
[LAMBDA (STOPFLG) (* mjs "26-Mar-86 12:33")
(AND EDITHIST ATM (NOT STOPFLG)
(LISPXPUT (QUOTE *PRINT*)
(LIST (QUOTE EDITL2)
ATM)
NIL EDITHIST)) (* Hoaky stuff for the edit history
list)
(RETFROM (FUNCTION DEDITL0)
(NOT STOPFLG)
T])
)
(DEFINEQ
(DEDITEdit
[LAMBDA (EDITOR EDITEE) (* bvm: "30-May-86 16:50")
(RESETLST (RESETSAVE (SETCURSOR DEFAULTCURSOR)
(LIST (QUOTE SETCURSOR)
WAITINGCURSOR))
(PROG ((S (CAR (TOPSELECTION)))
A)
(SELECTQ EDITEE
((Def NIL)
(COND
((NOT (OR (LISTP S)
(LITATOM S)))
(DEDITDatatype S))
((AND (for old (S ← (POPSELECTION)) by (CAR S) while (LISTP S)
finally (RETURN (LITATOM S)))
(SETQ A (TYPESOF S NIL NIL (QUOTE ?)))
(SETQ A (SELECT.ATOM.ASPECT S NIL A)))
(RESETSAVE (EDITMODE EDITOR)) (* User can refuse all
SELECT.ATOM.ASPECT choices)
(EDITDEF S A (QUOTE ?)))
(T (CANT "No editable aspect"))))
(Form (AND [SETQ S (APPLY* (SELECTQ EDITOR
((TELETYPE DISPLAY)
(RESETSAVE (EDITMODE EDITOR))
(FUNCTION EDITE))
EDITOR)
(LIST (COPY S]
(DEDITZAPCAR (TOPSELECTION)
(CAR S))))
(SHOULDNT])
(DEDITCEdit
[LAMBDA (E FN) (* bvm: "30-May-86 16:55")
(* * "Edits an expression using the editor defined by FN. FN takes 2 args, the first a list of the expression(s) to edit, the second the edit window. Returns new list of expressions.")
(LET ((EW (GETEBUF (TOPEDITW)))
V)
(SETQ V (APPLY* FN E EW))
(COND
((CDR V) (* Replaced one expression with many)
(SETQ V (LIST V)))
(T V))
(OR (BUFSELP (GETME4 (TOPSELECTION)))
(BUFSELP (GETME4 (NXTSELECTION T)))
(SETUPDEDITW EW (COPY V)))
V])
(DEDIT.TTYinEdit
[LAMBDA (S) (* bvm: "30-May-86 16:55")
(COND
((DEFINEDP (QUOTE TTYINEDIT))
(DEDITCEdit S (QUOTE TTYINEDIT)))
(T (CANT "TTYIN not loaded"])
(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])
)
(ADDTOVAR DT.EDITMACROS )
(* "Structure changing")
(DEFINEQ
(SETPTRTO
[LAMBDA (X Y) (* bas: "12-Sep-84 16:25")
(PROG (XM BK TEM)
(COND
((NOT (SETQ XM (GETME4 X)))
(CANT "Already deleted!"))
([SETQ TEM (GETLEFT XM (SETQ BK (GETMEBP XM]
(DEDITZAPCDR TEM Y))
((fetch BP of BK)
(DEDITZAPCAR BK Y))
((NLISTP Y)
(CANT "Delete last list element"))
(T [DEDITZAPBOTH X (CAR Y)
(COND
((EQ X (CDR Y))
(RPLNODE2 Y X))
(T (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.)
(COND
[[SETQ ENT (COND
[(type? DEDITMAP CC)
(PROG1 CC (SETQ CC (fetch TAIL of CC]
(T (GETME4 CC]
(COND
((fetch BP of ENT))
((BUFSELP ENT))
((AND (EQ D (CDR CC))
(LISTP (CAR CC))
(LISTP A))
(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)))
(T (CANT "Alter top")))
[COND
((DPCDRSEL ENT)
[SETQ CC (LAST (fetch SELEXP of (fetch BP of ENT](* Real CONS)
(SETQ D (COND
((NEQ A (CDR CC))
A)
(T D)))
(SETQ A (CAR CC))
(PROG ((V (DOTTEDEND D)))
(COND
(V (DEDITFZAP (fetch TAIL of ENT)
V V))
(T (PUTHASH (fetch TAIL of (fetch BP of ENT))
NIL \DEDITDPHASH)
(PUTHASH (fetch TAIL of ENT)
NIL \DEDITMEHASH]
(AND EDITSMASHUSERFN (APPLY* EDITSMASHUSERFN CC (GETEDITCHAIN ENT)))
(COND
((DEDITFZAP CC A D)
[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]
(T (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 (COND
((EQ D OD)
(AND (NEQ A OA)
(FRPLACA CC A)))
((EQ A OA)
(FRPLACD CC D))
(T (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.)
(COND
((NLISTP CC))
[(AND CLISPTRANFLG (EQ CLISPTRANFLG (CAR CC)))
(COND
((LISTP (CDDR CC))
(/RPLNODE2 CC (CDDR CC)))
(T (* CLISP% used to translate an atom
e.g. QLISP does this.)
(SHOULDNT]
((AND CLISPARRAY (GETHASH CC CLISPARRAY))
(/PUTHASH CC NIL CLISPARRAY])
(DEDITZAPCHANGES
[LAMBDA (ME) (* bas: "18-OCT-81 22:29")
(COND
((for (I ← ME) by (fetch BP of I) while I never (GETHASH (fetch TAIL of I)
CHANGESARRAY))
[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.)
(COND
(LISPXHIST (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.)
(COND
((NLISTP X)
(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"))
)
((CAR X)
(DUNDOEDITCOM1 X) (* else has been undone before, dont
UNDO it again.)
))
(COND
(FLG (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])
)
(* "Selection code. Select expressions or from the command menu")
(DEFINEQ
(DEDITSLCTLP
[LAMBDA (CDS) (* mjs "26-Mar-86 16:27")
(* Does selections until a command is
given)
(RESETLST (RESETSAVE (DEDITUSER T))
(RESETSAVE \DEDITALLOWSELS T)
(CAR (ERSETQ (bind CMD do (WAIT.FOR.TTY)
(SETEDITMENU (COND
((KEYDOWNP (QUOTE TAB))
NIL)
(T CDS)))
[COND
((NOT (\SYSBUFP))
(SETQ CMD (READEDITMENU)))
((EQ (\PEEKSYSBUF)
(CHARCODE TAB))
(\GETSYSBUF) (* Flush TAB char)
)
[(SETQ CMD (DODEDITTYPEDCOM (GETEBUF CDS]
(T (SELECTKEYS (GETEBUF CDS]
(AND CMD (RETURN CMD))
(BLOCK])
(DEDITUSER
[LAMBDA (DS) (* bas: "12-Apr-84 20:17")
(FLIPSELS)
(SETCURSOR (COND
(DS DEFAULTCURSOR)
(T WAITINGCURSOR)))
(NOT DS])
(SELECTKEYS
[LAMBDA (W) (* mjs "26-Mar-86 16:19")
(PROG ((LINE (DEDITREADLINE NIL W)))
(SHADEIFNOTBUF (NXTSELECTION T)
SECSHADE) (* Push shading)
(SHADEIFNOTBUF (TOPSELECTION T)
SWITCHSHADE)
(SHADESELECTION (SETUPDEDITW W (PUSHSELECTION (LIST LINE)))
PRIMSHADE])
(DODEDITTYPEDCOM
[LAMBDA (W) (* mjs "26-Mar-86 16:19")
(bind (C ← (\PEEKSYSBUF)) for I in DEDITTYPEINCOMS
do (COND
((EQ C (CONTROLCODE (CAR I)))
(\GETSYSBUF)
(printout W (CADR I)
": ")
(RETURN (CONS (CADR I)
(CONS (CADDR I)
(DEDITREADLINE T W])
(DEDITREADLINE
[LAMBDA (ASLIST W) (* mjs "26-Mar-86 16:19")
(* Read a line of input from T.
This is like the grunge that goes on
inside of LISPX, figuring out where
the line ends...)
(RESETLST (RESETSAVE (TTYDISPLAYSTREAM W))
(RESETSAVE \DEDITALLOWSELS NIL)
(PROG ((FIRSTITEM (APPLY* LISPXREADFN T T))
CH LINE)
(RETURN (COND
((AND (LISTP FIRSTITEM)
(OR (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)
(COND
((SHIFTSELECTKEYS)
(SELECTREAD W))
(\DEDITALLOWSELS (SELECTELEMENT W])
(DEDITRIGHTBUTTONFN
[LAMBDA (W) (* bas: " 1-Apr-84 15:31")
(TOTOPW W) (* Bring it up, if nothing else)
(COND
((AND \DEDITALLOWSELS (INWINDOW W))
(SELECTTREE W))
(T (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)
(COND
((SHIFTSELECTKEYS)
(SELECTREAD W))
(T (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)))
(COND
((EQ M N))
(T (COND
((AND N M))
(T (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) (* bvm: " 4-Jun-86 18:48")
(bind M N while (SHIFTSELECTKEYS) do (until (SELECTDONE DS)
do (AND (SETQ M (SEARCHMAP DS))
(LASTMOUSESTATE MIDDLE)
(SETQ M (fetch BP of M)))
(COND
[(AND N M)
(COND
((EQ M N))
(T (SHADESELECTION N READSHADE)
(SHADESELECTION M READSHADE]
(T (SHADESELECTION (OR N M)
READSHADE)))
(SETQ N M))
finally (COND
(M (SHADESELECTION M READSHADE)
(WITH-READER-ENVIRONMENT (WINDOWPROP DS (QUOTE READER-ENVIRONMENT))
(BKSYSBUF (fetch SELEXP of M)
T)
(COND
((LISTP (fetch SELEXP of M)))
(T (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)
[COND
[(NOT (SETQ E (GETME4 L S]
((HASASBP E S))
(T (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 (COND
((IGREATERP Y (IPLUS FA (fetch STARTY of E)))
NIL)
[(IGEQ Y (IDIFFERENCE (fetch STARTY of E)
FD))
(AND (IGEQ X (fetch STARTX of E))
(OR (ILESSP X (fetch STOPX of E))
(NEQ (fetch STARTY of E)
(fetch STOPY of E]
((ILESSP Y (IDIFFERENCE (fetch STOPY of E)
FD))
NIL)
[(IGREATERP Y (IPLUS FA (fetch STOPY of E]
(T (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")
(COND
((NOT S2)
S1)
((EQ (fetch PDSP of S1)
(fetch PDSP of S2))
(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 (COND
((AND S1 S2)
(for old S2 by (fetch BP of S2) while S2 thereis (EQ S1 S2)))
(T (for I on (CAR (LISTP SUP)) thereis (DOMINATE? I SUB])
)
(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)
(* "Handling the selection stack")
(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)
(COND
[(OR (NOT NU)
(EQ (fetch TAIL of NU)
(TOPSELECTION T]
(T (SHADESELECTION (GETME4 (TOPSELECTION T)
T)
PRIMSHADE)
(replace TOPELT of \DEDITSELECTIONS with (fetch TAIL of NU))
(SHADESELECTION NU PRIMSHADE])
(SHADESELECTION
[LAMBDA (S SHADE) (* rrb "13-Feb-86 16:45")
(AND S (SHADESELECTION1 S SHADE])
(SHADESELECTION1
[LAMBDA (S TXT) (* bvm: "22-May-86 12:49")
(LET ((START (fetch STARTY of S))
(STOP (fetch STOPY of S)))
(COND
((EQ START STOP) (*
"All on one line. Last clause handles this in general, but test common case here for efficiency")
(SHADESELECTION2 S START (fetch STARTX of S)
(fetch STOPX of S)
TXT))
((LISTP (fetch SELEXP of S)) (* "Shade the parens and every element")
(SHADESELECTION2 S START (fetch STARTX of S)
(fetch LPEND of S)
TXT)
[for E on (fetch SELEXP of S) do (SHADESELECTION1 (GETME4 E S)
TXT)
finally (COND
(E (* Dotted pair)
(SHADESELECTION1 (GETME4 E S)
TXT]
(SHADESELECTION2 S STOP (fetch RPSTART of S)
(fetch STOPX of S)
TXT))
(T (* "A non-list spanning more than one line, probably a string. We don't know where the internal margins are, so be conservative")
(LET* [(DS (fetch PDSP of S))
[LEFT (COND
[(fetch LONGSTRINGP of S)
(fetch STARTX of (COND
((fetch LONGSTRING1MARGINP of S)
S)
(T (fetch BP of S]
(T (DSPLEFTMARGIN NIL DS]
(RIGHT (COND
((fetch LONGSTRINGSYMMETRICP of S)
(IDIFFERENCE (DSPRIGHTMARGIN NIL DS)
LEFT))
(T (DSPRIGHTMARGIN NIL DS]
(for I from START by (IMINUS (FONTPROP (fetch FNT of S)
(QUOTE HEIGHT))) to STOP
do (SHADESELECTION2 S I (COND
((EQ I START)
(fetch STARTX of S))
(T LEFT))
(COND
((EQ I STOP)
(fetch STOPX of S))
(T RIGHT))
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])
(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 (COND
((MAPENTRYP X)
(fetch TAIL of X))
(T 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))
(COND
[(CDR (THELIST LST))
(SETQ TMP (OR [COND
((LISTP (CAR LST))
(TAILP (CAR LST)
(CADR LST)))
(T (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]
(T (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)))
(COND
((EQ X (TOPSELECTION T))
(replace TOPELT of \DEDITSELECTIONS with Y))
((EQ X (NXTSELECTION T))
(replace NXTELT of \DEDITSELECTIONS with Y))
(T (SHOULDNT)))
(RETURN Y])
)
(* "Initializing and flushing edit windows")
(DEFINEQ
(ACTIVEEDITW
[LAMBDA (W ONFLG) (* lmm " 9-Jul-85 16:30")
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(AND ONFLG (FUNCTION DEDITBUTTONFN)))
[WINDOWPROP W (QUOTE RIGHTBUTTONFN)
(COND
(ONFLG (FUNCTION DEDITRIGHTBUTTONFN))
(T (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)
(COND
(ONFLG (FUNCTION DEDITWINDOWENTRYFN))
(T (FUNCTION GIVE.TTY.PROCESS]
(DSPSCROLL (COND
(ONFLG (QUOTE OFF))
(T 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) (* rrb " 2-Oct-85 18:44")
(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))) (* make this process be the process
for this window so that clicking in it
will give the tty to this Dedit.)
(WINDOWPROP W (QUOTE PROCESS)
(THIS.PROCESS))
(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) (* rrb " 2-Oct-85 18:44")
(PROG [(W (COND
((TOPEDITW)
(WINDOWPROP (TOPEDITW)
(QUOTE DEDITCACHED)
NIL))
(T (WINDOWP DEditWindow]
(DECLARE (USEDFREE EDITCHANGES))
(AND (COND
[(NOT W)
(SETQ W (CREATEW NIL (NAMEOFEDITW NAME TYP]
((NOT (SAMEEDITW W NAME TYP))
(CLEARW W)
(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 (COND
[(CADR (LISTP NAME))
(PROG1 (CONCAT (CADR NAME)
" property of ")
(SETQ NAME (CAR NAME]
(T "property list of")))
(VARS (COND
[(AND (STREQUAL (SUBSTRING NAME -4 -1)
"COMS")
(HASDEF (SUBSTRING NAME 1 -5)
(QUOTE FILE)))
(PROG1 "filecoms for file" (SETQ NAME (SUBSTRING NAME 1 -5]
(T "variable")))
TYPE)
" " NAME])
(PURGEW
[LAMBDA (W DONTCLR) (* rmk: "13-Sep-84 16:49")
[PROG [(WDS (COND
((WINDOWP W)
(WINDOWPROP W (QUOTE DSP)))
(T (PROG1 W (SETQ W (WFROMDS W]
[COND
((EQ W DEditWindow)
(CLRHASH \DEDITMEHASH)
(CLRHASH \DEDITDPHASH))
(T (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)
(COND
(DONTCLR)
(T (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) (* bvm: "22-May-86 12:46")
(* * "Desensitizes DEDIT windows and removes surplus ones")
(COND
(\DEDITMNUW (WINDOWPROP \DEDITMNUW (QUOTE PROCESS)
NIL)
(CLOSEW \DEDITMNUW)))
(PROG [(W (WFROMDS (OR (CAR (LISTP WDS))
(SHOULDNT]
(DECLARE (USEDFREE DEditLinger))
(TAKEDOWN (WINDOWPROP W (QUOTE EDITBUF)))
(SETQ \DEDITBUFW NIL)
[COND
((EQ WDS \DEDITWINDOWS)
(SETQ \DEDITWINDOWS (CDR WDS)))
(T (for I on \DEDITWINDOWS when (EQ WDS (CDR I)) do (RETURN (RPLACD I (CDDR I)))
finally (SHOULDNT "DEDITDSPS tangled"]
(COND
[\DEDITWINDOWS (COND
((FMEMB W \DEDITWINDOWS))
(T (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]
(T (COND
((AND RESETSTATE (CADR (WINDOWPROP W (QUOTE DEDITCHANGES)
NIL)))
(ZORCHEDITW W)))
(OR (WINDOWP DEditWindow)
(SETQ DEditWindow W))
(WINDOWPROP W (QUOTE PROCESS)
NIL)
(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)))
(COND
((ZORCHEDWP W)
(RETURN (SETDEDITMAP W (LIST (GETDEDITDEF4 W])
)
(RPAQ? DEditLinger T)
(* "Manipulating the Edit menu")
(DEFINEQ
(SETEDITMENU
[LAMBDA (EW) (* bvm: "30-May-86 16:04")
(DECLARE (GLOBALVARS \DEDITCOMS))
(PROG (MR X Y H W IMAGE)
[SETQ MR (AND (WINDOWP \DEDITMNUW)
(WINDOWPROP \DEDITMNUW (QUOTE REGION]
(* 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)
[COND
(MR (SETQ W (fetch (REGION WIDTH) of MR))
(SETQ H (fetch (REGION HEIGHT) of MR)))
(T (SETQ IMAGE (CACHEDEDITCOMS *DEDIT-MENU-COMMANDS*))
(SETQ W (ITIMES 2 (SUB1 WBorder)))
(SETQ H (IPLUS (BITMAPHEIGHT IMAGE)
(IMINUS (DSPLINEFEED NIL WindowTitleDisplayStream))
W))
(SETQ W (IPLUS (BITMAPWIDTH IMAGE)
W]
[COND
[EW (PROG (ER)
(SETQ ER (WINDOWPROP EW (QUOTE REGION)))
(SETQ X (fetch (REGION PRIGHT) of ER))
(SETQ Y (IDIFFERENCE (fetch (REGION PTOP) of ER)
H]
(T (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]
[COND
(MR (COND
[(AND (EQ X (fetch (REGION LEFT) of MR))
(EQ Y (fetch (REGION BOTTOM) of MR]
(T (MOVEW \DEDITMNUW X Y)))
(TOTOPW \DEDITMNUW))
(T (PROG (NUR)
(SETQ NUR
(create REGION
LEFT ← X
BOTTOM ← Y
WIDTH ← W
HEIGHT ← H))
[COND
((DISPLAYSTREAMP \DEDITMNUW)
(SETQ \DEDITMNUW (WFROMDS \DEDITMNUW))
(WINDOWPROP \DEDITMNUW (QUOTE RESHAPEFN)
NIL)
(SHAPEW \DEDITMNUW NUR))
(T (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 (COMLIST) (* bvm: "30-May-86 16:20")
(* * "Builds a menu image from the commands in COMLIST. Sets arrays EDITMENU\COMS and EDITMENU\SUBS with elements in INVERSE order for convenience of READEDITMENU")
(DECLARE (GLOBALVARS EDITMENU\COMS EDITMENU\SUBS))
(LET* ((N (LENGTH COMLIST))
(COMS (ARRAY N NIL NIL 0))
(SUBMENUS (ARRAY N NIL NIL 0)))
[for ITEM in COMLIST as J from (SUB1 N) by -1
do (SETA COMS J (CONS (CAR ITEM)
(CADR ITEM))) (* The main item)
(SETA SUBMENUS J (AND (CDDR ITEM)
(create MENU
ITEMS ←
[for Q in (CDDR ITEM)
collect (BQUOTE ((\, (CAR Q))
[QUOTE ((\, (CAR Q))
(\,@ (CADR Q]
(\,@ (CDDR Q]
CENTERFLG ← T
MENUOFFSET ← (create POSITION
XCOORD ← -1
YCOORD ←
(IQUOTIENT
(ITIMES (FONTPROP MENUFONT
(QUOTE HEIGHT))
(LENGTH (CDDR ITEM)))
2]
(SETQ EDITMENU\COMS COMS)
(SETQ EDITMENU\SUBS SUBMENUS)
(CHECK/MENU/IMAGE (create MENU
ITEMS ← COMLIST
CENTERFLG ← T])
(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 (* lmm " 4-Nov-85 22:47")
(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 (COND
((SHIFTDOWNP (QUOTE CTRL))
(COND
(VAL (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))
[COND
((AND [EQ (SETQ MOUSEWASDOWN MOUSEISDOWN)
(SETQ MOUSEISDOWN (LASTMOUSESTATE (NOT UP]
(EQ N OLDN)) (* Nothing going on)
(OR MOUSEISDOWN (BLOCK)) (* But dont block if mouse is down
lest we miss an upclick)
)
(T (COND
((EQ N OLDN)
(SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW)
OTHERS))
(T (SHADEMENUENTRY OLDN EMDS VLF MOUSEWASDOWN OTHERS)
(SHADEMENUENTRY N EMDS VLF MOUSEISDOWN OTHERS)))
(COND
((AND (LASTMOUSESTATE MIDDLE)
(ELT EDITMENU\SUBS N)) (* Submenu)
(SETQ VAL (MENU (ELT EDITMENU\SUBS N)))
(SETQ MOUSEISDOWN NIL)
(SHADEMENUENTRY N EMDS VLF (QUOTE HOLLOW)
OTHERS))
((AND (NOT MOUSEISDOWN)
MOUSEWASDOWN N) (* 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 (COND
(\DEDITMNUW (WFROMDS EMDS))
(T EMDS))) (* Exited cleanly, restore global)
(RETURN (COND
[OTHERS (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]
(T 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])
)
(RPAQQ *DEDIT-MENU-COMMANDS* [(After DEDITAfter)
(Before DEDITBefore)
(Delete DEDITDelete)
(Replace DEDITReplace)
(Switch DEDITSwitch)
("( )" DEDITBI ("( ) in" DEDITBI)
("( in" DEDITLI)
(") in" DEDITRI))
("( ) out" DEDITBO ("( ) out" DEDITBO)
("( out" DEDITLO)
(") out" DEDITRO))
(Undo DEDITUndo (Undo DEDITUndo)
(!Undo (DEDITUndo T))
(?Undo (UNDOCHOOSE))
(&Undo (UNDOCHOOSE T)))
(Find DEDITFind)
(Swap DEDITSwap (Center DEDITCenter)
(Clear (SETQ \DEDITSELECTIONS NIL))
(Copy DEDITCopy)
(Pop (POPSELECTION))
(Swap DEDITSwap))
(Reprint DEDITReprint)
[Edit DEDITEdit [DEdit (DEDITEdit (QUOTE DISPLAY)
(QUOTE Def))
NIL
(SUBITEMS ("DEdit Def" (DEDITEdit (QUOTE DISPLAY
)
(QUOTE Def)))
("DEdit Form" (DEDITEdit (QUOTE DISPLAY)
(QUOTE Form]
[TTYEdit (DEDITEdit (QUOTE TELETYPE)
(QUOTE Def))
NIL
(SUBITEMS ("TTYEdit Def" (DEDITEdit (QUOTE TELETYPE)
(QUOTE Def)))
("TTYEdit Form" (DEDITEdit (QUOTE TELETYPE)
(QUOTE Form]
(TTYIn% Form (DEDITEdit (QUOTE DEDIT.TTYinEdit)
(QUOTE Form]
[EditCom DEDITEditCom (?= DEDITARGS)
(GETD (DEDITEditCom (QUOTE GETD)))
(CL (DEDITEditCom (QUOTE CL)))
(DW (DEDITEditCom (QUOTE DW)))
(REPACK (DEDITEditCom (QUOTE REPACK)))
(CAP (DEDITEditCom (QUOTE CAP)))
(LOWER (DEDITEditCom (QUOTE LOWER)))
(RAISE (DEDITEditCom (QUOTE RAISE]
(Break DEDITBreak)
(Eval DEDITEval)
(Exit DEDITExit (OK DEDITExit)
(STOP (DEDITExit T])
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *DEDIT-MENU-COMMANDS*)
)
(* "Maintaining deditmap entries and the edit chain")
(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 (COND
((LISTP (CDR I))
(EQ (CDR I)
(fetch TAIL of SEL)))
((CDR I)
(EQ (CDR I)
(fetch SELEXP of SEL)))
(T 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")
(COND
((LISTP C)
(CDR (LAST C)))
(T 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 [COND
((LISTP C)
(HASASBP C B))
(T (EQ C (DOTTEDEND (fetch SELEXP of B]
(SHOULDNT "Invalid BP"))
(COND
((NLISTP C)
(GETDPME B))
[(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]
(T (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) (* bvm: "27-May-86 15:15")
(* * "Return the edit buffer window for main window EW, reshaping or moving it as needed if windows have moved in the meantime. Maybe should do this with attached windows.")
(LET ((MAINREG (WINDOWPROP EW (QUOTE REGION)))
(EBW (WINDOWPROP EW (QUOTE EDITBUF)))
EBWREG LEFT)
(COND
((AND \DEDITBUFW (NEQ EBW \DEDITBUFW))
(CLOSEW \DEDITBUFW)))
(COND
((NOT EBW)
(SETQ EBW (CREATEW (GETEBUFREGION MAINREG (OR (FIXP *DEDIT-BUFFER-HEIGHT*)
60)
EW)
"Edit buffer"))
(WINDOWPROP EBW (QUOTE PAGEFULLFN)
(FUNCTION NILL))
(WINDOWPROP EW (QUOTE EDITBUF)
EBW))
((PROGN (PURGEW (ACTIVEEDITW EBW NIL))
(SETQ EBWREG (WINDOWPROP EBW (QUOTE REGION)))
(NEQ (fetch (REGION WIDTH) of MAINREG)
(fetch (REGION WIDTH) of EBWREG))) (* "User reshaped edit window to different width. Reshape it now to the main window's width, user's height. No DEdit specific reshaping will happen because window is now inactive")
(SHAPEW EBW (GETEBUFREGION MAINREG (fetch (REGION HEIGHT) of EBWREG)
EBW)))
((NEQ (SETQ LEFT (fetch (REGION LEFT) of MAINREG))
(fetch (REGION LEFT) of EBWREG)) (*
"Window strayed somehow, move it to the right place")
(MOVEW EBW LEFT (IDIFFERENCE (fetch (REGION BOTTOM) of MAINREG)
(fetch (REGION HEIGHT) of EBWREG)))
(OPENW EBW))
(T (OPENW EBW)))
(WINDOWPROP EBW (QUOTE READER-ENVIRONMENT)
(WINDOWPROP EW (QUOTE READER-ENVIRONMENT)))
(WINDOWPROP (SETQ \DEDITBUFW EBW)
(QUOTE DSP])
(GETEBUFREGION
[LAMBDA (MAINREG HEIGHT EW) (* bvm: "27-May-86 15:07")
(LET* ((FONTHEIGHT (FONTPROP EW (QUOTE HEIGHT)))
(TOTALHEIGHT (HEIGHTIFWINDOW HEIGHT T))
(BOTTOM (IDIFFERENCE (fetch (REGION BOTTOM) of MAINREG)
TOTALHEIGHT))
EXCESS)
[COND
((LESSP BOTTOM 0) (*
"Region overlaps bottom of screen, so force it on")
(SETQ BOTTOM 0)
[SETQ HEIGHT (IDIFFERENCE HEIGHT (IDIFFERENCE TOTALHEIGHT (SETQ TOTALHEIGHT
(IDIFFERENCE
(fetch (REGION BOTTOM)
of MAINREG)
BOTTOM]
(COND
((LESSP HEIGHT 0) (*
"Eek, it's off screen entirely. Make it one high just for giggles")
(SETQ TOTALHEIGHT (HEIGHTIFWINDOW (SETQ HEIGHT FONTHEIGHT)
T]
[COND
((NEQ (SETQ EXCESS (IREMAINDER HEIGHT FONTHEIGHT))
0) (* Try to make window integral number
of lines high)
(SETQ TOTALHEIGHT (IDIFFERENCE TOTALHEIGHT EXCESS))
(SETQ BOTTOM (IPLUS BOTTOM EXCESS]
(create REGION
LEFT ← (fetch (REGION LEFT) of MAINREG)
BOTTOM ← BOTTOM
WIDTH ← (fetch (REGION WIDTH) of MAINREG)
HEIGHT ← TOTALHEIGHT])
(GETEDITCHAIN
[LAMBDA (E) (* bas: "30-MAR-83 21:45")
(DECLARE (USEDFREE LASTAIL))
(COND
((LISTP E)
(SETQ LASTAIL E)
(SETQ E (OR (GETME4 E)
E)))
((type? DEDITMAP E)
(SETQ LASTAIL (fetch TAIL of E)))
(E (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 (COND
((ZORCHEDWP DS)
(LIST (GETDEDITDEF4 DS)))
(T (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")
(COND
(WDS (PURGEW WDS T)
(CLOSEW WDS])
)
(RPAQ? *DEDIT-BUFFER-HEIGHT* 60)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *DEDIT-BUFFER-HEIGHT*)
)
(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
(RESETDEDIT
[LAMBDA NIL (* bvm: " 4-Jun-86 17:34")
(DECLARE (GLOBALVARS \DEDITCOMS))
(pushnew MARKASCHANGEDFNS (FUNCTION DEDITMARKASCHANGED))
[PROGN (MOVD? (QUOTE EDITL)
(QUOTE NORMAL/EDITL))
(MOVD? (QUOTE EDITDATE)
(QUOTE NORMAL\EDITDATE))
(EDITMODE (COND
((BOUNDP (QUOTE DEditMode))
DEditMode)
(T (QUOTE DISPLAY]
(PROGN (for I in (CONS DEditWindow (LISTP \DEDITWINDOWS)) when (WINDOWP I)
do (CLOSEW I))
(SETQ DEditWindow NIL) (* Initialize DEDIT globals)
(SETQ \DEDITWINDOWS NIL)
(SETQ \DEDITALLOWSELS NIL)
(SETQ \DEDITSELECTIONS NIL)
(SETQ \DEDITBUFW NIL)
(SETQ \DEDITMNUW NIL)
(SETQ \DEDITMEHASH (HASHARRAY 255))
(SETQ \DEDITDPHASH (HASHARRAY 255))
(SETQ \DEDITFONTS NIL)
(SETQ \DEDITDSPS (ARRAY 8)) (* 8 is arbitrary)
)
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 (COND
((FINDEDITW NAME TYPE))
(T (AND (WINDOWP DEditWindow)
(SAMEEDITW DEditWindow NAME TYPE)
(NOT (CADR (WINDOWPROP DEditWindow (QUOTE DEDITCHANGES)
NIL)))
DEditWindow])
)
(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)
(COND
((NLISTP C1)
C1)
((EQ C1 C2)
(COPYCONS C1))
(T (PROG ((CA (COPYOUTCONS (CAR C1)
C2))
(CD (COPYOUTCONS (CDR C1)
C2)))
(RETURN (COND
((AND (EQ CA (CAR C1))
(EQ CD (CDR C1)))
C1)
(T (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 (* hdj " 7-May-86 11:09")
(* Report error by flashing window)
(DSPRESET PROMPTWINDOW)
(printout PROMPTWINDOW T "Can't: ")
(for I to NMSGS do (printout PROMPTWINDOW , (ARG NMSGS I)))
(FLASHWINDOW 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 CONTROLCODE MACRO ((CHAR)
(IDIFFERENCE (CHCON1 CHAR)
(CONSTANT (IDIFFERENCE (CHARCODE A)
(CHARCODE ↑A]
[PUTPROPS OVERLAP MACRO (OPENLAMBDA (H1 L1 H2 L2)
(NOT (OR (ILESSP H1 L2)
(ILESSP H2 L1]
[PUTPROPS SHIFTSELECTKEYS MACRO (NIL (OR (SHIFTDOWNP (QUOTE SHIFT))
(KEYDOWNP (QUOTE COPY]
)
(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: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEditWindow \DEDITMNUW \DEDITBUFW \DEDITALLOWSELS \DEDITWINDOWS \DEDITSELECTIONS
DT.EDITMACROS UPFINDFLG)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS ATM EDITCHANGES EDITHIST LASTAIL UNDOLST UNDOLST1)
)
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
DSPRINTDEF NEWPRINTDEF)
)
(DECLARE: DONTEVAL@LOAD 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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9926 13200 (DF 9936 . 10263) (DV 10265 . 10456) (DP 10458 . 10653) (DC 10655 . 11121) (
EF 11123 . 11314) (EV 11316 . 11508) (EP 11510 . 11706) (EDITPROP 11708 . 11957) (EDITMODE 11959 .
13022) (DEDITIT 13024 . 13198)) (13315 23085 (DEDITL 13325 . 17653) (DEDITL0 17655 . 21147) (
DEDITTTYFN 21149 . 23083)) (23126 37193 (DEDITAfter 23136 . 23720) (DEDITBefore 23722 . 24278) (
DEDITDelete 24280 . 25071) (DEDITReplace 25073 . 25428) (DEDITSwitch 25430 . 25857) (DEDITBI 25859 .
26505) (DEDITBO 26507 . 26733) (DEDITLI 26735 . 26926) (DEDITLO 26928 . 27123) (DEDITRI 27125 . 27651)
(DEDITRO 27653 . 27824) (DEDITUndo 27826 . 28509) (UNDOCHOOSE 28511 . 29615) (DEDITFind 29617 . 30225
) (DEDITSwap 30227 . 30734) (DEDITCenter 30736 . 32347) (DEDITCopy 32349 . 32517) (DEDITReprint 32519
. 32694) (DEDITEditCom 32696 . 33623) (DEDITARGS 33625 . 34043) (DEDITBreak 34045 . 35901) (DEDITEval
35903 . 36700) (DEDITExit 36702 . 37191)) (37194 41515 (DEDITEdit 37204 . 38990) (DEDITCEdit 38992 .
39750) (DEDIT.TTYinEdit 39752 . 40002) (DEDITDatatype 40004 . 41513)) (41580 53192 (SETPTRTO 41590 .
42333) (DEDITCONS 42335 . 42634) (DEDITZAPCAR 42636 . 42851) (DEDITZAPCDR 42853 . 43080) (DEDITZAPNODE
43082 . 43247) (DEDITZAPBOTH 43249 . 46194) (DEDITFZAP 46196 . 47134) (DEDITZAPCLISP 47136 . 48063) (
DEDITZAPCHANGES 48065 . 49073) (DEDITMOVETAILDOWN 49075 . 49543) (DUNDOEDITL 49545 . 50544) (
DUNDOEDITCOM 50546 . 51867) (DUNDOEDITCOM1 51869 . 53190)) (53268 66289 (DEDITSLCTLP 53278 . 54662) (
DEDITUSER 54664 . 54903) (SELECTKEYS 54905 . 55383) (DODEDITTYPEDCOM 55385 . 55859) (DEDITREADLINE
55861 . 57751) (SHADEIFNOTBUF 57753 . 57973) (DEDITBUTTONFN 57975 . 58298) (DEDITRIGHTBUTTONFN 58300
. 58629) (DEDITWINDOWENTRYFN 58631 . 59216) (SELECTELEMENT 59218 . 60048) (SELECTREAD 60050 . 61563)
(SELECTTREE 61565 . 61847) (SEARCHMAP 61849 . 63350) (WITHINME 63352 . 64414) (ONAPARENP 64416 . 64993
) (SELECTDONE 64995 . 65163) (INWINDOW 65165 . 65369) (FINDLCA 65371 . 65705) (DOMINATE? 65707 . 66287
)) (66887 77214 (POPSELECTION 66897 . 67079) (PUSHSELECTION 67081 . 67237) (NXTSELECTION 67239 . 67475
) (TOPSELECTION 67477 . 67712) (SWITCHANDSHADE 67714 . 68375) (SHADESELECTION 68377 . 68533) (
SHADESELECTION1 68535 . 71540) (SHADESELECTION2 71542 . 71899) (OVERLAPSELBAND 71901 . 72172) (
PUSHEDITCHAIN 72174 . 72569) (MAKESELCHAIN 72571 . 73811) (PUSHINTOBUF 73813 . 73959) (DUMMYMAPENTRY
73961 . 74378) (FLIPSELS 74380 . 74914) (FLIPSELSIN 74916 . 75741) (FIXUPSEL 75743 . 76745) (NEWSELFOR
76747 . 77212)) (77268 87637 (ACTIVEEDITW 77278 . 78453) (FINDEDITW 78455 . 78642) (GETEDITW 78644 .
79512) (GETDEDITDEF4 79514 . 79937) (MAKEEDITW 79939 . 80965) (NAMEOFEDITW 80967 . 82049) (PURGEW
82051 . 83259) (MAKECPOSBE 83261 . 83616) (SAMEEDITW 83618 . 83869) (SETUPDEDITW 83871 . 84057) (
TOPEDITW 84059 . 84193) (UNDEDITW 84195 . 86065) (WHICHEDITW 86067 . 86385) (ZORCHEDITW 86387 . 86966)
(ZORCHEDWP 86968 . 87336) (UNZORCHME 87338 . 87635)) (87706 98791 (SETEDITMENU 87716 . 91206) (
CACHEDEDITCOMS 91208 . 93405) (FINDEDITCOM 93407 . 93636) (READEDITMENU 93638 . 97515) (SHADEMENUENTRY
97517 . 98540) (DEDITMENURESTORE 98542 . 98789)) (102364 115311 (BUFSELP 102374 . 102596) (
EDITWINDOWP 102598 . 102845) (GETLEFT 102847 . 103579) (GETMEBP 103581 . 103750) (HASASBP 103752 .
104113) (TAILOF 104115 . 104401) (DOTTEDEND 104403 . 104579) (GETME4 104581 . 106254) (GETSELMAP
106256 . 106791) (DEARME 106793 . 107699) (DPCDRSEL 107701 . 108065) (GETDPME 108067 . 108274) (
GETEBUF 108276 . 110485) (GETEBUFREGION 110487 . 112445) (GETEDITCHAIN 112447 . 112941) (GETDEDITMAP
112943 . 113282) (GETMAP? 113284 . 113443) (UNPURGEDP 113445 . 114133) (SUBSELOF 114135 . 114386) (
SETDEDITMAP 114388 . 115131) (TAKEDOWN 115133 . 115309)) (115422 116124 (DEDITRESHAPEFN 115432 .
115854) (DEDITREPAINTFN 115856 . 116122)) (116125 118563 (RESETDEDIT 116135 . 117295) (DEDITDATE
117297 . 117744) (DEDITMARKASCHANGED 117746 . 118561)) (118564 119797 (COPYCONS 118574 . 118720) (
COPYOUTCONS 118722 . 119476) (MAPENTRYP 119478 . 119633) (THELIST 119635 . 119795)) (119798 120204 (
CANT 119808 . 120202)))))
STOP