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)])
(when frame
(send frame next-tab))))])
(let ([frame (find-frame windows-menu)])
(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))]
#:when (< i 9))
(new menu-item%
@ -683,7 +686,9 @@
[callback
(λ (a b)
(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.
;; Ignore the framework's empty frames test, since

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

@ -44,7 +44,8 @@
items))
(let* ([file-menu (find-menu (string-constant file-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))]
[other-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))))
(let ([mb (make-object (get-menu-bar%) this)])
(when (or (eq? (system-type) 'macos)
(eq? (system-type) 'macosx))
(make-object menu:can-restore-underscore-menu% (string-constant windows-menu-label)
mb)))
(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)

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

@ -30,6 +30,11 @@
(f menu)
(old menu)))))
(define windows-menu-label
(case (system-type)
[(macosx) (string-constant windows-menu-label)]
[else (string-constant tabs-menu-label)]))
(define %
(class object%
@ -47,8 +52,10 @@
(and menu-bar
(let ([menus (send menu-bar get-items)])
(ormap (λ (x)
(if (string=? (string-constant windows-menu)
(if (or (string=? (string-constant windows-menu)
(send x get-plain-label))
(string=? (string-constant tabs-menu)
(send x get-plain-label)))
x
#f))
menus)))))
@ -105,7 +112,7 @@
[parent menu]
[callback (λ (x y)
(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% ()
(label (string-constant bring-frame-to-front...))
(parent menu)
@ -116,10 +123,11 @@
(parent menu)
(callback (λ (x y) (most-recent-window-to-front)))
(shortcut #\'))
(make-object separator-menu-item% menu)
(make-object separator-menu-item% menu))
(extra-windows-menus-proc menu)
(when (eq? (system-type) 'macosx)
(for-each
(λ (frame)
(let ([frame (frame-frame frame)])
@ -131,7 +139,7 @@
menu
(λ (_1 _2)
(send frame show #t)))))
sorted/visible-frames))
sorted/visible-frames)))
windows-menus)))
;; 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")
(help-menu "Help")
(windows-menu "Windows")
(tabs-menu "Tabs") ;; this is the name of the "Windows" menu under linux & windows
;;; menus
;;; - in menu labels, the & indicates a alt-key based shortcut.
@ -730,6 +731,7 @@ please adhere to these guidelines:
;; windows menu
(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
(zoom "Zoom")
(bring-frame-to-front "Bring Frame to Front") ;;; title of dialog