glib/gobject.cffi-callbacks.lisp

   1 (in-package :gobject)
   2
   3 (defun wrap-body-with-boxed-translations (args body)
   4   (if (null args)
   5       body
   6       (let ((arg (first args)))
   7         (destructuring-bind (arg-name arg-type) arg
   8           (if (and (listp arg-type) (eq 'g-boxed-foreign (first arg-type)))
   9               (let ((var (gensym))
  10                     (cffi-type (cffi::parse-type arg-type)))
  11                 `((let ((,var ,arg-name)
  12                         (,arg-name (translate-from-foreign ,arg-name ,cffi-type)))
  13                     (unwind-protect
  14                          (progn ,@(wrap-body-with-boxed-translations (rest args) body))
  15                       (cleanup-translated-object-for-callback ,cffi-type ,arg-name ,var)))))
  16               (wrap-body-with-boxed-translations (rest args) body))))))
  17
  18 (defmacro glib-defcallback (name-and-options return-type args &body body)
  19   (let* ((c-args (iter (for arg in args)
  20                        (for (name type) = arg)
  21                        (if (and (listp type) (eq 'g-boxed-foreign (first type)))
  22                            (collect `(,name :pointer))
  23                            (collect arg))))
  24          (c-body (wrap-body-with-boxed-translations args body)))
  25     `(defcallback ,name-and-options ,return-type ,c-args
  26        ,@c-body)))