From: Christopher Allan Webber Date: Sat, 28 Nov 2015 14:52:48 +0000 (-0600) Subject: Fancy printed exceptions if it's an asynchronous exception X-Git-Tag: v0.1.0~52 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=bab788cecd849975fc10e39b193dad304b186fe4;p=8sync.git Fancy printed exceptions if it's an asynchronous exception --- diff --git a/eightsync/agenda.scm b/eightsync/agenda.scm index 7ee0ec4..2a43135 100644 --- a/eightsync/agenda.scm +++ b/eightsync/agenda.scm @@ -700,12 +700,27 @@ return the wrong thing via (%8sync) and trip themselves up." (define (print-error-and-continue key . args) "Frequently used as pre-unwind-handler for agenda" - (format (current-error-port) - "\n*** Caught exception with key '~s and arguments: ~s ***\n" - key args) - (display-backtrace (make-stack #t 1 0) - (current-error-port)) - (newline (current-error-port))) + (cond + ((eq? key '8sync-caught-error) + (match args + ((orig-key orig-args stacks) + (display "\n*** Caught async exception. ***\n") + (format (current-error-port) + "* Original key '~s and arguments: ~s *\n" + orig-key orig-args) + (display "* Caught stacks below (ending with original) *\n\n") + (for-each + (lambda (s) + (display-backtrace s (current-error-port)) + (newline (current-error-port))) + stacks)))) + (else + (format (current-error-port) + "\n*** Caught exception with key '~s and arguments: ~s ***\n" + key args) + (display-backtrace (make-stack #t 1 0) + (current-error-port)) + (newline (current-error-port))))) (define-syntax-rule (maybe-catch-all (catch-handler pre-unwind-handler) body ...)