Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv31088/root/cells-gtk

Modified Files: widgets.lisp Log Message: Replaced hello-c:ff-defun-callable with cffi:defcallback. Replaced some fgn-alloc fgn-free stuff with equivalent cffi.

--- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/01/03 19:03:02 1.15 +++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/02/11 03:39:10 1.16 @@ -110,15 +110,15 @@ (intern (format nil "GTK-~a~{-~a~}" class slot-access) :gtk-ffi))))

;;; --- widget -------------------- -;;; Define handlers that recover the the callback defined on the widget +;;; Define handlers that recover the callback defined on the widget + (defmacro def-gtk-event-handler (event) - `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event))) - ((widget :pointer-void) (event :pointer-void) (data :pointer-void)) - ;(print (list :entered-gtk-event-handler-cb ,(symbol-name event) widget)) + `(cffi:defcallback ,(intern (format nil "~a-HANDLER" event)) :int + ((widget :pointer) (event :pointer) (data :pointer)) (bif (self (gtk-object-find widget)) - (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword)))) - (funcall cb self widget event data)) - (trc nil "unknown widget. from prior run. clean up on errors" widget)))) + (let ((cb (callback-recover self ,(intern (string event) :keyword)))) + (funcall cb self widget event data)) + (trc nil "Unknown widget from prior run. Clean up on errors" widget))))

(def-gtk-event-handler clicked) (def-gtk-event-handler changed) @@ -131,15 +131,15 @@ (def-gtk-event-handler modified-changed)

(defparameter *widget-callbacks* - (list (cons 'clicked (ff-register-callable 'clicked-handler)) - (cons 'changed (ff-register-callable 'changed-handler)) - (cons 'activate (ff-register-callable 'activate-handler)) - (cons 'value-changed (ff-register-callable 'value-changed-handler)) - (cons 'day-selected (ff-register-callable 'day-selected-handler)) - (cons 'selection-changed (ff-register-callable 'selection-changed-handler)) - (cons 'toggled (ff-register-callable 'toggled-handler)) - (cons 'delete-event (ff-register-callable 'delete-event-handler)) - (cons 'modified-changed (ff-register-callable 'modified-changed-handler)))) + (list (cons 'clicked (cffi:get-callback 'clicked-handler)) + (cons 'changed (cffi:get-callback 'changed-handler)) + (cons 'activate (cffi:get-callback 'activate-handler)) + (cons 'value-changed (cffi:get-callback 'value-changed-handler)) + (cons 'day-selected (cffi:get-callback 'day-selected-handler)) + (cons 'selection-changed (cffi:get-callback 'selection-changed-handler)) + (cons 'toggled (cffi:get-callback 'toggled-handler)) + (cons 'delete-event (cffi:get-callback 'delete-event-handler)) + (cons 'modified-changed (cffi:get-callback 'modified-changed-handler))))

(eval-when (:compile-toplevel :load-toplevel :execute)

@@ -226,14 +226,11 @@ ,@body 1))))

-(ff-defun-callable :cdecl :int timeout-handler-callback - ((data (* :int))) - ;;(print (list :timeout-handler-callback data)) - (let* ((id (elti data 0)) - (r2 (gtk-global-callback-funcall id))) - (trc nil "timeout func really returning" r2) - (if r2 1 0))) - +(cffi:defcallback timeout-handler-callback :int ((data :pointer)) + (let* ((id (cffi:mem-aref data :int 0)) + (r2 (gtk-global-callback-funcall id))) + (trc nil "timeout func really returning" r2) + (if r2 1 0)))

(defun timeout-add (milliseconds function) (let ((id (gtk-global-callback-register @@ -244,9 +241,9 @@ (trc nil "timeout func returning" r) r)))) (c-id (fgn-alloc :int 1))) - (setf (elti c-id 0) id) - (trc nil "timeout-add > passing cb data, *data" c-id (elti c-id 0)) - (g-timeout-add milliseconds (ff-register-callable 'timeout-handler-callback) c-id))) + (setf (cffi:mem-aref c-id :int 0) (coerce id 'integer)) + (trc nil "timeout-add > passing cb data, *data" c-id (cffi:mem-aref c-id :int 0)) + (g-timeout-add milliseconds (cffi:get-callback 'timeout-handler-callback) c-id)))

(def-object widget () ((tooltip :accessor tooltip :initarg :tooltip :initform (c-in nil))