fix Gtk global<->local

original commit: 7de0f66b974dbc926c218cf609ad208a8de1b3f8

collects/mred/private/wx/gtk/canvas.rkt

@@ -171,6 +171,11 @@
     (define/override (get-client-gtk) client-gtk)
     (define/override (handles-events?) #t)
 
+    ;; For the moment, the client area always starts at the 
+    ;; control area's top left
+    (define/override (get-client-delta)
+      (values 0 0))
+
     ;; Avoid multiple queued paints:
     (define paint-queued? #f)
     ;; To handle paint requests that happen while on-paint

collects/mred/private/wx/gtk/client-window.rkt

@@ -18,6 +18,8 @@
   (lambda (gtk a)
     (let ([wx (gtk->wx gtk)])
       (send wx remember-client-size 
+            (GtkAllocation-x a)
+            (GtkAllocation-y a)
             (GtkAllocation-width a)
             (GtkAllocation-height a)))
     #t))
@@ -30,11 +32,15 @@
 
     (define client-w 0)
     (define client-h 0)
+    (define client-x 0)
+    (define client-y 0)
 
     (define/public (on-client-size w h) (void))
 
-    (define/public (remember-client-size w h)
+    (define/public (remember-client-size x y w h)
       ;; Called in the Gtk event-loop thread
+      (set! client-x x)
+      (set! client-y y)
       (set! client-w w)
       (set! client-h h)
       (queue-window-event this (lambda () 
@@ -48,4 +54,7 @@
       (set-box! xb client-w)
       (set-box! yb client-h))
 
+    (define/override (get-client-delta)
+      (values client-x client-y))
+
     (super-new)))

collects/mred/private/wx/gtk/frame.rkt

@@ -16,6 +16,10 @@
 
 ;; ----------------------------------------
 
+(define GDK_GRAVITY_NORTH_WEST 1)
+(define GDK_GRAVITY_STATIC 10)
+
+
 (define-gtk gtk_window_new (_fun _int -> _GtkWidget))
 (define-gtk gtk_window_set_title (_fun _GtkWindow _string -> _void))
 (define-gtk gtk_fixed_new (_fun _gboolean _int -> _GtkWidget))
@@ -30,6 +34,7 @@
 (define-gtk gtk_window_get_position (_fun _GtkWidget (x : (_ptr o _int)) (y : (_ptr o _int)) 
                                           -> _void
                                           -> (values x y)))
+(define-gtk gtk_window_set_gravity (_fun _GtkWindow _int -> _void))
 
 (define (handle-delete gtk)
   (let ([wx (gtk->wx gtk)])
@@ -74,7 +79,8 @@
     (init [is-dialog? #f])
    
     (inherit get-gtk set-size on-size
-             pre-on-char pre-on-event)
+             pre-on-char pre-on-event
+             get-client-delta)
 
     (define gtk (gtk_window_new GTK_WINDOW_TOPLEVEL))
     (when (memq 'no-caption style)
@@ -165,9 +171,12 @@
       (pre-on-char w e))
 
     (define/override (client-to-screen x y)
-      (let-values ([(dx dy) (gtk_window_get_position gtk)])
-        (set-box! x (+ (unbox x) dx))
-        (set-box! y (+ (unbox y) dy))))
+      (gtk_window_set_gravity gtk GDK_GRAVITY_STATIC)
+      (let-values ([(dx dy) (gtk_window_get_position gtk)]
+                   [(cdx cdy) (get-client-delta)])
+        (gtk_window_set_gravity gtk GDK_GRAVITY_NORTH_WEST)
+        (set-box! x (+ (unbox x) dx cdx))
+        (set-box! y (+ (unbox y) dy cdy))))
 
     (def/public-unimplemented on-toolbar-click)
     (def/public-unimplemented on-menu-click)

collects/mred/private/wx/gtk/window.rkt

@@ -366,9 +366,13 @@
         (set-box! x (- (unbox x) (unbox xb)))
         (set-box! y (- (unbox y) (unbox yb)))))
     (define/public (client-to-screen x y)
-      (send parent client-to-screen x y)
-      (set-box! x (+ (unbox x) save-x))
-      (set-box! y (+ (unbox y) save-y)))
+      (let-values ([(dx dy) (get-client-delta)])
+        (send parent client-to-screen x y)
+        (set-box! x (+ (unbox x) save-x dx))
+        (set-box! y (+ (unbox y) save-y dy))))
+
+    (define/public (get-client-delta)
+      (values 0 0))
 
     (def/public-unimplemented get-position)
     (def/public-unimplemented fit)