Mercurial > emacs
annotate lisp/mail/rfc2368.el @ 46840:65ec8c8b0b3e
*** empty log message ***
author | Ken Raeburn <raeburn@raeburn.org> |
---|---|
date | Thu, 08 Aug 2002 16:59:23 +0000 |
parents | afc8a292184c |
children | 0d8b17d428b5 |
rev | line source |
---|---|
28496 | 1 ;;; rfc2368.el --- support for rfc2368 |
2 | |
28520
afc8a292184c
Correct author's email address.
Gerd Moellmann <gerd@gnu.org>
parents:
28500
diff
changeset
|
3 ;; Author: Sen Nagata <sen@eccosys.com> |
28496 | 4 ;; Keywords: mail |
5 | |
6 ;; Copyright (C) 1998, 2000 Free Software Foundation, Inc. | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 ;; | |
27 ;; notes: | |
28 ;; | |
29 ;; -repeat after me: "the colon is not part of the header name..." | |
30 ;; -if w3 becomes part of emacs, then it may make sense to have this | |
31 ;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs | |
32 ;; is planned! | |
33 ;; | |
34 ;; historical note: | |
35 ;; | |
36 ;; this is intended as a replacement for mailto.el | |
37 ;; | |
38 ;; acknowledgements: | |
39 ;; | |
40 ;; the functions that deal w/ unhexifying in this file were basically | |
41 ;; taken from w3 -- i hope to replace them w/ something else soon OR | |
42 ;; perhaps if w3 becomes a part of emacs soon, use the functions from w3. | |
43 | |
44 ;;; History: | |
45 ;; | |
46 ;; 0.3: | |
47 ;; | |
48 ;; added the constant rfc2368-version | |
49 ;; implemented first potential fix for a bug in rfc2368-mailto-regexp | |
50 ;; implemented first potential fix for a bug in rfc2368-parse-mailto | |
51 ;; (both bugs reported by Kenichi OKADA) | |
52 ;; | |
53 ;; 0.2: | |
54 ;; | |
55 ;; started to use checkdoc | |
56 ;; | |
57 ;; 0.1: | |
58 ;; | |
59 ;; initial implementation | |
60 | |
61 ;;; Code: | |
62 | |
63 ;; only an approximation? | |
64 ;; see rfc 1738 | |
65 (defconst rfc2368-mailto-regexp | |
66 "^\\(mailto:\\)\\([^?]+\\)*\\(\\?\\(.*\\)\\)*" | |
67 "Regular expression to match and aid in parsing a mailto url.") | |
68 | |
69 ;; describes 'mailto:' | |
70 (defconst rfc2368-mailto-scheme-index 1 | |
71 "Describes the 'mailto:' portion of the url.") | |
72 ;; i'm going to call this part the 'prequery' | |
73 (defconst rfc2368-mailto-prequery-index 2 | |
74 "Describes the portion of the url between 'mailto:' and '?'.") | |
75 ;; i'm going to call this part the 'query' | |
76 (defconst rfc2368-mailto-query-index 4 | |
77 "Describes the portion of the url after '?'.") | |
78 | |
79 ;; for dealing w/ unhexifying strings, my preferred approach is to use | |
80 ;; a 'string-replace-match-using-function' which can perform a | |
81 ;; string-replace-match and compute the replacement text based on a | |
82 ;; passed function -- however, emacs doesn't seem to have such a | |
83 ;; function yet :-( | |
84 | |
85 ;; for the moment a rip-off of url-unhex (w3/url.el) | |
86 (defun rfc2368-unhexify-char (char) | |
87 "Unhexify CHAR -- e.g. %20 -> <SPC>." | |
88 (if (> char ?9) | |
89 (if (>= char ?a) | |
90 (+ 10 (- char ?a)) | |
91 (+ 10 (- char ?A))) | |
92 (- char ?0))) | |
93 | |
94 ;; for the moment a rip-off of url-unhex-string (w3/url.el) (slightly modified) | |
95 (defun rfc2368-unhexify-string (string) | |
96 "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'." | |
97 (let ((case-fold-search t) | |
98 (result "")) | |
99 (while (string-match "%[0-9a-f][0-9a-f]" string) | |
100 (let* ((start (match-beginning 0)) | |
101 (hex-code (+ (* 16 | |
102 (rfc2368-unhexify-char (elt string (+ start 1)))) | |
103 (rfc2368-unhexify-char (elt string (+ start 2)))))) | |
104 (setq result (concat | |
105 result (substring string 0 start) | |
106 (char-to-string hex-code)) | |
107 string (substring string (match-end 0))))) | |
108 ;; it seems clearer to do things this way than to just return: | |
109 ;; (concat result string) | |
110 (setq result (concat result string)) | |
111 result)) | |
112 | |
113 (defun rfc2368-parse-mailto-url (mailto-url) | |
114 "Parse MAILTO-URL, and return an alist of header-name, header-value pairs. | |
115 MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a | |
116 key of 'Body' is a special case and is considered a header for this purpose. | |
117 The returned alist is intended for use w/ the `compose-mail' interface. | |
118 Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. & -> &), before | |
119 calling this function." | |
120 (let ((case-fold-search t) | |
121 prequery query headers-alist) | |
122 | |
123 (if (string-match rfc2368-mailto-regexp mailto-url) | |
124 (progn | |
125 | |
126 (setq prequery | |
127 (match-string rfc2368-mailto-prequery-index mailto-url)) | |
128 | |
129 (setq query | |
130 (match-string rfc2368-mailto-query-index mailto-url)) | |
131 | |
132 ;; build alist of header name-value pairs | |
133 (if (not (null query)) | |
134 (setq headers-alist | |
135 (mapcar | |
136 (lambda (x) | |
137 (let* ((temp-list (split-string x "=")) | |
138 (header-name (car temp-list)) | |
139 (header-value (cadr temp-list))) | |
140 ;; return ("Header-Name" . "header-value") | |
141 (cons | |
142 (capitalize (rfc2368-unhexify-string header-name)) | |
143 (rfc2368-unhexify-string header-value)))) | |
144 (split-string query "&")))) | |
145 | |
146 ;; deal w/ multiple 'To' recipients | |
147 (if prequery | |
148 (progn | |
149 (if (assoc "To" headers-alist) | |
150 (let* ((our-cons-cell | |
151 (assoc "To" headers-alist)) | |
152 (our-cdr | |
153 (cdr our-cons-cell))) | |
154 (setcdr our-cons-cell (concat our-cdr ", " prequery))) | |
155 (setq headers-alist | |
156 (cons (cons "To" prequery) headers-alist))))) | |
157 | |
158 headers-alist) | |
159 | |
160 (error "Failed to match a mailto: url")) | |
161 )) | |
162 | |
163 (provide 'rfc2368) | |
164 | |
165 ;;; rfc2368.el ends here |