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

added a tabs menu for windows (and linux)

Browse Source 
original commit: dd081d9b4e50617580c6fc286a08aa7ebad38b7a
This commit is contained in:
Robby Findler 2010-12-07 14:29:54 -06:00
commit b73c80f3c2
2 changed files with 41 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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)

60
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)
(send x get-plain-label))
(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,33 +112,34 @@
[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)
(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)
(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))
(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)))
;; most-recent-window-to-front : -> void?