fix Gtk global<->local
original commit: 7de0f66b974dbc926c218cf609ad208a8de1b3f8
This commit is contained in:
parent
d4385a7174
commit
7a4aa05ba1
|
@ -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
|
||||
|
|
|
@ -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)))
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
(let-values ([(dx dy) (get-client-delta)])
|
||||
(send parent client-to-screen x y)
|
||||
(set-box! x (+ (unbox x) save-x))
|
||||
(set-box! y (+ (unbox y) save-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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user