;;;-*-Lisp-*-

(declare (load '((alan) lspenv init)))

(defstruct (frame default-pointer conc-name
		  (eval-when (eval compile)))
	   n
	   evf
	   (up nil)
	   (down nil))

(eval-when (eval compile)

(defmacro frame-type (&optional (frame 'frame))
	  `(car (frame-evf ,frame)))

(defmacro frame-pdl (&optional (frame 'frame))
	  `(cadr (frame-evf ,frame)))

(defmacro frame-stuff (&optional (frame 'frame))
	  `(caddr (frame-evf ,frame)))

(defmacro frame-env (&optional (frame 'frame))
	  `(cadddr (frame-evf ,frame)))

)

(defun crawl ()
       (do ((prev nil frame)
	    (evf (evalframe nil)
		 (evalframe (cadr evf)))
	    (n 0 (1+ n))
	    (top)
	    (frame))
	   ((null evf) (crawl-loop top frame))
	   (setq frame (make-frame n n
				   up prev
				   evf evf))
	   (if (null prev)
	       (setq top frame)
	       (setf (frame-down prev) frame))))

(defun crawl-loop (top bottom)
  (let ((frame top))
       (print-crawl-frame frame)
       (do ((flag nil))
	   (())
	   (terpri)
	   (tyo #/.)
   forgive (setq flag nil)
 next-char (caseq (tyi)
		  ((#/d #/D)
		   (setq frame (crawl-new-frame frame (frame-down))))
		  ((#/u #/U)
		   (setq frame (crawl-new-frame frame (frame-up))))
		  ((#/r #/R)
		   (terpri)
		   (princ "Form to evaluate and return: ")
		   (errset (freturn (frame-pdl) (eval (read) (frame-env)))))
		  ((#/e #/E)
		   (terpri)
		   (princ "Form to evaluate: ")
		   (errset (print (eval (read) (frame-env)))))
		  ((#/c #/C)
		   (fretry (frame-pdl)
			   (frame-evf)))
		  ((#/g #/G)
		   (or (get 'gprint1 'lsubr)
		       (load '((liblsp) gprint fasl)))
		   (terpri)
		   (gprint1 (frame-stuff) nil nil nil nil nil nil))
		  ((#/t #/T)
		   (setq frame (crawl-new-frame frame top)))
		  ((#/b #/B)
		   (setq frame (crawl-new-frame frame bottom)))
		  ((#/j #/J)
		   (princ " -> ")
		   (setq frame (crawl-find-numbered-frame frame top (read))))
		  ((#\form #/l #/L)
		   (print-crawl-frame frame))
		  ((#/q #/Q)
		   (return 'done))
		  ((#/i #/I)
		   (cond (flag (inspect (frame-stuff)))
			 (t
			  (terpri)
			  (princ "Form to evaluate and inspect: ")
			  (errset (inspect (eval (read) (frame-env)))))))
		  ((#/p #/P)
		   (cond (flag (describe (frame-stuff)))
			 (t
			  (terpri)
			  (princ "Form to evaluate and describe: ")
			  (errset (describe (eval (read) (frame-env)))))))
		  ((#\alt) (setq flag t) (go next-char))
		  ((#/? #//)
		   (princ "
CRAWL Commands:

U - Up a frame
D - Down a frame
T - go to Top frame
B - go to Bottom frame
J - Jump to a numbered frame
E - Evaluate a form in current frame
R - Return from current frame
C - Continue current frame (start over)
G - Grind stuff in current frame
I - Inspect
<alt>I - Inspect contents of current frame
P - describe (Print cute)
<alt>P - describe contents of current frame
Q - Quit"))
		  ((#\space #\cr #\lf)
		   (go forgive))
		  (t
		   (princ " ???"))))))

(defun crawl-new-frame (old new)
       (cond ((null new)
	      (princ " No more.")
	      old)
	     (t
	      (print-crawl-frame new)
	      new)))

(defun print-crawl-frame (frame)
  (let ((prinlength 4)
	(prinlevel 3))
    (caseq (frame-type)
	   (eval
	    (terpri)
	    (princ (frame-n))
	    (princ " Evaluating ")
	    (prin1 (frame-stuff)))
	   (apply
	    (terpri)
	    (princ (frame-n))
	    (princ " Applying ")
	    (prin1 (car (frame-stuff)))
	    (terpri)
	    (princ "To ")
	    (prin1 (cadr (frame-stuff))))
	   (t (error "-- wierd evalframe." (frame-type))))))

(defun crawl-find-numbered-frame (old top n)
       (do ((frame top (frame-down)))
	   ((null frame)
	    (princ " Not found.")
	    old)
	   (and (= n (frame-n))
		(return (crawl-new-frame old frame)))))