X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a57471f93507c55b55ee9e28c493ba78b46796e3..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/mail/mailclient.el

diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index b957d9f36c..bfd6e7d142 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -1,6 +1,6 @@
 ;;; mailclient.el --- mail sending via system's mail client.
 
-;; Copyright (C) 2005-2011 Free Software Foundation
+;; Copyright (C) 2005-2016 Free Software Foundation, Inc.
 
 ;; Author: David Reitter <david.reitter@gmail.com>
 ;; Keywords: mail
@@ -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
@@ -96,10 +95,11 @@ supported.  Defaults to non-nil on Windows, nil otherwise."
 		       recp)))
 	       (setq first nil))
 	     (split-string
-	      (mail-strip-quoted-names field) "\, *"))
+	      (mail-strip-quoted-names field) ", *"))
 	    result)))))
 
-(declare-function clipboard-kill-ring-save "menu-bar.el" (beg end))
+(declare-function clipboard-kill-ring-save "menu-bar.el"
+		  (beg end &optional region))
 
 ;;;###autoload
 (defun mailclient-send-it ()
@@ -124,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))
@@ -134,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
@@ -159,18 +175,31 @@ The mail client is taken to be the handler of mailto URLs."
 			       (mailclient-encode-string-as-url subj))
 		     ""))))
 	      ;; body
-	      (concat
-	       (mailclient-url-delim) "body="
-	       (mailclient-encode-string-as-url
-		(if mailclient-place-body-on-clipboard-flag
-		    (progn
-		      (clipboard-kill-ring-save
-		       (+ 1 delimline) (point-max))
-		      (concat
-		       "*** E-Mail body has been placed on clipboard, "
-		       "please paste it here! ***"))
-		  ;; else
-		  (buffer-substring (+ 1 delimline) (point-max))))))))))))
+	      (mailclient-url-delim) "body="
+	      (progn
+		(delete-region (point-min) delimline)
+		(unless (null character-coding)
+		  ;; mailto: and clipboard need UTF-8 and cannot deal with
+		  ;; Content-Transfer-Encoding or Content-Type.
+		  ;; FIXME: There is code duplication here with rmail.el.
+		  (set-buffer-multibyte nil)
+		  (cond
+		   ((string= character-coding "base64")
+		    (base64-decode-region (point-min) (point-max)))
+		   ((string= character-coding "quoted-printable")
+		    (mail-unquote-printable-region (point-min) (point-max)
+						   nil nil t))
+		   (t (error "unsupported Content-Transfer-Encoding: %s"
+			     character-coding)))
+		  (decode-coding-region (point-min) (point-max) coding-system))
+		(mailclient-encode-string-as-url
+		 (if mailclient-place-body-on-clipboard-flag
+		     (progn
+		       (clipboard-kill-ring-save (point-min) (point-max))
+		       (concat
+			"*** E-Mail body has been placed on clipboard, "
+			"please paste it here! ***"))
+		   (buffer-string)))))))))))
 
 (provide 'mailclient)