chiark
/
gitweb
/
~mdw
/
clg
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
985e4aa
)
Added the PCL package to list of used packages
author
espen
<espen>
Fri, 3 Feb 2006 00:15:52 +0000
(
00:15
+0000)
committer
espen
<espen>
Fri, 3 Feb 2006 00:15:52 +0000
(
00:15
+0000)
examples/ginspect.lisp
patch
|
blob
|
blame
|
history
diff --git
a/examples/ginspect.lisp
b/examples/ginspect.lisp
index f07e87e07a7eca2a42664d73faf570823c32dc66..b9d9ba726965c659fbcadd4f447d51e68adc7662 100644
(file)
--- 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.
;; 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-")
(defvar *ginspect-unbound-object-marker*
#+cmu (gensym "UNBOUND-OBJECT-")
@@
-35,6
+42,12
@@
(defgeneric object-has-parts-p (object))
(defgeneric decompose-describe-object (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)
(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))))
;; 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
(tree-view-expand-row view path nil))))
(make-instance 'dialog
@@
-153,15
+166,14
@@
(defmethod object-to-string ((object (eql *ginspect-unbound-object-marker*)))
"<unbound>")
(defmethod insert-object ((object t) store parent &optional (name ""))
"<unbound>")
(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)))
(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)
(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
(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)
(defmethod insert-parts :around ((object t) store parent)
(when (object-has-parts-p object)