[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
Peter Scott
pscott at common-lisp.net
Wed Mar 9 21:05:04 UTC 2005
Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector
In directory common-lisp.net:/tmp/cvs-serv21238
Modified Files:
inspector.lisp
Log Message:
It seemed unforgivably messy for INSPECTOR-TABLE and
INSPECTOR-TABLE-ROW to capture OBJECT and PANE from the surrounding
environment, and it also made the code look a little odd. So, I added
some new options to both which let you specify values for those
things. I then went through the rest of the code and changed it to
give the new options.
As a note to emacs users, you may want to put this in your .emacs file
to get these macros to indent right:
(put 'inspector-table 'lisp-indent-function 1)
(put 'inspector-table-row 'lisp-indent-function 1)
Date: Wed Mar 9 22:05:04 2005
Author: pscott
Index: mcclim/Apps/Inspector/inspector.lisp
diff -u mcclim/Apps/Inspector/inspector.lisp:1.26 mcclim/Apps/Inspector/inspector.lisp:1.27
--- mcclim/Apps/Inspector/inspector.lisp:1.26 Tue Mar 8 23:11:28 2005
+++ mcclim/Apps/Inspector/inspector.lisp Wed Mar 9 22:05:03 2005
@@ -136,35 +136,40 @@
could be boldface, or a different style, or even another font."
`(with-text-face (,stream :bold)
, at body))
-
-(defmacro inspector-table (header &body body)
- "Present OBJECT (captured from environment) in tabular form, with
+;; FIXMEFIXME!!!!!
+(defmacro inspector-table ((object pane) header &body body)
+ "Present OBJECT in tabular form on PANE, with
HEADER printed in a box at the top. BODY should output the rows of the
-table using INSPECTOR-TABLE-ROW. Also capured from the macro's
-environment is PANE, which is the pane on which the table will be
-drawn."
- `(with-output-as-presentation
- (pane object (presentation-type-of object))
- (formatting-table (pane)
- (formatting-column (pane)
- (formatting-cell (pane)
- (surrounding-output-with-border (pane)
- (with-heading-style (pane)
- ,header)))
- (formatting-cell (pane)
- (formatting-table (pane)
- , at body))))
- (print-documentation object pane)))
-
-(defmacro inspector-table-row (left right)
- "Output a table row with two items, LEFT and RIGHT, in the
-environment created by INSPECTOR-TABLE."
- `(formatting-row (pane)
- (formatting-cell (pane :align-x :right)
- (with-heading-style (pane)
- ,left))
- (formatting-cell (pane)
- ,right)))
+table using INSPECTOR-TABLE-ROW."
+ (let ((evaluated-pane (gensym "pane"))
+ (evaluated-object (gensym "object")))
+ `(let ((,evaluated-pane ,pane)
+ (,evaluated-object ,object))
+ (with-output-as-presentation
+ (pane ,evaluated-object
+ (presentation-type-of ,evaluated-object))
+ (formatting-table (,evaluated-pane)
+ (formatting-column (,evaluated-pane)
+ (formatting-cell (,evaluated-pane)
+ (surrounding-output-with-border (,evaluated-pane)
+ (with-heading-style (,evaluated-pane)
+ ,header)))
+ (formatting-cell (,evaluated-pane)
+ (formatting-table (,evaluated-pane)
+ , at body))))
+ (print-documentation ,evaluated-object ,evaluated-pane)))))
+
+(defmacro inspector-table-row ((pane) left right)
+ "Output a table row with two items, LEFT and RIGHT, on PANE. This
+should be used only within INSPECTOR-TABLE."
+ (let ((evaluated-pane (gensym "pane")))
+ `(let ((,evaluated-pane ,pane))
+ (formatting-row (,evaluated-pane)
+ (formatting-cell (,evaluated-pane :align-x :right)
+ (with-heading-style (,evaluated-pane)
+ ,left))
+ (formatting-cell (,evaluated-pane)
+ ,right)))))
(defun print-documentation (object pane)
"Print OBJECT's documentation, if any, to PANE"
@@ -180,27 +185,27 @@
called by the INSPECT-OBJECT methods for both standard objects and
structure objects."
(let ((class (class-of object)))
- (inspector-table
- (print (class-name class) pane)
- (when (clim-mop:class-direct-superclasses class)
- (inspector-table-row
- (princ "Superclasses" pane)
- (inspect-vertical-list (clim-mop:class-direct-superclasses class)
- pane)))
- (when (clim-mop:class-direct-subclasses class)
- (inspector-table-row
- (princ "Subclasses" pane)
- (inspect-vertical-list (clim-mop:class-direct-subclasses class)
- pane)))
- (loop for slot in (reverse (clim-mop:class-slots class))
- do (let ((slot-name (clim-mop:slot-definition-name slot)))
- (inspector-table-row
- (with-output-as-presentation
- (pane (cons object slot-name) 'settable-slot)
- (format pane "~a:" slot-name))
- (if (slot-boundp object slot-name)
- (inspect-object (slot-value object slot-name) pane)
- (format pane "#<unbound slot>"))))))))
+ (inspector-table (object pane)
+ (print (class-name class) pane)
+ (when (clim-mop:class-direct-superclasses class)
+ (inspector-table-row (pane)
+ (princ "Superclasses" pane)
+ (inspect-vertical-list (clim-mop:class-direct-superclasses class)
+ pane)))
+ (when (clim-mop:class-direct-subclasses class)
+ (inspector-table-row (pane)
+ (princ "Subclasses" pane)
+ (inspect-vertical-list (clim-mop:class-direct-subclasses class)
+ pane)))
+ (loop for slot in (reverse (clim-mop:class-slots class))
+ do (let ((slot-name (clim-mop:slot-definition-name slot)))
+ (inspector-table-row (pane)
+ (with-output-as-presentation
+ (pane (cons object slot-name) 'settable-slot)
+ (format pane "~a:" slot-name))
+ (if (slot-boundp object slot-name)
+ (inspect-object (slot-value object slot-name) pane)
+ (format pane "#<unbound slot>"))))))))
;; Try to print the normal, textual representation of an object, but
;; if that's too long, make an abbreviated "instance of ~S" version.
@@ -352,8 +357,8 @@
(pane object (presentation-type-of object))
(princ 'hash-table pane)))
(defmethod inspect-object ((object hash-table) pane)
- (inspector-table
- (format pane "~A (test: ~A)" 'hash-table (hash-table-test object))
+ (inspector-table (object pane)
+ (format pane "~A (test: ~A)" 'hash-table (hash-table-test object))
(loop for key being the hash-keys of object
do (formatting-row (pane)
(formatting-cell (pane :align-x :right)
@@ -363,9 +368,9 @@
(inspect-object (gethash key object) pane))))))
(defmethod inspect-object ((object generic-function) pane)
- (inspector-table
- (format pane "Generic Function: ~s"
- (clim-mop:generic-function-name object))
+ (inspector-table (object pane)
+ (format pane "Generic Function: ~s"
+ (clim-mop:generic-function-name object))
(dolist (method (clim-mop:generic-function-methods object))
(with-output-as-presentation
(pane method (presentation-type-of method))
@@ -442,18 +447,18 @@
(princ (package-name object) pane))))
(defmethod inspect-object ((object package) pane)
- (inspector-table
+ (inspector-table (object pane)
(format pane "Package: ~S" (package-name object))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "Name:" pane)
(inspect-object (package-name object) pane))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "Nicknames:" pane)
(inspect-vertical-list (package-nicknames object) pane))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "Used by:")
(inspect-vertical-list (package-used-by-list object) pane))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "Uses:")
(inspect-vertical-list (package-use-list object) pane))))
@@ -504,22 +509,22 @@
(inspect-complex object pane))
(defmethod inspect-object ((object float) pane)
- (inspector-table
+ (inspector-table (object pane)
(format pane "float ~S" object)
(multiple-value-bind (significand exponent sign)
(decode-float object)
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "sign:")
(inspect-object sign pane))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "significand:")
(inspect-object significand pane))
- (inspector-table-row
+ (inspector-table-row (pane)
(princ "exponent:")
(inspect-object exponent pane)))
- (inspector-table-row
- (princ "radix:")
- (inspect-object (float-radix object) pane))))
+ (inspector-table-row (pane)
+ (princ "radix:")
+ (inspect-object (float-radix object) pane))))
(defmethod inspect-object-briefly ((object symbol) pane)
(with-output-as-presentation
@@ -528,33 +533,33 @@
(prin1 object))))
(defmethod inspect-object ((object symbol) pane)
- (inspector-table
+ (inspector-table (object pane)
(format pane "Symbol ~S" (symbol-name object))
- (inspector-table-row
- (princ "value:")
- (if (boundp object)
- (inspect-object (symbol-value object) pane)
- (princ "unbound")))
- (inspector-table-row
- (princ "function:")
- (if (fboundp object)
- (inspect-object (symbol-function object) pane)
- (princ "unbound")))
+ (inspector-table-row (pane)
+ (princ "value:")
+ (if (boundp object)
+ (inspect-object (symbol-value object) pane)
+ (princ "unbound")))
+ (inspector-table-row (pane)
+ (princ "function:")
+ (if (fboundp object)
+ (inspect-object (symbol-function object) pane)
+ (princ "unbound")))
;; This is not, strictly speaking, a property of the
;; symbol. However, this is useful enough that I think it's worth
;; including here, since it can eliminate some minor annoyances.
- (inspector-table-row
- (princ "class:")
- (if (find-class object nil)
- (inspect-object (find-class object) pane)
- (princ "unbound")))
- (inspector-table-row
- (princ "package:")
- (inspect-object (symbol-package object) pane))
- (inspector-table-row
- (princ "propery list:")
- (dolist (property (symbol-plist object))
- (inspect-object property pane)))))
+ (inspector-table-row (pane)
+ (princ "class:")
+ (if (find-class object nil)
+ (inspect-object (find-class object) pane)
+ (princ "unbound")))
+ (inspector-table-row (pane)
+ (princ "package:")
+ (inspect-object (symbol-package object) pane))
+ (inspector-table-row (pane)
+ (princ "propery list:")
+ (dolist (property (symbol-plist object))
+ (inspect-object property pane)))))
;; Characters are so short that displaying them as "..." takes almost
;; as much space as just showing them, and this way is more
@@ -564,17 +569,17 @@
(pane object (presentation-type-of object))
(print object pane)))
(defmethod inspect-object ((object character) pane)
- (inspector-table
+ (inspector-table (object pane)
(format pane "Character ~S" object)
- (inspector-table-row
- (princ "code:" pane)
- (inspect-object (char-code object) pane))
- (inspector-table-row
- (princ "int:" pane)
- (inspect-object (char-int object) pane))
- (inspector-table-row
- (princ "name:" pane)
- (inspect-object (char-name object) pane))))
+ (inspector-table-row (pane)
+ (princ "code:" pane)
+ (inspect-object (char-code object) pane))
+ (inspector-table-row (pane)
+ (princ "int:" pane)
+ (inspect-object (char-int object) pane))
+ (inspector-table-row (pane)
+ (princ "name:" pane)
+ (inspect-object (char-name object) pane))))
(defun display-app (frame pane)
"Display the APP frame of the inspector"
More information about the Mcclim-cvs
mailing list