Added handle box demo and some other changes

[clg] / glib / glib.lisp

diff --git a/glib/glib.lisp b/glib/glib.lisp
index e8ca9cad1a833acd12cbadd4db721785456b1e60..afc7a8341a1f983bc558be16ee9712d1179aa667 100644 (file)
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 

-;; $Id: glib.lisp,v 1.22 2004/12/26 11:40:58 espen Exp $
+;; $Id: glib.lisp,v 1.23 2005/01/03 16:38:57 espen Exp $

 
 
 (in-package "GLIB")
 
 
 (in-package "GLIB")


@@ -64,6 +64,16 @@ (defun find-user-data (id)
   (multiple-value-bind (user-data p) (gethash id *user-data*)
     (values (car user-data) p)))
 
   (multiple-value-bind (user-data p) (gethash id *user-data*)
     (values (car user-data) p)))
 

+(defun update-user-data (id object)
+  (check-type id fixnum)
+  (multiple-value-bind (user-data exists-p) (gethash id *user-data*)
+    (cond
+     ((not exists-p) (error "User data id ~A does not exist" id))
+     (t 
+      (when (cdr user-data)
+       (funcall (cdr user-data) (car user-data)))
+      (setf (car user-data) object)))))
+

 (defun destroy-user-data (id)
   (check-type id fixnum)
   (let ((user-data (gethash id *user-data*)))
 (defun destroy-user-data (id)
   (check-type id fixnum)
   (let ((user-data (gethash id *user-data*)))


@@ -450,7 +460,7 @@ (defmethod from-alien-form (c-vector (type (eql 'vector)) &rest args)
        (error "Can't use vector of variable size as return type")
       `(let ((c-vector ,c-vector))
        (prog1
        (error "Can't use vector of variable size as return type")
       `(let ((c-vector ,c-vector))
        (prog1

-           (map-c-vector 'vector #'identity ',element-type ,length c-vector)
+           (map-c-vector 'vector #'identity c-vector ',element-type ,length)

          (destroy-c-vector c-vector ',element-type ,length))))))
 
 (defmethod copy-from-alien-form (c-vector (type (eql 'vector)) &rest args)
          (destroy-c-vector c-vector ',element-type ,length))))))
 
 (defmethod copy-from-alien-form (c-vector (type (eql 'vector)) &rest args)


@@ -458,7 +468,7 @@ (defmethod copy-from-alien-form (c-vector (type (eql 'vector)) &rest args)
   (destructuring-bind (element-type &optional (length '*)) args
     (if (eq length '*)
        (error "Can't use vector of variable size as return type")
   (destructuring-bind (element-type &optional (length '*)) args
     (if (eq length '*)
        (error "Can't use vector of variable size as return type")

-      `(map-c-vector 'vector #'identity ',element-type ',length ,c-vector))))
+      `(map-c-vector 'vector #'identity ,c-vector ',element-type ',length))))

 
 (defmethod cleanup-form (location (type (eql 'vector)) &rest args)
   (declare (ignore type))
 
 (defmethod cleanup-form (location (type (eql 'vector)) &rest args)
   (declare (ignore type))