updating lisp programs, lisp lib

2025-04-09 13:15:59 -07:00
parent 8f2a2be9ab
commit 268b8f2ee2
5 changed files with 133 additions and 60 deletions
--- a/lisp/edit.lsp
+++ b/lisp/edit.lsp
@@ -0,0 +1,45 @@
+(defvar *cmds* nil)
+
+(defun %edit (fun)
+  (cond
+   ((null *cmds*) fun)
+   ((eq (car *cmds*) #\b) (pop *cmds*) fun)
+   ((eq (car *cmds*) #\e) (pop *cmds*) (%edit (list fun)))
+   ((eq (car *cmds*) #\h) (pop *cmds*) (%edit (cons 'highlight (list fun))))
+   ((consp (car *cmds*))
+    (let ((val (cdar *cmds*)))
+      (case (caar *cmds*)
+        (#\r (pop *cmds*) (%edit val))
+        ((#\c #\i) (pop *cmds*) (%edit (cons val fun)))
+        (#\f (cond
+              ((null fun) nil)
+              ((equal val fun) (pop *cmds*) (%edit fun))
+              ((atom fun) fun)
+              (t (cons (%edit (car fun)) (%edit (cdr fun)))))))))
+   ((atom fun) (pop *cmds*) (%edit fun))
+   ((eq (car *cmds*) #\d) (pop *cmds*) (%edit (cons (car fun) (%edit (cdr fun)))))
+   ((eq (car *cmds*) #\a) (pop *cmds*) (%edit (cons (%edit (car fun)) (cdr fun))))
+   ((eq (car *cmds*) #\x) (pop *cmds*) (%edit (cdr fun)))
+   (t fun)))
+
+(defun edit (name)
+  (let ((fun (eval name))
+        cc)
+    (setq *cmds* nil)
+    (loop
+     (write-byte 12)
+     (setq cc (append cc (list #\h)))
+     (setq *cmds* cc)
+     (pprint (%edit fun))
+     (setq cc (butlast cc))
+     (let ((c (get-key)))
+       (case c
+         (#\q (set name fun) (return name))
+         (#\s (setq *cmds* cc) (set name (%edit fun)) (return name))
+         (#\z (when cc (setq cc (butlast cc))))
+         ((#\r #\c #\i #\f #\e)
+          (write-byte 11) (princ c) (princ #\:)
+          (setq cc (append cc (list (cons c (read))))))
+         ((#\d #\a #\x #\b)
+          (setq cc (append cc (list c))))
+         (t (write-byte 7)))))))