[mcclim-cvs] CVS mcclim/Backends/gtkairo
dlichteblau
dlichteblau at common-lisp.net
Mon Apr 17 18:46:19 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo
In directory clnet:/tmp/cvs-serv16577/Backends/gtkairo
Modified Files:
event.lisp gtk-ffi.lisp
Log Message:
* Backends/gtkairo/gtk-ffi.lisp (gtkwidget, gtkobject): Moved header into
its own structure declaration for correct alignment on 64 bit
architectures. (gtkwidget-header): New function. (gtkwidget-flags):
New accessor functions.
* Backends/gtkairo/event.lisp (connect-signals): Use gtkwidget-flags.
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/04/17 18:40:27 1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/04/17 18:46:18 1.2
@@ -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)
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/04/17 18:40:27 1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/04/17 18:46:18 1.2
@@ -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)
More information about the Mcclim-cvs
mailing list