(DEFSPEC EDIT
(LAMBDA (V-F)
        (PROG <V-D>
              <COND [(NOT (ATOM V-F)) (RETURN "CAN'T EDIT")]
                    [(IFTYPE (*CAR V-F) 6)
                      (COND [(SETQ V-D (*DEF V-F))
                              (CSET V-F (EVAL (EDIT1 (CONS 'LAMBDA V-D))
                               ))]
                            [(SETQ V-D
                               (OR (*DEF (RPLACA 0Q (*SPEC V-F)))
                                   (*DEF (RPLACA 0Q (*MACRO V-F)))))
                              (RPLACD (*CDR (ADD1 (RPLACD 0Q (*CAR V-F))
                               )) (EVAL (EDIT1 (CONS 'LAMBDA V-D))))]
                            [T (RETURN "CAN'T EDIT")])]
                    [(OR (IFTYPE (*CAR V-F) 4)
                         (IFTYPE (*CAR V-F) 5)) (RETURN "CAN'T EDIT")]
                    [T (CSET V-F (EDIT1 (*CAR V-F)))]>
              <RETURN V-F>)))

(CSETQ EDIT1
(LAMBDA (V-V)
        (PROG <V-VV W-EX>
        LOOP1 <PRINT "EDIT:">
              <SETQ V-VV V-V>
        LOOP2 <CSETQ ED-TARGET ED-D>
              <SETQ V-VV (CDR (ED-FIX (SETQ W-EX NIL) V-VV))>
              <COND [(EQ W-EX 'STORE) (RETURN V-VV)]
                    [(EQ W-EX 'RESTORE) (GO LOOP1)]
                    [(EQ V-VV ED-D)
                      (SETQ V-VV NIL)
                      (GO LOOP2)]
                    [T (GO LOOP2)]>)))

(CSETQ ED-FIX
(LAMBDA (W-L W-W)
        (PROG <V-I V-C V-N W-SL W-SW>
         LOOP <SETQ W-SL W-L>
              <SETQ W-SW W-W>
              <COND [(NOT (EQ ED-TARGET ED-D))
                      (COND [(NOT (ED-MATCH W-W ED-TARGET)) (GO HUNT)]
                            [T (CSETQ ED-TARGET ED-D)])]>
              <SETQ V-I (TOKEN)>
              <COND [(NUMBERP V-I) (GO NEXT)]
                    [(NOT (SETQ V-I (GET V-I 'ED-CF)))
                      (ED-HUH)
                      (GO LOOP)]>
              <SETQ V-I (V-I)>
         NEXT <COND [(ZEROP V-I) (GO LOOP)]
                    [(EQ V-I 'HUNT) (GO HUNT)]
                    [(MINUSP V-I)
                      (RETURN (CONS (ADD1 V-I) (ED-BUILD W-L W-W)))]>
              <SETQ V-N V-I>
         PICK <COND [(ATOM W-W)
                      (ED-HUH)
                      (GO LOOP)]
                    [(NOT (ZEROP (SETQ V-I (SUB1 V-I))))
                      (SETQ W-L (CONS (CAR W-W) W-L))
                      (SETQ W-W (CDR W-W))
                      (GO PICK)]>
         DOIT <SETQ V-I (ED-FIX NIL (CAR W-W))>
              <SETQ V-C (CDR V-I)>
              <SETQ V-I (CAR V-I)>
              <COND [(EQ V-I 'HUNT)
                      (SETQ W-L (CONS V-C W-L))
                      (SETQ W-W (CDR W-W))
                      (GO HUNT)]
                    [(EQ V-C ED-D) (SETQ W-W (CDR W-W))]
                    [T (SETQ W-W (CONS V-C (CDR W-W)))]>
              <ED-MOVE (DIFFERENCE 1 V-N)>
              <GO NEXT>
         HUNT <COND [(ATOM W-W)
                      (RETURN (CONS 'HUNT (ED-BUILD W-L W-W)))]>
              <SETQ V-N 1>
              <GO DOIT>)))

(CSETQ ED-BUILD
(LAMBDA (V-L V-W)
        (COND [(NULL V-L) V-W]
              [T (ED-BUILD (CDR V-L) (CONS (CAR V-L) V-W))])))

(CSETQ ED-HUH
(LAMBDA NIL
        (CLEARBUFF)
        (SETQ W-L W-SL)
        (SETQ W-W W-SW)
        (PRINT "?")))

(CSETQ ED-MOVE
(LAMBDA (V-N)
        (PROG NIL
         LOOP <COND [(ZEROP V-N) (RETURN 0)]
                    [(MINUSP V-N) (GO LEFT)]
                    [(ATOM W-W) (RETURN 0)]>
              <SETQ V-N (SUB1 V-N)>
              <SETQ W-L (CONS (CAR W-W) W-L)>
              <SETQ W-W (CDR W-W)>
              <GO LOOP>
         LEFT <COND [(NULL W-L) (RETURN 0)]>
              <SETQ V-N (ADD1 V-N)>
              <SETQ W-W (CONS (CAR W-L) W-W)>
              <SETQ W-L (CDR W-L)>
              <GO LOOP>)))

(CSETQ ED-GROUP
(LAMBDA (V-W V-N V-L)
        (COND [(ZEROP V-N) (CONS (REVERSE V-L) V-W)]
              [(ATOM V-W)
                (ED-HUH)
                W-W]
              [T (ED-GROUP (CDR V-W) (SUB1 V-N) (CONS (CAR V-W) V-L))]))
)

(CSETQ ED-MATCH
(LAMBDA (V-W V-P)
        (COND [(ATOM V-P) (COND [(EQ V-P '&) T]
                                [T (EQ V-W V-P)])]
              [(ATOM V-W) NIL]
              [(EQ (CAR V-P) '--)
                (COND [(ED-MATCH V-W (CDR V-P)) T]
                      [T (ED-MATCH (CDR V-W) V-P)])]
              [(ED-MATCH (CAR V-W) (CAR V-P))
                (ED-MATCH (CDR V-W) (CDR V-P))]
              [T NIL])))

(PUT 'D 'ED-CF
(LAMBDA NIL
        (SETQ W-L NIL)
        (SETQ W-W ED-D)
        -1))

(PUT 'I 'ED-CF
(LAMBDA NIL
        (SETQ W-W (CONS (EVAL (READ)) W-W))
        0))

(PUT 'R 'ED-CF
(LAMBDA NIL
        (SETQ W-W (EVAL (READ)))
        0))

(PUT 'M 'ED-CF
(LAMBDA NIL
        (ED-MOVE (EVAL (READ)))))

(PUT 'P 'ED-CF
(LAMBDA NIL
        (COND [W-L (CSETQ ED-SAVE (PLIMIT (CONS (CAR ED-LIMIT) (ADD1 (
                    CDR ED-LIMIT)))))
                   (PRINT (CONS "--" W-W))]
              [T (CSETQ ED-SAVE (PLIMIT ED-LIMIT))
                 (PRINT W-W)])
        (PLIMIT ED-SAVE)
        0))

(PUT 'F 'ED-CF
(LAMBDA NIL
        (CSETQ ED-TARGET (EVAL (READ)))
        'HUNT))

(PUT 'G 'ED-CF
(LAMBDA NIL
        (SETQ W-W (ED-GROUP W-W (EVAL (READ)) NIL))
        0))

(PUT 'S 'ED-CF
(LAMBDA NIL
        (SET (READ) W-W)
        0))

(PUT 'E 'ED-CF
(LAMBDA NIL
        (EVAL (READ))
        0))

(PUT 'U 'ED-CF
(LAMBDA NIL
        (COND [(OR (ATOM W-W)
                   (ATOM (CAR W-W))) (ED-HUH)]
              [T (SETQ W-W (APPEND (CAR W-W) (CDR W-W)))])
        0))

(PUT 'C 'ED-CF
(LAMBDA NIL
        (PROG <(V-OLD (EVAL (READ)))>
              <SETQ W-W (SUBST (EVAL (READ)) V-OLD W-W)>
              <RETURN 0>)))

(PUT 'STORE 'ED-CF
(LAMBDA NIL
        (SETQ W-EX 'STORE)
        -999))

(PUT 'RESTORE 'ED-CF
(LAMBDA NIL
        (SETQ W-EX 'RESTORE)
        -999))

(CSETQ ED-LIMIT '(3 . 5))
(CSETQ ED-D 'G1)
(CSETQ ED-SAVE 'NIL)
(CSETQ ED-TARGET 'NIL)

(CSETQ ED-DUMP '(EDIT EDIT1 ED-FIX ED-BUILD ED-HUH ED-MOVE ED-GROUP
         ED-MATCH (ED-CF D I R M P F G S E U C STORE RESTORE) ED-LIMIT
         ED-D ED-SAV ED-TARGET ED-DUMP))

"EDITOR LOADED"