Commit | Line | Data |
---|---|---|
62f20204 GM |
1 | ;;; rfc2368.el --- support for rfc2368 |
2 | ||
f2e3589a | 3 | ;; Copyright (C) 1998, 2000, 2001, 2002, 2003, 2004, |
49f70d46 | 4 | ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. |
f2e3589a | 5 | |
4bcb5a9e | 6 | ;; Author: Sen Nagata <sen@eccosys.com> |
62f20204 GM |
7 | ;; Keywords: mail |
8 | ||
62f20204 GM |
9 | ;; This file is part of GNU Emacs. |
10 | ||
b1fc2b50 | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
62f20204 | 12 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
62f20204 GM |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
62f20204 GM |
23 | |
24 | ;;; Commentary: | |
25 | ;; | |
26 | ;; notes: | |
27 | ;; | |
28 | ;; -repeat after me: "the colon is not part of the header name..." | |
29 | ;; -if w3 becomes part of emacs, then it may make sense to have this | |
30 | ;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs | |
31 | ;; is planned! | |
32 | ;; | |
33 | ;; historical note: | |
34 | ;; | |
35 | ;; this is intended as a replacement for mailto.el | |
36 | ;; | |
37 | ;; acknowledgements: | |
38 | ;; | |
39 | ;; the functions that deal w/ unhexifying in this file were basically | |
40 | ;; taken from w3 -- i hope to replace them w/ something else soon OR | |
41 | ;; perhaps if w3 becomes a part of emacs soon, use the functions from w3. | |
42 | ||
43 | ;;; History: | |
44 | ;; | |
45 | ;; 0.3: | |
46 | ;; | |
47 | ;; added the constant rfc2368-version | |
48 | ;; implemented first potential fix for a bug in rfc2368-mailto-regexp | |
49 | ;; implemented first potential fix for a bug in rfc2368-parse-mailto | |
50 | ;; (both bugs reported by Kenichi OKADA) | |
51 | ;; | |
52 | ;; 0.2: | |
53 | ;; | |
54 | ;; started to use checkdoc | |
55 | ;; | |
56 | ;; 0.1: | |
57 | ;; | |
58 | ;; initial implementation | |
59 | ||
60 | ;;; Code: | |
61 | ||
62 | ;; only an approximation? | |
63 | ;; see rfc 1738 | |
64 | (defconst rfc2368-mailto-regexp | |
65 | "^\\(mailto:\\)\\([^?]+\\)*\\(\\?\\(.*\\)\\)*" | |
66 | "Regular expression to match and aid in parsing a mailto url.") | |
67 | ||
68 | ;; describes 'mailto:' | |
69 | (defconst rfc2368-mailto-scheme-index 1 | |
70 | "Describes the 'mailto:' portion of the url.") | |
71 | ;; i'm going to call this part the 'prequery' | |
72 | (defconst rfc2368-mailto-prequery-index 2 | |
73 | "Describes the portion of the url between 'mailto:' and '?'.") | |
74 | ;; i'm going to call this part the 'query' | |
75 | (defconst rfc2368-mailto-query-index 4 | |
76 | "Describes the portion of the url after '?'.") | |
77 | ||
62f20204 GM |
78 | (defun rfc2368-unhexify-string (string) |
79 | "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'." | |
651f4d9f EZ |
80 | (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}" |
81 | (lambda (match) | |
82 | (string (string-to-number (substring match 1) | |
83 | 16))) | |
84 | string t t)) | |
62f20204 GM |
85 | |
86 | (defun rfc2368-parse-mailto-url (mailto-url) | |
87 | "Parse MAILTO-URL, and return an alist of header-name, header-value pairs. | |
88 | MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a | |
89 | key of 'Body' is a special case and is considered a header for this purpose. | |
90 | The returned alist is intended for use w/ the `compose-mail' interface. | |
91 | Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. & -> &), before | |
92 | calling this function." | |
93 | (let ((case-fold-search t) | |
94 | prequery query headers-alist) | |
95 | ||
96 | (if (string-match rfc2368-mailto-regexp mailto-url) | |
97 | (progn | |
98 | ||
99 | (setq prequery | |
100 | (match-string rfc2368-mailto-prequery-index mailto-url)) | |
a1506d29 | 101 | |
62f20204 GM |
102 | (setq query |
103 | (match-string rfc2368-mailto-query-index mailto-url)) | |
104 | ||
105 | ;; build alist of header name-value pairs | |
106 | (if (not (null query)) | |
107 | (setq headers-alist | |
108 | (mapcar | |
109 | (lambda (x) | |
110 | (let* ((temp-list (split-string x "=")) | |
111 | (header-name (car temp-list)) | |
112 | (header-value (cadr temp-list))) | |
113 | ;; return ("Header-Name" . "header-value") | |
114 | (cons | |
115 | (capitalize (rfc2368-unhexify-string header-name)) | |
116 | (rfc2368-unhexify-string header-value)))) | |
117 | (split-string query "&")))) | |
118 | ||
119 | ;; deal w/ multiple 'To' recipients | |
120 | (if prequery | |
121 | (progn | |
860e1e0f | 122 | (setq prequery (rfc2368-unhexify-string prequery)) |
62f20204 GM |
123 | (if (assoc "To" headers-alist) |
124 | (let* ((our-cons-cell | |
125 | (assoc "To" headers-alist)) | |
126 | (our-cdr | |
127 | (cdr our-cons-cell))) | |
860e1e0f | 128 | (setcdr our-cons-cell (concat prequery ", " our-cdr))) |
62f20204 GM |
129 | (setq headers-alist |
130 | (cons (cons "To" prequery) headers-alist))))) | |
a1506d29 | 131 | |
62f20204 | 132 | headers-alist) |
a1506d29 | 133 | |
62f20204 GM |
134 | (error "Failed to match a mailto: url")) |
135 | )) | |
136 | ||
137 | (provide 'rfc2368) | |
138 | ||
cbee283d | 139 | ;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95 |
62f20204 | 140 | ;;; rfc2368.el ends here |