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

Modified Files: gtk-ffi.lisp Log Message: uffi --> cffi

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/02/16 21:55:32 1.18 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/02/19 20:17:41 1.19 @@ -16,11 +16,12 @@

|#

-(defpackage :gtk-ffi (:use :common-lisp :pod :uffi)) ; pod remove uffi +(defpackage :gtk-ffi (:use :common-lisp :pod))

(in-package :gtk-ffi)

-;;; POD throw-away utility +;;; POD throw-away utility to convert hello-c/uffi to cffi +#+nil (defun gtk-lib2cffi (body) "Convert hello-c to uffi to cffi types. Swap order of arguments." (flet ((convert-type (type) @@ -49,7 +50,6 @@

(defconstant +c-null+ (cffi:null-pointer)) (defvar *gtk-debug* nil) -(defvar *zippy* "diagnostics")

;;; ============== Define CFFI types, and their translations.... (cffi:defctype :gtk-string :pointer :documentation "string type for cffi type translation") @@ -73,15 +73,11 @@

(defun int-slot-indexed (obj obj-type slot index) (declare (ignorable obj-type)) - (deref-array - (get-slot-pointer obj obj-type slot) - '(:array :int) index)) + (cffi:mem-aref (cffi:foreign-slot-value obj obj-type slot) :int index))

(defun (setf int-slot-indexed) (new-value obj obj-type slot index) (declare (ignorable obj-type)) - (setf (deref-array - (get-slot-pointer obj obj-type slot) - '(:array :int) index) + (setf (cffi:mem-aref (cffi:foreign-slot-value obj obj-type slot) :int index) new-value))

(cffi:define-foreign-library 'gobject @@ -224,10 +220,10 @@ `(defun ,(intern (string-upcase (format nil "make-~a" struct-name))) (&key ,@(loop for (name supplied nil) in slot-defs collecting (list name nil supplied))) - (let ((,obj (allocate-foreign-object ',struct-name))) + (let ((,obj (uffi:allocate-foreign-object ',struct-name))) ,@(loop for (name supplied nil) in slot-defs collecting `(when ,supplied - (setf (get-slot-value ,obj ',struct-name ',name) ,name))) + (setf (cffi:foreign-slot-value ,obj ',struct-name ',name) ,name))) ,obj)))

;; --- accessors --- @@ -236,9 +232,9 @@ (accessor (intern (format nil "~a-~a" struct-name slot-name)))) `(progn (defun ,accessor (self) - (get-slot-value self ',struct-name ',slot-name)) + (cffi:foreign-slot-value self ',struct-name ',slot-name)) (defun (setf ,accessor) (new-value self) - (setf (get-slot-value self ',struct-name ',slot-name) + (setf (cffi:foreign-slot-value self ',struct-name ',slot-name) new-value)))) slot-defs))))

@@ -380,10 +376,10 @@

(defmacro with-tree-iter ((iter-var) &body body) `(uffi:with-foreign-object (,iter-var 'gtk-tree-iter) - (setf (get-slot-value ,iter-var 'gtk-tree-iter 'stamp) 0) - (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data) +c-null+) - (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data2) +c-null+) - (setf (get-slot-value ,iter-var 'gtk-tree-iter 'user-data3) +c-null+) + (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'stamp) 0) + (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data) +c-null+) + (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data2) +c-null+) + (setf (cffi:foreign-slot-value ,iter-var 'gtk-tree-iter 'user-data3) +c-null+) ,@body))

(eval-when (:compile-toplevel :load-toplevel :execute) @@ -421,14 +417,14 @@ (defmacro deref-pointer-runtime-typed (ptr type) "Returns a object pointed" (declare (ignorable type)) - `(deref-pointer ,ptr ,type)) + `(uffi:deref-pointer ,ptr ,type))

(defun cast (ptr type) (deref-pointer-runtime-typed ptr (ffi-to-uffi-type type)))

(eval-when (compile load eval) (export '(uint c-pointer c-ptr-null c-array-ptr c-ptr c-string sint32 uint32 uint8 boolean - ulong int long single-float double-float otherwise *gtk-debug* - col-type-to-ffi-type deref-pointer-runtime-typed gtk-tree-iter))) + ulong int long single-float double-float otherwise *gtk-debug* load-gtk-libs + col-type-to-ffi-type deref-pointer-runtime-typed gtk-tree-iter +c-null+)))