From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sun, 12 Jul 2009 12:05:58 +0000 (+0400)
Subject: Moved GClosure code
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=09d2c36049dbbcaaa2e9cd347d7ef7e03c6bb6b6;p=cl-gtk2.git

Moved GClosure code
---

diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd
index 011d6eb..fa55020 100644
--- a/glib/cl-gtk2-glib.asd
+++ b/glib/cl-gtk2-glib.asd
@@ -23,8 +23,8 @@
                (:file "gobject.gvalue")
                (:file "gobject.foreign")
                (:file "gobject.stable-pointer")
+               (:file "gobject.closure")
                (:file "gobject.foreign-gobject")
-               (:file "gobject.foreign-closures")
                (:file "gobject.foreign-gboxed")
                
                (:file "gobject.meta")
diff --git a/glib/gobject.closure.lisp b/glib/gobject.closure.lisp
new file mode 100644
index 0000000..502d9e4
--- /dev/null
+++ b/glib/gobject.closure.lisp
@@ -0,0 +1,49 @@
+(in-package :gobject)
+
+(defcstruct lisp-closure
+  (:parent-instance g-closure)
+  (:function-id :pointer))
+
+(defun finalize-lisp-closure (closure)
+  (let ((function-id (foreign-slot-value closure 'lisp-closure :function-id)))
+    (free-stable-pointer function-id)))
+
+(defcallback lisp-closure-finalize :void ((data :pointer)
+                                          (closure (:pointer lisp-closure)))
+  (declare (ignore data))
+  (finalize-lisp-closure closure))
+
+(defun call-with-restarts (fn args)
+  (restart-case
+      (apply fn args)
+    (return-from-g-closure (&optional v) :report "Return value from closure" v)))
+
+(defcallback lisp-closure-marshal :void ((closure (:pointer lisp-closure))
+                                         (return-value (:pointer g-value))
+                                         (count-of-args :uint)
+                                         (args (:pointer g-value))
+                                         (invocation-hint :pointer)
+                                         (marshal-data :pointer))
+  (declare (ignore invocation-hint marshal-data))
+  (let* ((args (parse-closure-arguments count-of-args args))
+         (function-id (foreign-slot-value closure 'lisp-closure :function-id))
+         (return-type (and (not (null-pointer-p return-value))
+                           (gvalue-type return-value)))
+         (fn (get-stable-pointer-value function-id))
+         (fn-result (call-with-restarts fn args)))
+    (when return-type
+      (set-g-value return-value fn-result return-type :g-value-init nil))))
+
+(defun parse-closure-arguments (count-of-args args)
+  (loop
+     for i from 0 below count-of-args
+     collect (parse-gvalue (mem-aref args 'g-value i))))
+
+(defun create-g-closure (fn)
+  (let ((function-id (allocate-stable-pointer fn))
+        (closure (g-closure-new-simple (foreign-type-size 'lisp-closure) (null-pointer))))
+    (setf (foreign-slot-value closure 'lisp-closure :function-id) function-id)
+    (g-closure-add-finalize-notifier closure (null-pointer)
+                                     (callback lisp-closure-finalize))
+    (g-closure-set-marshal closure (callback lisp-closure-marshal))
+    closure))
diff --git a/glib/gobject.ffi.lisp b/glib/gobject.ffi.lisp
index fab0916..626900f 100644
--- a/glib/gobject.ffi.lisp
+++ b/glib/gobject.ffi.lisp
@@ -985,10 +985,6 @@ Example:
   (detail-ptr (:pointer g-quark))
   (force-detail-quark :boolean))
 
-(defcstruct lisp-closure
-  (:parent-instance g-closure)
-  (:function-id :pointer))
-
 (defcstruct g-object-struct
   (:type-instance g-type-instance)
   (:ref-count :uint)
diff --git a/glib/gobject.foreign-closures.lisp b/glib/gobject.foreign-closures.lisp
deleted file mode 100644
index 0b30da8..0000000
--- a/glib/gobject.foreign-closures.lisp
+++ /dev/null
@@ -1,62 +0,0 @@
-(in-package :gobject)
-
-(defcallback lisp-closure-finalize :void ((data :pointer)
-                                          (closure (:pointer lisp-closure)))
-  (declare (ignore data))
-  (finalize-lisp-closure closure))
-
-(defun call-with-restarts (fn args)
-  (restart-case
-      (apply fn args)
-    (return-from-g-closure (&optional v) :report "Return value from closure" v)))
-
-(defcallback lisp-closure-marshal :void ((closure (:pointer lisp-closure))
-                                         (return-value (:pointer g-value))
-                                         (count-of-args :uint)
-                                         (args (:pointer g-value))
-                                         (invocation-hint :pointer)
-                                         (marshal-data :pointer))
-  (declare (ignore invocation-hint marshal-data))
-  (let* ((args (parse-closure-arguments count-of-args args))
-         (function-id (foreign-slot-value closure 'lisp-closure :function-id))
-         (return-type (and (not (null-pointer-p return-value))
-                           (gvalue-type return-value)))
-         (fn (get-stable-pointer-value function-id))
-         (fn-result (call-with-restarts fn args)))
-    (when return-type
-      (set-g-value return-value fn-result return-type :g-value-init nil))))
-
-(defun parse-closure-arguments (count-of-args args)
-  (loop
-     for i from 0 below count-of-args
-     collect (parse-gvalue (mem-aref args 'g-value i))))
-
-(defun create-closure (fn)
-  (let ((function-id (allocate-stable-pointer fn))
-        (closure (g-closure-new-simple (foreign-type-size 'lisp-closure) (null-pointer))))
-    (setf (foreign-slot-value closure 'lisp-closure :function-id) function-id)
-    (g-closure-add-finalize-notifier closure (null-pointer)
-                                     (callback lisp-closure-finalize))
-    (g-closure-set-marshal closure (callback lisp-closure-marshal))
-    closure))
-
-(defun g-signal-connect (object signal handler &key after)
-  "Deprecated alias for @fun{connect-signal}"
-  (connect-signal object signal handler :after after))
-
-(defun connect-signal (object signal handler &key after)
-  "Connects the function to a signal for a particular object.
-If @code{after} is true, then the function will be called after the default handler of the signal.
-
-@arg[object]{an instance of @class{gobject}}
-@arg[signal]{a string; names the signal}
-@arg[handler]{a function; handles the signal. Number (and type) of arguments and return value type depends on the signal}
-@arg[after]{a boolean}"
-  (g-signal-connect-closure (ensure-object-pointer object)
-                            signal
-                            (create-closure handler)
-                            after))
-
-(defun finalize-lisp-closure (closure)
-  (let ((function-id (foreign-slot-value closure 'lisp-closure :function-id)))
-    (free-stable-pointer function-id)))
\ No newline at end of file
diff --git a/glib/gobject.foreign-gobject.lisp b/glib/gobject.foreign-gobject.lisp
index 15fa956..244e664 100644
--- a/glib/gobject.foreign-gobject.lisp
+++ b/glib/gobject.foreign-gobject.lisp
@@ -342,6 +342,23 @@
 (defmethod set-gvalue-for-type (gvalue-ptr (type-numeric (eql +g-type-interface+)) value)
   (set-gvalue-object gvalue-ptr value))
 
+(defun g-signal-connect (object signal handler &key after)
+  "Deprecated alias for @fun{connect-signal}"
+  (connect-signal object signal handler :after after))
+
+(defun connect-signal (object signal handler &key after)
+  "Connects the function to a signal for a particular object.
+If @code{after} is true, then the function will be called after the default handler of the signal.
+
+@arg[object]{an instance of @class{gobject}}
+@arg[signal]{a string; names the signal}
+@arg[handler]{a function; handles the signal. Number (and type) of arguments and return value type depends on the signal}
+@arg[after]{a boolean}"
+  (g-signal-connect-closure (ensure-object-pointer object)
+                            signal
+                            (create-g-closure handler)
+                            after))
+
 (defun emit-signal (object signal-name &rest args)
   "Emits the signal.
 @arg[object]{an instance of @class{g-object}. Signal is emitted on this object}