-(defun signal-connect (instance signal function &key after object)
- (let ((callback
- (cond
- ((or (eq object t) (eq object instance)) function)
- ((not object)
- #'(lambda (&rest args) (apply function (cdr args))))
- (t
- #'(lambda (&rest args) (apply function object (rest args)))))))
-
- (signal-connect-closure
- instance signal (register-callback-function callback) :after after)))
-
-
-;;;; Idles and timeouts
-
-; (defun timeout-remove (tag)
-; (source-remove tag))
-
-; (defun idle-remove (tag)
-; (source-remove tag))
+(defmethod signal-connect ((gobject gobject) signal function &key after object)
+"Connects a callback function to a signal for a particular object. If :OBJECT
+ is T, the object connected to is passed as the first argument to the callback
+ function, or if :OBJECT is any other non NIL value, it is passed as the first
+ argument instead. If :AFTER is non NIL, the handler will be called after the
+ default handler of the signal."
+ (let ((callback-id
+ (make-callback-closure
+ (cond
+ ((or (eq object t) (eq object gobject)) function)
+ ((not object)
+ #'(lambda (&rest args) (apply function (cdr args))))
+ (t
+ #'(lambda (&rest args) (apply function object (rest args))))))))
+ (signal-connect-closure gobject signal callback-id :after after)))
+
+
+;;; Message logging
+
+;; TODO: define and signal conditions based on log-level
+;(defun log-handler (domain log-level message)
+(def-callback log-handler (void (domain c-string) (log-level int)
+ (message c-string))
+ (error "~A: ~A" domain message))
+
+(setf (extern-alien "log_handler" system-area-pointer) (callback log-handler))