master 7dabcb1: Make rfc2368 obsolete and add rfc6068

[Lars Ingebrigtsen]

branch: master
commit 7dabcb15118674be4a6254f1d69d44a3db20c7c4
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Make rfc2368 obsolete and add rfc6068
    
    * lisp/obsolete/rfc2368.el: Moved here and made obsolete.
    
    * lisp/mail/rfc6068.el (rfc6068-unhexify-string): New file.
---
 etc/NEWS                                      |  7 +++
 lisp/mail/rfc6068.el                          | 76 +++++++++++++++++++++++++++
 lisp/net/browse-url.el                        |  4 +-
 lisp/{mail => obsolete}/rfc2368.el            |  1 +
 test/lisp/mail/rfc6068-tests.el               | 52 ++++++++++++++++++
 test/lisp/{mail => obsolete}/rfc2368-tests.el |  0
 6 files changed, 138 insertions(+), 2 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 9651ce1..5beea33 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1489,6 +1489,13 @@ deleting.
 +++
 **** The spec element 'function-form' is obsolete, use 'form' instead.
 
+---
+*** rfc2368.el is now obsolete.
+Use rfc6068.el instead.  The main difference is that
+'rfc2368-parse-mailto-url' and 'rfc2368-unhexify-string' assumed that
+the strings were all-ASCII, while 'rfc6068-parse-mailto-url' and
+'rfc2068-unhexify-string' parse UTF-8 strings.
+
 +++
 *** New function 'def-edebug-elem-spec' to define Edebug spec elements.
 These used to be defined with 'def-edebug-spec' thus conflating the
diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el
new file mode 100644
index 0000000..6198342
--- /dev/null
+++ b/lisp/mail/rfc6068.el
@@ -0,0 +1,76 @@
+;;; rfc6068.el --- support for rfc6068  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(defun rfc6068-unhexify-string (string)
+  "Unhexify STRING -- e.g. `hello%20there' -> `hello there'."
+  (decode-coding-string
+   (with-temp-buffer
+     (set-buffer-multibyte nil)
+     (insert string)
+     (goto-char (point-min))
+     (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
+       (replace-match (string (string-to-number (match-string 1) 16)) t t))
+     (buffer-string))
+   'utf-8))
+
+(defun rfc6068-parse-mailto-url (mailto-url)
+  "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
+MAILTO-URL should be a RFC 6068 (mailto) compliant url.  A cons cell w/ a
+key of `Body' is a special case and is considered a header for this purpose.
+The returned alist is intended for use w/ the `compose-mail' interface.
+Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., &amp; -> &), before
+calling this function."
+  (let ((case-fold-search t)
+       headers-alist)
+    (setq mailto-url (string-replace "\n" " " mailto-url))
+    (when (string-match "^\\(mailto:\\)\\([^?]+\\)?\\(\\?\\(.*\\)\\)*"
+                        mailto-url)
+      (let ((address (match-string 2 mailto-url))
+            (query (match-string 4 mailto-url)))
+       ;; Build alist of header name-value pairs.
+       (when query
+         (setq headers-alist
+               (mapcar
+                (lambda (x)
+                  (let* ((pair (split-string x "="))
+                         (name (car pair))
+                         (value (cadr pair)))
+                    ;; Return ("Header-Name" . "header-value").
+                    (cons
+                     (capitalize (rfc6068-unhexify-string name))
+                     (rfc6068-unhexify-string value))))
+                (split-string query "&"))))
+
+       (when address
+         (setq address (rfc6068-unhexify-string address))
+         ;; Deal with multiple 'To' recipients.
+         (if-let ((elem (assoc "To" headers-alist)))
+             (setcdr elem (concat address ", " (cdr elem)))
+            (push (cons "To" address) headers-alist)))
+
+       headers-alist))))
+
+(provide 'rfc6068)
+
+;;; rfc6068.el ends here
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index c8ca70c..73b8c43 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -1603,7 +1603,7 @@ used instead of `browse-url-new-window-flag'."
 
 ;; --- mailto ---
 
-(autoload 'rfc2368-parse-mailto-url "rfc2368")
+(autoload 'rfc6068-parse-mailto-url "rfc2368")
 
 ;;;###autoload
 (defun browse-url-mail (url &optional new-window)
@@ -1622,7 +1622,7 @@ When called non-interactively, optional second argument 
NEW-WINDOW is
 used instead of `browse-url-new-window-flag'."
   (interactive (browse-url-interactive-arg "Mailto URL: "))
   (save-excursion
-    (let* ((alist (rfc2368-parse-mailto-url url))
+    (let* ((alist (rfc6068-parse-mailto-url url))
           (to (assoc "To" alist))
           (subject (assoc "Subject" alist))
           (body (assoc "Body" alist))
diff --git a/lisp/mail/rfc2368.el b/lisp/obsolete/rfc2368.el
similarity index 99%
rename from lisp/mail/rfc2368.el
rename to lisp/obsolete/rfc2368.el
index b96f15d..8a842b0 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/obsolete/rfc2368.el
@@ -4,6 +4,7 @@
 
 ;; Author: Sen Nagata <sen@eccosys.com>
 ;; Keywords: mail
+;; Obsolete-since: 28.1
 
 ;; This file is part of GNU Emacs.
 
diff --git a/test/lisp/mail/rfc6068-tests.el b/test/lisp/mail/rfc6068-tests.el
new file mode 100644
index 0000000..caf8230
--- /dev/null
+++ b/test/lisp/mail/rfc6068-tests.el
@@ -0,0 +1,52 @@
+;;; rfc6068-tests.el --- Tests for rfc6068.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'rfc6068)
+
+(ert-deftest rfc6068-unhexify-string ()
+  (should (equal (rfc6068-unhexify-string "hello%20there") "hello there"))
+  (should (equal (rfc6068-unhexify-string "caf%C3%A9") "café")))
+
+(ert-deftest rfc6068-parse-mailto-url ()
+  (should
+   (equal
+    (rfc6068-parse-mailto-url "mailto:foo@example.org?subject=Foo&bar=baz";)
+    '(("To" . "foo@example.org") ("Subject" . "Foo") ("Bar" . "baz"))))
+  (should
+   (equal
+    (rfc6068-parse-mailto-url "mailto:foo@bar.com?to=bar@example.org";)
+    '(("To" . "foo@bar.com, bar@example.org"))))
+  (should
+   (equal (rfc6068-parse-mailto-url "mailto:foo@bar.com?subject=bar%20baz";)
+          '(("To" . "foo@bar.com") ("Subject" . "bar baz"))))
+  (should
+   (equal (rfc6068-parse-mailto-url 
"mailto:foo@bar.com?subject=bar%20baz&to=other@bar.com";)
+          '(("Subject" . "bar baz") ("To" . "foo@bar.com, other@bar.com"))))
+  (should
+   (equal (rfc6068-parse-mailto-url 
"mailto:user@example.org?subject=caf%C3%A9&body=caf%C3%A9";)
+          '(("To" . "user@example.org") ("Subject" . "café") ("Body" . 
"café")))))
+
+(provide 'rfc6068-tests)
+
+;;; rfc6068-tests.el ends here
diff --git a/test/lisp/mail/rfc2368-tests.el 
b/test/lisp/obsolete/rfc2368-tests.el
similarity index 100%
rename from test/lisp/mail/rfc2368-tests.el
rename to test/lisp/obsolete/rfc2368-tests.el