File psl-1983/3-1/util/zpedit.lsp artifact 8c7739dd3b part of check-in 3af273af29


(!* 
"ZPEDIT contains two packages --
     (1) YPP -- a derivative of the ILISP pretty-printer.
     (2) YEDIT -- a derivative of the ILISP form-oriented editor. ")

(!* 
" YPP -- THE PRETTYPRINTER

PP( LST:list )                        FEXPR
PP1( X:any )                          EXPR
PP-VAL ( X:id )                       EXPR
PP-DEF ( X:id )                       EXPR
SPRINT( X:any COL:number )            EXPR
and others...

")

(FLUID
 '(PP!#PROPS PP!#FLAGS PRINTMACRO COMMENTCOL COMMENTFLG CONTOURFLG PPPRINT))

(FLUID '(!#FILE))

(SETQ PP!#PROPS '(READMACRO PRINTMACRO))

(SETQ PP!#FLAGS '(FLUID GLOBAL))

(SETQ COMMENTCOL 50)

(SETQ COMMENTFLG NIL)

(SETQ CONTOURFLG T)

(!* "Tell the loader we need ZBasic and ZMacro.")

(IMPORTS '(ZBOOT ZBASIC ZMACRO))

(!* "Change the system prettyprint function to use this one.")

(DE PRETTYPRINT (!#X) (PROGN (SPRINT !#X 1) (TERPRI)))

(!* "Tell editor to use SPRINT for PP command.")

(SETQ PPPRINT 'SPRINT)

(PUT 'QUOTE 'PRINTMACRO '!#QUOTE)

(PUT '!* 'PRINTMACRO '!#!*)

(CDF PP (!#L) (PROGN (MAPC !#L (FUNCTION PP1)) (TERPRI) T))

(DF PPL (!#L)
 (PROG (!#FILE)
       (SETQ !#L
             (APPLY (FUNCTION APPEND) (MAPCAR !#L (FUNCTION ADD!#SELF!#REF))))
       (!* "Print the readmacros at the front of the file in a PROGN")
       (!* "#FILE becomes non-nil when printing to files")
       (WRS (SETQ !#FILE (WRS NIL)))
       (COND ((AND !#FILE (MEMQ 'READMACRO PP!#PROPS))
              (PROGN (MAPC !#L (FUNCTION FPP!#READMACRO))
                     (!* "Trick: #FILE is now NIL if readmacros were printed")
                     (COND ((NULL !#FILE)
                            (PROGN (SPRINT ''READMACROS!-LOADED 1)
                                   (PRIN2 ")")))))))
       (MAPC !#L (FUNCTION PP1))))

(!* "SETCHR is only meaningful in the dec slisp, where it is defined")

(CDE SETCHR (CHR FLAGS) NIL)

(DE FPP!#READMACRO (!#A)
 (COND ((GET !#A 'READMACRO)
        (PROGN (!* "Put the readmacros inside a PROGN")
               (COND (!#FILE
                      (PROGN (TERPRI) (PRIN2 "(PROGN") (SETQ !#FILE NIL))))
               (SPRINT (LIST 'SETCHR (LIST 'QUOTE !#A) (SETCHR !#A NIL)) 
2)))))

(DE PP1 (!#EXP)
 (PROG NIL
       (TERPRI)
       (COND ((IDP !#EXP)
              (PROG (!#PROPS !#FLAGS)
                    (SETQ !#PROPS PP!#PROPS)
               LP1  (COND (!#PROPS
                           (PROGN (PP!-PROP !#EXP (CAR !#PROPS))
                                  (SETQ !#PROPS (CDR !#PROPS))
                                  (GO LP1))))
                    (SETQ !#FLAGS PP!#FLAGS)
               LP2  (COND (!#FLAGS
                           (PROGN (PP!-FLAG !#EXP (CAR !#FLAGS))
                                  (SETQ !#FLAGS (CDR !#FLAGS))
                                  (GO LP2))))
                    (PP!-VAL !#EXP)
                    (PP!-DEF !#EXP)))
             (T (PROGN (SPRINT !#EXP 1) (TERPRI))))))

(DE PP!-VAL (!#ID)
 (PROG (!#VAL)
       (COND ((ATOM (SETQ !#VAL (ERRORSET !#ID NIL NIL))) (RETURN NIL)))
       (TERPRI)
       (PRIN2 "(SETQ ")
       (PRIN1 !#ID)
       (S2PRINT " '" (CAR !#VAL))
       (PRIN2 ")")
       (TERPRI)))

(DE PP!-DEF (!#ID)
 (PROG (!#DEF !#TYPE ORIG!#DEF)
       (SETQ !#DEF (GETD !#ID))
  TEST (COND ((NULL !#DEF)
              (RETURN
               (AND ORIG!#DEF
                    (WARNING
                     (LIST "Gack. " !#ID " has no unbroken definition.")))))
             ((ATOM !#DEF)
              (RETURN (WARNING (LIST "Bad definition for " !#ID " : " !#DEF))))
             ((CODEP (CDR !#DEF))
              (RETURN (WARNING (LIST "Can't PP compiled def for " !#ID))))
             ((NOT (AND (CDR !#DEF)
                        (EQ (CADR !#DEF) 'LAMBDA)
                        (CDDR !#DEF)
                        (CDDDR !#DEF)
                        (NULL (CDDDDR !#DEF))))
              (WARNING (LIST !#ID " has ill-formed definition.")))
             ((AND (NOT ORIG!#DEF) (BROKEN !#ID))
              (PROGN (WARNING (LIST "Note: " !#ID " is broken or traced."))
                     (SETQ ORIG!#DEF !#DEF)
                     (SETQ !#DEF (GET!#GOOD!#DEF !#ID))
                     (GO TEST))))
       (SETQ !#TYPE (CAR !#DEF))
       (TERPRI)
       (COND ((EQ !#TYPE 'EXPR) (PRIN2 "(DE "))
             ((EQ !#TYPE 'FEXPR) (PRIN2 "(DF "))
             ((EQ !#TYPE 'MACRO) (PRIN2 "(DM "))
             (T (RETURN (WARNING (LIST "Bad fntype for " !#ID " : " !#TYPE)))))
       (PRIN1 !#ID)
       (PRIN2 " ")
       (PRIN1 (CADDR !#DEF))
       (MAPC (CDDDR !#DEF) (FUNCTION (LAMBDA (!#X) (S2PRINT " " !#X))))
       (PRIN2 ")")
       (TERPRI)))

(DE BROKEN (!#X) (GET !#X 'TRACE))

(DE GET!#GOOD!#DEF (!#X)
 (PROG (!#XX!#)
       (COND ((AND (SETQ !#XX!# (GET !#X 'TRACE))
                   (IDP (SETQ !#XX!# (CDR !#XX!#))))
              (RETURN (GETD !#XX!#))))))

(DE PP!-PROP (!#ID !#PROP)
 (PROG (!#VAL)
       (COND ((NULL (SETQ !#VAL (GET !#ID !#PROP))) (RETURN NIL)))
       (TERPRI)
       (PRIN2 "(PUT '")
       (PRIN1 !#ID)
       (PRIN2 " '")
       (PRIN1 !#PROP)
       (S2PRINT " '" !#VAL)
       (PRIN2 ")")
       (TERPRI)))

(DE PP!-FLAG (!#ID !#FLAG)
 (PROG NIL
       (COND ((NULL (FLAGP !#ID !#FLAG)) (RETURN NIL)))
       (TERPRI)
       (PRIN2 "(FLAG '(")
       (PRIN1 !#ID)
       (PRIN2 ") '")
       (PRIN1 !#FLAG)
       (PRIN2 ")")
       (TERPRI)))

(DE ADD!#SELF!#REF (!#ID)
 (PROG (!#L)
       (COND ((NOT (MEMQ !#ID (SETQ !#L (EVAL !#ID))))
              (PROGN (RPLACD !#L (CONS (CAR !#L) (CDR !#L)))
                     (RPLACA !#L !#ID))))
       (RETURN !#L)))

(!* "S2PRINT: prin2 a string and then sprint an expression.")

(DE S2PRINT (!#S !#EXP)
 (PROGN
  (OR (GREATERP (SPACES!#LEFT) (PLUS (FLATSIZE2 !#S) (FLATSIZE !#EXP)))
      (TERPRI))
  (PRIN2 !#S)
  (SPRINT !#EXP (ADD1 (POSN)))))

(DE SPRINT (!#EXP LEFT!#MARGIN)
 (PROG (ORIGINAL!#SPACE NEW!#SPACE CAR!#EXP P!#MACRO CADR!#MARGIN ELT!#MARGIN
        LBL!#MARGIN !#SIZE)
       (COND ((ATOM !#EXP)
              (PROGN (SAFE!#PPOS LEFT!#MARGIN (FLATSIZE !#EXP))
                     (RETURN (PRIN1 !#EXP)))))
       (PPOS LEFT!#MARGIN)
       (SETQ LEFT!#MARGIN (ADD1 LEFT!#MARGIN))
       (SETQ ORIGINAL!#SPACE (SPACES!#LEFT))
       (COND ((PAIRP (SETQ CAR!#EXP (CAR !#EXP)))
              (PROGN (PRIN2 "(") (SPRINT CAR!#EXP LEFT!#MARGIN)))
             ((AND (IDP CAR!#EXP) (SETQ P!#MACRO (GET CAR!#EXP 'PRINTMACRO)))
              (COND ((STRINGP P!#MACRO)
                     (PROGN (SAFE!#PPOS (POSN1) (FLATSIZE2 P!#MACRO))
                            (PRIN2 P!#MACRO)
                            (RETURN
                             (AND (CDR !#EXP) (SPRINT (CADR !#EXP) (POSN1))))))
                    (T (PROGN (SETQ PRINTMACRO NIL)
                              (SETQ !#EXP (APPLY P!#MACRO (LIST !#EXP)))
                              (COND ((NULL PRINTMACRO) (RETURN NIL))
                                    ((ATOM PRINTMACRO)
                                     (PROGN (SETQ CAR!#EXP PRINTMACRO)
                                            (PRIN2 "(")
                                            (SPRINT (CAR !#EXP) LEFT!#MARGIN)))
                                    (T (PROGN
                                        (SETQ CADR!#MARGIN
                                              (SETQ ELT!#MARGIN
                                                    (CDR PRINTMACRO)))
                                        (SETQ LBL!#MARGIN
                                              (COND ((EQ
                                                      (CAR PRINTMACRO)
                                                      'PROG)
                                                     LEFT!#MARGIN)
                                                    (T CADR!#MARGIN)))
                                        (GO B))))))))
             (T (PROGN (PRIN2 "(")
                       (SAFE!#PPOS (POSN1) (FLATSIZE CAR!#EXP))
                       (PRIN1 CAR!#EXP))))
       (COND ((ATOM (SETQ !#EXP (CDR !#EXP))) (GO C)))
       (SETQ CADR!#MARGIN (POSN2))
       (SETQ NEW!#SPACE (SPACES!#LEFT))
       (SETQ !#SIZE (PPFLATSIZE CAR!#EXP))
       (COND ((NOT (LESSP !#SIZE ORIGINAL!#SPACE))
              (SETQ CADR!#MARGIN
                    (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
             ((EQ CAR!#EXP '!*)
              (PROGN
               (SETQ LEFT!#MARGIN (SETQ CADR!#MARGIN (PLUS LEFT!#MARGIN 
2)))           (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN NIL))))
             ((OR (LESSP (PPFLATSIZE !#EXP) NEW!#SPACE)
                  (PROG (!#E1)
                        (SETQ !#E1 !#EXP)
                   LP   (COND ((PAIRP (CAR !#E1)) (RETURN NIL))
                              ((ATOM (SETQ !#E1 (CDR !#E1))) (RETURN T))
                              (T (GO LP)))))
              (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN NIL)))
             ((LESSP NEW!#SPACE 24)
              (PROGN
               (COND ((NOT (AND (MEMQ CAR!#EXP
                                      '(SETQ LAMBDA PROG SELECTQ SET))
                                (LESSP (PPFLATSIZE (CAR !#EXP)) NEW!#SPACE)))
                      (SETQ CADR!#MARGIN LEFT!#MARGIN)))
               (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
             ((EQ CAR!#EXP 'LAMBDA)
              (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN)))
             ((EQ CAR!#EXP 'PROG)
              (PROGN (SETQ ELT!#MARGIN CADR!#MARGIN)
                     (SETQ LBL!#MARGIN LEFT!#MARGIN)))
             ((OR (GREATERP !#SIZE 14)
                  (AND (GREATERP !#SIZE 4)
                       (NOT (LESSP (PPFLATSIZE (CAR !#EXP)) NEW!#SPACE))))
              (SETQ CADR!#MARGIN
                    (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
             (T (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN CADR!#MARGIN))))
       (COND ((ATOM (SETQ CAR!#EXP (CAR !#EXP)))
              (PROGN (SAFE!#PPOS CADR!#MARGIN (PPFLATSIZE CAR!#EXP))
                     (PRIN1 CAR!#EXP)))
             (T (SPRINT CAR!#EXP CADR!#MARGIN)))
  A    (COND ((ATOM (SETQ !#EXP (CDR !#EXP))) (GO C)))
  B    (SETQ CAR!#EXP (CAR !#EXP))
       (COND ((ATOM CAR!#EXP)
              (PROGN (SETQ !#SIZE (PPFLATSIZE CAR!#EXP))
                     (COND (LBL!#MARGIN (SAFE!#PPOS LBL!#MARGIN !#SIZE))
                           ((LESSP !#SIZE (SPACES!#LEFT)) (PRIN2 " "))
                           (T (SAFE!#PPOS LEFT!#MARGIN !#SIZE)))
                     (PRIN1 CAR!#EXP)))
             (T (SPRINT CAR!#EXP (COND (ELT!#MARGIN ELT!#MARGIN) (T (POSN2)))))
        )
       (GO A)
  C    (COND (!#EXP
              (PROGN (COND ((LESSP (SPACES!#LEFT) 3) (PPOS LEFT!#MARGIN)))
                     (PRIN2 " . ")
                     (SETQ !#SIZE (PPFLATSIZE !#EXP))
                     (COND ((GREATERP !#SIZE (SPACES!#LEFT))
                            (SAFE!#PPOS LEFT!#MARGIN !#SIZE)))
                     (PRIN1 !#EXP))))
       (COND ((LESSP (SPACES!#LEFT) 1) (PPOS LEFT!#MARGIN)))
       (PRIN2 ")")))

(DE SPRIN1 (!#EXP !#C1 !#C2)
 (PROG (!#ROOM)
       (SETQ !#ROOM (DIFFERENCE (LINELENGTH NIL) !#C1))
       (COND ((GREATERP (PLUS (FLATSIZE !#EXP) 3) !#ROOM)
              (COND ((NULL (STRINGP !#EXP)) (SPRINT !#EXP !#C2))
                    ((FIRSTLINE!-FITS !#EXP !#ROOM)
                     (PROGN (PPOS !#C1) (PRIN1 !#EXP)))
                    (T (PROGN (TERPRI) (PRIN1 !#EXP)))))
             (T (SPRINT !#EXP !#C1)))))

(DE SPRINL (!#EXP !#C1 !#C2)
 (PROG (!#SIZE)
       (COND ((ATOM !#EXP) (RETURN (SPRIN1 !#EXP !#C1 !#C2)))
             (T (PROGN (PPOS !#C1) (PRIN2 "("))))
  A    (SPRIN1 (CAR !#EXP) (ADD1 !#C1) !#C2)
       (COND ((NULL (SETQ !#EXP (CDR !#EXP)))
              (PROGN (COND ((LESSP (SPACES!#LEFT) 1) (PPOS !#C2)))
                     (RETURN (PRIN2 ")"))))
             ((ATOM !#EXP)
              (PROGN (COND ((LESSP (SPACES!#LEFT) 3) (PPOS !#C1)))
                     (PRIN2 " . ")
                     (SETQ !#SIZE (ADD1 (PPFLATSIZE !#EXP)))
                     (COND ((GREATERP !#SIZE (SPACES!#LEFT))
                            (SAFE!#PPOS !#C1 !#SIZE)))
                     (PRIN1 !#EXP)
                     (PRIN2 ")")))
             (T (PROGN (SETQ !#C1 (POSN1)) (GO A))))))

(DE !#QUOTE (!#L)
  (!#QUOTES !#L "'"))

(DE !#QUOTES (!#L !#CH)
 (PROG (!#N)
       (COND ((ATOM (CDR !#L))
	      (PROGN (SETQ !#N (POSN1)) (SPRINL !#L !#N (PLUS !#N 3))))
	     (T (PROGN (PRIN2 !#CH)
		       (SETQ !#N (POSN1))
		       (SPRIN1 (CADR !#L) !#N !#N))))))

(!* "Addition for PSL, backquote and friends.")

(PUT 'BACKQUOTE 'PRINTMACRO '!#BACKQUOTE)

(DE !#BACKQUOTE (!#L)
  (!#QUOTES !#L "`"))

(PUT 'UNQUOTE 'PRINTMACRO '!#UNQUOTE)

(DE !#UNQUOTE (!#L)
  (!#QUOTES !#L ","))

(PUT 'UNQUOTEL 'PRINTMACRO '!#UNQUOTEL)

(DE !#UNQUOTEL (!#L)
  (!#QUOTES !#L ",@"))

(PUT 'UNQUOTED 'PRINTMACRO '!#UNQUOTED)

(DE !#UNQUOTED (!#L)
  (!#QUOTES !#L ",."))

(DE !#!* (!#L)
 (PROG (!#F !#N)
       (COND ((ATOM (CDR !#L))
              (RETURN (SPRINL !#L (SETQ !#N (POSN1)) (PLUS !#N 3)))))
       (!* COND ((EQ (CADR !#L) 'E) (EVAL (CADDR !#L))))
       (WRS (SETQ !#F (WRS NIL)))
       (COND ((OR !#F COMMENTFLG)
              (SPRINL !#L
                      (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
                      (PLUS (COND (CONTOURFLG (POSN1)) (T COMMENTCOL)) 
3)))         (T (PRIN2 "(* ...)")))))

(!* DE SPRINL (!#EXP !#C1 !#C2)
   (PROG NIL
         (COND ((ATOM !#EXP) (RETURN (SPRIN1 !#EXP !#C1 !#C2)))
               (T (PROGN (PPOS !#C1) (PRIN2 "("))))
    A    (SPRIN1 (CAR !#EXP) (ADD1 !#C1) !#C2)
         (COND ((NULL (SETQ !#EXP (CDR !#EXP)))
                (PROGN (COND ((LESSP (SPACES!#LEFT) 1) (PPOS !#C2)))
                       (RETURN (PRIN2 ")"))))
               (T (PROGN (SETQ !#C1 (POSN1)) (GO A))))))

(!* DE !#QUOTE (!#L)
   (PROG (!#N)
         (COND ((NUMBERP (CADR !#L))
                (SPRINL !#L (SETQ !#N (POSN1)) (PLUS !#N 3)))
               (T (PROGN (PRIN2 "'")
                         (SETQ !#N (POSN1))
                         (SPRIN1 (CADR !#L) !#N !#N))))))

(!* DE !#!* (!#L)
   (PROG (!#F)
         (COND ((EQ (CADR !#L) 'E) (EVAL (CADDR !#L))))
         (WRS (SETQ !#F (WRS NIL)))
         (COND ((OR !#F COMMENTFLG)
                (SPRINL !#L
                        (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
                        (PLUS (COND (CONTOURFLG (POSN1)) (T COMMENTCOL)) 
3)))           (T (PRIN2 "(* ...)")))))

(DE PRINCOMMA (!#LIST FIRST!#COL)
 (COND (!#LIST
        (PROGN (PRIN2 (CAR !#LIST))
               (MAPC (CDR !#LIST)
                     (FUNCTION
                      (LAMBDA (ELT)
                       (PROGN (PRIN2 ", ")
                              (COND ((LESSP (SPACES!#LEFT)
                                            (PLUS 2 (FLATSIZE2 ELT)))
                                     (PROGN (TERPRI) (PPOS FIRST!#COL))))
                              (PRIN2 ELT)))))
               (PRIN2 ".")))))

(CDE CHRCT NIL (DIFFERENCE (MIN 80 (LINELENGTH NIL)) (POSN)))

(DE SPACES!#LEFT NIL (SUB1 (CHRCT)))

(DE SAFE!#PPOS (!#N !#SIZE)
 (PROG (MIN!#N)
       (SETQ MIN!#N (SUB1 (DIFFERENCE (LINELENGTH NIL) !#SIZE)))
       (COND ((LESSP MIN!#N !#N)
              (PROGN (OR (GREATERP MIN!#N (POSN1)) (TERPRI)) (PPOS MIN!#N)))
             (T (PPOS !#N)))))

(DE PPFLATSIZE (!#EXP) (DIFFERENCE (FLATSIZE !#EXP) (PP!#SAVINGS !#EXP)))

(DE PP!#SAVINGS (Y)
 (PROG (N)
       (COND ((ATOM Y) (RETURN 0))
             ((AND (EQ (CAR Y) 'QUOTE) (CDR Y) (NOT (NUMBERP (CADR Y))))
              (RETURN (PLUS 7 (PP!#SAVINGS (CDR Y))))))
       (SETQ N 0)
  LP   (COND ((ATOM Y) (RETURN N)))
       (SETQ N (PLUS N (PP!#SAVINGS (CAR Y))))
       (SETQ Y (CDR Y))
       (GO LP)))

(DE FIRSTLINE!-FITS (!#STR !#N)
 (PROG (!#BIG)
       (!* "This addition is an empirical hack")
       (SETQ !#N (PLUS2 !#N 2))
       (SETQ !#BIG (EXPLODE !#STR))
  LP   (COND ((EQ (CAR !#BIG) !$EOL!$) (RETURN T))
             ((NULL (SETQ !#BIG (CDR !#BIG))) (RETURN T))
             ((ZEROP (SETQ !#N (SUB1 !#N))) (RETURN NIL)))
       (GO LP)))

(DE POSN1 NIL (ADD1 (POSN)))

(DE POSN2 NIL (PLUS 2 (POSN)))

(DE PPOS (N)
 (PROG NIL
       (OR (GREATERP N (POSN)) (TERPRI))
       (SETQ N (SUB1 N))
  LOOP (COND ((LESSP (POSN) N) (PROGN (PRIN2 " ") (GO LOOP))))))

(!* " YEDIT -- THE EDITOR "

" Originally from ilisp editor -- see zedit.doc for evolution.

EDITF (X)                 FEXPR
EDITFNS (X)               FEXPR
EDITV (X)                 FEXPR
EDITP (X)                 FEXPR
EDITE (EXPR COMS ATM)     EXPR

")

(!* "Due to deficiency in standard-lisp")

(GLOBAL '(!#SELECTQ G!:SHOW!:ERRORS G!:SHOW!:TRACE))

(!* "G!:EDIT!:ERRORS and G!:EDIT!:TRACE switch editor errorset args on/off")

(GLOBAL '(G!:EDIT!:ERRORS G!:EDIT!:TRACE))

(!* " Global to editor")

(FLUID
 '(F!:E!#LOOKDPTH F!:E!#TRACEFLG F!:E!#LAST!#ID F!:E!#MAXLEVEL F!:E!#UPFINDFLG
   F!:E!#MAXLOOP F!:E!#EDITCOMSL F!:E!#USERMACROS F!:E!#MACROS F!:E!#OPS
   F!:E!#MAX!#PLENGTH))

(!* " Fluid in editor, but initialized to non-NIL at top level")

(FLUID '(F!:E!#DEPTH))

(!* " Fluid in editor ")

(FLUID
 '(F!:E!#LOCLST F!:E!#LOCLST!#0 F!:E!#MARKLST F!:E!#UNDOLST F!:E!#UNDOLST!#1
   F!:E!#OLDPROMPT F!:E!#ID F!:E!#INBUF F!:E!#CMD F!:E!#UNFIND F!:E!#FINDFLAG
   F!:E!#COM0 F!:E!#TOPFLG F!:E!#COPYFLG F!:E!#LASTP1 F!:E!#LASTP2 F!:E!#LCFLG
   F!:E!#LASTAIL F!:E!#SN F!:E!#TOFLG F!:E!#1 F!:E!#2 F!:E!#3))

(!* 
"EDITLINEREAD():list            EXPR
    ------------
    Prints a supplementary prompt before the READ generated prompt.
    Reads a line of input containing a series of LISP expressions.
    But the several expressions on the line must be separated by
    spaces or commas and terminated with a bare CR.  ")

(FLUID '(PROMPTSTRING!*))

(DE EDITLINEREAD NIL
 (PROG (!#NEXT !#RES PROMPTSTRING!*)
       (!* "PromptString!* for PSL (EAB 2:08am  Friday, 6 November 1981)")
       (SETQ PROMPTSTRING!* "-E- ")
       (!* (PRIN2 "-E-"))
       (TERPRI)
  LOOP (SETQ !#RES (NCONC !#RES (LIST (READ))))
       (COND ((NOT (MEMQ (SETQ !#NEXT (READCH)) '(!, ! ))) (RETURN !#RES))
             (T (GO LOOP)))))

(DM EDIT!#!# (!#X) (LIST 'EDIT!#!#DE (MKQUOTE (CDR !#X))))

(DE EDIT!#!#DE (!#COMS)
 ((LAMBDA (F!:E!#LOCLST F!:E!#UNDOLST!#1) (EDITCOMS !#COMS)) F!:E!#LOCLST 
NIL))

(DF EDITFNS (!#X)
 (PROG (!#Y)
       (SETQ !#Y (EVAL (CAR !#X)))
  LP   (COND ((NULL !#Y) (RETURN NIL)))
       (ERRORSET (CONS 'EDITF (CONS (PRIN1 (CAR !#Y)) (CDR !#X)))
                 G!:EDIT!:ERRORS
                 G!:EDIT!:TRACE)
       (SETQ !#Y (CDR !#Y))
       (GO LP)))

(DF EDITF (!#X)
 (PROG (!#Y !#FN)
       (COND ((NULL !#X)
              (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
       (COND ((IDP (CAR !#X))
              (PROGN
               (COND ((SETQ !#Y (GET (SETQ !#FN (CAR !#X)) 'TRACE))
                      (SETQ !#FN (CDR !#Y))))
               (COND ((SETQ !#Y (GETD !#FN))
                      (PROGN (RPLACD !#Y
                                     (EDITE (CDR !#Y) (CDR !#X) (CAR !#X)))
                             (RETURN (SETQ F!:E!#LAST!#ID (CAR !#X)))))
                     ((AND (SETQ !#Y (GET !#FN 'VALUE)) (PAIRP (CDR !#Y)))
                      (GO L1)))))
             ((PAIRP (CAR !#X)) (GO L1)))
       (PRIN1 (CAR !#X))
       (PRIN2 " not editable.")
       (ERROR NIL NIL)
  L1   (PRINT2 "=EDITV")
       (RETURN (EVAL (CONS 'EDITV !#X)))))

(DF EDITV (!#X)
 (PROG (!#Y)
       (COND ((NULL !#X)
              (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
       (COND ((PAIRP (CAR !#X))
              (PROGN (EDITE (EVAL (CAR !#X)) (CDR !#X) NIL) (RETURN T)))
             ((AND (IDP (CAR !#X))
                   (PAIRP (ERRORSET (CAR !#X) G!:EDIT!:ERRORS G!:EDIT!:TRACE)))
              (PROGN
               (SET (CAR !#X) (EDITE (EVAL (CAR !#X)) (CDR !#X) (CAR !#X)))
               (RETURN (SETQ F!:E!#LAST!#ID (CAR !#X)))))
             (T (PROGN (TERPRI)
                       (PRIN1 (CAR !#X))
                       (PRIN2 " not editable")
                       (ERROR NIL NIL))))))

(!* "For PSL, the BREAK function uses an EXPR, EDIT.  I don't know how else
to edit a form but to call the FEXPR EDITV.")

(FLUID '(EDIT!:FORM))

(DE EDIT (EDIT!:FORM)
  (PROGN (EDITV EDIT!:FORM)
         EDIT!:FORM))

(DF EDITP (!#X)
 (PROGN
  (COND ((NULL !#X)
         (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
  (COND ((PAIRP (CAR !#X)) (PROGN (PRIN2 "=EDITV") (EVAL (CONS 'EDITV !#X))))
        ((IDP (CAR !#X))
         (PROGN (!* "For PSL, changed (CDAR !#X) to (PROP (CAR !#X))")
		(EDITE (PROP (CAR !#X)) (CDR !#X) (CAR !#X))
		(SETQ F!:E!#LAST!#ID (CAR !#X))))
        (T (PROGN (TERPRI)
                  (PRIN1 (CAR !#X))
                  (PRIN2 " not editable.")
                  (ERROR NIL NIL))))))

(DE EDITE (!#EXPR !#COMS !#ATM)
 (COND ((NULL (PAIRP !#EXPR))
        (PROGN (PRINT !#EXPR) (PRIN2 " not editable.") (ERROR NIL NIL)))
       (T (CAR (LAST (EDITL (LIST !#EXPR) !#COMS !#ATM NIL NIL))))))

(DE EDITL (F!:E!#LOCLST !#COMS !#ATM F!:E!#MARKLST !#MESS)
 (PROG (F!:E!#CMD F!:E!#LASTAIL F!:E!#UNDOLST F!:E!#UNDOLST!#1 F!:E!#FINDFLAG
        F!:E!#LCFLG F!:E!#UNFIND F!:E!#LASTP1 F!:E!#LASTP2 F!:E!#INBUF
        F!:E!#LOCLST!#0 F!:E!#COM0 F!:E!#OLDPROMPT)
       (SETQ F!:E!#LOCLST
             (ERRORSET
              (LIST 'EDITL0
                    (ADD1 F!:E!#DEPTH)
                    (MKQUOTE !#COMS)
                    (MKQUOTE !#MESS)
                    (MKQUOTE !#ATM))
              G!:EDIT!:ERRORS
              G!:EDIT!:TRACE))
       (COND ((PAIRP F!:E!#LOCLST) (RETURN (CAR F!:E!#LOCLST)))
             (T (ERROR NIL NIL)))))

(DE EDITL0 (F!:E!#DEPTH !#COMS !#MESS F!:E!#ID)
 (PROG (!#RES)
       (COND ((NULL !#COMS) NIL)
             ((EQ (CAR !#COMS) 'START) (SETQ F!:E!#INBUF (CDR !#COMS)))
             ((PAIRP
               (ERRORSET (LIST 'EDIT1 (MKQUOTE !#COMS))
                         G!:EDIT!:ERRORS
                         G!:EDIT!:TRACE))
              (RETURN F!:E!#LOCLST))
             (T (ERROR NIL NIL)))
       (TERPRI)
       (PRINT2 (OR !#MESS "EDIT"))
       (COND ((OR (EQ (CAR F!:E!#LOCLST)
                      (CAR (LAST (CAR (COND ((SETQ F!:E!#CMD
                                                   (GET 'EDIT 'LASTVALUE))
                                             F!:E!#CMD)
                                            (T '((NIL))))))))
                  (AND F!:E!#ID
                       (EQ (CAR F!:E!#LOCLST)
                           (CAR (LAST (CAR (COND ((SETQ F!:E!#CMD
                                                        (GET
                                                         F!:E!#ID
                                                         'EDIT!-SAVE))
                                                  F!:E!#CMD)
                                                 (T '((NIL))))))))))
              (PROGN (SETQ F!:E!#LOCLST (CAR F!:E!#CMD))
                     (SETQ F!:E!#MARKLST (CADR F!:E!#CMD))
                     (SETQ F!:E!#UNDOLST (CADDR F!:E!#CMD))
                     (COND ((CAR F!:E!#UNDOLST)
                            (SETQ F!:E!#UNDOLST (CONS NIL F!:E!#UNDOLST))))
                     (SETQ F!:E!#UNFIND (CDDDR F!:E!#CMD)))))
  LP   (SETQ !#RES (ERRORSET '(EDITL1) G!:EDIT!:ERRORS G!:EDIT!:TRACE))
       (COND ((EQ !#RES 'OK) (RETURN F!:E!#LOCLST))
             ((EQ !#RES 'STOP) (ERROR 'STOP NIL))
             (T (GO LP)))))

(DE EDIT1 (!#COMS)
 (PROG (!#X)
       (SETQ !#X !#COMS)
  L1   (COND ((NULL !#X) (RETURN NIL)))
       (EDITCOM (SETQ F!:E!#CMD (CAR !#X)) NIL)
       (SETQ !#X (CDR !#X))
       (GO L1)))

(DE EDITVAL (!#X)
 (PROG (!#RES)
       (SETQ !#RES (ERRORSET !#X G!:EDIT!:ERRORS G!:EDIT!:TRACE))
       (AND !#RES (ATOM !#RES) (ERROR !#RES NIL))
       (RETURN !#RES)))

(DE EDITL1 NIL
 (PROG (!#RES)
  CT   (SETQ F!:E!#FINDFLAG NIL)
       (COND ((NULL F!:E!#OLDPROMPT)
              (SETQ F!:E!#OLDPROMPT (CONS F!:E!#DEPTH '!#))))
  A    (SETQ F!:E!#UNDOLST!#1 NIL)
       (SETQ F!:E!#CMD (EDITREAD))
       (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
       (SETQ F!:E!#COM0
             (COND ((ATOM F!:E!#CMD) F!:E!#CMD) (T (CAR F!:E!#CMD))))
       (SETQ !#RES
             (ERRORSET (LIST 'EDITCOM (MKQUOTE F!:E!#CMD) T)
                       G!:EDIT!:ERRORS
                       G!:EDIT!:TRACE))
       (COND ((EQ !#RES 'OK) (ERROR 'OK NIL))
             ((EQ !#RES 'STOP) (ERROR 'STOP NIL))
             (F!:E!#UNDOLST!#1
              (PROGN
               (SETQ F!:E!#UNDOLST!#1
                     (CONS F!:E!#COM0 (CONS F!:E!#LOCLST!#0 F!:E!#UNDOLST!#1)))
               (SETQ F!:E!#UNDOLST (CONS F!:E!#UNDOLST!#1 F!:E!#UNDOLST)))))
       (COND ((PAIRP !#RES) (GO A)))
       (SETQ F!:E!#INBUF NIL)
       (TERPRI)
       (COND (F!:E!#CMD (PROGN (PRIN1 F!:E!#CMD) (PRIN2 "  ?"))))
       (GO CT)))

(DE EDITREAD NIL
 (PROG (!#X)
       (COND ((NULL F!:E!#INBUF)
              (PROG NIL
               LP   (TERPRI)
                    (COND ((NOT (EQUAL (CAR F!:E!#OLDPROMPT) 0))
                           (PRIN2 (CAR F!:E!#OLDPROMPT))))
                    (SETQ F!:E!#INBUF
                          (ERRORSET '(EDITLINEREAD)
                                    G!:EDIT!:ERRORS
                                    G!:EDIT!:TRACE))
                    (COND ((ATOM F!:E!#INBUF) (PROGN (TERPRI) (GO LP))))
                    (SETQ F!:E!#INBUF (CAR F!:E!#INBUF)))))
       (SETQ !#X (CAR F!:E!#INBUF))
       (SETQ F!:E!#INBUF (CDR F!:E!#INBUF))
       (RETURN !#X)))

(DE EDITCOM (!#CMD F!:E!#TOPFLG)
 (PROGN (SETQ F!:E!#CMD !#CMD)
        (COND (F!:E!#TRACEFLG (EDITRACEFN !#CMD)))
        (COND (F!:E!#FINDFLAG
               (COND ((EQ F!:E!#FINDFLAG 'BF)
                      (PROGN (SETQ F!:E!#FINDFLAG NIL) (EDITBF !#CMD NIL)))
                     (T (PROGN (SETQ F!:E!#FINDFLAG NIL) (EDITQF !#CMD)))))
              ((NUMBERP !#CMD)
               (SETQ F!:E!#LOCLST (EDIT1F !#CMD F!:E!#LOCLST)))
              ((ATOM !#CMD) (EDITCOMA !#CMD (NULL F!:E!#TOPFLG)))
              (T (EDITCOML !#CMD (NULL F!:E!#TOPFLG))))
        (CAR F!:E!#LOCLST)))

(DE EDITCOMA (!#CMD F!:E!#COPYFLG)
 (PROG (!#TEM)
       (SELECTQ !#CMD
                (NIL NIL)
                (OK (COND (F!:E!#ID (REMPROP F!:E!#ID 'EDIT!-SAVE)))
                    (PUT 'EDIT
                         'LASTVALUE
                         (CONS (LAST F!:E!#LOCLST)
                               (CONS F!:E!#MARKLST
                                     (CONS F!:E!#UNDOLST F!:E!#LOCLST))))
                    (ERROR 'OK NIL))
                (STOP (ERROR 'STOP NIL))
                (SAVE (COND (F!:E!#ID
                             (PUT 'EDIT
                                  'LASTVALUE
                                  (PUT F!:E!#ID
                                       'EDIT!-SAVE
                                       (CONS F!:E!#LOCLST
                                             (CONS F!:E!#MARKLST
                                                   (CONS F!:E!#UNDOLST
                                                    F!:E!#UNFIND)))))))
                      (ERROR 'OK NIL))
                (TTY!: (SETQ F!:E!#CMD F!:E!#COM0)
                       (SETQ F!:E!#LOCLST
                             (EDITL F!:E!#LOCLST NIL NIL NIL 'TTY!:)))
                (E (COND (F!:E!#TOPFLG
                          (COND ((PAIRP (SETQ !#TEM (EDITVAL (EDITREAD))))
                                 (EDIT!#PRINT (CAR !#TEM) F!:E!#LOOKDPTH NIL)))
                          )
                         (T (PROGN (EDITQF !#CMD) T))))
                (P (EDITBPNT0 (CAR F!:E!#LOCLST) 2))
                (!? (EDITBPNT0 (CAR F!:E!#LOCLST) 100))
                (PP (EDITBPNT0 (CAR F!:E!#LOCLST) NIL))
                (!^ (AND (CDR F!:E!#LOCLST) (SETQ F!:E!#UNFIND F!:E!#LOCLST))
                    (SETQ F!:E!#LOCLST (LAST F!:E!#LOCLST)))
                (!@0 (COND ((NULL (CDR F!:E!#LOCLST)) (ERROR NIL NIL)))
                     (PROG NIL
                      LP   (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST))
                           (COND ((TAIL!-P (CAR F!:E!#LOCLST)
                                           (CADR F!:E!#LOCLST))
                                  (GO LP)))))
                (MARK (SETQ F!:E!#MARKLST (CONS F!:E!#LOCLST F!:E!#MARKLST)))
                (UNDO (EDITUNDO F!:E!#TOPFLG
                                NIL
                                (COND (F!:E!#INBUF (EDITREAD)))))
                (TEST (SETQ F!:E!#UNDOLST (CONS NIL F!:E!#UNDOLST)))
                (!@UNDO (EDITUNDO T T NIL))
                (UNBLOCK
                 (COND ((SETQ !#TEM (MEMQ NIL F!:E!#UNDOLST))
                        (EDITSMASH !#TEM (LIST NIL) (CDR !#TEM)))
                       (T (PRINT2 " not blocked"))))
                (!_ (COND (F!:E!#MARKLST
                           (PROGN
                            (AND (CDR F!:E!#LOCLST)
                                 (SETQ F!:E!#UNFIND F!:E!#LOCLST))
                            (SETQ F!:E!#LOCLST (CAR F!:E!#MARKLST))))
                          (T (ERROR NIL NIL))))
                (!\ (COND (F!:E!#UNFIND
                           (PROGN (SETQ !#CMD F!:E!#LOCLST)
                                  (SETQ F!:E!#LOCLST F!:E!#UNFIND)
                                  (AND (CDR !#CMD) (SETQ F!:E!#UNFIND !#CMD))))
                          (T (ERROR NIL NIL))))
                (!\P (COND ((AND F!:E!#LASTP1
                                 (NOT (EQ F!:E!#LASTP1 F!:E!#LOCLST)))
                            (SETQ F!:E!#LOCLST F!:E!#LASTP1))
                           ((AND F!:E!#LASTP2
                                 (NOT (EQ F!:E!#LASTP2 F!:E!#LOCLST)))
                            (SETQ F!:E!#LOCLST F!:E!#LASTP2))
                           (T (ERROR NIL NIL))))
                (!_!_ (COND (F!:E!#MARKLST
                             (AND (CDR F!:E!#LOCLST)
                                  (SETQ F!:E!#UNFIND F!:E!#LOCLST)
                                  (SETQ F!:E!#LOCLST (CAR F!:E!#MARKLST))
                                  (SETQ F!:E!#MARKLST (CDR F!:E!#MARKLST))))
                            (T (ERROR NIL NIL))))
                ((F BF)
                 (COND ((NULL F!:E!#TOPFLG)
                        (PROGN (SETQ F!:E!#FINDFLAG !#CMD) (RETURN NIL)))
                       (T (PROGN (SETQ !#TEM (EDITREAD))
                                 (SELECTQ !#CMD
                                          (F (EDITQF !#TEM))
                                          (BF (EDITBF !#TEM NIL))
                                          (ERROR NIL NIL))))))
                (UP (EDITUP))
                (DELETE (SETQ !#CMD '(DELETE)) (EDIT!: '!: NIL NIL))
                (NX (EDIT!* 1))
                (BK (EDIT!* -1))
                (!@NX (SETQ F!:E!#LOCLST
                            ((LAMBDA (F!:E!#LOCLST)
                              (PROG (!#UF)
                                    (SETQ !#UF F!:E!#LOCLST)
                               LP   (COND ((OR (NULL (SETQ F!:E!#LOCLST
                                                      (CDR F!:E!#LOCLST)))
                                               (NULL (CDR F!:E!#LOCLST)))
                                           (ERROR NIL NIL))
                                          ((OR (NULL (SETQ !#TEM
                                                      (MEMQ
                                                       (CAR F!:E!#LOCLST)
                                                       (CADR F!:E!#LOCLST))))
                                               (NULL (CDR !#TEM)))
                                           (GO LP)))
                                    (EDITCOM 'NX NIL)
                                    (SETQ F!:E!#UNFIND !#UF)
                                    (RETURN F!:E!#LOCLST)))
                             F!:E!#LOCLST)))
                (!?!? (EDITH F!:E!#UNDOLST))
                (COND ((AND (NULL (SETQ !#TEM
                                        (EDITMAC !#CMD F!:E!#MACROS NIL)))
                            (NULL (SETQ !#TEM
                                        (EDITMAC !#CMD F!:E!#USERMACROS NIL))))
                       (RETURN (EDITDEFAULT !#CMD)))
                      (T (EDITCOMS (COPY (CDR !#TEM))))))))

(DE EDITCOML (!#CMD F!:E!#COPYFLG)
 (PROG (!#C2 !#C3 !#TEM)
  LP   (COND ((PAIRP (CDR !#CMD))
              (PROGN (SETQ !#C2 (CADR !#CMD))
                     (COND ((PAIRP (CDDR !#CMD)) (SETQ !#C3 (CADDR !#CMD)))))))
       (COND ((AND F!:E!#LCFLG
                   (SELECTQ !#C2
                            ((TO THRU THROUGH)
                             (COND ((NULL (CDDR !#CMD))
                                    (PROGN (SETQ !#C3 -1) (SETQ !#C2 'THRU))))
                             T)
                            NIL))
              (PROGN (EDITTO (CAR !#CMD) !#C3 !#C2) (RETURN NIL)))
             ((NUMBERP (CAR !#CMD))
              (PROGN (EDIT2F (CAR !#CMD) (CDR !#CMD)) (RETURN NIL)))
             ((EQ !#C2 '!:!:)
              (PROGN (EDITCONT (CAR !#CMD) (CDDR !#CMD)) (RETURN NIL))))
       (SELECTQ (CAR !#CMD)
                (S (SET !#C2
                        (COND ((NULL !#C2) (ERROR NIL NIL))
                              (T ((LAMBDA (F!:E!#LOCLST)
                                   (EDITLOC (CDDR !#CMD)))
                                  F!:E!#LOCLST)))))
                (R (SETQ !#C2 (EDITNEWC2 (LIST (CAR F!:E!#LOCLST)) !#C2))
                   (EDITDSUBST !#C3 !#C2 (CAR F!:E!#LOCLST)))
                (E (SETQ !#TEM (EVAL !#C2))
                   (COND ((NULL (CDDR !#CMD)) (PRINT !#TEM)))
                   (RETURN !#TEM))
                (I (SETQ !#CMD
                         (CONS (COND ((ATOM !#C2) !#C2) (T (EVAL !#C2)))
                               (MAPCAR (CDDR !#CMD)
                                       (FUNCTION
                                        (LAMBDA (X)
                                         (COND (F!:E!#TOPFLG (PRINT (EVAL X)))
                                               (T (EVAL X))))))))
                   (SETQ F!:E!#COPYFLG NIL)
                   (GO LP))
                (N (COND ((ATOM (CAR F!:E!#LOCLST)) (ERROR NIL NIL)))
                   (EDITNCONC (CAR F!:E!#LOCLST)
                              (COND (F!:E!#COPYFLG (COPY (CDR !#CMD)))
                                    (T (APPEND (CDR !#CMD) NIL)))))
                (P (COND ((NOT (EQ F!:E!#LASTP1 F!:E!#LOCLST))
                          (PROGN (SETQ F!:E!#LASTP2 F!:E!#LASTP1)
                                 (SETQ F!:E!#LASTP1 F!:E!#LOCLST))))
                   (EDITBPNT (CDR !#CMD)))
                (F (EDIT4F !#C2 !#C3))
                (FS (PROG NIL
                     L1   (COND ((SETQ !#CMD (CDR !#CMD))
                                 (PROGN (EDITQF (SETQ F!:E!#CMD (CAR !#CMD)))
                                        (GO L1))))))
                (F!= (EDIT4F (CONS '!=!= !#C2) !#C3))
                (ORF (EDIT4F (CONS '!*ANY!* (CDR !#CMD)) 'N))
                (BF (EDITBF !#C2 !#C3))
                (NTH (COND ((NOT (EQ (SETQ !#TEM
                                           (EDITNTH (CAR F!:E!#LOCLST) !#C2))
                                     (CAR F!:E!#LOCLST)))
                            (SETQ F!:E!#LOCLST (CONS !#TEM F!:E!#LOCLST)))))
                (IF (COND ((AND (PAIRP (SETQ !#TEM (EDITVAL !#C2)))
                                (CAR !#TEM))
                           (COND ((CDR !#CMD) (EDITCOMS !#C3))))
                          ((AND (CDDR !#CMD) (CDDDR !#CMD))
                           (EDITCOMS (CADDDR !#CMD)))
                          (T (ERROR NIL NIL))))
                (BI (EDITBI !#C2
                            (COND ((CDDR !#CMD) !#C3) (T !#C2))
                            (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
                (RI (EDITRI !#C2
                            !#C3
                            (AND (CDR !#CMD) (CDDR !#CMD) (CAR F!:E!#LOCLST))))
                (RO (EDITRO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
                (LI (EDITLI !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
                (LO (EDITLO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
                (BO (EDITBO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
                (M (EDITM !#CMD !#C2))
                (NX (EDIT!* !#C2))
                (BK (EDIT!* (MINUS !#C2)))
                (ORR (EDITOR (CDR !#CMD)))
                (MBD (EDITMBD NIL (CDR !#CMD)))
                (XTR (EDITXTR NIL (CDR !#CMD)))
                ((THRU TO) (EDITTO NIL !#C2 (CAR !#CMD)))
                ((A B !: AFTER BEFORE) (EDIT!: (CAR !#CMD) NIL (CDR !#CMD)))
                (MV (EDITMV NIL (CADR !#CMD) (CDDR !#CMD)))
                ((LP LPQ) (EDITRPT (CDR !#CMD) (EQ (CAR !#CMD) 'LPQ)))
                (LC (EDITLOC (CDR !#CMD)))
                (LCL (EDITLOCL (CDR !#CMD)))
                (!_ (SETQ F!:E!#LOCLST (EDITNEWLOCLST F!:E!#LOCLST !#C2)))
                (BELOW (EDITBELOW !#C2 (COND ((CDDR !#CMD) !#C3) (T 1))))
                (SW (EDITSW (CADR !#CMD) (CADDR !#CMD)))
                (BIND (PROG (F!:E!#1 F!:E!#2 F!:E!#3) (EDITCOMS (CDR !#CMD))))
                (COMS (PROG NIL
                       L1   (COND ((SETQ !#CMD (CDR !#CMD))
                                   (PROGN
                                    (EDITCOM
                                     (SETQ F!:E!#CMD (EVAL (CAR !#CMD)))
                                     NIL)
                                    (GO L1))))))
                (COMSQ (EDITCOMS (CDR !#CMD)))
                (COND ((AND (NULL (SETQ !#TEM
                                        (EDITMAC (CAR !#CMD) F!:E!#MACROS T)))
                            (NULL (SETQ !#TEM
                                        (EDITMAC (CAR !#CMD)
                                                 F!:E!#USERMACROS
                                                 T))))
                       (RETURN (EDITDEFAULT !#CMD)))
                      ((NOT (ATOM (SETQ !#C3 (CAR !#TEM))))
                       (EDITCOMS (SUBLIS (PAIR !#C3 (CDR !#CMD)) (CDR !#TEM))))
                      (T (EDITCOMS (SUBST (CDR !#CMD) !#C3 (CDR !#TEM))))))))

(DE EDITNEWC2 (F!:E!#LOCLST !#C2)
 (PROGN (EDIT4F !#C2 T)
        (SETQ F!:E!#UNFIND F!:E!#LOCLST)
        (COND ((AND (ATOM !#C2) F!:E!#UPFINDFLG (PAIRP (CAR F!:E!#LOCLST)))
               (CAAR F!:E!#LOCLST))
              (T (CAR F!:E!#LOCLST)))))

(DE EDITM (!#CMD !#C2)
 (PROG (!#NEWMACRO !#TEM)
       (COND ((ATOM !#C2)
              (COND ((SETQ !#TEM (EDITMAC !#C2 F!:E!#USERMACROS NIL))
                     (PROGN (RPLACD !#TEM (CDDR !#CMD)) (RETURN NIL)))
                    (T (SETQ !#NEWMACRO (CONS !#C2 (CONS NIL (CDDR !#CMD)))))))
             ((SETQ !#TEM (EDITMAC (CAR !#C2) F!:E!#USERMACROS T))
              (PROGN (RPLACA !#TEM (CADDR !#CMD))
                     (RPLACD !#TEM (CDDDR !#CMD))
                     (RETURN NIL)))
             (T (PROGN (NCONC F!:E!#EDITCOMSL (LIST (CAR !#C2)))
                       (SETQ !#NEWMACRO (CONS (CAR !#C2) (CDDR !#CMD))))))
       (SETQ F!:E!#USERMACROS (CONS !#NEWMACRO F!:E!#USERMACROS))))

(DE EDITNEWLOCLST (F!:E!#LOCLST !#C2)
 (PROG (!#UF !#TEM)
       (SETQ !#UF F!:E!#LOCLST)
       (SETQ !#C2 (EDITFPAT !#C2))
  LP   (COND ((COND ((AND (ATOM !#C2) (PAIRP (CAR F!:E!#LOCLST)))
                     (EQ !#C2 (CAAR F!:E!#LOCLST)))
                    ((EQ (CAR !#C2) 'IF)
                     (COND ((ATOM (SETQ !#TEM (EDITVAL (CADR !#C2)))) NIL)
                           (T !#TEM)))
                    (T (EDIT4E !#C2
                               (COND ((EQ (CAR !#C2) '!') (CAAR F!:E!#LOCLST))
                                     (T (CAR F!:E!#LOCLST))))))
              (PROGN (SETQ F!:E!#UNFIND !#UF) (RETURN F!:E!#LOCLST)))
             ((SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST)) (GO LP)))
       (ERROR NIL NIL)))

(DE EDITMAC (!#C !#LST !#FLG)
 (PROG (!#X !#Y)
  LP   (COND ((NULL !#LST) (RETURN NIL))
             ((EQ !#C (CAR (SETQ !#X (CAR !#LST))))
              (PROGN (SETQ !#Y (CDR !#X))
                     (COND ((COND (!#FLG (CAR !#Y)) (T (NULL (CAR !#Y))))
                            (RETURN !#Y))))))
       (SETQ !#LST (CDR !#LST))
       (GO LP)))

(DE EDITCOMS (!#COMS)
 (PROG NIL
  L1   (COND ((ATOM !#COMS) (RETURN (CAR F!:E!#LOCLST))))
       (EDITCOM (CAR !#COMS) NIL)
       (SETQ !#COMS (CDR !#COMS))
       (GO L1)))

(DE EDITH (!#LST)
 (PROG NIL
       (TERPRI)
       (MAPC !#LST
             (FUNCTION
              (LAMBDA (!#ELT)
               (PROGN
                (COND ((NULL !#ELT) (PRIN2 " block"))
                      ((NULL (CAR !#ELT)) NIL)
                      ((NUMBERP (CAR !#ELT)) (PRIN2 (LIST (CAR !#ELT) "--")))
                      (T (PRIN1 (CAR !#ELT))))
                (PRIN2 " ")))))))

(DE EDITUNDO (!#PRINTFLG !#UNDOFLG !#UNDOP)
 (PROG (!#LST !#FLG)
       (SETQ !#LST F!:E!#UNDOLST)
  LP   (COND ((OR (NULL !#LST) (NULL (CAR !#LST))) (GO OUT)))
       (COND ((NULL !#UNDOP)
              (SELECTQ (CAAR !#LST)
                       ((NIL !@UNDO UNBLOCK) (GO LP1))
                       (UNDO (COND ((NULL !#UNDOFLG) (GO LP1))))
                       NIL))
             ((NOT (EQ !#UNDOP (CAAR !#LST))) (GO LP1)))
       (EDITUNDOCOM (CAR !#LST) !#PRINTFLG)
       (COND ((NULL !#UNDOFLG) (RETURN NIL)))
       (SETQ !#FLG T)
  LP1  (SETQ !#LST (CDR !#LST))
       (GO LP)
  OUT  (COND (!#FLG NIL)
             ((AND !#LST (CDR !#LST)) (PRINT2 " blocked"))
             (T (PRINT2 " nothing saved")))))

(DE EDITUNDOCOM (!#X !#FLG)
 (PROG (!#C !#Y !#Z)
       (COND ((ATOM !#X) (ERROR NIL NIL))
             ((NOT (EQ (CAR (LAST F!:E!#LOCLST)) (CAR (LAST (CADR !#X)))))
              (PROGN (PRINT2 " different expression")
                     (SETQ F!:E!#CMD NIL)
                     (ERROR NIL NIL))))
       (SETQ !#C (CAR !#X))
       (SETQ F!:E!#LOCLST (CADR !#X))
       (SETQ !#Y (CDR !#X))
  L1   (COND ((SETQ !#Y (CDR !#Y))
              (PROGN (SETQ !#Z (CAR !#Y))
                     (COND ((EQ (CAR !#Z) 'R)
                            ((LAMBDA (F!:E!#LOCLST)
                              (EDITCOM (LIST 'R (CADR !#Z) (CADDR !#Z)) NIL))
                             (CADDDR !#Z)))
                           (T (EDITSMASH (CAR !#Z) (CADR !#Z) (CDDR !#Z))))
                     (GO L1))))
       (EDITSMASH !#X NIL (CONS (CAR !#X) (CDR !#X)))
       (COND (!#FLG
              (PROGN
               (COND ((NUMBERP !#C) (PRINT2 (LIST !#C "--"))) (T (PRIN1 !#C)))
               (PRIN2 " undone"))))
       (RETURN T)))

(DE EDITSMASH (!#OLD !#A !#D)
 (PROGN (COND ((ATOM !#OLD) (ERROR NIL NIL)))
        (SETQ F!:E!#UNDOLST!#1
              (CONS (CONS !#OLD (CONS (CAR !#OLD) (CDR !#OLD)))
                    F!:E!#UNDOLST!#1))
        (RPLACA !#OLD !#A)
        (RPLACD !#OLD !#D)))

(DE EDITNCONC (!#X !#Y)
 (PROG (!#TEM)
       (RETURN
        (COND ((NULL !#X) !#Y)
              ((ATOM !#X) (ERROR NIL NIL))
              (T (PROGN (EDITSMASH (SETQ !#TEM (LAST !#X)) (CAR !#TEM) !#Y)
                        !#X))))))

(DE EDITDSUBST (!#X !#Y !#Z)
 (PROG NIL
  LP   (COND ((NULL (PAIRP !#Z)) (RETURN NIL))
             ((EQUAL !#Y (CAR !#Z)) (EDITSMASH !#Z (COPY !#X) (CDR !#Z)))
             (T (EDITDSUBST !#X !#Y (CAR !#Z))))
       (COND ((AND !#Y (EQ !#Y (CDR !#Z)))
              (PROGN (EDITSMASH !#Z (CAR !#Z) (COPY !#X)) (RETURN NIL))))
       (SETQ !#Z (CDR !#Z))
       (GO LP)))

(DE EDIT1F (!#C F!:E!#LOCLST)
 (COND ((EQUAL !#C 0)
        (COND ((NULL (CDR F!:E!#LOCLST)) (ERROR NIL NIL))
              (T (CDR F!:E!#LOCLST))))
       ((ATOM (CAR F!:E!#LOCLST)) (ERROR NIL NIL))
       ((GREATERP !#C 0)
        (COND ((GREATERP !#C (LENGTH (CAR F!:E!#LOCLST))) (ERROR NIL NIL))
              (T (CONS (CAR (SETQ F!:E!#LASTAIL
                                  (NTH!-TAIL (CAR F!:E!#LOCLST) !#C)))
                       F!:E!#LOCLST))))
       ((GREATERP (MINUS !#C) (LENGTH (CAR F!:E!#LOCLST))) (ERROR NIL NIL))
       (T (CONS (CAR (SETQ F!:E!#LASTAIL
                           (NTH!-TAIL (CAR F!:E!#LOCLST)
                                      (PLUS (LENGTH (CAR F!:E!#LOCLST))
                                            (PLUS !#C 1)))))
                F!:E!#LOCLST))))

(DE EDIT2F (!#N !#X)
 (PROG (!#CL)
       (SETQ !#CL (CAR F!:E!#LOCLST))
       (COND ((ATOM !#CL) (ERROR NIL NIL))
             (F!:E!#COPYFLG (SETQ !#X (COPY !#X)))
             (T (SETQ !#X (APPEND !#X NIL))))
       (COND ((GREATERP !#N 0)
              (COND ((GREATERP !#N (LENGTH !#CL)) (ERROR NIL NIL))
                    ((NULL !#X) (GO DELETE))
                    (T (GO REPLACE))))
             ((OR (EQUAL !#N 0)
                  (NULL !#X)
                  (GREATERP (MINUS !#N) (LENGTH !#CL)))
              (ERROR NIL NIL))
             (T (PROGN
                 (COND ((NOT (EQUAL !#N -1))
                        (SETQ !#CL (NTH!-TAIL !#CL (MINUS !#N)))))
                 (EDITSMASH !#CL (CAR !#X) (CONS (CAR !#CL) (CDR !#CL)))
                 (COND ((CDR !#X)
                        (EDITSMASH !#CL
                                   (CAR !#CL)
                                   (NCONC (CDR !#X) (CDR !#CL)))))
                 (RETURN NIL))))
  DELETE
       (COND ((EQUAL !#N 1)
              (PROGN (OR (PAIRP (CDR !#CL)) (ERROR NIL NIL))
                     (EDITSMASH !#CL (CADR !#CL) (CDDR !#CL))))
             (T (PROGN (SETQ !#CL (NTH!-TAIL !#CL (DIFFERENCE !#N 1)))
                       (EDITSMASH !#CL (CAR !#CL) (CDDR !#CL)))))
       (RETURN NIL)
  REPLACE
       (COND ((NOT (EQUAL !#N 1)) (SETQ !#CL (NTH!-TAIL !#CL !#N))))
       (EDITSMASH !#CL (CAR !#X) (CDR !#CL))
       (COND ((CDR !#X)
              (EDITSMASH !#CL (CAR !#CL) (NCONC (CDR !#X) (CDR !#CL)))))))

(DE EDIT4E (!#PAT !#Y)
 (COND ((EQ !#PAT !#Y) T)
       ((ATOM !#PAT) (OR (EQ !#PAT '!&) (EQUAL !#PAT !#Y)))
       ((EQ (CAR !#PAT) '!*ANY!*)
        (PROG NIL
         LP   (COND ((NULL (SETQ !#PAT (CDR !#PAT))) (RETURN NIL))
                    ((EDIT4E (CAR !#PAT) !#Y) (RETURN T)))
              (GO LP)))
       ((AND (EQ (CAR !#PAT) '!') (ATOM !#Y))
        (PROG (!#Z)
              (SETQ !#PAT (CDR !#PAT))
              (SETQ !#Z (EXPLODE2 !#Y))
         LP   (COND ((EQ (CAR !#PAT) '!')
                     (PROGN (FREELIST !#Z)
                            (PRINT2 "=")
                            (PRIN1 !#Y)
                            (RETURN T)))
                    ((NULL !#Z) (RETURN NIL))
                    ((NOT (EQ (CAR !#PAT) (CAR !#Z)))
                     (PROGN (FREELIST !#Z) (RETURN NIL))))
              (SETQ !#PAT (CDR !#PAT))
              (SETQ !#Z (CDR !#Z))
              (GO LP)))
       ((EQ (CAR !#PAT) '!-!-)
        (OR (NULL (SETQ !#PAT (CDR !#PAT)))
            (PROG NIL
             LP   (COND ((EDIT4E !#PAT !#Y) (RETURN T))
                        ((ATOM !#Y) (RETURN NIL)))
                  (SETQ !#Y (CDR !#Y))
                  (GO LP))))
       ((EQ (CAR !#PAT) '!=!=) (EQ (CDR !#PAT) !#Y))
       ((ATOM !#Y) NIL)
       ((EDIT4E (CAR !#PAT) (CAR !#Y)) (EDIT4E (CDR !#PAT) (CDR !#Y)))))

(DE EDITQF (!#PAT)
 (PROG (!#Q1)
       (COND ((AND (PAIRP (CAR F!:E!#LOCLST))
                   (PAIRP (SETQ !#Q1 (CDAR F!:E!#LOCLST)))
                   (SETQ !#Q1 (MEMQ !#PAT !#Q1)))
              (SETQ F!:E!#LOCLST
                    (CONS (COND (F!:E!#UPFINDFLG !#Q1)
                                (T (PROGN (SETQ F!:E!#LASTAIL !#Q1)
                                          (CAR !#Q1))))
                          F!:E!#LOCLST)))
             (T (EDIT4F !#PAT 'N)))))

(DE EDIT4F (!#PAT F!:E!#SN)
 (PROG (!#LL !#X !#FF)
       (SETQ !#FF (LIST NIL))
       (SETQ F!:E!#CMD !#PAT)
       (SETQ !#PAT (EDITFPAT !#PAT))
       (SETQ !#LL F!:E!#LOCLST)
       (COND ((EQ F!:E!#SN 'N)
              (PROGN (SETQ F!:E!#SN 1)
                     (COND ((ATOM (CAR F!:E!#LOCLST)) (GO LP1))
                           ((AND (ATOM (CAAR F!:E!#LOCLST)) F!:E!#UPFINDFLG)
                            (PROGN
                             (SETQ !#LL
                                   (CONS (CAAR F!:E!#LOCLST) F!:E!#LOCLST))
                             (GO LP1)))
                           (T (SETQ !#LL
                                    (CONS (CAAR F!:E!#LOCLST) F!:E!#LOCLST)))))
              ))
       (COND ((AND F!:E!#SN (NOT (NUMBERP F!:E!#SN))) (SETQ F!:E!#SN 1)))
       (COND ((AND (EDIT4E
                    (COND ((AND (PAIRP !#PAT) (EQ (CAR !#PAT) '!:!:!:))
                           (CDR !#PAT))
                          (T !#PAT))
                    (CAR !#LL))
                   (OR (NULL F!:E!#SN)
                       (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
              (RETURN (SETQ F!:E!#LOCLST !#LL))))
       (SETQ !#X (CAR !#LL))
  LP   (COND ((EDIT4F1 !#PAT !#X F!:E!#MAXLEVEL !#FF)
              (PROGN (AND (CDR F!:E!#LOCLST) (SETQ F!:E!#UNFIND F!:E!#LOCLST))
                     (RETURN
                      (CAR (SETQ F!:E!#LOCLST
                                 (NCONC (CAR !#FF)
                                        (COND ((EQ (CADR !#FF) (CAR !#LL))
                                               (CDR !#LL))
                                              (T !#LL))))))))
             ((NULL F!:E!#SN) (ERROR NIL NIL)))
  LP1  (SETQ !#X (CAR !#LL))
       (COND ((NULL (SETQ !#LL (CDR !#LL))) (ERROR NIL NIL))
             ((AND (SETQ !#X (MEMQ !#X (CAR !#LL)))
                   (PAIRP (SETQ !#X (CDR !#X))))
              (GO LP)))
       (GO LP1)))

(DE EDITFPAT (!#PAT)
 (COND ((PAIRP !#PAT)
        (COND ((OR (EQ (CAR !#PAT) '!=!=) (EQ (CAR !#PAT) '!')) !#PAT)
              (T (MAPCAR !#PAT (FUNCTION EDITFPAT)))))
       ((EQ (NTHCHAR !#PAT -1) '!') (CONS '!' (EXPLODE2 !#PAT)))
       (T !#PAT)))

(DE EDIT4F1 (!#PAT !#X !#LVL !#FF)
 (PROG NIL
  LP   (COND ((NOT (GREATERP !#LVL 0))
              (PROGN (PRINT2 " maxlevel exceeded") (RETURN NIL)))
             ((ATOM !#X) (RETURN NIL))
             ((AND (PAIRP !#PAT)
                   (EQ (CAR !#PAT) '!:!:!:)
                   (EDIT4E (CDR !#PAT) !#X)
                   (OR (NULL F!:E!#SN)
                       (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
              T)
             ((AND (OR (ATOM !#PAT) (NOT (EQ (CAR !#PAT) '!:!:!:)))
                   (EDIT4E !#PAT (CAR !#X))
                   (OR (NULL F!:E!#SN)
                       (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
              (COND ((OR (NULL F!:E!#UPFINDFLG) (PAIRP (CAR !#X)))
                     (PROGN (SETQ F!:E!#LASTAIL !#X) (SETQ !#X (CAR !#X))))))
             ((AND !#PAT
                   (EQ !#PAT (CDR !#X))
                   (OR (NULL F!:E!#SN)
                       (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
              (SETQ !#X (CDR !#X)))
             ((AND F!:E!#SN
                   (PAIRP (CAR !#X))
                   (EDIT4F1 !#PAT (CAR !#X) (DIFFERENCE !#LVL 1) !#FF)
                   (EQUAL F!:E!#SN 0))
              (SETQ !#X (CAR !#X)))
             (T (PROGN (SETQ !#X (CDR !#X))
                       (SETQ !#LVL (DIFFERENCE !#LVL 1))
                       (GO LP))))
       (COND ((AND !#FF (NOT (EQ !#X (CADR !#FF)))) (TCONC !#FF !#X)))
       (RETURN (OR !#FF T))))

(DE EDITFINDP (!#X !#PAT !#FLG)
 (PROG (F!:E!#SN F!:E!#LASTAIL !#FF)
       (SETQ F!:E!#SN 1)
       (AND (NULL !#FLG) (SETQ !#PAT (EDITFPAT !#PAT)))
       (RETURN (OR (EDIT4E !#PAT !#X) (EDIT4F1 !#PAT !#X F!:E!#MAXLEVEL !#FF)))
  ))

(DE EDITBF (!#PAT !#N)
 (PROG (!#LL !#X !#Y !#FF)
       (SETQ !#LL F!:E!#LOCLST)
       (SETQ !#FF (LIST NIL))
       (SETQ F!:E!#CMD !#PAT)
       (SETQ !#PAT (EDITFPAT !#PAT))
       (COND ((AND (NULL !#N) (CDR !#LL)) (GO LP1)))
  LP   (COND ((EDITBF1 !#PAT (CAR !#LL) F!:E!#MAXLEVEL !#Y !#FF)
              (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST)
                     (RETURN
                      (CAR (SETQ F!:E!#LOCLST
                                 (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 NIL NIL))
             ((OR (SETQ !#Y (MEMQ !#X (CAR !#LL)))
                  (SETQ !#Y (TAIL!-P !#X (CAR !#LL))))
              (GO LP)))
       (GO LP1)))

(DE EDITBF1 (!#PAT !#X !#LVL !#TAIL !#FF)
 (PROG (!#Y)
  LP   (COND ((NOT (GREATERP !#LVL 0))
              (PROGN (PRINT2 " maxlevel exceeded") (RETURN NIL)))
             ((EQ !#TAIL !#X)
              (RETURN
               (COND ((EDIT4E
                       (COND ((AND (PAIRP !#PAT) (EQ (CAR !#PAT) '!:!:!:))
                              (CDR !#PAT))
                             (T !#PAT))
                       !#X)
                      (TCONC !#FF !#X))))))
       (SETQ !#Y !#X)
  LP1  (COND ((NULL (OR (EQ (CDR !#Y) !#TAIL) (ATOM (CDR !#Y))))
              (PROGN (SETQ !#Y (CDR !#Y)) (GO LP1))))
       (SETQ !#TAIL !#Y)
       (COND ((AND (PAIRP (CAR !#TAIL))
                   (EDITBF1 !#PAT (CAR !#TAIL) (DIFFERENCE !#LVL 1) NIL))
              (SETQ !#TAIL (CAR !#TAIL)))
             ((AND (EQ (CAR !#PAT) '!:!:!:) (EDIT4E (CDR !#PAT) !#TAIL)) T)
             ((AND (OR (ATOM !#PAT) (NOT (EQ (CAR !#PAT) '!:!:!:)))
                   (EDIT4E !#PAT (CAR !#TAIL)))
              (COND ((OR (NULL F!:E!#UPFINDFLG) (PAIRP (CAR !#TAIL)))
                     (PROGN (SETQ F!:E!#LASTAIL !#TAIL)
                            (SETQ !#TAIL (CAR !#TAIL))))))
             ((AND !#PAT (EQ !#PAT (CDR !#TAIL))) (SETQ !#X (CDR !#X)))
             (T (PROGN (SETQ !#LVL (DIFFERENCE !#LVL 1)) (GO LP))))
       (COND ((NOT (EQ !#TAIL (CADR !#FF))) (TCONC !#FF !#TAIL)))
       (RETURN !#FF)))

(DE EDITNTH (!#X !#N)
 (COND ((ATOM !#X) (ERROR NIL NIL))
       ((NOT (NUMBERP !#N))
        (OR (MEMQ !#N !#X)
            (MEMQ (SETQ !#N (EDITELT !#N (LIST !#X))) !#X)
            (TAIL!-P !#N !#X)))
       ((EQUAL !#N 0) (ERROR NIL NIL))
       ((NULL (SETQ !#N
                    (COND ((OR (NOT (LESSP !#N 0))
                               (GREATERP (SETQ !#N (PLUS (LENGTH !#X) !#N 
1))                                      0))
                           (NTH!-TAIL !#X !#N)))))
        (ERROR NIL NIL))
       (T !#N)))

(DE EDITBPNT0 (!#EXP !#DEPTH)
 (PROGN
  (COND ((NOT (EQUAL F!:E!#LASTP1 F!:E!#LOCLST))
         (PROGN (SETQ F!:E!#LASTP2 F!:E!#LASTP1)
                (SETQ F!:E!#LASTP1 F!:E!#LOCLST))))
  (TERPRI)
  (!* " 3nd arg to edit#print indicates whether print should start with ... ")
  (!* " 2nd arg to sprint is left margin")
  (COND (!#DEPTH
         (EDIT!#PRINT !#EXP
                      !#DEPTH
                      (TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))))
        (T (SPRINT !#EXP 1)))))

(DE EDITBPNT (!#X)
 (PROG (!#Y !#N)
       (COND ((EQUAL (CAR !#X) 0) (SETQ !#Y (CAR F!:E!#LOCLST)))
             (T (SETQ !#Y (CAR (EDITNTH (CAR F!:E!#LOCLST) (CAR !#X))))))
       (COND ((NULL (CDR !#X)) (SETQ !#N 2))
             ((NOT (NUMBERP (SETQ !#N (CADR !#X)))) (ERROR NIL NIL))
             ((LESSP !#N 0) (ERROR NIL NIL)))
       (TERPRI)
       (!* " 3nd arg indicates whether print should start with ... ")
       (EDIT!#PRINT !#Y !#N (TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST)))
       (RETURN !#Y)))

(DE EDITRI (!#M !#N !#X)
 (PROG (!#A !#B)
       (SETQ !#A (EDITNTH !#X !#M))
       (SETQ !#B (EDITNTH (CAR !#A) !#N))
       (COND ((OR (NULL !#A) (NULL !#B)) (ERROR NIL NIL)))
       (EDITSMASH !#A (CAR !#A) (EDITNCONC (CDR !#B) (CDR !#A)))
       (EDITSMASH !#B (CAR !#B) NIL)))

(DE EDITRO (!#N !#X)
 (PROGN (SETQ !#X (EDITNTH !#X !#N))
        (COND ((OR (NULL !#X) (ATOM (CAR !#X))) (ERROR NIL NIL)))
        (EDITSMASH (SETQ !#N (LAST (CAR !#X))) (CAR !#N) (CDR !#X))
        (EDITSMASH !#X (CAR !#X) NIL)))

(DE EDITLI (!#N !#X)
 (PROGN (SETQ !#X (EDITNTH !#X !#N))
        (COND ((NULL !#X) (ERROR NIL NIL)))
        (EDITSMASH !#X (CONS (CAR !#X) (CDR !#X)) NIL)))

(DE EDITLO (!#N !#X)
 (PROGN (SETQ !#X (EDITNTH !#X !#N))
        (COND ((OR (NULL !#X) (ATOM (CAR !#X))) (ERROR NIL NIL)))
        (EDITSMASH !#X (CAAR !#X) (CDAR !#X))))

(DE EDITBI (!#M !#N !#X)
 (PROG (!#A !#B)
       (SETQ !#B (CDR (SETQ !#A (EDITNTH !#X !#N))))
       (SETQ !#X (EDITNTH !#X !#M))
       (COND ((AND !#A (NOT (GREATERP (LENGTH !#A) (LENGTH !#X))))
              (PROGN (EDITSMASH !#A (CAR !#A) NIL)
                     (EDITSMASH !#X (CONS (CAR !#X) (CDR !#X)) !#B)))
             (T (ERROR NIL NIL)))))

(DE EDITBO (!#N !#X)
 (PROGN (SETQ !#X (EDITNTH !#X !#N))
        (COND ((ATOM (CAR !#X)) (ERROR NIL NIL)))
        (EDITSMASH !#X (CAAR !#X) (EDITNCONC (CDAR !#X) (CDR !#X)))))

(DE EDITDEFAULT (!#X)
 (PROG (!#Y)
       (COND (F!:E!#LCFLG
              (RETURN
               (COND ((EQ F!:E!#LCFLG T) (EDITQF !#X))
                     (T (EDITCOM (LIST F!:E!#LCFLG !#X) F!:E!#TOPFLG)))))
             ((PAIRP !#X)
              (RETURN
               (COND ((SETQ !#Y (ATSOC (CAR !#X) F!:E!#OPS))
                      (EDITRAN !#X (CDR !#Y)))
                     (T (ERROR NIL NIL)))))
             ((NULL F!:E!#TOPFLG) (ERROR NIL NIL))
             ((MEMQ !#X F!:E!#EDITCOMSL)
              (COND (F!:E!#INBUF
                     (PROGN (SETQ !#X (CONS !#X F!:E!#INBUF))
                            (SETQ F!:E!#INBUF NIL)))
                    (T (ERROR NIL NIL))))
             ((AND (EQ (NTHCHAR !#X -1) 'P)
                   (MEMQ (SETQ !#X
                               (ICOMPRESS
                                (REVERSIP (CDR (REVERSIP (EXPLODE !#X))))))
                         '(!^ !_ UP NX BK !@NX UNDO)))
              (SETQ F!:E!#INBUF (CONS 'P F!:E!#INBUF)))
             (T (ERROR NIL NIL)))
       (RETURN
        (COND ((SETQ !#Y (ATSOC (CAR !#X) F!:E!#OPS)) (EDITRAN !#X (CDR !#Y)))
              (T (EDITCOM (SETQ F!:E!#CMD !#X) F!:E!#TOPFLG))))))

(DE EDITUP NIL
 (PROG (!#CL F!:E!#LOCLST!#1 !#X !#Y)
       (SETQ !#CL (CAR F!:E!#LOCLST))
       (!* "unused LP was here")
       (COND ((NULL (SETQ F!:E!#LOCLST!#1 (CDR F!:E!#LOCLST)))
              (ERROR NIL NIL))
             ((TAIL!-P !#CL (CAR F!:E!#LOCLST!#1)) (RETURN NIL))
             ((NOT (SETQ !#X (MEMQ !#CL (CAR F!:E!#LOCLST!#1))))
              (ERROR NIL NIL))
             ((OR (EQ !#X F!:E!#LASTAIL)
                  (NOT (SETQ !#Y (MEMQ !#CL (CDR !#X)))))
              NIL)
             ((AND (EQ !#CL (CAR F!:E!#LASTAIL)) (TAIL!-P F!:E!#LASTAIL !#Y))
              (SETQ !#X F!:E!#LASTAIL))
             (T (PROGN (TERPRI) (PRIN2 !#CL) (PRINT2 " - location uncertain")))
        )
       (COND ((EQ !#X (CAR F!:E!#LOCLST!#1))
              (SETQ F!:E!#LOCLST F!:E!#LOCLST!#1))
             (T (SETQ F!:E!#LOCLST (CONS !#X F!:E!#LOCLST!#1))))
       (RETURN NIL)))

(DE EDIT!* (!#N)
 (CAR (SETQ F!:E!#LOCLST
            ((LAMBDA (F!:E!#CMD F!:E!#LOCLST !#M)
              (PROGN (COND ((NOT (GREATERP !#M !#N)) (ERROR NIL NIL)))
                     (EDITCOM '!@0 NIL)
                     (EDITCOM (DIFFERENCE !#N !#M) NIL)
                     F!:E!#LOCLST))
             NIL
             F!:E!#LOCLST
             ((LAMBDA (F!:E!#LOCLST)
               (PROGN (EDITUP) (LENGTH (CAR F!:E!#LOCLST))))
              F!:E!#LOCLST)))))

(DE EDITOR (!#COMS)
 (PROG (!#RES)
  LP   (COND ((NULL !#COMS) (ERROR NIL NIL)))
       (SETQ !#RES
             (ERRORSET (LIST 'EDITOR1 (MKQUOTE !#COMS))
                       G!:EDIT!:ERRORS
                       G!:EDIT!:TRACE))
       (COND ((PAIRP !#RES) (RETURN (CAR F!:E!#LOCLST)))
             (!#RES (ERROR !#RES NIL)))
       (SETQ !#COMS (CDR !#COMS))
       (GO LP)))

(DE EDITOR1 (!#COMS)
 (SETQ F!:E!#LOCLST
       ((LAMBDA (F!:E!#LOCLST)
         (PROGN
          (COND ((ATOM (CAR !#COMS)) (EDITCOM (CAR !#COMS)))
                (T (EDITCOMS (CAR !#COMS))))
          F!:E!#LOCLST))
        F!:E!#LOCLST)))

(DE EDITERRCOM (!#COMS)
 (ERRORSET (LIST 'EDITCOMS (MKQUOTE !#COMS)) G!:EDIT!:ERRORS G!:EDIT!:TRACE))

(DE EDITRPT (!#EDRX !#QUIET)
 (PROG (!#EDRL !#EDRPTCNT)
       (SETQ !#EDRL F!:E!#LOCLST)
       (SETQ !#EDRPTCNT 0)
  LP   (COND ((GREATERP !#EDRPTCNT F!:E!#MAXLOOP)
              (PRINT2 " maxloop exceeded"))
             ((PAIRP (EDITERRCOM !#EDRX))
              (PROGN (SETQ !#EDRL F!:E!#LOCLST)
                     (SETQ !#EDRPTCNT (PLUS !#EDRPTCNT 1))
                     (GO LP)))
             ((NULL !#QUIET) (PROGN (PRIN1 !#EDRPTCNT)
                                    (PRINT2 " occurrences"))))
       (SETQ F!:E!#LOCLST !#EDRL)))

(DE EDITLOC (!#X)
 (PROG (!#OLDL !#OLDF F!:E!#LCFLG !#L)
       (SETQ !#OLDL F!:E!#LOCLST)
       (SETQ !#OLDF F!:E!#UNFIND)
       (SETQ F!:E!#LCFLG T)
       (COND ((ATOM !#X) (EDITCOM !#X NIL))
             ((AND (NULL (CDR !#X)) (ATOM (CAR !#X))) (EDITCOM (CAR !#X) NIL))
             (T (GO LP)))
       (SETQ F!:E!#UNFIND !#OLDL)
       (RETURN (CAR F!:E!#LOCLST))
  LP   (SETQ !#L F!:E!#LOCLST)
       (COND ((PAIRP (EDITERRCOM !#X))
              (PROGN (SETQ F!:E!#UNFIND !#OLDL) (RETURN (CAR F!:E!#LOCLST)))))
       (COND ((EQUAL !#L F!:E!#LOCLST)
              (PROGN (SETQ F!:E!#LOCLST !#OLDL)
                     (SETQ F!:E!#UNFIND !#OLDF)
                     (ERROR NIL NIL))))))

(DE EDITLOCL (!#COMS)
 (CAR (SETQ F!:E!#LOCLST
            (NCONC
             ((LAMBDA (F!:E!#LOCLST F!:E!#UNFIND)
               (PROGN (EDITLOC !#COMS) F!:E!#LOCLST))
              (LIST (CAR F!:E!#LOCLST))
              NIL)
             (CDR F!:E!#LOCLST)))))

(DE EDIT!: (!#TYPE !#LC !#X)
 (PROG (F!:E!#TOFLG F!:E!#LOCLST!#0)
       (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
       (SETQ !#X
             (MAPCAR !#X
                     (FUNCTION
                      (LAMBDA (!#X)
                       (COND ((AND (PAIRP !#X) (EQ (CAR !#X) '!#!#))
                              ((LAMBDA (F!:E!#LOCLST F!:E!#UNDOLST!#1)
                                (COPY (EDITCOMS (CDR !#X))))
                               F!:E!#LOCLST
                               NIL))
                             (T !#X))))))
       (COND (!#LC (PROGN (COND ((EQ (CAR !#LC) 'HERE) (SETQ !#LC (CDR !#LC))))
                          (EDITLOC !#LC))))
       (EDITUP)
       (COND ((EQ F!:E!#LOCLST!#0 F!:E!#LOCLST) (SETQ !#LC NIL)))
       (SELECTQ !#TYPE
                ((B BEFORE) (EDIT2F -1 !#X))
                ((A AFTER)
                 (COND ((CDAR F!:E!#LOCLST) (EDIT2F -2 !#X))
                       (T (EDITCOML (CONS 'N !#X) F!:E!#COPYFLG))))
                ((!: FOR)
                 (COND ((OR !#X (CDAR F!:E!#LOCLST)) (EDIT2F 1 !#X))
                       ((MEMQ (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
                        (PROGN (EDITUP) (EDIT2F 1 (LIST NIL))))
                       (T (EDITCOMS '(0 (NTH -2) (2)))))
                 (RETURN (COND ((NULL !#LC) F!:E!#LOCLST))))
                (ERROR NIL NIL))
       (RETURN NIL)))

(DE EDITMBD (!#LC !#X)
 (PROG (!#Y F!:E!#TOFLG)
       (COND (!#LC (EDITLOC !#LC)))
       (EDITUP)
       (SETQ !#Y
             (COND (F!:E!#TOFLG (CAAR F!:E!#LOCLST))
                   (T (LIST (CAAR F!:E!#LOCLST)))))
       (EDIT2F 1
               (LIST (COND ((OR (ATOM (CAR !#X)) (CDR !#X)) (APPEND !#X !#Y))
                           (T (LSUBST !#Y '!* (CAR !#X))))))
       (SETQ F!:E!#LOCLST
             (CONS (CAAR F!:E!#LOCLST)
                   (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
                          (CDR F!:E!#LOCLST))
                         (T F!:E!#LOCLST))))
       (RETURN (COND ((NULL !#LC) F!:E!#LOCLST)))))

(DE EDITXTR (!#LC !#X)
 (PROG (F!:E!#TOFLG)
       (COND (!#LC (EDITLOC !#LC)))
       ((LAMBDA (F!:E!#LOCLST F!:E!#UNFIND)
         (PROGN (EDITLOC !#X)
                (SETQ !#X
                      (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
                             (CAAR F!:E!#LOCLST))
                            (T (CAR F!:E!#LOCLST))))))
        (LIST (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
                     (CAAR F!:E!#LOCLST))
                    (T (CAR F!:E!#LOCLST))))
        NIL)
       (EDITUP)
       (EDIT2F 1 (COND (F!:E!#TOFLG (APPEND !#X NIL)) (T (LIST !#X))))
       (AND (NULL F!:E!#TOFLG)
            (PAIRP (CAAR F!:E!#LOCLST))
            (SETQ F!:E!#LOCLST
                  (CONS (CAAR F!:E!#LOCLST)
                        (COND ((TAIL!-P (CAR F!:E!#LOCLST)
                                        (CADR F!:E!#LOCLST))
                               (CDR F!:E!#LOCLST))
                              (T F!:E!#LOCLST)))))))

(DE EDITELT (!#LC F!:E!#LOCLST)
 (PROG (!#Y)
       (EDITLOC !#LC)
  LP   (SETQ !#Y F!:E!#LOCLST)
       (COND ((CDR (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST))) (GO LP)))
       (RETURN (CAR !#Y))))

(DE EDITCONT (!#LC1 F!:E!#SN)
 (SETQ F!:E!#LOCLST
       ((LAMBDA (F!:E!#LOCLST)
         (PROG (!#RES)
               (SETQ !#LC1 (EDITFPAT !#LC1))
          LP   (COND ((NULL (EDIT4F !#LC1 'N)) (ERROR NIL NIL)))
               (SETQ !#RES
                     (ERRORSET (LIST 'EDITLOCL (MKQUOTE F!:E!#SN))
                               G!:EDIT!:ERRORS
                               G!:EDIT!:TRACE))
               (COND ((NULL !#RES) (GO LP)) ((ATOM !#RES) (ERROR !#RES NIL)))
          LP1  (COND ((NULL (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST)))
                      (ERROR NIL NIL))
                     ((COND ((ATOM !#LC1) (EQ !#LC1 (CAAR F!:E!#LOCLST)))
                            ((EQ (CAR !#LC1) '!')
                             (EDIT4E !#LC1 (CAAR F!:E!#LOCLST)))
                            (T (EDIT4E !#LC1 (CAR F!:E!#LOCLST))))
                      (RETURN F!:E!#LOCLST)))
               (GO LP1)))
        F!:E!#LOCLST)))

(DE EDITSW (!#M !#N)
 (PROG (!#Y !#Z !#TEM)
       (SETQ !#Y (EDITNTH (CAR F!:E!#LOCLST) !#M))
       (SETQ !#Z (EDITNTH (CAR F!:E!#LOCLST) !#N))
       (SETQ !#TEM (CAR !#Y))
       (EDITSMASH !#Y (CAR !#Z) (CDR !#Y))
       (EDITSMASH !#Z !#TEM (CDR !#Z))))

(DE EDITMV (!#LC !#OP !#X)
 (PROG (F!:E!#LOCLST!#0 F!:E!#LOCLST!#1 !#Z F!:E!#TOFLG)
       (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
       (AND !#LC (EDITLOC !#LC))
       (COND ((EQ !#OP 'HERE)
              (PROGN (COND ((NULL !#LC) (PROGN (EDITLOC !#X) (SETQ !#X NIL))))
                     (SETQ !#OP '!:)))
             ((EQ (CAR !#X) 'HERE)
              (COND ((NULL !#LC) (PROGN (EDITLOC (CDR !#X)) (SETQ !#X NIL)))
                    (T (SETQ !#X (CDR !#X))))))
       (EDITUP)
       (SETQ F!:E!#LOCLST!#1 F!:E!#LOCLST)
       (SETQ !#Z (CAAR F!:E!#LOCLST))
       (SETQ F!:E!#LOCLST F!:E!#LOCLST!#0)
       (AND !#X (EDITLOC !#X))
       (EDITCOML
        (COND (F!:E!#TOFLG (CONS !#OP (APPEND !#Z NIL))) (T (LIST !#OP !#Z)))
        NIL)
       (PROG (F!:E!#LOCLST)
             (SETQ F!:E!#LOCLST F!:E!#LOCLST!#1)
             (EDITCOMS '(1 DELETE)))
       (RETURN
        (COND ((NULL !#LC)
               (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST!#1) F!:E!#LOCLST))
              ((NULL !#X)
               (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST!#1) F!:E!#LOCLST!#0))
              (T (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST) F!:E!#LOCLST!#0))))))

(DE EDITTO (!#LC1 !#LC2 !#FLG)
 (PROGN
  (SETQ F!:E!#LOCLST
        ((LAMBDA (F!:E!#LOCLST)
          (PROGN (COND (!#LC1 (PROGN (EDITLOC !#LC1) (EDITUP))))
                 (EDITBI 1
                         (COND ((AND (NUMBERP !#LC1)
                                     (NUMBERP !#LC2)
                                     (GREATERP !#LC2 !#LC1))
                                (DIFFERENCE (PLUS !#LC2 1) !#LC1))
                               (T !#LC2))
                         (CAR F!:E!#LOCLST))
                 (COND ((AND (EQ !#FLG 'TO) (CDAAR F!:E!#LOCLST))
                        (EDITRI 1 -2 (CAR F!:E!#LOCLST))))
                 (EDITCOM 1 NIL)
                 F!:E!#LOCLST))
         F!:E!#LOCLST))
  (SETQ F!:E!#TOFLG T)))

(DE EDITBELOW (!#PLACE !#DEPTH)
 (PROGN (COND ((LESSP (SETQ !#DEPTH (EVAL !#DEPTH)) 0) (ERROR NIL NIL)))
        (PROG (!#N1 !#N2)
              (SETQ !#N1
                    (LENGTH
                     ((LAMBDA (F!:E!#LOCLST F!:E!#LCFLG)
                       (PROGN (EDITCOM !#PLACE NIL) F!:E!#LOCLST))
                      F!:E!#LOCLST
                      '!_)))
              (SETQ !#N2 (LENGTH F!:E!#LOCLST))
              (COND ((LESSP !#N2 (PLUS !#N1 !#DEPTH)) (ERROR NIL NIL)))
              (SETQ F!:E!#UNFIND F!:E!#LOCLST)
              (SETQ F!:E!#LOCLST
                    (NTH!-TAIL F!:E!#LOCLST
                               (DIFFERENCE (DIFFERENCE (PLUS !#N2 1) !#N1)
                                           !#DEPTH))))))

(DE EDITRAN (!#C !#DEF)
 (SETQ F!:E!#LOCLST
       (OR ((LAMBDA (F!:E!#LOCLST)
             (PROG (!#Z !#W)
                   (COND ((NULL !#DEF) (ERROR NIL NIL))
                         ((NULL (SETQ !#Z (CAR !#DEF))) (GO OUT)))
              LP   (COND ((NULL !#Z) (ERROR NIL NIL))
                         ((NULL (SETQ !#W (MEMQ (CAR !#Z) !#C)))
                          (PROGN (SETQ !#Z (CDR !#Z)) (GO LP))))
              OUT  (SETQ !#Z
                         (APPLY (CAR (SETQ !#DEF (CADR !#DEF)))
                                (PROG (F!:E!#1 F!:E!#2 F!:E!#3)
                                      (SETQ F!:E!#1 (CDR (LDIFF !#C !#W)))
                                      (SETQ F!:E!#2 (CAR !#Z))
                                      (SETQ F!:E!#3 (CDR !#W))
                                      (RETURN
                                       (MAPCAR (CDR !#DEF)
                                               (FUNCTION
                                                (LAMBDA (!#X)
                                                 (SELECTQ !#X
                                                  (!#1 F!:E!#1)
                                                  (!#2 F!:E!#2)
                                                  (!#3 F!:E!#3)
                                                  (EVAL !#X)))))))))
                   (RETURN
                    (COND ((NULL !#Z)
                           (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST) NIL))
                          (T !#Z)))))
            F!:E!#LOCLST)
           F!:E!#LOCLST)))

(DE EDIT!#PRINT (!#E !#DEPTH !#DOTFLG)
 (PROG (!#RES)
       (SETQ !#RES
             (ERRORSET
              (LIST 'DEPTH!#PRINT (MKQUOTE !#E) !#DEPTH 0 (MKQUOTE !#DOTFLG))
              G!:EDIT!:ERRORS
              G!:EDIT!:TRACE))
       (COND ((EQ !#RES 'TOOBIG) (RETURN (PRINT2 " ...> ")))
             ((ATOM !#RES) (ERROR !#RES NIL)))
       (RETURN !#E)))

(DE DEPTH!#PRINT (!#E !#DEPTH !#PLENGTH !#DOTFLG)
 (PROG NIL
       (OR (LESSP (SETQ !#PLENGTH (ADD1 !#PLENGTH)) F!:E!#MAX!#PLENGTH)
           (ERROR 'TOOBIG NIL))
       (COND ((ATOM !#E) (PROGN (PRIN1 !#E) (RETURN !#PLENGTH)))
             ((ZEROP !#DEPTH) (PROGN (PRIN2 "&") (RETURN !#PLENGTH))))
       (PRIN2 (COND (!#DOTFLG "... ") (T "(")))
       (SETQ !#DEPTH (SUB1 !#DEPTH))
  LOOP (SETQ !#PLENGTH (DEPTH!#PRINT (CAR !#E) !#DEPTH !#PLENGTH NIL))
       (SETQ !#E (CDR !#E))
       (COND ((NULL !#E) NIL)
             ((ATOM !#E) (PROGN (PRIN2 " . ") (PRIN1 !#E)))
             (T (PROGN (PRIN2 " ") (GO LOOP))))
       (PRIN2 ")")
       (RETURN !#PLENGTH)))

(!* 
"LDIFF( X:list Y:list ):list                         EXPR
    -----
    If X is a tail of Y, returns the list difference of X and Y,
    a list of the elements of Y preceeding X.")

(CDE LDIFF (!#X !#Y)
 (COND ((OR (EQ !#X !#Y) (ATOM !#X)) NIL)
       ((NULL !#Y) !#X)
       (T (PROG (!#V !#Z)
                (SETQ !#Z (SETQ !#V (LIST (CAR !#X))))
           LOOP (SETQ !#X (CDR !#X))
                (COND ((OR (EQ !#X !#Y) (ATOM !#X)) (RETURN !#Z)))
                (SETQ !#V (CDR (RPLACD !#V (LIST (CAR !#X)))))
                (GO LOOP)))))

(!* "FREELIST is an efficiency hack in the DEC interpreter."
"It explicitly returns the cells of a list to the freelist.")

(CDE FREELIST (!#X) NIL)

(!* "EDITRACEFN is an optional debugging routine for the editor.")

(CDE EDITRACEFN (!#X) NIL)

(DE PRINT2 (!#X) (PROGN (PRIN2 !#X) (TERPRI) !#X))

(SETQ F!:E!#LOOKDPTH -1)

(SETQ F!:E!#DEPTH -1)

(SETQ F!:E!#TRACEFLG NIL)

(SETQ F!:E!#LAST!#ID NIL)

(SETQ F!:E!#MAXLEVEL 300)

(SETQ F!:E!#UPFINDFLG T)

(SETQ F!:E!#MAXLOOP 30)

(SETQ F!:E!#EDITCOMSL
 '(S R E I N P F FS F!= ORF BF NTH IF RI RO LI LO BI BO M NX BK ORR MBD XTR
   THRU TO A B !: AFTER BEFORE FOR MV LP LPQ LC LCL !_ BELOW SW BIND COMS 
COMSQ INSERT REPLACE CHANGE DELETE EMBED SURROUND MOVE EXTRACT SECOND THIRD 
NEX REPACK MAKEFN))

(SETQ F!:E!#USERMACROS NIL)

(SETQ F!:E!#MAX!#PLENGTH 1750)

(SETQ F!:E!#MACROS
 '((MAKEFN (EX ARGS N M)
           (IF 'M
               ((BI N M) (LC . N) (BELOW !\))
               ((IF 'N ((BI N) (LC . N) (BELOW !\)))))
           (E (MAPC '(LAMBDA (!#X !#Y) (EDITDSUBST !#X !#Y (EDIT!#!#)))
                    'ARGS
                    (CDR 'EX))
              T)
           (E (PUTD (CAR 'EX) 'EXPR (CONS 'LAMBDA (CONS 'ARGS (EDIT!#!#)))) 
T)         UP
           (1 EX))
   (REPACK !#X (LC . !#X) REPACK)
   (REPACK NIL
           (IF (PAIRP (EDIT!#!#)) (1) NIL)
           (I !: (PRINT (READLIST (EDITE (EXPLODE (EDIT!#!#)) NIL NIL)))))
   (NEX (!#X) (BELOW !#X) NX)
   (NEX NIL (BELOW !_) NX)
   (THIRD !#X (ORR ((LC . !#X) (LC . !#X) (LC . !#X))))
   (SECOND !#X (ORR ((LC . !#X) (LC . !#X))))))

(SETQ F!:E!#OPS
 '((INSERT (BEFORE AFTER FOR) (EDIT!: F!:E!#2 F!:E!#3 F!:E!#1))
   (REPLACE (WITH BY) (EDIT!: !: F!:E!#1 F!:E!#3))
   (CHANGE (TO) (EDIT!: !: F!:E!#1 F!:E!#3))
   (DELETE NIL (EDIT!: !: F!:E!#1 NIL))
   (EMBED (IN WITH) (EDITMBD F!:E!#1 F!:E!#3))
   (SURROUND (WITH IN) (EDITMBD F!:E!#1 F!:E!#3))
   (MOVE (TO) (EDITMV F!:E!#1 (CAR F!:E!#3) (CDR F!:E!#3)))
   (EXTRACT (FROM) (EDITXTR F!:E!#3 F!:E!#1))))



REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]