Return to cmuedit.l CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / lisp / lisplib

Annotation of 43BSD/ucb/lisp/lisplib/cmuedit.l, revision 1.1

1.1     ! root        1: (setq rcs-cmuedit-
        !             2:    "$Header: /usr/lib/lisp/cmuedit.l,v 1.1 83/01/29 18:33:36 jkf Exp $")
        !             3: 
        !             4: (eval-when (compile load eval) (load 'cmumacs) (load 'cmufncs))
        !             5: 
        !             6: (declare (special c2 c3 tem nopr %changes))
        !             7: 
        !             8: (dv editsfns
        !             9:     ((declare
        !            10:       (special |#1|
        !            11:                |#2|
        !            12:                |#3|
        !            13:                $%dotflg
        !            14:                %lookdpth
        !            15:                %prevfn%
        !            16:                atm
        !            17:                autop
        !            18:                com
        !            19:                com0
        !            20:                coms
        !            21:                copyflg
        !            22:                editcomsl
        !            23:                editracefn
        !            24:                %%w
        !            25:                findflag
        !            26:                l
        !            27:                l0
        !            28:                lastail
        !            29:                lastp1
        !            30:                lastp2
        !            31:                lastword
        !            32:                lcflg
        !            33:                marklst
        !            34:                maxlevel
        !            35:                maxloop
        !            36:                mess
        !            37:                noprint
        !            38:                oldprompt
        !            39:                readbuf
        !            40:                %%x
        !            41:                toflg
        !            42:                topflg
        !            43:                undolst
        !            44:                undolst1
        !            45:                unfind
        !            46:                upfindflg
        !            47:                usermacros
        !            48:                findarg
        !            49:                commentflg
        !            50:                changed))
        !            51:      |##|
        !            52:      editfns
        !            53:      editf
        !            54:      editv
        !            55:      editp
        !            56:      edite
        !            57:      editl
        !            58:      editl0
        !            59:      edval
        !            60:      editread
        !            61:      (declare (*expr editracefn))
        !            62:      editcom
        !            63:      editcoma
        !            64:      editcoml
        !            65:      editmac
        !            66:      editcoms
        !            67:      edith
        !            68:      edit!undo
        !            69:      undoeditcom
        !            70:      editsmash
        !            71:      editnconc
        !            72:      editdsubst
        !            73:      edit1f
        !            74:      edit2f
        !            75:      edit4e
        !            76:      editqf
        !            77:      edit4f
        !            78:      editfpat
        !            79:      edit4f1
        !            80:      editfindp
        !            81:      editbf
        !            82:      editbf1
        !            83:      editnth
        !            84:      bpnt0
        !            85:      bpnt
        !            86:      editri
        !            87:      editro
        !            88:      editli
        !            89:      editlo
        !            90:      editbi
        !            91:      editbo
        !            92:      editdefault
        !            93:      edup
        !            94:      edit*l
        !            95:      edit*
        !            96:      edor
        !            97:      errcom
        !            98:      edrpt
        !            99:      edloc
        !           100:      edlocl
        !           101:      edit:
        !           102:      editmbd
        !           103:      editxtr
        !           104:      editelt
        !           105:      editcont
        !           106:      editsw
        !           107:      editmv
        !           108:      editto
        !           109:      editbelow
        !           110:      editran
        !           111:      edit!0
        !           112:      editrepack
        !           113:      editmakefn
        !           114:      usermacros
        !           115:      editracefn
        !           116:      lastword
        !           117:      maxlevel
        !           118:      maxloop
        !           119:      editcomsl
        !           120:      autop
        !           121:      upfindflg))
        !           122: 
        !           123: (declare
        !           124:  (special |#1|
        !           125:           |#2|
        !           126:           |#3|
        !           127:           $%dotflg
        !           128:           %lookdpth
        !           129:           %prevfn%
        !           130:           atm
        !           131:           autop
        !           132:           com
        !           133:           com0
        !           134:           coms
        !           135:           copyflg
        !           136:           editcomsl
        !           137:           editracefn
        !           138:           %%w
        !           139:           findflag
        !           140:           l
        !           141:           l0
        !           142:           lastail
        !           143:           lastp1
        !           144:           lastp2
        !           145:           lastword
        !           146:           lcflg
        !           147:           marklst
        !           148:           maxlevel
        !           149:           maxloop
        !           150:           mess
        !           151:           noprint
        !           152:           oldprompt
        !           153:           readbuf
        !           154:           %%x
        !           155:           toflg
        !           156:           topflg
        !           157:           undolst
        !           158:           undolst1
        !           159:           unfind
        !           160:           upfindflg
        !           161:           usermacros
        !           162:           findarg
        !           163:           commentflg
        !           164:           changed))
        !           165: (declare (special c nopr))     ; LWE 1/11/80 Hacks for new compiler.
        !           166: (def |##|
        !           167:   (nlambda (coms)
        !           168:     ((lambda (l undolst1) (editcoms coms)) l nil)))
        !           169: 
        !           170: (def editfns
        !           171:   (nlambda (x)
        !           172:     (prog (y)
        !           173:           (setq y (eval (car x)))
        !           174:      l1   (cond
        !           175:            (y (print (car y))
        !           176:               (eval
        !           177:                (list 'errset
        !           178:                      (cons 'editf (cons (car y) (cdr x)))))
        !           179:               (setq y (cdr y))
        !           180:               (go l1))))))
        !           181: 
        !           182: (def editf
        !           183:   (nlambda (x)
        !           184:     (prog (y fn changed)
        !           185:           (cond
        !           186:            ((null x)
        !           187:             (print '=)
        !           188:             (prin1 lastword)
        !           189:             (setq x (ncons lastword))))
        !           190:           (cond ((symbolp (car x))
        !           191:                  (setq fn (car x))
        !           192:                  (cond ((*** setq y (get fn 'trace)) (setq fn (cdr y))))
        !           193:                  (cond ((setq y (getd fn))
        !           194:                         (edite y (cdr x) (car x))
        !           195:                         (cond
        !           196:                          (changed
        !           197:                           (*** cond
        !           198:                                ((eq (car x) fn)
        !           199:                                 (*** move property to front)
        !           200:                                 (remprop (car x) (car y))
        !           201:                                 (putprop (car x) (cadr y) (car y)))
        !           202:                                ((setq y (cdr (get fn 'funtype)))
        !           203:                                 (*** move the *right* property of the
        !           204:                                  original word to the front)
        !           205:                                 (setq fn (get (car x) y))
        !           206:                                 (remprop (car x) y)
        !           207:                                 (putprop (car x) fn y)))))
        !           208:                         (return (setq lastword (car x))))
        !           209:                        ((and (boundp fn) (dtpr (cdr y))) (go l1))))
        !           210:                 ((dtpr (car x)) (go l1)))
        !           211:           (print (car x))
        !           212:           (princ '" not editable")
        !           213:           (err nil)
        !           214:      l1   (print '=editv)
        !           215:           (return (eval (cons 'editv x))))))
        !           216: 
        !           217: (def editv
        !           218:   (nlambda (x)
        !           219:     (prog (y)
        !           220:           (cond
        !           221:            ((null x)
        !           222:             (print '=)
        !           223:             (prin1 lastword)
        !           224:             (setq x (ncons lastword))))
        !           225:           (cond ((dtpr (car x)) (edite (eval (car x)) (cdr x) nil) (return t))
        !           226:                 ((and (symbolp (car x))
        !           227:                       (boundp (car x))
        !           228:                       (setq y (eval (car x))))
        !           229:                  (edite y (cdr x) (car x))
        !           230:                  (return (setq lastword (car x))))
        !           231:                 (t (print (car x)) (princ '" not editable") (err nil))))))
        !           232: 
        !           233: (def editp
        !           234:   (nlambda (x)
        !           235:     (cond
        !           236:      ((null x) (print '=) (prin1 lastword) (setq x (ncons lastword))))
        !           237:     (cond ((dtpr (car x)) (print '=editv) (eval (cons 'editv x)))
        !           238:           ((symbolp (car x))
        !           239:            (edite (plist (car x)) (cdr x) (car x))
        !           240:            (setq lastword (car x)))
        !           241:           (t (print (car x)) (princ '" not editable") (err nil)))))
        !           242: 
        !           243: (def edite
        !           244:   (lambda (expr coms atm)
        !           245:     (cond ((atom expr) (print expr) (princ '" not editable") (err nil))
        !           246:           (t (car (last (editl (ncons expr) coms atm nil nil)))))))
        !           247: 
        !           248: (def editl
        !           249:   (lambda (l coms atm marklst mess)
        !           250:     (prog (com lastail undolst undolst1 findflag lcflg unfind lastp1 lastp2 readbuf l0 com0 oldprompt upfindflg noprint findarg)
        !           251:           (makunbound 'findarg)
        !           252:           (setq upfindflg t)
        !           253:           (cond ((dtpr (setq l (catch (eval '(editl0)) edit-abort)))
        !           254:                  (return l))
        !           255:                 (t (err nil))))))
        !           256: 
        !           257: (def editl0
        !           258:   (lambda nil
        !           259:     (prog nil
        !           260:           (cond
        !           261:            (coms
        !           262:             (cond ((eq (car coms) 'start)
        !           263:                    (setq readbuf (append (cdr coms) (list nil)))
        !           264:                    (setq coms nil)
        !           265:                    (*** don 't quit if command fails))
        !           266:                   (t (editcoms (append coms (list 'ok))) (return l)))))
        !           267:           (cond
        !           268:            ((or (null coms) (eq (car coms) 'start))
        !           269:             (print (or mess 'edit))))
        !           270:           (cond
        !           271:            ((or (eq (car l)
        !           272:                     (car
        !           273:                      (last
        !           274:                       (car
        !           275:                        (cond ((setq com
        !           276:                                     (get 'edit 'lastvalue)))
        !           277:                              (t '((nil))))))))
        !           278:                 (and atm
        !           279:                      (eq (car l)
        !           280:                          (car
        !           281:                           (last
        !           282:                            (car
        !           283:                             (cond ((setq com
        !           284:                                          (get atm 'edit-save)))
        !           285:                                   (t '((nil))))))))))
        !           286:             (setq l (car com))
        !           287:             (setq marklst (cadr com))
        !           288:             (setq undolst (caddr com))
        !           289:             (cond ((car undolst) (setq undolst (cons nil undolst))))
        !           290:             (setq unfind (cdddr com))))
        !           291:           (*** setq
        !           292:                oldprompt
        !           293:                (cons (sub1 (stkcount 'editl0 (add1 (spdlpt)) 0))
        !           294:                      (prompt 35)))
        !           295:      ct   (setq noprint t)
        !           296:           (setq findflag nil)
        !           297:      a    (setq undolst1 nil)
        !           298:           (cond
        !           299:            ((and autop (null readbuf) (not noprint)) (bpnt (list 0 autop))))
        !           300:           (setq com (editread))
        !           301:           (setq l0 l)
        !           302:           (setq com0 (cond ((atom com) com) (t (car com))))
        !           303:           (cond
        !           304:            ((dtpr
        !           305:              (prog1 (errset (editcom com t))
        !           306:                     (cond
        !           307:                      (undolst1 (setq undolst1
        !           308:                                      (cons com0 (cons l0 undolst1)))
        !           309:                                (setq undolst (cons undolst1 undolst))))))
        !           310:             (go a)))
        !           311:           (setq readbuf nil)
        !           312:           (cond (coms (err nil)))
        !           313:           (terpri)
        !           314:           (cond (com (prin1 com) (princ '"  ?") (terpri)))
        !           315:           (go ct))))
        !           316: 
        !           317: (def edval
        !           318:   (lambda (%%x)
        !           319:     (errset (eval %%x))))
        !           320: 
        !           321: (def editread
        !           322:   (lambda nil
        !           323:     (prog (x)
        !           324:           (cond
        !           325:            ((null readbuf)
        !           326:             (prog nil
        !           327:              l1   (terpri)
        !           328:                   (princ '|#|)
        !           329:                   (*** cond
        !           330:                        ((neq (car oldprompt) 0) (princ (car oldprompt))))
        !           331:                   (*** prompt 35)
        !           332:                   (cond
        !           333:                    ((atom (setq readbuf (errset (lineread))))
        !           334:                     (terpri)
        !           335:                     (go l1)))
        !           336:                   (setq readbuf (car readbuf)))))
        !           337:           (setq x (car readbuf))
        !           338:           (setq readbuf (cdr readbuf))
        !           339:           (return x))))
        !           340: 
        !           341: (declare (*expr editracefn))
        !           342: 
        !           343: (def editcom
        !           344:   (lambda (c topflg)
        !           345:     (setq com c)
        !           346:     (cond (editracefn (editracefn c)))
        !           347:     (cond (findflag
        !           348:            (cond ((eq findflag 'bf) (setq findflag nil) (editbf c nil))
        !           349:                  (t (setq findflag nil) (editqf c))))
        !           350:           ((numberp c) (setq l (edit1f c l)) (setq noprint nil))
        !           351:           ((atom c) (editcoma c (null topflg)))
        !           352:           (t (editcoml c (null topflg))))
        !           353:     (car l)))
        !           354: 
        !           355: (def editcoma
        !           356:   (lambda (c copyflg)
        !           357:     (prog (tem nopr)
        !           358:           (selectq c
        !           359:                    (help (setq nopr t)
        !           360:                          (eval (cons 'help readbuf))
        !           361:                          (setq readbuf nil)
        !           362:                          (*** inserted dec 78 by don cohen))
        !           363:                    (!0 (edit!0))
        !           364:                    (!nx
        !           365:                     (setq l
        !           366:                           ((lambda (l)
        !           367:                                    (prog (uf)
        !           368:                                          (setq uf l)
        !           369:                                     lp   (cond ((or (null (setq l (cdr l)))
        !           370:                                                     (null (cdr l)))
        !           371:                                                 (err nil))
        !           372:                                                ((or (null
        !           373:                                                      (setq tem
        !           374:                                                            (memq (car l)
        !           375:                                                                  (cadr
        !           376:                                                                   l))))
        !           377:                                                     (null (cdr tem)))
        !           378:                                                 (go lp)))
        !           379:                                          (edit* 1)
        !           380:                                          (setq unfind uf)
        !           381:                                          (return l)))
        !           382:                            l)))
        !           383:                    (!undo (edit!undo t t nil))
        !           384:                    (? (bpnt0 (car l) 64) (setq nopr t))
        !           385:                    (?? (edith undolst) (setq nopr t))
        !           386:                    (bk (edit* -1))
        !           387:                    (delete (setq c '(delete)) (edit: ': nil nil))
        !           388:                    (mark (setq marklst (cons l marklst)) (setq nopr t))
        !           389:                    (nex
        !           390:                     (setq l
        !           391:                           ((lambda (l) (editbelow '_ 1) (edit* 1) l)
        !           392:                            l)))
        !           393:                    ((f bf)
        !           394:                     (cond ((null topflg) (setq findflag c))
        !           395:                           (t (setq findarg
        !           396:                                    (cond ((or readbuf
        !           397:                                               (not
        !           398:                                                (boundp 'findarg)))
        !           399:                                           (editread))
        !           400:                                          (t findarg)))
        !           401:                              (selectq c
        !           402:                                       (f (editqf findarg))
        !           403:                                       (bf (editbf findarg nil))
        !           404:                                       (err nil)))))
        !           405:                    (nil (setq nopr t))
        !           406:                    (autop nil)
        !           407:                    (nx (edit* 1))
        !           408:                    (ok (cond
        !           409:                         (atm (cond
        !           410:                               ((and (dtpr undolst) (car undolst))
        !           411:                                (setq changed t)
        !           412:                                (*** bound in editf)
        !           413:                                (mark!changed atm)))
        !           414:                              (remprop atm 'edit-save)))
        !           415:                        (putprop 'edit
        !           416:                                 (cons (last l) (cons marklst (cons undolst l)))
        !           417:                                 'lastvalue)
        !           418:                        (throw l edit-abort)
        !           419:                        (*** prompt (cdr oldprompt))
        !           420:                        (*** retfrom 'editl0 l))
        !           421:                    (p (bpnt0 (car l) 2) (setq nopr t))
        !           422:                    (pp (bpnt0 (car l) nil) (setq nopr t))
        !           423:                    (pp* ((lambda (commentflg) (bpnt0 (car l) nil)) t)
        !           424:                         (setq nopr t))
        !           425:                    (repack (editrepack))
        !           426:                    (save (cond
        !           427:                           (atm (cond
        !           428:                                 ((and (dtpr undolst) (car undolst))
        !           429:                                  (mark!changed atm)))
        !           430:                                (putprop 'edit
        !           431:                                         (putprop atm
        !           432:                                                  (cons l
        !           433:                                                        (cons marklst
        !           434:                                                              (cons undolst
        !           435:                                                                    unfind)))
        !           436:                                                  'edit-save)
        !           437:                                         'lastvalue)))
        !           438:                          (*** prompt (cdr oldprompt))
        !           439:                          (*** retfrom 'editl0 l)
        !           440:                          (throw l edit-abort))
        !           441:                    (stop (*** prompt (cdr oldprompt))
        !           442:                          (*** spreval
        !           443:                               (stksrch 'editl0 (spdlpt) nil)
        !           444:                               '(err nil))
        !           445:                          (throw nil edit-abort))
        !           446:                    (test (setq undolst (cons nil undolst)) (setq nopr t))
        !           447:                    (tty: (setq com com0)
        !           448:                          (setq l (editl l nil atm nil 'tty:)))
        !           449:                    (unblock (cond ((setq tem (memq nil undolst))
        !           450:                                    (editsmash tem (ncons nil) (cdr tem)))
        !           451:                                   (t (terpri) (princ '"not blocked")))
        !           452:                             (setq nopr t))
        !           453:                    (undo (edit!undo topflg nil (cond (readbuf (editread)))))
        !           454:                    (up (edup))
        !           455:                    (/
        !           456:                     (cond (unfind (setq c l)
        !           457:                                   (setq l unfind)
        !           458:                                   (and (cdr c) (setq unfind c)))
        !           459:                           (t (err nil))))
        !           460:                    (/p
        !           461:                     (cond ((and lastp1 (neq lastp1 l)) (setq l lastp1))
        !           462:                           ((and lastp2 (neq lastp2 l)) (setq l lastp2))
        !           463:                           (t (err nil))))
        !           464:                    (^ (and (cdr l) (setq unfind l)) (setq l (last l)))
        !           465:                    (_
        !           466:                     (cond (marklst (and (cdr l) (setq unfind l))
        !           467:                                    (setq l (car marklst)))
        !           468:                           (t (err nil))))
        !           469:                    (__
        !           470:                     (cond (marklst
        !           471:                            (and (cdr l)
        !           472:                                 (setq unfind l)
        !           473:                                 (setq l (car marklst))
        !           474:                                 (setq marklst (cdr marklst))))
        !           475:                           (t (err nil))))
        !           476:                    (tl (top-level) (setq nopr t))
        !           477:                    (cond ((null (setq tem (editmac c usermacros nil)))
        !           478:                           (editdefault c)
        !           479:                           (setq nopr noprint))
        !           480:                          (t (editcoms (copy (cdr tem))) (setq nopr noprint))))
        !           481:           (setq noprint nopr))))
        !           482: 
        !           483: (def editcoml
        !           484:   (lambda (c copyflg)
        !           485:     (prog (c2 c3 tem nopr)
        !           486:      lp   (cond ((dtpr (cdr c))
        !           487:                  (setq c2 (cadr c))
        !           488:                  (cond ((dtpr (cddr c)) (setq c3 (caddr c)))
        !           489:                        (t (setq c3 nil))))
        !           490:                 (t (setq c2 (setq c3 nil))))
        !           491:           (cond ((and lcflg
        !           492:                       (selectq c2
        !           493:                                ((to thru through)
        !           494:                                 (cond
        !           495:                                  ((null (cddr c))
        !           496:                                   (setq c3 -1)
        !           497:                                   (setq c2 'thru)))
        !           498:                                 t)
        !           499:                                nil))
        !           500:                  (editto (car c) c3 c2)
        !           501:                  (return nil))
        !           502:                 ((numberp (car c))
        !           503:                  (edit2f (car c) (cdr c))
        !           504:                  (setq noprint nil)
        !           505:                  (return nil))
        !           506:                 ((eq c2 '::)
        !           507:                  (editcont (car c) (cddr c))
        !           508:                  (setq noprint nil)
        !           509:                  (return nil)))
        !           510:           (selectq (car c)
        !           511:                    ((a b :) (edit: (car c) nil (cdr c)))
        !           512:                    (below (editbelow c2 (cond ((cddr c) c3) (t 1))))
        !           513:                    (bf (editbf c2 c3))
        !           514:                    (bi
        !           515:                     (editbi c2
        !           516:                             (cond ((cddr c) c3) (t c2))
        !           517:                             (and (cdr c) (car l))))
        !           518:                    (bind (prog (|#1| |#2| |#3|)
        !           519:                                (editcoms (cdr c)))
        !           520:                          (setq nopr noprint))
        !           521:                    (bk (edit* (minus c2)))
        !           522:                    (bo (editbo c2 (and (cdr c) (car l))))
        !           523:                    (change (editran c '((to) (edit: : |#1| |#3|))))
        !           524:                    (coms (prog nil
        !           525:                           l1   (cond
        !           526:                                 ((setq c (cdr c))
        !           527:                                  (editcom (setq com (eval (car c))) nil)
        !           528:                                  (go l1))))
        !           529:                          (setq nopr noprint))
        !           530:                    (comsq (editcoms (cdr c)) (setq nopr noprint))
        !           531:                    (copy
        !           532:                     (editran c '((to) (editmv |#1| (car |#3|) (cdr |#3|) t))))
        !           533:                    (cp (editmv nil (cadr c) (cddr c) t))
        !           534:                    (delete (editran c '(nil (edit: : |#1| nil))))
        !           535:                    (e (setq tem (eval c2))
        !           536:                       (cond ((null (cddr c)) (print tem)))
        !           537:                       (setq nopr t))
        !           538:                    (embed (editran c '((in with) (editmbd |#1| |#3|))))
        !           539:                    (extract (editran c '((from) (editxtr |#3| |#1|))))
        !           540:                    (f (edit4f c2 c3))
        !           541:                    (f= (edit4f (cons '== c2) c3))
        !           542:                    (fs
        !           543:                     (prog nil
        !           544:                      l1   (cond
        !           545:                            ((setq c (cdr c))
        !           546:                             (editqf (setq com (car c)))
        !           547:                             (go l1)))))
        !           548:                    (help (eval c)
        !           549:                          (setq nopr t)
        !           550:                          (*** inserted dec 78 by don cohen))
        !           551:                    (i (setq c
        !           552:                             (cons (cond ((atom c2) c2) (t (eval c2)))
        !           553:                                   (mapcar (function
        !           554:                                            (lambda (x)
        !           555:                                                    (cond (topflg (print
        !           556:                                                                   (setq x
        !           557:                                                                         (eval
        !           558:                                                                          x)))
        !           559:                                                                  x)
        !           560:                                                          (t (eval x)))))
        !           561:                                           (cddr c))))
        !           562:                       (setq copyflg nil)
        !           563:                       (go lp))
        !           564:                    (if (cond ((and (dtpr (setq tem (edval c2))) (car tem))
        !           565:                               (cond ((cdr c) (editcoms c3))))
        !           566:                              ((and (cddr c) (cdddr c)) (editcoms (cadddr c)))
        !           567:                              (t (err nil)))
        !           568:                        (setq nopr noprint))
        !           569:                    (insert
        !           570:                     (editran c '((before after for) (edit: |#2| |#3| |#1|))))
        !           571:                    (lc (edloc (cdr c)))
        !           572:                    (lcl (edlocl (cdr c)))
        !           573:                    (li (editli c2 (and (cdr c) (car l))))
        !           574:                    (lo (editlo c2 (and (cdr c) (car l))))
        !           575:                    ((lp lpq)
        !           576:                     (edrpt (cdr c) (eq (car c) 'lpq))
        !           577:                     (setq nopr noprint))
        !           578:                    (m (cond ((atom c2)
        !           579:                              (cond ((setq tem (editmac c2 usermacros nil))
        !           580:                                     (rplacd tem (cddr c)))
        !           581:                                    (t
        !           582:                                     (setq usermacros
        !           583:                                           (cons (cons c2
        !           584:                                                       (cons nil (cddr c)))
        !           585:                                                 usermacros)))))
        !           586:                             (t
        !           587:                              (cond ((setq tem
        !           588:                                           (editmac (car c2) usermacros t))
        !           589:                                     (rplaca tem (caddr c))
        !           590:                                     (rplacd tem (cdddr c)))
        !           591:                                    (t (nconc editcomsl (ncons (car c2)))
        !           592:                                       (mark!changed 'editcomsl)
        !           593:                                       (setq usermacros
        !           594:                                             (cons (cons (car c2) (cddr c))
        !           595:                                                   usermacros))))))
        !           596:                       (mark!changed 'usermacros)
        !           597:                       (setq nopr t))
        !           598:                    (makefn
        !           599:                     (cond ((or (null c2) (null c3) (null (cdddr c)))
        !           600:                            (err nil))
        !           601:                           (t
        !           602:                            (editmakefn c2
        !           603:                                        c3
        !           604:                                        (cadddr c)
        !           605:                                        (cond ((null (cddddr c)) (cadddr c))
        !           606:                                              (t (car (cddddr c))))))))
        !           607:                    (mbd (editmbd nil (cdr c)))
        !           608:                    (move
        !           609:                     (editran c
        !           610:                              '((to) (editmv |#1| (car |#3|) (cdr |#3|) nil))))
        !           611:                    (mv (editmv nil (cadr c) (cddr c) nil))
        !           612:                    (n (cond ((atom (car l)) (err nil)))
        !           613:                       (editnconc (car l)
        !           614:                                  (cond (copyflg (copy (cdr c)))
        !           615:                                        (t (append (cdr c) nil)))))
        !           616:                    (nex
        !           617:                     (setq l
        !           618:                           ((lambda (l)
        !           619:                                    (editbelow c2 (cond ((cddr c) c3) (t 1)))
        !           620:                                    (edit* 1)
        !           621:                                    l)
        !           622:                            l)))
        !           623:                    (nth
        !           624:                     (cond
        !           625:                      ((neq (setq tem (editnth (car l) c2)) (car l))
        !           626:                       (setq l (cons tem l)))))
        !           627:                    (nx (edit* c2))
        !           628:                    (orf (edit4f (cons '*any* (cdr c)) 'n))
        !           629:                    (orr (edor (cdr c)) (setq nopr noprint))
        !           630:                    (p (cond
        !           631:                        ((neq lastp1 l) (setq lastp2 lastp1) (setq lastp1 l)))
        !           632:                       (bpnt (cdr c))
        !           633:                       (setq nopr t))
        !           634:                    (r ((lambda (l)
        !           635:                                (edit4f c2 t)
        !           636:                                (setq unfind l)
        !           637:                                (setq c2
        !           638:                                      (cond ((and (atom c2)
        !           639:                                                  upfindflg
        !           640:                                                  (dtpr (car l)))
        !           641:                                             (caar l))
        !           642:                                            (t (car l)))))
        !           643:                        (ncons (car l)))
        !           644:                       (editdsubst c3 c2 (car l)))
        !           645:                    (repack (edloc (cdr c)) (editrepack))
        !           646:                    (replace (editran c '((with by) (edit: : |#1| |#3|))))
        !           647:                    (ri (editri c2 c3 (and (cdr c) (cddr c) (car l))))
        !           648:                    (ro (editro c2 (and (cdr c) (car l))))
        !           649:                    (s (set c2
        !           650:                            (cond ((null c2) (err nil))
        !           651:                                  (t ((lambda (l) (edloc (cddr c))) l))))
        !           652:                       (setq nopr t))
        !           653:                    (second (edloc (append (cdr c) (cdr c))))
        !           654:                    (surround (editran c '((with in) (editmbd |#1| |#3|))))
        !           655:                    (sw (editsw (cadr c) (caddr c)))
        !           656:                    (third (edloc (append (cdr c) (cdr c) (cdr c))))
        !           657:                    ((thru to) (editto nil c2 (car c)))
        !           658:                    (undo (edit!undo topflg nil c2))
        !           659:                    (xtr (editxtr nil (cdr c)))
        !           660:                    (_
        !           661:                     (setq l
        !           662:                           ((lambda (l)
        !           663:                                    (prog (uf)
        !           664:                                          (setq uf l)
        !           665:                                          (setq c2 (editfpat c2))
        !           666:                                     lp   (cond ((cond ((and (atom c2)
        !           667:                                                             (dtpr (car l)))
        !           668:                                                        (eq c2 (caar l)))
        !           669:                                                       ((eq (car c2)
        !           670:                                                            'if)
        !           671:                                                        (cond ((atom
        !           672:                                                                (setq tem
        !           673:                                                                      (edval
        !           674:                                                                       (cadr
        !           675:                                                                        c2))))
        !           676:                                                               nil)
        !           677:                                                              (t tem)))
        !           678:                                                       (t
        !           679:                                                        (edit4e c2
        !           680:                                                                (cond ((eq (car
        !           681:                                                                            c2)
        !           682:                                                                           '@)
        !           683:                                                                       (caar
        !           684:                                                                        l))
        !           685:                                                                      (t
        !           686:                                                                       (car
        !           687:                                                                        l))))))
        !           688:                                                 (setq unfind uf)
        !           689:                                                 (return l))
        !           690:                                                ((setq l (cdr l)) (go lp)))
        !           691:                                          (err nil)))
        !           692:                            l)))
        !           693:                    (cond ((null (setq tem (editmac (car c) usermacros t)))
        !           694:                           (editdefault c)
        !           695:                           (setq nopr noprint))
        !           696:                          ((not (atom (setq c3 (car tem))))
        !           697:                           (editcoms (subpair c3 (cdr c) (cdr tem)))
        !           698:                           (setq nopr noprint))
        !           699:                          (t (editcoms (subst (cdr c) c3 (cdr tem)))
        !           700:                             (setq nopr noprint))))
        !           701:           (setq noprint nopr))))
        !           702: 
        !           703: (def editmac
        !           704:   (lambda (c lst flg)
        !           705:     (prog (x y)
        !           706:      lp   (cond ((null lst) (return nil))
        !           707:                 ((eq c (car (setq x (car lst))))
        !           708:                  (setq y (cdr x))
        !           709:                  (cond ((cond (flg (car y)) (t (null (car y)))) (return y)))))
        !           710:           (setq lst (cdr lst))
        !           711:           (go lp))))
        !           712: 
        !           713: (def editcoms
        !           714:   (lambda (coms)
        !           715:     (prog nil
        !           716:      l1   (cond ((atom coms) (return (car l))))
        !           717:           (editcom (car coms) nil)
        !           718:           (setq coms (cdr coms))
        !           719:           (go l1))))
        !           720: 
        !           721: (def edith
        !           722:   (lambda (lst)
        !           723:     (prog nil
        !           724:           (terpri)
        !           725:      l1   (cond ((null lst) (return nil))
        !           726:                 ((null (car lst)) (prin1 'block) (go l2))
        !           727:                 ((null (caar lst)) (go l3))
        !           728:                 ((numberp (caar lst))
        !           729:                  (prin1 (list (caar lst) '--))
        !           730:                  (go l2)))
        !           731:           (prin1 (caar lst))
        !           732:      l2   (princ '" ")
        !           733:      l3   (setq lst (cdr lst))
        !           734:           (go l1))))
        !           735: 
        !           736: (def edit!undo
        !           737:   (lambda (printflg !undoflg undop)
        !           738:     (prog (lst flg)
        !           739:           (setq lst undolst)
        !           740:      lp   (cond ((or (null lst) (null (car lst))) (go out)))
        !           741:           (cond ((null undop)
        !           742:                  (selectq (caar lst)
        !           743:                           ((nil !undo unblock) (go lp1))
        !           744:                           (undo (cond ((null !undoflg) (go lp1))))
        !           745:                           nil))
        !           746:                 ((neq undop (caar lst)) (go lp1)))
        !           747:           (undoeditcom (car lst) printflg)
        !           748:           (cond ((null !undoflg) (return nil)))
        !           749:           (setq flg t)
        !           750:      lp1  (setq lst (cdr lst))
        !           751:           (go lp)
        !           752:      out  (cond (flg (return nil))
        !           753:                 ((and lst (cdr lst)) (print 'blocked))
        !           754:                 (t (terpri) (princ '"nothing saved"))))))
        !           755: 
        !           756: (def undoeditcom
        !           757:   (lambda (x flg)
        !           758:     (prog (c)
        !           759:           (cond ((atom x) (err nil))
        !           760:                 ((neq (car (last l)) (car (last (cadr x))))
        !           761:                  (terpri)
        !           762:                  (princ '"different expression")
        !           763:                  (setq com nil)
        !           764:                  (err nil)))
        !           765:           (setq c (car x))
        !           766:           (setq l (cadr x))
        !           767:           (prog (y z)
        !           768:                 (setq y (cdr x))
        !           769:            l1   (cond
        !           770:                  ((setq y (cdr y))
        !           771:                   (setq z (car y))
        !           772:                   (cond ((eq (car z) 'r)
        !           773:                          ((lambda (l)
        !           774:                                   (editcom (list 'r
        !           775:                                                  (cadr z)
        !           776:                                                  (caddr z))
        !           777:                                            nil))
        !           778:                           (cadddr z)))
        !           779:                         (t (editsmash (car z) (cadr z) (cddr z))))
        !           780:                   (go l1))))
        !           781:           (editsmash x nil (cons (car x) (cdr x)))
        !           782:           (and flg
        !           783:                (setq flg
        !           784:                      (cond ((not (numberp c)) c) (t (cons c '(--)))))
        !           785:                (print flg)
        !           786:                (princ 'undone))
        !           787:           (return t))))
        !           788: 
        !           789: (def editsmash
        !           790:   (lambda (old a d)
        !           791:     (cond ((atom old) (err nil)))
        !           792:     (setq undolst1 (cons (cons old (cons (car old) (cdr old))) undolst1))
        !           793:     (rplaca old a)
        !           794:     (rplacd old d)))
        !           795: 
        !           796: (def editnconc
        !           797:   (lambda (x y)
        !           798:     (prog (tem)
        !           799:           (return
        !           800:            (cond ((null x) y)
        !           801:                  ((atom x) (err nil))
        !           802:                  (t (editsmash (setq tem (last x)) (car tem) y) x))))))
        !           803: 
        !           804: (def editdsubst
        !           805:   (lambda (x y z)
        !           806:     (prog nil
        !           807:      lp   (cond ((atom z) (return nil))
        !           808:                 ((cond ((symbolp y)
        !           809:                         (or (eq y (car z))
        !           810:                             (and (stringp (car z)) (eqstr y (car z)))))
        !           811:                        (t (equal y (car z))))
        !           812:                  (editsmash z (copy x) (cdr z)))
        !           813:                 (t (editdsubst x y (car z))))
        !           814:           (cond
        !           815:            ((and y (eq y (cdr z)))
        !           816:             (editsmash z (car z) (copy x))
        !           817:             (return nil)))
        !           818:           (setq z (cdr z))
        !           819:           (go lp))))
        !           820: 
        !           821: (def edit1f
        !           822:   (lambda (c l)
        !           823:     (cond ((eq c 0) (cond ((null (cdr l)) (err nil)) (t (cdr l))))
        !           824:           ((atom (car l)) (err nil))
        !           825:           ((> c 0)
        !           826:            (cond ((> c (length (car l))) (err nil))
        !           827:                  (t (cons (car (setq lastail (Cnth (car l) c))) l))))
        !           828:           ((> (minus c) (length (car l))) (err nil))
        !           829:           (t
        !           830:            (cons (car
        !           831:                   (setq lastail
        !           832:                         (Cnth (car l) (+ (length (car l)) (add1 c)))))
        !           833:                  l)))))
        !           834: 
        !           835: (def edit2f
        !           836:   (lambda (n x)
        !           837:     (prog (cl)
        !           838:           (setq cl (car l))
        !           839:           (cond ((atom cl) (err nil))
        !           840:                 (copyflg (setq x (copy x)))
        !           841:                 (t (setq x (append x nil))))
        !           842:           (cond ((> n 0)
        !           843:                  (cond ((> n (length cl)) (err nil))
        !           844:                        ((null x) (go delete))
        !           845:                        (t (go replace))))
        !           846:                 ((or (eq n 0) (null x) (> (minus n) (length cl))) (err nil))
        !           847:                 (t (cond ((neq n -1) (setq cl (Cnth cl (minus n)))))
        !           848:                    (editsmash cl (car x) (cons (car cl) (cdr cl)))
        !           849:                    (cond
        !           850:                     ((cdr x)
        !           851:                      (editsmash cl (car cl) (nconc (cdr x) (cdr cl)))))
        !           852:                    (return nil)))
        !           853:      delete
        !           854:           (cond ((eq n 1)
        !           855:                  (or (dtpr (cdr cl)) (err nil))
        !           856:                  (editsmash cl (cadr cl) (cddr cl)))
        !           857:                 (t (setq cl (Cnth cl (sub1 n)))
        !           858:                    (editsmash cl (car cl) (cddr cl))))
        !           859:           (return nil)
        !           860:      replace
        !           861:           (cond ((neq n 1) (setq cl (Cnth cl n))))
        !           862:           (editsmash cl (car x) (cdr cl))
        !           863:           (cond ((cdr x) (editsmash cl (car cl) (nconc (cdr x) (cdr cl))))))))
        !           864: 
        !           865: (def edit4e
        !           866:   (lambda (pat y)
        !           867:     (cond ((eq pat y) t)
        !           868:           ((atom pat)
        !           869:            (or (eq pat '&)
        !           870:                (equal pat y)
        !           871:                (and (stringp y) (stringp pat) (eqstr pat y))))
        !           872:           ((eq (car pat) '*any*)
        !           873:            (prog nil
        !           874:             lp   (cond ((null (setq pat (cdr pat))) (return nil))
        !           875:                        ((edit4e (car pat) y) (return t)))
        !           876:                  (go lp)))
        !           877:           ((and (eq (car pat) '@) (atom y))
        !           878:            (prog (z)
        !           879:                  (setq pat (cdr pat))
        !           880:                  (setq z (explodec y))
        !           881:             lp   (cond ((eq (car pat) '@)
        !           882:                         (*** freelist z)
        !           883:                         (print '=)
        !           884:                         (prin1 y)
        !           885:                         (return t))
        !           886:                        ((null z) (return nil))
        !           887:                        ((neq (car pat) (car z))
        !           888:                         (*** freelist z)
        !           889:                         (return nil)))
        !           890:                  (setq pat (cdr pat))
        !           891:                  (setq z (cdr z))
        !           892:                  (go lp)))
        !           893:           ((eq (car pat) '--)
        !           894:            (or (null (setq pat (cdr pat)))
        !           895:                (prog nil
        !           896:                 lp   (cond ((edit4e pat y) (return t))
        !           897:                            ((atom y) (return nil)))
        !           898:                      (setq y (cdr y))
        !           899:                      (go lp))))
        !           900:           ((eq (car pat) '==) (eq (cdr pat) y))
        !           901:           ((atom y) nil)
        !           902:           ((edit4e (car pat) (car y)) (edit4e (cdr pat) (cdr y))))))
        !           903: 
        !           904: (def editqf
        !           905:   (lambda (pat)
        !           906:     (prog (q1)
        !           907:           (cond ((and (dtpr (car l))
        !           908:                       (dtpr (setq q1 (cdar l)))
        !           909:                       (setq q1 (memq pat q1)))
        !           910:                  (setq l
        !           911:                        (cons (cond (upfindflg q1)
        !           912:                                    (t (setq lastail q1) (car q1)))
        !           913:                              l)))
        !           914:                 (t (edit4f pat 'n))))))
        !           915: 
        !           916: (def edit4f
        !           917:   (lambda (pat %%x)
        !           918:     (prog (ll x %%w)
        !           919:           (setq %%w (ncons nil))
        !           920:           (setq com pat)
        !           921:           (setq pat (editfpat pat))
        !           922:           (setq ll l)
        !           923:           (cond
        !           924:            ((eq %%x 'n)
        !           925:             (setq %%x 1)
        !           926:             (cond ((atom (car l)) (go lp1))
        !           927:                   ((and (atom (caar l)) upfindflg)
        !           928:                    (setq ll (cons (caar l) l))
        !           929:                    (go lp1))
        !           930:                   (t (setq ll (cons (caar l) l))))))
        !           931:           (cond ((and %%x (not (numberp %%x))) (setq %%x 1)))
        !           932:           (cond
        !           933:            ((and (edit4e (cond ((and (dtpr pat) (eq (car pat) ':::))
        !           934:                                 (cdr pat))
        !           935:                                (t pat))
        !           936:                          (car ll))
        !           937:                  (or (null %%x) (eq (setq %%x (sub1 %%x)) 0)))
        !           938:             (return (setq l ll))))
        !           939:           (setq x (car ll))
        !           940:      lp   (cond ((edit4f1 pat x maxlevel)
        !           941:                  (and (cdr l) (setq unfind l))
        !           942:                  (return
        !           943:                   (car
        !           944:                    (setq l
        !           945:                          (nconc (car %%w)
        !           946:                                 (cond ((eq (cadr %%w) (car ll)) (cdr ll))
        !           947:                                       (t ll)))))))
        !           948:                 ((null %%x) (err nil)))
        !           949:      lp1  (setq x (car ll))
        !           950:           (cond ((null (setq ll (cdr ll))) (err nil))
        !           951:                 ((and (setq x (memq x (car ll))) (dtpr (setq x (cdr x))))
        !           952:                  (go lp)))
        !           953:           (go lp1))))
        !           954: 
        !           955: (def editfpat
        !           956:   (lambda (pat)
        !           957:     (cond ((dtpr pat)
        !           958:            (cond ((or (eq (car pat) '==) (eq (car pat) '@)) pat)
        !           959:                  (t (mapcar (function editfpat) pat))))
        !           960:           ((eq (nthchar pat -1) '@) (cons '@ (explodec pat)))
        !           961:           (t pat))))
        !           962: 
        !           963: (def edit4f1
        !           964:   (lambda (pat x lvl)
        !           965:     (prog nil
        !           966:      lp   (cond ((not (> lvl 0))
        !           967:                  (terpri)
        !           968:                  (princ '"maxlevel exceeded")
        !           969:                  (return nil))
        !           970:                 ((atom x) (return nil))
        !           971:                 ((and (dtpr pat)
        !           972:                       (eq (car pat) ':::)
        !           973:                       (edit4e (cdr pat) x)
        !           974:                       (or (null %%x) (eq (setq %%x (sub1 %%x)) 0))))
        !           975:                 ((and (or (atom pat) (neq (car pat) ':::))
        !           976:                       (edit4e pat (car x))
        !           977:                       (or (null %%x) (eq (setq %%x (sub1 %%x)) 0)))
        !           978:                  (cond
        !           979:                   ((or (null upfindflg) (dtpr (car x)))
        !           980:                    (setq lastail x)
        !           981:                    (setq x (car x)))))
        !           982:                 ((and pat
        !           983:                       (eq pat (cdr x))
        !           984:                       (or (null %%x) (eq (setq %%x (sub1 %%x)) 0)))
        !           985:                  (setq x (cdr x)))
        !           986:                 ((and %%x
        !           987:                       (dtpr (car x))
        !           988:                       (edit4f1 pat (car x) (sub1 lvl))
        !           989:                       (eq %%x 0))
        !           990:                  (setq x (car x)))
        !           991:                 (t (setq x (cdr x)) (setq lvl (sub1 lvl)) (go lp)))
        !           992:           (cond ((and %%w (neq x (cadr %%w))) (tconc %%w x)))
        !           993:           (return (or %%w t)))))
        !           994: 
        !           995: (def editfindp
        !           996:   (lambda (x pat flg)
        !           997:     (prog (%%x lastail %%w)
        !           998:           (setq %%x 1)
        !           999:           (and (null flg) (setq pat (editfpat pat)))
        !          1000:           (return (or (edit4e pat x) (edit4f1 pat x maxlevel))))))
        !          1001: 
        !          1002: (def editbf
        !          1003:   (lambda (pat n)
        !          1004:     (prog (ll x y %%w)
        !          1005:           (setq ll l)
        !          1006:           (setq %%w (ncons nil))
        !          1007:           (setq com pat)
        !          1008:           (setq pat (editfpat pat))
        !          1009:           (cond ((and (null n) (cdr ll)) (go lp1)))
        !          1010:      lp   (cond
        !          1011:            ((editbf1 pat (car ll) maxlevel y)
        !          1012:             (setq unfind l)
        !          1013:             (return
        !          1014:              (car
        !          1015:               (setq l
        !          1016:                     (nconc (car %%w)
        !          1017:                            (cond ((eq (car ll) (cadr %%w)) (cdr ll))
        !          1018:                                  (t ll))))))))
        !          1019:      lp1  (setq x (car ll))
        !          1020:           (cond ((null (setq ll (cdr ll))) (err nil))
        !          1021:                 ((or (setq y (memq x (car ll))) (setq y (tailp x (car ll))))
        !          1022:                  (go lp)))
        !          1023:           (go lp1))))
        !          1024: 
        !          1025: (def editbf1
        !          1026:   (lambda (pat x lvl tail)
        !          1027:     (prog (y)
        !          1028:      lp   (cond ((not (> lvl 0))
        !          1029:                  (terpri)
        !          1030:                  (princ '"maxlevel exceeded")
        !          1031:                  (return nil))
        !          1032:                 ((eq tail x)
        !          1033:                  (return
        !          1034:                   (cond
        !          1035:                    ((edit4e (cond ((and (dtpr pat)
        !          1036:                                         (eq (car pat) ':::))
        !          1037:                                    (cdr pat))
        !          1038:                                   (t pat))
        !          1039:                             x)
        !          1040:                     (tconc %%w x))))))
        !          1041:           (setq y x)
        !          1042:      lp1  (cond
        !          1043:            ((null (or (eq (cdr y) tail) (atom (cdr y))))
        !          1044:             (setq y (cdr y))
        !          1045:             (go lp1)))
        !          1046:           (setq tail y)
        !          1047:           (cond ((and (dtpr (car tail))
        !          1048:                       (editbf1 pat (car tail) (sub1 lvl) nil))
        !          1049:                  (setq tail (car tail)))
        !          1050:                 ((and (dtpr pat)
        !          1051:                       (eq (car pat) ':::)
        !          1052:                       (edit4e (cdr pat) tail)))
        !          1053:                 ((and (or (atom pat) (neq (car pat) ':::))
        !          1054:                       (edit4e pat (car tail)))
        !          1055:                  (cond
        !          1056:                   ((or (null upfindflg) (dtpr (car tail)))
        !          1057:                    (setq lastail tail)
        !          1058:                    (setq tail (car tail)))))
        !          1059:                 ((and pat (eq pat (cdr tail))) (setq x (cdr x)))
        !          1060:                 (t (setq lvl (sub1 lvl)) (go lp)))
        !          1061:           (cond ((neq tail (cadr %%w)) (tconc %%w tail)))
        !          1062:           (return %%w))))
        !          1063: 
        !          1064: (def editnth
        !          1065:   (lambda (x n)
        !          1066:     (cond ((atom x) (err nil))
        !          1067:           ((not (numberp n))
        !          1068:            (or (memq n x) (memq (setq n (editelt n (ncons x))) x) (tailp n x)))
        !          1069:           ((eq n 0) (err nil))
        !          1070:           ((null
        !          1071:             (setq n
        !          1072:                   (cond
        !          1073:                    ((or (not (minusp n))
        !          1074:                         (> (setq n (plus (length x) n 1)) 0))
        !          1075:                     (Cnth x n)))))
        !          1076:            (err nil))
        !          1077:           (t n))))
        !          1078: 
        !          1079: (def bpnt0
        !          1080:   (lambda (y n)
        !          1081:     (cond ((neq lastp1 l) (setq lastp2 lastp1) (setq lastp1 l)))
        !          1082:     (cond (n (setq $%dotflg (tailp (car l) (cadr l)))
        !          1083:              (setq %prevfn% '" ")
        !          1084:              (printlev y n))
        !          1085:           (t (terpri) (*** sprint y 1) ($prpr y) (terpri)))))
        !          1086: 
        !          1087: (def bpnt
        !          1088:   (lambda (x)
        !          1089:     (prog (y n)
        !          1090:           (cond ((eq (car x) 0)
        !          1091:                  (setq y (car l))
        !          1092:                  (setq $%dotflg (tailp (car l) (cadr l))))
        !          1093:                 (t (setq y (car (editnth (car l) (car x))))))
        !          1094:           (cond ((null (cdr x)) (setq n 2))
        !          1095:                 ((not (numberp (setq n (cadr x)))) (err nil))
        !          1096:                 ((minusp n) (err nil)))
        !          1097:           (setq %prevfn% '" ")
        !          1098:           (return (printlev y n)))))
        !          1099: 
        !          1100: (def editri
        !          1101:   (lambda (m n x)
        !          1102:     (prog (a b)
        !          1103:           (setq a (editnth x m))
        !          1104:           (setq b (editnth (car a) n))
        !          1105:           (cond ((or (null a) (null b)) (err nil)))
        !          1106:           (editsmash a (car a) (editnconc (cdr b) (cdr a)))
        !          1107:           (editsmash b (car b) nil))))
        !          1108: 
        !          1109: (def editro
        !          1110:   (lambda (n x)
        !          1111:     (setq x (editnth x n))
        !          1112:     (cond ((or (null x) (atom (car x))) (err nil)))
        !          1113:     (editsmash (setq n (last (car x))) (car n) (cdr x))
        !          1114:     (editsmash x (car x) nil)))
        !          1115: 
        !          1116: (def editli
        !          1117:   (lambda (n x)
        !          1118:     (setq x (editnth x n))
        !          1119:     (cond ((null x) (err nil)))
        !          1120:     (editsmash x (cons (car x) (cdr x)) nil)))
        !          1121: 
        !          1122: (def editlo
        !          1123:   (lambda (n x)
        !          1124:     (setq x (editnth x n))
        !          1125:     (cond ((or (null x) (atom (car x))) (err nil)))
        !          1126:     (editsmash x (caar x) (cdar x))))
        !          1127: 
        !          1128: (def editbi
        !          1129:   (lambda (m n x)
        !          1130:     (prog (a b)
        !          1131:           (setq b (cdr (setq a (editnth x n))))
        !          1132:           (setq x (editnth x m))
        !          1133:           (cond ((and a (not (> (length a) (length x))))
        !          1134:                  (editsmash a (car a) nil)
        !          1135:                  (editsmash x (cons (car x) (cdr x)) b))
        !          1136:                 (t (err nil))))))
        !          1137: 
        !          1138: (def editbo
        !          1139:   (lambda (n x)
        !          1140:     (setq x (editnth x n))
        !          1141:     (cond ((atom (car x)) (err nil)))
        !          1142:     (editsmash x (caar x) (editnconc (cdar x) (cdr x)))))
        !          1143: 
        !          1144: (def editdefault
        !          1145:   (lambda (editx)
        !          1146:     (prog nil
        !          1147:           (cond (lcflg
        !          1148:                  (return
        !          1149:                   (cond ((eq lcflg t) (editqf editx))
        !          1150:                         (t (editcom (list lcflg editx) topflg)))))
        !          1151:                 ((null topflg) (err nil))
        !          1152:                 ((memq editx editcomsl)
        !          1153:                  (cond (readbuf (setq editx (cons editx readbuf))
        !          1154:                                 (setq readbuf nil))
        !          1155:                        (t (err nil))))
        !          1156:                 (t (err nil)))
        !          1157:           (return (editcom (setq com editx) topflg)))))
        !          1158: 
        !          1159: (def edup
        !          1160:   (lambda nil
        !          1161:     (prog (c-exp l1 x y)
        !          1162:           (setq c-exp (car l))
        !          1163:      lp   (cond ((null (setq l1 (cdr l))) (err nil))
        !          1164:                 ((tailp c-exp (car l1)) (return nil))
        !          1165:                 ((not (setq x (memq c-exp (car l1)))) (err nil))
        !          1166:                 ((or (eq x lastail) (not (setq y (memq c-exp (cdr x))))))
        !          1167:                 ((and (eq c-exp (car lastail)) (tailp lastail y))
        !          1168:                  (setq x lastail))
        !          1169:                 (t (terpri)
        !          1170:                    (princ c-exp)
        !          1171:                    (princ '"- location uncertain")))
        !          1172:           (cond ((eq x (car l1)) (setq l l1)) (t (setq l (cons x l1))))
        !          1173:           (return nil))))
        !          1174: 
        !          1175: (def edit*l
        !          1176:   (lambda (l)
        !          1177:     (edup)
        !          1178:     (length (car l))))
        !          1179: 
        !          1180: (def edit*
        !          1181:   (lambda (n)
        !          1182:     (car
        !          1183:      (setq l
        !          1184:            ((lambda (com l m)
        !          1185:                     (cond ((not (> m n)) (err nil)))
        !          1186:                     (edit!0)
        !          1187:                     (edit1f (difference n m) l))
        !          1188:             nil
        !          1189:             l
        !          1190:             (edit*l l))))))
        !          1191: 
        !          1192: (def edor
        !          1193:   (lambda (coms)
        !          1194:     (prog nil
        !          1195:      lp   (cond ((null coms) (err nil))
        !          1196:                 ((dtpr
        !          1197:                   (errset
        !          1198:                    (setq l
        !          1199:                          ((lambda (l)
        !          1200:                                   (cond ((atom (car coms))
        !          1201:                                          (editcom (car coms) nil))
        !          1202:                                         (t (editcoms (car coms))))
        !          1203:                                   l)
        !          1204:                           l))))
        !          1205:                  (return (car l))))
        !          1206:           (setq coms (cdr coms))
        !          1207:           (go lp))))
        !          1208: 
        !          1209: (def errcom
        !          1210:   (lambda (coms)
        !          1211:     (errset (editcoms coms))))
        !          1212: 
        !          1213: (def edrpt
        !          1214:   (lambda (edrx quiet)
        !          1215:     (prog (edrl edrptcnt)
        !          1216:           (setq edrl l)
        !          1217:           (setq edrptcnt 0)
        !          1218:      lp   (cond ((> edrptcnt maxloop)
        !          1219:                  (terpri)
        !          1220:                  (princ '"maxloop exceeded"))
        !          1221:                 ((dtpr (errcom edrx))
        !          1222:                  (setq edrl l)
        !          1223:                  (setq edrptcnt (add1 edrptcnt))
        !          1224:                  (go lp))
        !          1225:                 ((null quiet) (print edrptcnt) (princ 'occurrences)))
        !          1226:           (setq l edrl))))
        !          1227: 
        !          1228: (def edloc
        !          1229:   (lambda (edx)
        !          1230:     (prog (oldl oldf lcflg edl)
        !          1231:           (setq oldl l)
        !          1232:           (setq oldf unfind)
        !          1233:           (setq lcflg t)
        !          1234:           (cond ((atom edx) (editcom edx nil))
        !          1235:                 ((and (null (cdr edx)) (atom (car edx)))
        !          1236:                  (editcom (car edx) nil))
        !          1237:                 (t (go lp)))
        !          1238:           (setq unfind oldl)
        !          1239:           (return (car l))
        !          1240:      lp   (setq edl l)
        !          1241:           (cond ((dtpr (errcom edx)) (setq unfind oldl) (return (car l))))
        !          1242:           (cond ((equal edl l) (setq l oldl) (setq unfind oldf) (err nil)))
        !          1243:           (go lp))))
        !          1244: 
        !          1245: (def edlocl
        !          1246:   (lambda (coms)
        !          1247:     (car
        !          1248:      (setq l
        !          1249:            (nconc ((lambda (l unfind) (edloc coms) l) (ncons (car l)) nil)
        !          1250:                   (cdr l))))))
        !          1251: 
        !          1252: (def edit:
        !          1253:   (lambda (type lc x)
        !          1254:     (prog (toflg l0)
        !          1255:           (setq l0 l)
        !          1256:           (setq x
        !          1257:                 (mapcar (function
        !          1258:                          (lambda (x)
        !          1259:                                  (cond ((and (dtpr x)
        !          1260:                                              (eq (car x) '|##|))
        !          1261:                                         ((lambda (l undolst1)
        !          1262:                                                  (copy (editcoms (cdr x))))
        !          1263:                                          l
        !          1264:                                          nil))
        !          1265:                                        (t x))))
        !          1266:                         x))
        !          1267:           (cond
        !          1268:            (lc (cond ((eq (car lc) 'here) (setq lc (cdr lc))))
        !          1269:                (edloc lc)))
        !          1270:           (edup)
        !          1271:           (cond ((eq l0 l) (setq lc nil)))
        !          1272:           (selectq type
        !          1273:                    ((b before) (edit2f -1 x))
        !          1274:                    ((a after)
        !          1275:                     (cond ((cdar l) (edit2f -2 x))
        !          1276:                           (t (editcoml (cons 'n x) copyflg))))
        !          1277:                    ((: for)
        !          1278:                     (cond ((or x (cdar l)) (edit2f 1 x))
        !          1279:                           ((memq (car l) (cadr l))
        !          1280:                            (edup)
        !          1281:                            (edit2f 1 (ncons nil)))
        !          1282:                           (t (editcoms '(0 (nth -2) (2)))))
        !          1283:                     (return (cond ((null lc) l))))
        !          1284:                    (err nil))
        !          1285:           (return nil))))
        !          1286: 
        !          1287: (def editmbd
        !          1288:   (lambda (lc x)
        !          1289:     (prog (y toflg)
        !          1290:           (cond (lc (edloc lc)))
        !          1291:           (edup)
        !          1292:           (setq y (cond (toflg (caar l)) (t (ncons (caar l)))))
        !          1293:           (edit2f 1
        !          1294:                   (ncons
        !          1295:                    (cond ((or (atom (car x)) (cdr x)) (append x y))
        !          1296:                          (t (lsubst y '* (car x))))))
        !          1297:           (setq l
        !          1298:                 (cons (caar l)
        !          1299:                       (cond ((tailp (car l) (cadr l)) (cdr l)) (t l))))
        !          1300:           (return (cond ((null lc) l))))))
        !          1301: 
        !          1302: (def editxtr
        !          1303:   (lambda (lc x)
        !          1304:     (prog (toflg)
        !          1305:           (cond (lc (edloc lc)))
        !          1306:           ((lambda (l unfind)
        !          1307:                    (edloc x)
        !          1308:                    (setq x
        !          1309:                          (cond ((tailp (car l) (cadr l)) (caar l))
        !          1310:                                (t (car l)))))
        !          1311:            (ncons (cond ((tailp (car l) (cadr l)) (caar l)) (t (car l))))
        !          1312:            nil)
        !          1313:           (edup)
        !          1314:           (edit2f 1 (cond (toflg (append x nil)) (t (ncons x))))
        !          1315:           (and (null toflg)
        !          1316:                (dtpr (caar l))
        !          1317:                (setq l
        !          1318:                      (cons (caar l)
        !          1319:                            (cond ((tailp (car l) (cadr l)) (cdr l)) (t l))))))))
        !          1320: 
        !          1321: (def editelt
        !          1322:   (lambda (lc l)
        !          1323:     (prog (y)
        !          1324:           (edloc lc)
        !          1325:      lp   (setq y l)
        !          1326:           (cond ((cdr (setq l (cdr l))) (go lp)))
        !          1327:           (return (car y)))))
        !          1328: 
        !          1329: (def editcont
        !          1330:   (lambda (lc1 %%x)
        !          1331:     (setq l
        !          1332:           ((lambda (l)
        !          1333:                    (prog nil
        !          1334:                          (setq lc1 (editfpat lc1))
        !          1335:                     lp   (cond ((null (edit4f lc1 'n)) (err nil))
        !          1336:                                ((atom (errset (edlocl %%x))) (go lp)))
        !          1337:                     lp1  (cond ((null (setq l (cdr l))) (err nil))
        !          1338:                                ((cond ((atom lc1) (eq lc1 (caar l)))
        !          1339:                                       ((eq (car lc1) '@)
        !          1340:                                        (edit4e lc1 (caar l)))
        !          1341:                                       (t (edit4e lc1 (car l))))
        !          1342:                                 (return l)))
        !          1343:                          (go lp1)))
        !          1344:            l))))
        !          1345: 
        !          1346: (def editsw
        !          1347:   (lambda (m n)
        !          1348:     (prog (y z tem)
        !          1349:           (setq y (editnth (car l) m))
        !          1350:           (setq z (editnth (car l) n))
        !          1351:           (setq tem (car y))
        !          1352:           (editsmash y (car z) (cdr y))
        !          1353:           (editsmash z tem (cdr z)))))
        !          1354: 
        !          1355: (def editmv
        !          1356:   (lambda (lc op x cp)
        !          1357:     (prog (l0 l1 z toflg)
        !          1358:           (setq l0 l)
        !          1359:           (and lc (edloc lc))
        !          1360:           (cond ((eq op 'here)
        !          1361:                  (cond ((null lc) (edloc x) (setq x nil)))
        !          1362:                  (setq op ':))
        !          1363:                 ((eq (car x) 'here)
        !          1364:                  (cond ((null lc) (edloc (cdr x)) (setq x nil))
        !          1365:                        (t (setq x (cdr x))))))
        !          1366:           (edup)
        !          1367:           (setq l1 l)
        !          1368:           (setq z (cond (cp (copy (caar l))) (t (caar l))))
        !          1369:           (setq l l0)
        !          1370:           (and x (edloc x))
        !          1371:           (cond ((eq op 'after) (setq op 'a))
        !          1372:                 ((eq op 'before) (setq op 'b)))
        !          1373:           (editcoml (cond (toflg (cons op (append z nil))) (t (list op z)))
        !          1374:                     nil)
        !          1375:           (prog (l)
        !          1376:                 (setq l l1)
        !          1377:                 (cond ((not cp) (editcoms '(1 delete)))
        !          1378:                       (toflg (editcoml '(bo 1) nil))))
        !          1379:           (return
        !          1380:            (cond ((null lc) (setq unfind l1) l)
        !          1381:                  ((null x) (setq unfind l1) l0)
        !          1382:                  (t (setq unfind l) l0))))))
        !          1383: 
        !          1384: (def editto
        !          1385:   (lambda (lc1 lc2 flg)
        !          1386:     (setq l
        !          1387:           ((lambda (l)
        !          1388:                    (cond (lc1 (edloc lc1) (edup)))
        !          1389:                    (editbi 1
        !          1390:                            (cond ((and (numberp lc1)
        !          1391:                                        (numberp lc2)
        !          1392:                                        (> lc2 lc1))
        !          1393:                                   (difference (add1 lc2) lc1))
        !          1394:                                  (t lc2))
        !          1395:                            (car l))
        !          1396:                    (cond
        !          1397:                     ((and (eq flg 'to) (cdaar l))
        !          1398:                      (editri 1 -2 (car l))))
        !          1399:                    (editcom 1 nil)
        !          1400:                    l)
        !          1401:            l))
        !          1402:     (setq toflg t)))
        !          1403: 
        !          1404: (def editbelow
        !          1405:   (lambda (place depth)
        !          1406:     (cond ((minusp (setq depth (eval depth))) (err nil)))
        !          1407:     (prog (n1 n2)
        !          1408:           (setq n1
        !          1409:                 (length
        !          1410:                  ((lambda (l lcflg) (editcom place nil) l) l '_)))
        !          1411:           (setq n2 (length l))
        !          1412:           (cond ((< n2 (+ n1 depth)) (err nil)))
        !          1413:           (setq unfind l)
        !          1414:           (setq l (Cnth l (difference (add1 n2) n1 depth))))))
        !          1415: 
        !          1416: (def editran
        !          1417:   (lambda (c def)
        !          1418:     (setq l
        !          1419:           (or ((lambda (l)
        !          1420:                        (prog (z w)
        !          1421:                              (cond ((null def) (err nil))
        !          1422:                                    ((null (setq z (car def))) (go out)))
        !          1423:                         lp   (cond ((null z) (err nil))
        !          1424:                                    ((null (setq w (memq (car z) c)))
        !          1425:                                     (setq z (cdr z))
        !          1426:                                     (go lp)))
        !          1427:                         out  (setq z
        !          1428:                                    (apply (car (setq def (cadr def)))
        !          1429:                                           (prog (|#1| |#2| |#3|)
        !          1430:                                                 (setq |#1| (cdr
        !          1431:                                                             (ldiff c w)))
        !          1432:                                                 (setq |#2| (car z))
        !          1433:                                                 (setq |#3| (cdr w))
        !          1434:                                                 (return
        !          1435:                                                  (mapcar (function
        !          1436:                                                           (lambda (x)
        !          1437:                                                                   (cond ((atom
        !          1438:                                                                           x)
        !          1439:                                                                          (selectq x
        !          1440:                                                                                   (|#1|
        !          1441:                                                                                    |#1|)
        !          1442:                                                                                   (|#2|
        !          1443:                                                                                    |#2|)
        !          1444:                                                                                   (|#3|
        !          1445:                                                                                    |#3|)
        !          1446:                                                                                   x))
        !          1447:                                                                         (t
        !          1448:                                                                          (eval
        !          1449:                                                                           x)))))
        !          1450:                                                          (cdr def))))))
        !          1451:                              (return
        !          1452:                               (cond ((null z) (setq unfind l) nil) (t z)))))
        !          1453:                l)
        !          1454:               l))))
        !          1455: 
        !          1456: (def edit!0
        !          1457:   (lambda nil
        !          1458:     (cond ((null (cdr l)) (err nil)))
        !          1459:     (prog nil
        !          1460:      lp   (setq l (cdr l))
        !          1461:           (cond ((tailp (car l) (cadr l)) (go lp))))))
        !          1462: 
        !          1463: (def editrepack
        !          1464:   (lambda nil
        !          1465:     (cond ((dtpr (car l)) (setq l (edit1f 1 l))))
        !          1466:     (edit: ': nil (ncons (readlist (edite (explode (car l)) nil nil))))))
        !          1467: 
        !          1468: (def editmakefn
        !          1469:   (lambda (ex args n m)
        !          1470:     (editbi n m (car l))
        !          1471:     (edloc n)
        !          1472:     (editbelow '/ 1)
        !          1473:     (mapc (function (lambda (x y) (editdsubst x y (car l)))) args (cdr ex))
        !          1474:     (putprop (car ex) (cons 'lambda (cons args (car l))) 'expr)
        !          1475:     (mark!changed (car ex))
        !          1476:     (edup)
        !          1477:     (edit2f 1 (ncons ex))))
        !          1478: 
        !          1479: (dv usermacros nil)
        !          1480: 
        !          1481: (dv editracefn nil)
        !          1482: 
        !          1483: (dv lastword editsfns)
        !          1484: 
        !          1485: (dv maxlevel 192)
        !          1486: 
        !          1487: (dv maxloop 24)
        !          1488: 
        !          1489: (dv editcomsl
        !          1490:     (: a
        !          1491:        b
        !          1492:        below
        !          1493:        bf
        !          1494:        bi
        !          1495:        bind
        !          1496:        bk
        !          1497:        bo
        !          1498:        change
        !          1499:        coms
        !          1500:        comsq
        !          1501:        copy
        !          1502:        cp
        !          1503:        delete
        !          1504:        e
        !          1505:        embed
        !          1506:        extract
        !          1507:        f
        !          1508:        f=
        !          1509:        fs
        !          1510:        help
        !          1511:        i
        !          1512:        if
        !          1513:        insert
        !          1514:        lc
        !          1515:        lcl
        !          1516:        li
        !          1517:        lo
        !          1518:        lp
        !          1519:        lpq
        !          1520:        m
        !          1521:        makefn
        !          1522:        mbd
        !          1523:        move
        !          1524:        mv
        !          1525:        n
        !          1526:        nex
        !          1527:        nth
        !          1528:        nx
        !          1529:        orf
        !          1530:        orr
        !          1531:        p
        !          1532:        r
        !          1533:        repack
        !          1534:        replace
        !          1535:        ri
        !          1536:        ro
        !          1537:        s
        !          1538:        second
        !          1539:        surround
        !          1540:        sw
        !          1541:        third
        !          1542:        thru
        !          1543:        to
        !          1544:        undo
        !          1545:        xtr
        !          1546:        _))
        !          1547: 
        !          1548: (dv autop 2)
        !          1549: 
        !          1550: (dv upfindflg t)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.