cocoa: event-dispatch repairs, especially when no frame is shown

Relevant to PR 11672

collects/mred/private/mrmenu.rkt

@@ -24,6 +24,8 @@
 	   (protect menu-parent-only
 		    menu-or-bar-parent))
 
+  (define root-menu-frame-used? #f)
+
   ;; Most of the work is in the item. Anything that appears in a menubar or
   ;;  menu has an item. Submenus are created as instances of menu%, but
   ;;  menu% has a get-item method for manipulating the menu w.r.t. the parent
@@ -426,17 +428,13 @@
       (private-field 
        [callback demand-callback]
        [prnt (if (eq? parent 'root)
-		 (let ([f (make-object (class frame%
+		 (begin
-					 (define/override (on-exit)
-					   (exit))
-					 (super-make-object "Root")))])
 		   (as-entry
 		    (lambda ()
-		      (when root-menu-frame
+		      (when root-menu-frame-used?
 			(raise-mismatch-error (constructor-name 'menu-bar) "already has a menu bar: " parent))
-		      (send (mred->wx f) designate-root-frame)
+		      (set! root-menu-frame-used? #t)))
-		      (set-root-menu-frame! f)))
+		   root-menu-frame)
-		   f)
 		 parent)]
        [wx #f]
        [wx-parent #f]

collects/mred/private/mrtop.rkt

@@ -14,13 +14,13 @@
 	   "wxpanel.ss"
 	   "wxitem.ss"
 	   "mrwindow.ss"
-	   "mrcontainer.ss")
+	   "mrcontainer.ss"
+           "app.ss")
 
   (provide top-level-window<%>
 	   frame%
 	   dialog%
-	   (protect root-menu-frame
+	   (protect root-menu-frame)
-		    set-root-menu-frame!)
 	   get-top-level-windows
 	   get-top-level-focus-window
 	   get-top-level-edit-target-window
@@ -267,11 +267,6 @@
 			   (check-container-ready cwho parent)))
 		       label parent))))))
   
-  (define root-menu-frame #f)
-  (define (set-root-menu-frame! f) 
-    (set! root-menu-frame f)
-    (set-root-menu-wx-frame! (mred->wx f)))
-  
   (define (get-top-level-windows)
     (remq root-menu-frame (map wx->mred (wx:get-top-level-windows))))
 
@@ -313,4 +308,18 @@
 
   (define (check-frame-parent/false who p)
     (unless (or (not p) (is-a? p frame%))
-      (raise-type-error (who->name who) "frame% object or #f" p))))
+      (raise-type-error (who->name who) "frame% object or #f" p)))
+
+  (define root-menu-frame
+    (and (current-eventspace-has-menu-root?)
+         ;; The very first frame shown is somehow sticky under Cocoa,
+         ;;  so create the root frame, show it , and hide it.
+         (let* ([f (make-object (class frame%
+                                  (define/override (on-exit)
+                                    (exit))
+                                  (super-make-object "Root" #f 0 0 -9000 -9000
+                                                     '(no-resize-border no-caption))))]
+                [wx (mred->wx f)])
+           (set-root-menu-wx-frame! wx)
+           (send wx designate-root-frame)
+           f))))

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

@@ -114,6 +114,11 @@
         (let ([wx (->wx wxb)])
           (when wx
             (send wx notify-responder #f))))]
+  [-a _void (windowDidMiniaturize: [_id notification])
+      (when wxb
+        (let ([wx (->wx wxb)])
+          (when wx
+            (send wx force-window-focus))))]
   [-a _void (toggleToolbarShown: [_id sender])
       (when wxb
         (let ([wx (->wx wxb)])
@@ -136,13 +141,25 @@
                      (values f
                              (and f (send f get-eventspace))))))
 
-(set-eventspace-hook! (lambda (w)
+(set-eventspace-hook! (lambda (evt w)
-                        (or (and w
+                        (define (is-mouse-or-key?)
-                                 (if (objc-is-a? w MyWindow)
+                          (bitwise-bit-set? MouseAndKeyEventMask
-                                     (tell #:type _scheme w getEventspace)
+                                            (tell #:type _NSInteger evt type)))
-                                     #f))
+                        (cond
-                            (and front
+                         [w
-                                 (send front get-eventspace)))))
+                          (and (or (not root-fake-frame)
+                                   ;; only mouse and key events in the root
+                                   ;; frame need to be dispatched in the root
+                                   ;; eventspace:
+                                   (not (ptr-equal? w (send root-fake-frame get-cocoa)))
+                                   (is-mouse-or-key?))
+                               (objc-is-a? w MyWindow)
+                               (tell #:type _scheme w getEventspace))]
+                         [front (send front get-eventspace)]
+                         [root-fake-frame 
+                          (and (is-mouse-or-key?)
+                               (send root-fake-frame get-eventspace))]
+                         [else #f])))
 
 (define frame%
   (class window%
@@ -287,12 +304,9 @@
                   (send p set-sheet #f)
                   (tell (tell NSApplication sharedApplication)
                         endSheet: cocoa))))
+            (tellv cocoa deminiaturize: #f)
             (tellv cocoa orderOut: #f)
-            (let ([next (get-app-front-window)])
+            (force-window-focus)))
-              (cond
-               [next (tellv next makeKeyWindow)]
-               [root-fake-frame (send root-fake-frame install-mb)]
-               [else (void)]))))
       (register-frame-shown this on?)
       (let ([num (tell #:type _NSInteger cocoa windowNumber)])
         (if on?
@@ -320,6 +334,20 @@
       (atomically
        (direct-show on?)))
 
+    (define/public (force-window-focus)
+      (let ([next (get-app-front-window)])
+        (cond
+         [next (tellv next makeKeyWindow)]
+         [root-fake-frame 
+          ;; Make key focus shift to root frame:
+          (let ([root-cocoa (send root-fake-frame get-cocoa)])
+            (tellv root-cocoa orderFront: #f)
+            (tellv root-cocoa makeKeyWindow)
+            (tellv root-cocoa orderOut: #f))
+          ;; Install root frame's menu bar:
+          (send root-fake-frame install-mb)]
+         [else (void)])))
+
     (define/private (do-paint-children)
       (when saved-child
         (send saved-child paint-children))
@@ -350,7 +378,8 @@
         (send saved-child enable-window (and on? (is-window-enabled?)))))
 
     (define/override (is-shown?)
-      (tell #:type _bool cocoa isVisible))
+      (or (tell #:type _bool cocoa isVisible)
+          (tell #:type _bool cocoa isMiniaturized)))
 
     (define/override (is-shown-to-root?)
       (is-shown?))
@@ -534,7 +563,12 @@
     (def/public-unimplemented on-mdi-activate)
     (define/public (on-close) #t)
     (define/public (designate-root-frame)
-      (set! root-fake-frame this))
+      (set! root-fake-frame this)
+      ;; The first window shown is somehow sticky, so that it becomes
+      ;; the main window if no windows are shown:
+      (tellv cocoa orderFront: #f)
+      (tellv cocoa orderOut: #f)
+      (sync-cocoa-events))
     (def/public-unimplemented system-menu)
 
     (define/public (set-modified on?)

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

@@ -22,7 +22,8 @@
               set-fixup-window-locations!
               post-dummy-event
 
-              try-to-sync-refresh)
+              try-to-sync-refresh
+              sync-cocoa-events)
 
  ;; from common/queue:
  current-eventspace
@@ -315,7 +316,7 @@
        (when evt (check-menu-bar-click evt))
        (and evt
             (or (not dequeue?)
-                (let ([e (eventspace-hook (tell evt window))])
+                (let ([e (eventspace-hook evt (tell evt window))])
                   (if e
                       (let ([mouse-or-key?
                              (bitwise-bit-set? MouseAndKeyEventMask
@@ -374,6 +375,10 @@
    ;; in atomic mode
    (dispatch-all-ready)))
 
+(define (sync-cocoa-events)
+  (atomically
+   (dispatch-all-ready)))
+
 ;; ------------------------------------------------------------
 ;; Install an alternate "sleep" function (in the PLT Scheme core)
 ;; that wakes up if any Cocoa event is ready.