Add support to the show menu item to make ordering the items
simpler. Use that support to adjust the Show menu to have a better ordering for the built-in DrRacket items.
This commit is contained in:
Robby Findler
parent
83bae29b21
commit
70fac182c6
|
|
@ -1579,7 +1579,7 @@ profile todo:
|
|||
(define profile-unit-frame-mixin
|
||||
(mixin (drracket:unit:frame<%> drracket:frame:<%>) ()
|
||||
|
||||
(inherit get-interactions-text get-current-tab)
|
||||
(inherit get-interactions-text get-current-tab set-show-menu-sort-key)
|
||||
|
||||
;; update-shown : -> void
|
||||
;; updates the state of the profile item's show menu
|
||||
|
|
@ -1600,7 +1600,8 @@ profile todo:
|
|||
(parent show-menu)
|
||||
(callback
|
||||
(λ (x y)
|
||||
(show-profile-menu-callback))))))
|
||||
(show-profile-menu-callback)))))
|
||||
(set-show-menu-sort-key show-profile-menu-item 207))
|
||||
|
||||
(define show-profile-menu-item #f)
|
||||
(define profile-gui-constructed? #f)
|
||||
|
|
|
|||
|
|
@ -628,10 +628,74 @@
|
|||
(define/public get-show-menu (λ () show-menu))
|
||||
(define/public update-shown (λ () (void)))
|
||||
(define/public (add-show-menu-items show-menu) (void))
|
||||
(define sort-menu-sort-keys (make-hasheq))
|
||||
(define/public (set-show-menu-sort-key item val)
|
||||
(cond
|
||||
[sort-menu-sort-keys
|
||||
(for ([(k v) (in-hash sort-menu-sort-keys)])
|
||||
(when (eq? k item)
|
||||
(error 'set-show-menu-sort-key
|
||||
"set menu item ~s twice, to ~s and ~s"
|
||||
(send item get-label)
|
||||
v val))
|
||||
(when (= v val)
|
||||
(error 'set-show-menu-sort-key
|
||||
"two menu items have the same val: ~s and ~s"
|
||||
(send k get-label)
|
||||
(send item get-label))))
|
||||
(hash-set! sort-menu-sort-keys item val)]
|
||||
[else
|
||||
(error 'set-show-menu-sort-key
|
||||
"the sort menu has already been created and its order has been set")]))
|
||||
(super-new)
|
||||
(set! show-menu (make-object (get-menu%) (string-constant view-menu-label)
|
||||
(get-menu-bar)))
|
||||
(add-show-menu-items show-menu)))
|
||||
(add-show-menu-items show-menu)
|
||||
(sort-show-menu-items show-menu sort-menu-sort-keys)
|
||||
(set! sort-menu-sort-keys #f)))
|
||||
|
||||
(define (sort-show-menu-items show-menu show-menu-sort-keys)
|
||||
(define items (send show-menu get-items))
|
||||
(for ([itm (in-list items)])
|
||||
(send itm delete))
|
||||
(define (get-key item)
|
||||
(hash-ref show-menu-sort-keys item
|
||||
(λ ()
|
||||
(define lab
|
||||
(cond
|
||||
[(is-a? item labelled-menu-item<%>)
|
||||
(send item get-label)]
|
||||
[else ""]))
|
||||
(cond
|
||||
[(regexp-match #rx"^Show (.*)$" lab)
|
||||
=> (λ (x) (list-ref x 1))]
|
||||
[(regexp-match #rx"^Hide (.*)$" lab)
|
||||
=> (λ (x) (list-ref x 1))]
|
||||
[else lab]))))
|
||||
(define (cmp item-x item-y)
|
||||
(define x (get-key item-x))
|
||||
(define y (get-key item-y))
|
||||
(cond
|
||||
[(and (number? x) (number? y)) (< x y)]
|
||||
[(and (string? x) (string? y)) (string<=? x y)]
|
||||
[(and (number? x) (string? y)) #t]
|
||||
[(and (string? x) (number? y)) #f]))
|
||||
(define sorted-items (sort items cmp))
|
||||
(for ([item (in-list sorted-items)]
|
||||
[next-item (in-list (append (cdr sorted-items) (list #f)))])
|
||||
(define item-key (get-key item))
|
||||
(define next-item-key (and next-item (get-key next-item)))
|
||||
(define add-sep?
|
||||
(cond
|
||||
[(and (number? item-key) (number? next-item-key))
|
||||
(not (= (quotient item-key 100) (quotient next-item-key 100)))]
|
||||
[(or (and (string? item-key) (string? next-item-key))
|
||||
(not next-item-key))
|
||||
#f]
|
||||
[else #t]))
|
||||
(send item restore)
|
||||
(when add-sep?
|
||||
(new separator-menu-item% [parent show-menu]))))
|
||||
|
||||
|
||||
(define (create-root-menubar)
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@ remain the same for tools that use them.
|
|||
(interface (frame:editor<%> frame:basics<%> frame:text-info<%>)
|
||||
get-show-menu
|
||||
update-shown
|
||||
add-show-menu-items))
|
||||
add-show-menu-items
|
||||
set-show-menu-sort-key))
|
||||
|
||||
(define unit:frame<%>
|
||||
(interface (frame:<%>
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@
|
|||
|
||||
(define frame-mixin
|
||||
(mixin (drracket:frame:<%> drracket:unit:frame<%>) ()
|
||||
(inherit get-current-tab)
|
||||
(inherit get-current-tab set-show-menu-sort-key)
|
||||
(define show-tracing-menu-item #f)
|
||||
(define tracing-visible? #f)
|
||||
|
||||
|
|
@ -183,7 +183,8 @@
|
|||
(new menu-item%
|
||||
(parent show-menu)
|
||||
(label (string-constant tracing-show-tracing-window))
|
||||
(callback (lambda (x y) (toggle-tracing))))))
|
||||
(callback (lambda (x y) (toggle-tracing)))))
|
||||
(set-show-menu-sort-key show-tracing-menu-item 206))
|
||||
|
||||
(define/public (show-tracing)
|
||||
(set! tracing-visible? #t)
|
||||
|
|
|
|||
|
|
@ -3190,7 +3190,8 @@ module browser threading seems wrong.
|
|||
(define/public (get-definitions/interactions-panel-parent)
|
||||
toolbar/rest-panel)
|
||||
|
||||
(inherit delegated-text-shown? hide-delegated-text show-delegated-text)
|
||||
(inherit delegated-text-shown? hide-delegated-text show-delegated-text
|
||||
set-show-menu-sort-key)
|
||||
(define/override (add-show-menu-items show-menu)
|
||||
(super add-show-menu-items show-menu)
|
||||
(set! definitions-item
|
||||
|
|
@ -3202,6 +3203,7 @@ module browser threading seems wrong.
|
|||
(update-shown))
|
||||
#\d
|
||||
(string-constant definitions-menu-item-help-string)))
|
||||
(set-show-menu-sort-key definitions-item 101)
|
||||
(set! interactions-item
|
||||
(make-object menu:can-restore-menu-item%
|
||||
(string-constant show-interactions-menu-item-label)
|
||||
|
|
@ -3211,49 +3213,52 @@ module browser threading seems wrong.
|
|||
(update-shown))
|
||||
#\e
|
||||
(string-constant interactions-menu-item-help-string)))
|
||||
(set-show-menu-sort-key interactions-item 102)
|
||||
|
||||
(new menu:can-restore-menu-item%
|
||||
[label (string-constant use-horizontal-layout)]
|
||||
[parent (get-show-menu)]
|
||||
[callback (λ (x y)
|
||||
(define vertical? (send resizable-panel get-vertical?))
|
||||
(preferences:set 'drracket:defs/ints-horizontal vertical?)
|
||||
(send resizable-panel set-orientation vertical?)
|
||||
(define update-shown? (or (not interactions-shown?)
|
||||
(not definitions-shown?)))
|
||||
(unless interactions-shown?
|
||||
(toggle-show/hide-interactions))
|
||||
(unless definitions-shown?
|
||||
(toggle-show/hide-definitions))
|
||||
(when update-shown?
|
||||
(update-shown)))]
|
||||
[demand-callback
|
||||
(λ (mi) (send mi set-label (if (send resizable-panel get-vertical?)
|
||||
(string-constant use-horizontal-layout)
|
||||
(string-constant use-vertical-layout))))]
|
||||
[shortcut #\l]
|
||||
[shortcut-prefix (cons 'shift (get-default-shortcut-prefix))])
|
||||
(let ([layout-item
|
||||
(new menu:can-restore-menu-item%
|
||||
[label (string-constant use-horizontal-layout)]
|
||||
[parent (get-show-menu)]
|
||||
[callback (λ (x y)
|
||||
(define vertical? (send resizable-panel get-vertical?))
|
||||
(preferences:set 'drracket:defs/ints-horizontal vertical?)
|
||||
(send resizable-panel set-orientation vertical?)
|
||||
(define update-shown? (or (not interactions-shown?)
|
||||
(not definitions-shown?)))
|
||||
(unless interactions-shown?
|
||||
(toggle-show/hide-interactions))
|
||||
(unless definitions-shown?
|
||||
(toggle-show/hide-definitions))
|
||||
(when update-shown?
|
||||
(update-shown)))]
|
||||
[demand-callback
|
||||
(λ (mi) (send mi set-label (if (send resizable-panel get-vertical?)
|
||||
(string-constant use-horizontal-layout)
|
||||
(string-constant use-vertical-layout))))]
|
||||
[shortcut #\l]
|
||||
[shortcut-prefix (cons 'shift (get-default-shortcut-prefix))])])
|
||||
(set-show-menu-sort-key layout-item 103))
|
||||
|
||||
(new separator-menu-item% [parent (get-show-menu)])
|
||||
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut #\u)
|
||||
(label
|
||||
(if (delegated-text-shown?)
|
||||
(string-constant hide-overview)
|
||||
(string-constant show-overview)))
|
||||
(parent (get-show-menu))
|
||||
(callback
|
||||
(λ (menu evt)
|
||||
(if (delegated-text-shown?)
|
||||
(begin
|
||||
(send menu set-label (string-constant show-overview))
|
||||
(preferences:set 'framework:show-delegate? #f)
|
||||
(hide-delegated-text))
|
||||
(begin
|
||||
(send menu set-label (string-constant hide-overview))
|
||||
(preferences:set 'framework:show-delegate? #t)
|
||||
(show-delegated-text))))))
|
||||
(let ([overview-menu-item
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut #\u)
|
||||
(label
|
||||
(if (delegated-text-shown?)
|
||||
(string-constant hide-overview)
|
||||
(string-constant show-overview)))
|
||||
(parent (get-show-menu))
|
||||
(callback
|
||||
(λ (menu evt)
|
||||
(if (delegated-text-shown?)
|
||||
(begin
|
||||
(send menu set-label (string-constant show-overview))
|
||||
(preferences:set 'framework:show-delegate? #f)
|
||||
(hide-delegated-text))
|
||||
(begin
|
||||
(send menu set-label (string-constant hide-overview))
|
||||
(preferences:set 'framework:show-delegate? #t)
|
||||
(show-delegated-text))))))])
|
||||
(set-show-menu-sort-key overview-menu-item 301))
|
||||
|
||||
(set! module-browser-menu-item
|
||||
(new menu:can-restore-menu-item%
|
||||
|
|
@ -3266,10 +3271,12 @@ module browser threading seems wrong.
|
|||
(if module-browser-shown?
|
||||
(hide-module-browser)
|
||||
(show-module-browser))))))
|
||||
(set-show-menu-sort-key module-browser-menu-item 401)
|
||||
|
||||
(set! toolbar-menu (new menu%
|
||||
[parent show-menu]
|
||||
[label (string-constant toolbar)]))
|
||||
(set-show-menu-sort-key toolbar-menu 1)
|
||||
(set! toolbar-left-menu-item
|
||||
(new checkable-menu-item%
|
||||
[label (string-constant toolbar-on-left)]
|
||||
|
|
@ -3300,7 +3307,43 @@ module browser threading seems wrong.
|
|||
[label (string-constant show-log)]
|
||||
[parent show-menu]
|
||||
[callback
|
||||
(λ (x y) (send current-tab toggle-log))])))
|
||||
(λ (x y) (send current-tab toggle-log))]))
|
||||
(set-show-menu-sort-key logger-menu-item 205)
|
||||
|
||||
|
||||
|
||||
|
||||
(set! show-line-numbers-menu-item
|
||||
(new menu:can-restore-menu-item%
|
||||
[label (if (show-line-numbers?)
|
||||
(string-constant hide-line-numbers/menu)
|
||||
(string-constant show-line-numbers/menu))]
|
||||
[parent (get-show-menu)]
|
||||
[callback (lambda (self event)
|
||||
(define value (preferences:get 'drracket:show-line-numbers?))
|
||||
(preferences:set 'drracket:show-line-numbers? (not value))
|
||||
(show-line-numbers! (not value)))]))
|
||||
(set-show-menu-sort-key show-line-numbers-menu-item 302)
|
||||
|
||||
(let ([split
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut (if (eq? (system-type) 'macosx) #f #\m))
|
||||
(label (string-constant split-menu-item-label))
|
||||
(parent (get-show-menu))
|
||||
(callback (λ (x y) (split)))
|
||||
(demand-callback (λ (item) (split-demand item))))]
|
||||
[collapse
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut (if (eq? (system-type) 'macosx) #f #\m))
|
||||
(shortcut-prefix (if (eq? (system-type) 'macosx)
|
||||
(get-default-shortcut-prefix)
|
||||
(cons 'shift (get-default-shortcut-prefix))))
|
||||
(label (string-constant collapse-menu-item-label))
|
||||
(parent (get-show-menu))
|
||||
(callback (λ (x y) (collapse)))
|
||||
(demand-callback (λ (item) (collapse-demand item))))])
|
||||
(set-show-menu-sort-key split 2)
|
||||
(set-show-menu-sort-key collapse 3)))
|
||||
|
||||
|
||||
;
|
||||
|
|
@ -4082,35 +4125,6 @@ module browser threading seems wrong.
|
|||
has-editor-on-demand)
|
||||
(register-capability-menu-item 'drscheme:special:insert-lambda insert-menu))
|
||||
|
||||
(set! show-line-numbers-menu-item
|
||||
(new menu:can-restore-menu-item%
|
||||
[label (if (show-line-numbers?)
|
||||
(string-constant hide-line-numbers/menu)
|
||||
(string-constant show-line-numbers/menu))]
|
||||
[parent (get-show-menu)]
|
||||
[callback (lambda (self event)
|
||||
(define value (preferences:get 'drracket:show-line-numbers?))
|
||||
(preferences:set 'drracket:show-line-numbers? (not value))
|
||||
(show-line-numbers! (not value)))]))
|
||||
|
||||
(make-object separator-menu-item% (get-show-menu))
|
||||
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut (if (eq? (system-type) 'macosx) #f #\m))
|
||||
(label (string-constant split-menu-item-label))
|
||||
(parent (get-show-menu))
|
||||
(callback (λ (x y) (split)))
|
||||
(demand-callback (λ (item) (split-demand item))))
|
||||
(new menu:can-restore-menu-item%
|
||||
(shortcut (if (eq? (system-type) 'macosx) #f #\m))
|
||||
(shortcut-prefix (if (eq? (system-type) 'macosx)
|
||||
(get-default-shortcut-prefix)
|
||||
(cons 'shift (get-default-shortcut-prefix))))
|
||||
(label (string-constant collapse-menu-item-label))
|
||||
(parent (get-show-menu))
|
||||
(callback (λ (x y) (collapse)))
|
||||
(demand-callback (λ (item) (collapse-demand item))))
|
||||
|
||||
(frame:reorder-menus this)))
|
||||
|
||||
(define/public (jump-to-previous-error-loc)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
#lang scribble/doc
|
||||
@(require "common.rkt")
|
||||
@(require "common.rkt" scribble/core)
|
||||
@(tools-title "frame")
|
||||
|
||||
@defclass[drracket:frame:name-message% canvas% ()]{
|
||||
|
|
@ -191,27 +191,69 @@ This interface is the result of the @racket[drracket:frame:basics-mixin]
|
|||
void?]{
|
||||
@methspec{
|
||||
|
||||
This method is called during the construction of the view
|
||||
menu. This method is intended to be overridden. It is
|
||||
expected to add other Show/Hide menu items to the show menu.
|
||||
This method is called during the construction of the @onscreen{View}
|
||||
menu. This method is intended to be overridden with the
|
||||
overriding methods adding other Show/Hide menu items to the @onscreen{View}
|
||||
menu.
|
||||
|
||||
See also
|
||||
@method[drracket:frame:<%> set-show-menu-sort-key] and
|
||||
@method[drracket:frame:<%> get-show-menu].
|
||||
|
||||
}
|
||||
@methimpl{
|
||||
|
||||
Does nothing.
|
||||
|
||||
|
||||
|
||||
Does nothing.
|
||||
}}
|
||||
|
||||
@defmethod[(set-show-menu-sort-key [item (is-a?/c menu-item<%>)]
|
||||
[key (and/c real? positive?)])
|
||||
void?]{
|
||||
Controls the ordering of items in the @onscreen{View} menu.
|
||||
|
||||
The number determines the sorting order and where separators in the menu appear
|
||||
(smaller numbers first).
|
||||
|
||||
These are the numbers for many of the @onscreen{View} menu items that come
|
||||
built-in to DrRacket:
|
||||
@table[(style #f '())
|
||||
(let ()
|
||||
(define (add-blocks lol)
|
||||
(for/list ([strs (in-list lol)])
|
||||
(for/list ([str (in-list (reverse strs))]
|
||||
[i (in-naturals)])
|
||||
@paragraph[(style #f '())
|
||||
(if (zero? i)
|
||||
(list str "\ua0\ua0\ua0\ua0\ua0")
|
||||
str)])))
|
||||
(add-blocks
|
||||
(list (list @racket[1] @onscreen{Toolbar})
|
||||
(list @racket[2] @onscreen{Split})
|
||||
(list @racket[3] @onscreen{Collapse})
|
||||
(list @racket[101] @onscreen{Show Definitions})
|
||||
(list @racket[102] @onscreen{Show Interactions})
|
||||
(list @racket[103] @onscreen{Use Horizontal Layout})
|
||||
(list @racket[205] @onscreen{Show Log})
|
||||
(list @racket[206] @onscreen{Show Tracing})
|
||||
(list @racket[207] @onscreen{Hide Profile})
|
||||
(list @racket[301] @onscreen{Show Program Contour})
|
||||
(list @racket[302] @onscreen{Show Line Numbers})
|
||||
(list @racket[401] @onscreen{Show Module Browser}))))]
|
||||
|
||||
In addition, a separator is inserted for each 100. So, for example,
|
||||
a separator is inserted between @onscreen{Collapse} and
|
||||
@onscreen{Show Definitions}.
|
||||
|
||||
Note that the argument may be a rational number,
|
||||
effectively allowing insertion between any two menu items already in the menu.
|
||||
For this reason, avoid using @racket[0], or any number is that @racket[0]
|
||||
modulo @racket[100].
|
||||
|
||||
}
|
||||
|
||||
@defmethod[(get-show-menu)
|
||||
(is-a?/c menu%)]{
|
||||
@index{View menu}
|
||||
|
||||
returns the view menu, for use by the
|
||||
returns the @onscreen{View} menu, for use by the
|
||||
@method[drracket:frame:<%> update-shown] method.
|
||||
|
||||
See also
|
||||
|
|
@ -219,7 +261,7 @@ See also
|
|||
|
||||
The method (and others) uses the word @tt{show} to preserve
|
||||
backwards compatibility from when the menu itself was named
|
||||
the Show menu.
|
||||
the @onscreen{Show} menu.
|
||||
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user