[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp

[Peter Scott]

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

Modified Files:
	inspector.lisp 
Log Message:
Made symbols in generic function display inspectable. Added :allocation 
printing in slot descriptions, along with experimental :readers and 
:writers printing which doesn't seem to do anything in SBCL 0.8.16 for 
some reason. Added my name to the copyright area at the top, as 
suggested by Vincent Arkesteijn.

Date: Mon Feb  7 22:05:47 2005
Author: pscott

Index: mcclim/Apps/Inspector/inspector.lisp
diff -u mcclim/Apps/Inspector/inspector.lisp:1.15 mcclim/Apps/Inspector/inspector.lisp:1.16
--- mcclim/Apps/Inspector/inspector.lisp:1.15	Sat Feb  5 18:28:00 2005
+++ mcclim/Apps/Inspector/inspector.lisp	Mon Feb  7 22:05:47 2005
@@ -4,6 +4,8 @@
 ;;;           Robert Strandh (strandh at labri.fr)
 ;;;  (c) copyright 2005 by
 ;;;           Vincent Arkesteijn
+;;;  (c) copyright 2005 by
+;;;           Peter Scott (sketerpot at gmail.com)
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Library General Public
@@ -74,7 +76,9 @@
 only the class name would be shown."))
 
 (defgeneric inspect-object (object pane)
-  (:documentation "Inspect an object, displaying it on PANE"))
+  (:documentation "Inspect an object, displaying it on PANE. This can
+be as verbose as you like; the important thing is that all the
+information is present."))
 
 (defmethod inspect-object :around (object pane)
   (cond ((member object *inspected-objects*)
@@ -87,6 +91,11 @@
          (let ((*inspected-objects* (cons object *inspected-objects*)))
            (call-next-method)))))
 
+;; This behavior should be overridden by methods for specific object
+;; types that have a more informative short representation. For
+;; example, the symbol FOO would be printed as "FOO" instead of "...",
+;; since that's just as short and more informative. When it's clicked
+;; on, it can then go to a more verbose view.
 (defmethod inspect-object-briefly (object pane)
   (with-output-as-presentation
       (pane object (presentation-type-of object))
@@ -290,13 +299,16 @@
                    (print (method-qualifiers method)))
                  (loop for specializer in (clim-mop:method-specializers method)
                     do (formatting-cell (pane)
-                         (format pane "~a "
-				 (if (typep specializer
-					    'clim-mop:eql-specializer)
-				     (format nil "(EQL ~S)"
-					     (clim-mop:eql-specializer-object
-					      specializer))
-				     (class-name specializer))))))))))
+			 (if (typep specializer 'clim-mop:eql-specializer)
+			     (progn
+			       (princ "(EQL " pane)
+			       (inspect-object
+				(clim-mop:eql-specializer-object
+				 specializer)
+				pane)
+			       (princ ")" pane))
+			     (inspect-object (class-name specializer)
+					     pane)))))))))
 
 (defun pretty-print-function (fun)
   "Print a function in a readable way, returning a string. On most
@@ -415,7 +427,7 @@
 (defmethod inspect-object-briefly ((object symbol) pane)
   (with-output-as-presentation
       (pane object (presentation-type-of object))
-    (print object)))
+    (prin1 object)))
 
 (defmethod inspect-object ((object symbol) pane)
   (inspector-table
@@ -519,4 +531,17 @@
       (when documentation
 	(format stream "~&Documentation: ~A~%" documentation))
       (format stream "~&Type: ~S~%"
-	      (clim-mop:slot-definition-type slot-object)))))
\ No newline at end of file
+	      (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?
+      (when (clim-mop:slot-definition-readers slot-object)
+	(format stream "~&Readers: ")
+	(format-textual-list (clim-mop:slot-definition-readers slot-object)
+			     #'inspect-object))
+      (when (clim-mop:slot-definition-writers slot-object)
+	(format stream "~&Writers: ")
+	(format-textual-list (clim-mop:slot-definition-writers slot-object)
+			     #'inspect-object)))))
\ No newline at end of file