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