aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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)))