diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 738ccbb6..67617318 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/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 diff --git a/collects/mred/private/wx/gtk/client-window.rkt b/collects/mred/private/wx/gtk/client-window.rkt index 60cb0d38..5a5e50b7 100644 --- a/collects/mred/private/wx/gtk/client-window.rkt +++ b/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))) \ No newline at end of file diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 23a4cec8..e4067326 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/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) diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index eb5e3ce3..edb83cab 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/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)