glib/gobject.object-function.lisp

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