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

simplified hopeless-exception raising

Browse Source 
svn: r10615
This commit is contained in:
Eli Barzilay 2008-07-05 04:51:15 +00:00
parent df2b02ed94
commit 4952fa6db9
1 changed files with 17 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -246,29 +246,23 @@
(define hopeless-repl (make-thread-cell #t))
(define (raise-hopeless-exception exn [prefix #f])
(define rep (drscheme:rep:current-rep))
;; if we don't have the drscheme rep, then we just raise
;; the exception as normal. (I don't think this can happen...?)
(unless rep
(raise exn))
(let ([send-over
(λ (t)
(let ([s (make-semaphore 0)])
(parameterize ([current-eventspace drscheme:init:system-eventspace])
(queue-callback
(λ ()
(t)
(semaphore-post s))))
(semaphore-wait s)))])
(send-over (λ () (send rep set-show-no-user-evaluation-message? #f)))
(when prefix
(fprintf (current-error-port) "Module Language: ~a\n" prefix))
((error-display-handler) (exn-message exn) exn)
(send-over
(λ () (send rep insert-warning "\nInteractions disabled.")))
(custodian-shutdown-all (send rep get-user-custodian))))
;; 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))
(when prefix (fprintf (current-error-port) "Module Language: ~a\n" prefix))
((error-display-handler) (exn-message exn) exn)
;; do the rep-related work carefully -- using drscheme's eventspace, and
;; wait for it to finish before we continue.
(let ([s (make-semaphore 0)])
(parameterize ([current-eventspace drscheme:init:system-eventspace])
(queue-callback
(λ ()
(send* rep (insert-warning "\nInteractions disabled.")
(set-show-no-user-evaluation-message? #f))
(semaphore-post s))))
(semaphore-wait s))
(custodian-shutdown-all (send rep get-user-custodian)))
(define (raise-hopeless-syntax-error . error-args)
(with-handlers ([exn? raise-hopeless-exception])
(apply raise-syntax-error '|Module Language|