[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