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

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

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