3 (defcstruct lisp-closure
4 (parent-instance g-closure)
5 (function-id :pointer))
7 (defcallback lisp-closure-finalize :void ((data :pointer)
8 (closure (:pointer lisp-closure)))
9 (declare (ignore data))
10 (finalize-lisp-closure closure))
12 (defcallback lisp-closure-marshal :void ((closure (:pointer lisp-closure))
13 (return-value (:pointer g-value))
15 (args (:pointer g-value))
16 (invocation-hint :pointer)
17 (marshal-data :pointer))
18 (declare (ignore invocation-hint marshal-data))
19 (let* ((args (parse-closure-arguments count-of-args args))
20 (function-id (foreign-slot-value closure 'lisp-closure 'function-id))
21 (return-type (and (not (null-pointer-p return-value))
22 (gvalue-type return-value)))
23 (fn (get-stable-pointer-value function-id))
24 (fn-result (apply fn args)))
26 (set-g-value return-value fn-result return-type))))
28 (defun parse-closure-arguments (count-of-args args)
30 for i from 0 below count-of-args
31 collect (parse-gvalue (mem-aref args 'g-value i))))
33 (defun create-closure (fn)
34 (let ((function-id (allocate-stable-pointer fn))
35 (closure (g-closure-new-simple (foreign-type-size 'lisp-closure)
37 (setf (foreign-slot-value closure 'lisp-closure 'function-id) function-id)
38 (g-closure-add-finalize-notifier closure (null-pointer)
39 (callback lisp-closure-finalize))
40 (g-closure-set-marshal closure (callback lisp-closure-marshal))
43 (defun g-signal-connect (object signal handler &key after)
44 (g-signal-connect-closure (ensure-object-pointer object)
46 (create-closure handler)
49 (defun finalize-lisp-closure (closure)
50 (let ((function-id (foreign-slot-value closure 'lisp-closure 'function-id)))
51 (free-stable-pointer function-id)))