[cells-gtk-cvs] CVS root/gtk-ffi

[pdenno]

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