*** empty log message ***

[gnus] / lisp / mm-bodies.el

diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el
index 0403bb6..3ced083 100644 (file)
--- a/lisp/mm-bodies.el
+++ b/lisp/mm-bodies.el
@@ -38,6 +38,28 @@
 ;; BS, vertical TAB, form feed, and ^_
 (defvar mm-8bit-char-regexp "[^\x20-\x7f\r\n\t\x7\x8\xb\xc\x1f]")
 
+(defvar mm-body-charset-encoding-alist
+  '((us-ascii . 7bit)
+    (iso-8859-1 . quoted-printable)
+    (iso-8859-2 . quoted-printable)
+    (iso-8859-3 . quoted-printable)
+    (iso-8859-4 . quoted-printable)
+    (iso-8859-5 . base64)
+    (koi8-r . 8bit)
+    (iso-8859-7 . quoted-printable)
+    (iso-8859-8 . quoted-printable)
+    (iso-8859-9 . quoted-printable)
+    (iso-2022-jp . base64)
+    (iso-2022-kr . base64)
+    (gb2312 . base64)
+    (cn-gb . base64)
+    (cn-gb-2312 . base64)
+    (euc-kr . 8bit)
+    (iso-2022-jp-2 . base64)
+    (iso-2022-int-1 . base64))
+  "Alist of MIME charsets to encodings.
+Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'.")
+
 (defun mm-encode-body ()
   "Encode a body.
 Should be called narrowed to the body that is to be encoded.
@@ -51,14 +73,14 @@ If no encoding was done, nil is returned."
       (save-excursion
        (goto-char (point-min))
        (if (re-search-forward "[^\x0-\x7f]" nil t)
-           (mm-read-charset "Charset used in the article: ")
+           (or mail-parse-charset
+               (mm-read-charset "Charset used in the article: "))
          ;; The logic in `mml-generate-mime-1' confirms that it's OK
          ;; to return nil here.
          nil))
     (save-excursion
       (goto-char (point-min))
-      (let ((charsets
-            (delq 'ascii (mm-find-charset-region (point-min) (point-max))))
+      (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))
            charset)
        (cond
         ;; No encoding.
@@ -69,31 +91,44 @@ If no encoding was done, nil is returned."
          charsets)
         ;; We encode.
         (t
-         (let ((mime-charset
-                (mm-mime-charset (car charsets) (point-min) (point-max)))
+         (let ((charset (car charsets))
                start)
            (when (or t
                      ;; We always decode.
                      (not (mm-coding-system-equal
-                           mime-charset buffer-file-coding-system)))
+                           charset buffer-file-coding-system)))
              (while (not (eobp))
                (if (eq (char-charset (char-after)) 'ascii)
                    (when start
                      (save-restriction
                        (narrow-to-region start (point))
-                       (mm-encode-coding-region start (point) mime-charset)
+                       (mm-encode-coding-region start (point) charset)
                        (goto-char (point-max)))
                      (setq start nil))
                  (unless start
                    (setq start (point))))
                (forward-char 1))
              (when start
-               (mm-encode-coding-region start (point) mime-charset)
+               (mm-encode-coding-region start (point) charset)
                (setq start nil)))
-           mime-charset)))))))
-
-(defun mm-body-encoding ()
-  "Return the encoding of the current buffer."
+           charset)))))))
+
+(defun mm-body-encoding (charset)
+  "Do Content-Transfer-Encoding and return the encoding of the current buffer."
+  (let ((bits (mm-body-7-or-8)))
+    (cond
+     ((eq bits '7bit)
+      bits)
+     ((eq charset mail-parse-charset)
+      bits)
+     (t
+      (let ((encoding (or (cdr (assq charset mm-body-charset-encoding-alist))
+                         'quoted-printable)))
+       (mm-encode-content-transfer-encoding encoding "text/plain")
+       encoding)))))
+
+(defun mm-body-7-or-8 ()
+  "Say whether the body is 7bit or 8bit."
   (cond
    ((not (featurep 'mule))
     (if (save-excursion
@@ -126,12 +161,20 @@ If no encoding was done, nil is returned."
           ((eq encoding 'quoted-printable)
            (quoted-printable-decode-region (point-min) (point-max)))
           ((eq encoding 'base64)
-           (base64-decode-region (point-min) (point-max)))
+           (base64-decode-region (point-min)
+                                 ;; Some mailers insert whitespace
+                                 ;; junk at the end which
+                                 ;; base64-decode-region dislikes.
+                                 (save-excursion
+                                   (goto-char (point-max))
+                                   (skip-chars-backward "\n\t ")
+                                   (delete-region (point) (point-max))
+                                   (point))))
           ((memq encoding '(7bit 8bit binary))
            )
           ((null encoding)
            )
-          ((eq encoding 'x-uuencode)
+          ((memq encoding '(x-uuencode x-uue))
            (funcall mm-uu-decode-function (point-min) (point-max)))
           ((eq encoding 'x-binhex)
            (funcall mm-uu-binhex-decode-function (point-min) (point-max)))
@@ -143,7 +186,7 @@ If no encoding was done, nil is returned."
         (message "Error while decoding: %s" error)
         nil))
     (when (and
-          (memq encoding '(base64 x-uuencode x-binhex))
+          (memq encoding '(base64 x-uuencode x-uue x-binhex))
           (equal type "text/plain"))
       (goto-char (point-min))
       (while (search-forward "\r\n" nil t)
@@ -152,7 +195,10 @@ If no encoding was done, nil is returned."
 (defun mm-decode-body (charset &optional encoding type)
   "Decode the current article that has been encoded with ENCODING.
 The characters in CHARSET should then be decoded."
-  (setq charset (or charset mail-parse-charset))
+  (if (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (if (or (not charset) (memq charset mail-parse-ignored-charsets))
+      (setq charset mail-parse-charset))
   (save-excursion
     (when encoding
       (mm-decode-content-transfer-encoding encoding type))
@@ -161,8 +207,8 @@ The characters in CHARSET should then be decoded."
        (when (and charset
                   (setq mule-charset (mm-charset-to-coding-system charset))
                   ;; buffer-file-coding-system
-                                       ;Article buffer is nil coding system
-                                       ;in XEmacs
+                  ;;Article buffer is nil coding system
+                  ;;in XEmacs
                   enable-multibyte-characters
                   (or (not (eq mule-charset 'ascii))
                       (setq mule-charset mail-parse-charset)))
@@ -170,7 +216,10 @@ The characters in CHARSET should then be decoded."
 
 (defun mm-decode-string (string charset)
   "Decode STRING with CHARSET."
-  (setq charset (or charset mail-parse-charset))
+  (if (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (if (or (not charset) (memq charset mail-parse-ignored-charsets))
+      (setq charset mail-parse-charset))
   (or
    (when (featurep 'mule)
      (let (mule-charset)