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

pdenno pdenno at common-lisp.net
Sat Feb 11 03:48:09 UTC 2006


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

Modified Files:
	gtk-utilities.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/gtk-ffi/gtk-utilities.lisp	2006/01/03 19:10:45	1.16
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp	2006/02/11 03:48:09	1.17
@@ -82,46 +82,36 @@
 	  , at body)
      (gdk-threads-leave)))
 
-(ffx:ff-defun-callable :cdecl :int button-press-event-handler
-  ((widget :pointer-void) (signal (* gdk-event-button)) (data :pointer-void))
+(cffi:defcallback button-press-event-handler :int
+                  ((widget :pointer) (signal :pointer) (data :pointer))
   (let ((event (gdk-event-button-type signal)))
-    (when (or (eql (event-type event) :button_press) 
+    (when (or (eql (event-type event) :button_press)
               (eql (event-type event) :button_release))
       (when (= (gdk-event-button-button signal) 3)
-        (gtk-menu-popup widget nil nil nil nil 3 
-          (gdk-event-button-time signal)))))
+        (gtk-menu-popup widget nil nil nil nil 3
+			(gdk-event-button-time signal)))))
   0)
 
 (defun gtk-widget-set-popup (widget menu)
   (gtk-signal-connect-swap widget "button-press-event"
-                           (ffx:ff-register-callable 'button-press-event-handler)
+                           (cffi:get-callback 'button-press-event-handler)
                            :data menu)
   (gtk-signal-connect-swap widget "button-release-event"
-                           (ffx:ff-register-callable 'button-press-event-handler)
+                           (cffi:get-callback 'button-press-event-handler)
                            :data menu))
 
 (defun gtk-list-store-new (col-types)
-  (let ((c-types (ffx:fgn-alloc :int (length col-types))))
+  (let ((c-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))))
     (loop for type in col-types
           for n upfrom 0
-          do (setf (ffx:elti c-types n) (as-gtk-type type)))
+          do (setf (cffi:mem-aref c-types :int n) (coerce (as-gtk-type type) 'integer)))
     (prog1
         (gtk-list-store-newv (length col-types) c-types)
-      (ffx:fgn-free c-types))))
+      (cffi:foreign-free c-types))))
 
 
 (defun gvi (&optional (key :anon))
-  key
-;;;  (ukt:trc nil "gvi> " keY)
-;;;  (let ((tv (ffx:fgn-alloc :int 32)))
-;;;    (dotimes (n 32) (setf (ffx:elti tv n) 0))
-;;;    (loop for type in '(:string :icon :int :string)
-;;;        do (print (list tv type (as-gtk-type type)
-;;;                    (g_value_init tv (as-gtk-type type))))
-;;;          (g_value_unset tv))
-;;;    (ffx:fgn-free tv))
-  )
-
+  key)
 
 (defun gtk-list-store-set (lstore iter types-lst data-lst)
   (with-g-value (value)
@@ -156,10 +146,10 @@
       (gvi :post-set))))
 
 (defun gtk-tree-store-new (col-types)
-  (let ((gtk-types (ffx:fgn-alloc :int (length col-types))))
+  (let ((gtk-types (cffi:foreign-alloc :int :count (length col-types)))) ;(ffx:fgn-alloc :int (length col-types))
     (loop for type in col-types
           for tn upfrom 0
-          do (setf (ffx:elti gtk-types tn) (as-gtk-type type)))
+          do (setf (cffi:mem-aref gtk-types :int tn) (coerce (as-gtk-type type) 'integer)))
     (gtk-tree-store-newv (length col-types) gtk-types)))
 
 (defun gtk-tree-store-set (tstore iter types-lst data-lst)
@@ -234,7 +224,7 @@
     (DECLARE (ignorable tree-column data))
     (ukt:trc nil "gtv-render-cell (callback)> entry"
       tree-column cell-renderer model iter data)
-    (let ((return-buffer (ffx:fgn-alloc :int 16)))
+    (let ((return-buffer (cffi:foreign-alloc :int :count 16)))
       (gtk-tree-model-get model iter col
         return-buffer -1)
       (let* ((returned-value (deref-pointer-runtime-typed return-buffer
@@ -267,9 +257,8 @@
         (when cell-attrib-f 
           (loop for property in (parse-cell-attrib (funcall cell-attrib-f item-value))
               do (apply #'gtk-object-set-property cell-renderer property)))
-        (when ret$
-          (uffi:free-foreign-object ret$))
-        (ffx:fgn-free return-buffer)))
+        (when ret$ (cffi:foreign-free ret$))
+        (cffi:foreign-free return-buffer)))
     1))
 
 (defun gtk-file-chooser-get-filenames-strs (file-chooser)




More information about the Cells-gtk-cvs mailing list