diff options
author | Ludovic Courtès | 2008-11-23 01:19:58 +0100 |
---|---|---|
committer | Ludovic Courtès | 2008-11-23 01:21:04 +0100 |
commit | d70349707d5aed8a48176937235866e52126ec6e (patch) | |
tree | c62cc3a45c54430267f8c1e71cec6e6bce0332ec /src/guile | |
parent | 4cb21ba4a7a8a6ee2678657d4d7cae82b96c554b (diff) | |
download | skribilo-d70349707d5aed8a48176937235866e52126ec6e.tar.gz skribilo-d70349707d5aed8a48176937235866e52126ec6e.tar.lz skribilo-d70349707d5aed8a48176937235866e52126ec6e.zip |
Try to display a stack trace in `call-with-skribilo-error-catch'.
* src/guile/skribilo/condition.scm (show-stack-trace): New.
(%call-with-skribilo-error-catch): Use `with-exception-handler'
instead of `guard' so the faulty call stack can be captured. Use
`show-stack-trace'.
* NEWS: Update.
Diffstat (limited to 'src/guile')
-rw-r--r-- | src/guile/skribilo/condition.scm | 29 |
1 files changed, 25 insertions, 4 deletions
diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm index 2accab2..2fc0e33 100644 --- a/src/guile/skribilo/condition.scm +++ b/src/guile/skribilo/condition.scm @@ -20,7 +20,7 @@ (define-module (skribilo condition) :autoload (srfi srfi-1) (find) - :autoload (srfi srfi-34) (guard) + :autoload (srfi srfi-34) (with-exception-handler) :use-module (srfi srfi-35) :use-module (srfi srfi-39) :autoload (skribilo utils syntax) (_ N_) @@ -118,12 +118,26 @@ ;;; Convenience functions. ;;; +(define (show-stack-trace) + ;; Display a backtrace to stderr if possible. + (let ((stack (make-stack #t))) + (if stack + (begin + (format (current-error-port) "~%Call stack:~%") + (display-backtrace stack (current-error-port))) + (begin + (format (current-error-port) (_ "Call stack trace not available.~%")) + (format (current-error-port) (_ "Use `GUILE=\"guile --debug\" skribilo ...' for a detailed stack trace.")))))) + (define (%call-with-skribilo-error-catch thunk exit exit-val) - (guard (c ((invalid-argument-error? c) + (with-exception-handler + (lambda (c) + (cond ((invalid-argument-error? c) (format (current-error-port) (_ "in `~a': invalid argument: ~S~%") (invalid-argument-error:proc-name c) (invalid-argument-error:argument c)) + (show-stack-trace) (exit exit-val)) ((too-few-arguments-error? c) @@ -131,6 +145,7 @@ (_ "in `~a': too few arguments: ~S~%") (too-few-arguments-error:proc-name c) (too-few-arguments-error:arguments c)) + (show-stack-trace) (exit exit-val)) ((file-search-error? c) @@ -138,24 +153,28 @@ (_ "~a: not found in path `~S'~%") (file-error:file-name c) (file-search-error:path c)) + (show-stack-trace) (exit exit-val)) ((file-open-error? c) (format (current-error-port) (_ "~a: cannot open file~%") (file-error:file-name c)) + (show-stack-trace) (exit exit-val)) ((file-write-error? c) (format (current-error-port) (_ "~a: cannot write to file~%") (file-error:file-name c)) + (show-stack-trace) (exit exit-val)) ((file-error? c) (format (current-error-port) (_ "file error: ~a~%") (file-error:file-name c)) + (show-stack-trace) (exit exit-val)) ((skribilo-error? c) @@ -165,13 +184,15 @@ (format (current-error-port) (_ "undefined skribilo error: ~S~%") c))) + (show-stack-trace) (exit exit-val)) ((message-condition? c) (format (current-error-port) (condition-message c)) - (exit exit-val))) + (show-stack-trace) + (exit exit-val)))) - (thunk))) + thunk)) (define-macro (call-with-skribilo-error-catch thunk) `(call/cc (lambda (cont) |