X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign.lisp;h=65e08b833312dba5ecf24a22409ae21aac44ae10;hb=8db173e3df82074b8ca96d00304c4e63b499f598;hp=051d7007b9013b84cb7034a0a4e2927db374d21f;hpb=af90ac5cff9dbb5f44677cc4726eee60ab88bc5d;p=cl-gtk2.git diff --git a/glib/gobject.foreign.lisp b/glib/gobject.foreign.lisp index 051d700..65e08b8 100644 --- a/glib/gobject.foreign.lisp +++ b/glib/gobject.foreign.lisp @@ -33,37 +33,3 @@ (defmacro using* ((&rest bindings) &body body) (using-expand bindings body)) - -(defvar *registered-stable-pointers* (make-array 0 :adjustable t :fill-pointer t)) - -(defun allocate-stable-pointer (thing) - "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. -@arg[thing]{any object} -@return{integer}" - (let ((id (find-fresh-id))) - (setf (aref *registered-stable-pointers* id) thing) - (make-pointer id))) - -(defun free-stable-pointer (stable-pointer) - "Frees the stable pointer previously allocated by @fun{allocate-stable-pointer}" - (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) nil)) - -(defun get-stable-pointer-value (stable-pointer) - "Returns the objects that is referenced by stable pointer previously allocated by @fun{allocate-stable-pointer}. May be called any number of times." - (when (<= 0 (pointer-address stable-pointer) (length *registered-stable-pointers*)) - (aref *registered-stable-pointers* (pointer-address stable-pointer)))) - -(defun find-fresh-id () - (or (position nil *registered-stable-pointers*) - (progn (vector-push-extend nil *registered-stable-pointers*) - (1- (length *registered-stable-pointers*))))) - -(defmacro with-stable-pointer ((ptr expr) &body body) - "Executes @code{body} with @code{ptr} bound to the stable pointer to result of evaluating @code{expr}. - -@arg[ptr]{a symbol naming the variable which will hold the stable pointer value} -@arg[expr]{an expression}" - `(let ((,ptr (allocate-stable-pointer ,expr))) - (unwind-protect - (progn ,@body) - (free-stable-pointer ,ptr)))) \ No newline at end of file