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.
This commit is contained in:
Robby Findler
parent
1e375bab48
commit
49eb4ab11c
|
|
@ -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?)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))])
|
||||
|
|
|
|||
|
|
@ -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^
|
||||
())
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user