[cells-gtk-cvs] CVS root/cells-gtk

[pdenno]

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 @@
                    , at 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))