X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Frfc2047.el;h=6e7512c50f0b7f30cd7fba8d843d8a9407bee394;hb=3aca09c100b6c60da9524bebf9c9eed6ad3e0174;hp=b68146afc42c76e813c4a3ef23b0c0b065911792;hpb=daea6bb7f5bda46077dabaf7a2ab4450df400fa7;p=elisp%2Fgnus.git-

diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index b68146a..6e7512c 100644
--- 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)