Index: Apps/Inspector/inspector.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp,v retrieving revision 1.7 diff -u -r1.7 inspector.lisp --- Apps/Inspector/inspector.lisp 30 Jan 2005 06:02:56 -0000 1.7 +++ Apps/Inspector/inspector.lisp 2 Feb 2005 00:47:37 -0000 @@ -23,9 +23,11 @@ ;;; CLIM inspector application (in-package :inspector) +(define-modify-macro togglef () not) (define-application-frame inspector () ((dico :initform (make-hash-table) :reader dico) + (cons-cell-dico :initform (make-hash-table) :reader cons-cell-dico) (obj :initarg :obj :reader obj)) (:pointer-documentation t) (:panes @@ -113,6 +115,8 @@ (define-presentation-type settable-slot () :inherit-from t) +(define-presentation-type cons () + :inherit-from t) (define-presentation-method present (object (type settable-slot) stream @@ -156,7 +160,7 @@ (format pane "~a:" slot-name)) (inspect-object (slot-value object slot-name) pane))))))) -(defmethod inspect-object ((object cons) pane) +(defun inspect-cons-as-cells (object pane) (if (null (cdr object)) (formatting-table (pane) (formatting-column (pane) @@ -186,6 +190,40 @@ (formatting-cell (pane) (inspect-object (cdr object) pane)))))) +(defun inspect-cons-as-list (object pane) + (with-output-as-presentation + (pane object 'cons) + (formatting-table (pane) + (formatting-row (pane) + (formatting-cell (pane) + (princ "(" pane)) + (do + ((length 0 (1+ length)) + (cdr (cdr object) (cdr cdr)) + (car (car object) (car cdr))) + ((cond ((eq nil cdr) + (formatting-cell (pane) (inspect-object car pane)) + (formatting-cell (pane) (princ ")" pane)) + t) + ((not (consp cdr)) + (formatting-cell (pane) (inspect-object car pane)) + (formatting-cell (pane) (princ "." pane)) + (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)) + t) + (t nil))) + (formatting-cell (pane) (inspect-object car pane))))))) + +(defmethod inspect-object ((object cons) pane) + (if (gethash object (cons-cell-dico *application-frame*)) + (inspect-cons-as-cells object pane) + (inspect-cons-as-list object pane))) + + (defmethod inspect-object-briefly ((object hash-table) pane) (with-output-as-presentation (pane object (presentation-type-of object)) @@ -259,6 +297,11 @@ (pane object (presentation-type-of object)) (print object))) +(defmethod inspect-object-briefly ((object character) pane) + (with-output-as-presentation + (pane object (presentation-type-of object)) + (print object))) + (defmethod inspect-object ((object complex) pane) (with-output-as-presentation (pane object (presentation-type-of object)) @@ -295,6 +338,7 @@ (with-output-as-presentation (pane object (presentation-type-of object)) (print object))) + (defmethod inspect-object ((object symbol) pane) (inspector-table (format pane "Symbol ~S" (symbol-name object)) @@ -327,11 +371,16 @@ (clim-sys:make-process #'(lambda () (inspector obj)) :name "inspector"))) +(define-inspector-command (com-toggle-show-list-cells :name t) + ((obj 'cons :gesture :select :prompt "Select a cons or list")) + (togglef (gethash obj (cons-cell-dico *application-frame*)))) + (define-inspector-command (com-toggle-inspect :name t) ((obj t :gesture :select :prompt "Select an object")) (unless (eq obj (obj *application-frame*)) - (setf (gethash obj (dico *application-frame*)) - (not (gethash obj (dico *application-frame*)))))) + (togglef (gethash obj (dico *application-frame*))))) + + (define-inspector-command (com-remove-method :name t) ((obj 'method :gesture :delete :prompt "Remove method"))