diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/condition.scm | 56 |
1 files changed, 39 insertions, 17 deletions
diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm index 2fc0e33..85ab70e 100644 --- a/src/guile/skribilo/condition.scm +++ b/src/guile/skribilo/condition.scm @@ -23,6 +23,7 @@ :autoload (srfi srfi-34) (with-exception-handler) :use-module (srfi srfi-35) :use-module (srfi srfi-39) + :autoload (skribilo parameters) (*destination-file*) :autoload (skribilo utils syntax) (_ N_) :export (&skribilo-error skribilo-error? &invalid-argument-error invalid-argument-error? @@ -127,7 +128,18 @@ (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.")))))) + (format (current-error-port) (_ "Use `GUILE=\"guile --debug\" skribilo ...' for a detailed stack trace.~%")))))) + +(define (abort exit-val) + ;; Abort the `skribilo' command-line program, returning EXIT-VAL. + + ;; XXX: Whether this works depends on whether `with-exception-handler' is + ;; broken, see below. + (and (string? (*destination-file*)) + (false-if-exception (delete-file (*destination-file*)))) + + (show-stack-trace) + (exit exit-val)) (define (%call-with-skribilo-error-catch thunk exit exit-val) (with-exception-handler @@ -137,45 +149,39 @@ (_ "in `~a': invalid argument: ~S~%") (invalid-argument-error:proc-name c) (invalid-argument-error:argument c)) - (show-stack-trace) - (exit exit-val)) + (abort exit-val)) ((too-few-arguments-error? c) (format (current-error-port) (_ "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)) + (abort exit-val)) ((file-search-error? c) (format (current-error-port) (_ "~a: not found in path `~S'~%") (file-error:file-name c) (file-search-error:path c)) - (show-stack-trace) - (exit exit-val)) + (abort 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)) + (abort 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)) + (abort exit-val)) ((file-error? c) (format (current-error-port) (_ "file error: ~a~%") (file-error:file-name c)) - (show-stack-trace) - (exit exit-val)) + (abort exit-val)) ((skribilo-error? c) (let ((handler (lookup-error-condition-handler c))) @@ -184,13 +190,16 @@ (format (current-error-port) (_ "undefined skribilo error: ~S~%") c))) - (show-stack-trace) - (exit exit-val)) + (abort exit-val)) ((message-condition? c) (format (current-error-port) (condition-message c)) - (show-stack-trace) - (exit exit-val)))) + (abort exit-val)) + + (else + (format (current-error-port) + (_ "unexpected error condition: ~A~%") c) + (abort exit-val)))) thunk)) @@ -201,5 +210,18 @@ (define (call-with-skribilo-error-catch/exit thunk) (%call-with-skribilo-error-catch thunk primitive-exit 1)) + +;;; +;;; SRFI-34 replacement. +;;; + +(define (with-exception-handler handler thunk) + ;; Work around a "bug" in `with-exception-handler' in Guile up to 1.8.5. + ;; See http://thread.gmane.org/gmane.lisp.guile.user/6969 for details. + ;; XXX: This code is useless for 1.8.6 and later. + (with-throw-handler 'srfi-34 + thunk + (lambda (key obj) + (handler obj)))) ;;; conditions.scm ends here |