[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-core.lisp
Peter Denno
pdenno at common-lisp.net
Tue Jan 3 19:05:20 UTC 2006
Update of /project/cells-gtk/cvsroot/root/gtk-ffi
In directory common-lisp.net:/tmp/cvs-serv30441/root/gtk-ffi
Modified Files:
gtk-core.lisp
Log Message:
CFFI : removed various ifdefs.
Date: Tue Jan 3 20:05:18 2006
Author: pdenno
Index: root/gtk-ffi/gtk-core.lisp
diff -u root/gtk-ffi/gtk-core.lisp:1.4 root/gtk-ffi/gtk-core.lisp:1.5
--- root/gtk-ffi/gtk-core.lisp:1.4 Sat Oct 8 16:44:40 2005
+++ root/gtk-ffi/gtk-core.lisp Tue Jan 3 20:05:17 2006
@@ -67,33 +67,18 @@
(defmacro with-g-value ((var) &body body)
`(call-with-g-value (lambda (,var) , at body)))
-#+cmu
-(ffx:def-type g-value-type
- (* (alien:struct gtk-ffi::g-value
- (gtk-ffi::g-type (array (alien:signed 32) 16)))))
-
-#+sbcl
-(ffx:def-type g-value-type
- (* (sb-alien:struct gtk-ffi::g-value
- (gtk-ffi::g-type (array (sb-alien:signed 32) 16)))))
-
-
(defun call-with-g-value (fn)
(declare (optimize (speed 3) (safety 0) (space 0)))
(let ((gva (ffx:fgn-alloc 'g-value 1 :with-g-value)))
- #+(or cmu sbcl) (declare (type g-value-type gva))
(unwind-protect
- (progn
- (dotimes (n 16)
- (let ((gv (ff-elt gva 'g-value 0)))
+ (dotimes (n 16)
+ (let ((gv (ffx:ff-elt gva 'g-value 0)))
(let ((ns (get-slot-pointer gv 'g-value 'g-type)))
- #+lispworks (setf (fli:foreign-aref ns n) 0)
- #-lispworks (setf (deref-array ns '(:array :int) n) 0))))
- (funcall fn gva))
+ (setf (deref-array ns '(:array :int) n) 0))))
+ (funcall fn gva)
(ffx:fgn-free gva))))
(eval-when (compile load eval) (export 'with-g-value))
-
#+test
(def-gtk-lib-functions :gobject
More information about the Cells-gtk-cvs
mailing list