![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cmuedit.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / lisplib|
Return to cmuedit.l CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / lisp / lisplib |
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.