glib/gobject.foreign.lisp

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