Change decoders to decode to a port rather than to a string. This is
authorChris Hanson <org/chris-hanson/cph>
Sat, 3 Jun 2000 01:58:32 +0000 (01:58 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 3 Jun 2000 01:58:32 +0000 (01:58 +0000)
almost always more efficient.

v7/src/imail/mime-codec.scm

index 4ef81b9e07acd1dbc71f85290b043ff2e235f898..6bb2a0aa1db32affab7d7ff6fc698865da781ef9 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: mime-codec.scm,v 1.6 2000/06/01 19:29:05 cph Exp $
+;;; $Id: mime-codec.scm,v 1.7 2000/06/03 01:58:32 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
 \f
 ;;;; Decode quoted-printable
 
-(define (decode-quoted-printable-string string)
-  (decode-quoted-printable-substring string 0 (string-length string)))
+(define (decode-quoted-printable-string string port)
+  (decode-quoted-printable-substring string 0 (string-length string) port))
 
-(define (decode-quoted-printable-substring string start end)
-  (with-string-output-port
-    (lambda (port)
-      (let loop ((start start))
-       (let ((i (substring-find-next-char string start end #\newline)))
-         (if i
-             (begin
-               (if (decode-quoted-printable-line string start i port)
-                   (newline port))
-               (loop (fix:+ i 1)))
-             (decode-quoted-printable-line string start end port)))))))
+(define (decode-quoted-printable-substring string start end port)
+  (let loop ((start start))
+    (let ((i (substring-find-next-char string start end #\newline)))
+      (if i
+         (begin
+           (if (decode-quoted-printable-line string start i port)
+               (newline port))
+           (loop (fix:+ i 1)))
+         (decode-quoted-printable-line string start end port)))))
 
 (define (decode-quoted-printable-line string start end port)
   (let ((end (skip-lwsp-backwards string start end)))
 \f
 ;;;; Decode BASE64
 
-(define (decode-base64-binary-string string)
-  (decode-base64-binary-substring string 0 (string-length string)))
+(define (decode-base64-binary-string string port)
+  (decode-base64-binary-substring string 0 (string-length string) port))
 
-(define (decode-base64-binary-substring string start end)
+(define (decode-base64-binary-substring string start end port)
   (decode-base64-internal string start end
-    (lambda (port)
-      (lambda (char)
-       (write-char char port)))))
+                         (lambda (char) (write-char char port))))
 
-(define (decode-base64-text-string string pending-return?)
+(define (decode-base64-text-string string pending-return? port)
   (decode-base64-text-substring string 0 (string-length string)
-                               pending-return?))
+                               pending-return? port))
 
-(define (decode-base64-text-substring string start end pending-return?)
-  (let ((result
-        (decode-base64-internal string start end
-          (lambda (port)
-            (lambda (char)
-              (if pending-return?
-                  (case char
-                    ((#\linefeed)
-                     (set! pending-return? #f)
-                     (newline port))
-                    ((#\return)
-                     (write-char #\return port))
-                    (else
-                     (set! pending-return? #f)
-                     (write-char #\return port)))
-                  (if (char=? char #\return)
-                      (set! pending-return? #t)
-                      (write-char char port))))))))
-    (values result pending-return?)))
+(define (decode-base64-text-substring string start end pending-return? port)
+  (decode-base64-internal string start end
+    (lambda (char)
+      (if pending-return?
+         (case char
+           ((#\linefeed)
+            (set! pending-return? #f)
+            (newline port))
+           ((#\return)
+            (write-char #\return port))
+           (else
+            (set! pending-return? #f)
+            (write-char #\return port)))
+         (if (char=? char #\return)
+             (set! pending-return? #t)
+             (write-char char port)))))
+  pending-return?)
 
-(define (decode-base64-internal string start end make-output)
-  (let ((input (string->input-port string start end)))
-    (with-string-output-port
-      (lambda (output)
-       (let ((input
-              (lambda (index)
-                (let loop ()
-                  (let ((char (read-char input)))
-                    (cond ((eof-object? char)
-                           (if (not (fix:= index 0))
-                               (error "Premature EOF from BASE64 port."))
-                           #f)
-                          ((let ((digit
-                                  (vector-8b-ref base64-char-table
-                                                 (char->integer char))))
-                             (and (fix:< digit #x40)
-                                  digit)))
-                          ((char=? char #\=)
-                           (if (not (or (fix:= index 2) (fix:= index 3)))
-                               (error "Misplaced #\= from BASE64 port."))
-                           #f)
-                          (else (loop)))))))
-             (output (make-output output)))
-         (let loop ()
-           (if (decode-base64-quantum input output)
-               (loop))))))))
+(define (decode-base64-internal string start end output)
+  (let ((input
+        (let ((port (string->input-port string start end)))
+          (lambda (index)
+            (let loop ()
+              (let ((char (read-char port)))
+                (cond ((eof-object? char)
+                       (if (not (fix:= index 0))
+                           (error "Premature EOF from BASE64 port."))
+                       #f)
+                      ((let ((digit
+                              (vector-8b-ref base64-char-table
+                                             (char->integer char))))
+                         (and (fix:< digit #x40)
+                              digit)))
+                      ((char=? char #\=)
+                       (if (not (or (fix:= index 2) (fix:= index 3)))
+                           (error "Misplaced #\= from BASE64 port."))
+                       #f)
+                      (else (loop)))))))))
+    (let loop ()
+      (if (decode-base64-quantum input output)
+         (loop)))))
 \f
 (define (decode-base64-quantum input output)
   (let ((d1 (input 0))