From 3c3d84832499392d9bab94841e8229ea3531c4bc Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 14 Feb 2007 23:42:42 +0000 Subject: [PATCH] added module language recognition into the mix svn: r5604 --- collects/drscheme/private/unit.ss | 86 +++++++++++++++++++------------ 1 file changed, 54 insertions(+), 32 deletions(-) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index 6abd00e254..7710614a3a 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -460,38 +460,60 @@ module browser threading seems wrong. (begin-edit-sequence)) (define/augment (after-load-file success?) (when success? - (let* ([tp (open-input-text-editor this)] - [l (read-line tp)]) - (unless (eof-object? l) - (unless (regexp-match #rx"[;#]" l) ;; no comments on the first line - (when (equal? #\) (get-character (- (last-position) 1))) - (let ([sp (open-input-string l)]) - (when (regexp-match #rx"[(]" sp) - (let/ec k - (let-values ([(mod name module-spec) - (with-handlers ([exn:fail:read? (λ (x) (k (void)))]) - (values (read sp) - (read sp) - (read sp)))]) - (when (eq? mod 'module) - (let ([matching-language - (ormap - (λ (lang) - (and (equal? module-spec (send lang get-save-module)) - lang)) - (drscheme:language-configuration:get-languages))]) - (delete (- (last-position) 1) (last-position)) - (delete (paragraph-start-position 0) - (paragraph-start-position 1)) - (when matching-language - (unless (eq? (drscheme:language-configuration:language-settings-language - next-settings) - matching-language) - (set-next-settings - (drscheme:language-configuration:make-language-settings - matching-language - (send matching-language default-settings))))) - (set-modified #f)))))))))))) + (let ([found-language? #f]) + (let* ([tp (open-input-text-editor this)] + [l (read-line tp)]) + (unless (eof-object? l) + (unless (regexp-match #rx"[;#]" l) ;; no comments on the first line + (when (equal? #\) (get-character (- (last-position) 1))) + (let ([sp (open-input-string l)]) + (when (regexp-match #rx"[(]" sp) + (let/ec k + (let-values ([(mod name module-spec) + (with-handlers ([exn:fail:read? (λ (x) (k (void)))]) + (values (parameterize ([read-accept-reader #f]) (read sp)) + (parameterize ([read-accept-reader #f]) (read sp)) + (parameterize ([read-accept-reader #f]) (read sp))))]) + (when (eq? mod 'module) + (let ([matching-language + (ormap + (λ (lang) + (and (equal? module-spec (send lang get-save-module)) + lang)) + (drscheme:language-configuration:get-languages))]) + (when matching-language + (delete (- (last-position) 1) (last-position)) + (delete (paragraph-start-position 0) + (paragraph-start-position 1)) + (set! found-language? #t) + (unless (eq? (drscheme:language-configuration:language-settings-language + next-settings) + matching-language) + (set-next-settings + (drscheme:language-configuration:make-language-settings + matching-language + (send matching-language default-settings)))) + (set-modified #f)))))))))))) + (unless found-language? + (let* ([tp (open-input-text-editor this)] + [r1 (parameterize ([read-accept-reader #f]) (read tp))] + [r2 (parameterize ([read-accept-reader #f]) (read tp))]) + (when (and (eof-object? r2) + (pair? r1) + (eq? (car r1) 'module)) + (let ([ml (ormap (λ (lang) + (and (is-a? lang drscheme:module-language:module-language<%>) + lang)) + (drscheme:language-configuration:get-languages))]) + (when ml + (unless (eq? (drscheme:language-configuration:language-settings-language + next-settings) + ml) + (set-next-settings + (drscheme:language-configuration:make-language-settings + ml + (send ml default-settings)))) + (set-modified #f)))))))) (end-edit-sequence) (inner (void) after-load-file success?))