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

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

@ -62,15 +62,25 @@
(inherit get-language-name)
(define/public (get-users-language-name defs-text)
(let* ([i (open-input-text-editor defs-text)]
[l (with-handlers ((exn:fail? (λ (x) '?)))
(read-language i (lambda () '?)))])
(if (eq? '? l)
(get-language-name)
(regexp-replace #rx".*#(?:!|lang ) *"
(send defs-text get-text 0 (file-position i))
""))))
(let ([defs-port (open-input-text-editor defs-text)])
(with-handlers ((exn:fail? (λ (x) (void))))
(let/ec k
(let ([orig-security (current-security-guard)])
(parameterize ([current-security-guard
(make-security-guard
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/augment (capability-value key)