WITH-GVALUE now uses WITH-ALLOCATED-MEMORY

[clg] / glib / gcallback.lisp

diff --git a/glib/gcallback.lisp b/glib/gcallback.lisp
index cf0b9ea619e69aec56f709e8fcb0f57a23dc4ad2..faab749b7fccc2af05f6593df0278397a958f38f 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.29 2006/02/08 19:56:25 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-get (sap+ param-values offset) t))))
+    (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


@@ -213,14 +220,12 @@ (defbinding %signal-chain-from-overridden () nil
   (return-value (or null gvalue)))
 
 
   (return-value (or null gvalue)))
 
 

-(defun %call-next-handler (n-params types args defaults return-type)
+(defun %call-next-handler (n-params types args return-type)

   (let ((params (allocate-memory (* n-params +gvalue-size+))))
     (loop 
   (let ((params (allocate-memory (* n-params +gvalue-size+))))
     (loop 

-     as tmp = args then (rest tmp)
-     for default in defaults
+     for arg in args

      for type in types
      for offset from 0 by +gvalue-size+
      for type in types
      for offset from 0 by +gvalue-size+

-     as arg = (if tmp (car tmp) default)

      do (gvalue-init (sap+ params offset) type arg))
 
     (unwind-protect
      do (gvalue-init (sap+ params offset) type arg))
 
     (unwind-protect


@@ -246,15 +251,16 @@ (defmacro define-signal-handler (name ((object class) &rest args) &body body)
                until (eq arg '&rest)
                collect arg))
         (rest (cadr (member '&rest args)))
                until (eq arg '&rest)
                collect arg))
         (rest (cadr (member '&rest args)))

-        (next (make-symbol "ARGS")))
+        (next (make-symbol "ARGS"))
+        (default (make-symbol "DEFAULT")))

 
     `(progn
        (signal-override-class-closure ',name ',class 
        #'(lambda (,object ,@args)
 
     `(progn
        (signal-override-class-closure ',name ',class 
        #'(lambda (,object ,@args)

-           (flet ((call-next-handler (&rest ,next)
-                    (let ((defaults (list* ,object ,@vars ,rest)))
+           (let ((,default (list* ,object ,@vars ,rest)))
+             (flet ((call-next-handler (&rest ,next)

                       (%call-next-handler 
                       (%call-next-handler 

-                       ,n-params ',types ,next defaults ',return-type))))
+                       ,n-params ',types (or ,next ,default) ',return-type))))

              ,@body)))
        ',name)))
 
              ,@body)))
        ',name)))