From d427b0a5682deda370b1642fbf53d82cc6fb6de4 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Fri, 3 Feb 2006 00:15:52 +0000 Subject: [PATCH] Added the PCL package to list of used packages Organization: Straylight/Edgeware From: espen --- examples/ginspect.lisp | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/examples/ginspect.lisp b/examples/ginspect.lisp index ebdbefe..25b49d1 100644 --- a/examples/ginspect.lisp +++ b/examples/ginspect.lisp @@ -20,9 +20,16 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: ginspect.lisp,v 1.7 2006-02-02 23:00:28 espen Exp $ +;; $Id: ginspect.lisp,v 1.8 2006-02-03 00:15:52 espen Exp $ -(in-package :gtk) +#+sbcl(require :gtk) +#+cmu(asdf:oos 'asdf:load-op :gtk) + +(defpackage "GINSPECT" + (:use "COMMON-LISP" "GLIB" "GTK" #+cmu"PCL" #+sbcl"SB-PCL") + (:export "GINSPECT")) + +(in-package "GINSPECT") (defvar *ginspect-unbound-object-marker* #+cmu (gensym "UNBOUND-OBJECT-") @@ -35,6 +42,12 @@ (defgeneric object-has-parts-p (object)) (defgeneric decompose-describe-object (object)) +;; A container to hold lisp objects "inside" the tree store +(defclass object-container (gobject) + ((object :initarg :object)) + (:metaclass gobject-class)) + + (defun ginspect (object) (let* ((store (make-instance 'tree-store :column-types '(string string gobject boolean) @@ -62,8 +75,8 @@ (defun ginspect (object) ;; Remove old children (when valid (loop while (tree-store-remove store child-iter)))) - (let ((gobject (tree-model-value store iter 'object))) - (insert-parts (object-data gobject 'object) store iter)) + (let ((container (tree-model-value store iter 'object))) + (insert-parts (slot-value container 'object) store iter)) (tree-view-expand-row view path nil)))) (make-instance 'dialog @@ -153,15 +166,14 @@ (defmethod object-to-string ((object (eql *ginspect-unbound-object-marker*))) "") (defmethod insert-object ((object t) store parent &optional (name "")) - (let ((gobject (make-instance 'gobject)) ; to "hang" the lisp object on + (let ((container (make-instance 'object-container :object object)) (has-parts (object-has-parts-p object))) - (setf (object-data gobject 'object) object) (let ((iter (tree-store-append store parent (vector name (object-to-string object) - gobject (not has-parts))))) + container (not has-parts))))) (when has-parts ;; Insert dummy child - (tree-store-append store iter (vector "" "" gobject t)))))) + (tree-store-append store iter (vector "" "" container t)))))) (defmethod insert-parts :around ((object t) store parent) (when (object-has-parts-p object) -- [mdw]