fix bug in detecting the name of the language

(encoding problems)

Also, Rackety
This commit is contained in:
Robby Findler 2012-10-22 11:49:14 -05:00
parent 7355c59fb1
commit b61f1789c7

View File

@ -145,29 +145,31 @@
(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* ([defs-port (open-input-text-editor defs-text)] (define defs-port (open-input-text-editor defs-text))
[read-successfully? (port-count-lines! defs-port)
(with-handlers ((exn:fail? (λ (x) #f))) (define read-successfully?
(read-language defs-port (λ () #f)) (with-handlers ((exn:fail? (λ (x) #f)))
#t)]) (read-language defs-port (λ () #f))
(cond #t))
[read-successfully? (cond
(let* ([str (send defs-text get-text 0 (file-position defs-port))] [read-successfully?
[pos (regexp-match-positions #rx"#(?:!|lang )" str)]) (define-values (_line _col port-pos) (port-next-location defs-port))
(cond (define str (send defs-text get-text 0 (- port-pos 1)))
[(not pos) (define pos (regexp-match-positions #rx"#(?:!|lang )" str))
(get-language-name)] (cond
[else [(not pos)
;; newlines can break things (ie the language text won't (get-language-name)]
;; be in the right place in the interactions window, which [else
;; at least makes the test suites unhappy), so get rid of ;; newlines can break things (ie the language text won't
;; them from the name. Otherwise, if there is some weird formatting, ;; be in the right place in the interactions window, which
;; so be it. ;; at least makes the test suites unhappy), so get rid of
(regexp-replace* #rx"[\r\n]+" ;; them from the name. Otherwise, if there is some weird formatting,
(substring str (cdr (car pos)) (string-length str)) ;; so be it.
" ")]))] (regexp-replace* #rx"[\r\n]+"
[else (substring str (cdr (car pos)) (string-length str))
(get-language-name)]))) " ")])]
[else
(get-language-name)]))
(define/override (use-namespace-require/copy?) #f) (define/override (use-namespace-require/copy?) #f)