glib/gobject.foreign.lisp

   1 (in-package :gobject)
   2
   3 (defgeneric release (object)
   4   (:documentation "Manually frees the Lisp reference to the @code{object}. Probably should not be called.
   5
   6 @arg[object]{an instance of @class{g-object}}"))
   7
   8 (defmethod release ((object null)))
   9
  10 (defun release* (&rest objects)
  11   "Calls @fun{release} on all objects in @code{objects}
  12
  13 @arg[objects]{a list of instances of @class{g-object}}"
  14   (declare (dynamic-extent objects))
  15   (loop
  16      for object in objects
  17      do (release object)))
  18
  19 (defmacro using ((var &optional (expr var)) &body body)
  20   `(let ((,var ,expr))
  21      (unwind-protect
  22           (progn ,@body)
  23        (release ,var))))
  24
  25 (defun using-expand (bindings body)
  26   (if bindings
  27       (destructuring-bind (var &optional (expr var)) (ensure-list (first bindings))
  28        `(let ((,var ,expr))
  29           (unwind-protect
  30                ,(using-expand (rest bindings) body)
  31             (release ,var))))
  32       `(progn ,@body)))
  33
  34 (defmacro using* ((&rest bindings) &body body)
  35   (using-expand bindings body))
  36
  37 (defvar *registered-stable-pointers* (make-array 0 :adjustable t :fill-pointer t))
  38
  39 (defun allocate-stable-pointer (thing)
  40   "Allocates the stable pointer for @code{thing}. Stable pointer is an integer that can be dereferenced with @fun{get-stable-pointer-value} and freed with @fun{free-stable-pointer}. Stable pointers are used to pass references to lisp objects to foreign code.
  41 @arg[thing]{any object}
  42 @return{integer}"
  43   (let ((id (find-fresh-id)))
  44     (setf (aref *registered-stable-pointers* id) thing)
  45     (make-pointer id)))
  46
  47 (defun free-stable-pointer (stable-pointer)
  48   "Frees the stable pointer previously allocated by @fun{allocate-stable-pointer}"
  49   (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) nil))
  50
  51 (defun get-stable-pointer-value (stable-pointer)
  52   "Returns the objects that is referenced by stable pointer previously allocated by @fun{allocate-stable-pointer}. May be called any number of times."
  53   (when (<= 0 (pointer-address stable-pointer) (length *registered-stable-pointers*))
  54     (aref *registered-stable-pointers* (pointer-address stable-pointer))))
  55
  56 (defun find-fresh-id ()
  57   (or (position nil *registered-stable-pointers*)
  58       (progn (vector-push-extend nil *registered-stable-pointers*)
  59              (1- (length *registered-stable-pointers*)))))
  60
  61 (defmacro with-stable-pointer ((ptr expr) &body body)
  62   "Executes @code{body} with @code{ptr} bound to the stable pointer to result of evaluating @code{expr}.
  63
  64 @arg[ptr]{a symbol naming the variable which will hold the stable pointer value}
  65 @arg[expr]{an expression}"
  66   `(let ((,ptr (allocate-stable-pointer ,expr)))
  67      (unwind-protect
  68           (progn ,@body)
  69        (free-stable-pointer ,ptr))))