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

* Remove a bunch of additional stuff from the bug-report menu

Browse Source 
* Rewrote `reorder-menus' to remove menus that are left empty
* Solves PR7360

svn: r3052

original commit: 9ae090e45b9f29fe756a3f7795550037dc043970
This commit is contained in:
Eli Barzilay 2006-05-24 23:01:45 +00:00
parent b259e75244
commit a9ec4a2668
1 changed files with 16 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
collects/framework/private/frame.ss
View File

@ -33,40 +33,29 @@
[scheme : framework:scheme^]
[exit : framework:exit^]
[comment-box : framework:comment-box^])
(rename [-editor<%> editor<%>]
[-pasteboard% pasteboard%]
[-text% text%])
(define (reorder-menus frame)
(let* ([items (send (send frame get-menu-bar) get-items)]
[move-to-back
(λ (name items)
(let loop ([items items]
[back null])
(cond
[(null? items) back]
[else (let ([item (car items)])
(if (string=? (send item get-plain-label) name)
(loop (cdr items)
(cons item back))
(cons item (loop (cdr items) back))))])))]
[move-to-front
(λ (name items)
(reverse (move-to-back name (reverse items))))]
[re-ordered
(move-to-front
(string-constant file-menu)
(move-to-front
(string-constant edit-menu)
(move-to-back
(string-constant help-menu)
(move-to-back
(string-constant windows-menu)
items))))])
(define items (send (send frame get-menu-bar) get-items))
(define (find-menu name)
(ormap (λ (i) (and (string=? (send i get-plain-label) name) i))
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))]
[help-menu (find-menu (string-constant help-menu))]
[other-items
(remq* (list file-menu edit-menu windows-menu help-menu) items)]
[? (λ (menu) (and menu (pair? (send menu get-items)) menu))]
[re-ordered (filter values `(,(? file-menu) ,(? edit-menu)
,@other-items
,(? windows-menu) ,(? help-menu)))])
(for-each (λ (item) (send item delete)) items)
(for-each (λ (item) (send item restore)) re-ordered)))
(define (add-snip-menu-items edit-menu c%)
(let* ([get-edit-target-object
(λ ()