From e45c69c4cedf41be1d5fae8cf6b1d13500f945d9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Tue, 15 Apr 2008 21:32:53 +0200
Subject: Use SRFI-35 exceptions in `(skribilo sui)'.

* src/guile/skribilo/sui.scm (&sui-error, &invalid-sui-error,
  handle-sui-error): New.
  Use them instead of `skribe-error'.
---
 src/guile/skribilo/sui.scm | 67 +++++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 16 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm
index 304ae8c..effc263 100644
--- a/src/guile/skribilo/sui.scm
+++ b/src/guile/skribilo/sui.scm
@@ -20,7 +20,6 @@
 ;;; USA.
 
 (define-module (skribilo sui)
-  :use-module (skribilo lib)
   :use-module (skribilo ast)
   :autoload   (skribilo parameters) (*verbose* *destination-file*
                                      *sui-path*)
@@ -28,14 +27,14 @@
   :autoload   (skribilo engine)     (find-engine)
   :autoload   (skribilo evaluator)  (evaluate-document)
   :autoload   (skribilo engine html)(html-file)
-  :autoload   (skribilo condition)  (&file-search-error)
+  :use-module (skribilo condition)
   :use-module (skribilo utils strings)
   :use-module (skribilo utils syntax)
   :use-module (skribilo utils files)
 
   :use-module (ice-9 match)
   :use-module (srfi srfi-1)
-  :use-module (srfi srfi-34)
+  :autoload   (srfi srfi-34)        (raise)
   :use-module (srfi srfi-35)
 
   :export (load-sui sui-ref->url sui-title sui-file sui-key
@@ -48,15 +47,49 @@
 ;;; Author: Manuel Serrano, Ludovic Courtès
 ;;; Commentary:
 ;;;
-;;; Library dealing with Skribe URL Indexes (SUI).
+;;; Library dealing with Skribe URL Indices (SUI).
 ;;;
 ;;; Code:
 
+
+;;;
+;;; Error conditions.
+;;;
+
+(define-condition-type &sui-error &skribilo-error
+  sui-error?)
+
+(define-condition-type &invalid-sui-error &sui-error
+  invalid-sui-error?
+  (sexp   invalid-sui-error:sexp))
 
-;;; The contents of the file below are (almost) unchanged compared to Skribe
-;;; 1.2d's `sui.scm' file found in the `common' directory.
 
+(define (handle-sui-error c)
+  ;; Issue a user-friendly error message for error condition C.
+  (define (show-location sexp)
+    (let* ((props  (and (pair? sexp) (source-properties sexp)))
+           (file   (and props (assoc-ref props 'filename)))
+           (line   (and props (assoc-ref props 'line)))
+           (column (and props (assoc-ref props 'column))))
+      (if (and file line column)
+          (format (current-error-port) "~a:~a:~a: "
+                  file line column))))
 
+  (cond ((invalid-sui-error? c)
+	 (let ((sexp (invalid-sui-error:sexp c)))
+           (show-location sexp)
+	   (format (current-error-port)
+                   (_ "invalid SUI form: ~A~%")
+                   sexp)))
+
+	(else
+	 (format (current-error-port)
+                 (_ "undefined sui error: ~A~%")
+		 c))))
+
+(register-error-condition-handler! sui-error? handle-sui-error)
+
+
 ;*---------------------------------------------------------------------*/
 ;*    *sui-table* ...                                                  */
 ;*---------------------------------------------------------------------*/
@@ -82,18 +115,16 @@
               (let ((p (open-input-file path))
                     (read (make-reader 'skribe)))
 		(if (not (input-port? p))
-		    (skribe-error 'load-sui
-				  "Can't find `Skribe Url Index' file"
-				  path)
+                    (raise (condition (&file-open-error
+                                       (file-name path))))
 		    (unwind-protect
                      (let ((sexp (read p)))
                        (match sexp
                               (('sui (? string?) . _)
                                (hash-set! *sui-table* path sexp))
                               (else
-                               (skribe-error 'load-sui
-                                             "Illegal `Skribe Url Index' file"
-                                             path)))
+                               (raise (condition (&invalid-sui-error
+                                                  (sexp     sexp))))))
                        sexp)
                      (close-input-port p)))))))))
 
@@ -116,7 +147,8 @@
       (('sui (and title (? string?)) . _)
        title)
       (else
-       (skribe-error 'sui-title "Illegal `sui' format" sexp))))
+       (raise (condition (&invalid-sui-error
+                          (sexp sexp)))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    sui-file ...                                                     */
@@ -137,7 +169,8 @@
 			(cadr rest))
 		   (loop (cdr rest))))))
       (else
-       (skribe-error 'sui-key "Illegal `sui' format" sexp))))
+       (raise (condition (&invalid-sui-error
+                          (sexp sexp)))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    sui-find-ref ...                                                 */
@@ -162,7 +195,8 @@
 	     (ident (sui-search-all-refs sui ident class))
 	     (else '())))
 	 (else
-	  (skribe-error 'sui-find-ref "Illegal `sui' format" sui)))))
+          (raise (condition (&invalid-sui-error
+                             (sexp sui))))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    sui-search-all-refs ...                                          */
@@ -214,7 +248,8 @@
 		  (loop (cdr refs) res))
 	      (reverse! res))))
       (else
-       (skribe-error 'sui-filter "Illegal `sui' format" sui))))
+       (raise (condition (&invalid-sui-error
+                          (sexp sui)))))))
 
 ;*---------------------------------------------------------------------*/
 ;*    document-sui ...                                                 */
-- 
cgit v1.2.3