glib/gobject.foreign.lisp

   1 (in-package :gobject)
   2
   3 (defgeneric release (object))
   4
   5 (defun release* (&rest objects)
   6   (declare (dynamic-extent objects))
   7   (loop
   8      for object in objects
   9      do (release object)))
  10
  11 (defmacro using ((var expr) &body body)
  12   `(let ((,var ,expr))
  13      (unwind-protect
  14           (progn ,@body)
  15        (release ,var))))
  16
  17 (defun using-expand (bindings body)
  18   (if bindings
  19       (destructuring-bind (var expr) (first bindings)
  20        `(let ((,var ,expr))
  21           (unwind-protect
  22                ,(using-expand (rest bindings) body)
  23             (release ,var))))
  24       `(progn ,@body)))
  25
  26 (defmacro using* ((&rest bindings) &body body)
  27   (using-expand bindings body))
  28
  29 (defvar *registered-stable-pointers* (make-array 0 :adjustable t :fill-pointer t))
  30
  31 (defun allocate-stable-pointer (thing)
  32   (let ((id (find-fresh-id)))
  33     (setf (aref *registered-stable-pointers* id) thing)
  34     (make-pointer id)))
  35
  36 (defun free-stable-pointer (stable-pointer)
  37   (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) nil))
  38
  39 (defun get-stable-pointer-value (stable-pointer)
  40   (aref *registered-stable-pointers* (pointer-address stable-pointer)))
  41
  42 (defun find-fresh-id ()
  43   (or (position nil *registered-stable-pointers*)
  44       (progn (vector-push-extend nil *registered-stable-pointers*)
  45              (1- (length *registered-stable-pointers*)))))
  46
  47 (defmacro with-stable-pointer ((ptr expr) &body body)
  48   `(let ((,ptr (allocate-stable-pointer ,expr)))
  49      (unwind-protect
  50           (progn ,@body)
  51        (free-stable-pointer ,ptr))))