racket/gui, win32: fix problem with modal dialogs

Although most events in other frames were blocked, it was
possible to bring other frames to the front and to select
menu items in other frames.
This commit is contained in:
Matthew Flatt 2012-04-05 06:56:56 -06:00
parent 20256a3f15
commit 9d563c786a
3 changed files with 33 additions and 7 deletions

View File

@ -551,7 +551,7 @@
(hash-map (eventspace-frames-hash e)
(lambda (k v) k)))
(define (other-modal? win [e #f])
(define (other-modal? win [e #f] [ignore-win #f])
;; called in atomic mode in eventspace's thread
(and
;; deliver mouse-motion events even if a modal window
@ -566,7 +566,9 @@
(or (positive? (eventspace-external-modal es))
(let loop ([frames (get-top-level-windows es)])
(and (pair? frames)
(let ([status (send (car frames) frame-relative-dialog-status win)])
(let ([status (if (eq? ignore-win (car frames))
#f
(send (car frames) frame-relative-dialog-status win))])
(case status
[(#f) (loop (cdr frames))]
[(same) (loop (cdr frames))]

View File

@ -33,6 +33,7 @@
(define dialog%
(class (dialog-mixin frame%)
(super-new)
(inherit get-eventspace)
(define/override (create-frame parent label x y w h style)
(let ([hwnd
@ -51,4 +52,11 @@
(MoveWindow hwnd x y w h #t))
hwnd))
(define/override (is-dialog?) #t)))
(define/override (is-dialog?) #t)
(define/override (direct-show on?)
;; atomic mode
(when on? (super direct-show on?))
(for ([f (in-list (get-top-level-windows (get-eventspace)))])
(send f modal-enable (and (not on?) this)))
(when (not on?) (super direct-show on?)))))

View File

@ -65,6 +65,8 @@
(define SPI_GETWORKAREA #x0030)
(define MA_NOACTIVATEANDEAT 4)
(define (get-all-screen-rects)
(let ([rects null])
(EnumDisplayMonitors #f #f (lambda (mon dc r ptr)
@ -268,10 +270,11 @@
(define/override (wndproc w msg wParam lParam default)
(cond
[(= msg WM_CLOSE)
(queue-window-event this (lambda ()
(when (on-close)
(atomically
(direct-show #f)))))
(unless (other-modal? this)
(queue-window-event this (lambda ()
(when (on-close)
(atomically
(direct-show #f))))))
0]
[(and (= msg WM_SIZE)
(not (= wParam SIZE_MINIMIZED)))
@ -387,6 +390,19 @@
(define/override (call-pre-on-char w e)
(pre-on-char w e))
(define modal-enabled? #t)
(define otherwise-enabled? #t)
(define/public (modal-enable ignoring)
(define on? (not (other-modal? this #f ignoring)))
(unless (eq? modal-enabled? on?)
(set! modal-enabled? on?)
(update-enabled)))
(define/override (internal-enable on?)
(set! otherwise-enabled? on?)
(update-enabled))
(define/private (update-enabled)
(super internal-enable (and modal-enabled? otherwise-enabled?)))
(define/override (generate-parent-mouse-ins mk)
;; assert: in-window is always the panel child
(unless (eq? mouse-frame this)