[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.lisp root/gtk-ffi/gtk-utilities.lisp

[Kenny Tilton]

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

Modified Files:
	gtk-ffi.lisp gtk-utilities.lisp 
Log Message:
Fix for Lispworks for, inter alia, GDK-BUTTON-EVENT-HANDLER
Date: Wed Dec 22 17:23:54 2004
Author: ktilton

Index: root/gtk-ffi/gtk-ffi.lisp
diff -u root/gtk-ffi/gtk-ffi.lisp:1.6 root/gtk-ffi/gtk-ffi.lisp:1.7
--- root/gtk-ffi/gtk-ffi.lisp:1.6	Thu Dec 16 05:51:17 2004
+++ root/gtk-ffi/gtk-ffi.lisp	Wed Dec 22 17:23:53 2004
@@ -22,7 +22,7 @@
 
 (in-package :gtk-ffi)
 
-(defconstant c-null #+clisp nil #-clisp (make-null-pointer '(* void)))
+(defconstant c-null #+clisp nil #-clisp (make-null-pointer '(* :void)))
 (defconstant c-null-int #+clisp nil #-clisp (make-null-pointer :int))
 
 (defvar *gtk-debug* nil)
@@ -61,34 +61,37 @@
         (:gdk "libgdk-win32-2.0-0.dll")
         (:gtk "libgtk-win32-2.0-0.dll")))
     #-(or win32 mswindows)
-    (ecase lib
-      (:gobject "libgobject-2.0.so")      
-      (:glib "libglib-2.0.so")
-      (:gthread "libgthread-2.0.so")
-      (:gdk "libgdk-x11-2.0.so")
-      (:gtk "libgtk-x11-2.0.so")))
+    (concatenate 'string
+      "/usr/lib"
+      (ecase lib
+        (:gobject "libgobject-2.0.so")      
+        (:glib "libglib-2.0.so")
+        (:gthread "libgthread-2.0.so")
+        (:gdk "libgdk-x11-2.0.so")
+        (:gtk "libgtk-x11-2.0.so"))))
   
   (defun ffi-to-uffi-type (clisp-type)
     #+clisp clisp-type
     #-clisp (if (consp clisp-type)
                 (mapcar 'ffi-to-uffi-type clisp-type)
               (case clisp-type
-                  (uint :UNSIGNED-INT)
-                  (c-pointer :pointer-void)
-                  (c-ptr-null '*)
-                  (c-array-ptr '*)
-                  (c-ptr '*)
-                  (c-string :cstring)
-                  (sint32 :int)
-                  (uint32 :unsigned-int)
-                  (uint8 :unsigned-byte)
-                  (boolean :unsigned-int)
-                  (ulong :unsigned-long)
-                  (int :int)
-                  (long :long)
-                  (single-float :float)
-                  (double-float :double)
-                  (otherwise clisp-type))))
+                ((nil) :void)
+                (uint :UNSIGNED-INT)
+                (c-pointer :pointer-void)
+                (c-ptr-null '*)
+                (c-array-ptr '*)
+                (c-ptr '*)
+                (c-string :cstring)
+                (sint32 :int)
+                (uint32 :unsigned-int)
+                (uint8 :unsigned-byte)
+                (boolean :unsigned-int)
+                (ulong :unsigned-long)
+                (int :int)
+                (long :long)
+                (single-float :float)
+                (double-float :double)
+                (otherwise clisp-type))))
   
   #-clisp
   (defun ffi-to-native-type (ffi-type)


Index: root/gtk-ffi/gtk-utilities.lisp
diff -u root/gtk-ffi/gtk-utilities.lisp:1.4 root/gtk-ffi/gtk-utilities.lisp:1.5
--- root/gtk-ffi/gtk-utilities.lisp:1.4	Thu Dec 16 05:51:17 2004
+++ root/gtk-ffi/gtk-utilities.lisp	Wed Dec 22 17:23:53 2004
@@ -74,14 +74,14 @@
      (gdk-threads-leave)))
 
 (ffx:ff-defun-callable :cdecl :int button-press-event-handler
-    ((widget (* :void)) (signal (* :void)) (data (* :void)))
-  (declare (ignore data))
-  (let ((event (uffi:deref-pointer signal :int)))
+  ((widget (* :void)) (signal (* gdk-event-button)) (data (* :void)))
+  (declare (ignorable data))
+  (let ((event (gdk-event-button-type signal)))
     (when (eql (event-type event) :button_press)
       (when (= (gdk-event-button-button signal) 3)
-        (gtk-menu-popup widget nil nil nil nil
-          (gdk-event-button-button signal) 
-          (gdk-event-button-time signal))))))
+        (gtk-menu-popup widget nil nil nil nil 3 
+          (gdk-event-button-time signal)))))
+  1)
 
 (defun gtk-widget-set-popup (widget menu)
   (gtk-signal-connect-swap widget "button-press-event"
@@ -157,7 +157,7 @@
     (loop for col from 0
         for data in data-lst
         for type in types-lst
-        do (print (list :tree-store-set value type (as-gtk-type type)))
+        do ;; (print (list :tree-store-set value type (as-gtk-type type)))
           (g-value-init value (as-gtk-type type))
           (funcall (intern (format nil "G-VALUE-SET-~a" (case type 
                                                           (:date 'float)
@@ -186,27 +186,6 @@
 	  (:font (list "font" 'c-string val))
 	  (:size (list "size-points" 'double-float (coerce val 'double-float)))
 	  (:strikethrough (list "strikethrough" 'boolean val)))))
-
-(defun make-address-pointer (addr type)
-  #+(or allegro mcl) (declare (ignore type))
-  (assert (or (null addr) (numberp addr)))
-  (if addr
-      (progn
-        #+(or cmu scl)
-        (alien:sap-alien (system:int-sap addr)
-          (* (convert-from-uffi-type type :type)))
-        #+sbcl
-        (sb-alien:sap-alien (sb-sys:int-sap addr)
-          (* (convert-from-uffi-type type :type)))
-        #+lispworks
-        (fli:make-pointer
-         :address addr
-         :type (convert-from-uffi-type type :type))
-        #+allegro addr
-        #+mcl
-        (ccl:%int-to-ptr addr)
-        )
-    c-null))
 
 (uffi:def-struct all-types
     (:string :cstring)