diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index ad54429629..1628315679 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -238,7 +238,6 @@ is-window-enabled? block-mouse-events move get-x get-y - on-size register-as-child get-size get-position set-focus @@ -456,7 +455,9 @@ (fix-dc) (when (is-auto-scroll?) (reset-auto-scroll 0 0)) - (on-size 0 0)) + (on-size)) + + (define/public (on-size) (void)) (define/public (show-scrollbars h? v?) (let ([h? (and h? hscroll-ok?)] diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 525dc73f50..d55d0a28aa 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/collects/mred/private/wx/cocoa/frame.rkt @@ -63,7 +63,7 @@ (let ([wx (->wx wxb)]) (when wx (queue-window-event wx (lambda () - (send wx on-size 0 0) + (send wx queue-on-size) (send wx clean-up))) ;; Live resize: (constrained-reply (send wx get-eventspace) @@ -74,7 +74,7 @@ [-a _void (windowDidMove: [_id notification]) (when wxb (queue-window*-event wxb (lambda (wx) - (send wx on-size 0 0))))] + (send wx queue-on-size))))] [-a _void (windowDidBecomeMain: [_id notification]) ;; We check whether the window is visible because ;; clicking the dock item tries to resurrect a hidden diff --git a/collects/mred/private/wx/cocoa/window.rkt b/collects/mred/private/wx/cocoa/window.rkt index c6b8d1253c..80ce551aaf 100644 --- a/collects/mred/private/wx/cocoa/window.rkt +++ b/collects/mred/private/wx/cocoa/window.rkt @@ -591,7 +591,9 @@ [y (if (= y -11111) (get-y) y)]) (tellv cocoa setNeedsDisplay: #:type _BOOL #t) (tellv cocoa setFrame: #:type _NSRect (make-NSRect (make-NSPoint x (flip y h)) - (make-NSSize w h))))) + (make-NSSize w h)))) + (queue-on-size)) + (define/public (internal-move x y) (set-size x y (get-width) (get-height))) (define/public (move x y) @@ -702,7 +704,7 @@ (define/public (on-char s) (void)) (define/public (on-event m) (void)) - (define/public (on-size x y) (void)) + (define/public (queue-on-size) (void)) (define last-l? #f) (define last-m? #f) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index cf252365d1..1e4f0e6c0f 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -194,7 +194,7 @@ [gl-config #f]) (inherit get-gtk set-size get-size get-client-size - on-size get-top-win + get-top-win set-auto-size adjust-client-delta infer-client-delta is-auto-scroll? get-virtual-width get-virtual-height @@ -438,10 +438,9 @@ (define/override (internal-on-client-size w h) (reset-dc)) (define/override (on-client-size w h) - (let ([xb (box 0)] - [yb (box 0)]) - (get-size xb yb) - (on-size (unbox xb) (unbox yb)))) + (on-size)) + + (define/public (on-size) (void)) (define/public (show-scrollbars h? v?) (when hscroll-gtk diff --git a/collects/mred/private/wx/gtk/frame.rkt b/collects/mred/private/wx/gtk/frame.rkt index 33a57505c0..7575b6547d 100644 --- a/collects/mred/private/wx/gtk/frame.rkt +++ b/collects/mred/private/wx/gtk/frame.rkt @@ -139,7 +139,7 @@ style) (init [is-dialog? #f]) - (inherit get-gtk set-size on-size + (inherit get-gtk set-size pre-on-char pre-on-event get-client-delta get-size get-parent get-eventspace diff --git a/collects/mred/private/wx/gtk/window.rkt b/collects/mred/private/wx/gtk/window.rkt index e4cc352e2a..b878609dce 100644 --- a/collects/mred/private/wx/gtk/window.rkt +++ b/collects/mred/private/wx/gtk/window.rkt @@ -420,7 +420,8 @@ (unless (= h -1) (set! save-h h)) (set! save-w (max save-w client-delta-w)) (set! save-h (max save-h client-delta-h)) - (really-set-size gtk x y save-x save-y save-w save-h))) + (really-set-size gtk x y save-x save-y save-w save-h) + (queue-on-size))) (define/public (save-size x y w h) (set! save-w w) @@ -441,13 +442,7 @@ (set! save-h h) (queue-on-size))) - (define on-size-queued? #f) - (define/public (queue-on-size) - (unless on-size-queued? - (set! on-size-queued? #t) - (queue-window-event this (lambda () - (set! on-size-queued? #f) - (on-size 0 0))))) + (define/public (queue-on-size) (void)) (define client-delta-w 0) (define client-delta-h 0) @@ -605,8 +600,6 @@ (define/public (on-char e) (void)) (define/public (on-event e) (void)) - (define/public (on-size w h) (void)) - (define/public (register-child child on?) (void)) (define/public (register-child-in-parent on?) diff --git a/collects/mred/private/wx/win32/canvas.rkt b/collects/mred/private/wx/win32/canvas.rkt index c9998f3862..375f950d89 100644 --- a/collects/mred/private/wx/win32/canvas.rkt +++ b/collects/mred/private/wx/win32/canvas.rkt @@ -86,8 +86,7 @@ set-control-font is-auto-scroll? get-virtual-width get-virtual-height reset-auto-scroll - refresh-for-autoscroll - on-size) + refresh-for-autoscroll) (define hscroll? (memq 'hscroll style)) (define vscroll? (memq 'vscroll style)) @@ -241,7 +240,9 @@ [h (if (= h -1) (- (RECT-bottom r) (RECT-top r)) h)]) (MoveWindow canvas-hwnd 0 0 (max 1 (- w COMBO-WIDTH)) h #t) (MoveWindow combo-hwnd 0 0 (max 1 w) (- h 2) #t))) - (on-size 0 0)) + (on-size)) + + (define/public (on-size) (void)) ;; The `queue-paint' and `paint-children' methods ;; are defined by `canvas-mixin' from ../common/canvas-mixin diff --git a/collects/mred/private/wx/win32/window.rkt b/collects/mred/private/wx/win32/window.rkt index 6aab5bcab9..67dbfd65e6 100644 --- a/collects/mred/private/wx/win32/window.rkt +++ b/collects/mred/private/wx/win32/window.rkt @@ -244,7 +244,7 @@ (unless (memq 'deleted style) (show #t)) - (define/public (on-size w h) (void)) + (define/public (queue-on-size) (void)) (define/public (on-set-focus) (void)) (define/public (on-kill-focus) (void)) @@ -314,6 +314,7 @@ (MoveWindow hwnd x y w h #t)) (unless (and (= w -1) (= h -1)) (on-resized)) + (queue-on-size) (refresh)) (define/public (move x y) (set-size x y -1 -1)) diff --git a/collects/mred/private/wxme/editor-canvas.rkt b/collects/mred/private/wxme/editor-canvas.rkt index a12cbeeba5..43bafcb4ed 100644 --- a/collects/mred/private/wxme/editor-canvas.rkt +++ b/collects/mred/private/wxme/editor-canvas.rkt @@ -288,13 +288,16 @@ (send admin set-canvas #f) #|(super ~)|#) - (define/override (on-size w h) + (define/override (on-size) (unless noloop? - (unless (and (= w lastwidth) - (= h lastheight)) - (unless (and media - (send media get-printing)) - (reset-size))))) + (unless (and media + (send media get-printing)) + (let-boxes ([w 0] + [h 0]) + (get-size w h) + (unless (and (= w lastwidth) + (= h lastheight)) + (reset-size)))))) (define/private (reset-size) (reset-visual #f) diff --git a/collects/mred/private/wxpanel.rkt b/collects/mred/private/wxpanel.rkt index 99e2017e85..955a8ca7d5 100644 --- a/collects/mred/private/wxpanel.rkt +++ b/collects/mred/private/wxpanel.rkt @@ -34,7 +34,6 @@ [on-set-focus (lambda () (void))] [on-kill-focus (lambda () (void))] [set-focus (lambda () (void))] - [on-size (lambda () (void))] [enable (lambda () (void))] [show (lambda (on?) (void))] [is-shown? (lambda () #f)] diff --git a/collects/mred/private/wxtop.rkt b/collects/mred/private/wxtop.rkt index cda7b38b39..05513e8427 100644 --- a/collects/mred/private/wxtop.rkt +++ b/collects/mred/private/wxtop.rkt @@ -395,8 +395,8 @@ ;; aren't stretchable, frame resized to size of ;; contents. Each direction is handled ;; independently. - [on-size - (lambda (bad-width bad-height) + [queue-on-size + (lambda () (unless (and already-trying? (not (eq? 'unix (system-type)))) (parameterize ([wx:current-eventspace (get-eventspace)]) (wx:queue-callback (lambda () (resized)) #t))))]) diff --git a/collects/mred/private/wxwindow.rkt b/collects/mred/private/wxwindow.rkt index be3d476669..dc18af233d 100644 --- a/collects/mred/private/wxwindow.rkt +++ b/collects/mred/private/wxwindow.rkt @@ -190,29 +190,28 @@ (as-exit (lambda () (send (get-proxy) on-drop-file f)))))] - [on-size (lambda (bad-w bad-h) - (super on-size bad-w bad-h) - ;; Delay callback to make sure X structures (position) are updated, first. - ;; Also, Windows needs a trampoline. - (queue-window-callback - this - (entry-point - (lambda () - (let ([mred (get-mred)]) - (when mred - (let* ([w (get-width)] - [h (get-height)]) - (when (not (and (= w old-w) (= h old-h))) - (set! old-w w) - (set! old-h h) - (as-exit (lambda () (send mred on-size w h))))) - (let* ([p (area-parent)] - [x (- (get-x) (or (and p (send p dx)) 0))] - [y (- (get-y) (or (and p (send p dy)) 0))]) - (when (not (and (= x old-x) (= y old-y))) - (set! old-x x) - (set! old-y y) - (as-exit (lambda () (send mred on-move x y)))))))))))] + [queue-on-size + (lambda () + (super queue-on-size) + (queue-window-callback + this + (entry-point + (lambda () + (let ([mred (get-mred)]) + (when mred + (let* ([w (get-width)] + [h (get-height)]) + (when (not (and (= w old-w) (= h old-h))) + (set! old-w w) + (set! old-h h) + (as-exit (lambda () (send mred on-size w h))))) + (let* ([p (area-parent)] + [x (- (get-x) (or (and p (send p dx)) 0))] + [y (- (get-y) (or (and p (send p dy)) 0))]) + (when (not (and (= x old-x) (= y old-y))) + (set! old-x x) + (set! old-y y) + (as-exit (lambda () (send mred on-move x y)))))))))))] [on-set-focus (lambda () (super on-set-focus) (when expose-focus? (send (get-proxy) on-focus #t)))]