[cells-gtk-cvs] CVS root/gtk-ffi
pdenno
pdenno at common-lisp.net
Sun Feb 19 20:18:27 UTC 2006
Update of /project/cells-gtk/cvsroot/root/gtk-ffi
In directory common-lisp:/tmp/cvs-serv16186/root/gtk-ffi
Modified Files:
gtk-utilities.lisp
Log Message:
uffi --> cffi
--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp 2006/02/16 18:07:50 1.18
+++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp 2006/02/19 20:18:27 1.19
@@ -35,10 +35,10 @@
(or destroy-data +c-null+)
(if after 1 0)))))
-(uffi:def-function ("g_signal_connect_data" g_signal_connect_data)
- ((instance :pointer-void) (detailed-signal :cstring)
- (c-handler :pointer-void) (data :pointer-void)(destroy-data :pointer-void) (after :int))
- :returning :unsigned-long)
+(cffi:defcfun ("g_signal_connect_data" g_signal_connect_data)
+ :unsigned-long
+ (instance :pointer) (detailed-signal :pointer) (c-handler :pointer)
+ (data :pointer) (destroy-data :pointer) (after :int))
(defun wrap-func (func-address) ;; vestigial. func would never be nil. i think.
(or func-address 0))
@@ -62,17 +62,17 @@
(typecase pointer
(string pointer)
(otherwise
- (ukt:trc nil "get-gtk-string sees" pointer (type-of pointer))
- #+allegro (convert-from-cstring pointer)
- #+lispworks (convert-from-foreign-string pointer
+ (pod:trc nil "get-gtk-string sees" pointer (type-of pointer))
+ #+allegro (uffi:convert-from-cstring pointer)
+ #+lispworks (uffi:convert-from-foreign-string pointer
:null-terminated-p t)
#-(or allegro lispworks)
- (with-foreign-object (bytes-written :int)
+ (uffi:with-foreign-object (bytes-written :int)
(g-locale-from-utf8 pointer -1 +c-null+ bytes-written +c-null+)))))
(defun to-gtk-string (str)
"!!!! remember to free returned str pointer"
- (with-foreign-object (bytes-written :int)
+ (uffi:with-foreign-object (bytes-written :int)
(g-locale-to-utf8 str -1 +c-null+ bytes-written +c-null+)))
(defmacro with-gdk-threads (&rest body)
@@ -134,7 +134,7 @@
(or str-ptr (and (eql type :date) (coerce data 'single-float)) data))
(gtk-list-store-set-value lstore iter col value)
(g-value-unset value)
- (when str-ptr (free-cstring str-ptr)))))
+ (when str-ptr (uffi:free-cstring str-ptr)))))
(defun gtk-list-store-set-items (store types-lst data-lst)
(with-tree-iter (iter)
@@ -180,7 +180,7 @@
"Returns the item at column-no if column-no [0,<num-columns-1>] or a
a string like '(0 1 0)', which navigates to the selected item, if
column-no = num-columns. (See gtk-tree-store-set-kids)."
- (with-foreign-object (item :pointer-void)
+ (uffi:with-foreign-object (item :pointer-void)
(gtk-tree-model-get model iter column-no item -1)
(case cell-type
(:string (uffi:convert-from-cstring (uffi:deref-pointer item :cstring)))
@@ -198,31 +198,31 @@
(progn
(defun alloc-col-type-buffer (col-type)
(ecase col-type
- ((:string :icon) (allocate-foreign-object '(:array :cstring) 1))
- (:boolean (allocate-foreign-object '(:array :unsigned-byte) 1)) ;;guess
- (:date (allocate-foreign-object '(:array :float) 1))
- (:int (allocate-foreign-object '(:array :int) 1))
- (:long (allocate-foreign-object '(:array :long) 1))
- (:float (allocate-foreign-object '(:array :float) 1))
- (:double (allocate-foreign-object '(:array :double) 1))))
+ ((:string :icon) (uffi:allocate-foreign-object '(:array :cstring) 1))
+ (:boolean (uffi:allocate-foreign-object '(:array :unsigned-byte) 1)) ;;guess
+ (:date (uffi:allocate-foreign-object '(:array :float) 1))
+ (:int (uffi:allocate-foreign-object '(:array :int) 1))
+ (:long (uffi:allocate-foreign-object '(:array :long) 1))
+ (:float (uffi:allocate-foreign-object '(:array :float) 1))
+ (:double (uffi:allocate-foreign-object '(:array :double) 1))))
(defun deref-col-type-buffer (col-type buffer)
(ecase col-type
((:string :icon)
(get-gtk-string
- (make-pointer (deref-array buffer '(:array :cstring) 0) :cstring)))
- (:boolean (not (zerop (deref-array buffer '(:array :unsigned-byte) 0)))) ;;guess
- (:date (deref-array buffer '(:array :float) 0))
- (:int (deref-array buffer '(:array :int) 0))
- (:long (deref-array buffer '(:array :long) 0))
- (:float (deref-array buffer '(:array :float) 0))
- (:double (deref-array buffer '(:array :double) 0)))))
+ (cffi:make-pointer (cffi:mem-aref buffer :pointer 0) :cstring)))
+ (:boolean (not (zerop (cffi:mem-aref buffer :unsigned-char 0))))
+ (:date (cffi:mem-aref buffer :FLOAT 0))
+ (:int (cffi:mem-aref buffer :int 0))
+ (:long (cffi:mem-aref buffer :long 0))
+ (:float (cffi:mem-aref buffer :float 0))
+ (:double (cffi:mem-aref buffer :double 0)))))
(defun gtk-tree-view-render-cell (col col-type cell-attrib-f)
- (ukt:trc nil "gtv-render-cell> creating callback" col col-type cell-attrib-f)
+ (pod:trc nil "gtv-render-cell> creating callback" col col-type cell-attrib-f)
(lambda (tree-column cell-renderer model iter data)
(DECLARE (ignorable tree-column data))
- (ukt:trc nil "gtv-render-cell (callback)> entry"
+ (pod:trc nil "gtv-render-cell (callback)> entry"
tree-column cell-renderer model iter data)
(let ((return-buffer (cffi:foreign-alloc :int :count 16)))
(gtk-tree-model-get model iter col
@@ -233,11 +233,11 @@
(ret$ (when (find col-type '(:string :icon))
returned-value))
(item-value (cond
- (ret$ (convert-from-cstring ret$))
+ (ret$ (uffi:convert-from-cstring ret$))
((eq col-type :boolean)
(not (zerop returned-value)))
(t returned-value))))
- (ukt:trc nil "gtv-render-cell (callback)>> rendering value"
+ (pod:trc nil "gtv-render-cell (callback)>> rendering value"
col col-type ret$ item-value)
(apply #'gtk-object-set-property cell-renderer
@@ -263,9 +263,9 @@
(defun gtk-file-chooser-get-filenames-strs (file-chooser)
(let ((glist (gtk-file-chooser-get-filenames file-chooser)))
- (loop for lst-address = glist then (get-slot-value lst-address 'gslist 'next)
+ (loop for lst-address = glist then (cffi:foreign-slot-value lst-address 'gslist 'next)
while (and lst-address (not (zerop lst-address)))
- collect (get-slot-value lst-address 'gslist 'data)
+ collect (cffi:foreign-slot-value lst-address 'gslist 'data)
finally (g-slist-free glist))))
(eval-when (compile load eval)
More information about the Cells-gtk-cvs
mailing list