Synch with Gnus.

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

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index fa18f9d..529e211 100644 (file)
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -38,6 +38,8 @@
 (defvar rfc2047-header-encoding-alist
   '(("Newsgroups" . nil)
     ("Message-ID" . nil)
+    ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
+     "-A-Za-z0-9!*+/=_")
     (t . mime))
   "*Header/encoding method alist.
 The list is traversed sequentially.  The keys can either be
@@ -49,7 +51,8 @@ The values can be:
 2) `mime', in which case the header will be encoded according to RFC2047;
 3) a charset, in which case it will be encoded as that charset;
 4) `default', in which case the field will be encoded as the rest
-   of the article.")
+   of the article.
+5) a string, like `mime', expect for using it as word-chars.")
 
 (defvar rfc2047-charset-encoding-alist
   '((us-ascii . nil)
@@ -82,7 +85,8 @@ Valid encodings are nil, `Q' and `B'.")
   "Alist of RFC2047 encodings to encoding functions.")
 
 (defvar rfc2047-q-encoding-alist
-  '(("\\(From\\|Cc\\|To\\|Bcc\||Reply-To\\):" . "-A-Za-z0-9!*+/") 
+  '(("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\):" 
+     . "-A-Za-z0-9!*+/" )
     ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
     ;; Avoid using 8bit characters. Some versions of Emacs has bug!
     ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
@@ -137,6 +141,8 @@ Should be called narrowed to the head of the message."
                (setq alist nil
                      method (cdr elem))))
            (cond
+            ((stringp method)
+             (rfc2047-encode-region (point-min) (point-max) method))
             ((eq method 'mime)
              (rfc2047-encode-region (point-min) (point-max)))
             ((eq method 'default)
@@ -176,11 +182,12 @@ Should be called narrowed to the head of the message."
        (setq found t)))
     found))
 
-(defun rfc2047-dissect-region (b e)
+(defun rfc2047-dissect-region (b e &optional word-chars)
   "Dissect the region between B and E into words."
-  (let ((word-chars "-A-Za-z0-9!*+/") 
-       ;; Not using ietf-drums-specials-token makes life simple.
-       mail-parse-mule-charset
+  (unless word-chars
+    ;; Anything except most CTLs, WSP
+    (setq word-chars "\010\012\014\041-\177"))
+  (let (mail-parse-mule-charset
        words point current 
        result word)
     (save-restriction
@@ -230,9 +237,9 @@ Should be called narrowed to the head of the message."
        (setq word (pop words))))
     result))
 
-(defun rfc2047-encode-region (b e)
+(defun rfc2047-encode-region (b e &optional word-chars)
   "Encode all encodable words in REGION."
-  (let ((words (rfc2047-dissect-region b e)) word)
+  (let ((words (rfc2047-dissect-region b e word-chars)) word)
     (save-restriction
       (narrow-to-region b e)
       (delete-region (point-min) (point-max))
@@ -252,11 +259,11 @@ Should be called narrowed to the head of the message."
                          (cdr word))))
       (rfc2047-fold-region (point-min) (point-max)))))
 
-(defun rfc2047-encode-string (string)
+(defun rfc2047-encode-string (string &optional word-chars)
   "Encode words in STRING."
   (with-temp-buffer
     (insert string)
-    (rfc2047-encode-region (point-min) (point-max))
+    (rfc2047-encode-region (point-min) (point-max) word-chars)
     (buffer-string)))
 
 (defun rfc2047-encode (b e charset)
@@ -476,6 +483,17 @@ Return WORD if not."
        (error word))
      word)))
 
+(defun rfc2047-pad-base64 (string)
+  "Pad STRING to quartets."
+  ;; Be more liberal to accept buggy base64 strings. If
+  ;; base64-decode-string accepts buggy strings, this function could
+  ;; be aliased to identity.
+  (case (mod (length string) 4)
+    (0 string)
+    (1 string) ;; Error, don't pad it.
+    (2 (concat string "=="))
+    (3 (concat string "="))))
+
 (defun rfc2047-decode (charset encoding string)
   "Decode STRING that uses CHARSET with ENCODING.
 Valid ENCODINGs are \"B\" and \"Q\".
@@ -501,7 +519,8 @@ If your Emacs implementation can't decode CHARSET, it returns nil."
        (mm-decode-coding-string
         (cond
          ((equal "B" encoding)
-          (base64-decode-string string))
+          (base64-decode-string 
+           (rfc2047-pad-base64 string)))
          ((equal "Q" encoding)
           (quoted-printable-decode-string
            (mm-replace-chars-in-string string ?_ ? )))