Improve error handling in conj.

* src/cgi-bin/conj.scm4: Add error handling.
* src/ellinika/conjugator.scm: Throw 'conjugator-error
instead of calling (error).
* src/ellinika/elmorph.c: Use ~A in error messages when referring to
elstrs.  Guile's ~S sucks on UTF-8.
* src/ellinika/utf8scm.c: Likewise.
* style.css (.error): Output in red.

1 files changed, 66 insertions, 14 deletions

diff --git a/src/cgi-bin/conj.scm4 b/src/cgi-bin/conj.scm4
index 931c580..253de1d 100644
--- a/src/cgi-bin/conj.scm4
+++ b/src/cgi-bin/conj.scm4
@@ -21,6 +21,7 @@
 (use-modules ifelse(IFACE,[CGI],(www cgi),(guile-user))
 	     (srfi srfi-1)
 	     (ice-9 rdelim)
+	     (ice-9 optargs)
 	     (xmltools dict)
 	     (ellinika elmorph)
 	     (ellinika tenses)
@@ -133,7 +134,7 @@ ifelse(IFACE,[CGI],(cgi:init))
    lst))
 
 
-(define (format-tenses count tense-names voice mood verb)
+(define (format-tenses count tense-list voice mood)
   (let ((prosopa (if (string=? mood "imp")
 		     '(2 5)
 		     '(1 2 3 4 5 6))))
@@ -150,21 +151,20 @@ ifelse(IFACE,[CGI],(cgi:init))
 	 (display "</tr>"))))
      (transpose
       (map
-       (lambda (tense)
-	 (let ((conj (conjugator verb voice mood tense)))
-	   (compact-conj-list (transpose (map conjugation:table conj)))))
-       tense-names))
+       (lambda (conj)
+	 (compact-conj-list (transpose (map conjugation:table conj))))
+       tense-list))
      '(1 2 3 4 5 6)
      '("odd" "even" "odd" "even" "odd" "even"))))
 
-(define (show-conjugation:mood voice mood tense-list verb)
+(define (show-conjugation:mood voice mood tense-list)
   (format #t "<div class=\"subsection\"><h3>~A</h3>"
 	  (ellinika-conjugation-term mood))
   (for-each
    (lambda (count)
      (let ((tenses (list-head tense-list count)))
-       (table-header count tenses)
-       (format-tenses count tenses voice mood verb)
+       (table-header count (map car tenses))
+       (format-tenses count (map cdr tenses) voice mood)
        (table-footer)
        (set! tense-list (list-tail tense-list count))
        (if (not (null? tense-list))
@@ -172,19 +172,71 @@ ifelse(IFACE,[CGI],(cgi:init))
    (assoc-ref tense-driver-list mood))
   (display "</div>"))
 
-(define (show-conjugation:voice voice verb)
+(define (show-conjugation:voice voice)
   (format #t "<div class=\"section\"><h2>~A</h2>"
-	  (ellinika-conjugation-term voice))
+	  (ellinika-conjugation-term (car voice)))
   (for-each
    (lambda (mood-tenses)
-     (show-conjugation:mood voice (car mood-tenses) (cdr mood-tenses) verb))
-   ellinika-tense-list)
+     (show-conjugation:mood voice (car mood-tenses) (cdr mood-tenses)))
+   (cdr voice))
 
   (display "</div>"))
 
+(define (conjugate-all verb)
+  (map
+   (lambda (voice)
+     (cons voice
+	   (map
+	    (lambda (mood-tenses)
+	      (let ((mood (car mood-tenses)))
+		(cons mood
+		      (map
+		       (lambda (tense)
+			 (cons tense
+			       (conjugator verb voice mood tense)))
+		       (cdr mood-tenses)))))
+	    ellinika-tense-list)))
+   '("act" "pas")))
+
+(define (force-string str)
+  (if (elstr? str)
+      (elstr->string str)
+      str))
+
+(define (error-message fmtstr . fmtargs)
+  (display "<h2 class=\"error\">")
+  (apply format #t fmtstr fmtargs)
+  (display "</h2>"))
+
 (define (show-conjugation verb)
-  (show-conjugation:voice "act" verb)
-  (show-conjugation:voice "pas" verb))
+  (catch #t
+	 (lambda ()
+	   (for-each
+	    (lambda (voice)
+	      (show-conjugation:voice voice))
+	    (conjugate-all verb)))
+	 (lambda (key . args)
+	   (case key
+	     ((conjugator-error)
+	      (let-optional
+	       args
+	       (subkey fmtstr fmtargs)
+	       (case subkey
+		 ((conjugator-error-input)
+		  (error-message "Invalid input"))
+		 (else
+		  (error-message "CONJUGATOR ERROR: ~A ~A"
+				 subkey (apply format #f fmtstr fmtargs))))))
+	     ((misc-error)
+	      (let-optional
+	       args
+	       (func-name fmtstr fmtargs sys-err)
+	       (error-message "MISC ERROR in ~A: ~A"
+			      func-name
+			      (apply format #f fmtstr
+				     (map force-string fmtargs)))))
+	     (else
+	      (error-message "OTHER ERROR: ~S ~S" key args))))))
    
 (define (do-conj)
   (let ((keyval (cgi:value "key")))