Implement CONDITION-TYPE:DECODE-BASE64.

diff --git a/v7/src/runtime/mime-codec.scm b/v7/src/runtime/mime-codec.scm
index 9eb5a52b5cf64a5f5a447d06a45e9801aa921c99..998e0d4d3a21f4bca2288e9eb4739ab1d3181f2f 100644 (file)
--- a/v7/src/runtime/mime-codec.scm
+++ b/v7/src/runtime/mime-codec.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: mime-codec.scm,v 14.21 2008/07/26 05:12:20 cph Exp $
+$Id: mime-codec.scm,v 14.22 2008/09/09 06:36:17 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -479,7 +479,7 @@ USA.
 
 (define (decode-base64:finalize context)
   (if (fix:> (base64-decoding-context/input-index context) 0)
-      (error "BASE64 input length is not a multiple of 4."))
+      (error:decode-base64 "BASE64 input length is not a multiple of 4."))
   (if (base64-decoding-context/pending-return? context)
       (write-char #\return (base64-decoding-context/port context))))
 
@@ -582,11 +582,11 @@ USA.
          (else
           (vector-8b-set! output 0 (fix:+ (fix:lsh d1 2) (fix:lsh d2 -4)))
           1))))
-
+\f
 (define (decode-base64-char input index)
   (let ((digit (vector-8b-ref base64-char-table (vector-8b-ref input index))))
     (if (fix:> digit #x40)
-       (error "Misplaced #\\= in BASE64 input."))
+       (error:decode-base64 "Misplaced #\\= in BASE64 input."))
     digit))
 
 (define base64-char-table)
@@ -608,6 +608,17 @@ USA.
   (set! base64-char-table char-table)
   (set! base64-digit-table digit-table)
   unspecific)
+
+(define condition-type:decode-base64
+  (make-condition-type 'DECODE-BASE64 condition-type:simple-error '() #f))
+
+(define error:decode-base64
+  (let ((signal
+        (condition-signaller condition-type:decode-base64
+                             '(MESSAGE IRRITANTS)
+                             standard-error-handler)))
+    (lambda (message . irritants)
+      (signal message irritants))))
 \f
 ;;;; Decode BinHex 4.0
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index c3821a324fe057e78593fa431abafd29d64a1b34..8d399cb6cf3164627ea79169d2e8a53a3c46e713 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.676 2008/09/09 05:23:53 cph Exp $
+$Id: runtime.pkg,v 14.677 2008/09/09 06:36:20 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -4800,6 +4800,7 @@ USA.
          call-with-decode-binhex40-output-port
          call-with-decode-quoted-printable-output-port
          call-with-decode-uue-output-port
+         condition-type:decode-base64
          decode-base64:finalize
          decode-base64:initialize
          decode-base64:update