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

Adjust DrRacket to not use on-demand to populate the

Browse Source 
teachpack menu.

Instead DrRacket explicitly changes the menu items when
the language changes or when a teachpack is added/removed

Also, Rackety.

Closes PR 13395
This commit is contained in:
Robby Findler 2013-01-01 21:44:43 -06:00
parent e5eb9751f0
commit 0f26aafd1f
1 changed files with 328 additions and 333 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/drracket/private/unit.rkt
View File

@ -2174,8 +2174,8 @@ module browser threading seems wrong.
(update-tab-label current-tab))) (update-tab-label current-tab)))
(define/public (language-changed) (define/public (language-changed)
(let* ([settings (send definitions-text get-next-settings)] (define settings (send definitions-text get-next-settings))
[language (drracket:language-configuration:language-settings-language settings)]) (define language (drracket:language-configuration:language-settings-language settings))
(send func-defs-canvas language-changed language (or (toolbar-is-left?) (send func-defs-canvas language-changed language (or (toolbar-is-left?)
(toolbar-is-right?))) (toolbar-is-right?)))
(send language-message set-yellow/lang (send language-message set-yellow/lang
@ -2186,11 +2186,12 @@ module browser threading seems wrong.
settings)) settings))
"" ""
(string-append " " (string-constant custom))))) (string-append " " (string-constant custom)))))
(update-teachpack-menu)
(when (is-a? language-specific-menu menu%) (when (is-a? language-specific-menu menu%)
(let ([label (send language-specific-menu get-label)] (define label (send language-specific-menu get-label))
[new-label (send language capability-value 'drscheme:language-menu-title)]) (define new-label (send language capability-value 'drscheme:language-menu-title))
(unless (equal? label new-label) (unless (equal? label new-label)
(send language-specific-menu set-label new-label)))))) (send language-specific-menu set-label new-label))))
(define/public (get-language-menu) language-specific-menu) (define/public (get-language-menu) language-specific-menu)
@ -3880,7 +3881,8 @@ module browser threading seems wrong.
(λ (settings) (λ (settings)
(send (get-definitions-text) set-next-settings (send (get-definitions-text) set-next-settings
(drracket:language-configuration:language-settings language settings)) (drracket:language-configuration:language-settings language settings))
(send (get-definitions-text) teachpack-changed))]) (send (get-definitions-text) teachpack-changed)
(update-teachpack-menu))])
(set! teachpack-items (set! teachpack-items
(list* (list*
(make-object separator-menu-item% language-menu) (make-object separator-menu-item% language-menu)
@ -3900,7 +3902,6 @@ module browser threading seems wrong.
(update-settings (update-settings
((teachpack-callbacks-remove-all tp-callbacks) ((teachpack-callbacks-remove-all tp-callbacks)
settings)))])]) settings)))])])
(send mi enable (not (null? tp-names))) (send mi enable (not (null? tp-names)))
mi) mi)
(map (λ (name) (map (λ (name)
@ -3939,27 +3940,21 @@ module browser threading seems wrong.
#:dialog-mixin frame:focus-table-mixin))])))]))) #:dialog-mixin frame:focus-table-mixin))])))])))
(define/private (initialize-menus) (define/private (initialize-menus)
(let* ([mb (get-menu-bar)] (define mb (get-menu-bar))
[language-menu-on-demand (λ (menu-item) (update-teachpack-menu))] (set! language-menu (new (get-menu%)
[_ (set! language-menu (make-object (get-menu%) [label (string-constant language-menu-name)]
(string-constant language-menu-name) [parent mb]))
mb (set! language-specific-menu (new (get-menu%)
#f
language-menu-on-demand))]
[_ (set! language-specific-menu (new (get-menu%)
[label (drracket:language:get-capability-default [label (drracket:language:get-capability-default
'drscheme:language-menu-title)] 'drscheme:language-menu-title)]
[parent mb]))] [parent mb]))
[send-method (define ((send-method method) _1 _2)
(λ (method) (define text (get-focus-object))
(λ (_1 _2)
(let ([text (get-focus-object)])
(when (is-a? text racket:text<%>) (when (is-a? text racket:text<%>)
(method text)))))] (method text)))
[show/hide-capability-menus (define (show/hide-capability-menus)
(λ () (for ([menu (in-list (send (get-menu-bar) get-items))])
(for-each (λ (menu) (update-items/capability menu)) (update-items/capability menu)))
(send (get-menu-bar) get-items)))])
(make-object menu:can-restore-menu-item% (make-object menu:can-restore-menu-item%
(string-constant choose-language-menu-item-label) (string-constant choose-language-menu-item-label)
@ -4259,7 +4254,7 @@ module browser threading seems wrong.
has-editor-on-demand) has-editor-on-demand)
(register-capability-menu-item 'drscheme:special:insert-lambda insert-menu)) (register-capability-menu-item 'drscheme:special:insert-lambda insert-menu))
(frame:reorder-menus this))) (frame:reorder-menus this))
(define/public (jump-to-previous-error-loc) (define/public (jump-to-previous-error-loc)
(define-values (before after sorted) (find-before-and-after)) (define-values (before after sorted) (find-before-and-after))