From bb5a42bb55024c5730cefe0a17bc5f90014f26f5 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sun, 12 Jul 2009 15:42:19 +0400 Subject: [PATCH] Moved stable-pointer code to its place --- glib/cl-gtk2-glib.asd | 1 + glib/gobject.foreign.lisp | 34 ---------------------------- glib/gobject.package.lisp | 3 ++- glib/gobject.stable-pointer.lisp | 46 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 49 insertions(+), 35 deletions(-) create mode 100644 glib/gobject.stable-pointer.lisp diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd index af886e3..292fdb1 100644 --- a/glib/cl-gtk2-glib.asd +++ b/glib/cl-gtk2-glib.asd @@ -23,6 +23,7 @@ (:file "gobject.gvalue") (:file "gobject.signals") (:file "gobject.foreign") + (:file "gobject.stable-pointer") (:file "gobject.foreign-gobject") (:file "gobject.foreign-closures") (:file "gobject.foreign-gboxed") 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 diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index 25b6c6b..59a21fa 100644 --- a/glib/gobject.package.lisp +++ b/glib/gobject.package.lisp @@ -113,7 +113,8 @@ #:flags-item-name #:flags-item-value #:flags-item-nick - #:get-flags-items) + #:get-flags-items + #:stable-pointer-value) (:documentation "CL-GTK2-GOBJECT is a binding to GObject type system. For information on GObject, see its @a[http://library.gnome.org/devel/gobject/stable/]{documentation}. diff --git a/glib/gobject.stable-pointer.lisp b/glib/gobject.stable-pointer.lisp new file mode 100644 index 0000000..2358bb7 --- /dev/null +++ b/glib/gobject.stable-pointer.lisp @@ -0,0 +1,46 @@ +(in-package :gobject) + +(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 set-stable-pointer-value (stable-pointer value) + "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*)) + (setf (aref *registered-stable-pointers* (pointer-address stable-pointer)) value))) + +(defun stable-pointer-value (stable-pointer) + (get-stable-pointer-value stable-pointer)) + +(defun (setf stable-pointer-value) (new-value stable-pointer) + (set-stable-pointer-value stable-pointer new-value)) + +(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)))) -- 1.7.10.4