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