diff --git a/collects/algol60/tool.ss b/collects/algol60/tool.ss index caafc09738..d48099577c 100644 --- a/collects/algol60/tool.ss +++ b/collects/algol60/tool.ss @@ -50,6 +50,7 @@ (define lang% (class* object% (drscheme:language:language<%>) (define/public (capability-value s) (drscheme:language:get-capability-default s)) + (define/public (get-language-id) "plt:algol60") (define/public (first-opened) (void)) (define/public (config-panel parent) (case-lambda diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index be726fdf8a..eb8918218c 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -63,11 +63,22 @@ (error 'drscheme:language:add-language "expected language ~e to implement ~e, forgot to use drscheme:language:get-default-mixin ?" language i<%>))) (drscheme:language:get-language-extensions)) + (ensure-no-duplicate-ids language languages) (set! languages (if front? (cons language languages) (append languages (list language)))))) + (define (ensure-no-duplicate-ids l1 languages) + (for-each + (λ (l2) + (when (equal? (send l1 get-language-id) + (send l2 get-language-id)) + (error 'drscheme:language-configuration:add-language + "found two languages with the id ~s" + (send l1 get-language-id)))) + languages)) + ;; get-languages : -> (listof languages) (define (get-languages) (drscheme:tools:only-in-phase @@ -1220,6 +1231,7 @@ (platform-independent-string->path lang-module)) `(lib ,@lang-module))) (language-position lang-position) + (language-id (format "plt:lang-from-module: ~s" lang-module)) (language-numbers lang-numbers) (one-line-summary one-line-summary) (language-url url) @@ -1359,7 +1371,7 @@ (use-namespace-require/copy?))))) (super-instantiate ()))))] [make-simple - (λ (module position numbers mred-launcher? one-line-summary extra-mixin) + (λ (module id position numbers mred-launcher? one-line-summary extra-mixin) (let ([% (extra-mixin ((extras-mixin mred-launcher? one-line-summary) @@ -1369,10 +1381,12 @@ drscheme:language:simple-module-based-language%)))))]) (instantiate % () (module module) + (language-id id) (language-position position) (language-numbers numbers))))]) (add-language (make-simple '(lib "plt-mzscheme.ss" "lang") + "plt:mz" (list (string-constant professional-languages) (string-constant plt) (string-constant mzscheme-w/debug)) @@ -1382,6 +1396,7 @@ (λ (x) x))) (add-language (make-simple '(lib "plt-mred.ss" "lang") + "plt:mred" (list (string-constant professional-languages) (string-constant plt) (string-constant mred-w/debug)) @@ -1391,6 +1406,7 @@ (λ (x) x))) (add-language (make-simple '(lib "plt-pretty-big.ss" "lang") + "plt:pretty-big" (list (string-constant professional-languages) (string-constant plt) (string-constant pretty-big-scheme)) @@ -1400,6 +1416,7 @@ (λ (x) x))) (add-language (make-simple '(lib "plt-mzscheme.ss" "lang") + "plt:expander" (list (string-constant professional-languages) (string-constant plt) (string-constant expander)) @@ -1409,6 +1426,7 @@ add-expand-to-front-end)) (add-language (make-simple '(lib "lang.ss" "r5rs") + "plt:r5rs" (list (string-constant professional-languages) (string-constant r5rs-lang-name)) (list -1000 -1000) @@ -1418,6 +1436,7 @@ (add-language (make-simple 'mzscheme + "plt:no-language-chosen" (list (string-constant initial-language-category) (string-constant no-language-chosen)) (list 10000 1000) diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index bc8beaa1cc..9b118311f8 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -61,6 +61,7 @@ get-language-position get-language-name + get-language-id get-style-delta get-language-numbers get-one-line-summary @@ -89,6 +90,7 @@ render-value get-language-position + get-language-id get-language-numbers get-one-line-summary get-language-url)) @@ -97,6 +99,7 @@ (interface () get-module get-language-position + get-language-id get-language-numbers get-one-line-summary get-language-url @@ -131,9 +134,14 @@ (read-syntax src port))]) (if (eof-object? v) v - (namespace-syntax-introduce v)))))) + (namespace-syntax-introduce v))))) + (language-id (if (pair? language-position) + (car (last-pair language-position)) + (error 'simple-module-based-language<%> + "expected non-empty list of strings, got ~e" language-position)))) (define/public (get-module) module) (define/public (get-language-position) language-position) + (define/public (get-language-id) language-id) (define/public (get-language-numbers) language-numbers) (define/public (get-one-line-summary) one-line-summary) (define/public (get-language-url) language-url) diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss index d37f4dd59b..75cee94ef6 100644 --- a/collects/drscheme/private/main.ss +++ b/collects/drscheme/private/main.ss @@ -317,18 +317,22 @@ (λ (x) (let ([lang (drscheme:language-configuration:language-settings-language x)] [settings (drscheme:language-configuration:language-settings-settings x)]) - (list (send lang get-language-position) + (list (send lang get-language-id) (send lang marshall-settings settings)))) (λ (x) - (and (list? x) + (and (list? x) (= 2 (length x)) - (let* ([lang-position (first x)] + (let* ([lang-id (first x)] [marshalled-settings (second x)] [lang (ormap (λ (x) - (and (equal? lang-position - (send x get-language-position)) - x)) + (and (or (equal? (send x get-language-id) lang-id) + + ;; this second branch of the `or' corresdponds + ;; to preferences saved from earlier versions of + ;; drscheme, for a sort of backwards compatibility + (equal? (send x get-language-position) lang-id)) + x)) (drscheme:language-configuration:get-languages))]) (and lang (let ([settings (send lang unmarshall-settings marshalled-settings)]) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index 911ee91015..db67ae5afd 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -57,6 +57,8 @@ (define/override (config-panel parent) (module-language-config-panel parent)) + (define/override (get-language-id) "plt:module") + (define/override (default-settings) (let ([super-defaults (super default-settings)]) (apply make-module-language-settings diff --git a/collects/eopl/eopl-tool.ss b/collects/eopl/eopl-tool.ss index 4fb8761573..f5d783bbee 100644 --- a/collects/eopl/eopl-tool.ss +++ b/collects/eopl/eopl-tool.ss @@ -27,6 +27,7 @@ wraps the load of the module.) (define/public (get-language-position) (list (string-constant teaching-languages) "Essentials of Programming Languages (2nd ed.)")) + (define/public (get-language-id) "plt:eopl") (define/public (get-module) '(lib "eopl.ss" "eopl")) (define/public (get-one-line-summary) diff --git a/collects/frtime/frtime-tool.ss b/collects/frtime/frtime-tool.ss index b402445a87..c730bcc4b5 100644 --- a/collects/frtime/frtime-tool.ss +++ b/collects/frtime/frtime-tool.ss @@ -20,6 +20,7 @@ '(1000 -400 1)) (define/public (get-language-position) (list (string-constant experimental-languages) "FrTime" "Minimal")) + (define/public (get-langauge-id) "plt:frtime") (define/public (get-module) '(lib "frtime.ss" "frtime")) (define/public (get-one-line-summary) @@ -39,6 +40,7 @@ '(1000 -400)) (define/public (get-language-position) (list (string-constant experimental-languages) "FrTime")) + (define/public (get-language-id) "plt:frtime-big") (define/public (get-module) '(lib "frtime-big.ss" "frtime")) (define/public (get-one-line-summary) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index 1d611994dc..2f6137f9e3 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -935,6 +935,7 @@ tracing todo: (list (string-constant teaching-languages) (string-constant how-to-design-programs) (string-constant advanced-student))) + (language-id "plt:advanced-student") (language-numbers '(-500 -500 5)) (sharing-printing #t) (abbreviate-cons-as-list #t) @@ -949,6 +950,7 @@ tracing todo: (list (string-constant teaching-languages) (string-constant how-to-design-programs) (string-constant intermediate-student/lambda))) + (language-id "plt:intermediate-student/lambda") (style-delta (let ([match (regexp-match-positions "lambda" (string-constant intermediate-student/lambda))]) @@ -972,6 +974,7 @@ tracing todo: (list (string-constant teaching-languages) (string-constant how-to-design-programs) (string-constant intermediate-student))) + (language-id "plt:intermediate-student") (language-numbers '(-500 -500 3)) (sharing-printing #f) (abbreviate-cons-as-list #t) @@ -987,6 +990,7 @@ tracing todo: (list (string-constant teaching-languages) (string-constant how-to-design-programs) (string-constant beginning-student/abbrev))) + (language-id "plt:beginning-student/abbrev") (language-numbers '(-500 -500 2)) (sharing-printing #f) (abbreviate-cons-as-list #t) @@ -1002,6 +1006,7 @@ tracing todo: (string-constant how-to-design-programs) (string-constant beginning-student))) (language-numbers '(-500 -500 1)) + (language-id "plt:beginning-student") (sharing-printing #f) (abbreviate-cons-as-list #f) (allow-sharing? #f) diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index 1051ec5bb2..9db287f04a 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -587,8 +587,9 @@ (define/public (get-comment-character) (values "//" #\*)) (define/public (get-style-delta) #f) + (define/public (get-language-id) (format "plt:~a" name)) ;; name is assume to be constant (ie, not a string-constant that can be translated) (define/public (get-language-position) - (cons (string-constant experimental-languages) (list "ProfessorJ" name) )) + (cons (string-constant experimental-languages) (list "ProfessorJ" name))) (define/public (get-language-numbers) (list 1000 10 number)) (define/public (get-language-name) (string-append "ProfessorJ: " name)) (define/public (get-language-url) #f) diff --git a/collects/slideshow/tool.ss b/collects/slideshow/tool.ss index 050111121d..7c50357d5c 100644 --- a/collects/slideshow/tool.ss +++ b/collects/slideshow/tool.ss @@ -714,6 +714,7 @@ pict snip : [(syntax? sv) (rewrite-syntax sv)] [else sv]))))) (define/override (get-language-name) "Slideshow") + (define/override (get-language-id) "plt:slideshow") (super-new (module '(lib "plt-mred.ss" "lang")) (language-position (list (string-constant experimental-languages) "Slideshow")) diff --git a/collects/swindle/tool.ss b/collects/swindle/tool.ss index da12df8e81..fe92d5b79b 100644 --- a/collects/swindle/tool.ss +++ b/collects/swindle/tool.ss @@ -21,6 +21,7 @@ (class* object% (drscheme:language:simple-module-based-language<%>) (define/public (get-language-numbers) '(-1000 2000 0)) + (define/public (get-language-id) (format "plt:~a" l-name)) ;; assumed to always be the same, (ie, not translated) (define/public (get-language-position) (list (string-constant professional-languages) "Swindle" l-entry-name))