[Emacs-diffs] master 1ee47d4: Don’t double-encode non-ASCII for mail client

[Paul Eggert]

branch: master
commit 1ee47d477ddb9c567eaf63154f78fad5d5826b78
Author: Paul Eggert <address@hidden>
Commit: Paul Eggert <address@hidden>

    Don’t double-encode non-ASCII for mail client
    
    * 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:@address@hidden@var{contents}[&@address@hidden
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_:/address@hidden" (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)