summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Court`es2006-06-06 09:21:27 +0000
committerLudovic Court`es2006-06-06 09:21:27 +0000
commit2c02c5b84395f1669e1ebbfe91013408fdf3eeaa (patch)
tree408a0162009929cd7dbe02be743ad7d314397403
parent1fcd75bfb36d9b58bd08b0cf947457f38a9cb4c8 (diff)
downloadskribilo-2c02c5b84395f1669e1ebbfe91013408fdf3eeaa.tar.gz
skribilo-2c02c5b84395f1669e1ebbfe91013408fdf3eeaa.tar.lz
skribilo-2c02c5b84395f1669e1ebbfe91013408fdf3eeaa.zip
Generalized the error condition handling framework.
* src/guile/skribilo/condition.scm (&too-few-arguments-error): New. (%external-error-condition-alist): New. (register-error-condition-handler!): New. (lookup-error-condition-handler): New. (%call-with-skribilo-error-catch): Handle `too-few-arguments-error?'. Use `lookup-error-condition-handler' when unhandled exceptions are caught. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-86
-rw-r--r--src/guile/skribilo/condition.scm50
1 files changed, 47 insertions, 3 deletions
diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm
index 820dcc5..e063b4f 100644
--- a/src/guile/skribilo/condition.scm
+++ b/src/guile/skribilo/condition.scm
@@ -19,16 +19,22 @@
;;; USA.
(define-module (skribilo condition)
+ :autoload (srfi srfi-1) (find)
:autoload (srfi srfi-34) (guard)
:use-module (srfi srfi-35)
:use-module (srfi srfi-39)
:export (&skribilo-error skribilo-error?
&invalid-argument-error invalid-argument-error?
+ &too-few-arguments-error too-few-arguments-error?
+
&file-error file-error?
&file-search-error file-search-error?
&file-open-error file-open-error?
&file-write-error file-write-error?
+ register-error-condition-handler!
+ lookup-error-condition-handler
+
%call-with-skribilo-error-catch
call-with-skribilo-error-catch))
@@ -58,6 +64,11 @@
(proc-name invalid-argument-error:proc-name)
(argument invalid-argument-error:argument))
+(define-condition-type &too-few-arguments-error &skribilo-error
+ too-few-arguments-error?
+ (proc-name too-few-arguments-error:proc-name)
+ (arguments too-few-arguments-error:arguments))
+
;;;
;;; File errors.
@@ -80,6 +91,28 @@
;;;
+;;; Adding new error conditions from other modules.
+;;;
+
+(define %external-error-condition-alist '())
+
+(define (register-error-condition-handler! pred handler)
+ (set! %external-error-condition-alist
+ (cons (cons pred handler)
+ %external-error-condition-alist)))
+
+(define (lookup-error-condition-handler c)
+ (let ((pair (find (lambda (pair)
+ (let ((pred (car pair)))
+ (pred c)))
+ %external-error-condition-alist)))
+ (if (pair? pair)
+ (cdr pair)
+ #f)))
+
+
+
+;;;
;;; Convenience functions.
;;;
@@ -90,6 +123,11 @@
(invalid-argument-error:argument c))
(exit 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)))
+
((file-search-error? c)
(format (current-error-port) "~a: not found in path `~S'~%"
(file-error:file-name c)
@@ -111,9 +149,15 @@
(file-error:file-name c))
(exit exit-val))
- ((skribilo-error? c)
- (format (current-error-port) "undefined skribilo error: ~S~%"
- c)
+ (;;(skribilo-error? c)
+ #t ;; XXX: The SRFI-35 currently in `guile-lib' doesn't work
+ ;; properly with non-direct super-types.
+ (let ((handler (lookup-error-condition-handler c)))
+ (if (procedure? handler)
+ (handler c)
+ (format (current-error-port)
+ "undefined skribilo error: ~S~%"
+ c)))
(exit exit-val)))
(thunk)))