X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/aace61f56d713c69ac6b0f2930c415438e8d4424..2ed3bebb9efa151539a23a5ae76a112388f13852:/gtk/gtkobject.lisp diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index f56f5a6..6b536e2 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 @@ (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 +212,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