3 (defcallback lisp-closure-finalize :void ((data :pointer)
4 (closure (:pointer lisp-closure)))
5 (declare (ignore data))
6 (finalize-lisp-closure closure))
8 (defun call-with-restarts (fn args)
11 (return-from-g-closure (&optional v) :report "Return value from closure" v)))
13 (defcallback lisp-closure-marshal :void ((closure (:pointer lisp-closure))
14 (return-value (:pointer g-value))
16 (args (:pointer g-value))
17 (invocation-hint :pointer)
18 (marshal-data :pointer))
19 (declare (ignore invocation-hint marshal-data))
20 (let* ((args (parse-closure-arguments count-of-args args))
21 (function-id (foreign-slot-value closure 'lisp-closure :function-id))
22 (return-type (and (not (null-pointer-p return-value))
23 (gvalue-type return-value)))
24 (fn (get-stable-pointer-value function-id))
25 (fn-result (call-with-restarts fn args)))
27 (set-g-value return-value fn-result return-type :g-value-init nil))))
29 (defun parse-closure-arguments (count-of-args args)
31 for i from 0 below count-of-args
32 collect (parse-gvalue (mem-aref args 'g-value i))))
34 (defun create-closure (fn)
35 (let ((function-id (allocate-stable-pointer fn))
36 (closure (g-closure-new-simple (foreign-type-size 'lisp-closure) (null-pointer))))
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 "Deprecated alias for @fun{connect-signal}"
45 (connect-signal object signal handler :after after))
47 (defun connect-signal (object signal handler &key after)
48 "Connects the function to a signal for a particular object.
49 If @code{after} is true, then the function will be called after the default handler of the signal.
51 @arg[object]{an instance of @class{gobject}}
52 @arg[signal]{a string; names the signal}
53 @arg[handler]{a function; handles the signal. Number (and type) of arguments and return value type depends on the signal}
54 @arg[after]{a boolean}"
55 (g-signal-connect-closure (ensure-object-pointer object)
57 (create-closure handler)
60 (defun finalize-lisp-closure (closure)
61 (let ((function-id (foreign-slot-value closure 'lisp-closure :function-id)))
62 (free-stable-pointer function-id)))