Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv4973

Modified Files: inspector.lisp Log Message: Applied patch from Christophe Rhodes which:

* deals with unbound slots; * defines a brief method for structure objects and conditions; * defines a normal method for conditions; * fixes the inspection of functions.

Date: Tue Feb 8 21:37:36 2005 Author: pscott

Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.16 mcclim/Apps/Inspector/inspector.lisp:1.17 --- mcclim/Apps/Inspector/inspector.lisp:1.16 Mon Feb 7 22:05:47 2005 +++ mcclim/Apps/Inspector/inspector.lisp Tue Feb 8 21:37:34 2005 @@ -178,23 +178,38 @@ (with-output-as-presentation (pane (cons object slot-name) 'settable-slot) (format pane "~a:" slot-name)) - (inspect-object (slot-value object slot-name) pane))))))) + (if (slot-boundp object slot-name) + (inspect-object (slot-value object slot-name) pane) + (format pane "#<unbound slot>"))))))))

;; FIXME: should this be removed? It's really ugly. (defparameter *object-representation-max-length* 300 "Maximum number of characters of an object's textual representation that are allowed before abbreviation kicks in")

+(defun inspect-structure-or-object-briefly (object pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (handler-case + (let ((representation (with-output-to-string (string) + (prin1 object string)))) + (if (< (length representation) *object-representation-max-length*) + (princ representation pane) + (format pane "#<~S ...>" (class-name (class-of object))))) + (error () + (format pane "#<unprintable ~S>" (class-name (class-of object))))))) + ;; Try to print the normal, textual representation of an object, but ;; if that's too long, make an abbreviated "instance of ~S" version. + (defmethod inspect-object-briefly ((object standard-object) pane) - (with-output-as-presentation - (pane object (presentation-type-of object)) - (let ((representation (with-output-to-string (string) - (prin1 object string)))) - (if (< (length representation) *object-representation-max-length*) - (princ representation pane) - (format pane "#<~S ...>" (class-name (class-of object))))))) + (inspect-structure-or-object-briefly object pane)) + +(defmethod inspect-object-briefly ((object structure-object) pane) + (inspect-structure-or-object-briefly object pane)) + +(defmethod inspect-object-briefly ((object condition) pane) + (inspect-structure-or-object-briefly object pane))

(defmethod inspect-object ((object standard-object) pane) (inspect-structure-or-object object pane)) @@ -202,6 +217,9 @@ (defmethod inspect-object ((object structure-object) pane) (inspect-structure-or-object object pane))

+(defmethod inspect-object ((object condition) pane) + (inspect-structure-or-object object pane)) + (defun inspect-cons-as-cells (object pane) "Inspect a cons cell in a fancy graphical way. The inconvenient part is that this necessarily involves quite a bit of clicking to show a @@ -319,10 +337,13 @@ (prin1 fun string)))) ;; If we have SBCL, try to do fancy formatting. If anything goes ;; wrong with that, fall back on ugly standard PRIN1. - #+sbcl (handler-case (format nil "~A ~S" - (sb-impl::%simple-fun-name fun) - (sb-impl::%simple-fun-arglist fun)) - (error () (generic-print fun))) + #+sbcl + (unless (typep fun 'generic-function) + (let ((fun (sb-kernel:%closure-fun fun))) + (handler-case (format nil "~A ~S" + (sb-kernel:%simple-fun-name fun) + (sb-kernel:%simple-fun-arglist fun)) + (error () (generic-print fun))))) ;; FIXME: Other Lisp implementations have ways of getting this ;; information. If you want a better inspector on a non-SBCL Lisp, ;; please add code for it and send patches. @@ -333,8 +354,10 @@ (pane object (presentation-type-of object)) (format pane "Function: ~A" (pretty-print-function object)) - #+sbcl (format pane "~&Type: ~A" - (sb-impl::%simple-fun-type object)) + #+sbcl + (unless (typep object 'generic-function) + (format pane "~&Type: ~A" + (sb-kernel:%simple-fun-type (sb-kernel:%closure-fun object)))) (print-documentation object pane)))

(defmethod inspect-object-briefly ((object package) pane) @@ -534,9 +557,10 @@ (clim-mop:slot-definition-type slot-object)) (format stream "~&Allocation: ~S~%" (clim-mop:slot-definition-allocation slot-object)) - ;; FIXME: This should show readers and writers, but it doesn't - ;; work on SBCL 0.8.16 for me. Is this an SBCL-specific problem? - ;; Is the code broken? + ;; FIXME: This should show readers and writers for object slots + ;; (but not structure slots), but it doesn't work on SBCL 0.8.16 + ;; for me. Is this an SBCL-specific problem? Is the code + ;; broken? (when (clim-mop:slot-definition-readers slot-object) (format stream "~&Readers: ") (format-textual-list (clim-mop:slot-definition-readers slot-object)