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