chiark / gitweb /
Added function for user data
authorespen <espen>
Sun, 11 Feb 2001 20:21:13 +0000 (20:21 +0000)
committerespen <espen>
Sun, 11 Feb 2001 20:21:13 +0000 (20:21 +0000)
glib/glib.lisp

index d168a46fd1ae29b72a4337ca485c19e485387e75..a34944e484007b8f3e22d3fe1db3e6e4ab683cc5 100644 (file)
 ;; 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.7 2000-10-05 17:17:41 espen Exp $
+;; $Id: glib.lisp,v 1.8 2001-02-11 20:21:13 espen Exp $
 
 
 (in-package "GLIB")
+
 (use-prefix "g")
 
 
@@ -39,9 +40,42 @@ (defun copy-memory (from length &optional (to (allocate-memory length)))
   to)
 
 
+;;;; User data mechanism
+
+(internal *user-data* *user-data-count*)
+
+(declaim (fixnum *user-data-count*))
+
+(defvar *destroy-notify* (system:foreign-symbol-address "destroy_notify"))
+(defvar *user-data* (make-hash-table))
+(defvar *user-data-count* 0)
+
+(defun register-user-data (object &optional destroy-function)
+  (check-type destroy-function (or null symbol function))
+  (incf *user-data-count*)
+  (setf
+   (gethash *user-data-count* *user-data*)
+   (cons object destroy-function))
+  *user-data-count*)
+
+(defun find-user-data (id)
+  (check-type id fixnum)
+  (multiple-value-bind (user-data p) (gethash id *user-data*)
+    (values (car user-data) p)))
+
+(defun destroy-user-data (id)
+  (check-type id fixnum)
+  (let ((user-data (gethash id *user-data*)))
+    (when (cdr user-data)
+      (funcall (cdr user-data) (car user-data))))
+  (remhash id *user-data*))
+
+
 
 ;;;; Quarks
 
+(internal *quark-counter* *quark-from-object* *quark-to-object*)
+
 (deftype quark () 'unsigned)
 
 ;(define-foreign %quark-get-reserved () quark)
@@ -49,10 +83,11 @@ (deftype quark () 'unsigned)
 (define-foreign %quark-from-string () quark
   (string string))
 
-(defvar *string-counter* 0)
+(defvar *quark-counter* 0)
 
 (defun %quark-get-reserved ()
-  (%quark-from-string (format nil "CLG-~D" (incf *string-counter*))))
+  ;; The string is just a dummy
+  (%quark-from-string (format nil "#@£$%&-quark-~D" (incf *quark-counter*))))
 
 (defvar *quark-from-object* (make-hash-table))
 (defvar *quark-to-object* (make-hash-table))