diff --git a/collects/mred/private/mrmenu.rkt b/collects/mred/private/mrmenu.rkt index 2dbbac2751..562b2464ce 100644 --- a/collects/mred/private/mrmenu.rkt +++ b/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% - (define/override (on-exit) - (exit)) - (super-make-object "Root")))]) + (begin (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! f))) - f) + (set! root-menu-frame-used? #t))) + root-menu-frame) parent)] [wx #f] [wx-parent #f] diff --git a/collects/mred/private/mrtop.rkt b/collects/mred/private/mrtop.rkt index b07ae72cd8..b6fa45abae 100644 --- a/collects/mred/private/mrtop.rkt +++ b/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 - set-root-menu-frame!) + (protect root-menu-frame) get-top-level-windows get-top-level-focus-window get-top-level-edit-target-window @@ -266,11 +266,6 @@ (let ([cwho '(constructor dialog)]) (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)))) diff --git a/collects/mred/private/wx/cocoa/frame.rkt b/collects/mred/private/wx/cocoa/frame.rkt index 9b8a4395b2..c70d89d277 100644 --- a/collects/mred/private/wx/cocoa/frame.rkt +++ b/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) - (or (and w - (if (objc-is-a? w MyWindow) - (tell #:type _scheme w getEventspace) - #f)) - (and front - (send front get-eventspace))))) +(set-eventspace-hook! (lambda (evt w) + (define (is-mouse-or-key?) + (bitwise-bit-set? MouseAndKeyEventMask + (tell #:type _NSInteger evt type))) + (cond + [w + (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)]) - (cond - [next (tellv next makeKeyWindow)] - [root-fake-frame (send root-fake-frame install-mb)] - [else (void)])))) + (force-window-focus))) (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?) diff --git a/collects/mred/private/wx/cocoa/queue.rkt b/collects/mred/private/wx/cocoa/queue.rkt index b41049e3b0..0480478fbb 100644 --- a/collects/mred/private/wx/cocoa/queue.rkt +++ b/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.