From: Kenichi Handa <handa@m17n.org>
Date: Mon, 23 May 2011 04:44:29 +0000 (+0900)
Subject: RFC2047-encode header of outgoing mails.
X-Git-Tag: emacs-pretest-24.0.90~104^3~40^2
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b8d747b9bd6e8278349aa7faaf4bbbf0b9ce24db;p=emacs.git

RFC2047-encode header of outgoing mails.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9d591146cbe..bad99e7294b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2011-05-23  Kenichi Handa  <handa@m17n.org>
+
+	* mail/sendmail.el: Require `rfc2047'.
+	(mail-insert-from-field): Do not perform RFC2047 encoding.
+	(mail-encode-header): New function.
+	(sendmail-send-it): Set buffer-file-coding-system of the work
+	buffer to the return value of select-message-coding-system.  Call
+	mail-encode-header.
+
+	* mail/smtpmail.el (smtpmail-send-it): Call mail-encode-header.
+
 2011-05-22  Sean Neakums  <sneakums@zork.net>  (tiny change)
 
 	* mail/supercite.el (sc-default-cite-frame): Handle
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 8cd650317b1..b6fd586c2ed 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -34,7 +34,7 @@
   (require 'rmail)
   (require 'mailalias))
 
-(autoload 'rfc2047-encode-string "rfc2047")
+(require 'rfc2047)
 
 (defgroup sendmail nil
   "Mail sending commands for Emacs."
@@ -952,12 +952,14 @@ of outgoing mails regardless of the current language environment.
 See also the function `select-message-coding-system'.")
 
 (defun mail-insert-from-field ()
+  "Insert the \"From:\" field of a mail header.
+The style of the field is determined by the variable `mail-from-style'.
+This function does not perform RFC2047 encoding."
   (let* ((login user-mail-address)
 	 (fullname (user-full-name))
 	 (quote-fullname nil))
     (if (string-match "[^\0-\177]" fullname)
-	(setq fullname (rfc2047-encode-string fullname)
-	      quote-fullname t))
+	(setq quote-fullname t))
     (cond ((null mail-from-style)
 	   (insert "From: " login "\n"))
 	  ;; This is deprecated.
@@ -1017,6 +1019,20 @@ See also the function `select-message-coding-system'.")
 		 (goto-char fullname-start))))
 	   (insert ")\n")))))
 
+(defun mail-encode-header (beg end)
+  "Encode the mail header between BEG and END according to RFC2047.
+Return non-nil if and only if some part of the header is encoded."
+  (save-restriction
+    (narrow-to-region beg end)
+    (let* ((selected (select-message-coding-system))
+	   (mm-coding-system-priorities
+	    (if (and selected (coding-system-get selected :mime-charset))
+		(cons selected mm-coding-system-priorities)
+	      mm-coding-system-priorities))
+	   (tick (buffer-chars-modified-tick)))
+      (rfc2047-encode-message-header)
+      (= tick (buffer-chars-modified-tick)))))
+
 ;; Normally you will not need to modify these options unless you are
 ;; using some non-genuine substitute for sendmail which does not
 ;; implement each and every option that the original supports.
@@ -1060,6 +1076,7 @@ external program defined by `sendmail-program'."
 	  (unless multibyte
 	    (set-buffer-multibyte nil))
 	  (insert-buffer-substring mailbuf)
+	  (set-buffer-file-coding-system selected-coding)
 	  (goto-char (point-max))
 	  ;; require one newline at the end.
 	  (or (= (preceding-char) ?\n)
@@ -1166,6 +1183,8 @@ external program defined by `sendmail-program'."
 	    (if mail-interactive
 		(with-current-buffer errbuf
 		  (erase-buffer))))
+	  ;; Encode the header according to RFC2047.
+	  (mail-encode-header (point-min) delimline)
 	  (goto-char (point-min))
 	  (if (let ((case-fold-search t))
 		(or resend-to-addresses
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index f59e8b02cd0..a68e1e6b1f2 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -362,6 +362,8 @@ The list is in preference order.")
 	    (if mail-interactive
 		(with-current-buffer errbuf
 		  (erase-buffer))))
+	  ;; Encode the header according to RFC2047.
+	  (mail-encode-header (point-min) delimline)
 	  ;;
 	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
 	  (setq smtpmail-recipient-address-list