suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
* 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
This commit is contained in:
Eli Barzilay 2008-08-08 08:25:17 +00:00
parent c9933fdd6b
commit 372bbefdb3
3 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

6
collects/drscheme/private/rep.ss
View File

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

20
collects/tests/drscheme/module-lang-test.ss
View File

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