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

added a capability to change the title of the Scheme menu

Browse Source 
svn: r3124
This commit is contained in:
Robby Findler 2006-05-30 17:40:39 +00:00
parent dc0e3b5700
commit 0d98327eae
4 changed files with 29 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/drscheme/private/main.ss
View File

@ -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)

4
collects/drscheme/private/tool-contracts.ss
View File

@ -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?)

33
collects/drscheme/private/unit.ss
View File

@ -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

3
collects/profj/tool.ss
View File

@ -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))