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)