-(defun inspect (object)
- (unwind-protect
- (input-loop object (describe-parts object) *standard-output*)
- (setf *inspect-object-stack* nil)))
-
-;;; When *ILLEGAL-OBJECT-MARKER* occurs in a parts list, it indicates
-;;; that that slot is unbound.
-(defvar *illegal-object-marker* (cons nil nil))
-
-(defun input-loop (object parts s)
- (tty-display-object parts s)
- (loop
- (format s "~&> ")
- (force-output)
- (let ((command (read))
- ;; Use 2 less than the length because the first 2 elements
- ;; are bookkeeping.
- (parts-len-2 (- (length parts) 2)))
- (typecase command
- (integer
- (cond ((< -1 command parts-len-2)
- (cond ((eq (nth-parts parts command) *illegal-object-marker*)
- (format s "~%That slot is unbound.~%"))
- (t
- (push (cons object parts) *inspect-object-stack*)
- (setf object (nth-parts parts command))
- (setf parts (describe-parts object))
- (tty-display-object parts s))))
- (t
- (if (= parts-len-2 0)
- (format s "~%This object contains nothing to inspect.~%~%")
- (format s "~%Enter a VALID number (~:[0-~D~;0~]).~%~%"
- (= parts-len-2 1) (1- parts-len-2))))))
- (symbol
- (case (find-symbol (symbol-name command) *keyword-package*)
- ((:q :e)
- (return object))
- (:u
- (cond (*inspect-object-stack*
- (setf object (caar *inspect-object-stack*))
- (setf parts (cdar *inspect-object-stack*))
- (pop *inspect-object-stack*)
- (tty-display-object parts s))
- (t (format s "~%Bottom of Stack.~%"))))
- (:r
- (setf parts (describe-parts object))
- (tty-display-object parts s))
- (:d
- (tty-display-object parts s))
- ((:h :? :help)
- (show-help s))
- (t
- (do-inspect-eval command s))))
- (t
- (do-inspect-eval command s))))))
-
-(defun do-inspect-eval (command stream)
- (let ((result-list (restart-case (multiple-value-list (eval command))
- (nil () :report "Return to the inspector."
- (format stream "~%returning to the inspector~%")
- (return-from do-inspect-eval nil)))))
- (setf /// // // / / result-list)
- (setf +++ ++ ++ + + - - command)
- (setf *** ** ** * * (car /))
- (format stream "~&~{~S~%~}" /)))
-
-(defun show-help (s)
- (terpri)
- (write-line "inspector help:" s)
- (write-line " R - recompute current object." s)
- (write-line " D - redisplay current object." s)
- (write-line " U - Move upward through the object stack." s)
- (write-line " Q, E - Quit inspector." s)
- (write-line " ?, H, Help - Show this help." s))
-
-(defun tty-display-object (parts stream)
- (format stream "~%~A" (car parts))
- (let ((numbered-parts-p (numbered-parts-p parts))
- (parts (cddr parts)))
- (do ((part parts (cdr part))
- (i 0 (1+ i)))
- ((endp part) nil)
- (if numbered-parts-p
- (format stream "~D. ~A: ~A~%" i (caar part)
- (if (eq (cdar part) *illegal-object-marker*)
- "unbound"
- (cdar part)))
- (format stream "~D. ~A~%" i (car part))))))
+(defun eval-for-inspect (command stream)
+ (let ((result-list (restart-case
+ (multiple-value-list (interactive-eval command))
+ (nil () :report "Return to the inspector."
+ (format stream "~%returning to the inspector~%")
+ (return-from eval-for-inspect nil)))))
+ (format stream "~&~{~S~%~}" result-list)))
+
+(defun tty-display-inspected-parts (description named-p elements stream)
+ (format stream "~%~A" description)
+ (let ((index 0))
+ (dolist (element elements)
+ (if named-p
+ (destructuring-bind (name . value) element
+ (format stream "~W. ~A: ~W~%" index name
+ (if (eq value *inspect-unbound-object-marker*)
+ "unbound"
+ value)))
+ (format stream "~W. ~W~%" index element))
+ (incf index))))