diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt index 310c194412..358c231a3f 100644 --- a/collects/drracket/private/debug.rkt +++ b/collects/drracket/private/debug.rkt @@ -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) diff --git a/collects/drracket/private/frame.rkt b/collects/drracket/private/frame.rkt index 030f7be056..e5b79b321b 100644 --- a/collects/drracket/private/frame.rkt +++ b/collects/drracket/private/frame.rkt @@ -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) diff --git a/collects/drracket/private/interface.rkt b/collects/drracket/private/interface.rkt index 007438bb57..bd4c5e2782 100644 --- a/collects/drracket/private/interface.rkt +++ b/collects/drracket/private/interface.rkt @@ -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:<%> diff --git a/collects/drracket/private/tracing.rkt b/collects/drracket/private/tracing.rkt index 0e27e4f2a5..fe6ff47243 100644 --- a/collects/drracket/private/tracing.rkt +++ b/collects/drracket/private/tracing.rkt @@ -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) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index a474c10108..db282ab04a 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -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) diff --git a/collects/scribblings/tools/frame.scrbl b/collects/scribblings/tools/frame.scrbl index 16afd84b27..d4185cc50b 100644 --- a/collects/scribblings/tools/frame.scrbl +++ b/collects/scribblings/tools/frame.scrbl @@ -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. }