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

now allow strings (as relative paths) in drscheme-language-modules

Browse Source 
svn: r2068
This commit is contained in:
Robby Findler 2006-02-01 03:56:51 +00:00
parent d9abc7f2cf
commit c1630e256f
1 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,6 +5,7 @@
(lib "class.ss") (lib "class.ss")
(lib "contract.ss") (lib "contract.ss")
(lib "kw.ss") (lib "kw.ss")
(lib "string.ss")
"drsig.ss" "drsig.ss"
(lib "string-constant.ss" "string-constants") (lib "string-constant.ss" "string-constants")
(lib "mred.ss" "mred") (lib "mred.ss" "mred")
@ -1121,7 +1122,8 @@
(define (add-info-specified-languages) (define (add-info-specified-languages)
(for-each add-info-specified-language (find-relevant-directories '(drscheme-language-positions)))) (for-each add-info-specified-language
(find-relevant-directories '(drscheme-language-positions))))
(define (add-info-specified-language directory) (define (add-info-specified-language directory)
(let ([info-proc (get-info/full directory)]) (let ([info-proc (get-info/full directory)])
@ -1146,6 +1148,7 @@
(λ () (λ ()
(map (λ (lang-position) #f) (map (λ (lang-position) #f)
lang-positions)))]) lang-positions)))])
(printf "dir ~s lang-positions ~s\n" directory lang-positions)
(cond (cond
[(and (list? lang-positions) [(and (list? lang-positions)
(andmap (λ (lang-position numbers) (andmap (λ (lang-position numbers)
@ -1160,8 +1163,9 @@
numberss) numberss)
(list? lang-modules) (list? lang-modules)
(andmap (λ (x) (andmap (λ (x)
(or (string? x)
(and (list? x) (and (list? x)
(andmap string? x))) (andmap string? x))))
lang-modules) lang-modules)
(list? summaries) (list? summaries)
(andmap string? summaries) (andmap string? summaries)
@ -1209,7 +1213,11 @@
'drscheme)) 'drscheme))
read-syntax/namespace-introduce)]) read-syntax/namespace-introduce)])
(add-language (instantiate % () (add-language (instantiate % ()
(module `(lib ,@lang-module)) (module (if (string? lang-module)
(build-path
directory
(platform-independent-string->path lang-module))
`(lib ,@lang-module)))
(language-position lang-position) (language-position lang-position)
(language-numbers lang-numbers) (language-numbers lang-numbers)
(one-line-summary one-line-summary) (one-line-summary one-line-summary)
@ -1233,6 +1241,16 @@
urls urls
reader-specs))]))))) reader-specs))])))))
(define (platform-independent-string->path str)
(apply
build-path
(map (λ (x)
(cond
[(string=? ".." x) 'up]
[(string=? "." x) 'same]
[else x]))
(regexp-split #rx"/" str))))
(define read-syntax/namespace-introduce (define read-syntax/namespace-introduce
(opt-lambda (source-name-v [input-port (current-input-port)]) (opt-lambda (source-name-v [input-port (current-input-port)])
(let ([v (read-syntax source-name-v input-port)]) (let ([v (read-syntax source-name-v input-port)])