lisp/gnus/rfc2047.el (rfc2047-encode-message-header): Unify charsets into a single one used for encoding the whole text in a header

2 files changed, 91 insertions, 75 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 4ea0830cb76..9733215b591 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-02  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2047.el (rfc2047-encode-message-header): Unify charsets into
+	a single one used for encoding the whole text in a header.
+
 2013-08-01  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* message.el (message-ignored-news-headers): Delete X-Gnus-Delayed
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index a9498d46e79..ebf597423b8 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -235,85 +235,96 @@ Should be called narrowed to the head of the message."
   (interactive "*")
   (save-excursion
     (goto-char (point-min))
-    (let (alist elem method)
+    (let (alist elem method charsets)
       (while (not (eobp))
 	(save-restriction
 	  (rfc2047-narrow-to-field)
 	  (setq method nil
-		alist rfc2047-header-encoding-alist)
-	  (while (setq elem (pop alist))
-	    (when (or (and (stringp (car elem))
-			   (looking-at (car elem)))
-		      (eq (car elem) t))
-	      (setq alist nil
-		    method (cdr elem))))
-	  (if (not (rfc2047-encodable-p))
-	      (prog2
-		  (when (eq method 'address-mime)
-		    (rfc2047-quote-special-characters-in-quoted-strings))
-		  (if (and (eq (mm-body-7-or-8) '8bit)
-			   (mm-multibyte-p)
-			   (mm-coding-system-p
-			    (car message-posting-charset)))
-		      ;; 8 bit must be decoded.
-		      (mm-encode-coding-region
-		       (point-min) (point-max)
-		       (mm-charset-to-coding-system
-			(car message-posting-charset))))
-		;; No encoding necessary, but folding is nice
-		(when nil
-		  (rfc2047-fold-region
-		   (save-excursion
-		     (goto-char (point-min))
-		     (skip-chars-forward "^:")
-		     (when (looking-at ": ")
-		       (forward-char 2))
-		     (point))
-		   (point-max))))
-	    ;; We found something that may perhaps be encoded.
-	    (re-search-forward "^[^:]+: *" nil t)
-	    (cond
-	     ((eq method 'address-mime)
-	      (rfc2047-encode-region (point) (point-max)))
-	     ((eq method 'mime)
-	      (let ((rfc2047-encoding-type 'mime))
-		(rfc2047-encode-region (point) (point-max))))
-	     ((eq method 'default)
-	      (if (and (featurep 'mule)
-		       (if (boundp 'enable-multibyte-characters)
-			   (default-value 'enable-multibyte-characters))
-		       mail-parse-charset)
-		  (mm-encode-coding-region (point) (point-max)
-					   mail-parse-charset)))
-	     ;; We get this when CC'ing messages to newsgroups with
-	     ;; 8-bit names.  The group name mail copy just got
-	     ;; unconditionally encoded.  Previously, it would ask
-	     ;; whether to encode, which was quite confusing for the
-	     ;; user.  If the new behavior is wrong, tell me.  I have
-	     ;; left the old code commented out below.
-	     ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
-	     ;; Modified by Dave Love, with the commented-out code changed
-	     ;; in accordance with changes elsewhere.
-	     ((null method)
-	      (rfc2047-encode-region (point) (point-max)))
-;;; 	     ((null method)
-;;; 	      (if (or (message-options-get
-;;; 		       'rfc2047-encode-message-header-encode-any)
-;;; 		      (message-options-set
-;;; 		       'rfc2047-encode-message-header-encode-any
-;;; 		       (y-or-n-p
-;;; 			"Some texts are not encoded. Encode anyway?")))
-;;; 		  (rfc2047-encode-region (point-min) (point-max))
-;;; 		(error "Cannot send unencoded text")))
-	     ((mm-coding-system-p method)
-	      (if (or (and (featurep 'mule)
-			   (if (boundp 'enable-multibyte-characters)
-			       (default-value 'enable-multibyte-characters)))
-		      (featurep 'file-coding))
-		  (mm-encode-coding-region (point) (point-max) method)))
-	     ;; Hm.
-	     (t)))
-	  (goto-char (point-max)))))))
+		alist rfc2047-header-encoding-alist
+		charsets (mm-find-mime-charset-region (point-min) (point-max)))
+	  ;; M$ Outlook boycotts decoding of a header if it consists
+	  ;; of two or more encoded words and those charsets differ;
+	  ;; it seems to decode all words in a header from a charset
+	  ;; found first in the header.  So, we unify the charsets into
+	  ;; a single one used for encoding the whole text in a header.
+	  (let ((mm-coding-system-priorities
+		 (if (= (length charsets) 1)
+		     (cons (mm-charset-to-coding-system (car charsets))
+			   mm-coding-system-priorities)
+		   mm-coding-system-priorities)))
+	    (while (setq elem (pop alist))
+	      (when (or (and (stringp (car elem))
+			     (looking-at (car elem)))
+			(eq (car elem) t))
+		(setq alist nil
+		      method (cdr elem))))
+	    (if (not (rfc2047-encodable-p))
+		(prog2
+		    (when (eq method 'address-mime)
+		      (rfc2047-quote-special-characters-in-quoted-strings))
+		    (if (and (eq (mm-body-7-or-8) '8bit)
+			     (mm-multibyte-p)
+			     (mm-coding-system-p
+			      (car message-posting-charset)))
+			;; 8 bit must be decoded.
+			(mm-encode-coding-region
+			 (point-min) (point-max)
+			 (mm-charset-to-coding-system
+			  (car message-posting-charset))))
+		  ;; No encoding necessary, but folding is nice
+		  (when nil
+		    (rfc2047-fold-region
+		     (save-excursion
+		       (goto-char (point-min))
+		       (skip-chars-forward "^:")
+		       (when (looking-at ": ")
+			 (forward-char 2))
+		       (point))
+		     (point-max))))
+	      ;; We found something that may perhaps be encoded.
+	      (re-search-forward "^[^:]+: *" nil t)
+	      (cond
+	       ((eq method 'address-mime)
+		(rfc2047-encode-region (point) (point-max)))
+	       ((eq method 'mime)
+		(let ((rfc2047-encoding-type 'mime))
+		  (rfc2047-encode-region (point) (point-max))))
+	       ((eq method 'default)
+		(if (and (featurep 'mule)
+			 (if (boundp 'enable-multibyte-characters)
+			     (default-value 'enable-multibyte-characters))
+			 mail-parse-charset)
+		    (mm-encode-coding-region (point) (point-max)
+					     mail-parse-charset)))
+	       ;; We get this when CC'ing messages to newsgroups with
+	       ;; 8-bit names.  The group name mail copy just got
+	       ;; unconditionally encoded.  Previously, it would ask
+	       ;; whether to encode, which was quite confusing for the
+	       ;; user.  If the new behavior is wrong, tell me.  I have
+	       ;; left the old code commented out below.
+	       ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
+	       ;; Modified by Dave Love, with the commented-out code changed
+	       ;; in accordance with changes elsewhere.
+	       ((null method)
+		(rfc2047-encode-region (point) (point-max)))
+;;;	       ((null method)
+;;;		(if (or (message-options-get
+;;;			 'rfc2047-encode-message-header-encode-any)
+;;;			(message-options-set
+;;;			 'rfc2047-encode-message-header-encode-any
+;;;			 (y-or-n-p
+;;;			  "Some texts are not encoded. Encode anyway?")))
+;;;		    (rfc2047-encode-region (point-min) (point-max))
+;;;		  (error "Cannot send unencoded text")))
+	       ((mm-coding-system-p method)
+		(if (or (and (featurep 'mule)
+			     (if (boundp 'enable-multibyte-characters)
+				 (default-value 'enable-multibyte-characters)))
+			(featurep 'file-coding))
+		    (mm-encode-coding-region (point) (point-max) method)))
+	       ;; Hm.
+	       (t)))
+	    (goto-char (point-max))))))))
 
 ;; Fixme: This, and the require below may not be the Right Thing, but
 ;; should be safe just before release.  -- fx 2001-02-08