Importing Pterodactyl Gnus v0.95.

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

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index b68146a..6e7512c 100644 (file)
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -124,7 +124,8 @@ 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)))))
@@ -134,9 +135,10 @@ Should be called narrowed to the head of the message."
 
 (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))))
+  (let ((charsets
+        (mapcar
+         'mm-mime-charset
+         (mm-find-charset-region (point-min) (point-max))))
        (cs (list 'us-ascii mail-parse-charset))
        found)
     (while charsets
@@ -183,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)) "?"
@@ -194,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))
@@ -207,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."
@@ -266,7 +296,8 @@ 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) mail-parse-charset)
+         (when (and (mm-multibyte-p)
+                    mail-parse-charset)
            (mm-decode-coding-region b e mail-parse-charset))
          (setq b (point)))
        (when (and (mm-multibyte-p)
@@ -303,6 +334,10 @@ 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."
+  (if (stringp charset)
+    (setq charset (intern (downcase charset))))
+  (if (or (not charset) (memq charset mail-parse-ignored-charsets))
+      (setq charset mail-parse-charset))
   (let ((cs (mm-charset-to-coding-system charset)))
     (when cs
       (when (and (eq cs 'ascii)