* Added a `call-without-reset-highlighting' to "rep.ss"

* When the language does not have #%top-interaction binding, don't
  throw an error, just disable the repl (useful, for example, with
  setup/infotab as a langauge)
* To do that, used the above new method so that the original error
  highlighting is kept
* Updated tests, and added a test for using setup/infotab, verifying
  that no error is displayed.

svn: r11137

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
+            (raise-hopeless-exception
-             "invalid language (no #%top-interaction binding)"
+             #f #f ; no error message, just a suffix
-             lang)))
+             (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
+    ;; Throw an error as usual if we don't have the drscheme rep, then we just
-    ;; normal.  (It can happen in some rare cases like having a single empty
+    ;; raise the exception as normal.  (It can happen in some rare cases like
-    ;; scheme box in the definitions.)
+    ;; having a single empty scheme box in the definitions.)
-    (unless rep (raise exn))
+    (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.")
+           (send rep call-without-reset-highlighting
-                      (set-show-no-user-evaluation-message? #f)
+             (λ ()
-                      (highlight-errors/exn exn))
+               (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)))

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

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))