updating lisp programs, lisp lib

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)))))))

lisp/pkg.lsp

@@ -0,0 +1,24 @@
+(defvar *packages* nil)
+
+(defun load-package (filename)
+  (let* ((path  (concatenate 'string filename ".pkg"))
+	 (forms (load path)))
+   (setf *packages* (append-to-list
+		    (cons filename forms)
+		    (remove-if (lambda (x)
+				(string= (car x) filename))
+		     *packages*)))))
+
+(defun save-package (filename lst)
+  (with-sd-card (str filename 2)
+   (dolist (f lst)
+      (symbol-def f str))))
+
+(defun unload-package (package)
+ (dolist (sym (cdr (assoc package *packages*)))
+  (makunbound sym)))
+
+(defun add-to-package (filename list)
+   (with-sd-card (str filename 1)
+     (dolist (f lst)
+         (symbol-def f str))))