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"))