From 49eb4ab11cb28ba543b4f5ee9738cd240bec6b8a Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 16 Aug 2012 08:42:42 -0500 Subject: [PATCH] adjust the windows menu so that it doesn't rely on various callbacks to keep its menu items straight, but instead uses the on-demand callback to just get them all right. --- collects/framework/main.rkt | 8 ++ collects/framework/private/frame.rkt | 7 +- collects/framework/private/group.rkt | 107 ++++++++++++++------------- collects/framework/private/sig.rkt | 3 +- 4 files changed, 65 insertions(+), 60 deletions(-) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index 9e4ecd88d9..c55824aebd 100644 --- a/collects/framework/main.rkt +++ b/collects/framework/main.rkt @@ -770,6 +770,14 @@ @{Procedures passed to this function are called when the @onscreen{Windows} menu is created. Use it to add additional menu items.}) + (proc-doc/names + group:create-windows-menu + (-> (is-a?/c menu-item-container<%>) (is-a?/c menu%)) + (mb) + @{Creates a windows menu, registers it (internally) with + the frame group (see @racket[(get-the-frame-group)]), and + returns it.}) + (proc-doc/names handler:handler? (any/c . -> . boolean?) diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt index ff25eeb8eb..215dab0786 100644 --- a/collects/framework/private/frame.rkt +++ b/collects/framework/private/frame.rkt @@ -242,12 +242,7 @@ (set-icon large (send large get-loaded-mask) 'large)) (set-icon icon (send icon get-loaded-mask) 'both)))) - (let ([mb (make-object (get-menu-bar%) this)]) - (make-object menu:can-restore-underscore-menu% - (case (system-type) - [(macosx) (string-constant windows-menu-label)] - [else (string-constant tabs-menu-label)]) - mb)) + (group:create-windows-menu (make-object (get-menu-bar%) this)) (reorder-menus this) diff --git a/collects/framework/private/group.rkt b/collects/framework/private/group.rkt index e23e3a7939..e880742c51 100644 --- a/collects/framework/private/group.rkt +++ b/collects/framework/private/group.rkt @@ -34,6 +34,8 @@ [(macosx) (string-constant windows-menu-label)] [else (string-constant tabs-menu-label)])) + (define-local-member-name update-windows-menu) + (define % (class object% @@ -68,7 +70,7 @@ (let ([menu (get-windows-menu frame)]) (when menu - ;; to help the (conservative) gc. + ;; to help the gc. (for-each (λ (i) (send i delete)) (send menu get-items)) (set! windows-menus @@ -77,7 +79,7 @@ windows-menus eq?))))) - (define/private (update-windows-menus) + (define/public (update-windows-menu menu) (let* ([windows (length windows-menus)] [default-name (string-constant untitled)] [get-name @@ -97,49 +99,46 @@ (λ (f1 f2) (string-ci<=? (get-name (frame-frame f1)) (get-name (frame-frame f2)))))]) - (for-each - (λ (menu) - (for-each (λ (item) (send item delete)) (send menu get-items)) - (when (eq? (system-type) 'macosx) - (new menu:can-restore-menu-item% - [label (string-constant minimize)] - [parent menu] - [callback (λ (x y) (send (send (send menu get-parent) get-frame) iconize #t))] - [shortcut #\m]) - (new menu:can-restore-menu-item% - [label (string-constant zoom)] - [parent menu] - [callback (λ (x y) - (let ([frame (send (send menu get-parent) get-frame)]) - (send frame maximize (not (send frame is-maximized?)))))]) - (instantiate menu:can-restore-menu-item% () - (label (string-constant bring-frame-to-front...)) - (parent menu) - (callback (λ (x y) (choose-a-frame (send (send menu get-parent) get-frame)))) - (shortcut #\j)) - (instantiate menu:can-restore-menu-item% () - (label (string-constant most-recent-window)) - (parent menu) - (callback (λ (x y) (most-recent-window-to-front))) - (shortcut #\')) - (make-object separator-menu-item% menu)) - - (extra-windows-menus-proc menu) - - (when (eq? (system-type) 'macosx) - (for-each - (λ (frame) - (let ([frame (frame-frame frame)]) - (make-object menu-item% - (regexp-replace* - #rx"&" - (gui-utils:trim-string (get-name frame) 200) - "&&") - menu - (λ (_1 _2) - (send frame show #t))))) - sorted/visible-frames))) - windows-menus))) + (for-each (λ (item) (send item delete)) (send menu get-items)) + (when (eq? (system-type) 'macosx) + (new menu:can-restore-menu-item% + [label (string-constant minimize)] + [parent menu] + [callback (λ (x y) (send (send (send menu get-parent) get-frame) iconize #t))] + [shortcut #\m]) + (new menu:can-restore-menu-item% + [label (string-constant zoom)] + [parent menu] + [callback (λ (x y) + (let ([frame (send (send menu get-parent) get-frame)]) + (send frame maximize (not (send frame is-maximized?)))))]) + (instantiate menu:can-restore-menu-item% () + (label (string-constant bring-frame-to-front...)) + (parent menu) + (callback (λ (x y) (choose-a-frame (send (send menu get-parent) get-frame)))) + (shortcut #\j)) + (instantiate menu:can-restore-menu-item% () + (label (string-constant most-recent-window)) + (parent menu) + (callback (λ (x y) (most-recent-window-to-front))) + (shortcut #\')) + (make-object separator-menu-item% menu)) + + (extra-windows-menus-proc menu) + + (when (eq? (system-type) 'macosx) + (for-each + (λ (frame) + (let ([frame (frame-frame frame)]) + (make-object menu-item% + (regexp-replace* + #rx"&" + (gui-utils:trim-string (get-name frame) 200) + "&&") + menu + (λ (_1 _2) + (send frame show #t))))) + sorted/visible-frames)))) ;; most-recent-window-to-front : -> void? ;; brings the most recent window to the front @@ -174,12 +173,10 @@ (define/public (get-frames) (map frame-frame frames)) (define/public (frame-label-changed frame) - (when (memq frame (map frame-frame frames)) - (update-windows-menus))) + (void)) (define/public (frame-shown/hidden frame) - (when (memq frame (map frame-frame frames)) - (update-windows-menus))) + (void)) (define/public (for-each-frame f) (for-each (λ (x) (f (frame-frame x))) frames) @@ -207,8 +204,7 @@ frames)]) (set! frames new-frames) (update-close-menu-item-state) - (insert-windows-menu new-frame) - (update-windows-menus)) + (insert-windows-menu new-frame)) (todo-to-new-frames new-frame))) (define/public (remove-frame f) @@ -220,8 +216,7 @@ (λ (f fr) (eq? f (frame-frame fr))))]) (set! frames new-frames) (update-close-menu-item-state) - (remove-windows-menu f) - (update-windows-menus))) + (remove-windows-menu f))) (define/public (clear) (set! frames null) @@ -261,6 +256,12 @@ (loop (cdr frames))))])))) (super-new))) + + (define (create-windows-menu mb) + (new menu:can-restore-underscore-menu% + [label windows-menu-label] + [demand-callback (λ (menu) (send (get-the-frame-group) update-windows-menu menu))] + [parent mb])) (define (can-close-check) (let ([number-of-frames (length (send (get-the-frame-group) get-frames))]) diff --git a/collects/framework/private/sig.rkt b/collects/framework/private/sig.rkt index 439253458f..5cf1d3e333 100644 --- a/collects/framework/private/sig.rkt +++ b/collects/framework/private/sig.rkt @@ -318,7 +318,8 @@ (get-the-frame-group on-close-action can-close-check - add-to-windows-menu)) + add-to-windows-menu + create-windows-menu)) (define-signature handler-class^ ())