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

[pdenno]

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