glib/gobject.object-function.lisp

   1 (in-package :gobject)
   2
   3 (defcstruct object-func-ref
   4   (:object :pointer)
   5   (:fn-id :int))
   6 (defctype object-func-ref (:struct object-func-ref))
   7
   8 (defmacro define-cb-methods (name return-type (&rest args))
   9   (flet ((make-name (control-string) (intern (format nil control-string (symbol-name name)) (symbol-package name))))
  10     (let ((call-cb (make-name "~A-CB"))
  11           (destroy-cb (make-name "~A-DESTROY-NOTIFY"))
  12           (object (gensym "OBJECT"))
  13           (fn-id (gensym "FN-ID"))
  14           (fn (gensym "FN"))
  15           (data (gensym "DATA"))
  16           (arg-names (mapcar #'first args)))
  17       `(progn
  18          (defcallback ,call-cb ,return-type (,@args (,data :pointer))
  19            (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object))
  20                   (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id))
  21                   (,fn (retrieve-handler-from-object ,object ,fn-id)))
  22              (funcall ,fn ,@arg-names)))
  23          (defcallback ,destroy-cb :void ((,data :pointer))
  24            (let* ((,object (convert-from-foreign (foreign-slot-value ,data 'object-func-ref :object) 'g-object))
  25                   (,fn-id (foreign-slot-value ,data 'object-func-ref :fn-id)))
  26              (delete-handler-from-object ,object ,fn-id))
  27            (foreign-free ,data))))))
  28
  29 (defun create-fn-ref (object function)
  30   (let ((ref (foreign-alloc 'object-func-ref))
  31         (fn-id (save-handler-to-object object function)))
  32     (setf (foreign-slot-value ref 'object-func-ref :object)
  33           (pointer object)
  34           (foreign-slot-value ref 'object-func-ref :fn-id)
  35           fn-id)
  36     ref))