Normalize errors.

7 files changed, 42 insertions, 20 deletions

diff --git a/module/vcomponent/duration.scm b/module/vcomponent/duration.scm
index 786675b8..637d7db4 100644
--- a/module/vcomponent/duration.scm
+++ b/module/vcomponent/duration.scm
@@ -20,7 +20,9 @@
           key: (sign '+)
           week day time)
   (when (and week (or day time))
-    (error "Can't give week together with day or time"))
+    (scm-error 'misc-error "duration"
+               "Can't give week together with day or time"
+               #f #f))
   (make-duration sign week day time))
 
 
@@ -64,7 +66,10 @@
 (define (parse-duration str)
   (let ((m (match-pattern dur-pattern str)))
     (unless m
-      (throw 'parse-error "~a doesn't appar to be a duration" str))
+      (scm-error 'parse-error "parse-duration"
+                 "~s doesn't appar to be a duration"
+                 (list str)
+                 #f))
 
     (unless (= (peg:end m) (string-length str))
       (warning "Garbage at end of duration"))
@@ -83,9 +88,12 @@
                              [(H) `(hour: ,n)]
                              [(M) `(minute: ,n)]
                              [(S) `(second: ,n)]
-                             [else (error "Invalid key")]))]
+                             [else (scm-error 'misc-error "parse-duration"
+                                              "Invalid key ~a" type #f)]))]
                         [a
-                         (error "~a not on form ((number <num>) type)" a)])
+                         (scm-error 'misc-error "parse-duration"
+                                    "~s not on expected form ((number <num>) type)"
+                                    (list a) #f)])
                       (context-flatten (lambda (x) (and (pair? (car x))
                                                    (eq? 'number (caar x))))
                       (cdr (member "P" tree)))
diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm
index efe17f36..97980e1a 100644
--- a/module/vcomponent/formats/common/types.scm
+++ b/module/vcomponent/formats/common/types.scm
@@ -136,4 +136,5 @@
 
 (define-public (get-parser type)
   (or (hashq-ref type-parsers type #f)
-      (error "No parser for type" type)))
+      (scm-error 'misc-error "get-parser" "No parser for type ~a"
+                 (list type) #f)))
diff --git a/module/vcomponent/formats/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm
index 30a1837f..08f31ae7 100644
--- a/module/vcomponent/formats/ical/parse.scm
+++ b/module/vcomponent/formats/ical/parse.scm
@@ -121,7 +121,9 @@
     (lambda (params value)
       (let ((vv (parser params value)))
         (when (list? vv)
-          (throw 'parse-error "List in enum field"))
+          (scm-error 'parse-error "enum-parser"
+                     "List in enum field"
+                     #f #f))
         (let ((v (string->symbol vv)))
           (unless (memv v enum)
             (warning "~a ∉ { ~{~a~^, ~} }"
@@ -193,7 +195,9 @@
                           DRAFT FINAL CANCELED))]
 
           [(memv key '(REQUEST-STATUS))
-           (throw 'parse-error "TODO Implement REQUEST-STATUS")]
+           (scm-error 'parse-error "build-vline"
+                      "TODO Implement REQUEST-STATUS"
+                      #f #f)]
 
           [(memv key '(ACTION))
            (enum-parser '(AUDIO DISPLAY EMAIL
@@ -319,7 +323,7 @@
                                      (set! (prop* (car stack) key) vline))))))
 
                       (loop (cdr lst) stack)])))
-            (lambda (err fmt . args)
+            (lambda (err proc fmt fmt-args data)
               (let ((linedata (get-metadata head*)))
                 (display (format
                           #f "ERROR parse error around ~a
@@ -327,7 +331,7 @@
   line ~a ~a
   Defaulting to string~%"
                           (get-string linedata)
-                          fmt args
+                          fmt fmt-args
                           (get-line linedata)
                           (get-file linedata))
                          (current-error-port))
diff --git a/module/vcomponent/formats/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm
index 7dee8d67..b21e72b5 100644
--- a/module/vcomponent/formats/xcal/parse.scm
+++ b/module/vcomponent/formats/xcal/parse.scm
@@ -81,10 +81,10 @@
                         bymonthday byyearday byweekno
                         bymonth bysetpos)
                  (string->number value))
-                (else (throw
-                       'key-error
+                (else (scm-error 'key-error "handle-value"
                        "Invalid type ~a, with value ~a"
-                       type value))))))
+                       (list type value)
+                       #f))))))
 
        ;; freq until count interval wkst
 
@@ -108,9 +108,11 @@
                                          byyearday byweekno bymonth bysetpos)
                                (list (symbol->keyword key)
                                      (map (lambda (v) (parse-value-of-that-type key v))
-                                          (map car values)))
-                               )
-                              (else (throw 'error)))))))))]
+                                          (map car values))))
+                              (else (scm-error 'misc-error "handle-value"
+                                               "Invalid key ~s"
+                                               (list key)
+                                               #f)))))))))]
 
     [(time) (parse-iso-time (car value))]
 
diff --git a/module/vcomponent/recurrence/generate.scm b/module/vcomponent/recurrence/generate.scm
index b498e033..33f86e3d 100644
--- a/module/vcomponent/recurrence/generate.scm
+++ b/module/vcomponent/recurrence/generate.scm
@@ -217,7 +217,9 @@
          [(BYHOUR) (to-dt (set (hour t) value))]
          [(BYMINUTE) (to-dt (set (minute t) value))]
          [(BYSECOND) (to-dt (set (second t) value))]
-         [else (error "Unrecognized by-extender" key)])))
+         [else (scm-error 'wrong-type-arg "update"
+                          "Unrecognized by-extender ~s"
+                          key #f)])))
    date-object
    extension-rule))
 
diff --git a/module/vcomponent/recurrence/parse.scm b/module/vcomponent/recurrence/parse.scm
index c2e3a10f..65d44331 100644
--- a/module/vcomponent/recurrence/parse.scm
+++ b/module/vcomponent/recurrence/parse.scm
@@ -51,7 +51,9 @@
 
 (define-macro (quick-case key . cases)
   (let ((else-clause (or (assoc-ref cases 'else)
-                         '(error "Guard failed"))))
+                         '(scm-error 'misc-error "quick-case"
+                                     "Guard failed"
+                                     #f #f))))
     `(case ,key
        ,@(map (match-lambda
                 ((key guard '=> body ...)
@@ -74,10 +76,10 @@
 
 (define* (string->number/throw string optional: (radix 10))
   (or (string->number string radix)
-      (scm-error 'wrong-type-argument
+      (scm-error 'wrong-type-arg
                  "string->number/throw"
                  "Can't parse ~s as number in base ~a"
-                 '(string radix) #f)))
+                 (list string radix) (list string radix))))
 
 ;; RFC 5545, Section 3.3.10. Recurrence Rule, states that the UNTIL value MUST have
 ;; the same type as the DTSTART of the event (date or datetime). I have seen events
diff --git a/module/vcomponent/util/parse-cal-path.scm b/module/vcomponent/util/parse-cal-path.scm
index 11a32064..df3fbf75 100644
--- a/module/vcomponent/util/parse-cal-path.scm
+++ b/module/vcomponent/util/parse-cal-path.scm
@@ -25,7 +25,10 @@
                (prop comp '-X-HNH-DIRECTORY) path)
          comp)]
       [(block-special char-special fifo socket unknown symlink)
-       => (lambda (t) (error "Can't parse file of type " t))]))
+       => (lambda (t) (scm-error 'misc-error "parse-cal-path"
+                            "Can't parse file of type ~s"
+                            (list t)
+                            #f))]))
 
   (unless (prop cal "NAME")
     (set! (prop cal "NAME")