3 (defcfun g-signal-connect-closure :ulong
5 (detailed-signal :string)
6 (closure (:pointer g-closure))
9 (defcfun g-signal-emitv :void
10 (instance-and-params (:pointer g-value))
13 (return-value (:pointer g-value)))
15 (defcfun g-signal-lookup :uint
19 (defbitfield g-signal-flags
20 :run-first :run-last :run-cleanup :no-recurse :detailed :action :no-hooks)
22 (defcstruct g-signal-query
26 (signal-flags g-signal-flags)
29 (param-types (:pointer g-type)))
31 (defcfun g-signal-query :void
33 (query (:pointer g-signal-query)))
35 (defun unmangle-type (type)
36 (logxor type (ldb (byte 1 0) type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE
38 (defun emit-signal (object signal-name &rest args)
39 (let ((signal-id (g-signal-lookup signal-name (g-type-from-object (pointer object)))))
41 (error "Signal ~A not found on object ~A" signal-name object))
42 (with-foreign-object (q 'g-signal-query)
43 (g-signal-query signal-id q)
44 (with-foreign-object (params 'g-value (+ 1 (foreign-slot-value q 'g-signal-query 'n-params)))
45 (set-g-value (mem-aref params 'g-value 0) object (g-type-from-object (pointer object)) :zero-g-value t)
46 (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params))
48 (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query 'param-types) 'g-type i)))
49 (set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t))
51 (if (= (foreign-slot-value q 'g-signal-query 'return-type) +g-type-void+)
52 (g-signal-emitv params signal-id signal-name (null-pointer))
53 (with-foreign-object (return-value 'g-value)
54 (g-value-zero return-value)
55 (g-value-init return-value (foreign-slot-value q 'g-signal-query 'return-type))
56 (prog1 (parse-gvalue return-value)
57 (g-value-unset return-value))))
58 (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params))
59 (g-value-unset (mem-aref params 'g-value (1+ i)))))))))