From 0d98327eae41aee5b8f14605e3bb78ce6d07f379 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 30 May 2006 17:40:39 +0000 Subject: [PATCH] added a capability to change the title of the Scheme menu svn: r3124 --- collects/drscheme/private/main.ss | 6 +++- collects/drscheme/private/tool-contracts.ss | 4 +-- collects/drscheme/private/unit.ss | 33 +++++++++++++-------- collects/profj/tool.ss | 3 +- 4 files changed, 29 insertions(+), 17 deletions(-) diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss index 5700f78e78..b466c60744 100644 --- a/collects/drscheme/private/main.ss +++ b/collects/drscheme/private/main.ss @@ -251,7 +251,11 @@ (drscheme:language:register-capability 'drscheme:special:insert-fraction (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-large-letters (flat-contract boolean?) #t) (drscheme:language:register-capability 'drscheme:special:insert-lambda (flat-contract boolean?) #t) - + (drscheme:language:register-capability 'drscheme:language-menu-title + (flat-contract string?) + (string-constant scheme-menu-name)) + + (handler:current-create-new-window (let ([drscheme-current-create-new-window (λ (filename) diff --git a/collects/drscheme/private/tool-contracts.ss b/collects/drscheme/private/tool-contracts.ss index b60a6d6134..ae68871b8d 100644 --- a/collects/drscheme/private/tool-contracts.ss +++ b/collects/drscheme/private/tool-contracts.ss @@ -909,6 +909,8 @@ "" "By default, these capabilities are registered as DrScheme starts up:" "\\begin{itemize}" + "\\item \\scheme|(drscheme:language:register-capability 'drscheme:language-menu-title (flat-contract string?) (string-constant scheme-menu-name))|" + " --- controls the name of the menu just to the right of the language menu (defaultly named ``Scheme'')" "\\item \\scheme|(drscheme:language:register-capability 'drscheme:define-popup (or/c (cons/c string? string?) false/c) (cons \"(define\" \"(define ...)\"))|" " --- specifies the prefix that the define popup should look for and what label it should have," "or \\scheme|#f| if it should not appear at all." @@ -918,8 +920,6 @@ " --- determines if the insert lambda menu item in the special menu is visible" "\\item \\scheme|(drscheme:language:register-capability 'drscheme:special:insert-large-letters (flat-contract boolean?) #t)|" " --- determines if the insert large letters menu item in the special menu is visible" - "\\item \\scheme|()|" - "\\item \\scheme|()|" "\\end{itemize}") (drscheme:language:capability-registered? (-> symbol? boolean?) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 577dc0e2cc..258fb62426 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -1286,13 +1286,16 @@ module browser threading seems wrong. (set! save-init-shown? mod?)) (update-tab-label current-tab))) - ;; update-define-popup : -> void - ;; brings the (define ...) popup in sync with the main drscheme window - (define/public (update-define-popup) - (let ([settings (send definitions-text get-next-settings)]) - (send func-defs-canvas language-changed - (drscheme:language-configuration:language-settings-language settings)))) - + (define/private (language-changed) + (let* ([settings (send definitions-text get-next-settings)] + [language (drscheme:language-configuration:language-settings-language settings)]) + (send func-defs-canvas language-changed language) + + (let ([label (send scheme-menu get-label)] + [new-label (send language capability-value 'drscheme:language-menu-title)]) + (unless (equal? label new-label) + (send scheme-menu set-label new-label))))) + ;; update-save-message : -> void ;; sets the save message. If input is #f, uses the frame's ;; title. @@ -2004,7 +2007,6 @@ module browser threading seems wrong. [(2) (revert)])))) (inherit get-menu-bar get-focus-object get-edit-target-object) - (define language-menu 'uninited-language-menu) (define/override on-size (lambda (w h) @@ -2098,7 +2100,7 @@ module browser threading seems wrong. (restore-visible-tab-regions) (update-save-message) (update-save-button) - (update-define-popup) + (language-changed) (send definitions-text update-frame-filename) (send definitions-text set-delegate old-delegate) @@ -2593,9 +2595,11 @@ module browser threading seems wrong. [new-language (drscheme:language-configuration:language-settings-language language-settings)]) (send new-language capability-value key))) + (define language-menu 'uninited-language-menu) + (define scheme-menu 'scheme-menu-not-yet-init) (define special-menu 'special-menu-not-yet-init) (define/public (get-special-menu) special-menu) - + (define/private (initialize-menus) (let* ([mb (get-menu-bar)] [language-menu-on-demand @@ -2606,7 +2610,10 @@ module browser threading seems wrong. mb #f language-menu-on-demand))] - [scheme-menu (make-object (get-menu%) (string-constant scheme-menu-name) mb)] + [_ (set! scheme-menu (new (get-menu%) + [label (drscheme:language:get-capability-default + 'drscheme:language-menu-title)] + [parent mb]))] [send-method (λ (method) (λ (_1 _2) @@ -2627,7 +2634,7 @@ module browser threading seems wrong. this)]) (when new-settings (send definitions-text set-next-settings new-settings) - (update-define-popup) + (language-changed) (preferences:set drscheme:language-configuration:settings-preferences-symbol new-settings)))) @@ -3076,7 +3083,7 @@ module browser threading seems wrong. (update-save-message) (update-save-button) - (update-define-popup) + (language-changed) (cond [filename diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index 35a888c5b2..b6b328741c 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -151,8 +151,9 @@ (class* object% (drscheme:language:language<%>) (define/public (capability-value s) (cond - [(regexp-match #rx"^drscheme:special:" (format "~a" s)) #f] + [(eq? s 'drscheme:language-menu-title) "Java"] [(memq s '(slideshow:special-menu drscheme:define-popup)) #f] + [(regexp-match #rx"^drscheme:special:" (format "~a" s)) #f] [else (drscheme:language:get-capability-default s)])) (define/public (first-opened) (void))