Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp:/tmp/cvs-serv3538/root/gtk-ffi

Modified Files: gtk-ffi.lisp Log Message: Added a troubling modification to cffi:translate-from-foreign-type for CLISP, :gtk-boolean

--- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/02/16 18:04:29 1.17 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/02/16 21:55:32 1.18 @@ -49,6 +49,7 @@

(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") @@ -58,7 +59,10 @@ (cffi:make-pointer (if value 1 0)))

(defmethod cffi:translate-from-foreign (value (type (eql :gtk-boolean))) - (not (zerop (cffi::pointer-address value)))) ; pod strange! + #-clisp(not (zerop (cffi::pointer-address value))) ; pod strange! + #+clisp(if (null value) ; pod something really wrong here! + nil + (not (zerop (cffi::pointer-address value)))))

(defmethod cffi:translate-to-foreign (value (type (eql :gtk-string))) (when (null value) (setf value "")) ; pod ??? @@ -114,29 +118,31 @@ ;;; After doing this, should be able to do (g-thread-init c-null) ;;; The above define-foreigh-library appears to be useless (doesn't ;;; work through the symbols) use the names. -(defun load-gtk-libs () - (handler-bind ((style-warning #'muffle-warning)) - (cffi:load-foreign-library #+linux "libgobject-2.0.so" - #+win32 "libgobject-2.0-0.dll" - #+macosx "libgobject-2.0-0.dylib") - (cffi:load-foreign-library #+linux "libglib-2.0.so" - #+win32 "libglib-2.0-0.dll" - #+macosx "libglib-2.0-0.dylib") - (cffi:load-foreign-library #+linux "libgthread-2.0.so" - #+win32 "libgthread-2.0-0.dll" - #+macosx "libgthread-2.0-0.dylib") - (cffi:load-foreign-library #+linux "libgdk-x11-2.0.so" - #+win32 "libgdk-win32-2.0-0.dll" - #+macosx "libgdk-win32-2.0-0.dylib") - (cffi:load-foreign-library #+linux "libgtk-x11-2.0.so" - #+win32 "libgtk-win32-2.0-0.dll" - #+macosx "libgtk-win32-2.0-0.dylib") - #+libcellsgtk - (cffi:load-foreign-library #+linux "libcellsgtk.so" - #+win32 "libcellsgtk.dll" - #+macosx "libcellsgtk.dylib"))) - (eval-when (:compile-toplevel :load-toplevel :execute) + (defun load-gtk-libs () + (handler-bind ((style-warning #'muffle-warning)) + (cffi:load-foreign-library #+cffi-features:unix "libgobject-2.0.so" + #+win32 "libgobject-2.0-0.dll" + #+macosx "libgobject-2.0-0.dylib") + (cffi:load-foreign-library #+cffi-features:unix "libglib-2.0.so" + #+win32 "libglib-2.0-0.dll" + #+macosx "libglib-2.0-0.dylib") + (cffi:load-foreign-library #+cffi-features:unix "libgthread-2.0.so" + #+win32 "libgthread-2.0-0.dll" + #+macosx "libgthread-2.0-0.dylib") + (cffi:load-foreign-library #+cffi-features:unix "libgdk-x11-2.0.so" + #+win32 "libgdk-win32-2.0-0.dll" + #+macosx "libgdk-win32-2.0-0.dylib") + (cffi:load-foreign-library #+cffi-features:unix "libgtk-x11-2.0.so" + #+win32 "libgtk-win32-2.0-0.dll" + #+macosx "libgtk-win32-2.0-0.dylib") + #+libcellsgtk + (cffi:load-foreign-library #+cffi-features:unix "libcellsgtk.so" + #+win32 "libcellsgtk.dll" + #+macosx "libcellsgtk.dylib"))) +) ; eval + +(eval-when (:compile-toplevel :execute) (export '(+c-null+ int-slot-indexed load-gtk-libs)) (defun gtk-function-name (lisp-name) (substitute #_ #- lisp-name)) @@ -178,15 +184,16 @@ (when *gtk-debug* ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING") (string= (symbol-name name) "GTK-MAIN-ITERATION-DO")) - `(format *trace-output* "~%before (~A ~{~A~^ ~})" + `(format *trace-output* "~%Calling (~A ~{~A~^ ~})" ,(string-downcase (string name)) (list ,@(mapcar 'car arguments))))) - (prog1 - (,gtk-name ,@(mapcar #'car arguments)) + (let ((result (,gtk-name ,@(mapcar #'car arguments)))) (when *gtk-debug* ,(unless (or (string= (symbol-name name) "GTK-EVENTS-PENDING") (string= (symbol-name name) "GTK-MAIN-ITERATION-DO")) - `(format *trace-output* "~%after (~A ~{~A~^ ~})" - ,(string-downcase (string name)) (list ,@(mapcar 'car arguments))))))) + `(format *trace-output* "~% (~A ~{~A~^ ~}) returns ~A" + ,(string-downcase (string name)) (list ,@(mapcar 'car arguments)) + result))) + result)) (eval-when (:compile-toplevel :load-toplevel :execute) (export ',name)))))