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

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

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)])
+    (group:create-windows-menu (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))
     
     (reorder-menus this)
     

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,8 +99,6 @@
                  (λ (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%
@@ -138,8 +138,7 @@
                    menu
                    (λ (_1 _2)
                      (send frame show #t)))))
-                sorted/visible-frames)))
+             sorted/visible-frames))))
-           windows-menus)))
       
       ;; 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))
+        (void))
-          (update-windows-menus)))
       
       (define/public (frame-shown/hidden frame)
-        (when (memq frame (map frame-frame frames))
+        (void))
-          (update-windows-menus)))
       
       (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)
+            (insert-windows-menu new-frame))
-            (update-windows-menus))
           (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)
+          (remove-windows-menu f)))
-          (update-windows-menus)))
       
       (define/public (clear)
         (set! frames null)
@@ -262,6 +257,12 @@
       
       (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))])
       (or (not (preferences:get 'framework:exit-when-no-frames))

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^
     ())