[mcclim-devel] gtkairo

[David Lichteblau]

Quoting C Y (smustudent1 at yahoo.com):
> Coool!  Are there any specific versions of CFFI, and specific lisps
> that are needed, or should it work wherever CFFI does?

Tested only on SBCL, but no inherent portability issues.

One exception perhaps: If you are using one of the Lisps with userland
threads that do not like blocking in native code, look for the the call
to sb-sys:wait-until-fd-usable in event.lisp and find a replacement.

And the other big problem was pointed out by Christophe: The original
tarball is not 64 bit clean.  The attached patch fixes that (tested
briefly on SBCL/x86-64).


David
-------------- next part --------------
diff -ur gtkairo/event.lisp gtkairo-64bitclean/event.lisp
--- gtkairo/event.lisp	2006-04-09 18:38:05.000000000 +0200
+++ gtkairo-64bitclean/event.lisp	2006-04-10 19:56:35.000000000 +0200
@@ -40,9 +40,8 @@
 				 GDK_ENTER_NOTIFY_MASK
 				 GDK_LEAVE_NOTIFY_MASK
 				 #+nil GDK_STRUCTURE_MASK))
-  (setf (cffi:foreign-slot-value widget 'gtkwidget 'flags)
-	(logior (cffi:foreign-slot-value widget 'gtkwidget 'flags)
-		GTK_CAN_FOCUS))
+  (setf (gtkwidget-flags widget)
+        (logior (gtkwidget-flags widget) GTK_CAN_FOCUS))
   (connect-signal widget "expose-event" 'expose-handler)
   (connect-signal widget "motion-notify-event" 'motion-notify-handler)
   (connect-signal widget "button-press-event" 'button-handler)
diff -ur gtkairo/gtk-ffi.lisp gtkairo-64bitclean/gtk-ffi.lisp
--- gtkairo/gtk-ffi.lisp	2006-04-09 18:38:05.000000000 +0200
+++ gtkairo-64bitclean/gtk-ffi.lisp	2006-04-10 19:56:35.000000000 +0200
@@ -112,14 +112,20 @@
 	(gdk_threads_leave)))))
 
 
-;; GROVELME
+;;; GROVELME
 
-(cffi:defcstruct gtkwidget
+;; must be a separate structure definition in order for padding on AMD64
+;; to work properly.
+(cffi:defcstruct gtkobject
   (gtype :unsigned-long)		;GTypeInstance
   (ref_count :unsigned-int)		;GObject
   (qdata :pointer)			;  -"-
   (flags :uint32)			;GtkObject
-  (private_flags :uint16)		;von hier an endlich GtkWidget
+  )
+
+(cffi:defcstruct gtkwidget
+  (header gtkobject)
+  (private_flags :uint16)
   (state :uint8)
   (saved_state :uint8)
   (name :pointer)
@@ -133,6 +139,16 @@
   (gdkwindow :pointer)
   (parent :pointer))
 
+(defun gtkwidget-header (widget)
+  (cffi:foreign-slot-value widget 'gtkwidget 'header))
+
+(defun gtkwidget-flags (widget)
+  (cffi:foreign-slot-value (gtkwidget-header widget) 'gtkobject 'flags))
+
+(defun (setf gtkwidget-flags) (newval widget)
+  (setf (cffi:foreign-slot-value (gtkwidget-header widget) 'gtkobject 'flags)
+        newval))
+
 (cffi:defcstruct gdkeventexpose
   (type :int)
   (gdkwindow :pointer)