From d76d8aa460927924ab35b119c49be09f8aa84dd3 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Mon, 14 Sep 2015 09:31:23 -0700
Subject: [PATCH] =?UTF-8?q?Don=E2=80=99t=20double-encode=20non-ASCII=20for?=
 =?UTF-8?q?=20mail=20client?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/mail/mailclient.el (mailclient-encode-string-as-url):
Use RFC 6068’s list of unreserved characters.
(mailclient-send-it): When encoding the body as a URL,
first decode it as per Content-Type: and Content-Transfer-Encoding:,
as URLs must use percent-encoded UTF-8 (Bug#21471).

* doc/misc/url.texi (mailto): Update RFC number.
---
 doc/misc/url.texi       |  2 +-
 lisp/mail/mailclient.el | 42 ++++++++++++++++++++++++++++++++++++++----
 2 files changed, 39 insertions(+), 5 deletions(-)

diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index d94b19f..95fe5ea 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -593,7 +593,7 @@ sending a message to @samp{foo@@bar.com}.  The ``retrieval method''
 for such URLs is to open a mail composition buffer in which the
 appropriate content (e.g., the recipient address) has been filled in.
 
-  As defined in RFC 2368, a @code{mailto} URL has the form
+  As defined in RFC 6068, a @code{mailto} URL can have the form
 
 @example
 @samp{mailto:@var{mailbox}[?@var{header}=@var{contents}[&@var{header}=@var{contents}]]}
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 31da6ee..bef2038 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -62,10 +62,9 @@ supported.  Defaults to non-nil on Windows, nil otherwise."
 	 (mapcar
 	  (lambda (char)
 	    (cond
-	     ((eq char ?\x20) "%20")   ;; space
 	     ((eq char ?\n) "%0D%0A")  ;; newline
-	     ((string-match "[-a-zA-Z0-9_:/.@]" (char-to-string char))
-	      (char-to-string char))   ;; printable
+	     ((string-match "[-a-zA-Z0-9._~]" (char-to-string char))
+	      (char-to-string char))   ;; unreserved as per RFC 6068
 	     (t                        ;; everything else
 	      (format "%%%02x" char))))	;; escape
 	  ;; Convert string to list of chars
@@ -125,6 +124,13 @@ The mail client is taken to be the handler of mailto URLs."
 		      (< (point) delimline))
 	    (replace-match "\n"))
 	  (let ((case-fold-search t)
+		(mime-charset-pattern
+		 (concat
+		  "^content-type:[ \t]*text/plain;"
+		  "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
+		  "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"))
+		coding-system
+		character-coding
 		;; Use the external browser function to send the
 		;; message.
 		(browse-url-mailto-function nil))
@@ -135,6 +141,15 @@ The mail client is taken to be the handler of mailto URLs."
 	     (concat
 	      (save-excursion
 		(narrow-to-region (point-min) delimline)
+		(goto-char (point-min))
+		(setq coding-system
+		      (if (re-search-forward mime-charset-pattern nil t)
+			  (coding-system-from-name (match-string 1))
+			'undecided))
+		(setq character-coding
+		      (mail-fetch-field "content-transfer-encoding"))
+		(when character-coding
+		  (setq character-coding (downcase character-coding)))
 		(concat
 		 "mailto:"
 		 ;; some of the headers according to RFC822
@@ -171,7 +186,26 @@ The mail client is taken to be the handler of mailto URLs."
 		       "*** E-Mail body has been placed on clipboard, "
 		       "please paste it here! ***"))
 		  ;; else
-		  (buffer-substring (+ 1 delimline) (point-max))))))))))))
+		  (let ((body (buffer-substring (+ 1 delimline) (point-max))))
+		    (if (null character-coding)
+			body
+		      ;; mailto: requires UTF-8 and cannot deal with
+		      ;; Content-Transfer-Encoding or Content-Type.
+		      ;; FIXME: There is a lot of code duplication here
+		      ;; with rmail.el.
+		      (erase-buffer)
+		      (set-buffer-multibyte nil)
+		      (insert body)
+		      (cond
+		       ((string= character-coding "quoted-printable")
+			(mail-unquote-printable-region (point-min) (point-max)
+						       nil nil 'unibyte))
+		       ((string= character-coding "base64")
+			(base64-decode-region (point-min) (point-max)))
+		       (t (error "unsupported Content-Transfer-Encoding: %s"
+				 character-coding)))
+		      (decode-coding-region (point-min) (point-max)
+					    coding-system t)))))))))))))
 
 (provide 'mailclient)
 
-- 
2.1.4