From: espen <espen>
Date: Mon, 3 Jan 2005 16:38:57 +0000 (+0000)
Subject: New function UPDATE-USER-DATA and some bug fixes
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/commitdiff_plain/c9219df21468b9fe8e171ac17b4196ca570dda7c

New function UPDATE-USER-DATA and some bug fixes
---

diff --git a/glib/glib.lisp b/glib/glib.lisp
index d9acc73..db28b8d 100644
--- 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
 
-;; $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")
@@ -64,6 +64,16 @@ (defun find-user-data (id)
   (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*)))
@@ -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
-	    (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)
@@ -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")
-      `(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))