Moved stable-pointer code to its place

diff --git a/glib/cl-gtk2-glib.asd b/glib/cl-gtk2-glib.asd
index af886e3..292fdb1 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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))))