Proxies for non reference counted foreign objects passed as arguments to signal handl...

diff --git a/glib/gcallback.lisp b/glib/gcallback.lisp
index e8d7ca48fddfd5d935c3cbd8ae6a542eb9b8f05f..6a5cbab784526bbfa2191bde44ef03a167d3c489 100644 (file)
--- a/glib/gcallback.lisp
+++ b/glib/gcallback.lisp
@@ -20,7 +20,7 @@
 ;; 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: gcallback.lisp,v 1.26 2006-02-01 14:18:49 espen Exp $
+;; $Id: gcallback.lisp,v 1.27 2006-02-06 11:56:22 espen Exp $

 
 (in-package "GLIB")
 
 
 (in-package "GLIB")
 


@@ -58,10 +58,17 @@ (defun callback-trampoline (callback-id n-params param-values &optional
                        (gvalue-type return-value)))
         (args (loop
                for n from 0 below n-params
                        (gvalue-type return-value)))
         (args (loop
                for n from 0 below n-params

-               collect (gvalue-get (sap+ param-values (* n +gvalue-size+))))))
-    (let ((result (apply #'invoke-callback callback-id return-type args)))
-      (when return-type
-       (gvalue-set return-value result)))))
+               for offset from 0 by +gvalue-size+
+               collect (gvalue-weak-get (sap+ param-values offset)))))
+    (unwind-protect
+       (let ((result (apply #'invoke-callback callback-id return-type args)))
+         (when return-type
+           (gvalue-set return-value result)))
+      (loop 
+       for arg in args
+       when (typep arg 'proxy)
+       do (invalidate-instance arg)))))
+

 
 (defun invoke-callback (callback-id return-type &rest args)
   (restart-case
 
 (defun invoke-callback (callback-id return-type &rest args)
   (restart-case


@@ -212,7 +219,7 @@ (defbinding %signal-chain-from-overridden () nil
   (args pointer)
   (return-value (or null gvalue)))
 
   (args pointer)
   (return-value (or null gvalue)))
 

-
+;; TODO: implement same semantics as CALL-NEXT-METHOD

 (defun %call-next-handler (n-params types args defaults return-type)
   (let ((params (allocate-memory (* n-params +gvalue-size+))))
     (loop 
 (defun %call-next-handler (n-params types args defaults return-type)
   (let ((params (allocate-memory (* n-params +gvalue-size+))))
     (loop 

diff --git a/glib/gparam.lisp b/glib/gparam.lisp
index d7065807238d251d31b25cb5a9ed9b980d1fbcef..7c1ab5e42b628335d0fd530839ab627ce13c0e82 100644 (file)
--- a/glib/gparam.lisp
+++ b/glib/gparam.lisp
@@ -20,7 +20,7 @@
 ;; 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: gparam.lisp,v 1.17 2005-04-23 16:48:51 espen Exp $
+;; $Id: gparam.lisp,v 1.18 2006-02-06 11:56:22 espen Exp $

 
 (in-package "GLIB")
 
 
 (in-package "GLIB")
 


@@ -64,10 +64,14 @@ (defun gvalue-free (gvalue &optional (unset-p t))
 (defun gvalue-type (gvalue)
   (type-from-number (sap-ref-32 gvalue 0)))
 
 (defun gvalue-type (gvalue)
   (type-from-number (sap-ref-32 gvalue 0)))
 

-(defun gvalue-get (gvalue)
+(defun gvalue-get (gvalue)  

   (funcall (reader-function (gvalue-type gvalue))
    gvalue +gvalue-value-offset+))
 
   (funcall (reader-function (gvalue-type gvalue))
    gvalue +gvalue-value-offset+))
 

+(defun gvalue-weak-get (gvalue)  
+  (funcall (weak-reader-function (gvalue-type gvalue))
+   gvalue +gvalue-value-offset+))
+

 (defun gvalue-set (gvalue value)
   (funcall (writer-function (gvalue-type gvalue))
    value gvalue +gvalue-value-offset+)
 (defun gvalue-set (gvalue value)
   (funcall (writer-function (gvalue-type gvalue))
    value gvalue +gvalue-value-offset+)