suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust the windows menu so that it doesn't rely on

Browse Source 
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 2012-08-16 08:42:42 -05:00
parent 1e375bab48
commit 49eb4ab11c
4 changed files with 65 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/framework/main.rkt
View File

@ -770,6 +770,14 @@
@{Procedures passed to this function are called when the @onscreen{Windows} @{Procedures passed to this function are called when the @onscreen{Windows}
menu is created. Use it to add additional menu items.}) 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 (proc-doc/names
handler:handler? handler:handler?
(any/c . -> . boolean?) (any/c . -> . boolean?)

7
collects/framework/private/frame.rkt
View File

@ -242,12 +242,7 @@
(set-icon large (send large get-loaded-mask) 'large)) (set-icon large (send large get-loaded-mask) 'large))
(set-icon icon (send icon get-loaded-mask) 'both)))) (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) (reorder-menus this)

107
collects/framework/private/group.rkt
View File

@ -34,6 +34,8 @@
[(macosx) (string-constant windows-menu-label)] [(macosx) (string-constant windows-menu-label)]
[else (string-constant tabs-menu-label)])) [else (string-constant tabs-menu-label)]))
(define-local-member-name update-windows-menu)
(define % (define %
(class object% (class object%
@ -68,7 +70,7 @@
(let ([menu (get-windows-menu frame)]) (let ([menu (get-windows-menu frame)])
(when menu (when menu
;; to help the (conservative) gc. ;; to help the gc.
(for-each (λ (i) (send i delete)) (send menu get-items)) (for-each (λ (i) (send i delete)) (send menu get-items))
(set! windows-menus (set! windows-menus
@ -77,7 +79,7 @@
windows-menus windows-menus
eq?))))) eq?)))))
(define/private (update-windows-menus) (define/public (update-windows-menu menu)
(let* ([windows (length windows-menus)] (let* ([windows (length windows-menus)]
[default-name (string-constant untitled)] [default-name (string-constant untitled)]
[get-name [get-name
@ -97,49 +99,46 @@
(λ (f1 f2) (λ (f1 f2)
(string-ci<=? (get-name (frame-frame f1)) (string-ci<=? (get-name (frame-frame f1))
(get-name (frame-frame f2)))))]) (get-name (frame-frame f2)))))])
(for-each (for-each (λ (item) (send item delete)) (send menu get-items))
(λ (menu) (when (eq? (system-type) 'macosx)
(for-each (λ (item) (send item delete)) (send menu get-items)) (new menu:can-restore-menu-item%
(when (eq? (system-type) 'macosx) [label (string-constant minimize)]
(new menu:can-restore-menu-item% [parent menu]
[label (string-constant minimize)] [callback (λ (x y) (send (send (send menu get-parent) get-frame) iconize #t))]
[parent menu] [shortcut #\m])
[callback (λ (x y) (send (send (send menu get-parent) get-frame) iconize #t))] (new menu:can-restore-menu-item%
[shortcut #\m]) [label (string-constant zoom)]
(new menu:can-restore-menu-item% [parent menu]
[label (string-constant zoom)] [callback (λ (x y)
[parent menu] (let ([frame (send (send menu get-parent) get-frame)])
[callback (λ (x y) (send frame maximize (not (send frame is-maximized?)))))])
(let ([frame (send (send menu get-parent) get-frame)]) (instantiate menu:can-restore-menu-item% ()
(send frame maximize (not (send frame is-maximized?)))))]) (label (string-constant bring-frame-to-front...))
(instantiate menu:can-restore-menu-item% () (parent menu)
(label (string-constant bring-frame-to-front...)) (callback (λ (x y) (choose-a-frame (send (send menu get-parent) get-frame))))
(parent menu) (shortcut #\j))
(callback (λ (x y) (choose-a-frame (send (send menu get-parent) get-frame)))) (instantiate menu:can-restore-menu-item% ()
(shortcut #\j)) (label (string-constant most-recent-window))
(instantiate menu:can-restore-menu-item% () (parent menu)
(label (string-constant most-recent-window)) (callback (λ (x y) (most-recent-window-to-front)))
(parent menu) (shortcut #\'))
(callback (λ (x y) (most-recent-window-to-front))) (make-object separator-menu-item% menu))
(shortcut #\'))
(make-object separator-menu-item% menu)) (extra-windows-menus-proc menu)
(extra-windows-menus-proc menu) (when (eq? (system-type) 'macosx)
(for-each
(when (eq? (system-type) 'macosx) (λ (frame)
(for-each (let ([frame (frame-frame frame)])
(λ (frame) (make-object menu-item%
(let ([frame (frame-frame frame)]) (regexp-replace*
(make-object menu-item% #rx"&"
(regexp-replace* (gui-utils:trim-string (get-name frame) 200)
#rx"&" "&&")
(gui-utils:trim-string (get-name frame) 200) menu
"&&") (λ (_1 _2)
menu (send frame show #t)))))
(λ (_1 _2) sorted/visible-frames))))
(send frame show #t)))))
sorted/visible-frames)))
windows-menus)))
;; most-recent-window-to-front : -> void? ;; most-recent-window-to-front : -> void?
;; brings the most recent window to the front ;; brings the most recent window to the front
@ -174,12 +173,10 @@
(define/public (get-frames) (map frame-frame frames)) (define/public (get-frames) (map frame-frame frames))
(define/public (frame-label-changed frame) (define/public (frame-label-changed frame)
(when (memq frame (map frame-frame frames)) (void))
(update-windows-menus)))
(define/public (frame-shown/hidden frame) (define/public (frame-shown/hidden frame)
(when (memq frame (map frame-frame frames)) (void))
(update-windows-menus)))
(define/public (for-each-frame f) (define/public (for-each-frame f)
(for-each (λ (x) (f (frame-frame x))) frames) (for-each (λ (x) (f (frame-frame x))) frames)
@ -207,8 +204,7 @@
frames)]) frames)])
(set! frames new-frames) (set! frames new-frames)
(update-close-menu-item-state) (update-close-menu-item-state)
(insert-windows-menu new-frame) (insert-windows-menu new-frame))
(update-windows-menus))
(todo-to-new-frames new-frame))) (todo-to-new-frames new-frame)))
(define/public (remove-frame f) (define/public (remove-frame f)
@ -220,8 +216,7 @@
(λ (f fr) (eq? f (frame-frame fr))))]) (λ (f fr) (eq? f (frame-frame fr))))])
(set! frames new-frames) (set! frames new-frames)
(update-close-menu-item-state) (update-close-menu-item-state)
(remove-windows-menu f) (remove-windows-menu f)))
(update-windows-menus)))
(define/public (clear) (define/public (clear)
(set! frames null) (set! frames null)
@ -261,6 +256,12 @@
(loop (cdr frames))))])))) (loop (cdr frames))))]))))
(super-new))) (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) (define (can-close-check)
(let ([number-of-frames (length (send (get-the-frame-group) get-frames))]) (let ([number-of-frames (length (send (get-the-frame-group) get-frames))])

3
collects/framework/private/sig.rkt
View File

@ -318,7 +318,8 @@
(get-the-frame-group (get-the-frame-group
on-close-action on-close-action
can-close-check can-close-check
add-to-windows-menu)) add-to-windows-menu
create-windows-menu))
(define-signature handler-class^ (define-signature handler-class^
()) ())