- (let ((user-data (gethash id *user-data*)))
- (when (cdr user-data)
- (funcall (cdr user-data) (car user-data))))
- (remhash id *user-data*)))
+ (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)))
+ (remhash id *user-data*))))))
+
+(defun take-user-data (id)
+ (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)))
+ (remhash id *user-data*)
+ (car user-data)))))
+
+(defmacro with-user-data ((var object) &body body)
+ `(let ((,var (register-user-data ,object)))
+ (unwind-protect
+ ,@body
+ (destroy-user-data ,var))))
+
+
+(deftype user-data-id () 'pointer-data)