- (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))))
+ (funcall *inspect-fun* object *standard-input* *standard-output*))
+
+(defvar *help-for-inspect*
+ "
+help for INSPECT:
+ Q, E - Quit the inspector.
+ <integer> - Inspect the numbered slot.
+ R - Redisplay current inspected object.
+ U - Move upward/backward to previous inspected object.
+ ?, H, Help - Show this help.
+ <other> - Evaluate the input as an expression.
+Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
+to the current inspected object, so that it can be referred to in
+evaluated expressions.
+")
+
+(defun %inspect (*inspected* s)
+ (named-let redisplay () ; "LAMBDA, the ultimate GOTO":-|
+ (multiple-value-bind (description named-p elements)
+ (inspected-parts *inspected*)
+ (tty-display-inspected-parts description named-p elements s)
+ (named-let reread ()
+ (format s "~&> ")
+ (force-output)
+ (let* (;; newly-consed object for hermetic protection against
+ ;; mischievous input like #.*EOF-OBJECT*:
+ (eof (cons *eof-object* nil))
+ (command (read *standard-input* nil eof)))
+ (when (eq command eof)
+ ;; currently-undocumented feature: EOF is handled as Q.
+ ;; If there's ever consensus that this is *the* right
+ ;; thing to do (as opposed to e.g. handling it as U), we
+ ;; could document it. Meanwhile, it seems more Unix-y to
+ ;; do this than to signal an error.
+ (/show0 "THROWing QUIT-INSPECT for EOF")
+ (throw 'quit-inspect nil))
+ (typecase command
+ (integer
+ (let ((elements-length (length elements)))
+ (cond ((< -1 command elements-length)
+ (let* ((element (nth command elements))
+ (value (if named-p (cdr element) element)))
+ (cond ((eq value *inspect-unbound-object-marker*)
+ (format s "~%That slot is unbound.~%")
+ (return-from %inspect (reread)))
+ (t
+ (%inspect value s)
+ ;; If we ever return, then we should be
+ ;; looking at *INSPECTED* again.
+ (return-from %inspect (redisplay))))))
+ ((zerop elements-length)
+ (format s "~%The object contains nothing to inspect.~%")
+ (return-from %inspect (reread)))
+ (t
+ (format s "~%Enter a valid index (~:[0-~W~;0~]).~%"
+ (= elements-length 1) (1- elements-length))
+ (return-from %inspect (reread))))))
+ (symbol
+ (case (find-symbol (symbol-name command) *keyword-package*)
+ ((:q :e)
+ (/show0 "THROWing QUIT-INSPECT for :Q or :E")
+ (throw 'quit-inspect nil))
+ (:u
+ (return-from %inspect))
+ (:r
+ (return-from %inspect (redisplay)))
+ ((:h :? :help)
+ (write-string *help-for-inspect* s)
+ (return-from %inspect (reread)))