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

added a tabs menu for windows (and linux)

Browse Source
This commit is contained in:
Robby Findler 2010-12-07 14:29:54 -06:00
parent 823da4321f
commit dd081d9b4e
4 changed files with 50 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/drracket/private/main.rkt
View File

@ -670,8 +670,11 @@
(let ([frame (find-frame item)]) (let ([frame (find-frame item)])
(when frame (when frame
(send frame next-tab))))]) (send frame next-tab))))])
(let ([frame (find-frame windows-menu)]) (let ([frame (find-frame windows-menu)])
(unless (or (not frame) (= 1 (send frame get-tab-count))) (unless (or (not frame) (= 1 (send frame get-tab-count)))
(unless (eq? (system-type) 'macosx)
(new separator-menu-item% [parent windows-menu]))
(for ([i (in-range 0 (send frame get-tab-count))] (for ([i (in-range 0 (send frame get-tab-count))]
#:when (< i 9)) #:when (< i 9))
(new menu-item% (new menu-item%
@ -683,7 +686,9 @@
[callback [callback
(λ (a b) (λ (a b)
(send frame change-to-nth-tab i))])))) (send frame change-to-nth-tab i))]))))
(new separator-menu-item% [parent windows-menu]))))
(when (eq? (system-type) 'macosx)
(new separator-menu-item% [parent windows-menu])))))
;; Check for any files lost last time. ;; Check for any files lost last time.
;; Ignore the framework's empty frames test, since ;; Ignore the framework's empty frames test, since

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

@ -44,7 +44,8 @@
items)) items))
(let* ([file-menu (find-menu (string-constant file-menu))] (let* ([file-menu (find-menu (string-constant file-menu))]
[edit-menu (find-menu (string-constant edit-menu))] [edit-menu (find-menu (string-constant edit-menu))]
[windows-menu (find-menu (string-constant windows-menu))] [windows-menu (or (find-menu (string-constant windows-menu))
(find-menu (string-constant tabs-menu)))]
[help-menu (find-menu (string-constant help-menu))] [help-menu (find-menu (string-constant help-menu))]
[other-items [other-items
(remq* (list file-menu edit-menu windows-menu help-menu) items)] (remq* (list file-menu edit-menu windows-menu help-menu) items)]
@ -212,10 +213,11 @@
(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)]) (let ([mb (make-object (get-menu-bar%) this)])
(when (or (eq? (system-type) 'macos) (make-object menu:can-restore-underscore-menu%
(eq? (system-type) 'macosx)) (case (system-type)
(make-object menu:can-restore-underscore-menu% (string-constant windows-menu-label) [(macosx) (string-constant windows-menu-label)]
mb))) [else (string-constant tabs-menu-label)])
mb))
(reorder-menus this) (reorder-menus this)

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

@ -30,6 +30,11 @@
(f menu) (f menu)
(old menu))))) (old menu)))))
(define windows-menu-label
(case (system-type)
[(macosx) (string-constant windows-menu-label)]
[else (string-constant tabs-menu-label)]))
(define % (define %
(class object% (class object%
@ -47,8 +52,10 @@
(and menu-bar (and menu-bar
(let ([menus (send menu-bar get-items)]) (let ([menus (send menu-bar get-items)])
(ormap (λ (x) (ormap (λ (x)
(if (string=? (string-constant windows-menu) (if (or (string=? (string-constant windows-menu)
(send x get-plain-label)) (send x get-plain-label))
(string=? (string-constant tabs-menu)
(send x get-plain-label)))
x x
#f)) #f))
menus))))) menus)))))
@ -105,7 +112,7 @@
[parent menu] [parent menu]
[callback (λ (x y) [callback (λ (x y)
(let ([frame (send (send menu get-parent) get-frame)]) (let ([frame (send (send menu get-parent) get-frame)])
(send frame maximize (not (send frame is-maximized?)))))])) (send frame maximize (not (send frame is-maximized?)))))])
(instantiate menu:can-restore-menu-item% () (instantiate menu:can-restore-menu-item% ()
(label (string-constant bring-frame-to-front...)) (label (string-constant bring-frame-to-front...))
(parent menu) (parent menu)
@ -116,10 +123,11 @@
(parent menu) (parent menu)
(callback (λ (x y) (most-recent-window-to-front))) (callback (λ (x y) (most-recent-window-to-front)))
(shortcut #\')) (shortcut #\'))
(make-object separator-menu-item% menu) (make-object separator-menu-item% menu))
(extra-windows-menus-proc menu) (extra-windows-menus-proc menu)
(when (eq? (system-type) 'macosx)
(for-each (for-each
(λ (frame) (λ (frame)
(let ([frame (frame-frame frame)]) (let ([frame (frame-frame frame)])
@ -131,7 +139,7 @@
menu menu
(λ (_1 _2) (λ (_1 _2)
(send frame show #t))))) (send frame show #t)))))
sorted/visible-frames)) sorted/visible-frames)))
windows-menus))) windows-menus)))
;; most-recent-window-to-front : -> void? ;; most-recent-window-to-front : -> void?

2
collects/string-constants/english-string-constants.rkt
View File

@ -599,6 +599,7 @@ please adhere to these guidelines:
(edit-menu "Edit") (edit-menu "Edit")
(help-menu "Help") (help-menu "Help")
(windows-menu "Windows") (windows-menu "Windows")
(tabs-menu "Tabs") ;; this is the name of the "Windows" menu under linux & windows
;;; menus ;;; menus
;;; - in menu labels, the & indicates a alt-key based shortcut. ;;; - in menu labels, the & indicates a alt-key based shortcut.
@ -730,6 +731,7 @@ please adhere to these guidelines:
;; windows menu ;; windows menu
(windows-menu-label "&Windows") (windows-menu-label "&Windows")
(tabs-menu-label "&Tabs") ;; this is the name of the menu under linux & windows
(minimize "Minimize") ;; minimize and zoom are only used under mac os x (minimize "Minimize") ;; minimize and zoom are only used under mac os x
(zoom "Zoom") (zoom "Zoom")
(bring-frame-to-front "Bring Frame to Front") ;;; title of dialog (bring-frame-to-front "Bring Frame to Front") ;;; title of dialog