(in-package :gobject)
-(defcfun g-signal-connect-closure :ulong
- (instance :pointer)
- (detailed-signal :string)
- (closure (:pointer g-closure))
- (after :boolean))
-
-(defcfun g-signal-emitv :void
- (instance-and-params (:pointer g-value))
- (signal-id :uint)
- (detail g-quark)
- (return-value (:pointer g-value)))
-
-(defcfun g-signal-lookup :uint
- (name :string)
- (type g-type))
-
-(defbitfield g-signal-flags
- :run-first :run-last :run-cleanup :no-recurse :detailed :action :no-hooks)
-
-(defcstruct g-signal-query
- (signal-id :uint)
- (signal-name :string)
- (owner-type g-type)
- (signal-flags g-signal-flags)
- (return-type g-type)
- (n-params :uint)
- (param-types (:pointer g-type)))
-
-(defcfun g-signal-query :void
- (signal-id :uint)
- (query (:pointer g-signal-query)))
-
-(defun unmangle-type (type)
- (logxor type (ldb (byte 1 0) type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE
-
(defun emit-signal (object signal-name &rest args)
- (let ((signal-id (g-signal-lookup signal-name (g-type-from-object (pointer object)))))
- (when (= signal-id 0)
+ "Emits the signal.
+@arg[object]{an instance of @class{g-object}. Signal is emitted on this object}
+@arg[signal-name]{a string specifying the signal}
+@arg[args]{arguments for the signal}
+@return{none}"
+ (let* ((object-type (g-type-from-object (pointer object)))
+ (signal-info (parse-signal-name object-type signal-name)))
+ (unless signal-info
(error "Signal ~A not found on object ~A" signal-name object))
- (with-foreign-object (q 'g-signal-query)
- (g-signal-query signal-id q)
- (with-foreign-object (params 'g-value (+ 1 (foreign-slot-value q 'g-signal-query 'n-params)))
- (set-g-value (mem-aref params 'g-value 0) object (g-type-from-object (pointer object)) :zero-g-value t)
- (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params))
+ (let ((params-count (length (signal-info-param-types signal-info))))
+ (with-foreign-object (params 'g-value (1+ params-count))
+ (set-g-value (mem-aref params 'g-value 0) object object-type :zero-g-value t)
+ (iter (for i from 0 below params-count)
(for arg in args)
- (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query 'param-types) 'g-type i)))
+ (for type in (signal-info-param-types signal-info))
(set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t))
- (with-foreign-object (return-value 'g-value)
- (g-value-zero return-value)
- (g-value-init return-value (foreign-slot-value q 'g-signal-query 'return-type))
- (g-signal-emitv params signal-id signal-name return-value)
- (prog1 (if (= (foreign-slot-value q 'g-signal-query 'return-type)
- +g-type-void+)
- (values)
- (parse-gvalue return-value))
- (g-value-unset return-value)
- (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params))
- (g-value-unset (mem-aref params 'g-value (1+ i))))))))))
\ No newline at end of file
+ (prog1
+ (if (= (g-type-numeric (signal-info-return-type signal-info)) +g-type-void+)
+ (g-signal-emitv params (signal-info-id signal-info) signal-name (null-pointer))
+ (with-foreign-object (return-value 'g-value)
+ (g-value-zero return-value)
+ (g-value-init return-value (signal-info-return-type signal-info))
+ (prog1 (parse-gvalue return-value)
+ (g-value-unset return-value))))
+ (iter (for i from 0 below (1+ params-count))
+ (g-value-unset (mem-aref params 'g-value i))))))))
\ No newline at end of file