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

improved the module langauge's name printing

Browse Source 
svn: r17895
This commit is contained in:
Robby Findler 2010-01-30 16:51:24 +00:00
parent 0e6c28e4b1
commit 6f17b84706
1 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,14 +62,24 @@
(inherit get-language-name) (inherit get-language-name)
(define/public (get-users-language-name defs-text) (define/public (get-users-language-name defs-text)
(let* ([i (open-input-text-editor defs-text)] (let ([defs-port (open-input-text-editor defs-text)])
[l (with-handlers ((exn:fail? (λ (x) '?))) (with-handlers ((exn:fail? (λ (x) (void))))
(read-language i (lambda () '?)))]) (let/ec k
(if (eq? '? l) (let ([orig-security (current-security-guard)])
(get-language-name) (parameterize ([current-security-guard
(regexp-replace #rx".*#(?:!|lang ) *" (make-security-guard
(send defs-text get-text 0 (file-position i)) orig-security
"")))) (lambda (what path modes) #t)
(lambda (what host port mode) (k (void))))])
(read-language defs-port (λ () (void)))
(void)))))
(let* ([str (send defs-text get-text 0 (file-position defs-port))]
[pos (regexp-match-positions #rx"#(?:!|lang )" str)])
(cond
[(not pos)
(get-language-name)]
[else
(substring str (cdr (car pos)) (string-length str))]))))
(define/override (use-namespace-require/copy?) #f) (define/override (use-namespace-require/copy?) #f)