Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv21361/Apps/Inspector
Modified Files: inspector.lisp Log Message: Added much snazzy eye candy for people dealing with hash tables. Hash tables are now displayed in a pretty graphical format which shows how much of the array is used and how far it is to the rehash threshold.
--- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2005/09/13 11:07:40 1.33 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/02/08 05:12:33 1.34 @@ -90,7 +90,7 @@ (defmethod inspect-object :around (object pane) (cond ((member object *inspected-objects*) (with-output-as-presentation - (pane object (presentation-type-of object)) + (pane object (presentation-type-of object)) (princ "===" pane))) ; Prevent infinite loops ((not (gethash object (dico *application-frame*))) (inspect-object-briefly object pane)) @@ -113,7 +113,7 @@
(defmethod inspect-object (object pane) (with-output-as-presentation - (pane object (presentation-type-of object)) + (pane object (presentation-type-of object)) (prin1 object pane)))
@@ -124,7 +124,7 @@ (define-presentation-type long-list-tail () :inherit-from t)
-(define-presentation-method present (object (type settable-slot) +(define-presentation-method present (object (type settable-slot) stream (view textual-view) &key acceptably for-context-type) @@ -417,21 +417,45 @@ (inspect-cons-as-cells object pane) (inspect-cons-as-list object pane)))
+(defun show-hash-table-status (hash pane &key (message "Usage Graph")) + "Show a hash table's status graphically on a given +pane. Display a given message, which defaults to 'Usage Graph'." + (with-room-for-graphics (pane :height 20) + (let* ((my-beige (make-rgb-color 0.9372549 0.8862745 0.8862745)) + (used-color (make-rgb-color 0.43529412 0.7921569 0.87058824)) + (text-color (make-rgb-color 0.7176471 0.29803923 0.2)) + (pattern (make-rectangular-tile + (make-pattern #2A((0 1 0 0 0) + (1 0 0 0 0) + (0 0 0 0 1) + (0 0 0 1 0) + (0 0 1 0 0)) + (list my-beige +black+)) 5 5))) + (draw-rectangle* pane 0 0 150 20 :filled t :ink my-beige) + (draw-rectangle* pane 0 0 (* 150 (/ (hash-table-count hash) + (hash-table-size hash))) + 20 :filled t :ink used-color :line-thickness 0) + (draw-rectangle* pane (* 150 (hash-table-rehash-threshold hash)) 0 150 20 + :filled t :ink pattern :line-thickness 0) + (draw-rectangle* pane 0 0 150 20 :filled nil :ink +black+) + (draw-text* pane message 7 10 :align-y :center :align-x :left + :text-size :small :ink text-color :text-face :italic))))
(defmethod inspect-object-briefly ((object hash-table) pane) (with-output-as-presentation (pane object (presentation-type-of object)) - (princ 'hash-table pane))) + (show-hash-table-status object pane :message "Hash table"))) (defmethod inspect-object ((object hash-table) pane) (inspector-table (object pane) - (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (progn (format pane "~A (test: ~A)" 'hash-table (hash-table-test object)) + (show-hash-table-status object pane)) (loop for key being the hash-keys of object - 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)))))) + 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 (object pane)