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 (get-client-gtk) client-gtk)
|
||||||
(define/override (handles-events?) #t)
|
(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:
|
;; Avoid multiple queued paints:
|
||||||
(define paint-queued? #f)
|
(define paint-queued? #f)
|
||||||
;; To handle paint requests that happen while on-paint
|
;; To handle paint requests that happen while on-paint
|
||||||
|
|
|
@ -18,6 +18,8 @@
|
||||||
(lambda (gtk a)
|
(lambda (gtk a)
|
||||||
(let ([wx (gtk->wx gtk)])
|
(let ([wx (gtk->wx gtk)])
|
||||||
(send wx remember-client-size
|
(send wx remember-client-size
|
||||||
|
(GtkAllocation-x a)
|
||||||
|
(GtkAllocation-y a)
|
||||||
(GtkAllocation-width a)
|
(GtkAllocation-width a)
|
||||||
(GtkAllocation-height a)))
|
(GtkAllocation-height a)))
|
||||||
#t))
|
#t))
|
||||||
|
@ -30,11 +32,15 @@
|
||||||
|
|
||||||
(define client-w 0)
|
(define client-w 0)
|
||||||
(define client-h 0)
|
(define client-h 0)
|
||||||
|
(define client-x 0)
|
||||||
|
(define client-y 0)
|
||||||
|
|
||||||
(define/public (on-client-size w h) (void))
|
(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
|
;; Called in the Gtk event-loop thread
|
||||||
|
(set! client-x x)
|
||||||
|
(set! client-y y)
|
||||||
(set! client-w w)
|
(set! client-w w)
|
||||||
(set! client-h h)
|
(set! client-h h)
|
||||||
(queue-window-event this (lambda ()
|
(queue-window-event this (lambda ()
|
||||||
|
@ -48,4 +54,7 @@
|
||||||
(set-box! xb client-w)
|
(set-box! xb client-w)
|
||||||
(set-box! yb client-h))
|
(set-box! yb client-h))
|
||||||
|
|
||||||
|
(define/override (get-client-delta)
|
||||||
|
(values client-x client-y))
|
||||||
|
|
||||||
(super-new)))
|
(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_new (_fun _int -> _GtkWidget))
|
||||||
(define-gtk gtk_window_set_title (_fun _GtkWindow _string -> _void))
|
(define-gtk gtk_window_set_title (_fun _GtkWindow _string -> _void))
|
||||||
(define-gtk gtk_fixed_new (_fun _gboolean _int -> _GtkWidget))
|
(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))
|
(define-gtk gtk_window_get_position (_fun _GtkWidget (x : (_ptr o _int)) (y : (_ptr o _int))
|
||||||
-> _void
|
-> _void
|
||||||
-> (values x y)))
|
-> (values x y)))
|
||||||
|
(define-gtk gtk_window_set_gravity (_fun _GtkWindow _int -> _void))
|
||||||
|
|
||||||
(define (handle-delete gtk)
|
(define (handle-delete gtk)
|
||||||
(let ([wx (gtk->wx gtk)])
|
(let ([wx (gtk->wx gtk)])
|
||||||
|
@ -74,7 +79,8 @@
|
||||||
(init [is-dialog? #f])
|
(init [is-dialog? #f])
|
||||||
|
|
||||||
(inherit get-gtk set-size on-size
|
(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))
|
(define gtk (gtk_window_new GTK_WINDOW_TOPLEVEL))
|
||||||
(when (memq 'no-caption style)
|
(when (memq 'no-caption style)
|
||||||
|
@ -165,9 +171,12 @@
|
||||||
(pre-on-char w e))
|
(pre-on-char w e))
|
||||||
|
|
||||||
(define/override (client-to-screen x y)
|
(define/override (client-to-screen x y)
|
||||||
(let-values ([(dx dy) (gtk_window_get_position gtk)])
|
(gtk_window_set_gravity gtk GDK_GRAVITY_STATIC)
|
||||||
(set-box! x (+ (unbox x) dx))
|
(let-values ([(dx dy) (gtk_window_get_position gtk)]
|
||||||
(set-box! y (+ (unbox y) dy))))
|
[(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-toolbar-click)
|
||||||
(def/public-unimplemented on-menu-click)
|
(def/public-unimplemented on-menu-click)
|
||||||
|
|
|
@ -366,9 +366,13 @@
|
||||||
(set-box! x (- (unbox x) (unbox xb)))
|
(set-box! x (- (unbox x) (unbox xb)))
|
||||||
(set-box! y (- (unbox y) (unbox yb)))))
|
(set-box! y (- (unbox y) (unbox yb)))))
|
||||||
(define/public (client-to-screen x y)
|
(define/public (client-to-screen x y)
|
||||||
(send parent client-to-screen x y)
|
(let-values ([(dx dy) (get-client-delta)])
|
||||||
(set-box! x (+ (unbox x) save-x))
|
(send parent client-to-screen x y)
|
||||||
(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 get-position)
|
||||||
(def/public-unimplemented fit)
|
(def/public-unimplemented fit)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user