Update of /project/lgtk/cvsroot/lgtk/src In directory common-lisp.net:/tmp/cvs-serv20598/src Modified Files: gtkbindings.lisp gtkclasshierarchy.lisp gtklisp.lisp gtknexus.lisp nexus.lisp widgets.lisp Log Message: The identity of accessory objects (like GSlist) gets properly handled. Date: Fri Oct 31 05:52:53 2003 Author: mmommer Index: lgtk/src/gtkbindings.lisp diff -u lgtk/src/gtkbindings.lisp:1.1.1.1 lgtk/src/gtkbindings.lisp:1.2 --- lgtk/src/gtkbindings.lisp:1.1.1.1 Mon Oct 27 14:14:55 2003 +++ lgtk/src/gtkbindings.lisp Fri Oct 31 05:52:52 2003 @@ -17,11 +17,15 @@ (defun rbooltrans (x) (if (/= x 0) t nil)) -(defclass gslist (simple-capsule) ()) +'(defclass gslist (simple-capsule) ()) -(defun gslist-capsule (obj) +'(defun gslist-capsule (obj) (make-instance 'gslist :contents obj)) +(defclass gslist (sapcapsule) ()) + +(def-encapsulator gslist-encap gslist) + ;; For types where nil is acceptable as an object (defun contents-nil (obj) (cond ((null obj) obj) @@ -36,7 +40,7 @@ (gslist :in 'contents-nil - :out 'gslist-capsule + :out 'gslist-encap :alien '(* t)) (gtkwindowtype @@ -149,6 +153,10 @@ (def-binding "gtk_radio_button_new_with_mnemonic_from_widget" (gtkradiobutton (gtkradiobutton group) (c-string msg))) + +(def-binding "gtk_radio_button_get_group" + (gslist (gtkradiobutton obj)) + :after (lambda (x) (gcconnect obj x) x)) (def-binding "gtk_toggle_button_get_active" (gboolean (gtktogglebutton wid))) Index: lgtk/src/gtkclasshierarchy.lisp diff -u lgtk/src/gtkclasshierarchy.lisp:1.1.1.1 lgtk/src/gtkclasshierarchy.lisp:1.2 --- lgtk/src/gtkclasshierarchy.lisp:1.1.1.1 Mon Oct 27 14:15:07 2003 +++ lgtk/src/gtkclasshierarchy.lisp Fri Oct 31 05:52:52 2003 @@ -38,7 +38,6 @@ :initarg :meta :initform (find-class 'gtk-objmeta)))) - ;;; ;;; Here we import the complete gtk class hierarchy. ;;; @@ -170,3 +169,4 @@ ;; engage. (make-gtk-object-hierarchy)) + Index: lgtk/src/gtklisp.lisp diff -u lgtk/src/gtklisp.lisp:1.1.1.1 lgtk/src/gtklisp.lisp:1.2 --- lgtk/src/gtklisp.lisp:1.1.1.1 Mon Oct 27 14:15:00 2003 +++ lgtk/src/gtklisp.lisp Fri Oct 31 05:52:52 2003 @@ -115,14 +115,14 @@ (let ((it (make-instance capsule :contents realw :nexus *gtkobjects*))) - - ;; We need at least one destroy call to know it's over and remove - ;; all activable trace of the widget. - (g-signal-connect it gtkdestroy - #'dummy-func) - it)))))) +;; We need at least one destroy call to know it's over and remove +;; all activable trace of the widget. +(defmethod initialize-instance :after ((it gtk-objcapsule) &key) + (g-signal-connect it + gtkdestroy + #'dummy-func)) ;; Initialize. (eval-when (:load-toplevel :execute :compile-toplevel) Index: lgtk/src/gtknexus.lisp diff -u lgtk/src/gtknexus.lisp:1.1.1.1 lgtk/src/gtknexus.lisp:1.2 --- lgtk/src/gtknexus.lisp:1.1.1.1 Mon Oct 27 14:15:02 2003 +++ lgtk/src/gtknexus.lisp Fri Oct 31 05:52:52 2003 @@ -13,7 +13,7 @@ (defmethod destroy ((m gtk-objmeta)) (debugf t "Here we go destroying a gtk-objmeta~%") (let ((standing (destroyers m))) - (cond (standing + (cond ((and standing (kill-on-gc-p m)) (debugf t "It is still standing.~%") (mapcar #'destroy (callbacks m)) (debugf t "Callbacks deallocated.~%") Index: lgtk/src/nexus.lisp diff -u lgtk/src/nexus.lisp:1.1.1.1 lgtk/src/nexus.lisp:1.2 --- lgtk/src/nexus.lisp:1.1.1.1 Mon Oct 27 14:15:05 2003 +++ lgtk/src/nexus.lisp Fri Oct 31 05:52:53 2003 @@ -14,6 +14,7 @@ :contents :metacapsule :metacapsule-identify + :kill-on-gc-p :bag :meta :nexus @@ -76,6 +77,10 @@ (capsule :initarg :capsule :initform nil) + ;; Do we destroy this on GC? Good question. On by default. + (kill-on-gc-p :accessor kill-on-gc-p + :initform T) + ;; The nexus keeps a reference to it. Needed for bookkeeping. (nexus :accessor nexus :initarg :nexus @@ -214,11 +219,12 @@ (setf (slot-value meta 'id) id) id)))) -;; Standard destroy methods. Like this they would not make any sense. +;; Standard destroy methods. Like this they would not make much sense. (defmethod destroy ((meta metacapsule)) (let ((n (nexus meta))) (if n (remhash (metacapsule-identify meta) (table n))) + (debugf t "Removed ~a from nexus ~a.~%" meta n))) (defmethod destroy ((meta idmeta)) Index: lgtk/src/widgets.lisp diff -u lgtk/src/widgets.lisp:1.1.1.1 lgtk/src/widgets.lisp:1.2 --- lgtk/src/widgets.lisp:1.1.1.1 Mon Oct 27 14:15:08 2003 +++ lgtk/src/widgets.lisp Fri Oct 31 05:52:53 2003 @@ -11,6 +11,8 @@ :widcapsule :callbacks :destroyers + :sapcapsule + :sapmeta :resource :callback-resource :marker @@ -30,6 +32,10 @@ (in-package :widget-nexus) (defclass sapmeta (metacapsule) ()) +(defclass sapcapsule (weak-capsule) + ((meta :accessor meta + :initarg :meta + :initform (find-class 'sapmeta)))) (defmethod metacapsule-identify ((m sapmeta)) (alien-address (contents m)))