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

fixed PR 8186

Browse Source 
svn: r4064
This commit is contained in:
Robby Findler 2006-08-15 03:10:15 +00:00
parent 5ef6eafcdc
commit 67f4db819d
11 changed files with 54 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/algol60/tool.ss
View File

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

21
collects/drscheme/private/language-configuration.ss
View File

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

10
collects/drscheme/private/language.ss
View File

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

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

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

2
collects/drscheme/private/module-language.ss
View File

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

1
collects/eopl/eopl-tool.ss
View File

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

2
collects/frtime/frtime-tool.ss
View File

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

5
collects/lang/htdp-langs.ss
View File

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

3
collects/profj/tool.ss
View File

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

1
collects/slideshow/tool.ss
View File

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

1
collects/swindle/tool.ss
View File

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