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:
parent
20256a3f15
commit
9d563c786a
|
@ -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))]
|
||||
|
|
|
@ -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?)))))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user