Fix bug: mime decoder wasn't properly flushing its output.

diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg
index 353a4b3061976f220e41e6ee0e99f5c3e4603767..ac19b4421d4c3152291f4e256d61758bb0bfe5f0 100644 (file)
--- a/src/edwin/edwin.pkg
+++ b/src/edwin/edwin.pkg
@@ -264,8 +264,6 @@ USA.
          substring<?
          substring=?
          substring?
-         textual-input-port->binary
-         textual-output-port->binary
          vector-8b-fill!
          vector-8b-find-next-char
          vector-8b-find-next-char-ci

diff --git a/src/edwin/string.scm b/src/edwin/string.scm
index 465c7639fe374d601b5eb88f8c0fa3dc859a6865..cfcfd5cd5edfb703ebca5f735e2292af39c62e21 100644 (file)
--- a/src/edwin/string.scm
+++ b/src/edwin/string.scm
@@ -583,40 +583,6 @@ USA.
        ((not (fix:< i end)))
       (string-set! string j (integer->char (bytevector-u8-ref bv i))))
     string))
-
-(define (textual-input-port->binary textual-port)
-
-  (define (has-bytes?)
-    (char-ready? textual-port))
-
-  (define (read-bytes! bv start end)
-    (let ((string (read-string (fix:- end start) textual-port)))
-      (if (or (not string) (eof-object? string))
-         string
-         (let ((n (string-length string)))
-           (do ((i 0 (fix:+ i 1))
-                (j start (fix:+ j 1)))
-               ((not (fix:< i n)))
-             (bytevector-u8-set! bv j (char->integer (string-ref string i))))
-           n))))
-
-  (define (close)
-    (close-port textual-port))
-
-  (make-binary-port (make-non-channel-input-source has-bytes? read-bytes! close)
-                   #f))
-
-(define (textual-output-port->binary textual-port)
-
-  (define (write-bytes bv start end)
-    (do ((i start (fix:+ i 1)))
-       ((not (fix:< i end)))
-      (write-char (integer->char (bytevector-u8-ref bv i)) textual-port)))
-
-  (define (close)
-    (close-port textual-port))
-
-  (make-binary-port #f (make-non-channel-output-sink write-bytes close)))
 \f
 (define (decorated-string-append prefix infix suffix strings)
   (let ((infix (string-append suffix infix prefix)))

diff --git a/src/imail/imail-mime.scm b/src/imail/imail-mime.scm
index 066865591b45de3043ffa22496ce3f0e2eb52b05..ab119c69ffabb6beb0522a33fe1cfb46a1ad0931 100644 (file)
--- a/src/imail/imail-mime.scm
+++ b/src/imail/imail-mime.scm
@@ -34,7 +34,7 @@ USA.
 ;;; Any kind of object can be a MIME entity, provided that it
 ;;; implements MIME-ENTITY-BODY-STRUCTURE.  A default method is
 ;;; provided if it instead implements MIME-ENTITY-HEADER-FIELDS and
-;;; either MIME-ENTITY-BODY-SUBSTRING or WRITE-ENTITY-MIME-BODY, which
+;;; either MIME-ENTITY-BODY-SUBSTRING or WRITE-MIME-ENTITY-BODY, which
 ;;; yield the literal text of the entity's body without decoding or
 ;;; interpretation.  MIME-ENTITY-BODY-STRUCTURE should return a
 ;;; <MIME-BODY> instance.
@@ -765,7 +765,6 @@ USA.
   (decoder-initializer           #f read-only #t)
   (decoder-finalizer             #f read-only #t)
   (decoder-updater               #f read-only #t)
-  (decoding-port-maker           #f read-only #t)
   (caller-with-decoding-port     #f read-only #t))
 
 (define-guarantee mime-encoding "MIME codec")
@@ -776,14 +775,14 @@ USA.
 (define (define-mime-encoding name
           encode:initialize encode:finalize encode:update
           decode:initialize decode:finalize decode:update
-          make-port call-with-port)
+         call-with-port)
   (hash-table/put!
    mime-encodings
    name
    (%make-mime-encoding name #f
                         encode:initialize encode:finalize encode:update
                         decode:initialize decode:finalize decode:update
-                        make-port call-with-port))
+                        call-with-port))
   name)
 \f
 (define (define-identity-mime-encoding name)
@@ -796,7 +795,6 @@ USA.
                                         (lambda (port text?) text? port)
                                         output-port/flush-output
                                         output-port/write-string
-                                        (lambda (port text?) text? port)
                                         (lambda (port text? generator)
                                           text?
                                           (generator port)))))
@@ -813,7 +811,7 @@ USA.
 
 (define (make-unknown-mime-encoding name)
   (let ((lose (lambda args args (error "Unknown MIME encoding name:" name))))
-    (%make-mime-encoding name #f lose lose lose lose lose lose lose lose)))
+    (%make-mime-encoding name #f lose lose lose lose lose lose lose)))
 
 (define (call-with-mime-decoding-output-port encoding port text? generator)
   ((mime-encoding/caller-with-decoding-port
@@ -849,17 +847,19 @@ USA.
   decode-quoted-printable:initialize
   decode-quoted-printable:finalize
   decode-quoted-printable:update
-  make-decode-quoted-printable-port
   call-with-decode-quoted-printable-output-port)
 
 (define (make-decode-base64-port* textual-port text?)
-  (make-decode-base64-port (textual-output-port->binary textual-port) text?))
+  (make-decode-base64-port (textual->binary-port textual-port 'iso-8859-1)
+                          text?))
 
 (define (call-with-decode-base64-port* textual-port text? procedure)
-  (let ((port (make-decode-base64-port* textual-port text?)))
-    (let ((value (procedure port)))
-      (close-port port)
-      value)))
+  (let ((binary-port (textual->binary-port textual-port 'iso-8859-1)))
+    (let ((decoding-port (make-decode-base64-port binary-port text?)))
+      (let ((value (procedure decoding-port)))
+       (close-port decoding-port)
+       (flush-output-port binary-port)
+       value))))
 
 (define-mime-encoding 'BASE64
   encode-base64:initialize
@@ -868,22 +868,19 @@ USA.
   decode-base64:initialize
   decode-base64:finalize
   decode-base64:update
-  make-decode-base64-port*
   call-with-decode-base64-port*)
 
-(define (make-decode-binhex40-port* textual-port text?)
-  (make-decode-binhex40-port (textual-output-port->binary textual-port) text?))
-
 (define (call-with-decode-binhex40-port* textual-port text? procedure)
-  (let ((port (make-decode-binhex40-port* textual-port text?)))
-    (let ((value (procedure port)))
-      (close-port port)
-      value)))
+  (let ((binary-port (textual->binary-port textual-port 'iso-8859-1)))
+    (let ((decoding-port (make-decode-binhex40-port binary-port text?)))
+      (let ((value (procedure decoding-port)))
+       (close-port decoding-port)
+       (flush-output-port binary-port)
+       value))))
 
 (define-mime-encoding 'BINHEX40
   #f #f #f                              ;No BinHex encoder.
   decode-binhex40:initialize
   decode-binhex40:finalize
   decode-binhex40:update
-  make-decode-binhex40-port*
   call-with-decode-binhex40-port*)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f60ca108e8e49bcb1d2b0f76c2896f9a862beb18..04428abc89f79dbd109b65515909989b36d4d759 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2523,12 +2523,6 @@ USA.
          u8-ready?
          write-bytevector
          write-u8)
-  ;; Temporary hack: this allows these bindings to be seen by Edwin.
-  ;; Move these bindings back to (runtime) after 9.3 release.
-  (export ()
-         make-binary-port
-         make-non-channel-input-source
-         make-non-channel-output-sink)
   (export (runtime)
          binary-port-sink
          binary-port-source
@@ -2538,8 +2532,11 @@ USA.
          input-source-open?
          input-source-port
          input-source?
+         make-binary-port
          make-channel-input-source
          make-channel-output-sink
+         make-non-channel-input-source
+         make-non-channel-output-sink
          output-sink-channel
          output-sink-custom-length
          output-sink-custom-ref