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.

original commit: 9d563c786a71b621fcd2909c917b49939e0d11b0

collects/mred/private/wx/common/queue.rkt

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

collects/mred/private/wx/win32/dialog.rkt

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

collects/mred/private/wx/win32/frame.rkt

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