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-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-large-letters (flat-contract boolean?) #t)
(drscheme:language:register-capability 'drscheme:special:insert-lambda (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 (handler:current-create-new-window
(let ([drscheme-current-create-new-window (let ([drscheme-current-create-new-window
(λ (filename) (λ (filename)

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

@ -909,6 +909,8 @@
"" ""
"By default, these capabilities are registered as DrScheme starts up:" "By default, these capabilities are registered as DrScheme starts up:"
"\\begin{itemize}" "\\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 ...)\"))|" "\\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," " --- 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." "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" " --- 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)|" "\\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" " --- determines if the insert large letters menu item in the special menu is visible"
"\\item \\scheme|()|"
"\\item \\scheme|()|"
"\\end{itemize}") "\\end{itemize}")
(drscheme:language:capability-registered? (drscheme:language:capability-registered?
(-> symbol? boolean?) (-> symbol? boolean?)

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

@ -1286,13 +1286,16 @@ module browser threading seems wrong.
(set! save-init-shown? mod?)) (set! save-init-shown? mod?))
(update-tab-label current-tab))) (update-tab-label current-tab)))
;; update-define-popup : -> void (define/private (language-changed)
;; brings the (define ...) popup in sync with the main drscheme window (let* ([settings (send definitions-text get-next-settings)]
(define/public (update-define-popup) [language (drscheme:language-configuration:language-settings-language settings)])
(let ([settings (send definitions-text get-next-settings)]) (send func-defs-canvas language-changed language)
(send func-defs-canvas language-changed
(drscheme:language-configuration:language-settings-language settings)))) (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 ;; update-save-message : -> void
;; sets the save message. If input is #f, uses the frame's ;; sets the save message. If input is #f, uses the frame's
;; title. ;; title.
@ -2004,7 +2007,6 @@ module browser threading seems wrong.
[(2) (revert)])))) [(2) (revert)]))))
(inherit get-menu-bar get-focus-object get-edit-target-object) (inherit get-menu-bar get-focus-object get-edit-target-object)
(define language-menu 'uninited-language-menu)
(define/override on-size (define/override on-size
(lambda (w h) (lambda (w h)
@ -2098,7 +2100,7 @@ module browser threading seems wrong.
(restore-visible-tab-regions) (restore-visible-tab-regions)
(update-save-message) (update-save-message)
(update-save-button) (update-save-button)
(update-define-popup) (language-changed)
(send definitions-text update-frame-filename) (send definitions-text update-frame-filename)
(send definitions-text set-delegate old-delegate) (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)]) [new-language (drscheme:language-configuration:language-settings-language language-settings)])
(send new-language capability-value key))) (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 special-menu 'special-menu-not-yet-init)
(define/public (get-special-menu) special-menu) (define/public (get-special-menu) special-menu)
(define/private (initialize-menus) (define/private (initialize-menus)
(let* ([mb (get-menu-bar)] (let* ([mb (get-menu-bar)]
[language-menu-on-demand [language-menu-on-demand
@ -2606,7 +2610,10 @@ module browser threading seems wrong.
mb mb
#f #f
language-menu-on-demand))] 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 [send-method
(λ (method) (λ (method)
(λ (_1 _2) (λ (_1 _2)
@ -2627,7 +2634,7 @@ module browser threading seems wrong.
this)]) this)])
(when new-settings (when new-settings
(send definitions-text set-next-settings new-settings) (send definitions-text set-next-settings new-settings)
(update-define-popup) (language-changed)
(preferences:set (preferences:set
drscheme:language-configuration:settings-preferences-symbol drscheme:language-configuration:settings-preferences-symbol
new-settings)))) new-settings))))
@ -3076,7 +3083,7 @@ module browser threading seems wrong.
(update-save-message) (update-save-message)
(update-save-button) (update-save-button)
(update-define-popup) (language-changed)
(cond (cond
[filename [filename

3
collects/profj/tool.ss
View File

@ -151,8 +151,9 @@
(class* object% (drscheme:language:language<%>) (class* object% (drscheme:language:language<%>)
(define/public (capability-value s) (define/public (capability-value s)
(cond (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] [(memq s '(slideshow:special-menu drscheme:define-popup)) #f]
[(regexp-match #rx"^drscheme:special:" (format "~a" s)) #f]
[else [else
(drscheme:language:get-capability-default s)])) (drscheme:language:get-capability-default s)]))
(define/public (first-opened) (void)) (define/public (first-opened) (void))