diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index b0ffa5610d..c1b4601974 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -174,9 +174,10 @@ (define modspec (or path `',(syntax-e name))) (define (check-interactive-language) (unless (memq '#%top-interaction (namespace-mapped-symbols)) - (raise-hopeless-syntax-error - "invalid language (no #%top-interaction binding)" - lang))) + (raise-hopeless-exception + #f #f ; no error message, just a suffix + (format "~s does not support a REPL (no #%top-interaction)" + (syntax->datum lang))))) ;; We're about to send the module expression to drscheme now, the rest ;; of the setup is done in `front-end/finished-complete-program' below, ;; so use `repl-init-thunk' to store an appropriate continuation for @@ -261,23 +262,31 @@ [language-position (list "Module")] [language-numbers (list -32768)]))) - (define (raise-hopeless-exception exn [prefix #f]) + ;; can be called with #f to just kill the repl (in case we want to kill it + ;; but keep the highlighting of a previous error) + (define (raise-hopeless-exception exn [prefix #f] [suffix #f]) (define rep (drscheme:rep:current-rep)) - ;; if we don't have the drscheme rep, then we just raise the exception as - ;; normal. (It can happen in some rare cases like having a single empty - ;; scheme box in the definitions.) - (unless rep (raise exn)) + ;; Throw an error as usual if we don't have the drscheme rep, then we just + ;; raise the exception as normal. (It can happen in some rare cases like + ;; having a single empty scheme box in the definitions.) + (unless rep (if exn (raise exn) (error "\nInteractions disabled"))) (when prefix (fprintf (current-error-port) "Module Language: ~a\n" prefix)) - ((error-display-handler) (exn-message exn) exn) + (when exn ((error-display-handler) (exn-message exn) exn)) + ;; these are needed, otherwise the warning can appear before the output + (flush-output (current-output-port)) + (flush-output (current-error-port)) ;; do the rep-related work carefully -- using drscheme's eventspace, and ;; wait for it to finish before we continue. - (let ([s (make-semaphore 0)]) + (let ([s (make-semaphore 0)] + [msg (string-append "\nInteractions disabled" + (if suffix (string-append ": " suffix) "."))]) (parameterize ([current-eventspace drscheme:init:system-eventspace]) (queue-callback (λ () - (send* rep (insert-warning "\nInteractions disabled.") - (set-show-no-user-evaluation-message? #f) - (highlight-errors/exn exn)) + (send rep call-without-reset-highlighting + (λ () + (send* rep (insert-warning msg) + (set-show-no-user-evaluation-message? #f)))) (semaphore-post s)))) (semaphore-wait s)) (custodian-shutdown-all (send rep get-user-custodian))) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index 53dbb4878e..59807194c4 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -733,8 +733,12 @@ TODO (when first-loc (send first-file set-caret-owner (get-focus-snip) 'global))))) + (define highlights-can-be-reset (make-parameter #t)) (define/public (reset-highlighting) - (reset-error-ranges)) + (when (highlights-can-be-reset) (reset-error-ranges))) + (define/public (call-without-reset-highlighting thunk) + (parameterize ([highlights-can-be-reset #f]) + (thunk))) ;; remove-duplicate-error-arrows : (listof X) -> (listof X) ;; duplicate arrows point from and to the same place -- only diff --git a/collects/tests/drscheme/module-lang-test.ss b/collects/tests/drscheme/module-lang-test.ss index 8a3f518856..d13ca363b7 100644 --- a/collects/tests/drscheme/module-lang-test.ss +++ b/collects/tests/drscheme/module-lang-test.ss @@ -159,6 +159,7 @@ (test @t{(module m (file "@in-here{module-lang-test-tmp1.ss}") 1 2 3)} @t{1} ;; just make sure no errors. "1") + ;; check that we have a working repl in the right language after ;; syntax errors, unless it's a bad language (test @t{#lang scheme @@ -182,13 +183,13 @@ @rx{. /: division by zero 123} #t) -(test @t{(module xx scheme/list ;"xx.ss" ;scheme/list +(test @t{(module xx scheme/list (define x 1) (define y (/ 0)))} #f @rx{no #%module-begin binding in the module's language - Module Language: invalid language \(no #%top-interaction binding\) - Interactions disabled} + Interactions disabled: + does not support a REPL \(no #%top-interaction\)} #t) (test @t{(module xx (file "@in-here{module-lang-test-tmp4.ss}") (define x 1) @@ -196,8 +197,9 @@ #f @rx{444 123 - Module Language: invalid language \(no #%top-interaction binding\) - Interactions disabled} + Interactions disabled: + does not support a REPL \(no #%top-interaction\) + } #t) (test @t{(module xx (file "@in-here{this-file-does-not-exist}") (define x 1) @@ -208,6 +210,14 @@ Module Language: invalid language specification Interactions disabled} #t) +(test @t{#lang setup/infotab} + #f + ;; test the complete buffer, to make sure that there is no error + (regexp (string-append "^Welcome to DrScheme, [^\n]*\n" + "Language: Module[^\n]*\n\n" + "Interactions disabled: setup/infotab does not" + " support a REPL \\(no #%top-interaction\\)\n*$")) + #t) (test @t{#lang scheme/load (module m mzscheme (provide x) (define x 2))