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

more consistent on-size' and on-move'

Browse Source
This commit is contained in:
Matthew Flatt 2011-01-05 10:00:07 -07:00
parent c9d2f43398
commit ae5093a134
12 changed files with 56 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -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?)]

4
collects/mred/private/wx/cocoa/frame.rkt
View File

@ -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

6
collects/mred/private/wx/cocoa/window.rkt
View File

@ -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)

9
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -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

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

@ -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

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

@ -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?)

7
collects/mred/private/wx/win32/canvas.rkt
View File

@ -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

3
collects/mred/private/wx/win32/window.rkt
View File

@ -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))

15
collects/mred/private/wxme/editor-canvas.rkt
View File

@ -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)

1
collects/mred/private/wxpanel.rkt
View File

@ -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)]

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

@ -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))))])

45
collects/mred/private/wxwindow.rkt
View File

@ -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)))]