suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/gui: fix excessive on-size' and on-move' callbacks

Browse Source 
Especially for gtk, where a client-resize notification was
getting mixed up with a frame-configure notification. On all
platforms, `on-size' and `on-move' for a frame% were queued
at too high a priority.
This commit is contained in:
Matthew Flatt 2011-09-10 14:37:13 -06:00
parent f3a79350e2
commit 2ecd32b86e
3 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mred/private/wx/gtk/frame.rkt
View File

@ -181,7 +181,8 @@
[client-gtk panel-gtk]
[no-show? #t]
[add-to-parent? #f]
[extra-gtks (list panel-gtk)])
[extra-gtks (list panel-gtk)]
[connect-size-allocate? #f])
(set-size x y w h)
@ -287,8 +288,7 @@
(define/override (really-set-size gtk x y processed-x processed-y w h)
(set-top-position x y)
(gtk_window_resize gtk (max 1 w) (max 1 h))
(queue-on-size))
(gtk_window_resize gtk (max 1 w) (max 1 h)))
(define/override (show on?)
(let ([es (get-eventspace)])

10
collects/mred/private/wx/gtk/window.rkt
View File

@ -422,7 +422,8 @@
gtk)
(init [no-show? #f]
[extra-gtks null]
[add-to-parent? #t])
[add-to-parent? #t]
[connect-size-allocate? #t])
(super-new [gtk gtk]
[extra-gtks extra-gtks]
@ -435,7 +436,8 @@
(define/public (get-unset-pos) 0)
(connect-size-allocate gtk)
(when connect-size-allocate?
(connect-size-allocate gtk))
(when add-to-parent?
(gtk_container_add (send parent get-container-gtk) gtk))
@ -451,8 +453,8 @@
(define/public (set-size x y w h)
(unless (and (or (= x -11111) (= save-x x))
(or (= y -11111) (= save-y y))
(or (= w -1) (= save-w w))
(or (= h -1) (= save-h h)))
(or (= w -1) (= save-w (max w client-delta-w)))
(or (= h -1) (= save-h (max h client-delta-h))))
(unless (= x -11111) (set! save-x x))
(unless (= y -11111) (set! save-y y))
(unless (= w -1) (set! save-w w))

2
collects/mred/private/wxtop.rkt
View File

@ -410,7 +410,7 @@
(lambda ()
(unless (and already-trying? (not (eq? 'unix (system-type))))
(parameterize ([wx:current-eventspace (get-eventspace)])
(wx:queue-callback (lambda () (resized)) #t))))])
(wx:queue-callback (lambda () (resized)) wx:middle-queue-key))))])
(public
[position-for-initial-show