...
original commit: 1e4ffd7e2918ab181efda30adeef60a663a120e2
This commit is contained in:
parent
d51a5b07dc
commit
0065eb43c5
|
@ -21,6 +21,33 @@
|
||||||
[-text% text%]
|
[-text% text%]
|
||||||
[-text<%> text<%>])
|
[-text<%> text<%>])
|
||||||
|
|
||||||
|
(define (reorder-menus frame)
|
||||||
|
(let* ([items (send (send frame get-menu-bar) get-items)]
|
||||||
|
[move-to-back
|
||||||
|
(lambda (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
|
||||||
|
(lambda (name items)
|
||||||
|
(reverse (move-to-back name (reverse items))))]
|
||||||
|
[re-ordered
|
||||||
|
(move-to-front
|
||||||
|
"File"
|
||||||
|
(move-to-front
|
||||||
|
"Edit"
|
||||||
|
(move-to-back
|
||||||
|
"Help"
|
||||||
|
items)))])
|
||||||
|
(for-each (lambda (item) (send item delete)) items)
|
||||||
|
(for-each (lambda (item) (send item restore)) re-ordered)))
|
||||||
|
|
||||||
(define frame-width 600)
|
(define frame-width 600)
|
||||||
(define frame-height 650)
|
(define frame-height 650)
|
||||||
(let ([window-trimming-upper-bound-width 20]
|
(let ([window-trimming-upper-bound-width 20]
|
||||||
|
@ -84,6 +111,7 @@
|
||||||
[else style])))
|
[else style])))
|
||||||
|
|
||||||
(make-object menu% "Windows" (make-object (get-menu-bar%) this))
|
(make-object menu% "Windows" (make-object (get-menu-bar%) this))
|
||||||
|
(reorder-menus this)
|
||||||
(send (group:get-the-frame-group) insert-frame this))
|
(send (group:get-the-frame-group) insert-frame this))
|
||||||
(private
|
(private
|
||||||
[panel (make-root-area-container (get-area-container%) this)])
|
[panel (make-root-area-container (get-area-container%) this)])
|
||||||
|
|
|
@ -140,7 +140,9 @@
|
||||||
wide-snip%))
|
wide-snip%))
|
||||||
|
|
||||||
(define-signature framework:frame^
|
(define-signature framework:frame^
|
||||||
(basic<%>
|
(reorder-menus
|
||||||
|
|
||||||
|
basic<%>
|
||||||
basic-mixin
|
basic-mixin
|
||||||
|
|
||||||
standard-menus<%>
|
standard-menus<%>
|
||||||
|
|
|
@ -148,7 +148,8 @@ string=? ; exec mred -mgaqvf $0
|
||||||
[(an-item? x) (build-item-menu-clause x)]
|
[(an-item? x) (build-item-menu-clause x)]
|
||||||
[(after? x) (build-after-menu-clause x)]
|
[(after? x) (build-after-menu-clause x)]
|
||||||
[(generic? x) (build-generic-clause x)]))
|
[(generic? x) (build-generic-clause x)]))
|
||||||
items))))
|
items)
|
||||||
|
(list `(sequence (reorder-menus this))))))
|
||||||
port))
|
port))
|
||||||
'text
|
'text
|
||||||
'truncate)
|
'truncate)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user