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)