merged 1134:1153 http://svn.plt-scheme.org/plt/branches/robby to trunk
svn: r1154
This commit is contained in:
Robby Findler
parent
e8e199af4b
commit
e073a97123
|
|
@ -145,34 +145,7 @@
|
|||
(λ x
|
||||
(send f close)))]
|
||||
[messages-panel (make-object vertical-panel% left-vp)]
|
||||
|
||||
[this-version (version)]
|
||||
[last-version (preferences:get 'drscheme:last-version)]
|
||||
[last-language (preferences:get 'drscheme:last-language)]
|
||||
[welcome-to-drs-msg (make-object message% (string-constant welcome-to-drscheme) messages-panel)]
|
||||
[this-version-message (make-object message%
|
||||
(format (string-constant version/language)
|
||||
this-version
|
||||
(this-language))
|
||||
messages-panel)]
|
||||
[last-version-message
|
||||
(let ([msg (cond
|
||||
[(and last-version
|
||||
last-language
|
||||
(not (equal? this-version last-version))
|
||||
(not (equal? (this-language) last-language)))
|
||||
(format (string-constant parenthetical-last-version/language)
|
||||
last-version last-language)]
|
||||
[(and last-language
|
||||
(not (equal? (this-language) last-language)))
|
||||
(format (string-constant parenthetical-last-language)
|
||||
last-language)]
|
||||
[(and last-version
|
||||
(not (equal? this-version last-version)))
|
||||
(format (string-constant parenthetical-last-version)
|
||||
last-version)]
|
||||
[else #f])])
|
||||
(and msg (make-object message% msg messages-panel)))])
|
||||
[welcome-to-drs-msg (make-object message% (string-constant welcome-to-drscheme) messages-panel)])
|
||||
(for-each (λ (native-lang-string language)
|
||||
(unless (equal? (this-language) language)
|
||||
(instantiate button% ()
|
||||
|
|
|
|||
|
|
@ -46,10 +46,6 @@
|
|||
;; if a language is registered with this position, it is
|
||||
;; considered the default language
|
||||
(define default-language-position
|
||||
(list (string-constant teaching-languages)
|
||||
(string-constant how-to-design-programs)
|
||||
(string-constant beginning-student))
|
||||
#;
|
||||
(list (string-constant initial-language-category)
|
||||
(string-constant choose-a-language-language)))
|
||||
|
||||
|
|
@ -119,9 +115,10 @@
|
|||
; ;;;; ;;;; ;;;;
|
||||
|
||||
|
||||
;; language-dialog : (boolean language-setting -> language-setting)
|
||||
;; language-dialog : (boolean language-setting -> (union #f language-setting))
|
||||
;; (boolean language-setting (union #f (instanceof top-level-window%))
|
||||
;; -> language-setting)
|
||||
;; ->
|
||||
;; (union #f language-setting))
|
||||
;; allows the user to configure their language. The input language-setting is used
|
||||
;; as the defaults in the dialog and the output language setting is the user's choice
|
||||
;; todo: when button is clicked, ensure language is selected
|
||||
|
|
@ -201,7 +198,7 @@
|
|||
(send dialog center 'both))
|
||||
(send dialog show #t)
|
||||
(if cancelled?
|
||||
language-settings-to-show
|
||||
#f
|
||||
(make-language-settings
|
||||
(get-selected-language)
|
||||
(get-selected-language-settings)))))
|
||||
|
|
@ -1333,7 +1330,6 @@
|
|||
(string-constant r5rs-one-line-summary)
|
||||
r5rs-mixin))
|
||||
|
||||
#;
|
||||
(add-language
|
||||
(make-simple 'mzscheme
|
||||
(list (string-constant initial-language-category)
|
||||
|
|
@ -1356,62 +1352,88 @@
|
|||
(define (not-a-language-message)
|
||||
(define (main)
|
||||
(o (string-constant must-choose-language))
|
||||
(o "\n\n")
|
||||
(o (string-constant using-a-text-book?))
|
||||
(o "\n")
|
||||
(insert-text-pls)
|
||||
(o "\n")
|
||||
(o (string-constant seasoned-plt-schemer-before))
|
||||
(o (lang-link-snip (list (string-constant professional-languages)
|
||||
"(module ...)")))
|
||||
(o (string-constant seasoned-plt-schemer-after))
|
||||
(o "\n\n")
|
||||
(o (string-constant otherwise-use-before))
|
||||
(o (lang-link-snip (list (string-constant professional-languages)
|
||||
(string-constant plt)
|
||||
(string-constant pretty-big-scheme))))
|
||||
(o (string-constant otherwise-use-between))
|
||||
(o (new link-snip%
|
||||
[words (string-constant otherwise-use-language-dialog)]
|
||||
[callback
|
||||
(λ (snip)
|
||||
(let ([new-lang
|
||||
(language-dialog #f
|
||||
(preferences:get settings-preferences-symbol)
|
||||
(find-parent-from-snip snip))])
|
||||
(preferences:set settings-preferences-symbol
|
||||
new-lang)))]))
|
||||
(display-plt-schemer)
|
||||
(display-standard-schemer)
|
||||
(display-future-choice))
|
||||
|
||||
(o (string-constant otherwise-use-after)))
|
||||
|
||||
(define (find-parent-from-snip snip)
|
||||
(let loop ([snip snip])
|
||||
(let* ([admin (send snip get-admin)]
|
||||
[ed (send admin get-editor)])
|
||||
(cond
|
||||
[(send ed get-canvas)
|
||||
=>
|
||||
(λ (c)
|
||||
(send c get-top-level-window))]
|
||||
[else
|
||||
(let ([admin (send ed get-admin)])
|
||||
(and (is-a? admin editor-snip-editor-admin<%>)
|
||||
(loop (send admin get-snip))))]))))
|
||||
|
||||
(define o
|
||||
(case-lambda
|
||||
[(arg)
|
||||
(cond
|
||||
[(string? arg)
|
||||
(fprintf (current-error-port) arg)]
|
||||
[(is-a? arg snip%)
|
||||
(write-special arg (current-error-port))])]
|
||||
[args (apply fprintf (current-error-port) args)]))
|
||||
(define (display-future-choice)
|
||||
(let* ([txt (new text:standard-style-list%)]
|
||||
[es (new editor-snip%
|
||||
[with-border? #f]
|
||||
[left-margin 0]
|
||||
[top-margin 0]
|
||||
[bottom-margin 0]
|
||||
[right-margin 0]
|
||||
[editor txt])])
|
||||
(send txt insert (string-constant use-language-menu-item-in-future))
|
||||
(send txt change-style
|
||||
default-sd
|
||||
0
|
||||
(send txt last-position))
|
||||
(o es)
|
||||
(o "\n")))
|
||||
|
||||
(define (insert-text-pls)
|
||||
(for-each
|
||||
display-text-pl
|
||||
(apply append (map get-text-pls (find-relevant-directories '(textbook-pls))))))
|
||||
(quicksort
|
||||
(apply append (map get-text-pls (find-relevant-directories '(textbook-pls))))
|
||||
(λ (x y)
|
||||
(cond
|
||||
[(string=? (cadr x) (string-constant how-to-design-programs))
|
||||
#t]
|
||||
[(string=? (string-constant how-to-design-programs) (cadr y))
|
||||
#f]
|
||||
[else
|
||||
(string<=? (cadr x) (cadr y))])))))
|
||||
|
||||
(define (display-plt-schemer)
|
||||
(question/answer (string-constant seasoned-plt-schemer?)
|
||||
(list (string-constant professional-languages)
|
||||
"(module ...)")
|
||||
(list "PLT-206-small.png" "icons")
|
||||
void))
|
||||
|
||||
(define (display-standard-schemer)
|
||||
(question/answer (string-constant looking-for-standard-scheme?)
|
||||
(list (string-constant professional-languages)
|
||||
(string-constant plt)
|
||||
(string-constant pretty-big-scheme))
|
||||
(list "r5rs.png" "icons")
|
||||
void))
|
||||
|
||||
(define (display-text-pl lst)
|
||||
(let ([icon-lst (car lst)]
|
||||
[text-name (cadr lst)]
|
||||
[lang (cddr lst)]
|
||||
[using-before (string-constant using-a-textbook-before)]
|
||||
[using-after (string-constant using-a-textbook-after)])
|
||||
(question/answer (string-append using-before text-name using-after)
|
||||
lang
|
||||
icon-lst
|
||||
(λ (txt)
|
||||
(send txt change-style
|
||||
italic-sd
|
||||
(string-length using-before)
|
||||
(+ (string-length using-before)
|
||||
(string-length text-name)))))))
|
||||
|
||||
(define (question/answer question lang icon-lst proc)
|
||||
(display-two-line-choice
|
||||
icon-lst
|
||||
(λ (inner-txt)
|
||||
(send inner-txt insert (format "~a\n~a" question (string-constant start-with-before)))
|
||||
(send inner-txt change-style default-sd 0 (send inner-txt last-position))
|
||||
(lang-link-snip lang inner-txt)
|
||||
(let ([before-pos (send inner-txt last-position)])
|
||||
(send inner-txt insert (string-constant start-with-after))
|
||||
(send inner-txt change-style
|
||||
default-sd
|
||||
before-pos
|
||||
(send inner-txt last-position)))
|
||||
(proc inner-txt))))
|
||||
|
||||
;; get-text-pls : path -> (listof (list* string string (listof string))
|
||||
;; gets the questions from an info.ss file.
|
||||
|
|
@ -1440,17 +1462,41 @@
|
|||
qs)
|
||||
'())))
|
||||
|
||||
(define (lang-link-snip lang)
|
||||
(define (lang-link-snip lang txt)
|
||||
#;
|
||||
(let ([before (send txt last-position)])
|
||||
(send txt insert (car (last-pair lang)))
|
||||
(let ([after (send txt last-position)])
|
||||
(send txt change-style link-sd before after)
|
||||
(send txt set-clickback before after
|
||||
(λ (txt start end)
|
||||
(change-current-lang-to lang txt)))))
|
||||
|
||||
(send txt insert
|
||||
(new link-snip%
|
||||
[words (car (last-pair lang))]
|
||||
[callback
|
||||
(λ (snip)
|
||||
(change-current-lang-to lang))]))
|
||||
(change-current-lang-to lang snip))])))
|
||||
|
||||
(define o
|
||||
(case-lambda
|
||||
[(arg)
|
||||
(cond
|
||||
[(string? arg)
|
||||
(fprintf (current-error-port) arg)]
|
||||
[(is-a? arg snip%)
|
||||
(write-special arg (current-error-port))])]
|
||||
[args (apply fprintf (current-error-port) args)]))
|
||||
|
||||
(define arrow-cursor (make-object cursor% 'arrow))
|
||||
|
||||
(define link-snip%
|
||||
(class editor-snip%
|
||||
(init-field words callback)
|
||||
|
||||
(define/override (adjust-cursor dc x y editorx editory event) arrow-cursor)
|
||||
|
||||
(define/override (on-event dc x y editorx editory event)
|
||||
(when (send event button-up?)
|
||||
(callback this)))
|
||||
|
|
@ -1471,29 +1517,41 @@
|
|||
(send txt insert words)
|
||||
(send txt change-style link-sd 0 (send txt last-position))))
|
||||
|
||||
#;
|
||||
(define link-snip%
|
||||
(class string-snip%
|
||||
(init-field words callback)
|
||||
|
||||
(define/override (adjust-cursor dc x y editorx editory event) arrow-cursor)
|
||||
|
||||
(define/override (on-event dc x y editorx editory event)
|
||||
(when (send event button-up?)
|
||||
(callback this)))
|
||||
|
||||
(define/override (copy)
|
||||
(new link-snip% [words words] [callback callback]))
|
||||
|
||||
(super-make-object words)
|
||||
(inherit get-flags set-flags set-style)
|
||||
(set-style link-style)
|
||||
(set-flags (cons 'handles-events (remq 'is-text (get-flags))))))
|
||||
|
||||
(define italic-sd (make-object style-delta% 'change-style 'slant))
|
||||
|
||||
(define link-sd (make-object style-delta% 'change-underline #t))
|
||||
(define stupid-internal-define-syntax1
|
||||
(send link-sd set-delta-foreground "blue"))
|
||||
(begin (send link-sd set-delta-foreground "blue")
|
||||
(send link-sd set-family 'default)))
|
||||
|
||||
(define (display-text-pl lst)
|
||||
(let ([icon-lst (car lst)]
|
||||
[text-name (cadr lst)]
|
||||
[lang (cddr lst)])
|
||||
(display-two-line-choice
|
||||
icon-lst
|
||||
lang
|
||||
(λ (inner-txt)
|
||||
(send inner-txt insert (format "~a\n~a" text-name (string-constant start-with-before)))
|
||||
(send inner-txt change-style err-style-delta 0 (send inner-txt last-position))
|
||||
(send inner-txt insert (lang-link-snip lang))
|
||||
(let ([before-pos (send inner-txt last-position)])
|
||||
(send inner-txt insert (string-constant start-with-after))
|
||||
(send inner-txt change-style
|
||||
err-style-delta
|
||||
before-pos
|
||||
(send inner-txt last-position)))))))
|
||||
(define default-sd (make-object style-delta% 'change-family 'default))
|
||||
|
||||
(define (display-two-line-choice icon-lst lang proc)
|
||||
(define link-style
|
||||
(send (editor:get-standard-style-list)
|
||||
find-or-create-style
|
||||
(send (editor:get-standard-style-list) find-named-style "Standard")
|
||||
link-sd))
|
||||
|
||||
(define (display-two-line-choice icon-lst proc)
|
||||
(let* ([outer-txt (new text:standard-style-list%)]
|
||||
[outer-es (new editor-snip% (editor outer-txt) (with-border? #f)
|
||||
[left-margin 0]
|
||||
|
|
@ -1522,21 +1580,42 @@
|
|||
(send err-sd set-delta-foreground (make-object color% 255 0 0))
|
||||
err-sd))
|
||||
|
||||
(main))
|
||||
|
||||
;; change-current-lang-to : (listof string) -> void
|
||||
(define (change-current-lang-to lang-strings)
|
||||
(let ([lang (ormap
|
||||
(define (change-current-lang-to lang-strings snip)
|
||||
(let ([parent (find-parent-from-snip snip)]
|
||||
[lang (ormap
|
||||
(λ (x)
|
||||
(and (equal? lang-strings (send x get-language-position))
|
||||
x))
|
||||
(get-languages))])
|
||||
(unless lang
|
||||
(error 'change-current-lang-to "unknown language! ~s" lang-strings))
|
||||
(preferences:set settings-preferences-symbol
|
||||
|
||||
(let ([new-lang
|
||||
(language-dialog #f
|
||||
(make-language-settings lang
|
||||
(send lang default-settings)))
|
||||
(message-box (string-constant drscheme)
|
||||
(format
|
||||
(string-constant drschemes-language-now-set)
|
||||
(car (last-pair lang-strings)))))))))
|
||||
(send lang default-settings))
|
||||
parent)])
|
||||
(when new-lang
|
||||
(preferences:set settings-preferences-symbol new-lang)
|
||||
(when (is-a? parent drscheme:unit:frame<%>)
|
||||
(send (send parent get-definitions-text) set-next-settings new-lang))))))
|
||||
|
||||
(main))
|
||||
|
||||
;; find-parent-from-editor : editor -> (union frame #f)
|
||||
(define (find-parent-from-editor ed)
|
||||
(cond
|
||||
[(send ed get-canvas)
|
||||
=>
|
||||
(λ (c) (send c get-top-level-window))]
|
||||
[else
|
||||
(let ([admin (send ed get-admin)])
|
||||
(and (is-a? admin editor-snip-editor-admin<%>)
|
||||
(find-parent-from-snip (send admin get-snip))))]))
|
||||
|
||||
;; find-parent-from-snip : snip -> (union frame #f)
|
||||
(define (find-parent-from-snip snip)
|
||||
(let* ([admin (send snip get-admin)]
|
||||
[ed (send admin get-editor)])
|
||||
(find-parent-from-editor ed))))))
|
||||
|
|
|
|||
|
|
@ -321,12 +321,6 @@
|
|||
(super-new))])
|
||||
(handler:set-recent-items-frame-superclass drs-handler-recent-items-super%))
|
||||
|
||||
;;
|
||||
;; Show expanded language dialog when version changes
|
||||
;;
|
||||
(preferences:set-default 'drscheme:last-version #f (λ (x) (or (string? x) (not x))))
|
||||
(preferences:set-default 'drscheme:last-language #f (λ (x) (or (symbol? x) (not x))))
|
||||
|
||||
(cond
|
||||
[(current-eventspace-has-menu-root?)
|
||||
(drscheme:frame:create-root-menubar)
|
||||
|
|
|
|||
|
|
@ -103,7 +103,7 @@ TODO
|
|||
ensure-rep-shown ;; (interactions-text -> void)
|
||||
;; make the rep visible in the frame
|
||||
|
||||
needs-execution? ;; (-> boolean)
|
||||
needs-execution ;; (-> boolean)
|
||||
;; ask if things have changed that would mean the repl is out
|
||||
;; of sync with the program being executed in it.
|
||||
|
||||
|
|
@ -815,11 +815,10 @@ TODO
|
|||
(ask-about-kill? #f))
|
||||
(define/public (get-in-evaluation?) in-evaluation?)
|
||||
|
||||
(define/private (insert-warning)
|
||||
(define/private (insert-warning message)
|
||||
(begin-edit-sequence)
|
||||
(let ([start (get-insertion-point)])
|
||||
(insert-before
|
||||
(string-constant interactions-out-of-sync))
|
||||
(insert-before message)
|
||||
(let ([end (get-insertion-point)])
|
||||
(change-style warning-style-delta start end)))
|
||||
(insert-before "\n")
|
||||
|
|
@ -871,13 +870,13 @@ TODO
|
|||
(save-interaction-in-history prompt-position (- (last-position) 2))
|
||||
(freeze-colorer)
|
||||
|
||||
(let* ([needs-execution? (send context needs-execution?)])
|
||||
(let ([needs-execution (send context needs-execution)])
|
||||
(when (if (preferences:get 'drscheme:execute-warning-once)
|
||||
(and (not already-warned?)
|
||||
needs-execution?)
|
||||
needs-execution?)
|
||||
needs-execution)
|
||||
needs-execution)
|
||||
(set! already-warned? #t)
|
||||
(insert-warning)))
|
||||
(insert-warning needs-execution)))
|
||||
|
||||
;; lets us know we are done with this one interaction
|
||||
;; (since there may be multiple expressions at the prompt)
|
||||
|
|
|
|||
|
|
@ -830,7 +830,7 @@
|
|||
(boolean? drscheme:language-configuration:language-settings?)
|
||||
((union false/c (is-a?/c top-level-window<%>))
|
||||
boolean?)
|
||||
drscheme:language-configuration:language-settings?)
|
||||
(union false/c drscheme:language-configuration:language-settings?))
|
||||
((show-welcome? language-settings-to-show)
|
||||
((parent #t)
|
||||
(manuals? #f)))
|
||||
|
|
@ -857,7 +857,10 @@
|
|||
""
|
||||
"The \\var{manuals?} argument is passed to"
|
||||
"@flink drscheme:language-configuration:fill-language-dialog %"
|
||||
".")
|
||||
"."
|
||||
""
|
||||
"The result if \\scheme|#f| when the user cancells the dialog, and"
|
||||
"the selected language if they hit ok.")
|
||||
|
||||
(drscheme:language-configuration:fill-language-dialog
|
||||
(opt->
|
||||
|
|
|
|||
|
|
@ -469,12 +469,13 @@ module browser threading seems wrong.
|
|||
(set! next-settings _next-settings)
|
||||
(change-mode-to-match))
|
||||
|
||||
(define/public (needs-execution?)
|
||||
(define/public (needs-execution)
|
||||
(or needs-execution-state
|
||||
(not (equal? execute-settings next-settings))))
|
||||
(and (not (equal? execute-settings next-settings))
|
||||
(string-constant needs-execute-language-changed))))
|
||||
|
||||
(define/pubment (teachpack-changed)
|
||||
(set! needs-execution-state #t))
|
||||
(set! needs-execution-state (string-constant needs-execute-teachpack-changed)))
|
||||
(define/pubment (just-executed)
|
||||
(set! execute-settings next-settings)
|
||||
(set! needs-execution-state #f)
|
||||
|
|
@ -484,10 +485,10 @@ module browser threading seems wrong.
|
|||
(define/pubment (already-warned)
|
||||
(set! already-warned-state #t))
|
||||
(define/augment (after-insert x y)
|
||||
(set! needs-execution-state #t)
|
||||
(set! needs-execution-state (string-constant needs-execute-defns-edited))
|
||||
(inner (void) after-insert x y))
|
||||
(define/augment (after-delete x y)
|
||||
(set! needs-execution-state #t)
|
||||
(set! needs-execution-state (string-constant needs-execute-defns-edited))
|
||||
(inner (void) after-delete x y))
|
||||
|
||||
(inherit get-filename)
|
||||
|
|
@ -901,8 +902,8 @@ module browser threading seems wrong.
|
|||
(let-values ([(base _1 _2) (split-path (mzlib:file:normalize-path filename))])
|
||||
base)
|
||||
#f)))
|
||||
(define/public (needs-execution?)
|
||||
(send defs needs-execution?))
|
||||
(define/public (needs-execution)
|
||||
(send defs needs-execution))
|
||||
|
||||
(define/pubment (can-close?)
|
||||
(and (send defs can-close?)
|
||||
|
|
|
|||
BIN
collects/icons/r5rs.png
Normal file
BIN
collects/icons/r5rs.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.9 KiB |
|
|
@ -225,8 +225,14 @@ please adhere to these guidelines:
|
|||
(no-full-name-since-not-saved
|
||||
"The file does not have a full name because it has not yet been saved.")
|
||||
(cannot-open-because-dne "Cannot open ~a because it does not exist.")
|
||||
(interactions-out-of-sync
|
||||
"WARNING: Interactions window is out of sync with the definitions window. Click Run.")
|
||||
|
||||
(needs-execute-language-changed
|
||||
"WARNING: The language has changed. Click Run.")
|
||||
(needs-execute-teachpack-changed
|
||||
"WARNING: The teachpacks have changed. Click Run.")
|
||||
(needs-execute-defns-edited
|
||||
"WARNING: The definitions window has changed. Click Run.")
|
||||
|
||||
(file-is-not-saved "The file \"~a\" is not saved.")
|
||||
(save "Save")
|
||||
(please-choose-either "Please choose either \"~a\" or \"~a\"")
|
||||
|
|
@ -989,23 +995,23 @@ please adhere to these guidelines:
|
|||
;;; from the `not a language language' used initially in drscheme.
|
||||
(must-choose-language "DrScheme cannot process programs until you choose a programming language.")
|
||||
|
||||
; intro to using a textbook
|
||||
(using-a-text-book? "Are you using one of the these textbooks?")
|
||||
; next two are used with each textbook
|
||||
; next two appear before and after the name of a text book (which will be in italics)
|
||||
(using-a-textbook-before "Using ")
|
||||
(using-a-textbook-after "?")
|
||||
|
||||
; next two are before and after a language
|
||||
(start-with-before "Start with ")
|
||||
(start-with-after ".")
|
||||
|
||||
; next ones are the default choices at the end of the list in the not-a-language-language error message
|
||||
(seasoned-plt-schemer-before "Are you a seasoned PLT Schemer? Try ")
|
||||
(seasoned-plt-schemer-after ".")
|
||||
(otherwise-use-before "Otherwise, use ")
|
||||
(otherwise-use-between ",\nor choose for yourself from the ")
|
||||
(otherwise-use-language-dialog "language dialog") ; this one will become clickable and will open the language dialog
|
||||
(otherwise-use-after ".")
|
||||
(seasoned-plt-schemer? "Seasoned PLT Schemer?")
|
||||
(looking-for-standard-scheme? "Looking for standard Scheme?")
|
||||
(use-language-menu-item-in-future "Use the Language|Choose Language... menu item to change languages later.")
|
||||
|
||||
; after clicking a language, this tells you that its done. The ~a is filled in with
|
||||
; the name of the language
|
||||
(drschemes-language-now-set "DrScheme's Language is now set to:\n ~a")
|
||||
; some of these belong ...
|
||||
;(otherwise-use-before "Otherwise, use ")
|
||||
;(otherwise-use-between ",\nor choose for yourself from the ")
|
||||
;(otherwise-use-language-dialog "language dialog") ; this one will become clickable and will open the language dialog
|
||||
;(otherwise-use-after ".")
|
||||
|
||||
;;; debug language
|
||||
(unknown-debug-frame "[unknown]")
|
||||
|
|
|
|||
|
|
@ -1,9 +0,0 @@
|
|||
|
||||
(module italian-string-constants "string-constant-lang.ss"
|
||||
(is-this-your-native-language "Is Italian Your Native Language?")
|
||||
|
||||
(are-you-sure-you-want-to-switch-languages
|
||||
"This will change the language of the GUI, which requires you to restart DrScheme. Are you sure?")
|
||||
|
||||
(interact-with-drscheme-in-language "Interact with DrScheme in Italian")
|
||||
)
|
||||
|
|
@ -8,7 +8,6 @@
|
|||
(prefix french: "french-string-constants.ss")
|
||||
(prefix dutch: "dutch-string-constants.ss")
|
||||
(prefix danish: "danish-string-constants.ss")
|
||||
(prefix italian: "italian-string-constants.ss")
|
||||
(prefix portuguese: "portuguese-string-constants.ss")
|
||||
(prefix japanese: "japanese-string-constants.ss")
|
||||
(prefix traditional-chinese: "traditional-chinese-string-constants.ss")
|
||||
|
|
@ -24,8 +23,42 @@
|
|||
(define (set-language-pref language)
|
||||
(put-preferences (list 'plt:human-language) (list language)))
|
||||
|
||||
;; table : (listof (list symbol regexp regexp))
|
||||
;; this table indicates what the default value of the natural language
|
||||
;; preference is. the first regexp is used under Windows and the second
|
||||
;; is used on other platofmr.s All regexps are compared to the result
|
||||
;; of (system-language+country)
|
||||
(define table
|
||||
'((english #rx"^en_" #rx"^English_")
|
||||
(spanish #rx"^es_" #rx"^Espanol_")
|
||||
(german #rx"^de_" #rx"^German_")
|
||||
(french #rx"^fr_" #rx"French_")
|
||||
(dutch #rx"nl_" #rx"^Netherlands_")
|
||||
(danish #rx"^da_DK" #rx"^Danish_")
|
||||
(portuguese #rx"^pt_" #rx"Portuguese_")
|
||||
(japanese #rx"^ja_" #rx"^Japan_")
|
||||
(traditional-chinese #rx"^zh_(HK|TW)" #rx"Chinese_China")
|
||||
(simplified-chinese #rx"^zh_CN" #rx"Chinese_(Hong|Taiwan)")))
|
||||
|
||||
;; default-language : -> symbol
|
||||
;; uses `table' and system-language+contry to find what language to start with
|
||||
(define (default-language)
|
||||
(let ([slc (system-language+country)])
|
||||
(let loop ([table table])
|
||||
(cond
|
||||
[(null? table)
|
||||
'english]
|
||||
[else
|
||||
(let ([ent (car table)])
|
||||
(if (or (regexp-match (cadr ent) slc)
|
||||
(and (cddr ent)
|
||||
(regexp-match (caddr ent) slc)))
|
||||
(car ent)
|
||||
(loop (cdr table))))]))))
|
||||
|
||||
|
||||
;; language : symbol
|
||||
(define language (get-preference 'plt:human-language (lambda () 'english)))
|
||||
(define language (get-preference 'plt:human-language (lambda () (default-language))))
|
||||
|
||||
(define-syntax-set (string-constant string-constants this-language all-languages)
|
||||
;; type sc = (make-sc symbol (listof (list symbol string)) (union #f hash-table[symbol -o> #t]))
|
||||
|
|
@ -39,7 +72,6 @@
|
|||
(make-sc 'german german:string-constants #f)
|
||||
(make-sc 'dutch dutch:string-constants #f)
|
||||
(make-sc 'danish danish:string-constants #f)
|
||||
(make-sc 'italian italian:string-constants #f)
|
||||
(make-sc 'portuguese portuguese:string-constants #f)
|
||||
(make-sc 'japanese japanese:string-constants #f)
|
||||
(make-sc 'traditional-chinese traditional-chinese:string-constants #f)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user