February 2005 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/INSTALL
by pscott＠common-lisp.net 08 Feb '05

08 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv10645 Modified Files: INSTALL Log Message: Fixed typos, changed clouseau::inspector to clouseau:inspector, added Usage and Threading sections with examples to get people off to a quick start, and put in a bigger example of inspecting a running inspector. Date: Tue Feb 8 23:23:12 2005 Author: pscott Index: mcclim/Apps/Inspector/INSTALL diff -u mcclim/Apps/Inspector/INSTALL:1.3 mcclim/Apps/Inspector/INSTALL:1.4 --- mcclim/Apps/Inspector/INSTALL:1.3 Tue Feb 8 23:14:01 2005 +++ mcclim/Apps/Inspector/INSTALL Tue Feb 8 23:23:12 2005 @@ -1,3 +1,6 @@ +Quick start +=========== + 1. Start your Lisp system and make sure you have ASDF and McCLIM in your core file. @@ -5,9 +8,50 @@ 3. Try something like: - (clouseau:inspector (clim:make-application-frame 'clouseau:inspector :obj 20)) + (clouseau:inspector (clim:make-application-frame + 'clouseau:inspector :obj 20)) in order to inspect the inspector pane. -4. Lef-click on occurrences of objects or of "...". +4. Left-click on occurrences of objects or of "...". + + +Usage +===== + +The inspector is invoked like this: + +(clouseau:inspector object) + +To get a feel for what the inspector can do, try these: + +(clouseau:inspector #'write-string) +(clouseau:inspector #'documentation) +(clouseau:inspector 'documentation) +(clouseau:inspector '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)) + +Click on things. See what happens. + + +Threading +========= + +If you have a multithreaded Lisp implementation, you can start an +inspector in a new process like this: + +(clouseau:inspector object :new-process t) + +For example, if you want to get really fancy and inspect a running +inspector, this ugly hack should do the job: +(let ((*print-length* 10) + (*print-level* 10) + inspected-inspector) + (setf inspected-inspector + (clim:make-application-frame 'clouseau::inspector + :obj (clim:make-application-frame + 'clouseau::inspector :obj 20))) + (clim-sys:make-process #'(lambda () + (clim:run-frame-top-level inspected-inspector)) + :name "Inspector Clouseau (being inspected)") + (clouseau:inspector inspected-inspector :new-process t)) \ No newline at end of file

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/INSTALL mcclim/Apps/Inspector/inspector.lisp
by varkesteijn＠common-lisp.net 08 Feb '05

08 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv9766 Modified Files: INSTALL inspector.lisp Log Message: * Fixed the command Describe Slot to correctly list the reader and writer functions, when available. * Removed two colons from INSTALL file to reflect the exported status of clouseau:inspector. Date: Tue Feb 8 23:14:01 2005 Author: varkesteijn Index: mcclim/Apps/Inspector/INSTALL diff -u mcclim/Apps/Inspector/INSTALL:1.2 mcclim/Apps/Inspector/INSTALL:1.3 --- mcclim/Apps/Inspector/INSTALL:1.2 Thu Feb 3 19:47:18 2005 +++ mcclim/Apps/Inspector/INSTALL Tue Feb 8 23:14:01 2005 @@ -5,7 +5,7 @@ 3. Try something like: - (clouseau::inspector (clim:make-application-frame 'clouseau::inspector :obj 20)) + (clouseau:inspector (clim:make-application-frame 'clouseau:inspector :obj 20)) in order to inspect the inspector pane. Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.19 mcclim/Apps/Inspector/inspector.lisp:1.20 --- mcclim/Apps/Inspector/inspector.lisp:1.19 Tue Feb 8 23:00:36 2005 +++ mcclim/Apps/Inspector/inspector.lisp Tue Feb 8 23:14:01 2005 @@ -567,23 +567,24 @@ (class (class-of object)) (documentation (handler-bind ((warning #'muffle-warning)) (slot-documentation class slot-name))) - (slot-object (find slot-name (clim-mop:class-slots class) - :key #'clim-mop:slot-definition-name))) + (slot-object (or (find slot-name (clim-mop:class-direct-slots class) + :key #'clim-mop:slot-definition-name) + (find slot-name (clim-mop:class-slots class) + :key #'clim-mop:slot-definition-name)))) (when documentation (format stream "~&Documentation: ~A~%" documentation)) (format stream "~&Type: ~S~%" (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 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) - #'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 + ;; slot-definition-{readers,writers} only works for direct slot + ;; definitions + (let ((readers (clim-mop:slot-definition-readers slot-object))) + (when readers + (format stream "~&Readers: ") + (present readers (presentation-type-of readers) :stream stream))) + (let ((writers (clim-mop:slot-definition-writers slot-object))) + (when writers + (format stream "~&Writers: ") + (present writers (presentation-type-of writers) :stream stream)))))) +

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by pscott＠common-lisp.net 08 Feb '05

08 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv9276 Modified Files: inspector.lisp Log Message: Fixed glitch in formatting of hash tables. Somtimes "=" got wrapped down to the next row but nothing else did. This no longer occurs since the "=" is put in its own cell, rather than being jammed in the left cell along with the key. Made it impossible to toggle inspection of nil. I've found that any attempt to toggle the inspection of nil is almost always a mistake, and an annoying one at that. If you want to inspect nil for some reason, you can always make a new inspector or use com-inspect. Date: Tue Feb 8 23:00:36 2005 Author: pscott Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.18 mcclim/Apps/Inspector/inspector.lisp:1.19 --- mcclim/Apps/Inspector/inspector.lisp:1.18 Tue Feb 8 22:08:39 2005 +++ mcclim/Apps/Inspector/inspector.lisp Tue Feb 8 23:00:36 2005 @@ -31,8 +31,11 @@ (define-application-frame inspector () ((dico :initform (make-hash-table) :reader dico) (cons-cell-dico :initform (make-hash-table) :reader cons-cell-dico) - (print-length :initform (make-hash-table) :reader print-length) - (obj :initarg :obj :reader obj)) + (print-length :initform (make-hash-table) :reader print-length + :documentation "A hash table mapping list objects to +their specific print lengths, if they have one.") + (obj :initarg :obj :reader obj + :documentation "The object being inspected")) (:pointer-documentation t) (:panes (app :application :width 600 :height 500 @@ -115,7 +118,8 @@ :inherit-from t) (define-presentation-type cons () :inherit-from t) -(define-presentation-type long-list-tail () :inherit-from t) +(define-presentation-type long-list-tail () + :inherit-from t) (define-presentation-method present (object (type settable-slot) stream @@ -304,11 +308,12 @@ (inspector-table (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) (loop for key being the hash-keys of object - do (inspector-table-row - (formatting-cell (pane) - (inspect-object key pane) - (princ "=" pane)) - (inspect-object (gethash key object) pane))))) + do (formatting-row (pane) + (formatting-cell (pane :align-x :right) + (inspect-object key pane)) + (formatting-cell (pane) (princ "=" pane)) + (formatting-cell (pane) + (inspect-object (gethash key object) pane)))))) (defmethod inspect-object ((object generic-function) pane) (inspector-table @@ -522,8 +527,9 @@ (define-inspector-command (com-toggle-inspect :name t) ((obj t :gesture :select :prompt "Select an object")) - (unless (eq obj (obj *application-frame*)) - (togglef (gethash obj (dico *application-frame*))))) + (unless (or (eq obj (obj *application-frame*)) + (null obj)) + (togglef (gethash obj (dico *application-frame*))))) (define-inspector-command (com-remove-method :name t) ((obj 'method :gesture :delete :prompt "Remove method"))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by pscott＠common-lisp.net 08 Feb '05

08 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv6579 Modified Files: inspector.lisp Log Message: Added patch from Peter Wilson to increase *print-length* for long lists upon request. It's pretty simple, and it works smoothly. The only problem I can see is that the user might want to do something other than increasing *print-length* by 10. This is, sadly, not yet supported. Date: Tue Feb 8 22:08:40 2005 Author: pscott Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.17 mcclim/Apps/Inspector/inspector.lisp:1.18 --- mcclim/Apps/Inspector/inspector.lisp:1.17 Tue Feb 8 21:37:34 2005 +++ mcclim/Apps/Inspector/inspector.lisp Tue Feb 8 22:08:39 2005 @@ -31,6 +31,7 @@ (define-application-frame inspector () ((dico :initform (make-hash-table) :reader dico) (cons-cell-dico :initform (make-hash-table) :reader cons-cell-dico) + (print-length :initform (make-hash-table) :reader print-length) (obj :initarg :obj :reader obj)) (:pointer-documentation t) (:panes @@ -88,7 +89,10 @@ ((not (gethash object (dico *application-frame*))) (inspect-object-briefly object pane)) (t - (let ((*inspected-objects* (cons object *inspected-objects*))) + (let ((*inspected-objects* (cons object *inspected-objects*)) + (*print-length* (or (gethash object (print-length + *application-frame*)) + *print-length*))) (call-next-method))))) ;; This behavior should be overridden by methods for specific object @@ -111,6 +115,7 @@ :inherit-from t) (define-presentation-type cons () :inherit-from t) +(define-presentation-type long-list-tail () :inherit-from t) (define-presentation-method present (object (type settable-slot) stream @@ -278,9 +283,9 @@ (formatting-cell (pane) (inspect-object cdr pane)) (formatting-cell (pane) (princ ")" pane)) t) - ((>= length *print-length*) - (formatting-cell (pane) (inspect-object car pane)) - (formatting-cell (pane) (princ "..." pane)) + ((and *print-length* (>= length *print-length*)) + (with-output-as-presentation (pane object 'long-list-tail) + (formatting-cell (pane) (princ "...)" pane))) t) (t nil))) (formatting-cell (pane) (inspect-object car pane))))))) @@ -505,8 +510,15 @@ (inspector obj :new-process t))) (define-inspector-command (com-toggle-show-list-cells :name t) - ((obj 'cons :gesture :select :prompt "Select a cons or list")) + ((obj 'cons :gesture :select :prompt "Select a cons or list")) (togglef (gethash obj (cons-cell-dico *application-frame*)))) + +(define-inspector-command (com-show-10-more-items :name t) + ((obj 'long-list-tail :gesture :select :prompt "Select a truncated list")) + (if (gethash obj (print-length *application-frame*)) + (incf (gethash obj (print-length *application-frame*)) 10) + (setf (gethash obj (print-length *application-frame*)) + (+ 10 *print-length*)))) (define-inspector-command (com-toggle-inspect :name t) ((obj t :gesture :select :prompt "Select an object"))

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by pscott＠common-lisp.net 08 Feb '05

08 Feb '05

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)

1 0

[mcclim-cvs] CVS update: mcclim/Lisp-Dep/fix-acl.lisp
by tmoore＠common-lisp.net 07 Feb '05

07 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory common-lisp.net:/tmp/cvs-serv27742 Modified Files: fix-acl.lisp Log Message: Complete enumeration of MOP symbols from Robert P. Goldman Date: Mon Feb 7 22:16:59 2005 Author: tmoore Index: mcclim/Lisp-Dep/fix-acl.lisp diff -u mcclim/Lisp-Dep/fix-acl.lisp:1.9 mcclim/Lisp-Dep/fix-acl.lisp:1.10 --- mcclim/Lisp-Dep/fix-acl.lisp:1.9 Fri Mar 21 16:15:09 2003 +++ mcclim/Lisp-Dep/fix-acl.lisp Mon Feb 7 22:16:58 2005 @@ -5,15 +5,117 @@ ;;; Needed to keep ACL from issuing warnings about toplevel (shadow ...) forms (setq comp:*cltl1-compile-file-toplevel-compatibility-p* nil) -(require :loop) +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :loop) + (require :mop)) (defpackage :clim-mop - (:use :clos)) - - -(eval-when (:compile-toplevel :load-toplevel :execute) - (do-external-symbols (sym :clos) - (export sym :clim-mop))) + (:use :clos :common-lisp) + (:export "ACCESSOR-METHOD-SLOT-DEFINITION" + "ADD-DEPENDENT" + "ADD-DIRECT-METHOD" + "ADD-DIRECT-SUBCLASS" + "ADD-METHOD" + "ALLOCATE-INSTANCE" + "BUILT-IN-CLASS" + "CLASS" + "CLASS-DEFAULT-INITARGS" + "CLASS-DIRECT-DEFAULT-INITARGS" + "CLASS-DIRECT-SLOTS" + "CLASS-DIRECT-SUBCLASSES" + "CLASS-DIRECT-SUPERCLASSES" + "CLASS-FINALIZED-P" + "CLASS-NAME" + "CLASS-PRECEDENCE-LIST" + "CLASS-PROTOTYPE" + "CLASS-SLOTS" + "COMPUTE-APPLICABLE-METHODS" + "COMPUTE-APPLICABLE-METHODS-USING-CLASSES" + "COMPUTE-CLASS-PRECEDENCE-LIST" + "COMPUTE-DEFAULT-INITARGS" + "COMPUTE-DISCRIMINATING-FUNCTION" + "COMPUTE-EFFECTIVE-METHOD" + "COMPUTE-EFFECTIVE-SLOT-DEFINITION" + "COMPUTE-SLOTS" + "DIRECT-SLOT-DEFINITION" + "DIRECT-SLOT-DEFINITION-CLASS" + "EFFECTIVE-SLOT-DEFINITION" + "EFFECTIVE-SLOT-DEFINITION-CLASS" + "ENSURE-CLASS" + "ENSURE-CLASS-USING-CLASS" + "ENSURE-GENERIC-FUNCTION" + "ENSURE-GENERIC-FUNCTION-USING-CLASS" + "EQL-SPECIALIZER" + "EQL-SPECIALIZER-OBJECT" + "EXTRACT-LAMBDA-LIST" + "EXTRACT-SPECIALIZER-NAMES" + "FINALIZE-INHERITANCE" + "FIND-METHOD-COMBINATION" + "FORWARD-REFERENCED-CLASS" + "FUNCALLABLE-STANDARD-CLASS" + "FUNCALLABLE-STANDARD-INSTANCE-ACCESS" + "FUNCALLABLE-STANDARD-OBJECT" + "FUNCTION" + "GENERIC-FUNCTION" + "GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER" + "GENERIC-FUNCTION-DECLARATIONS" + "GENERIC-FUNCTION-LAMBDA-LIST" + "GENERIC-FUNCTION-METHOD-CLASS" + "GENERIC-FUNCTION-METHOD-COMBINATION" + "GENERIC-FUNCTION-METHODS" + "GENERIC-FUNCTION-NAME" + "INTERN-EQL-SPECIALIZER" + "MAKE-INSTANCE" + "MAKE-METHOD-LAMBDA" + "MAP-DEPENDENTS" + "METAOBJECT" + "METHOD" + "METHOD-COMBINATION" + "METHOD-FUNCTION" + "METHOD-GENERIC-FUNCTION" + "METHOD-LAMBDA-LIST" + "METHOD-QUALIFIERS" + "METHOD-SPECIALIZERS" + "READER-METHOD-CLASS" + "REMOVE-DEPENDENT" + "REMOVE-DIRECT-METHOD" + "REMOVE-DIRECT-SUBCLASS" + "REMOVE-METHOD" + "SET-FUNCALLABLE-INSTANCE-FUNCTION" + "SLOT-BOUNDP-USING-CLASS" + "SLOT-DEFINITION" + "SLOT-DEFINITION-ALLOCATION" + "SLOT-DEFINITION-INITARGS" + "SLOT-DEFINITION-INITFORM" + "SLOT-DEFINITION-INITFUNCTION" + "SLOT-DEFINITION-LOCATION" + "SLOT-DEFINITION-NAME" + "SLOT-DEFINITION-READERS" + "SLOT-DEFINITION-TYPE" + "SLOT-DEFINITION-WRITERS" + "SLOT-MAKUNBOUND-USING-CLASS" + "SLOT-VALUE-USING-CLASS" + "SPECIALIZER" + "SPECIALIZER-DIRECT-GENERIC-FUNCTIONS" + "SPECIALIZER-DIRECT-METHODS" + "STANDARD-ACCESSOR-METHOD" + "STANDARD-CLASS" + "STANDARD-DIRECT-SLOT-DEFINITION" + "STANDARD-EFFECTIVE-SLOT-DEFINITION" + "STANDARD-GENERIC-FUNCTION" + "STANDARD-INSTANCE-ACCESS" + "STANDARD-METHOD" + "STANDARD-OBJECT" + "STANDARD-READER-METHOD" + "STANDARD-SLOT-DEFINITION" + "STANDARD-WRITER-METHOD" + "UPDATE-DEPENDENT" + "VALIDATE-SUPERCLASS" + "WRITER-METHOD-CLASS")) + +;;;(eval-when (:compile-toplevel :load-toplevel :execute) +;;; (do-external-symbols (sym :clos) +;;; (export sym :clim-mop))) (eval-when (:compile-toplevel :load-toplevel :execute) (export '(clim-lisp-patch::defclass) @@ -63,4 +165,3 @@ .args.)))))) (t `(defun ,fun ,args ,@body)))) ) -

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by pscott＠common-lisp.net 07 Feb '05

07 Feb '05

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(a)labri.fr) ;;; (c) copyright 2005 by ;;; Vincent Arkesteijn +;;; (c) copyright 2005 by +;;; Peter Scott (sketerpot(a)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

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by pscott＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv21501 Modified Files: inspector.lisp Log Message: Removed bad decision to use 'vector presentation type, extended abbreviation threshold, changed abbreviation syntax to be less surprising. Date: Sat Feb 5 18:28:00 2005 Author: pscott Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.14 mcclim/Apps/Inspector/inspector.lisp:1.15 --- mcclim/Apps/Inspector/inspector.lisp:1.14 Sat Feb 5 15:40:55 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Feb 5 18:28:00 2005 @@ -171,7 +171,8 @@ (format pane "~a:" slot-name)) (inspect-object (slot-value object slot-name) pane))))))) -(defparameter *object-representation-max-length* 60 +;; 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") @@ -184,7 +185,7 @@ (prin1 object string)))) (if (< (length representation) *object-representation-max-length*) (princ representation pane) - (format pane "instance of ~S" (class-name (class-of object))))))) + (format pane "#<~S ...>" (class-name (class-of object))))))) (defmethod inspect-object ((object standard-object) pane) (inspect-structure-or-object object pane)) @@ -348,10 +349,8 @@ (inspect-object uses pane))))) (defmethod inspect-object ((object vector) pane) - ;; Using 'vector as the presentation type may be nonstandard, but it - ;; is more useful than the default. (with-output-as-presentation - (pane object 'vector) + (pane object (presentation-type-of object)) (formatting-table (pane) (formatting-row (pane) (formatting-cell (pane)

1 0

[mcclim-cvs] CVS update: mcclim/Apps/Inspector/inspector.lisp
by varkesteijn＠common-lisp.net 05 Feb '05

05 Feb '05

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory common-lisp.net:/tmp/cvs-serv12440 Modified Files: inspector.lisp Log Message: Added an inspect-object method for characters. Date: Sat Feb 5 15:40:56 2005 Author: varkesteijn Index: mcclim/Apps/Inspector/inspector.lisp diff -u mcclim/Apps/Inspector/inspector.lisp:1.13 mcclim/Apps/Inspector/inspector.lisp:1.14 --- mcclim/Apps/Inspector/inspector.lisp:1.13 Fri Feb 4 23:37:21 2005 +++ mcclim/Apps/Inspector/inspector.lisp Sat Feb 5 15:40:55 2005 @@ -446,6 +446,18 @@ (with-output-as-presentation (pane object (presentation-type-of object)) (print object pane))) +(defmethod inspect-object ((object character) pane) + (inspector-table + (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)))) (defun display-app (frame pane) "Display the APP frame of the inspector"

1 0

[mcclim-cvs] CVS update: mcclim/input-editing.lisp
by tmoore＠common-lisp.net 04 Feb '05

04 Feb '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv28404 Modified Files: input-editing.lisp Log Message: Changed invoke-empty-input and handle-empty-input to use the activation/completion gesture typed by the user in deciding which empty input continuation to invoke. This avoids bailing out of a call to accept from within an inner (recursive) call to accept when the user types a delimiter gesture for the inner call in an attempt to get its default value. Date: Sat Feb 5 00:23:50 2005 Author: tmoore Index: mcclim/input-editing.lisp diff -u mcclim/input-editing.lisp:1.42 mcclim/input-editing.lisp:1.43 --- mcclim/input-editing.lisp:1.42 Sun Oct 24 17:47:02 2004 +++ mcclim/input-editing.lisp Sat Feb 5 00:23:49 2005 @@ -761,22 +761,28 @@ ;;; to supply a default. ;;; continuation = (stream scan-pointer <function of one arg (gesture)> +;;; activation-gestures delimiter gestures) (defvar *empty-input-continuations* nil) (defun invoke-empty-input (stream gesture) - "Invoke the continuation of the empty accept before the first non-empty - accept." + "Invoke the continuation of the empty `accept' before the first non-empty + accept `gesture' must be a member of that `accept''s activation or continuation + gestures." (let ((scan-pointer (1- (stream-scan-pointer stream)))) (loop - with active-continuation = nil + with active-continuation-function = nil for continuation in *empty-input-continuations* - for (cont-stream cont-scan-pointer) = continuation + for (cont-stream cont-scan-pointer func activations delimeters) + = continuation while (and (eq stream cont-stream) (eql scan-pointer cont-scan-pointer)) - do (setq active-continuation continuation) - finally (when active-continuation + when (or (gesture-match gesture activations) + (gesture-match gesture delimeters)) + do (setq active-continuation-function func) + end + finally (when active-continuation-function (unread-char gesture stream) - (funcall (caddr active-continuation)))) + (funcall active-continuation-function))) t)) (defmethod stream-read-gesture :around ((stream empty-input-mixin) @@ -815,7 +821,9 @@ (cons (list ,stream (stream-scan-pointer ,stream) #'(lambda () - (return-from ,context-block))) + (return-from ,context-block)) + *activation-gestures* + *delimiter-gestures*) *empty-input-continuations*))) (return-from ,return-block ,input-form))) ,@handler-forms)))

1 0