Importing Gnus v5.8.2.

[elisp/gnus.git-] / lisp / rfc2047.el

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index 5d44dc3..3344753 100644 (file)
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -32,9 +32,7 @@
 (require 'qp)
 (require 'mm-util)
 (require 'ietf-drums)
-
-(defvar rfc2047-default-charset 'iso-8859-1
-  "Default MIME charset -- does not need encoding.")
+(require 'mail-prsvr)
 
 (defvar rfc2047-header-encoding-alist
   '(("Newsgroups" . nil)
@@ -126,20 +124,22 @@ Should be called narrowed to the head of the message."
              (when method
                (cond
                 ((eq method 'mime)
-                 (rfc2047-encode-region (point-min) (point-max)))
+                 (rfc2047-encode-region (point-min) (point-max))
+                 (rfc2047-fold-region (point-min) (point-max)))
                 ;; Hm.
                 (t))))
            (goto-char (point-max)))))
-      (when rfc2047-default-charset
+      (when mail-parse-charset
        (encode-coding-region (point-min) (point-max)
-                             rfc2047-default-charset)))))
+                             mail-parse-charset)))))
 
 (defun rfc2047-encodable-p ()
   "Say whether the current (narrowed) buffer contains characters that need encoding."
-  (let ((charsets (mapcar
-                  'mm-mule-charset-to-mime-charset
-                  (mm-find-charset-region (point-min) (point-max))))
-       (cs (list 'us-ascii rfc2047-default-charset))
+  (let ((charsets
+        (mapcar
+         'mm-mime-charset
+         (mm-find-charset-region (point-min) (point-max))))
+       (cs (list 'us-ascii mail-parse-charset))
        found)
     (while charsets
       (unless (memq (pop charsets) cs)
@@ -185,10 +185,9 @@ Should be called narrowed to the head of the message."
 
 (defun rfc2047-encode (b e charset)
   "Encode the word in the region with CHARSET."
-  (let* ((mime-charset
-         (mm-mime-charset charset b e))
+  (let* ((mime-charset (mm-mime-charset charset))
         (encoding (or (cdr (assq mime-charset
-                             rfc2047-charset-encoding-alist))
+                                 rfc2047-charset-encoding-alist))
                       'B))
         (start (concat
                 "=?" (downcase (symbol-name mime-charset)) "?"
@@ -196,7 +195,14 @@ Should be called narrowed to the head of the message."
         (first t))
     (save-restriction
       (narrow-to-region b e)
-      (mm-encode-coding-region b e mime-charset)
+      (when (eq encoding 'B)
+       ;; break into lines before encoding
+       (goto-char (point-min))
+       (while (not (eobp))
+         (goto-char (min (point-max) (+ 15 (point))))
+         (unless (eobp)
+           (insert "\n"))))
+      (mm-encode-coding-region (point-min) (point-max) mime-charset)
       (funcall (cdr (assq encoding rfc2047-encoding-function-alist))
               (point-min) (point-max))
       (goto-char (point-min))
@@ -209,14 +215,36 @@ Should be called narrowed to the head of the message."
        (insert "?=")
        (forward-line 1)))))
 
+(defun rfc2047-fold-region (b e)
+  "Fold the long lines in the region."
+  (save-restriction
+    (narrow-to-region b e)
+    (goto-char (point-min))
+    (let ((break nil))
+      (while (not (eobp))
+       (cond
+        ((memq (char-after) '(?  ?\t))
+         (setq break (point)))
+        ((and (not break)
+              (looking-at "=\\?"))
+         (setq break (point)))
+        ((and (looking-at "\\?=")
+              (> (- (point) (save-excursion (beginning-of-line) (point))) 76))
+         (goto-char break)
+         (insert "\n ")
+         (forward-line 1)))
+       (unless (eobp)
+         (forward-char 1))))))
+
 (defun rfc2047-b-encode-region (b e)
   "Encode the header contained in REGION with the B encoding."
-  (base64-encode-region b e t)
-  (goto-char (point-min))
-  (while (not (eobp))
-    (goto-char (min (point-max) (+ 64 (point))))
-    (unless (eobp)
-      (insert "\n"))))
+  (save-restriction
+    (narrow-to-region (goto-char b) e)
+    (while (not (eobp))
+      (base64-encode-region (point) (progn (end-of-line) (point)) t)
+      (if (and (bolp) (eolp))
+         (delete-backward-char 1))
+      (forward-line))))
 
 (defun rfc2047-q-encode-region (b e)
   "Encode the header contained in REGION with the Q encoding."
@@ -268,13 +296,16 @@ Should be called narrowed to the head of the message."
                   (prog1
                       (match-string 0)
                     (delete-region (match-beginning 0) (match-end 0)))))
-         (when (and (mm-multibyte-p) rfc2047-default-charset)
-           (mm-decode-coding-region b e rfc2047-default-charset))
+         (when (and (mm-multibyte-p)
+                    mail-parse-charset
+                    (not (eq mail-parse-charset 'gnus-decoded)))
+           (mm-decode-coding-region b e mail-parse-charset))
          (setq b (point)))
        (when (and (mm-multibyte-p)
-                  rfc2047-default-charset
-                  (not (eq rfc2047-default-charset 'us-ascii)))
-         (mm-decode-coding-region b (point-max) rfc2047-default-charset))))))
+                  mail-parse-charset
+                  (not (eq mail-parse-charset 'us-ascii))
+                  (not (eq mail-parse-charset 'gnus-decoded)))
+         (mm-decode-coding-region b (point-max) mail-parse-charset))))))
 
 (defun rfc2047-decode-string (string)
   "Decode the quoted-printable-encoded STRING and return the results."
@@ -286,7 +317,7 @@ Should be called narrowed to the head of the message."
       (inline
        (rfc2047-decode-region (point-min) (point-max)))
       (buffer-string))))
- 
+
 (defun rfc2047-parse-and-decode (word)
   "Decode WORD and return it if it is an encoded word.
 Return WORD if not."
@@ -305,11 +336,22 @@ Return WORD if not."
   "Decode STRING that uses CHARSET with ENCODING.
 Valid ENCODINGs are \"B\" and \"Q\".
 If your Emacs implementation can't decode CHARSET, it returns nil."
-  (let ((cs (let ((mm-default-charset rfc2047-default-charset))
-             (mm-charset-to-coding-system charset))))
+  (if (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (if (or (not charset) 
+         (eq 'gnus-all mail-parse-ignored-charsets)
+         (memq 'gnus-all mail-parse-ignored-charsets)
+         (memq charset mail-parse-ignored-charsets))
+      (setq charset mail-parse-charset))
+  (let ((cs (mm-charset-to-coding-system charset)))
+    (if (and (not cs) charset 
+            (listp mail-parse-ignored-charsets)
+            (memq 'gnus-unknown mail-parse-ignored-charsets))
+      (setq cs (mm-charset-to-coding-system mail-parse-charset)))
     (when cs
-      (when (eq cs 'ascii)
-       (setq cs rfc2047-default-charset))
+      (when (and (eq cs 'ascii)
+                mail-parse-charset)
+       (setq cs mail-parse-charset))
       (mm-decode-coding-string
        (cond
        ((equal "B" encoding)