(FILECREATED "12-NOV-83 23:13:36" {PHYLUM}<LISPCORE>SOURCES>EDIT.;3 110825
changes to: (FNS EDITF EDITLOADFNS? EDITE)
previous date: "26-JUL-83 20:56:44" {PHYLUM}<LISPCORE>SOURCES>EDIT.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT EDITCOMS)
(RPAQQ EDITCOMS [(FNS ## EDIT* EDIT: EDITDEFAULT EDITDEFAULT1 EDITFNS EDITH EDITRAN EDITTO EDITXTR
EDLOC EDLOCL EDOR EDRPT EDUP ESUBST ESUBST1 EDITF EDITFA EDITFB EDITLOADFNS?
EDITE EDITELT UNSAVEBLOCK? EDITF1 EDITF2 EDITV EDITP EDITL EDITL0 EDITL1 EDITL2
UNDOEDITL EDITCOM EDITCOMA EDITCOML EDITCONT EDITMAC EDITMBD EDITMV EDITCOMS
EDIT!UNDO UNDOEDITCOM UNDOEDITCOM1 EDITCOM1 EDITSAVE EDITSAVE1 EDITSMASH
EDITSMASH1 EDITSW EDITNCONC EDITAPPEND EDIT1F EDIT2F EDIT4E EDIT4E1 EDITQF
EDIT4F EDIT4F1 EDIT4F2 EDIT4F3 EDITFPAT EDITFPAT1 EDITFINDP FEDITFINDP
EDITBELOW EDITBF EDITBF1 EDITNTH BPNT BPNT0 EDIT.RI EDIT.RO EDIT.LI EDIT.LO
EDIT.BI EDIT.BO)
(BLOCKS (EDITBLOCK EDITL EDITL0 EDITL1 UNDOEDITL EDITCOM EDITCOMA EDITCOML EDITMAC EDITCOMS
EDIT!UNDO UNDOEDITCOM UNDOEDITCOM1 EDITCOM1 EDITSMASH EDITSMASH1 EDITNCONC
EDITAPPEND EDIT1F EDIT2F EDITNTH BPNT BPNT0 EDIT.RI EDIT.RO EDIT.LI
EDIT.LO EDIT.BI EDIT.BO EDITDEFAULT EDITDEFAULT1 ## EDUP EDIT* EDOR EDRPT
EDLOC EDLOCL EDIT: EDITMBD EDITXTR EDITELT EDITCONT EDITSW EDITMV EDITTO
EDITBELOW EDITRAN EDITSAVE EDITSAVE1 EDITH
(ENTRIES EDITL EDITL0 ## UNDOEDITL BPNT0 EDITCONT EDLOCL)
(SPECVARS L ATM COM LCFLG #1 #2 #3 UNDOLST UNDOLST1 LASTAIL MARKLST UNFIND
LASTP1 LASTP2 COMS EDITCHANGES EDITHIST0 LISPXID)
(RETFNS EDITL0 EDITL1)
(BLKAPPLYFNS EDIT: EDITMBD EDITMV EDITXTR EDITSW)
(BLKLIBRARY NTH LAST MEMB NLEFT)
(NOLINKFNS PRINTDEF EDITRACEFN EDITUSERFN)
(LOCALFREEVARS FINDFLAG EDITHIST UNDOLST1 COM L L0 COM0 UNDOLST EDITLFLG
ATM MARKLST EDITHIST0 UNFIND TYPEIN LCFLG LASTP1 LASTP2
LASTAIL COPYFLG ORIGFLG COMS TOFLG C LVL EDITCHANGES
EDITLISPFLG)
(GLOBALVARS EDITCALLS P.A.STATS EDITUNDOSTATS EDITUNDOSAVES SPELLSTATS1
P.A.STATS EDITUSERFN EDITIME USERHANDLE DONTSAVEHISTORYCOMS
COMPACTHISTORYCOMS EDITEVALSTATS MAXLOOP EDITCOMSL EDITCOMSA
DWIMFLG CLISPTRANFLG EDITOPS HISTORYCOMS REREADFLG HISTSTR3
EDITRDTBL EDITHISTORY HISTSTR0 READBUF LISPXHISTORY LISPXBUFS
EDITRACEFN EDITMACROS USERMACROS CLISPARRAY CHANGESARRAY
COMMENTFLG **COMMENT**FLG EDITESTATS EDITISTATS PRETTYFLG
EDITSMASHUSERFN))
(EDITFINDBLOCK EDIT4E EDIT4E1 EDITQF EDIT4F EDITFPAT EDITFPAT1 EDIT4F1 EDIT4F2
EDIT4F3 EDITSMASH EDITSMASH1 EDITFINDP EDITBF EDITBF1 ESUBST
(ENTRIES EDIT4E EDIT4E1 EDITQF EDIT4F EDITFPAT EDITFINDP EDITBF ESUBST)
(LOCALFREEVARS C3 CHANGEFLG N TOPLVL FF NEWFLG FLG)
(GLOBALVARS EDITUNDOSAVES CHCONLST2 EDITQUIETFLG CHCONLST1 MAXLEVEL
UPFINDFLG CLISPTRANFLG CHANGESARRAY CLISPARRAY EDITHISTORY)
(SPECVARS ATM L COM UNFIND LASTAIL UNDOLST1 EDITCHANGES))
(EDITFBLOCK EDITF EDITFA EDITFB EDITV EDITP EDITE (ENTRIES EDITF EDITV EDITP EDITE)
(SPECVARS EDITCHANGES EDITFN)
(NOLINKFNS EDITLOADFNS? LOADFROM)
(GLOBALVARS DWIMFLG DWIMWAIT USERWORDS EDITLOADFNSFLG EDITUNSAVEBLOCKFLG
SPELLINGS3 DFNFLG ADDSPELLFLG))
(NIL ESUBST1 EDITFNS EDITLOADFNS? UNSAVEBLOCK? (GLOBALVARS FILELST FILEPKGFLG DWIMFLG
DWIMWAIT DWIMLOADFNSFLG)
(NOLINKFNS WHEREIS)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA EDITP EDITV EDITF EDITFNS ##)
(NLAML EDITF2)
(LAMA])
(DEFINEQ
(##
[NLAMBDA COMS
(PROG ((L (EVQ L))
UNDOLST1
(LASTAIL (EVQ LASTAIL))
(MARKLST (EVQ MARKLST))
(UNFIND (EVQ UNFIND)))
(* ## is an external entry to the editblock, so local freevariables must be looked up or traps will occur.
LASAIL, MARKLT, and UNDOLST1 are rebound (and therefore looked up) here to avoid their being changed by the call to
##. The rest are looked up in EDITL0 because it is called with EDITLFLG=nil.)
(RETURN (CAR (COND
((NULL COMS)
L)
(T (EDITL0 L COMS])
(EDIT*
[LAMBDA (N) (* Equivalent to a !0 followed by an appropriate number.)
(CAR (SETQ L (PROG (COM (L L)
[X (PROG ((L L))
(EDUP)
(RETURN (CAR L]
TEM)
(* COM is rebound here because EDITCOM resets it so that 'CURRENT' command is typed when failure occurs.
However, want to see BK typed, not !0 or -3)
(EDITCOM (QUOTE !0))
(SETQ TEM (CAR L))
[COND
([COND
((MINUSP N)
(SETQ TEM (NLEFT TEM (MINUS N)
X)))
(T (LISTP (SETQ TEM (CDR (NTH X N]
(SETQ LASTAIL TEM)
(RETURN (CONS (CAR TEM)
L]
(ERROR!])
(EDIT:
[LAMBDA (TYPE LC X) (* DD: " 7-Oct-81 20:49")
(PROG (TOFLG)
[SETQ X (MAPCAR X (FUNCTION (LAMBDA (X)
(COND
[(EQ (CAR (LISTP X))
|
(QUOTE ##))
(PROG ((L L)
UNDOLST1
(LCFLG T))
(RETURN (COPY (EDITCOMS (CDR X]
(T X]
(COND
(LC [COND
((EQ (CAR (LISTP LC))
|
(QUOTE HERE))
(SETQ LC (CDR LC]
(EDLOC LC T)))
(EDUP)
(SELECTQ TYPE
((B BEFORE)
(EDIT2F -1 X))
[(A AFTER)
(COND
((CDAR L)
(EDIT2F -2 X))
(T (EDITCOML (CONS (QUOTE N)
X)
COPYFLG]
[(: FOR)
(COND
((OR X (CDAR L))
(EDIT2F 1 X))
((MEMB (CAR L)
(CADR L))
(* Singleton list, e.g. (-- ((A)) --) (DELETE A) -
result is (-- NIL --); or (-- (A) --) and say (DELETE A 1) result is (-- NIL --))
(EDUP)
(EDIT2F 1 (LIST NIL)))
(T (* Delete last element of list of more than 1 element.)
(EDITCOMS (QUOTE (0 (NTH -2)
(2]
(ERROR!))
(RETURN L])
(EDITDEFAULT
[LAMBDA (EDITX) (* rmk: " 6-JUN-82 15:13")
(DECLARE (GLOBALVARS LPARKEY))
(PROG (EDITY EDITZ LISPXHIST) (* LISPXHIST is rebound so that messages associated with
spelling corrections will not appear on history list.)
(COND
[(AND (LISTP EDITX)
(SETQ EDITY (FASSOC (CAR EDITX)
EDITOPS)))
(RETURN (EDITRAN EDITX (CDR EDITY]
[LCFLG (RETURN (COND
((EQ LCFLG T)
(EDITQF EDITX))
(T (* E.g. LCFLG= ← in BELOW command.)
(EDITCOM (LIST LCFLG EDITX)
TYPEIN]
[(NLISTP EDITX)
(COND
((AND EDITHISTORY TYPEIN (FMEMB EDITX HISTORYCOMS))
(RETURN (EDITH EDITX)))
((AND EDITUSERFN (SETQ EDITY (EDITUSERFN EDITX)))
(RETURN (EDITCOM EDITY TYPEIN)))
((AND (NOT (U-CASEP EDITX))
(FMEMB (SETQ EDITY (U-CASE EDITX))
EDITCOMSA))
(SETQ EDITX EDITY)
(GO BACKUP))
((OR (FMEMB EDITX EDITCOMSL)
(AND EDITY (FMEMB EDITY EDITCOMSL)
(SETQ EDITX EDITY)))
(COND
((AND [NULL (CDR (SETQ EDITX (COND
(TYPEIN (READLINE EDITRDTBL (LIST EDITX)))
((EQ EDITX (CAR COMS))
(EDITSMASH COMS (CONS (CAR COMS)
(CDR COMS)))
(CAR COMS]
(NEQ (CAR EDITX)
(QUOTE :)))
(* : by itself means DELETE if nothing else follows it. : is not an atomic command so that : -- will work as a line
command.)
(ERROR!)))
(AND TYPEIN (EDITSAVE1 EDITX T)))
((AND TYPEIN (NULL REREADFLG)
(EQ LPARKEY (NTHCHAR EDITX 1)))
[EDITDEFAULT1 (SETQ EDITY (RPLSTRING EDITX 1 (QUOTE "("]
(GNC EDITY)
[SETQ EDITX (READLINE EDITRDTBL (LIST (MKATOM EDITY]
(AND EDITHIST (FRPLACA (CAAAR EDITHISTORY)
EDITX)))
((AND TYPEIN (NULL REREADFLG)
(FNTYP EDITX)
(COND
([NULL (AND (CDR (SETQ EDITY (READLINE EDITRDTBL (LIST EDITX)
T)))
(NULL (CDDR EDITY))
(OR (NULL (CADR EDITY))
(LISTP (CADR EDITY)))
(NOT (FMEMB (CAADR EDITY)
EDITCOMSL]
(SETQ READBUF (APPEND (CDR EDITY)
(CONS HISTSTR0 READBUF)))
(* put it back.)
NIL)
(T T)))
(EDITDEFAULT1 (QUOTE E)
EDITX)
(AND EDITHIST (FRPLACA (CAAR EDITHISTORY)
(SETQ EDITX EDITY)))
(EDITH (QUOTE !E))
(RETURN))
([AND DWIMFLG (OR TYPEIN (EQ EDITX (CAR COMS)))
(SETQ EDITY
(COND
((AND (EQ (NTHCHARCODE EDITX -1)
(CHARCODE P))
(GLC (SETQ EDITY (MKSTRING EDITX)))
(SELECTQ (SETQ EDITY (MKATOM EDITY))
((↑ ← UP NX BK !NX UNDO REDO CL DW)
T)
(NUMBERP EDITY)))
(* The GLC removes the last character.)
(EDITDEFAULT1 EDITY (QUOTE P))
(CONS EDITY (QUOTE P)))
(T (FIXSPELL EDITX 70 EDITCOMSA (NULL TYPEIN)
T]
[COND
((LISTP EDITY)
[COND
[TYPEIN (SETQ READBUF (CONS (CDR EDITY)
(CONS HISTSTR0 READBUF]
(T (EDITSMASH COMS (CAR EDITY)
(CONS (CDR EDITY)
(CDR COMS]
(SETQ EDITY (CAR EDITY)))
((NULL TYPEIN)
(EDITSMASH COMS EDITY (CDR COMS]
(SETQ EDITX EDITY)
(GO BACKUP))
([AND [CDR (SETQ EDITY (COND
(TYPEIN (READLINE EDITRDTBL (LIST EDITX)))
((EQ EDITX (CAR COMS))
COMS]
(COND
((NEQ (CAR EDITY)
EDITX) (* In the call to READLINE above, the user typed
control-U and changed the command himself.)
T)
((AND DWIMFLG (SETQ EDITZ (FIXSPELL EDITX 70 EDITCOMSL (NULL TYPEIN)
T)))
(* E.g. user types MBBD -- without parentheses.)
(COND
[(LISTP EDITZ)
(EDITSMASH EDITY (CAR EDITZ)
(CONS (CDR EDITZ)
(CDR EDITY]
(T (EDITSMASH EDITY EDITZ (CDR EDITY]
(AND (NULL TYPEIN)
(EDITSMASH COMS (CONS (CAR COMS)
(CDR COMS)))
(SETQ EDITY (CAR COMS)))
(SETQ EDITX EDITY)
(EDITSAVE1 EDITX T))
(T (EDITSAVE1 EDITY T)
(ERROR!]
((AND EDITHISTORY (FMEMB (CAR EDITX)
HISTORYCOMS))
(RETURN (EDITH EDITX)))
((AND EDITUSERFN (SETQ EDITY (EDITUSERFN EDITX)))
(RETURN (EDITCOM EDITY TYPEIN)))
((NLISTP EDITX)
(ERROR!))
((AND (EQ (CAR EDITX)
(QUOTE !))
(NULL (CDR EDITX)))
(EDITDEFAULT1 (QUOTE (1)))
(FRPLACA EDITX 1))
((AND (EQ (CAR EDITX)
(QUOTE #))
(NULL (CDR EDITX)))
(EDITDEFAULT1 (QUOTE (3)))
(FRPLACA EDITX 3))
[(AND DWIMFLG (ATOM (CAR EDITX))
(SETQ EDITY (FIXSPELL (CAR EDITX)
70 EDITCOMSL (NULL TYPEIN)
T)))
(COND
[(LISTP EDITY)
(EDITSMASH EDITX (CAR EDITY)
(CONS (CDR EDITY)
(CDR EDITX]
(T (EDITSMASH EDITX EDITY (CDR EDITX]
(T (ERROR!)))
[RETURN (COND
((EQ REREADFLG (QUOTE ABORT))
NIL)
(T (EDITCOM (SETQ COM EDITX)
TYPEIN]
BACKUP
(SETQ COM EDITX)
(COND
((AND EDITHIST TYPEIN (NULL REREADFLG))
(FRPLACA EDITHISTORY (CDAR EDITHISTORY))
(FRPLACA (CDR EDITHISTORY)
(SUB1 (CADR EDITHISTORY)))
(EDITSAVE COM)
(* Can't just smash com onto front of history because now that it has been corrected, EDITSAVE may not actually save
it, e.g. suppose COM is a misspelled P.)
))
(RETURN (EDITCOM COM TYPEIN])
(EDITDEFAULT1
[LAMBDA (X Y)
(PRIN1 (QUOTE =)
T)
(COND
((STRINGP X)
(PRIN1 X T))
(T (PRIN2 X T T)))
(COND
(Y (SPACES 1 T)
(PRIN2 Y T T)))
(TERPRI T)
(LISPXWATCH SPELLSTATS1])
(EDITFNS
[NLAMBDA X (* DD: " 7-Oct-81 20:56")
(* FNS is a list (or name of a list) of functions to be edited; (CDR X) are the operations to be performed.)
(SETQ X (MKLIST X))
|
(MAPC [COND
((LISTP (CAR X))
(STKEVAL (QUOTE EDITFNS)
(CAR X)
NIL
(QUOTE INTERNAL)))
(T (* If (CAR X) is name of a file, do editfns on its
functions.)
(OR (LISTP (EVALV (CAR X)
(QUOTE EDITFNS)))
(AND (GETPROP (OR (AND DWIMFLG (MISSPELLED? (CAR X)
70 FILELST NIL X))
(CAR X))
(QUOTE FILE))
(FILEFNSLST (CAR X)))
(STKEVAL (QUOTE EDITFNS)
(CAR X)
(QUOTE INTERNAL]
(FUNCTION (LAMBDA (Y)
(ERSETQ (APPLY (QUOTE EDITF)
(CONS (PROG1 (PRIN2 Y T T)
(SPACES 1 T))
(CDR X])
(EDITH
[LAMBDA (C) (* wt: 5-APR-77 17 56)
(PROG (X COMS LINE TEM)
[SELECTQ C
((DO !E !F !N)
(* USE is used when operator was incorrect, wheras DO is used when operator was
omitted.)
[SETQ X (SELECTQ C
(!E
(* !E is equivalent to DO E, !F to DO F, and !N to DO N.)
(QUOTE E))
(!F (QUOTE F))
(!N (QUOTE N))
(COND
((NULL (SETQ LINE (READLINE EDITRDTBL)))
(ERROR!))
(T (CAR LINE]
(SETQ COMS (LISPXFIND EDITHISTORY NIL (QUOTE INPUT)))
(* If COMS is a LINE command, e.g. FIE FUM, DO COMS is the same as (COMS FIE FUM) If COMS is a list command, e.g.
(FIE FUM), same as (COMS (FIE FUM)))
[COND
((SETQ TEM (FMEMB HISTSTR0 COMS))
(COND
((CDR TEM)
(SETQ COM C)
(ERROR!))
(T (* removes the last "<c.r.")
(SETQ COMS (LDIFF COMS TEM]
[SETQ COMS (COND
((OR (EQ X (QUOTE E))
(EQ X (QUOTE F)))
(* Always a LINE command)
(CONS X COMS))
((CDR COMS)
(* Was a LINE command.)
(LIST (CONS X COMS)))
(T (* Was a list command.)
(LIST (LIST X (CAR COMS]
(HISTORYSAVE EDITHISTORY (QUOTE *)
NIL NIL COMS (LIST (QUOTE *HISTORY*)
(CONS C LINE)))
(SETQ READBUF COMS)
(LISPXWATCH P.A.STATS))
(UNDO (NCONC (CAAAR EDITHISTORY)
(SETQ LINE (READLINE EDITRDTBL)))
(SETQ COM NIL)
(SETQ X NIL)
[MAPC (LISPXFIND EDITHISTORY LINE (QUOTE ENTRIES)
T)
(FUNCTION (LAMBDA (Y)
(AND (LISTP (SETQ Y (CADDR Y)))
(SETQ X T)
(UNDOEDITCOM Y T]
(COND
((NULL X)
(PRIN1 (QUOTE "nothing saved.
")
T)))
(LISPXWATCH P.A.STATS)
(RETURN))
(BUFS (LISPX C)
(* Restores input buffers. Transparent to history.)
(RETURN NIL))
(RESETLST (RESETSAVE (SETREADTABLE EDITRDTBL T)
(LIST (QUOTE SETREADTABLE)
(GETREADTABLE T)
T))
(* so reading and printing will be done with editreadtable.)
(RESETVARS ((LISPXHISTORY EDITHISTORY))
(SETQ COM NIL)
(RETURN (LISPX C (QUOTE *]
(* LISPX will set up READBUF. At this point we know C is on the list HISTORYCOMS, so it might be USE, REDO, FIX,
etc. Using LISPX this way means new history commands for LISPX can also be used in the editor simply by adding them
to the list HISTORYCOMS.)
(AND READBUF (SETQ EDITHIST (CDDAAR EDITHISTORY)))
(* For saving undo information for this command
(s) back in EDITL1.)
(PROG (EDITHIST)
LP (COND
((NULL (SETQ READBUF (LISPXREADBUF READBUF)))
(* e.g. a REDO N TIMES which just/is about to run out)
(RETURN)))
(SETQ COM (LISPXREAD T EDITRDTBL))
(AND EDITHISTORY (EDITSAVE COM))
(EDITCOM COM T)
(GO LP])
(EDITRAN
[LAMBDA (C DEF)
(SETQ L (OR [PROG ((L L)
(L0 L)
WORDS C1 TEM)
(COND
([AND (NULL DEF)
(NULL (SETQ DEF (CDR (FASSOC (CAR C)
EDITOPS]
(ERROR!))
((NULL (SETQ WORDS (CAR DEF)))
(GO OUT)))
(COND
([SETQ C1 (SOME C (FUNCTION (LAMBDA (X)
(FMEMB X WORDS]
(GO OUT))
([SETQ C1 (SOME C (FUNCTION (LAMBDA (X Y)
(SETQ TEM (FIXSPELL X 70 WORDS (NULL TYPEIN)
Y]
(EDITSMASH C1 TEM (CDR C1))
(GO OUT))
(T (ERROR!)))
OUT [SETQ TEM (BLKAPPLY (CAR (SETQ DEF (CADR DEF)))
(PROG ((#1 (CDR (LDIFF C C1)))
(#2 (CAR C1))
(#3 (CDR C1)))
(RETURN (MAPCAR (CDR DEF)
(FUNCTION (LAMBDA (X)
(COND
((ATOM X)
(* So you don't have to QUOTE atoms.)
(SELECTQ X
(#1 #1)
(#2 #2)
(#3 #3)
X))
(T (EVAL X]
(RETURN (COND
([AND TEM (CDR L0)
(NOT (MEMB (CAR L0)
(CADR L0)))
(NOT (TAILP (CAR L0)
(CADR L0]
TEM)
(T L0]
L])
(EDITTO
[LAMBDA (LC1 LC2 FLG) (* lmm "11-JUL-83 01:35")
(* Locates LC1 does an UP, and then attempts to do a BI at that level, i.e. LC2 specifies an element in the NTH or
BI sense -
that expression at this level containing C3.)
(SETQ L (PROG ((L L))
(COND
(LC1 (EDLOC LC1)
(EDUP)))
(SETQ COM LC2)
(PROG (COM)
(EDIT.BI 1 (COND
((AND (NUMBERP LC1)
(NUMBERP LC2)
(IGREATERP LC2 LC1))
(IPLUS LC2 (IMINUS LC1)
1))
(T LC2))
(CAR L)))
[COND
((AND (EQ FLG (QUOTE TO))
(CDAAR L)) (* Does not include endpoint.)
(EDIT.RI 1 -2 (CAR L]
(EDITCOM 1)
(* In case segment to be deleted is at beginning of list, this ensures that it is the segment that is deleted, not
the list.)
(RETURN L)))
(SETQ TOFLG T])
(EDITXTR
[LAMBDA (LC X) (* DD: " 7-Oct-81 21:07")
(PROG (TOFLG)
(COND
((AND (LISTP LC)
|
(NEQ (CAR LC)
(QUOTE HERE)))
(EDLOC LC T)))
[PROG ([L (LIST (COND
((TAILP (CAR L)
(CADR L)) (* Effectively does a 1)
(CAAR L))
(T (CAR L]
UNFIND)
(EDLOC X T)
(SETQ X (COND
((TAILP (CAR L)
(CADR L))
(CAAR L))
(T (CAR L]
(EDUP)
[EDIT2F 1 (COND
(TOFLG (* APPEND X for undoing.)
(APPEND X))
(T (LIST X]
[AND (NULL TOFLG)
(LISTP (CAAR L))
(SETQ L (CONS (CAAR L)
(COND
((TAILP (CAR L)
(CADR L)) (* To remove the extra (annoying) tail caused by the
UP.)
(CDR L))
(T L]
(RETURN L])
(EDLOC
[LAMBDA (EDX FLG)
(PROG ((OLDL L)
(OLDF UNFIND)
(LCFLG T)
EDL FINDFLAG COMS)
(COND
((NLISTP EDX)
(EDITCOM EDX))
((AND (NULL (CDR EDX))
(NLISTP (CAR EDX)))
(EDITCOM (CAR EDX)))
(T (GO LP)))
(SETQ UNFIND OLDL)
(RETURN (CAR L))
LP (SETQ EDL L)
[COND
((NLSETQ (EDITCOMS EDX))
(SETQ UNFIND OLDL)
(RETURN (CAR L]
(COND
((OR FLG (EQUAL EDL L))
(* If command of form (LC FOO (IF --)) this will check whether failure was because there were no more FOO'S or
because of the IF clause. In the latter case, the search continues.)
(* FLG is T on calls from EDIT:, EDITXTR, EDITMBD, and EDITMV. In this case, the search does not continue, e.g. if
user says (MOVE COND 3 TO AFTER --) and the next COND does not have a third clause, the MOVE fails.
Of course, the user can always type (MOVE (LC COND 3) TO AFTER --) if he intends to search for a COND containing
three elements.)
(SETQ L OLDL)
(SETQ UNFIND OLDF)
(ERROR!)))
(GO LP])
(EDLOCL
[LAMBDA (COMS)
(CAR (SETQ L (NCONC (PROG [(L (LIST (CAR L]
(EDLOC COMS T)
(RETURN L))
(CDR L])
(EDOR
[LAMBDA (COMS) (* lmm "22-NOV-82 00:09")
(PROG NIL
LP [COND
((NULL COMS)
(ERROR!))
([ERSETQ (SETQ L (PROG ((L L))
(EDITCOMS (CAR COMS))
(RETURN L]
(RETURN (CAR L]
(SETQ COMS (CDR COMS))
(GO LP])
(EDRPT
[LAMBDA (EDRX QUIET) (* wt: "14-NOV-78 02:03")
(PROG ((EDRL L)
(EDRPTCNT 0)
(COPYFLG T))
LP (COND
((AND MAXLOOP (IGREATERP EDRPTCNT MAXLOOP))
(PRIN1 (QUOTE "maxloop exceeded.
")
T))
((NLSETQ (RESETVARS ((MAXLOOP MAXLOOP))
(EDITCOMS EDRX)))
(SETQ EDRL L)
(SETQ EDRPTCNT (ADD1 EDRPTCNT))
(GO LP))
((NULL QUIET)
(PRIN1 EDRPTCNT T)
(PRIN1 (QUOTE " occurrences.
")
T)))
(SETQ L EDRL) (* L is left as of last successful completion of loop.)
(RETURN])
(EDUP
[LAMBDA NIL (* Always equivalent to a 0 followed by an appropriate NTH.)
(PROG (C-EXP L1 X)
(SETQ C-EXP (CAR L))
(COND
((NULL (SETQ L1 (CDR L)))
(SETQQ COM (ERROR: . "can't - at top.
"))
(ERROR!))
((TAILP C-EXP (CAR L1))
(* Already UP.)
(RETURN))
((AND (EQ C-EXP (CAR LASTAIL))
(TAILP LASTAIL (CAR L1)))
(SETQ X LASTAIL))
([NOT (SETQ X (MEMB C-EXP (CAR L1]
(ERROR!))
((MEMB C-EXP (CDR X))
(PRIN2 C-EXP T T)
(PRIN1 (QUOTE " - location uncertain.
")
T)
(ERROR!)))
[COND
([OR (EQ X (CAR L1))
(AND (EQ (CAAR L1)
CLISPTRANFLG)
(EQ X (CDDAR L1]
(* Since (NTH 1) is now a nop, to insure that 0 always does something, this check is to take care of 1 followed by
UP.)
(SETQ L L1))
(T (SETQ L (CONS X L1]
(RETURN])
(ESUBST
[LAMBDA (NEW OLD EXPR ERRORFLG CHARFLG)
(* wt: "16-FEB-79 13:08")
(* Does a /DSUBST a la R command in editor. Thus gives an error if Y not found in Z, and also allows you to specify
X and Y using alt-modes, or patterns. note that order of arguments is that of SUBST and DSUBST, not R, i.e. Y'S
become X'S.)
(PROG ([L (LIST (SETQ EXPR (LIST EXPR]
ATM COM UNFIND LASTAIL UNDOLST1 EDITCHANGES)
(COND
((NLSETQ (EDIT4F OLD NEW T CHARFLG))
(AND LISPXHIST (UNDOSAVE (LIST (FUNCTION ESUBST1)
UNDOLST1)
LISPXHIST))
(RETURN (CAR EXPR)))
(ERRORFLG (ERROR OLD (QUOTE " ?")
T)))
(ERROR!])
(ESUBST1
[LAMBDA (X) (* Undoes an ESUBST.)
(MAPC X (FUNCTION (LAMBDA (X)
(COND
((LISTP (CAR X))
(/RPLNODE (CAR X)
(CADR X)
(CDDR X)))
((EQ (CAR X)
(QUOTE LISPXHIST))
(* This is the way the editor marks an undo entry involving something other than
a /rplnode, e.g. a /puthash.)
(ESUBST1 (CDR X)))
(T (APPLY (CAR X)
(CDR X])
(EDITF
[NLAMBDA EDITFX (* bvm: "12-NOV-83 22:56")
(AND EDITFX (NLISTP EDITFX)
(SETQ EDITFX (LIST EDITFX)))
(PROG (EDITFN EDITFCOMS EDITFY EDITFTEM)
(SETQ EDITFN (CAR EDITFX))
LP (SETQ EDITFCOMS (CDR EDITFX))
[COND
((LISTP EDITFN)
(SETQ EDITFN (EVAL EDITFN]
(COND
((EXPRP (SETQ EDITFY (GETD EDITFN)))
[COND
[(NULL (SETQ EDITFTEM (GETLIS (GETPROPLIST EDITFN)
(QUOTE (ADVISED BROKEN]
((EXPRP (CADR EDITFTEM))
(* The unavised or unbroken definition is an expr. allow the user to edit it, since his edits will also affect the
original definition, but print a message.)
(EDITFA (CAR EDITFTEM)
(CADR EDITFTEM)))
(T (AND (NULL (GETPROP EDITFN (QUOTE EXPR)))
(EDITFB EDITFN)) (* There is no expr, so try to loa one in.)
(COND
((NULL (GETPROP EDITFN (QUOTE EXPR)))
(EDITFA (CAR EDITFTEM)
(CADR EDITFTEM)))
([OR (EQ (CAR EDITFTEM)
(QUOTE BROKEN))
(OR (NULL DWIMFLG)
(EQ (ASKUSER (QUOTE Y)
DWIMWAIT
(LIST (QUOTE "Do you want")
EDITFN
(QUOTE "to be unadvised")))
(QUOTE Y]
(VIRGINFN EDITFN T)
(GO LP]
(EDITE EDITFY EDITFCOMS EDITFN (QUOTE FNS)))
([EXPRP (SETQ EDITFY (GETPROP EDITFN (QUOTE EXPR]
(PRIN1 (QUOTE "prop ")
(SELECTQ (SYSTEMTYPE)
(D (TTYINFOSTREAM))
T)
T)
(EDITE EDITFY EDITFCOMS EDITFN (QUOTE PROP)))
((EDITFB EDITFN) (* An EXPR has been found and loaded.)
(GO LP))
((GETD EDITFN) (* User really meant to type EDITF, not EDITV or EDITP.)
(GO ERROR))
[(LISTP (GETATOMVAL EDITFN))
(PRINT (QUOTE =EDITV)
T T)
(RETURN (APPLY (QUOTE EDITV)
(CONS EDITFN EDITFCOMS]
[(GETPROPLIST EDITFN)
(PRINT (QUOTE =EDITP)
T T)
(RETURN (APPLY (QUOTE EDITP)
(CONS EDITFN EDITFCOMS]
((AND DWIMFLG (SETQ EDITFY (MISSPELLED? EDITFN 75 USERWORDS))
(NEQ EDITFY EDITFN))
(SETQ EDITFN EDITFY)
(GO LP))
(T (GO ERROR)))
(RETURN EDITFN)
ERROR
(ERROR EDITFN (QUOTE "not editable.")
T])
(EDITFA
[LAMBDA (TYPE DEF) (* wt: " 8-OCT-78 22:24")
|
(PRIN1 (QUOTE "Note: you are editing a")
|
T)
|
(AND (EQ TYPE (QUOTE ADVISED))
|
(PRIN1 (QUOTE n)
|
T))
|
(SPACES 1 T)
|
(PRIN2 TYPE T T)
|
(PRIN1 (COND
|
((EXPRP DEF)
|
(QUOTE " definition."))
|
((SUBRP DEF)
|
(QUOTE " subr!"))
|
(T (QUOTE " compiled function!")))
|
T)
|
(TERPRI T])
(EDITFB
[LAMBDA (FN) (* wt: " 4-JUL-79 16:20")
(PROG (FL TEM)
[OR [SETQ FL (EDITLOADFNS? FN (AND (NULL (CAR EDITLOADFNSFLG))
(QUOTE "not editable, shall I load it from"))
(NULL (CAR EDITLOADFNSFLG]
(AND (EQ (NARGS (QUOTE WHEREIS))
4)
(COND
((SETQ FL (EDITLOADFNS? FN (QUOTE "not editable, shall I LOADFROM")
T T))
(LOADFROM FL))
(T
(* i.e. user can be asked whether to loadfrom the file, if not mentioned before, but ifhe says no, he still has |
option ofhaving just the functio loaded)
(SETQ FL (EDITLOADFNS? FN (AND (NULL (CAR EDITLOADFNSFLG))
(QUOTE "not editable, shall I load it from"))
(NULL (CAR EDITLOADFNSFLG))
T]
[COND
((NULL FL)
(RETURN NIL))
([CDR (SETQ TEM (SUBSET (GETBLOCKDEC FN FL T)
(FUNCTION (LAMBDA (FN)
(NOT (EXPRP (VIRGINFN FN]
(AND [NULL (COND
((OR (NLISTP EDITLOADFNSFLG)
(NULL (CDR EDITLOADFNSFLG)))
(* EDITLOADFNFLG is really a dotted pair of two flags. CAR governs loading of the function, with NIL meaning ask, T
|
dont ask (and do it). CDR governs loading rest of the block, with NIL meaning ask, T dont ask and do it, anything |
else dont ask and dont do it. Note that if EDITLOADFNSFLG is an atom, effect is same as though list of that atom, |
i.e. will ask about blocks)
(EQ (ASKUSER DWIMWAIT (QUOTE Y)
(LIST (QUOTE "load the rest of the functions")
(LIST (SUB1 (LENGTH TEM)))
(QUOTE "in its block"))
NIL T)
(QUOTE Y)))
(T (EQ (CDR EDITLOADFNSFLG)
T]
(SETQ TEM NIL]
(LOADFNS (OR TEM FN)
FL
(QUOTE PROP))
(COND
((GETPROP FN (QUOTE EXPR))
(RETURN T)))
(ERROR FN (QUOTE "not found."])
(EDITLOADFNS?
[LAMBDA (FN STR ASKFLG FILES) (* bvm: "12-NOV-83 22:57")
(* Value is name of file from which function or functions can be loaded. If STR is non-NIL, user is asked to
approve, and STR used in the message. EDITLOADFNS? is also used by prettyprint)
(AND FN FILEPKGFLG (PROG ((LST (WHEREIS FN (QUOTE FNS)
FILES))
ECHOFILE DATES FL1 FL2 TEM FL)
(COND
((EQ FILES T)
(SETQ LST (LDIFFERENCE LST FILELST))
(* if FILES = T, means conult data base. if user has removed a function from one of those files, as evidenced by
the fact that editloafns? was called with files=T, then dont offer that file.)
))
[COND
((CDR LST)
(PRIN2 FN T)
(MAPRINT LST T " is contained on " "
" " and ")
(COND
((SETQ TEM (ASKUSER NIL NIL "indicate which file to use: "
(MAKEKEYLST LST)
T))
(SETQ LST (LIST TEM)))
(T (RETURN]
(SETQ ECHOFILE (SELECTQ (SYSTEMTYPE)
(D (TTYINFOSTREAM))
T))
LP (COND
((NULL LST)
(RETURN))
[[AND (FMEMB (SETQ FL (CAR LST))
FILELST)
(SETQ DATES (LISTP (GETPROP FL (QUOTE FILEDATES]
(SETQ FL1 (INFILEP (CDAR DATES)))
(SETQ FL2 (OR (INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(CDAR DATES)))
(FINDFILE FL T]
((SETQ FL1 (FINDFILE FL T))
(GO LOAD))
(T (GO LP1)))
[COND
((AND (NULL FL1)
(NULL FL2))
(GO LP1))
((NEQ FL1 FL2) (* either the file that was originally noticed not
longer exists, or else there is a newer version
(or both))
(COND
((NULL FL1)
(LISPXPRIN1 "****can't find " ECHOFILE)
(LISPXPRINT (CDAR DATES)
ECHOFILE)
(SETQ FL1 FL2))
((NULL FL2) (* if the file on DATES is there, then certain looking
for thatfile but withou specifying a verson number
should work)
(SHOULDNT))
(T (* both files exist. Fl2 is newer)
(LISPXPRIN1 "****Note: " ECHOFILE)
(LISPXPRIN2 FL1 ECHOFILE)
(LISPXPRIN1 " is not the newest version
" ECHOFILE)
(SETQ FL1 FL2]
LOAD(OR STR (SETQQ STR "loading from "))
(COND
((STREQUAL STR ""))
((NULL ASKFLG)
(LISPXPRIN1 STR ECHOFILE)
(LISPXPRINT FL1 ECHOFILE T))
((NEQ (ASKUSER DWIMWAIT (QUOTE Y)
(LIST FN STR FL1)
NIL T)
(QUOTE Y))
(RETURN NIL)))
(RETURN FL1)
LP1 (SETQ LST (CDR LST))
(GO LP])
(EDITE
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* bvm: "12-NOV-83 22:56")
(* Used by both EDITF and EDITV. Calls EDITL in such a way that if a change occurs, and EDITL is exited via OK,
STOP, or even conrol-D, the appropriate call to NEWFILE? is executed. Since it checks to see if a change has been
made, it also does the UNSAVEDEFING for EDITF in he case that we are editing a PROP. Value is the edited
expression or generates an error.)
(RESETLST (PROG ((ECHOFILE (SELECTQ (SYSTEMTYPE)
(D (TTYINFOSTREAM))
T))
EDITCHANGES TEM)
(COND
((NLISTP EXPR)
(ERROR EXPR (QUOTE "not editable.")
T)))
[AND ATM (RESETSAVE NIL (CONS (QUOTE EDITF2)
(SETQ EDITCHANGES (LIST ATM NIL TYPE IFCHANGEDFN
EXPR]
(PREEDITFN ATM TYPE EDITCHANGES) (* extensions to handle editing property lists, vars
etc.)
[ERSETQ (SETQ TEM (COND
((SETQ EXPR (LAST (EDITL (LIST EXPR)
COMS ATM NIL EDITCHANGES)))
(CAR EXPR))
(T (HELP (QUOTE (NULL LIST]
(COND
((CADR EDITCHANGES) (* A change was made.)
(COND
((NULL TEM)
(ERROR!)))
(SELECTQ TYPE
(FNS (/PUTD ATM TEM))
[PROP (COND
((OR (EQ DFNFLG (QUOTE PROP))
(EQ DFNFLG (QUOTE ALLPROP)))
(PRIN1 (QUOTE "changed, but NOT unsaved
")
ECHOFILE T))
(T (UNSAVEDEF ATM)
(PRINT (QUOTE unsaved)
ECHOFILE T)
(/PUTD ATM TEM)
(AND EDITUNSAVEBLOCKFLG (UNSAVEBLOCK? ATM]
(VARS (SAVESET ATM TEM NIL (QUOTE NOSAVE)))
(PROPLST (/SETPROPLIST ATM TEM))
NIL))
((NULL TEM)
(ERROR!))
((EQ TYPE (QUOTE PROP))
(PRIN1 (QUOTE "not changed, so not unsaved
")
ECHOFILE T)))
(COND
((AND TYPE ATM ADDSPELLFLG)
(ADDSPELL ATM (SELECTQ TYPE
((FNS PROP)
NIL)
(VARS T)
(PROPLST 0)
0))
(* TYPE is FNS or PROP for calls from EDITF, VARS for calls from EDITV, and PROPLST for calls fromEDITP.
TYPE CAN ALSO BE A PRETTYTYPE. can also be the name of a CHANGEDLST in the case of a direct call from the user.)
))
(RETURN TEM])
(EDITELT
[LAMBDA (LC L)
(PROG (Y)
(EDLOC LC)
LP (SETQ Y L)
(COND
((CDR (SETQ L (CDR L)))
(GO LP)))
(RETURN (CAR Y])
(UNSAVEBLOCK?
[LAMBDA (FN) (* wt: "27-APR-79 23:40")
(PROG (ENTRIES)
[MAPC FILELST
(FUNCTION (LAMBDA (FILE)
(MAPC (FILECOMSLST FILE (QUOTE BLOCKS))
(FUNCTION (LAMBDA (BLOCK)
(AND (CAR BLOCK)
(FMEMB FN (CDR BLOCK))
(MAPC (OR (CDR (FASSOC (QUOTE ENTRIES)
BLOCK))
(LIST (CAR BLOCK)))
(FUNCTION (LAMBDA (X)
(COND
((AND (NOT (EXPRP (OR (GETPROP X (QUOTE BROKEN))
(GETPROP X (QUOTE ADVISED))
X)))
(NOT (FMEMB X ENTRIES)))
(SETQ ENTRIES (NCONC1 ENTRIES X]
(COND
(ENTRIES (MAPRINT ENTRIES T "unsave/load the definitions of the (other) entries: " " ? "
", ")
(COND
((EQ (QUOTE Y)
(ASKUSER DWIMWAIT (QUOTE N)
|
NIL NIL T))
(MAPC ENTRIES (FUNCTION LOADDEF])
(EDITF1
[LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN) (* wt: " 8-OCT-78 19:39")
|
(PRIN1 "EDITF1 has been replaced by EDITE" T)
|
(EDITE EXPR COMS ATM TYPE IFCHANGEDFN])
(EDITF2
[NLAMBDA (ATM CHANGES TYPE IFCHANGEDFN EXPR) (* wt: " 7-DEC-79 00:38")
(AND CHANGES (PROG ((LISPXHIST (AND (NEQ RESETSTATE (QUOTE RESET))|
LISPXHIST)))|
(SELECTQ TYPE|
((PROP FNS)|
(FIXEDITDATE EXPR))|
NIL)|
(COND|
[IFCHANGEDFN (APPLY* IFCHANGEDFN ATM EXPR TYPE (SELECTQ RESETSTATE|
(NIL T)|
(ERROR NIL)|
(RESET NIL)|
(SHOULDNT]|
(T (SELECTQ TYPE|
((NIL PROPLST)|
NIL)|
(PROP (MARKASCHANGED ATM (QUOTE FNS)))|
(MARKASCHANGED ATM TYPE])
(EDITV
[NLAMBDA EDITVX (* wt: "20-OCT-78 20:14")
|
(AND EDITVX (NLISTP EDITVX)
|
(SETQ EDITVX (LIST EDITVX)))
|
(PROG ((EDITVAR (CAR EDITVX))
|
EDITVY EDITCHANGESFLG SPELLFLG)
|
(COND
|
((NOT (ATOM EDITVAR))
|
(EDITE (EVAL EDITVAR (QUOTE INTERNAL))
|
(CDR EDITVX))
|
(RETURN T)))
|
TOP (COND
|
([AND DWIMFLG (OR (NULL EDITVAR)
|
(NOT (BOUNDP EDITVAR]
|
(COND
|
[(GETD EDITVAR)
|
(PRINT (QUOTE =EDITF)
|
T T)
|
(RETURN (APPLY (QUOTE EDITF)
|
(CONS EDITVAR (CDR EDITVX]
|
([AND (NULL SPELLFLG)
|
(SETQ EDITVY (OR (MISSPELLED? EDITVAR 75 SPELLINGS3)
|
(MISSPELLED? EDITVAR 75 USERWORDS]
|
(SETQ SPELLFLG T) (* so wont keep trying over and over in case spelling
|
corrects to somethng which still is not editable.)
|
(SETQ EDITVAR EDITVY)
|
(GO TOP))) (* The functional argument allows user to say EDITV
|
(EDITM) meaning EDITMACROS, even though there is a
|
function called EDITMAC.)
|
))
|
(EDITE [RESETVARS (DWIMFLG)
|
(RETURN (EVAL EDITVAR (QUOTE INTERNAL]
|
(CDR EDITVX)
|
EDITVAR
|
(QUOTE VARS))
|
(RETURN EDITVAR])
(EDITP
[NLAMBDA EDITPX (* wt: " 5-DEC-78 01:05")
|
(AND EDITPX (NLISTP EDITPX)
|
(SETQ EDITPX (LIST EDITPX)))
|
(PROG (ATM)
|
[COND
|
([NOT (ATOM (SETQ ATM (CAR EDITPX]
|
(RETURN NIL))
|
((AND DWIMFLG (NLISTP (GETPROPLIST ATM)))
|
(SETQ ATM (OR (MISSPELLED? ATM 75 USERWORDS)
|
ATM]
|
(EDITE (GETPROPLIST ATM)
|
(CDR EDITPX)
|
ATM
|
(QUOTE PROPLST))
|
|
(* EDITP implemented via call to EDITF1 even though it does not currently make use of whether or not a change has
|
been made to update file package because some users may want to efffect such an operation by advising EDITE in
|
EDITFBLOCK)
|
|
|
(RETURN ATM])
(EDITL
[LAMBDA (L COMS ATM MESS EDITCHANGES)
(* DD: "20-Oct-81 14:02")
(* Takes edit push-down list L as argument.
Returns L as value.)
(COND
((NLISTP L)
L)
(T (PROG (LASTAIL MARKLST UNDOLST UNDOLST0 UNDOLST1 UNFIND LASTP1 LASTP2 TEM1 TEM2 EDITHIST0
EDITIME0 EDITLISPFLG)
(* EDITCHANGES is a cell used for destructivelymarking whether the edit has
caused any changes.)
(COND
((EQ (CAR (LISTP COMS))
(QUOTE START))
(SETQ READBUF (CDR COMS))
(SETQ COMS NIL)))
[COND
((AND ATM (NULL COMS)
EDITHISTORY)
(SETQ EDITHIST0 T)
(LISPXWATCH EDITCALLS)
(SETQ EDITIME0 (CLOCK 0]
(SETQ TEM2 (CAR (LAST L)))
(* TEM2 is the top level xpression. NOte that L is usually a list of only one element, i.e. you usually start
editing atthe top, but not necessarily, since editl can be called dirctly.)
[COND
([OR [EQ TEM2 (CAR (LAST (CAR (SETQ TEM1 (GETPROP (QUOTE EDIT)
(QUOTE LASTVALUE]
[AND ATM (EQ TEM2 (CAR (LAST (CAR (SETQ TEM1 (GETPROP ATM (QUOTE EDIT-SAVE]
(SOME (CAR LISPXHISTORY)
(FUNCTION (LAMBDA (X)
(EQ TEM2 (CAR (LAST (CAR (SETQ TEM1 (CADR (FMEMB (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.)
(AND (NULL (CDR L))
(SETQ L (CAR TEM1)))
(* if editor was called with an edit chain specified, rather just list of the
xpression, use this chain.)
(SETQ MARKLST (CADR TEM1))
(SETQ UNDOLST (CADDR TEM1))
[COND
((CAR UNDOLST)
(* Don't want to block it twice.)
(SETQ UNDOLST (CONS NIL UNDOLST]
(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 TEM1]
(COND
([PROG1 (NLSETQ (SETQ L (EDITL0 L COMS MESS T)))
[COND
(UNDOLST1 (SETQ UNDOLST (CONS (CONS T (CONS L UNDOLST1))
UNDOLST]
(COND
((NEQ UNDOLST UNDOLST0)
(AND LISPXHIST (UNDOSAVE (LIST (QUOTE UNDOEDITL)
L UNDOLST UNDOLST0)
LISPXHIST))
(* Takes care of making the entire call to EDITL undoable.)
))
(COND
(EDITIME0 (SETATOMVAL (QUOTE EDITIME)
(IPLUS EDITIME (IDIFFERENCE (CLOCK 0)
EDITIME0]
(* If one of COMS causes an error, or if call to session is terminated by a STOP, still want to move undo
information to LISPXHISTORY.)
(RETURN L))
(T (ERROR!])
(EDITL0
[LAMBDA (L COMS MESS EDITLFLG) (* wt: 29-APR-77 2 6)
(* EDITL0 should only be called while under an EDITL since the global states of the edit, e.g. UNFIND, LASTP1,
UNDOLST, etc. are all bound in EDITL. Note that individual calls to EDITL0 are not undoable, i.e. any changes that
are made are stored on UNDOLST or UNDOLST1, not on LISPXHISTORY. Only for calls to EDITL are the changes transfered
to LISPXHISTORY. Note also that when COMS are specified, all structure changes are saved on UNDOLST1.
When the editor is used on-line, structure changes for each command are saved on UNDOLST1 and at the end of each
command, gathered up and stored on UNDOLST.)
(COND
((NULL EDITLFLG) (* EDITL0 is being called from outside the block, look up these variables to
avoid traps.)
(EVQ LASTAIL)
(EVQ MARKLST)
(EVQ UNDOLST)
(EVQ UNDOLST1)
(EVQ UNFIND)
(EVQ LASTP1)
(EVQ LASTP2)
(EVQ ATM)
(EVQ EDITCHANGES)
(EVQ EDITHIST0)))
(PROG (FINDFLAG LCFLG TOFLG EDITHIST L0 COM0 COM COPYFLG ORIGFLG (LISPXID (QUOTE *)))
(COND
(COMS (SETQ COPYFLG T)
(EDITCOMS COMS)
(RETURN L)))
(AND (NEQ (POSITION T)
0)
(TERPRI T))
(PRINT (OR MESS (QUOTE edit))
T T)
LP (EDITL1) (* Only way to exit is via EDITEXIT which does a RETFROM.)
(SETQ LISPXBUFS (OR (CLBUFS T)
LISPXBUFS))
(* User control-e'd out of read, CLEARBUF has already been done.)
(GO LP])
(EDITL1
[LAMBDA (UNDOLST1 EDITHIST) (* DD: " 7-Oct-81 21:39")
(ERSETQ (RESETVARS ((USERHANDLE (QUOTE EDITL1)))
(* USERHANDLE mars the last place the user typed somthing to start "computaton" started, so that if somebody wants
to save state and RETTO to continue computing until some condition resumes the saved state, this is the place.
(If the edidtor were written to call userexec and let lispx pass the edit commands to a lispxuserfn, then this
wouldnt be necessary. editl1 plays the role of to editl0 that lispx plays to evalqt) Thus UNDOLST1 and EDITHIST
which are the only variabes associated with each event, need to be rebound below EDITL!. They are rebound as
arguments, even though they aret used that way, rather than puting them in as prog variabes to save making an extra
frame.)
CT (SETQ FINDFLAG NIL)
A (SETQ EDITHIST NIL)
(SETQ UNDOLST1 NIL)
(* Holds any changes from execution of this command.)
(PROMPTCHAR (QUOTE *)
NIL EDITHISTORY)
(SETQ COM (LISPXREAD T EDITRDTBL))
(SETQ L0 L)
(* Marks L as of beginning of this command.
Used by UNDO.)
[SETQ COM0 (COND
((NLISTP COM)
COM)
(T (CAR COM]
(* Saves command name. Needed for storing on UNDOLST below.)
(* Saves current L and command name for UNDOLST. Command name may be changed during execution to enable better error
diagnostics, e.g. on any find commands inside of a complicated operation.)
(AND EDITHISTORY (EDITSAVE COM))
(COND
([PROG1 (XNLSETQ (EDITCOM COM T)
T STOP)
[COND
(UNDOLST1 (SETQ UNDOLST1 (CONS COM0 (CONS L0 UNDOLST1)))
(SETQ UNDOLST (CONS UNDOLST1 UNDOLST]
(COND
(EDITHIST
(* Set in EDITSAVE.)
(FRPLACA EDITHIST UNDOLST1)
(COND
(EDITHIST0 (LISPXPUT (QUOTE *FIRSTPRINT*)
(LIST (QUOTE EDITL2)
ATM T)
NIL EDITHIST)
(SETQ EDITHIST0 NIL]
(GO A)))
(TERPRI T)
(SETQ LISPXBUFS (OR (CLBUFS)
LISPXBUFS))
[COND
(COM (* If COM is NIL, message has already been printed.)
(COND
((EQ (CAR (LISTP COM))
(QUOTE ERROR:))
(PRIN1 (CDR COM)
T))
(T (PRIN2 COM T T)
(PRIN1 (QUOTE " ?
")
T)))
(AND EDITHIST (LISPXPUT (QUOTE *ERROR*)
COM NIL EDITHIST]
(GO CT])
(EDITL2
[LAMBDA (FILE ATM FLG) (* wt: 14-MAY-76 19 1)
(* used for printing edit histry list)
(LISPXPRIN1 (COND
(FLG "{started ")
(T "{finished "))
FILE)
(LISPXPRIN2 ATM FILE)
(LISPXPRIN1 "}
" FILE])
(UNDOEDITL
[LAMBDA (L ULST ULST0)
(PROG (UNDOLST1 COM EDITCHANGES)
[MAP ULST [FUNCTION (LAMBDA (X)
(AND (CAR X)
(UNDOEDITCOM (CAR X]
(FUNCTION (LAMBDA (X)
(COND
((NEQ (SETQ X (CDR X))
ULST0)
X]
(COND
((NULL UNDOLST1)
(PRINT (QUOTE (UNDOEDITL - SHOW WT))
T T)))
(EDITSMASH ULST (CAR ULST0)
(CDR ULST0))
(AND LISPXHIST (UNDOSAVE [LIST (QUOTE UNDOEDITL)
L
(LIST (CONS T (CONS L UNDOLST1]
LISPXHIST])
(EDITCOM
[LAMBDA (C TYPEIN) (* wt: "25-APR-78 11:54")
(SETQ COM C) (* In case there is an error, user will see what command was being executed.)
(SELECTQ EDITRACEFN
(NIL)
((TRACE BREAK)
(PRIN1 (QUOTE "COM = ")
T)
(BPNT0 C T 1 10)
(PRIN1 (QUOTE "C-EXP = ")
T)
(BPNT0 (CAR L)
T 1 10 (CADR L))
[COND
((EQ EDITRACEFN (QUOTE BREAK))
(APPLY (QUOTE BREAK1)
(LIST NIL T C]
(TERPRI T))
(EDITRACEFN C))
(COND
[FINDFLAG (COND
((EQ FINDFLAG (QUOTE BF))
(SETQ FINDFLAG NIL)
(EDITBF C))
(T (SETQ FINDFLAG NIL)
(EDITQF C]
((NUMBERP C)
(SETQ L (EDIT1F C L)))
((ATOM C)
(EDITCOMA C (NULL TYPEIN)))
((LISTP C)
(EDITCOML C (NULL TYPEIN)))
(T (EDITDEFAULT C)))
(CAR L])
(EDITCOMA
[LAMBDA (C COPYFLG) (* rmk: " 3-NOV-81 21:41")
(PROG (TEM TEM1) (* Interprets atomic commands.)
(RETURN (COND
[[AND (NULL ORIGFLG)
(OR (SETQ TEM (CDR (EDITMAC C USERMACROS)))
(SETQ TEM (CDR (EDITMAC C EDITMACROS]
(PROG ((COPYFLG T))
(RETURN (EDITCOMS TEM]
(T (SELECTQ C
(NIL
(* Nop.)
NIL)
((OK STOP SAVE)
[COND
(UNDOLST1 (SETQ UNDOLST (CONS (SETQ UNDOLST1
(CONS COM0 (CONS L0 UNDOLST1)))
UNDOLST))
(COND
(EDITHIST (FRPLACA EDITHIST UNDOLST1]
[COND
((AND EDITCHANGES (CADR EDITCHANGES)
(OR (NULL EDITLFLG)
(EQ EDITLFLG T)))
(* a call to the editor completed, and exprssion was marked as being changed. check to make sure that it isnt the
case thatall the changes were undone, and if so, mark it not changed.)
(PROG ((LST UNDOLST))
(* looks on undolst and sees if there really were any changes made this time,
e.g. they might have been undon)
LP (COND
((OR (NULL LST)
(NULL (CAR LST)))
(FRPLACA (CDR EDITCHANGES)
NIL))
((SELECTQ (CAAR LST)
((UNDO !UNDO NIL)
T)
NIL)
(SETQ LST (CDR LST))
(GO LP]
(SELECTQ C
(OK [COND
((OR (NULL EDITLFLG)
(EQ EDITLFLG T))
(AND ATM (REMPROP ATM (QUOTE EDIT-SAVE)))
[PUTPROP (QUOTE EDIT)
(QUOTE LASTVALUE)
(SETQ TEM (CONS (LAST L)
(CONS MARKLST
(CONS UNDOLST L]
[COND
(LISPXHIST (NCONC LISPXHIST (LIST (QUOTE EDIT)
TEM]
(COND
((AND EDITHIST ATM)
(LISPXPUT (QUOTE *PRINT*)
(LIST (QUOTE EDITL2)
ATM)
NIL EDITHIST]
(RETFROM (QUOTE EDITL0)
L T))
(STOP
(* Aborts edit session. However all changes will have been saved for undoing on
UNDOLST and/or UNDOLST1.)
(RETEVAL (QUOTE EDITL0)
(QUOTE (ERROR!))
T))
(SAVE
(* Exit and save.)
[COND
((NEQ EDITLFLG T)
(ERROR (QUOTE "not legal under tty:")
(QUOTE "")
T))
(ATM (PUTPROP (QUOTE EDIT)
(QUOTE LASTVALUE)
(PUTPROP ATM (QUOTE EDIT-SAVE)
(CONS L
(CONS MARKLST
(CONS UNDOLST
UNFIND]
(RETFROM (QUOTE EDITL0)
L T))
(SHOULDNT)))
[TTY: (SETQ COM COM0)
(* So that COM0 will be printed if TTY: is aborted via stop.)
(COND
((SETQ TEM1 (PROG (UNDOLST1 UNDOLST)
(* UNDOLST1 must be protected since there may have been some changes executed in
this command before the TTY: was reached.)
[SETQ TEM (NLSETQ (EDITL0 L NIL
(QUOTE tty:)
(QUOTE tty:]
(RETURN UNDOLST)
(* UNDOLST1 will be NIL because TTY: can only be exited by typing in a STOP or
OK.)
))
(SETQ UNDOLST1 (CONS (CONS (QUOTE GROUPED)
TEM1)
UNDOLST1))
(* Note that once the TTY: command has completed operation, all of the changes executed under it are grouped
together as being changes of the TTY: command.)
))
(COND
(TEM (SETQ L (CAR TEM)))
([EVALV (QUOTE COMS)
(SETQ TEM (STKPOS (QUOTE EDITL0]
(* If COMS is not NIL, the editor is being used as subroutine, e.g. (BREAKIN -- (AFTER TTY:)). In this case, want to
abort the entire call to EDITL0.)
(RETEVAL TEM (QUOTE (ERROR!))
T))
(T
(* Otherwise, just abort this command, e.g.
(MOVE TTY TO HERE))
(RELSTK TEM)
(PROG (TEM2)
LP (SETQ TEM1 (STKPOS (QUOTE ERRORSET)
-1 TEM2))
(RELSTK TEM2)
(SETQ TEM2 TEM1)
(* This can be eliminated when STKPOS takes the extra optional argument.)
(COND
((NULL TEM2)
(HELP))
((NEQ (STKARG 3 TEM2)
(QUOTE STOP))
(SETQ TEM2 (STKNTH -1 TEM2 TEM2))
(GO LP)))
(RETFROM TEM2 NIL T]
[E (COND
(TYPEIN (LISPXWATCH EDITESTATS)
(SETQ EDITLISPFLG T)
(LISPX (LISPXREAD T T)
(QUOTE *)
NIL NIL T))
(LCFLG (EDITQF C))
(T (ERROR!]
(P (COND
((NEQ LASTP1 L)
(SETQ LASTP2 LASTP1)
(SETQ LASTP1 L)))
(BPNT0 (CAR L)
T 1 20 (CADR L)))
(? (COND
((NEQ LASTP1 L)
(SETQ LASTP2 LASTP1)
(SETQ LASTP1 L)))
(BPNT0 (CAR L)
T 100 100 (CADR L)))
[(PP PPV)
(COND
((NEQ LASTP1 L)
(SETQ LASTP2 LASTP1)
(SETQ LASTP1 L)))
(RESETLST (RESETSAVE (OUTPUT T))
(RESETSAVE (SETREADTABLE T))
(RESETVARS ((PRETTYFLG T))
(PRINTDEF (CAR L)
NIL
(NEQ C (QUOTE PPV)))
(TERPRI]
(↑ (AND (CDR L)
(SETQ UNFIND L))
(SETQ L (FLAST L)))
[!0
(* Continues to do 0's until TAILP is false, i.e. takes you back to next highest left parentheses regardless of
state of edit push down list)
(COND
((NULL (CDR L))
(ERROR!)))
(PROG NIL
LP (SETQ L (CDR L))
(COND
((TAILP (CAR L)
(CADR L))
(GO LP]
(MARK (SETQ MARKLST (CONS L MARKLST)))
[UNDO (COND
[(AND TYPEIN (LISPXREADP))
(* Indicates that this UNDO command uses the history list.)
(COND
(EDITHISTORY (EDITH C))
(T (ERROR!]
(T (EDIT!UNDO TYPEIN]
(!UNDO (EDIT!UNDO T T))
(TEST (SETQ UNDOLST (CONS NIL UNDOLST)))
[UNBLOCK (COND
((SETQ TEM (FMEMB NIL UNDOLST))
(EDITSMASH TEM (CONS NIL NIL)
(CDR TEM)))
(T (PRIN1 (QUOTE "not blocked.
")
T]
[← (COND
(MARKLST (AND (CDR L)
(SETQ UNFIND L))
(SETQ L (CAR MARKLST)))
(T (ERROR!]
[\ (COND
(UNFIND (SETQ C L)
(SETQ L UNFIND)
(AND (CDR C)
(SETQ UNFIND C)))
(T (ERROR!]
[\P (COND
((AND LASTP1 (NEQ LASTP1 L))
(SETQ L LASTP1))
((AND LASTP2 (NEQ LASTP2 L))
(SETQ L LASTP2))
(T (ERROR!]
[←← (COND
(MARKLST (AND (CDR L)
(SETQ UNFIND L))
(SETQ L (CAR MARKLST))
(SETQ MARKLST (CDR MARKLST)))
(T (ERROR!]
[(F BF)
(COND
((NULL TYPEIN)
(AND (NULL COMS)
(ERROR!))
(SETQ FINDFLAG C)
(RETURN NIL)))
(SETQ TEM (LISPXREAD T EDITRDTBL))
(EDITSAVE1 TEM)
(COND
((EQ C (QUOTE F))
(EDITQF TEM))
((EQ C (QUOTE BF))
(EDITBF TEM))
(T (ERROR!]
(UP (EDUP))
(DELETE (SETQ C (QUOTE (DELETE)))
(* For undoing.)
(EDIT:(QUOTE :)))
(NX (EDIT* 1))
(BK (EDIT* -1))
[!NX
(* Goes through a string of right parentheses to next element.)
(SETQ L (PROG ((L L)
(UF L))
LP (COND
((NULL (SETQ L (CDR L)))
(ERROR!))
([NULL (CDR (FMEMB (CAR L)
(CADR L]
(GO LP)))
(EDITCOM (QUOTE NX))
(SETQ UNFIND UF)
(RETURN L]
(EDITDEFAULT C])
(EDITCOML
[LAMBDA (C COPYFLG) (* lmm "26-JUL-83 20:51")
(PROG (C2 C3 TEM) (* Handles list commands.)
LP [SETQ C2 (CAR (LISTP (SETQ C3 (CDR C]
[SETQ C3 (CAR (LISTP (CDR (LISTP C3]
(COND
((AND LCFLG (SELECTQ C2
((TO THRU THROUGH to thru through)
[COND
((NULL (CDDR C))
(SETQ C3 -1)
(SETQ C2 (QUOTE THRU]
T)
NIL))
(EDITTO (CAR C)
C3 C2)
(RETURN))
((NUMBERP (CAR C))
(EDIT2F (CAR C)
(CDR C))
(RETURN))
((EQ C2 (QUOTE ..))
(EDITCONT (CAR C)
(CDDR C)
(QUOTE N))
(RETURN)))
(RETURN
(COND
[[AND (NULL ORIGFLG)
(OR (SETQ TEM (EDITMAC (CAR C)
USERMACROS T))
(SETQ TEM (EDITMAC (CAR C)
EDITMACROS T]
(PROG (COPYFLG)
(RETURN (EDITCOMS (COND
([NOT (ATOM (SETQ C3 (CAR TEM]
(SUBPAIR C3 (CDR C)
(CDR TEM)
T))
(T (SUBST (CDR C)
C3
(CDR TEM]
(T (SELECTQ
(CAR C)
[S (OR C2 (ERROR!))
(EDITCOM1 (LIST (LIST (COND
((OR (EQ C2 (QUOTE #1))
(EQ C2 (QUOTE #2))
(EQ C2 (QUOTE #3)))
(QUOTE SET))
(T (QUOTE SAVESET)))
C2
(PROG ((L L)
UNFIND)
(RETURN (EDLOC (CDDR C]
(MARK (SET C2 L))
(\ (SETQ UNFIND L)
(SETQ L (EDITCOM1 C2 T)))
(R (EDIT4F C2 C3 T))
(R1 (EDIT4F C2 C3 1))
((RC RC1)
(EDIT4F C2 C3 (OR (EQ (CAR C)
(QUOTE RC))
1)
T))
(E (SETQ TEM (EDITCOM1 C2 T))
(COND
((NULL (CADDR C))
(PRINT TEM T T)))
TEM)
(I (SETQ EDITLISPFLG T)
(AND TYPEIN (LISPXWATCH EDITISTATS))
[SETQ C (CONS (COND
((ATOM C2)
C2)
(T (EDITCOM1 C2 T)))
(EDITCOM1 (LIST (LIST (QUOTE MAPCAR)
(COND
(TYPEIN (MAPCAR (CDDR C)
(FUNCTION LISPX/)))
(T (CDDR C)))
(QUOTE EVAL]
(SETQ COPYFLG NIL)
(GO LP))
[N (COND
((NLISTP (CAR L))
(ERROR!)))
(EDITNCONC (CAR L)
(COND
((NLISTP (CDR C))
(CDR C))
(COPYFLG (COPY (CDR C)))
(T
(* APPEND makes it much easier for EDITHISTORY.)
(EDITAPPEND (CDR C]
(P (COND
((NEQ LASTP1 L)
(SETQ LASTP2 LASTP1)
(SETQ LASTP1 L)))
(BPNT (CDR C)))
(F (EDIT4F C2 C3))
[FS (MAPC (CDR C)
(FUNCTION (LAMBDA (X)
(EDITQF (SETQ COM X]
(F= (EDIT4F (CONS (QUOTE ==)
C2)
C3))
(ORF (EDIT4F (COND
((CDR (LISTP (CDR C)))
(CONS (QUOTE *ANY*)
(CDR C)))
(T C2))
(QUOTE N)))
(BF (EDITBF C2 C3))
[NTH [SETQ TEM (COND
((AND (LISTP (CAR L))
(EQ (CAAR L)
CLISPTRANFLG))
(CDDAR L))
(T (CAR L]
(COND
((NEQ TEM (SETQ TEM (EDITNTH TEM C2)))
(SETQ L (CONS TEM L]
[IF (* Provides for conditional editing. Form is
(if pred) or (if pred coms1 coms2))
(COND
((CAR (NLSETQ (EDITCOM1 C2 T)))
(* If predicate evaluates to true then perform list of commands)
(EDITCOMS C3))
((CDDDR C)
(* If false and default commands given (but may be NIL) execute them.)
(EDITCOMS (CADDDR C)))
(T (* Otherwise generate error. This would be used to terminate a LP or ORR clause.)
(ERROR!]
(RI (EDIT.RI (CADR C)
(CADDR C)
(CAR L)))
(RO (EDIT.RO (CADR C)
(CAR L)))
(LI (EDIT.LI (CADR C)
(CAR L)))
(LO (EDIT.LO (CADR C)
(CAR L)))
(BI (EDIT.BI (CADR C)
(CADDR C)
(CAR L)))
(BO (EDIT.BO (CADR C)
(CAR L)))
(M (SETQ USERMACROS (CONS [COND
[(NLISTP C2)
(COND
((SETQ TEM (EDITMAC C2 USERMACROS))
(RPLACD TEM (CDDR C))
(RETURN))
(T (NCONC1 EDITCOMSA C2)
(CONS C2 (CONS NIL (CDDR C]
(T (COND
((SETQ TEM (EDITMAC (CAR C2)
USERMACROS T))
(RPLACA TEM (CADDR C))
(RPLACD TEM (CDDDR C))
(RETURN))
(T (NCONC1 EDITCOMSL (CAR C2))
(CONS (CAR C2)
(CDDR C]
USERMACROS)))
(NX (EDIT* C2))
(BK (EDIT*(IMINUS C2)))
(ORR (EDOR (CDR C)))
(MBD (EDITMBD NIL (CDR C)))
(XTR (EDITXTR NIL (CDR C)))
((THRU TO) (* Same as (NIL THRU C2) i.e. starts here, does an up, and then a
(BI 1 C2) etc.)
(EDITTO NIL C2 (CAR C)))
((A B : AFTER BEFORE)
(EDIT: (CAR C)
NIL
(CDR C)))
(MV (EDITMV NIL (CADR C)
(CDDR C)))
[(LP LPQ)
(EDRPT (CDR C)
(EQ (CAR C)
(QUOTE LPQ]
(LC (EDLOC (CDR C)))
(LCL (EDLOCL (CDR C)))
[← (SETQ L (PROG ((L L)
(UF L)
TEM)
(SETQ C3 (EDITFPAT C2))
LP [SETQ TEM (COND
((AND (LISTP (CAR L))
(EQ (CAAR L)
CLISPTRANFLG))
(CDDAR L))
(T (CAR L]
(COND
((COND
((ATOM C3)
(EQ C3 (CAR TEM)))
[(EQ (CAR C3)
(QUOTE IF))
(CAR (NLSETQ (EDITCOM1 (CADR C3)
T]
((OR (EQ (CAR C3)
(QUOTE ))
(EQ (CAR C3)
(QUOTE )))
(* Alt-mode.)
(EDIT4E C3 (CAR TEM)))
(T (EDIT4E C3 TEM)))
(SETQ UNFIND UF)
(RETURN L))
((SETQ L (CDR L))
(GO LP)))
(SETQ COM C2)
(ERROR!]
(BELOW
(* Allows specification of new position in terms of depth below some other position. E.g. (BELOW COND 1) indicates
cond-clause you are currently in. (BELOW \ 2) Says 2 below UNFIND. This is useful for getting around in long lists,
e.g. user might perform an F SELECTQ then F FOO. To get to next SELECTQ clause, he does (BELOW \ 1) and then Observe
Observe that you can also save the depth directly by performing (S FOO (LENGTH L)) and then USE BELOW as in
(BELOW ↑ FOO))
(EDITBELOW C2 C3))
(SW (EDITSW (CADR C)
(CADDR C)))
[BIND (* Makes available temporary variables for EDIT macros.
Used by FIX8 and FIX9 macros.)
(PROG (#1 #2 #3)
(RETURN (EDITCOMS (CDR C]
[COMS (MAPC (CDR C)
(FUNCTION (LAMBDA (X)
(EDITCOM (SETQ COM (EDITCOM1 X T]
(COMSQ (EDITCOMS (CDR C)))
[ORIGINAL (PROG ((ORIGFLG T))
(EDITCOMS (CDR C]
[RESETVAR (SETQ TEM (SETQ RESETVARSLST (CONS (CONS C2 (GETATOMVAL C2))
RESETVARSLST)))
(COND
([NULL (PROG1 (XNLSETQ (PROGN (SETATOMVAL C2 (EDITCOM1 C3 T))
(EDITCOMS (CDDDR C)))
NIL STOP)
(SETATOMVAL (CAAR TEM)
(CDAR TEM))
(SETQ RESETVARSLST (CDR TEM]
(ERROR!]
(EDITDEFAULT C])
(EDITCONT
[LAMBDA (LC1 LC2 FLG) (* DD: " 7-Oct-81 21:56")
(* E.g. (COND CONTAINING RETURN) -
equivalent to three commands: F COND followed by (LCL RETURN) followed by (← COND) NOTE: this finds INNERMOST
expression, i.e. if a COND contains another COND which contains a return, (COND CONTAINING RETURN) will find the
inner one.)
(SETQ L (PROG ((L L))
(SETQ LC1 (EDITFPAT LC1))
LP (COND
((NULL (EDIT4F LC1 FLG))
(ERROR!))
((NULL (NLSETQ (EDLOCL LC2)))
(GO LP)))
LP1 (COND
((NULL (SETQ L (CDR L)))
(ERROR!))
([COND
[(NLISTP LC1)
(EQ LC1 (CAR (LISTP (CAR L]
[(EQ (CAR LC1)
(QUOTE ))
(EDIT4E LC1 (CAR (LISTP (CAR L]
(T (EDIT4E LC1 (CAR L]
(RETURN L)))
(GO LP1])
(EDITMAC
[LAMBDA (C LST FLG)
(PROG (X Y)
LP [COND
((NULL LST)
(RETURN NIL))
([EQ C (CAR (SETQ X (CAR LST]
(SETQ Y (CDR X))
(COND
([COND
(FLG (CAR Y))
(T (NULL (CAR Y]
(RETURN Y]
(SETQ LST (CDR LST))
(GO LP])
(EDITMBD
[LAMBDA (LC X) (* lmm "26-JUL-83 20:55")
(PROG (Y TOFLG)
(COND
(LC (EDLOC LC T)))
(EDUP)
[SETQ Y (COND
(TOFLG (CAAR L))
(T (LIST (CAAR L]
[EDIT2F 1 (COND
((NULL (FEDITFINDP X EDITEMBEDTOKEN))
(LIST (APPEND X Y)))
(T (LSUBST Y EDITEMBEDTOKEN X]
[SETQ L (CONS (CAAR L)
(COND
((TAILP (CAR L)
(CADR L))
(* To remove the extra (annoying) tail.)
(CDR L))
(T L]
(RETURN L])
(EDITMV
[LAMBDA (LC OP X)
(PROG ((L0 L)
L1 L2 TOFLG (COM0 COM))
(COND
((EQ OP (QUOTE HERE))
(COND
((NULL LC) (* (MOVE TO HERE --) is the same as (MOVE -- TO HERE))
(SETQ LC X)
(SETQ X NIL)))
(SETQ OP (QUOTE :)))
[(EQ (CAR X)
(QUOTE HERE))
(COND
((NULL LC) (* (MOVE TO AFTER HERE --) is the same as
(MOVE -- TO AFTER HERE))
(SETQ LC (CDR X))
(SETQ X NIL))
(T (SETQ X (CDR X]
((EQ (CAR LC)
(QUOTE HERE)) (* (MOVE HERE TO AFTER --) is same as (MOVE TO AFTER --))
(SETQ LC NIL)))
(AND X (NEQ (CAR X)
(QUOTE TTY:))
(EDLOC X T))
(PROG ((L L0)
(LASTAIL LASTAIL))
(AND LC (EDLOC LC T))
(SETQ L1 L) (* L1 will be used to delete the thing being moved.)
(EDUP)
(SETQ L2 L))
(AND (EQ (CAR X)
(QUOTE TTY:))
(EDLOC X T))
(* Normally we must locate X first because LC may specify TO's or THRU's which would affect numbers in X, e.g.
(MOVE (2 THRU 3) TO AFTER 5) However, it is distracting to do a TTY: first and then have LC fail, so in this special
case, we do LC first.)
(SETQ COM OP)
(COND
((MEMB (CAAR L2)
L)
(PRIN1 (QUOTE "destination is inside expression being moved.
")
T)
(SETQ COM COM0)
(ERROR!)))
[EDITCOML (COND
[TOFLG (CONS OP (APPEND (CAAR L2]
(T (LIST OP (CAAR L2]
(* This makes COPYFLG be bound to NIL while executing this command.)
(PROG ((L L1)
(LASTAIL (CAR L2)))
(EDITCOMA (QUOTE DELETE)))
[SETQ UNFIND (COND
((AND LC X) (* (MOVE -- TO AFTER --) unfind is where you put it.)
L)
([NULL (AND (CDR L2)
(NOT (MEMB (CAR L2)
(CADR L2)))
(NOT (TAILP (CAR L2)
(CADR L2]
(* E.g. MOVE to --, or MOVE -- to after here.
UNFIND is where the thing that was moved used to be.)
L2)
(T
(* CAR of L2 is not connected to the rest of L2, e.g. occurs when you MOVE the last thing in a list.
In this case, make UNFIND be equivalent to doing a 0 at the place where the object that was moved used to be.)
(CDR L2]
(RETURN L])
(EDITCOMS
[LAMBDA (COMS) (* MAPC not used because EDITDEFAULT needs tail for
|
spelling corrections.)
(PROG NIL
LP [COND
((NLISTP COMS)
(AND COMS (EDITCOM COMS)) (* Permits commands that take lists of commands as
arguments, e.g. ORR, IF, etc. to be given a single
atomic command.)
(RETURN (CAR L]
(EDITCOM (CAR COMS))
(SETQ COMS (CDR COMS))
(GO LP])
(EDIT!UNDO
[LAMBDA (PRINTFLG !UNDOFLG)
(AND EDITHISTORY (LISPXWATCH P.A.STATS))
(PROG ((LST UNDOLST)
FLG)
LP (COND
((OR (NULL LST)
(NULL (CAR LST)))
(GO OUT)))
(SELECTQ (CAAR LST)
((NIL !UNDO UNBLOCK)
(GO LP1))
[UNDO (COND
((NULL !UNDOFLG)
(GO LP1]
NIL)
(UNDOEDITCOM (CAR LST)
PRINTFLG)
(COND
((NULL !UNDOFLG)
(RETURN)))
(SETQ FLG T)
LP1 (SETQ LST (CDR LST))
(GO LP)
OUT (COND
(FLG (RETURN))
((CDR LST)
(PRINT (QUOTE blocked)
T T))
(T (PRIN1 (QUOTE "nothing saved.
")
T])
(UNDOEDITCOM
[LAMBDA (X FLG) (* If FLG is T, name of command is
printed.)
(PROG (C)
(COND
((NLISTP X)
(ERROR!))
((NULL (SETQ C (CAR X))) (* Has been undone before, but UNDO
it again.)
(SETQ C (QUOTE ALREADY))
(GO OUT))
([NEQ (CAR (FLAST L))
(CAR (FLAST (CADR X]
(* The expression being edited is not the one referred to by this undo
command. This can happen if you undo by using history list outside of scope
of this editing.)
(PRIN1 (QUOTE "different expression.
")
T)
(SETQ COM NIL)
(ERROR!)))
(SETQ L (CADR X))
[PROG (L)
(* L bound to NIL so that EDITSMASH doesnt search up it looking for CLISP
markers.)
(UNDOEDITCOM1 X)
(EDITSMASH X NIL (CONS (CAR X)
(CDR X]
(* Marks it so UNDO will skip it in future.
Note that undoing this UNDO will unmark it.)
OUT (AND FLG (PRIN2 [COND
((NULL C)
(QUOTE already))
((NOT (NUMBERP C))
C)
(T (CONS C (QUOTE (--]
T T)
(PRIN1 (QUOTE " undone.
")
T))
(RETURN T])
(UNDOEDITCOM1
[LAMBDA (X)
(* Takes a single entry on UNDOLST, i.e. list of the form
(command-name L . UNDOLST1) and maps down the UNDOLST1 portion performing
the corresonding EDITSMASHes.)
(MAPC (CDDR X)
(FUNCTION (LAMBDA (X)
(COND
((EQ (CAR X)
(QUOTE GROUPED))
(* Used by TTY: command, which must add entire UNDOLST from subordinate call
to EDITL0 to its own UNDOLST1.)
(MAPC (CDR X)
(FUNCTION UNDOEDITCOM1)))
((EQ (CAR X)
(QUOTE LISPXHIST))
(EDITCOM1 (CDR X)))
(T (EDITSMASH (CAR X)
(CADR X)
(CDDR X))
(LISPXWATCH EDITUNDOSTATS])
(EDITCOM1
[LAMBDA (LST FLG)
(* LST is a list of expressions of the form used for saving undo information on LISPXHIST, i.e. CAR of form is to be
|
applied to CDR. EDITCOM1 executes the forms and then transfers the undo information to the edit history list so that
|
UNDO can work as an edit command. EDITCOM1 is used by the S and I command, and for undoing these commands.
|
Value is the result of last application -
|
used by I command to get result of evaluaton back.)
(PROG ((LISPXHIST (CONS (QUOTE SIDE)
(CONS (LIST 0)
LISPXHIST)))
TEM)
(* LISPXHIST is rebound this way so that the SIDE information doesnt get stored on the regular side slot.
|
LISPXHIST is not completely rebound, i.e. to just the side info, so that other messages etc. will still be stored on
|
the correct entry)
[COND
[FLG (* IF FLG is T, LST is a single form.)
(SETQ EDITLISPFLG T)
|
(SETQ TEM (EVAL (COND
(TYPEIN (LISPX/ LST))
(T LST]
(T (MAPC LST (FUNCTION (LAMBDA (X)
(SETQ TEM (COND
((NLISTP X)
TEM)
((LISTP (CAR X))
(/RPLNODE (CAR X)
(CADR X)
(CDDR X)))
(T (APPLY (CAR X)
(CDR X]
(AND [SETQ LISPXHIST (CDR (LISTGET1 LISPXHIST (QUOTE SIDE]
(SETQ UNDOLST1 (CONS (CONS (QUOTE LISPXHIST)
LISPXHIST)
UNDOLST1)))
(RETURN TEM])
(EDITSAVE
[LAMBDA (COM) (* lmm "22-NOV-82 00:11")
(* This function was originally included in HIST but is now in the editor for
block compilation.)
(PROG (X)
(COND
((FMEMB COM DONTSAVEHISTORYCOMS)
(RETURN))
((AND (OR (NUMBERP COM)
(FMEMB COM COMPACTHISTORYCOMS))
(OR [NUMBERP (CAR (SETQ X (CAAAR EDITHISTORY]
(FMEMB (CAR X)
COMPACTHISTORYCOMS))
(NOT (FMEMB HISTSTR0 X)))
(* CAAR is first entry, CAAAR the input.)
(NCONC1 X COM)
(RETURN X))
((OR (FMEMB COM HISTORYCOMS)
(AND (LISTP COM)
(FMEMB (CAR COM)
HISTORYCOMS)))
(RETURN)))
(SETQ EDITHIST (CDDR (HISTORYSAVE EDITHISTORY (QUOTE *)
NIL COM)))
(* EDITHIST is bound in EDITL0. Note that it is imperative for subsequently storing the undo information to save the
history entry BEFORE executing the command since you cannot be sure that the first entry on EDITHISTORY corresponds
to the command just completed, e.g. consider a loop command with a TTY in it.)
(COND
(EDITLISPFLG (SETQ EDITLISPFLG NIL)))
(RETURN NIL])
(EDITSAVE1
[LAMBDA (X REPLACEFLG) (* Used to add inputs to history event, e.g. for F commands, and for line
commands typed without parentheses)
(AND EDITHIST EDITHISTORY (PROG (TEM)
(COND
[[OR (NULL REREADFLG)
(NULL (SETQ TEM (CDR (FMEMB (QUOTE *GROUP*)
(CADR (FMEMB HISTSTR3
REREADFLG]
(COND
(REPLACEFLG (FRPLACA (CAAR EDITHISTORY)
X))
(T (NCONC1 (CAAAR EDITHISTORY)
X]
(T
(* Value is the list of events in the GROUP property.)
(COND
(REPLACEFLG (FRPLACA (CAR (LAST (CAR TEM)))
X))
(T (NCONC1 (CAAR (LAST (CAR TEM)))
X])
(EDITSMASH
[LAMBDA (OLD A D) (* wt: "12-MAY-80 21:32")|
(* ALL edit changes go through this function.)
|
(COND|
((NLISTP OLD)|
(ERROR!)))|
(AND EDITSMASHUSERFN (APPLY* EDITSMASHUSERFN OLD L))|
|
(* hook to enable updating a structure thatis being edited that has hash links off of it. the PROG below is a built
|
in example of how such a thing might be used)|
|
|
(AND EDITCHANGES (FRPLACA (CDR EDITCHANGES)|
T))|
(SETQ UNDOLST1 (CONS (CONS OLD (CONS (CAR OLD)|
(CDR OLD)))|
UNDOLST1))|
(AND EDITHISTORY (LISPXWATCH EDITUNDOSAVES))|
(FRPLACA OLD A)|
(FRPLACD OLD D)|
(PROG ((L L)|
TEM)|
LP (COND|
((NULL L)|
(RETURN))|
((NLISTP (CAR L)))|
[(EQ (CAAR L)|
CLISPTRANFLG)|
|
(* Deletes CLISP translation. NOt made part of the edit event, because of the possibility of the uer performing two
|
changes, and then undoing the first, which would then restore the translation, even though it no longer corresond to
|
the untranslated and chaged CLISP.)|
|
|
(COND|
((LISTP (SETQ TEM (CDDAR L)))|
(/RPLNODE (CAR L)|
(CAR TEM)|
(CDR TEM)))|
(T (* CLISP% used to tranlsate an atom -|
e.g. QLISP does this.)|
(/RPLACA (MEMB (CAR L)|
(CADR L))|
TEM]|
((AND CLISPARRAY (GETHASH (CAR L)|
CLISPARRAY))|
(/PUTHASH (CAR L)|
NIL CLISPARRAY)))|
(SETQ L (CDR L))|
(GO LP))|
OLD])
(EDITSMASH1
[LAMBDA (X)
(AND CHANGESARRAY (PROG ((L0 L))
LP (COND
((NULL L0)
(GO OUT))
((NLISTP (CAR L0)))
((GETHASH (CAR L0)
CHANGESARRAY)
(RETURN NIL)))
(SETQ L0 (CDR L0))
(GO LP)
OUT [AND (NLISTP X)
(SETQ X (COND
((OR (NULL (SETQ X (CADR L)))
(FMEMB (CAR L)
X))
(CAR L))
(T X]
(SETQ UNDOLST1 (CONS (CONS (QUOTE LISPXHIST)
(LIST (LIST (QUOTE /PUTHASH)
X
(GETHASH X CHANGESARRAY)
CHANGESARRAY)))
UNDOLST1))
(* Done this way for efficiency rather than going through editcom1 since we
know what to undosave.)
(PUTHASH X ATM CHANGESARRAY)
(RETURN])
(EDITSW
[LAMBDA (M N)
(PROG ((Y (EDITNTH (CAR L)
M))
(Z (EDITNTH (CAR L)
N))
TEM)
(SETQ TEM (CAR Y))
(EDITSMASH Y (CAR Z)
(CDR Y))
(EDITSMASH1 (CAR Z))
(EDITSMASH Z TEM (CDR Z))
(EDITSMASH1 TEM])
(EDITNCONC
[LAMBDA (X Y)
(COND
((NULL X)
Y)
((NLISTP X)
(ERROR!))
(T (PROG1 X (EDITSMASH (SETQ X (LAST X))
(CAR X)
Y)
(AND CHANGESARRAY (MAPC Y (FUNCTION EDITSMASH1])
(EDITAPPEND
[LAMBDA (X) (* wt: " 3-OCT-78 19:59")
|
(* copies top level, differs fro append in that if ends
|
in non-nil, the non-nil is retained)
|
(COND
((NLISTP X)
X)
(T (CONS (CAR X)
(EDITAPPEND (CDR X])
(EDIT1F
[LAMBDA (C L) (* wt: "13-JUN-78 00:55")
(PROG (TEM)
[COND
[(EQ C 0)
(RETURN (COND
((CDR L)
(RETURN (CDR L)))
(T (SETQQ COM (ERROR: . "can't - at top.
"))
(ERROR!]
((NLISTP (CAR L))
(ERROR!))
((EQ (CAAR L)
CLISPTRANFLG)
(SETQ TEM (CDDAR L)))
(T (SETQ TEM (CAR L]
(RETURN (COND
[(IGREATERP C 0)
(COND
((NLISTP (SETQ TEM (NTH TEM C)))
(ERROR!))
(T (CONS (CAR (SETQ LASTAIL TEM))
L]
([NULL (SETQ TEM (NLEFT TEM (IMINUS C]
(ERROR!))
(T (CONS (CAR (SETQ LASTAIL TEM))
L])
(EDIT2F
[LAMBDA (N X)
(PROG ([CL (COND
((AND (LISTP (CAR L))
(EQ (CAAR L)
CLISPTRANFLG))
(CDDAR L))
(T (CAR L]
TEM)
(* Handles all deletion, replacement and insertion.
For deletion and replacement, saves information about what was destroyed on
variable LASTCHANGE. The command UNDO can then be used to restore the
structure.)
[COND
((NLISTP CL)
(ERROR!))
(COPYFLG (SETQ X (COPY X)))
(T (* APPEND makes it much easier for
EDITHISTORY.)
(SETQ X (APPEND X]
(COND
[(IGREATERP N 0)
(COND
([AND (NEQ N 1)
(OR [NLISTP (SETQ TEM (NTH CL (SUB1 N]
(NLISTP (CDR TEM]
(SETQ COM N)
(ERROR!))
((NULL X) (* Delete)
(GO DELETE))
(T (* Replace)
(GO REPLACE]
([OR (EQ N 0)
(NULL X)
(NLISTP (SETQ TEM (NTH CL (IMINUS N]
(ERROR!))
(T (* Insert)
(COND
((NEQ N -1)
(SETQ CL TEM))) (* Insertion also physically changes
indicated tail.)
(EDITSMASH CL (CAR X)
(CONS (CAR CL)
(CDR CL)))
(EDITSMASH1 (CAR X))
[COND
((CDR X)
(AND CHANGESARRAY (MAPC (CDR X)
(FUNCTION EDITSMASH1)))
(EDITSMASH CL (CAR CL)
(NCONC (CDR X)
(CDR CL]
(RETURN)))
DELETE
[COND
[(EQ N 1)
(OR (LISTP (CDR CL))
(ERROR!))
(* To delete first element you must effectively replace it by second element
and delete second element. This is why you cannot delete the first element
of a list when it is the only one.)
(EDITSMASH CL (CADR CL)
(CDDR CL))
(EDITSMASH1 (COND
((TAILP CL (CADR L))
(CADR L))
(T CL]
(T
(* Deleting any other element is done by patching around it, i.e. by
changing previous CDR to point to its CDR.
In general, you can't solve problem so pointers into tails will always be
updated without going down the entire list and moving everything over.
See manual.)
(EDITSMASH TEM (CAR TEM)
(CDDR TEM))
(EDITSMASH1 (COND
((TAILP CL (CADR L))
(CADR L))
(T CL]
(RETURN)
REPLACE
[COND
((NEQ N 1)
(SETQ CL (CDR TEM]
(* Replacement physically changes indicated tail i.e. if you are editing
(A B C D) and set FOO to (NTH 3) i.e. (C D) and then do a
(3 X Y) FOO will be changed to (X Y D))
(EDITSMASH CL (CAR X)
(CDR CL))
(EDITSMASH1 (CAR X))
(COND
((CDR X)
(AND CHANGESARRAY (MAPC (CDR X)
(FUNCTION EDITSMASH1)))
(EDITSMASH CL (CAR CL)
(NCONC (CDR X)
(CDR CL])
(EDIT4E
[LAMBDA (PAT X CHANGEFLG) (* DD: "29-MAR-83 18:02")
(COND
((EQ PAT X)
T)
((NLISTP PAT)
(OR (EQ PAT (QUOTE &))
(AND (NUMBERP PAT)
(EQP PAT X))
(AND (STRINGP PAT)
(STREQUAL PAT X)
T)))
((EQ (CAR PAT)
(QUOTE *ANY*))
(PROG NIL
LP (COND
((NULL (SETQ PAT (CDR PAT)))
(RETURN NIL))
((EDIT4E (CAR PAT)
X)
(RETURN T)))
(GO LP)))
((EQ (CAR PAT)
(QUOTE )) (* is the way the line printer prints alt-modes.)
(AND (OR (LITATOM X)
(STRINGP X))
(EDIT4E1 (CDR PAT)
(DUNPACK X CHCONLST2)
X CHANGEFLG)))
((EQ (CAR PAT)
(QUOTE ))
(* This pattern specifies a search for a 'close' word, using the spelling corrector, i.e. SKOR.
CADR of PAT is the number of characters in the word, CDDR its CHCON. The pattern is constructed by EDITFPAT when it
encounters a word or string that ends in .)
(AND (OR (LITATOM X)
(STRINGP X))
(SKOR0 X (CADR PAT)
(CADDR PAT)
(CDDDR PAT))
(PROGN (AND (NEQ EDITQUIETFLG T)
(PRIN1 (QUOTE =)
T)
(PRINT X T T))
T)))
[(EQ (CAR PAT)
(QUOTE --))
(OR (NULL (SETQ PAT (CDR PAT)))
(PROG NIL
LP (COND
((EDIT4E PAT X)
(RETURN T))
((NLISTP X)
(RETURN NIL)))
(SETQ X (CDR X))
(GO LP]
((EQ (CAR PAT)
(QUOTE ==))
(EQ (CDR PAT)
X))
((EQ (CAR (LISTP (CDR PAT)))
(QUOTE ..))
(AND (EDIT4E (CAR PAT)
(CAR X))
[NLSETQ (PROG ((L (LIST X))
UNFIND ORIGFLG LASTAIL)
(EDLOCL (CDDR PAT]
T))
((EQ (CAR PAT)
(QUOTE @))
(APPLY* (CADR PAT)
X))
((NLISTP X)
NIL)
([EDIT4E (CAR PAT)
(CAR (COND
((EQ (CAR X)
CLISPTRANFLG)
(SETQ X (CDDR X)))
(T X]
(EDIT4E (CDR PAT)
(CDR X])
(EDIT4E1
[LAMBDA (PAT LST X CHANGEFLG)
(* Compares PAT and X. PAT is a DUNPACK of an atom or string which contains
one or more alt-modes. An alt-mode can match any number
(including zero) of characters in X, e.g. NUM$, $BERP, and $U$E$ all match
NUMBERP. If CHANGEFLG is T and PAT matches X, the value of EDIT4E1 is a list
of pointer pairs corresponding to the beginning and end of the sequence
matched by each alt-mode.)
(PROG (PAT1 LST1 LST2 MATCH)
LP (COND
[(NULL PAT)
(COND
((OR (NULL LST)
(NULL PAT1))
(* If LST is NIL, then the final characters in PAT matched those in X, e.g.
$BERP vs NUMBERP. If PAT1 is NIL, then the last character in PAT was an
altmode, e.g. NUM$ vs NUMBERP, so extra characters in LST are acceptable.)
(GO SUCC))
(LST1 (SETQ LST LST1)
(SETQ LST1 NIL)
(SETQ PAT PAT1))
(T (RETURN NIL]
((EQ (CAR PAT)
(QUOTE ))
[COND
((AND CHANGEFLG LST2 LST1)
(* An alt-mode was seen before. (Note that we cannot determine the scope of
an alt-mode until the next one is encountered, or the end of the match is
reached.) LST2 was the value of LST as of the beginning of the alt-mode
match, LST1 the value of LST as of its end.
However, if LST1 is NIL, then there were two alt-modes in a row, and we
ignore the last one.)
(SETQ MATCH (CONS (CONS LST2 LST1)
MATCH]
(SETQ PAT (SETQ PAT1 (CDR PAT)))
(* PAT1 is a pointer into PAT as of the first character after an alt-mode.
It is used for backing up after a partially successful match, e.g. if PAT is
$XYZ$ and X is XYXYZ.)
(SETQ LST1 NIL)
(SETQ LST2 LST)
(GO LP))
((NULL LST)
(RETURN NIL))
((EQ (CAR PAT)
(CAR LST))
(COND
((NULL LST1)
(SETQ LST1 LST)))
(SETQ PAT (CDR PAT)))
((NULL (SETQ PAT PAT1))
(RETURN NIL))
(LST1 (SETQ LST LST1)
(SETQ LST1 NIL)))
(SETQ LST (CDR LST))
(GO LP)
SUCC(COND
[CHANGEFLG (AND (NEQ EDITQUIETFLG T)
(PRIN2 X T T))
(* EDIT4F2 will be called, and it will print -> followed by the new atom or
string.)
(RETURN (DREVERSE (CONS (CONS LST2 LST1)
MATCH]
((NEQ EDITQUIETFLG T)
(PRIN1 (QUOTE =)
T)
(PRINT X T T)))
(RETURN T])
(EDITQF
[LAMBDA (PAT)
(PROG (Q1)
(COND
([AND (LISTP (SETQ Q1 (CAR L)))
(SETQ Q1 (MEMB PAT (COND
((EQ (CAR Q1)
CLISPTRANFLG)
(CDDDR Q1))
(T (CDR Q1]
(SETQ L (CONS (COND
(UPFINDFLG Q1)
(T (SETQ LASTAIL Q1)
(CAR Q1)))
L)))
(T (EDIT4F PAT (QUOTE N])
(EDIT4F
[LAMBDA (PAT C3 CHANGEFLG CHARFLG)
(* DD: "29-MAR-83 17:56")
(* Searches the expression being edited, starting from current point and continuing in print order, until a position
is found for which the current level list matches PAT. Then, if (CAR L) is atomic, effectively does an UP
(unless UPFINDFLG=NIL) Thus F (SETQ X --) and F SETQ will produce the same result. -
If C3 is T, the search starts with the current exppession. If C3 is 'N', the search skips the current expression,
although it does search inside of it.)
(PROG (LL X TAIL (FF (CONS))
(TOPLVL (NULL C3))
N NEWFLG (PAT0 PAT))
[COND
((EQ [CAR (LISTP (CDR (LISTP PAT]
(QUOTE ..))
(RETURN (EDITCONT (CAR PAT)
(CDDR PAT)
C3]
(SETQ PAT (EDITFPAT PAT T))
(* Checks PAT for altmodes.)
(SETQ LL L)
(COND
(CHANGEFLG (SETQ N (COND
((NUMBERP CHANGEFLG)
CHANGEFLG)
(T (* Means change all occurrences.)
-1)))
(SETQ TOPLVL NIL)
(SETQ C3 (EDITFPAT1 C3))
[AND CHARFLG (NLISTP PAT)
(NLISTP C3)
[SETQ PAT (CONS (QUOTE )
(CONS (QUOTE )
(NCONC1 (UNPACK PAT)
(QUOTE ]
(SETQ C3 (CONS (QUOTE )
(CONS (QUOTE )
(NCONC1 (UNPACK C3)
(QUOTE ]
(* If CHARFLG is T and neither pattern nor format contain alt-modes, supply them, i.e. user wants a character
replacement operation. This option is used by the RC and RC1 commands, and by ESUBST.)
)
[(EQ C3 (QUOTE N))
(SETQ N 1)
[COND
((NLISTP (CAR L))
(GO LP1))
((EQ (CAAR L)
CLISPTRANFLG)
(SETQ X (CADDAR L)))
(T (SETQ X (CAAR L]
(SETQ LL (CONS X L))
(COND
((AND (NLISTP X)
UPFINDFLG)
(* E.g. If at (COND --) and do F COND, cannot be allowed to match with this COND, as the subsequent UP would leave
you right where you started. However, if UPFINDFLG is NIL, then it is ok to match with this COND.)
(GO LP1]
(T (SETQ N C3)))
(COND
((NOT (NUMBERP N))
(SETQ N 1)))
[COND
([COND
[(TAILP (CAR LL)
(CADR LL))
(AND (EQ (CAR (LISTP PAT))
(QUOTE ...))
(EDIT4E (CDR PAT)
(CAR LL]
(T (EDIT4E PAT (CAR LL]
(* This EDIT4E check is necessary because once search starts, EDIT4F1 is always looking down one level, i.e. at
car's of list it is examining. Similarly, since once the search starts, tails are only matched against patterns
beginning with ..., we do not call EDIT4E here on a TAIL unless the pattern also begins with ...)
(COND
[CHANGEFLG (COND
([NULL (AND (EQ PAT (QUOTE &))
(LISTP (CAR L]
(* R can't work if you are already there, e.g. current expression is B and user says (R B C), or current expression
is (CAR X) and user says (R (CAR X) (CDR Y)). the AND check is to enable commands like (r1 & .) to work.
In this case, it is assumed that & meant the first element in the current expression, not the current expression
itself.)
(PRINT (QUOTE can't)
T T)
(ERROR!]
((ZEROP (SETQ N (SUB1 N)))
(RETURN (SETQ L LL]
(SETQ X (CAR LL))
LP (COND
[(EDIT4F1 PAT X MAXLEVEL TAIL)
(AND (CDR L)
(SETQ UNFIND L))
(RETURN (CAR (SETQ L (NCONC (CAR FF)
(COND
((EQ (CADR FF)
(CAR LL))
(* To avoid repetitions.)
(CDR LL))
(T LL]
(TOPLVL (GO ERROR))
((EQ CHANGEFLG T)
(* R command only affects current expression. However, R1 is equivalent to an F and then a replacement and so is
allowed to search above the current expression.)
(COND
(NEWFLG (RETURN T)))
(GO ERROR)))
LP1 (SETQ X (CAR LL)) (* Ascend from this element and begin searching the next element in the next
higher list.)
(COND
((NULL (SETQ LL (CDR LL)))
(COND
(NEWFLG (* This was a replacement operation which has found a successful match.)
(RETURN T)))
(GO ERROR))
([SETQ TAIL (COND
((AND (EQ X (CAR LASTAIL))
(TAILP LASTAIL (CAR LL)))
(* This is sort of an open UP. It is necessary to handle the case where the current expression is atomic and the
next higher expression contains two instances of it.)
LASTAIL)
(T (MEMB X (CAR LL]
(SETQ X (CDR TAIL))
(GO LP)))
(GO LP1)
ERROR
(SETQ COM PAT0)
(ERROR!])
(EDIT4F1
[LAMBDA (PAT X LVL TAIL) (* wt: " 5-APR-78 11:07")
(* In most cases, EDIT4F1 treats X as a list, and matches PAT against elements of X. However, if TAIL is not NIL,
EDIT4F1 will also look at X itself if (1) X is not a list (this covers the case where a list ends in an atom other
than NIL), or (2) PAT begins with ... In both cases, X is EQ to CDR of TAIL, and TAIL is used if replacement is
being carried out.)
(PROG ((L L)
TEM XX)
(AND CHANGEFLG (NEQ X (CAR L))
(SETQ L (CONS X L)))
(* So that if there are any replacements in CLISP expressions that have been
translated, editsmash will know to remove the translations.)
[COND
((AND (LISTP X)
(NULL TAIL)
(EQ (CAR X)
CLISPTRANFLG))
(SETQ XX X)
(SETQ TAIL (CDR X))
(SETQ X (CDDR X]
LP (COND
((AND (LISTP PAT)
(EQ (CAR PAT)
(QUOTE ...)))
(* This check is made before the NULL check because F
(...) is acceptable and means find the first list ending in NIL.)
(GO CHECK...))
((NULL X))
((AND LVL (NOT (IGREATERP LVL 0)))
(* NIL = infinity.)
(PRIN1 (QUOTE "maxlevel exceeded.
")
T))
((LISTP X)
(GO ELEMENT))
((AND TAIL (SETQ TEM (EDIT4E PAT X CHANGEFLG)))
(* Compares PAT with atomic tail of
a list.)
[COND
(CHANGEFLG (SETQ X (EDIT4F2 TAIL TEM C3 T]
(COND
((ZEROP (SETQ N (SUB1 N)))
(GO SUCC)))
(* Note that the current expression is left at the
(atomic) tail to prevent accidents like
(MOVE FOO TO ...) and FOO is CDR of (FIE . FOO))
))
(RETURN NIL)
CHECK...
(COND
[(AND TAIL (SETQ TEM (EDIT4E (CDR PAT)
X CHANGEFLG)))
(* Note that at this point, X may still be atomic, as in F
(... . B))
[COND
(CHANGEFLG (SETQ X (EDIT4F2 TAIL TEM C3 T]
(COND
((ZEROP (SETQ N (SUB1 N)))
(GO SUCC))
(CHANGEFLG (* Don't want to go to LP1 because you don't want to
search through new structure inserted by replacement.)
(RETURN NIL))
((NLISTP X)
(RETURN NIL))
(T (GO LP1]
((NLISTP X)
(RETURN NIL))
(T (* PAT is a ... pattern, so don't
compare it with elements.)
(GO DESCEND)))
ELEMENT
[COND
((SETQ TEM (EDIT4E PAT (CAR X)
CHANGEFLG))
(COND
(CHANGEFLG (EDIT4F2 X TEM C3)))
(COND
((ZEROP (SETQ N (SUB1 N)))
[COND
((OR (NULL UPFINDFLG)
(LISTP (CAR X)))
(* Instead of adding atom and then doing UP -
this check is made and atom not added if UPFINDFLG is T.)
(SETQ LASTAIL X) (* For use by UP.)
(SETQ X (CAR X]
(GO SUCC))
(CHANGEFLG (* Don't want to go to DESCEND because you don't want to
search through new structure inserted by replacement
operation.)
(GO LP1]
DESCEND
(COND
((AND (NULL TOPLVL)
(LISTP (CAR X))
(EDIT4F1 PAT (CAR X)
(AND LVL (SUB1 LVL)))
(ZEROP N))
(SETQ X (CAR X)))
(T (GO LP1)))
SUCC(AND XX (EQ X (CDDR XX))
(SETQ X XX)) (* CLISP% expression.)
(COND
([AND FF (NOT (AND X (EQ X (CADR FF]
(* To eliminate repetitions.)
(TCONC FF X)))
(RETURN (OR FF T))
LP1 (SETQ TAIL X)
(SETQ X (CDR X))
(AND LVL (SETQ LVL (SUB1 LVL)))
(GO LP])
(EDIT4F2
[LAMBDA (NODE MATCH FORMAT CDRFLG)
(* Analagous to CONSTRUCT in FLIP, with EDITFPAT1 playing the role of
FORMTRAN. Replaces CAR of NODE by FORMAT
(CDR if CDRFLG=T). MATCH is the value returned by EDIT4E.
If MATCH is a list of pointers and FORMAT begins with $, EDIT4F2 assembles a
new atom or string, replacing those sequences not matched by alt-modes with
elements from NEW. For example, user types
(R $1 $2) then all terminal 1's will be changed to 2's.)
(PROG ([X (COND
(CDRFLG (CDR NODE))
(T (CAR NODE]
FLG)
(SETQ NEWFLG T) (* to let EDIT4F know that a
successful match was found.)
(SETQ FORMAT (EDIT4F3 FORMAT MATCH X))
(COND
((EQ EDITQUIETFLG T)
(GO OUT))
((NEQ MATCH T) (* EDIT4E printed X.)
)
(FLG
(* MATCH was T, indicating no alt-modes, and therefore X was not printed by
EDIT4E1. However, FLG being T means a format was used, and therefore X must
be printed here. For example, (R FOO $1))
(PRIN2 X T T))
(T (GO OUT)))
(PRIN1 (QUOTE ->)
T)
(PRINT FORMAT T T)
OUT [COND
(CDRFLG (EDITSMASH NODE (CAR NODE)
FORMAT))
(T (EDITSMASH NODE FORMAT (CDR NODE]
(EDITSMASH1 FORMAT)
(RETURN FORMAT])
(EDIT4F3
[LAMBDA (FORMAT MATCH X) (* lmm "18-NOV-82 13:54")
(PROG (LST)
(COND
[(LISTP FORMAT)
(COND
([EQ (CAR FORMAT)
(CONSTANT (CHARACTER (CHARCODE ESCAPE]
(SETQ FLG T))
(T (RETURN (CONS (EDIT4F3 (CAR FORMAT)
MATCH X)
(EDIT4F3 (CDR FORMAT)
MATCH X]
(T (RETURN FORMAT)))
LP [COND
[(NLISTP (SETQ FORMAT (CDR FORMAT)))
(RETURN (COND
((AND (EQ MATCH T)
(NULL (CDR LST)))
(CAR LST))
((STRINGP X)
(CONCATLIST LST))
(T (PACK LST]
[[EQ (CAR FORMAT)
(CONSTANT (CHARACTER (CHARCODE ESCAPE]
(SETQ LST (NCONC LST (COND
((EQ MATCH T)
(* Permits user to say (R FOO $1) meaning change all FOO's to FOO1's, etc.)
(LIST X))
(T (PROG1 (LDIFF (CAAR MATCH)
(CDAR MATCH))
(SETQ MATCH (CDR MATCH]
(T (SETQ LST (NCONC1 LST (CAR FORMAT]
(GO LP])
(EDITFPAT
[LAMBDA (PAT FLG) (* wt: 23-NOV-76 1 45)
(* Done once at beginning of find operation. Replaces atoms ending in alt-modes with patterns recognized by EDIT4E.
Analagous to PATTRAN in FLIP, with role of MATCH being played by EDIT4E1.)
(PROG (TEM)
(RETURN (COND
[(LISTP PAT)
(COND
((OR (EQ (CAR PAT)
(QUOTE ==))
(EQ (CAR PAT)
(QUOTE ))
(EQ (CAR PAT)
(QUOTE )))
PAT)
(T (CONS (EDITFPAT (CAR PAT))
(EDITFPAT (CDR PAT]
((OR (EQ PAT (QUOTE ))
(NOT (STRPOS (QUOTE )
PAT)))
PAT)
[(STRPOS (QUOTE "")
PAT -2) (* Used to specify a search for a 'close' word using
|
SKOR. See comment in EDIT4E.)
(SETQ TEM (CHCON PAT))
(FRPLACD (NLEFT TEM 3))
(CONS (QUOTE )
(CONS (LENGTH TEM)
(CONS (PROG ((ND 0)
CHAR)
[MAPC TEM (FUNCTION (LAMBDA (X)
(COND
((EQ X CHAR)
(SETQ ND (ADD1 ND)))
(T (SETQ CHAR X]
(RETURN ND))
TEM]
(T (CONS (QUOTE )
(COND
(FLG (DUNPACK PAT CHCONLST1))
(T (UNPACK PAT])
(EDITFPAT1
[LAMBDA (X) (* rmk: " 6-JUN-82 15:15")
(* Analgous to FORMTRAN in FLIP, with EDIT4F2 playing the role of CONSTRUCT. Used by EDIT4F once at the beginning of
a find operation that also specifies replacement -
i.e. an R command. Converts an atom or string containing alt modes into a list of the character sequences, e.g. if X
is $ABC$DEF$ then the value of EDITFPAT1 is ($ $ ABC $ DEF $) (The first $ is merely a flag.))
(COND
((OR (LITATOM X)
(STRINGP X))
(COND
[(STRPOS (QUOTE )
X)
(CONS (QUOTE )
(PROG ((N 1)
(NC (NCHARS X))
VAL)
LP (SETQ VAL (CONS [COND
((EQ (NTHCHARCODE X N)
(CHARCODE ESCAPE))
(QUOTE ))
(T (SUBSTRING X N (SETQ N
(SUB1 (OR (STRPOS "" X N)
0]
VAL))
[COND
((OR (EQ N -1)
(IGREATERP (SETQ N (ADD1 N))
NC))
(RETURN (DREVERSE VAL]
(GO LP]
(T X)))
[(LISTP X)
(CONS (EDITFPAT1 (CAR X))
(EDITFPAT1 (CDR X]
(T X])
(EDITFINDP
[LAMBDA (X PAT FLG)
(* Allows the user to use the edit find operation as a predicate without
being inside the editor or doing any conses.)
(PROG ((N 1)
CHANGEFLG LASTAIL TOPLVL FF)
(AND (NULL FLG)
(SETQ PAT (EDITFPAT PAT T)))
(RETURN (OR (EDIT4E PAT X)
(EDIT4F1 PAT X MAXLEVEL])
(FEDITFINDP
[LAMBDA (LST AT) (* lmm "26-JUL-83 20:55")
(OR (EQ AT LST)
(AND (LISTP LST)
(OR (FEDITFINDP (CAR LST)
AT)
(FEDITFINDP (CDR LST)
AT])
(EDITBELOW
[LAMBDA (PLACE DEPTH) (* See comment in EDITCOML)
(PROG ((L0 (PROG ((L L)
(LCFLG (QUOTE ←)))
(EDITCOM PLACE)
(RETURN L)))
L1 N)
(COND
((NULL DEPTH)
(SETQ COM C)
(SETQ DEPTH 1))
((MINUSP (SETQ COM (EVAL DEPTH)))
(* If anything goes wrong from hhe on, the error message shuld print the value of
DEPTH.)
(ERROR!))
(T (SETQ DEPTH COM)))
(SETQ L1 (REVERSE L))
(SETQ L0 (FMEMB (CAR L0)
L1))
LP [COND
((NULL L0)
(ERROR!))
[(ZEROP DEPTH)
(FRPLACD L0)
(SETQ UNFIND L)
(RETURN (SETQ L (DREVERSE L1]
((NOT (TAILP (CADR L0)
(CAR L0)))
(SETQ DEPTH (SUB1 DEPTH]
(SETQ L0 (CDR L0))
(GO LP])
(EDITBF
[LAMBDA (PAT N)
(PROG ((LL L)
X Y (FF (CONS)))
(* Same as EDIT4F, except searches in reverse printorder.
If N is T (or at top level) search includes current expression, otherwise
starts with first expression that would be printed before the current
expression.)
(SETQ COM PAT)
(SETQ PAT (EDITFPAT PAT))
(COND
((OR (NLISTP (CAR LL))
(AND (NULL N)
(CDR LL))) (* Do not examine current
expression.)
(GO LP1)))
LP [COND
((EDITBF1 PAT (CAR LL)
MAXLEVEL Y)
(SETQ UNFIND L)
(RETURN (CAR (SETQ L (NCONC (CAR FF)
(COND
((EQ (CAR LL)
(CADR FF))
(CDR LL))
(T LL]
LP1 (SETQ X (CAR LL))
(COND
((NULL (SETQ LL (CDR LL)))
(ERROR!))
([OR (SETQ Y (MEMB X (CAR LL)))
(SETQ Y (TAILP X (CAR LL]
(GO LP)))
(GO LP1])
(EDITBF1
[LAMBDA (PAT X LVL TAIL)
(PROG [Y XX (...PAT (AND (LISTP PAT)
(EQ (CAR PAT)
(QUOTE ...]
(AND (LISTP X)
(EQ (CAR X)
CLISPTRANFLG)
(SETQ XX X)
(SETQ X (CDDR X)))
LP [COND
((AND LVL (NOT (IGREATERP LVL 0)))
(PRIN1 (QUOTE "maxlevel exceeded.
")
T)
(RETURN NIL))
((EQ TAIL X)
(RETURN (COND
((AND (NOT ...PAT)
(EDIT4E PAT X))
(* Only compare with X after you have searched inside it, e.g. if backing up
to (COND -- (COND --)) should find inner COND.)
(TCONC FF X]
(SETQ Y X)
LP1 (COND
([NULL (OR (EQ (CDR Y)
TAIL)
(NLISTP (CDR Y]
(* TAIL is where you were last time. Go until you find the tail before it.)
(SETQ Y (CDR Y))
(GO LP1)))
(SETQ TAIL Y) (* Y is a tail of X, TAIL is CDR of
Y.)
(COND
((AND PAT (CDR TAIL)
(NLISTP (CDR TAIL))
(EDIT4E PAT (CDR TAIL))) (* Atomic tail.)
(SETQ TAIL (CDR TAIL)))
((AND ...PAT (EDIT4E (CDR PAT)
(CDR TAIL)))
(SETQ TAIL (CDR TAIL)))
([AND (LISTP (CAR TAIL))
(EDITBF1 PAT (CAR TAIL)
(AND LVL (SUB1 LVL]
(* Descend first before comparing
with outer one.)
(SETQ TAIL (CAR TAIL)))
[(AND (NOT ...PAT)
(EDIT4E PAT (CAR TAIL)))
(COND
((OR (NULL UPFINDFLG)
(LISTP (CAR TAIL)))
(SETQ LASTAIL TAIL)
(SETQ TAIL (CAR TAIL]
(T (AND LVL (SETQ LVL (SUB1 LVL)))
(GO LP)))
(AND XX (EQ TAIL (CDDR XX))
(SETQ TAIL XX))
(COND
([NOT (AND TAIL (EQ TAIL (CADR FF]
(TCONC FF TAIL)))
(RETURN FF])
(EDITNTH
[LAMBDA (X N)
(* If N is non-numeric, EDITELT is called, so that one can give commands
such as (BI COND SETQ) meaning do a BI starting at the element containing
COND up to the one containing SETQ.)
(PROG (TEM)
[COND
((NLISTP X)
(ERROR!))
((EQ (CAR X)
CLISPTRANFLG)
(SETQ X (CDDR X]
(RETURN (COND
((NOT (NUMBERP N))
(* Normally EDITELT returns the element of this level list containing N.
However, if N is atomic and ends with an alt-mode, it will fail the first
FMEMB, and EDITELT will return the tail of the list, so the second MEMB will
fail. This is the reason for the TAILP.)
(OR (MEMB N X)
(MEMB (SETQ N (EDITELT N (LIST X)))
X)
(TAILP N X)))
((ZEROP N)
(ERROR!))
([SETQ TEM (COND
((MINUSP N)
(NLEFT X (IMINUS N)))
(T (NTH X N]
TEM)
(T (SETQ COM N)
(ERROR!])
(BPNT
[LAMBDA (X) (* wt: 14-MAY-76 18 42)
(PROG (Y N Z)
[COND
((ZEROP (CAR X))
(SETQ Y (CAR L))
(SETQ Z (CADR L)))
(T (SETQ Y (CAR (EDITNTH (CAR L)
(CAR X]
[COND
((NULL (CDR X))
(SETQ N 1))
([NULL (NUMBERP (SETQ N (CADR X]
(ERROR!))
((MINUSP N)
(SETQ N (ADD1 N)))
(T (* Makes (P 0 N) have same effect as it did in old
system.)
(SETQ N (SUB1 N]
(RETURN (BPNT0 Y T N (OR (CADDR X)
20)
Z])
(BPNT0
[LAMBDA (X FILE CARLVL CDRLVL TAIL)
(* wt: 11-MAY-76 18 0)
(COND
((NULL (NLSETQ (LVLPRINT X FILE CARLVL CDRLVL TAIL)))
(SETQ COM NIL)
(ERROR!])
(EDIT.RI
[LAMBDA (M N X)
(PROG (A B)
(SETQ A (EDITNTH X M))
(SETQ B (EDITNTH (CAR A)
N))
(COND
((OR (NULL A)
(NULL B))
(ERROR!)))
[PROG ((L (CONS (CAR A)
L)))
(* The only reason for this is so that EDITSMASH will also check (CAR a) for clisp translation.
Note that EDIT.RI is the only command which lets you change something INSIDE of (CAR L) (The R command for xample
is rebinding L as it goes down.))
(MAPC (CDR B)
(FUNCTION EDITSMASH1))
(EDITSMASH1 (CAR A))
(EDITSMASH A (CAR A)
(EDITNCONC (CDR B)
(CDR A]
(EDITSMASH B (CAR B])
(EDIT.RO
[LAMBDA (N X)
(SETQ X (EDITNTH X N))
(COND
((OR (NULL X)
(NLISTP (CAR X)))
(ERROR!)))
(EDITSMASH (SETQ N (LAST (CAR X)))
(CAR N)
(CDR X))
(EDITSMASH X (CAR X))
(EDITSMASH1 (CAR X])
(EDIT.LI
[LAMBDA (N X)
(SETQ X (EDITNTH X N))
(COND
((NULL X)
(ERROR!)))
(EDITSMASH X (CONS (CAR X)
(CDR X)))
(EDITSMASH1 (CAR X))
(EDITSMASH1 (CAR X])
(EDIT.LO
[LAMBDA (N X)
(SETQ X (EDITNTH X N))
(COND
((OR (NULL X)
(NLISTP (CAR X)))
(ERROR!)))
(EDITSMASH X (CAAR X)
(CDAR X))
(MAPC X (FUNCTION EDITSMASH1])
(EDIT.BI
[LAMBDA (M N X) (* lmm "26-JUL-83 20:51")
(PROG (A B)
(OR N (SETQ N M))
[SETQ B (CDR (SETQ A (EDITNTH X N]
(SETQ X (EDITNTH X M))
(COND
((AND A (TAILP A X))
(EDITSMASH A (CAR A))
(EDITSMASH X (CONS (CAR X)
(CDR X))
B)
(EDITSMASH1 (CAR X)))
(T (ERROR!])
(EDIT.BO
[LAMBDA (N X)
(SETQ X (EDITNTH X N))
(COND
((NLISTP (CAR X))
(ERROR!)))
(EDITSMASH X (CAAR X)
(EDITNCONC (CDAR X)
(CDR X)))
(EDITSMASH1 (CAR X])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: EDITBLOCK EDITL EDITL0 EDITL1 UNDOEDITL EDITCOM EDITCOMA EDITCOML EDITMAC EDITCOMS EDIT!UNDO
UNDOEDITCOM UNDOEDITCOM1 EDITCOM1 EDITSMASH EDITSMASH1 EDITNCONC EDITAPPEND EDIT1F EDIT2F
EDITNTH BPNT BPNT0 EDIT.RI EDIT.RO EDIT.LI EDIT.LO EDIT.BI EDIT.BO EDITDEFAULT EDITDEFAULT1
## EDUP EDIT* EDOR EDRPT EDLOC EDLOCL EDIT: EDITMBD EDITXTR EDITELT EDITCONT EDITSW EDITMV
EDITTO EDITBELOW EDITRAN EDITSAVE EDITSAVE1 EDITH (ENTRIES EDITL EDITL0 ## UNDOEDITL BPNT0
EDITCONT EDLOCL)
(SPECVARS L ATM COM LCFLG #1 #2 #3 UNDOLST UNDOLST1 LASTAIL MARKLST UNFIND LASTP1 LASTP2 COMS
EDITCHANGES EDITHIST0 LISPXID)
(RETFNS EDITL0 EDITL1)
(BLKAPPLYFNS EDIT: EDITMBD EDITMV EDITXTR EDITSW)
(BLKLIBRARY NTH LAST MEMB NLEFT)
(NOLINKFNS PRINTDEF EDITRACEFN EDITUSERFN)
(LOCALFREEVARS FINDFLAG EDITHIST UNDOLST1 COM L L0 COM0 UNDOLST EDITLFLG ATM MARKLST
EDITHIST0 UNFIND TYPEIN LCFLG LASTP1 LASTP2 LASTAIL COPYFLG ORIGFLG COMS TOFLG
C LVL EDITCHANGES EDITLISPFLG)
(GLOBALVARS EDITCALLS P.A.STATS EDITUNDOSTATS EDITUNDOSAVES SPELLSTATS1 P.A.STATS EDITUSERFN
EDITIME USERHANDLE DONTSAVEHISTORYCOMS COMPACTHISTORYCOMS EDITEVALSTATS MAXLOOP
EDITCOMSL EDITCOMSA DWIMFLG CLISPTRANFLG EDITOPS HISTORYCOMS REREADFLG HISTSTR3
EDITRDTBL EDITHISTORY HISTSTR0 READBUF LISPXHISTORY LISPXBUFS EDITRACEFN
EDITMACROS USERMACROS CLISPARRAY CHANGESARRAY COMMENTFLG **COMMENT**FLG
EDITESTATS EDITISTATS PRETTYFLG EDITSMASHUSERFN))
(BLOCK: EDITFINDBLOCK EDIT4E EDIT4E1 EDITQF EDIT4F EDITFPAT EDITFPAT1 EDIT4F1 EDIT4F2 EDIT4F3
EDITSMASH EDITSMASH1 EDITFINDP EDITBF EDITBF1 ESUBST
(ENTRIES EDIT4E EDIT4E1 EDITQF EDIT4F EDITFPAT EDITFINDP EDITBF ESUBST)
(LOCALFREEVARS C3 CHANGEFLG N TOPLVL FF NEWFLG FLG)
(GLOBALVARS EDITUNDOSAVES CHCONLST2 EDITQUIETFLG CHCONLST1 MAXLEVEL UPFINDFLG CLISPTRANFLG
CHANGESARRAY CLISPARRAY EDITHISTORY)
(SPECVARS ATM L COM UNFIND LASTAIL UNDOLST1 EDITCHANGES))
(BLOCK: EDITFBLOCK EDITF EDITFA EDITFB EDITV EDITP EDITE (ENTRIES EDITF EDITV EDITP EDITE)
(SPECVARS EDITCHANGES EDITFN)
(NOLINKFNS EDITLOADFNS? LOADFROM)
(GLOBALVARS DWIMFLG DWIMWAIT USERWORDS EDITLOADFNSFLG EDITUNSAVEBLOCKFLG SPELLINGS3 DFNFLG
ADDSPELLFLG))
(BLOCK: NIL ESUBST1 EDITFNS EDITLOADFNS? UNSAVEBLOCK? (GLOBALVARS FILELST FILEPKGFLG DWIMFLG DWIMWAIT
DWIMLOADFNSFLG)
(NOLINKFNS WHEREIS))
]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA EDITP EDITV EDITF EDITFNS ##)
(ADDTOVAR NLAML EDITF2)
(ADDTOVAR LAMA )
)
(PUTPROPS EDIT COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3702 108157 (## 3712 . 4270) (EDIT* 4272 . 4954) (EDIT: 4956 . 6202) (EDITDEFAULT 6204
. 11907) (EDITDEFAULT1 11909 . 12133) (EDITFNS 12135 . 13081) (EDITH 13083 . 16325) (EDITRAN 16327 .
17479) (EDITTO 17481 . 18483) (EDITXTR 18485 . 19465) (EDLOC 19467 . 20632) (EDLOCL 20634 . 20771) (
EDOR 20773 . 21088) (EDRPT 21090 . 21703) (EDUP 21705 . 22679) (ESUBST 22681 . 23427) (ESUBST1 23429
. 23888) (EDITF 23890 . 26263) (EDITFA 26265 . 26976) (EDITFB 26978 . 28932) (EDITLOADFNS? 28934 .
31745) (EDITE 31747 . 34048) (EDITELT 34050 . 34228) (UNSAVEBLOCK? 34230 . 35148) (EDITF1 35150 .
35385) (EDITF2 35387 . 36034) (EDITV 36036 . 37973) (EDITP 37975 . 39096) (EDITL 39098 . 42049) (
EDITL0 42051 . 43658) (EDITL1 43660 . 46322) (EDITL2 46324 . 46651) (UNDOEDITL 46653 . 47199) (EDITCOM
47201 . 48107) (EDITCOMA 48109 . 56129) (EDITCOML 56131 . 63429) (EDITCONT 63431 . 64293) (EDITMAC
64295 . 64588) (EDITMBD 64590 . 65177) (EDITMV 65179 . 67598) (EDITCOMS 67600 . 68157) (EDIT!UNDO
68159 . 68828) (UNDOEDITCOM 68830 . 70134) (UNDOEDITCOM1 70136 . 70808) (EDITCOM1 70810 . 72432) (
EDITSAVE 72434 . 73702) (EDITSAVE1 73704 . 74453) (EDITSMASH 74455 . 76276) (EDITSMASH1 76278 . 77044)
(EDITSW 77046 . 77358) (EDITNCONC 77360 . 77576) (EDITAPPEND 77578 . 78083) (EDIT1F 78085 . 78753) (
EDIT2F 78755 . 81794) (EDIT4E 81796 . 83716) (EDIT4E1 83718 . 86196) (EDITQF 86198 . 86544) (EDIT4F
86546 . 91350) (EDIT4F1 91352 . 95191) (EDIT4F2 95193 . 96658) (EDIT4F3 96660 . 97622) (EDITFPAT 97624
. 98913) (EDITFPAT1 98915 . 100037) (EDITFINDP 100039 . 100413) (FEDITFINDP 100415 . 100623) (
EDITBELOW 100625 . 101468) (EDITBF 101470 . 102466) (EDITBF1 102468 . 104296) (EDITNTH 104298 . 105293
) (BPNT 105295 . 105935) (BPNT0 105937 . 106144) (EDIT.RI 106146 . 106869) (EDIT.RO 106871 . 107129) (
EDIT.LI 107131 . 107340) (EDIT.LO 107342 . 107548) (EDIT.BI 107550 . 107942) (EDIT.BO 107944 . 108155)
))))
STOP