X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/13148f195c1367ccd58e9931ea38098551dd70b9..597999f9e53ddc420f0c435916b459275bc539c2:/gtk/gtkobject.lisp?ds=sidebyside diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index 52fb4da..8bbd5e6 100644 --- a/gtk/gtkobject.lisp +++ b/gtk/gtkobject.lisp @@ -15,11 +15,17 @@ ;; 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.6 2000/09/04 22:14:54 espen Exp $ (in-package "GTK") + +;;;; Initializing + +(setf (alien-type-name 'pointer) "gpointer") + + ;;;; Misc utils (defun name-to-string (name) @@ -165,35 +171,13 @@ 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 +212,8 @@ (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