gobject: exported foreign closures API; add disconnect-signal
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Sat, 12 Sep 2009 21:04:49 +0000 (01:04 +0400)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Sat, 12 Sep 2009 21:04:49 +0000 (01:04 +0400)
glib/gobject.package.lisp
glib/gobject.signals.lisp

index e185819..5649e74 100644 (file)
            #:get-flags-items
            #:stable-pointer-value
            #:g-value-type
-           #:create-g-closure
            #:g-object-call-constructor
            #:g-object-call-get-property
            #:g-object-call-set-property
            #:g-boxed-foreign
            #:boxed-related-symbols
            #:define-boxed-opaque-accessor
-           #:glib-defcallback)
+           #:glib-defcallback
+           #:create-signal-handler-closure
+           #:save-handler-to-object
+           #:retrieve-handler-from-object
+           #:delete-handler-from-object)
   (:documentation
    "CL-GTK2-GOBJECT is a binding to GObject type system.
 For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}.
index 667f0d9..6935451 100644 (file)
@@ -1,5 +1,7 @@
 (in-package :gobject)
 
+;;; Signal handler closures
+
 (defcstruct lisp-signal-handler-closure
   (:parent-instance g-closure)
   (:object :pointer)
@@ -68,8 +70,8 @@
   (let ((id (find-free-signal-handler-id object))
         (handlers (g-object-signal-handlers object)))
     (if id
-        (setf (aref handlers id) handler)
-        (vector-push-extend handler handlers))))
+        (progn (setf (aref handlers id) handler) id)
+        (progn (vector-push-extend handler handlers) (1- (length handlers))))))
 
 (defun retrieve-handler-from-object (object handler-id)
   (aref (g-object-signal-handlers object) handler-id))
@@ -126,3 +128,9 @@ If @code{after} is true, then the function will be called after the default hand
                     (g-value-unset return-value))))
           (iter (for i from 0 below (1+ params-count))
                 (g-value-unset (mem-aref params 'g-value i))))))))
+
+(defcfun (disconnect-signal "g_signal_handler_disconnect") :void
+  (object g-object)
+  (handler-id :ulong))
+
+(export 'disconnect-signal)