(FILECREATED "22-Jul-86 01:00:56" {ERIS}<LISPCORE>SOURCES>EDIT.;31 169491 

      changes to:  (FNS ED)

      previous date: "20-Jul-86 21:23:15" {ERIS}<LISPCORE>SOURCES>EDIT.;30)


(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved. The following 
program was created in 1983  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 EDITCOMS)

(RPAQQ EDITCOMS 
       [(FNS ## EDIT* EDIT: EDITDEFAULT EDITDEFAULT1 EDITFNS EDITH EDITRAN EDITTO EDITXTR EDLOC 
             EDLOCL EDOR EDRPT EDUP ESUBST ESUBST1 EDITF ED EDITFERROR 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)
        (INITVARS (COMMON-SOURCE-MANAGER-TYPES (QUOTE (FUNCTIONS VARIABLES STRUCTURES TYPES SETFS 
                                                             OPTIMIZERS)))
               (EDITRDTBL (COPYREADTABLE T)))
        (VARS DUMMY-EDIT-FUNCTION-BODY)
        (USERMACROS ED)
        (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 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))
               (NIL EDITF EDITFA EDITFB EDITV EDITP EDITE (SPECVARS EDITCHANGES EDITFN))
               (NIL ESUBST1 EDITFNS EDITLOADFNS? UNSAVEBLOCK? (GLOBALVARS FILELST 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                                            (* lmm " 2-Sep-85 18:45")
    (SETQ EDITFX (NLAMBDA.ARGS EDITFX))
    (EDITDEF (if EDITFX
                 then (PROGN (HASDEF (CAR EDITFX)
                                    (QUOTE FNS)
                                    (QUOTE ?)
                                    EDITFX)
                             (CAR EDITFX))
               else (PROGN (PRIN1 "Editing " T)
                           (PRINT LASTWORD T)))
           (QUOTE FNS)
           NIL
           (CDR EDITFX])

(ED
  [LAMBDA (NAME OPTIONS)                                     (* lmm "21-Jul-86 21:01")
    (PROG ([FROMDISPLAY (OR (EQ OPTIONS T)
                            (EQMEMB OPTIONS (QUOTE DISPLAY]
           [TYPES (COND
                     ((AND (NULL NAME)
                           (SETQ NAME LASTWORD)
                           NIL)                              (* says (ED NIL) simply enters editor 
                                                             in last state, but this really edits 
                                                             LASTWORD instead)
                      (HELP))
                     (T (OR (for X inside OPTIONS when (NEQ X T) bind TYPE
                               when (SETQ TYPE (GETFILEPKGTYPE X (QUOTE TYPES)
                                                      T NAME)) collect TYPE)
                            (for TYPE in FILEPKGTYPES when (AND (LITATOM TYPE)
                                                                (NEQ (GET TYPE (QUOTE EDITDEF))
                                                                     (QUOTE NILL))
                                                                (HASDEF NAME TYPE (QUOTE ?)))
                               collect TYPE]
           TYPE)                                             (* see if the symbol has any 
                                                             interesting properties which we might 
                                                             want to edit)
          [for X on (GETPROPLIST NAME) by (CDDR X) bind PROPTYPES OTHERPROP
             do [LET [(PROPTYPE (GETPROP (CAR X)
                                       (QUOTE PROPTYPE]      (* don't pay attention to IGNORE 
                                                             properties. Otherwise, the PROPTYPE is 
                                                             a definition-type and might be 
                                                             editable)
                     (AND (NEQ PROPTYPE (QUOTE IGNORE))
                          (if PROPTYPE
                              then (pushnew PROPTYPES PROPTYPE)
                            else (SETQ OTHERPROP T] finally (if OTHERPROP
                                                                then (SETQ TYPES (CONS (QUOTE PROPLST
                                                                                              )
                                                                                       TYPES))
                                                              else (SETQ TYPES (UNION TYPES PROPTYPES
                                                                                      ]
          (SETQ TYPE (if (CDR TYPES)
                         then (if FROMDISPLAY
                                  then (OR (MENU (create MENU
                                                        ITEMS ← TYPES
                                                        TITLE ← (CONCAT "Edit which definition of " 
                                                                       NAME)))
                                           (RETURN))
                                else (ASKUSER NIL (CAR TYPES)
                                            (LIST "Edit which " TYPES " definition of " NAME)
                                            TYPES))
                       else (PRINTOUT (if FROMDISPLAY
                                          then PROMPTWINDOW
                                        else T)
                                   "Editing "
                                   (CAR TYPES)
                                   " definition of " NAME T)
                            (CAR TYPES)))
          (if (EQ TYPE (QUOTE PROPLST))
              then (EDITE (GETPROPLIST NAME)
                          NIL NAME (QUOTE PROPLST))
            else (RETURN (EDITDEF NAME TYPE])

(EDITFERROR
  [LAMBDA (FN FLG)                                           (* lmm " 4-Aug-85 01:35")
                                                             (* called when EDITF fails to find a 
                                                             function. FLG is the error message 
                                                             argument -
                                                             different than EDITDEF)
    [if (HASDEF FN (QUOTE MACROS))
        then (PRINTOUT T "Editing macro definition for " FN T)
             (EDITDEF FN (QUOTE MACROS)
                    (QUOTE CURRENT)
                    (if (BOUNDP (QUOTE EDITCOMS))
                        then EDITCOMS))
      elseif [AND (STRINGP FLG)
                  (OR (\DEFINEDP FN)
                      (NOT (EQ (QUOTE Y)
                               (ASKUSER DWIMWAIT (QUOTE N)
                                      (CONCAT "No FNS defn for " FN 
                                             ". Do you wish to edit a dummy definition?"]
        then (ERROR FN FLG T)
      else (PUTDEF FN (QUOTE FNS)
                  (EDITE (COPY DUMMY-EDIT-FUNCTION-BODY)
                         NIL FN (QUOTE FNS]
    (AND (GETD FN)
         (if (STRINGP FLG)
             then (RETFROM (QUOTE EDITF)
                         FN)
           else FN])

(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)                                               (* lmm "28-Sep-84 18:56")
    (PROG [FL TEM [EDITLOADFN (OR (EQ EDITLOADFNSFLG T)
                                  (CAR (LISTP EDITLOADFNSFLG]
              (EDITLOADBLOCK (OR (EQ EDITLOADFNSFLG T)
                                 (CDR (LISTP 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)

          [OR (SETQ FL (EDITLOADFNS? FN (AND (NULL EDITLOADFN)
                                             (QUOTE "not editable, shall I load it from"))
                              (NULL EDITLOADFN)))
              (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 EDITLOADFN)
                                                        (QUOTE "not editable, shall I load it from"))
                                         (NULL EDITLOADFN)
                                         T]
          [COND
             ((NULL FL)
              (RETURN NIL))
             ([CDR (SETQ TEM (SUBSET (GETBLOCKDEC FN FL T)
                                    (FUNCTION (LAMBDA (FN)
                                                (NOT (EXPRP (VIRGINFN FN]
              (AND [NULL (COND
                            ((NULL EDITLOADBLOCK)
                             (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 EDITLOADBLOCK 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)                              (* lmm "28-Sep-84 18:50")
          
          (* 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))
                              FILE DATES FD)
                             (OR (COND
                                    ((EQ FILES T)
          
          (* 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.)

                                     (SETQ LST (LDIFFERENCE LST FILELST)))
                                    (T LST))
                                 (RETURN))
                             [SETQ FILE (COND
                                           ((CDR LST)
                                            (PRIN2 FN T)
                                            (MAPRINT LST T " is contained on " "
" " and ")
                                            (OR (ASKUSER NIL NIL "indicate which file to use: "
                                                       (MAKEKEYLST LST)
                                                       T)
                                                (RETURN)))
                                           (T (CAR LST]
                             [SETQ DATES (LISTP (GETPROP FILE (QUOTE FILEDATES]
          
          (* * only look at file in FILEDATES if the file has been LOADed or LOADFROMd)

                             (SETQ FILE (OR (AND DATES (FMEMB (CDAR (GETPROP FILE (QUOTE FILE)))
                                                              (QUOTE (LOADFNS T)))
                                                 (INFILEP (CDAR DATES)))
                                            (FINDFILE FILE T)
                                            (RETURN)))
                             [COND
                                ((AND DATES (NEQ FILE (CDAR DATES)))
                                                             (* found a different file than in 
                                                             FILEDATES)
                                 (COND
                                    ((EQUAL (CAAR DATES)
                                            (SETQ FD (FILEDATE FILE)))
                                                             (* found a goood version of file on a 
                                                             different name. smash name)
                                     (/RPLACD (CAR DATES)
                                            FILE))
                                    (T (printout T "*** note: " (CDAR DATES)
                                              " dated "
                                              (CAAR DATES)
                                              "isn't current version; " FILE " dated " FD " is." T]
                             (COND
                                ((STREQUAL STR ""))
                                ((NULL ASKFLG)
                                 (if STR
                                     then (LISPXPRIN1 STR T)
                                   else (LISPXPRIN1 "loading definition of " T)
                                        (LISPXPRIN2 FN T)
                                        (LISPXPRIN1 " from " T))
                                 (LISPXPRINT FILE T T))
                                ((NEQ (ASKUSER DWIMWAIT (QUOTE Y)
                                             (LIST FN STR FILE)
                                             NIL T)
                                      (QUOTE Y))
                                 (RETURN)))
                             (RETURN FILE])

(EDITE
  [LAMBDA (EXPR COMS ATM TYPE IFCHANGEDFN)                   (* lmm " 5-Jul-85 10:44")
          
          (* 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 "EDITL returned NIL"]
                    (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)               (* lmm " 4-Jul-85 16:39")
    (AND CHANGES TYPE (PROG ((LISPXHIST (SELECTQ RESETSTATE
                                            ((RESET HARDRESET) 
                                                 NIL)
                                            LISPXHIST)))
                            (SELECTQ TYPE
                                ((PROP FNS) 
                                     (FIXEDITDATE EXPR))
                                NIL)
                            (COND
                               (IFCHANGEDFN (APPLY* IFCHANGEDFN ATM EXPR TYPE (NULL RESETSTATE)))
                               (T (SELECTQ TYPE
                                      (PROPLST NIL)
                                      (PROP (MARKASCHANGED ATM (QUOTE FNS)))
                                      (MARKASCHANGED ATM TYPE])

(EDITV
  [NLAMBDA EDITVX                                            (* lmm " 2-Sep-85 13:17")
    (SETQ EDITVX (NLAMBDA.ARGS EDITVX))
    (LET* [[VAR (OR (CAR EDITVX)
                    (PROGN (PRIN1 "= " T)
                           (PRINT LASTWORD T]
           (FRAME (AND VAR (STKSCAN VAR]
          (if FRAME
              then (EDITE (ENVEVAL VAR FRAME NIL T)
                          (CDR EDITVX)
                          VAR)
            elseif (SETQ VAR (HASDEF VAR (QUOTE VARS)
                                    (QUOTE CURRENT)
                                    T))
              then (EDITDEF VAR (QUOTE VARS)
                          (QUOTE CURRENT)
                          (CDR EDITVX))
            else (ERROR VAR "not editable"])

(EDITP
  [NLAMBDA EDITPX                                            (* lmm "10-Jun-85 17:12")
    (SETQ EDITPX (NLAMBDA.ARGS EDITPX))
    (PROG ((ATM (CAR EDITPX)))
          [COND
             ((AND DWIMFLG (NLISTP (GETPROPLIST ATM)))
              (SETQ ATM (OR (MISSPELLED? ATM 75 USERWORDS NIL NIL (FUNCTION GETPROPLIST))
                            ATM]
          (EDITE (GETPROPLIST ATM)
                 (CDR EDITPX)
                 ATM
                 (QUOTE PROPLST))
          (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)                             (* lmm " 5-Jul-85 10:46")
          
          (* 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.)

    (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)                                (* lmm "27-Jun-85 18:20")
    (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)
                       (FRESHLINE T)                         (* 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)                                        (* lmm " 1-Jul-85 23:42")
    (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 (LITATOM 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 TEM2 (STKPOS (QUOTE ERRORSET)
                                                                -1 TEM2 TEM2))
                                              (COND
                                                 ((NULL TEM2)
                                                  (HELP))
                                                 ((OR (ILESSP (STKNARGS TEM2)
                                                             3)
                                                      (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])
)

(RPAQ? COMMON-SOURCE-MANAGER-TYPES (QUOTE (FUNCTIONS VARIABLES STRUCTURES TYPES SETFS OPTIMIZERS)))

(RPAQ? EDITRDTBL (COPYREADTABLE T))

(RPAQQ DUMMY-EDIT-FUNCTION-BODY [LAMBDA (ARGS ...)
                                       BODY])

(ADDTOVAR USERMACROS [ED NIL (E (ED (COND ((LISTP (##))
                                           (CAR (##)))
                                          (T (##])

(ADDTOVAR EDITCOMSA ED)
[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 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: NIL EDITF EDITFA EDITFB EDITV EDITP EDITE (SPECVARS EDITCHANGES EDITFN))
(BLOCK: NIL ESUBST1 EDITFNS EDITLOADFNS? UNSAVEBLOCK? (GLOBALVARS FILELST 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" T 1983 1984 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (4729 166303 (## 4739 . 5427) (EDIT* 5429 . 6580) (EDIT: 6582 . 8629) (EDITDEFAULT 8631
 . 17737) (EDITDEFAULT1 17739 . 17988) (EDITFNS 17990 . 19635) (EDITH 19637 . 24637) (EDITRAN 24639 . 
27306) (EDITTO 27308 . 28920) (EDITXTR 28922 . 30386) (EDLOC 30388 . 31765) (EDLOCL 31767 . 31967) (
EDOR 31969 . 32388) (EDRPT 32390 . 33255) (EDUP 33257 . 34528) (ESUBST 34530 . 35420) (ESUBST1 35422
 . 36320) (EDITF 36322 . 36893) (ED 36895 . 40999) (EDITFERROR 41001 . 42418) (EDITFA 42420 . 42926) (
EDITFB 42928 . 45742) (EDITLOADFNS? 45744 . 49767) (EDITE 49769 . 53534) (EDITELT 53536 . 53729) (
UNSAVEBLOCK? 53731 . 55716) (EDITF1 55718 . 55922) (EDITF2 55924 . 56819) (EDITV 56821 . 57612) (EDITP
 57614 . 58132) (EDITL 58134 . 62744) (EDITL0 62746 . 64412) (EDITL1 64414 . 68687) (EDITL2 68689 . 
69063) (UNDOEDITL 69065 . 69906) (EDITCOM 69908 . 71223) (EDITCOMA 71225 . 87265) (EDITCOML 87267 . 
101760) (EDITCONT 101762 . 102970) (EDITMAC 102972 . 103361) (EDITMBD 103363 . 104227) (EDITMV 104229
 . 107962) (EDITCOMS 107964 . 108743) (EDIT!UNDO 108745 . 109612) (UNDOEDITCOM 109614 . 111608) (
UNDOEDITCOM1 111610 . 112972) (EDITCOM1 112974 . 115205) (EDITSAVE 115207 . 116978) (EDITSAVE1 116980
 . 118646) (EDITSMASH 118648 . 120810) (EDITSMASH1 120812 . 122466) (EDITSW 122468 . 122828) (
EDITNCONC 122830 . 123116) (EDITAPPEND 123118 . 123623) (EDIT1F 123625 . 124644) (EDIT2F 124646 . 
128829) (EDIT4E 128831 . 131651) (EDIT4E1 131653 . 134866) (EDITQF 134868 . 135490) (EDIT4F 135492 . 
142309) (EDIT4F1 142311 . 148092) (EDIT4F2 148094 . 149817) (EDIT4F3 149819 . 151463) (EDITFPAT 151465
 . 153817) (EDITFPAT1 153819 . 155562) (EDITFINDP 155564 . 156184) (FEDITFINDP 156186 . 156484) (
EDITBELOW 156486 . 157651) (EDITBF 157653 . 158978) (EDITBF1 158980 . 161459) (EDITNTH 161461 . 162829
) (BPNT 162831 . 163695) (BPNT0 163697 . 163911) (EDIT.RI 163913 . 164816) (EDIT.RO 164818 . 165098) (
EDIT.LI 165100 . 165331) (EDIT.LO 165333 . 165558) (EDIT.BI 165560 . 166064) (EDIT.BO 166066 . 166301)
))))
STOP