46 lines
1.5 KiB
Common Lisp
46 lines
1.5 KiB
Common Lisp
(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)))))))
|