From afe505f7ba9a9f77670b6332c669d58a443257cc Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Tue, 15 Apr 2008 20:44:37 +0200
Subject: Use SRFI-35 exceptions in `(skribilo verify)'.

* src/guile/skribilo/verify.scm (&verify-error,
  &unsupported-markup-option-error, handle-verify-error): New.
  (check-required-options): Use it instead of `skribe-error'.
---
 src/guile/skribilo/verify.scm | 59 ++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 55 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm
index f14138f..654e898 100644
--- a/src/guile/skribilo/verify.scm
+++ b/src/guile/skribilo/verify.scm
@@ -22,17 +22,67 @@
 (define-module (skribilo verify)
   :autoload   (skribilo engine) (engine-ident processor-get-engine)
   :autoload   (skribilo writer) (writer? writer-options lookup-markup-writer)
-  :autoload   (skribilo lib)    (skribe-warning/ast skribe-error)
+  :autoload   (skribilo lib)    (skribe-warning/ast)
   :use-module (skribilo debug)
   :use-module (skribilo ast)
+  :use-module (skribilo condition)
   :use-module (skribilo utils syntax)
+  :autoload   (skribilo location) (location?)
+
+  :autoload   (srfi srfi-34)    (raise)
+  :use-module (srfi srfi-35)
+
   :use-module (oop goops)
+
   :export (verify))
 
 
 (fluid-set! current-reader %skribilo-module-reader)
 
 
+
+;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &verify-error &skribilo-error
+  verify-error?)
+
+(define-condition-type &unsupported-markup-option-error &verify-error
+  unsupported-markup-option-error?
+  (markup  unsupported-markup-option-error:markup)
+  (engine  unsupported-markup-option-error:engine)
+  (option  unsupported-markup-option-error:option))
+
+
+(define (handle-verify-error c)
+  ;; Issue a user-friendly error message for error condition C.
+  (define (show-location obj)
+    (let ((location (and (ast? obj) (ast-loc obj))))
+      (if (location? location)
+          (format (current-error-port) "~a:~a:~a: "
+                  (location-file location)
+                  (location-line location)
+                  (location-column location)))))
+
+  (cond ((unsupported-markup-option-error? c)
+	 (let ((node   (unsupported-markup-option-error:markup c))
+               (engine (unsupported-markup-option-error:engine c))
+               (option (unsupported-markup-option-error:option c)))
+           (show-location node)
+	   (format (current-error-port)
+                   (_ "option `~a' of markup `~a' not supported by engine `~a'~%")
+		   option (and (markup? node)
+                               (markup-markup node))
+                   (engine-ident engine))))
+
+	(else
+	 (format (current-error-port)
+                 (_ "undefined verify error: ~a~%")
+		 c))))
+
+(register-error-condition-handler! verify-error? handle-verify-error)
+
 
 (define-generic verify)
 
@@ -48,9 +98,10 @@
 	(begin
 	  (for-each (lambda (o)
 		      (if (not (memq o options))
-			  (skribe-error (engine-ident engine)
-					(format #f "option unsupported: ~a, supported options: ~a" o options)
-					markup)))
+                          (raise (condition (&unsupported-markup-option-error
+                                             (markup markup)
+                                             (option o)
+                                             (engine engine))))))
 		    required-options)
 	  (slot-set! writer 'verified? #t)))))
 
-- 
cgit v1.2.3