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

adjust the way internal errors are shown in DrRacket

Browse Source 
so that printing an error no longer blocks (on user actions) but still
uses the GUI. Also: when new errors are generated while a dialog box
showing an error is still open, then just ignore those errors. Also,
if an error is generated that has been shown in the last 5 minutes, ignore
the new one.
This commit is contained in:
Robby Findler 2012-02-14 10:40:50 -06:00
parent 4763fb5189
commit 0e543fc66b
1 changed files with 53 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/drracket/private/init.rkt
View File

@ -31,24 +31,65 @@
(define system-security-guard (current-security-guard))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; internal error display support
;;
(define error-display-chan (make-channel))
(thread
(λ ()
(define-struct recent (msg when))
(define currently-visible-chan (make-channel))
(let loop ([recently-seen-errors/unfiltered '()]
[currently-visible #f])
(sync
(handle-evt
error-display-chan
(λ (msg+exn)
(define recently-seen-errors
;; recent errors are ones less than 5 minutes old
(let ([now (current-seconds)])
(filter (λ (x) (<= (+ (recent-when x) (* 60 5)) now))
recently-seen-errors/unfiltered)))
(define-values (msg exn) (apply values msg+exn))
(cond
[currently-visible
;; drop errors when we have one waiting to be clicked on
(loop recently-seen-errors #t)]
[(ormap (λ (x) (equal? msg (recent-msg x)))
recently-seen-errors)
;; drop the error if we've seen it recently
(loop recently-seen-errors #f)]
[else
;; show the error
(define title (error-display-handler-message-box-title))
(define text (let ([p (open-output-string)])
(parameterize ([current-error-port p]
[current-output-port p])
(original-error-display-handler msg exn))
(get-output-string p)))
(parameterize ([current-eventspace error-display-eventspace]
[current-custodian system-custodian])
(thread
(λ ()
(message-box title text #f '(stop ok) #:dialog-mixin frame:focus-table-mixin)
(channel-put currently-visible #f))))
(loop (cons (make-recent msg (current-seconds)) recently-seen-errors)
#t)])))
(handle-evt
currently-visible-chan
(λ (val)
(loop recently-seen-errors/unfiltered #f)))))))
;; override error-display-handler to duplicate the error
;; message in both the standard place (as defined by the
;; current error-display-handler) and in a message box
;; identifying the error as a drscheme internal error.
(error-display-handler
(λ (msg exn)
;; this may raise an exception if the port is gone.
(with-handlers ([exn:fail? (λ (x) (void))])
(original-error-display-handler msg exn))
(let ([title (error-display-handler-message-box-title)])
(let ([text (let ([p (open-output-string)])
(parameterize ([current-error-port p]
[current-output-port p])
(original-error-display-handler msg exn))
(get-output-string p))])
(parameterize ([current-custodian system-custodian])
(parameterize ([current-eventspace error-display-eventspace])
(message-box title text #f '(stop ok) #:dialog-mixin frame:focus-table-mixin)))))))
(channel-put error-display-chan (list msg exn))))