glib/gobject.signals.lisp

   1 (in-package :gobject)
   2
   3 (defun unmangle-type (type)
   4   (logxor type (ldb (byte 1 0) type)));;subtract the G_SIGNAL_TYPE_STATIC_SCOPE
   5
   6 (defun emit-signal (object signal-name &rest args)
   7   "Emits the signal.
   8 @arg[object]{an instance of @class{g-object}. Signal is emitted on this object}
   9 @arg[signal-name]{a string specifying the signal}
  10 @arg[args]{arguments for the signal}
  11 @return{none}"
  12   (let ((signal-id (g-signal-lookup signal-name (g-type-from-object (pointer object)))))
  13     (when (= signal-id 0)
  14       (error "Signal ~A not found on object ~A" signal-name object))
  15     (with-foreign-object (q 'g-signal-query)
  16       (g-signal-query signal-id q)
  17       (with-foreign-object (params 'g-value (+ 1 (foreign-slot-value q 'g-signal-query :n-params)))
  18         (set-g-value (mem-aref params 'g-value 0) object (g-type-from-object (pointer object)) :zero-g-value t)
  19         (iter (for i from 0 below (foreign-slot-value q 'g-signal-query :n-params))
  20               (for arg in args)
  21               (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query :param-types) 'g-type i)))
  22               (set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t))
  23         (prog1
  24             (if (= (foreign-slot-value q 'g-signal-query :return-type) +g-type-void+)
  25                 (g-signal-emitv params signal-id signal-name (null-pointer))
  26                 (with-foreign-object (return-value 'g-value)
  27                   (g-value-zero return-value)
  28                   (g-value-init return-value (foreign-slot-value q 'g-signal-query :return-type))
  29                   (prog1 (parse-gvalue return-value)
  30                     (g-value-unset return-value))))
  31           (iter (for i from 0 below (foreign-slot-value q 'g-signal-query :n-params))
  32                 (g-value-unset (mem-aref params 'g-value (1+ i)))))))))