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

Refactor the error handling code, making it more uniform for all error cases.

Browse Source
This commit is contained in:
Eli Barzilay 2011-06-01 15:57:25 -04:00
parent c32efa727c
commit c82d8cea32
1 changed files with 24 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
collects/help/bug-report.rkt
View File

@ -214,45 +214,32 @@
(send response-text auto-wrap #t) (send response-text auto-wrap #t)
(send response-text lock #t) (send response-text lock #t)
(channel-put response-chan response-text))))))))) (channel-put response-chan response-text)))))))))
(define (render-error to-render)
(cond
[(string? to-render)
(let ([str (string-append "<pre>\n\nERROR:\n"to-render"\n</pre>\n")])
(render-error (open-input-string str)))]
[(exn? to-render) (render-error (exn-message to-render))]
[(input-port? to-render)
(queue-callback
(λ ()
(with-pending-text
(λ () (render-html-to-text to-render pending-text #t #f)))
(send pending-back enable #t)
(send pending-abort enable #f)))]
[else (error 'render-error "internal error")]))
(thread (thread
(λ () (λ ()
(sync (sync (handle-evt exn-chan render-error)
(handle-evt (handle-evt (thread-dead-evt worker-thread)
exn-chan (λ (_) (render-error "reporting process killed")))
(λ (exn) (handle-evt response-chan
(queue-callback (λ (finished-text)
(λ () (queue-callback
(define sp (open-output-string)) (λ ()
(define-values (in out) (make-pipe)) (switch-to-finished-view finished-text))))))))
(thread
(λ ()
(fprintf out "<pre>\n")
(display (exn-message exn) out)
(fprintf out "\n</pre>\n")
(close-output-port out)))
(with-pending-text
(λ () (render-html-to-text in pending-text #t #f)))
(send pending-back enable #t)
(send pending-abort enable #f)))))
(handle-evt
(thread-dead-evt worker-thread)
(λ (_)
(queue-callback
(λ ()
(with-pending-text
(λ ()
(define p (send pending-text last-position))
(send pending-text insert "Killed." p p)))
(send pending-back enable #t)
(send pending-abort enable #f)))))
(handle-evt
response-chan
(λ (finished-text)
(queue-callback
(lambda ()
(switch-to-finished-view finished-text))))))))
(init-pending-view)) (init-pending-view))
(define (ok) (define (ok)