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) ,@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