? ChangeLog ? X11-colors.fasl ? bordered-output.fasl ? builtin-commands.fasl ? commands.fasl ? coordinates.fasl ? decls.fasl ? defresource.fasl ? describe.fasl ? design.fasl ? dialog-views.fasl ? dialog.fasl ? encapsulate.fasl ? events.fasl ? frames.fasl ? gadgets.fasl ? grafts.fasl ? graph-formatting.fasl ? graphics.fasl ? incremental-redisplay.fasl ? input-editing.fasl ? input.fasl ? medium.fasl ? menu.fasl ? output.fasl ? package.fasl ? panes.fasl ? patch.fasl ? pixmap.fasl ? pointer-tracking.fasl ? ports.fasl ? presentation-defs.fasl ? presentations.fasl ? recording.fasl ? regions.fasl ? repaint.fasl ? setf-star.fasl ? sheets.fasl ? stream-input.fasl ? stream-output.fasl ? table-formatting.fasl ? text-formatting.fasl ? text-selection.fasl ? transforms.fasl ? utils.fasl ? views.fasl ? Apps/Inspector/inspector.fasl ? Backends/CLX/clim-extensions.fasl ? Backends/CLX/frame-manager.fasl ? Backends/CLX/graft.fasl ? Backends/CLX/image.fasl ? Backends/CLX/keysymdef.fasl ? Backends/CLX/keysyms-common.fasl ? Backends/CLX/keysyms.fasl ? Backends/CLX/medium.fasl ? Backends/CLX/package.fasl ? Backends/CLX/port.fasl ? Backends/PostScript/afm.fasl ? Backends/PostScript/class.fasl ? Backends/PostScript/encoding.fasl ? Backends/PostScript/font.fasl ? Backends/PostScript/graphics.fasl ? Backends/PostScript/package.fasl ? Backends/PostScript/paper.fasl ? Backends/PostScript/sheet.fasl ? Backends/PostScript/standard-metrics.fasl ? Experimental/menu-choose.fasl ? Goatee/buffer.fasl ? Goatee/clim-area.fasl ? Goatee/conditions.fasl ? Goatee/dbl-list.fasl ? Goatee/editable-area.fasl ? Goatee/editable-buffer.fasl ? Goatee/editing-stream.fasl ? Goatee/flexivector.fasl ? Goatee/goatee-command.fasl ? Goatee/kill-ring.fasl ? Goatee/presentation-history.fasl ? Lisp-Dep/fix-sbcl.fasl ? Lisp-Dep/mp-nil.fasl Index: Apps/Inspector/inspector.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp,v retrieving revision 1.16 diff -u -r1.16 inspector.lisp --- Apps/Inspector/inspector.lisp 7 Feb 2005 21:05:47 -0000 1.16 +++ Apps/Inspector/inspector.lisp 8 Feb 2005 12:44:50 -0000 @@ -178,7 +178,21 @@ (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 "#")))))))) + +(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 "#" (class-name (class-of object))))))) ;; FIXME: should this be removed? It's really ugly. (defparameter *object-representation-max-length* 300 @@ -187,14 +201,15 @@ ;; 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)