X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/ab566f2c276d5b73296cd5c1f3ff4b01a98ebfdd..86d9d6ab4254f6f17fe7fbd15bee6b869ff8a145:/gtk/gtkobject.lisp diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index f56f5a6..541efde 100644 --- a/gtk/gtkobject.lisp +++ b/gtk/gtkobject.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: gtkobject.lisp,v 1.4 2000-08-16 22:16:23 espen Exp $ +;; $Id: gtkobject.lisp,v 1.5 2000-08-23 21:41:10 espen Exp $ (in-package "GTK") @@ -165,35 +165,13 @@ (defun (setf object-arg) (value object name) value) -;;;; Callback and user data mechanism - -(declaim (fixnum *user-data-count*)) - -(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*) - (setq *user-data-count* (the fixnum (1+ *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))) - +;;;; Callback mechanism (defun register-callback-function (function) (check-type function (or null symbol function)) ; We treat callbacks just as ordinary user data (register-user-data function)) - (defun callback-trampoline (callback-id nargs arg-array) (declare (fixnum callback-id nargs)) (let* ((return-arg (unless (null-pointer-p arg-array) @@ -228,17 +206,8 @@ (defun callback-trampoline (callback-id nargs arg-array) (invoke-callback))))) (invoke-callback)))) - -(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*)) - - (defvar *callback-marshal* (system:foreign-symbol-address "callback_marshal")) -(defvar *destroy-marshal* (system:foreign-symbol-address "destroy_marshal")) +(setq *destroy-marshal* (system:foreign-symbol-address "destroy_marshal")) (defun after-gc-hook () (setf