From 9d563c786a71b621fcd2909c917b49939e0d11b0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 5 Apr 2012 06:56:56 -0600
Subject: [PATCH] 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.
---
 collects/mred/private/wx/common/queue.rkt |  6 ++++--
 collects/mred/private/wx/win32/dialog.rkt | 10 +++++++++-
 collects/mred/private/wx/win32/frame.rkt  | 24 +++++++++++++++++++----
 3 files changed, 33 insertions(+), 7 deletions(-)

diff --git a/collects/mred/private/wx/common/queue.rkt b/collects/mred/private/wx/common/queue.rkt
index 1fd4febaa3..fab54e0f06 100644
--- a/collects/mred/private/wx/common/queue.rkt
+++ b/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))]
diff --git a/collects/mred/private/wx/win32/dialog.rkt b/collects/mred/private/wx/win32/dialog.rkt
index 45e1f0c11b..ce36271fb6 100644
--- a/collects/mred/private/wx/win32/dialog.rkt
+++ b/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?)))))
diff --git a/collects/mred/private/wx/win32/frame.rkt b/collects/mred/private/wx/win32/frame.rkt
index e916f7d639..a70b8c3414 100644
--- a/collects/mred/private/wx/win32/frame.rkt
+++ b/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)