51081
|
1 ;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*-
|
809
|
2
|
38363
|
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001
|
|
4 ;; Free Software Foundation, Inc.
|
846
|
5
|
809
|
6 ;; Author: Joe Wells <jbw@cs.bu.edu>
|
20285
|
7 ;; Maintainer: FSF
|
809
|
8 ;; Keywords: mail
|
|
9
|
|
10 ;; This file is part of GNU Emacs.
|
|
11
|
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
13 ;; it under the terms of the GNU General Public License as published by
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option)
|
809
|
15 ;; any later version.
|
|
16
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
20 ;; GNU General Public License for more details.
|
|
21
|
|
22 ;; You should have received a copy of the GNU General Public License
|
14169
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
25 ;; Boston, MA 02111-1307, USA.
|
809
|
26
|
|
27 ;;; Commentary:
|
|
28
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
29 ;; The entry point of this code is
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
30 ;;
|
20285
|
31 ;; mail-extract-address-components: (address &optional all)
|
47939
|
32 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
33 ;; Given an RFC-822 ADDRESS, extract full name and canonical address.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
34 ;; Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
35 ;; If no name can be extracted, FULL-NAME will be nil.
|
47939
|
36 ;; ADDRESS may be a string or a buffer. If it is a buffer, the visible
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
37 ;; (narrowed) portion of the buffer will be interpreted as the address.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
38 ;; (This feature exists so that the clever caller might be able to avoid
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
39 ;; consing a string.)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
40 ;; If ADDRESS contains more than one RFC-822 address, only the first is
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
41 ;; returned.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
42 ;;
|
20285
|
43 ;; If ALL is non-nil, that means return info about all the addresses
|
|
44 ;; that are found in ADDRESS. The value is a list of elements of
|
|
45 ;; the form (FULL-NAME CANONICAL-ADDRESS), one per address.
|
|
46 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
47 ;; This code is more correct (and more heuristic) parser than the code in
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
48 ;; rfc822.el. And despite its size, it's fairly fast.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
49 ;;
|
809
|
50 ;; There are two main benefits:
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
51 ;;
|
809
|
52 ;; 1. Higher probability of getting the correct full name for a human than
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
53 ;; any other package we know of. (On the other hand, it will cheerfully
|
809
|
54 ;; mangle non-human names/comments.)
|
|
55 ;; 2. Address part is put in a canonical form.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
56 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
57 ;; The interface is not yet carved in stone; please give us suggestions.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
58 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
59 ;; We have an extensive test-case collection of funny addresses if you want to
|
809
|
60 ;; work with the code. Developing this code requires frequent testing to
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
61 ;; make sure you're not breaking functionality. The test cases aren't included
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
62 ;; because they are over 100K.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
63 ;;
|
47939
|
64 ;; If you find an address that mail-extr fails on, please send it to the
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
65 ;; maintainer along with what you think the correct results should be. We do
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
66 ;; not consider it a bug if mail-extr mangles a comment that does not
|
47939
|
67 ;; correspond to a real human full name, although we would prefer that
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
68 ;; mail-extr would return the comment as-is.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
69 ;;
|
809
|
70 ;; Features:
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
71 ;;
|
809
|
72 ;; * Full name handling:
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
73 ;;
|
809
|
74 ;; * knows where full names can be found in an address.
|
|
75 ;; * avoids using empty comments and quoted text.
|
|
76 ;; * extracts full names from mailbox names.
|
|
77 ;; * recognizes common formats for comments after a full name.
|
|
78 ;; * puts a period and a space after each initial.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
79 ;; * understands & referring to the mailbox name, capitalized.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
80 ;; * strips name prefixes like "Prof.", etc.
|
809
|
81 ;; * understands what characters can occur in names (not just letters).
|
|
82 ;; * figures out middle initial from mailbox name.
|
|
83 ;; * removes funny nicknames.
|
|
84 ;; * keeps suffixes such as Jr., Sr., III, etc.
|
|
85 ;; * reorders "Last, First" type names.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
86 ;;
|
809
|
87 ;; * Address handling:
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
88 ;;
|
809
|
89 ;; * parses rfc822 quoted text, comments, and domain literals.
|
|
90 ;; * parses rfc822 multi-line headers.
|
|
91 ;; * does something reasonable with rfc822 GROUP addresses.
|
|
92 ;; * handles many rfc822 noncompliant and garbage addresses.
|
|
93 ;; * canonicalizes addresses (after stripping comments/phrases outside <>).
|
|
94 ;; * converts ! addresses into .UUCP and %-style addresses.
|
|
95 ;; * converts rfc822 ROUTE addresses to %-style addresses.
|
|
96 ;; * truncates %-style addresses at leftmost fully qualified domain name.
|
|
97 ;; * handles local relative precedence of ! vs. % and @ (untested).
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
98 ;;
|
809
|
99 ;; It does almost no string creation. It primarily uses the built-in
|
|
100 ;; parsing routines with the appropriate syntax tables. This should
|
|
101 ;; result in greater speed.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
102 ;;
|
809
|
103 ;; TODO:
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
104 ;;
|
809
|
105 ;; * handle all test cases. (This will take forever.)
|
|
106 ;; * software to pick the correct header to use (eg., "Senders-Name:").
|
|
107 ;; * multiple addresses in the "From:" header (almost all of the necessary
|
|
108 ;; code is there).
|
|
109 ;; * flag to not treat `,' as an address separator. (This is useful when
|
|
110 ;; there is a "From:" header but no "Sender:" header, because then there
|
|
111 ;; is only allowed to be one address.)
|
|
112 ;; * mailbox name does not necessarily contain full name.
|
|
113 ;; * fixing capitalization when it's all upper or lowercase. (Hard!)
|
|
114 ;; * some of the domain literal handling is missing. (But I've never even
|
|
115 ;; seen one of these in a mail address, so maybe no big deal.)
|
|
116 ;; * arrange to have syntax tables byte-compiled.
|
|
117 ;; * speed hacks.
|
|
118 ;; * delete unused variables.
|
|
119 ;; * arrange for testing with different relative precedences of ! vs. @
|
|
120 ;; and %.
|
|
121 ;; * insert documentation strings!
|
|
122 ;; * handle X.400-gatewayed addresses according to RFC 1148.
|
|
123
|
47939
|
124 ;;; Change Log:
|
|
125 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
126 ;; Thu Feb 17 17:57:33 1994 Jamie Zawinski (jwz@lucid.com)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
127 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
128 ;; * merged with jbw's latest version
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
129 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
130 ;; Wed Feb 9 21:56:27 1994 Jamie Zawinski (jwz@lucid.com)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
131 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
132 ;; * high-bit chars in comments weren't treated as word syntax
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
133 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
134 ;; Sat Feb 5 03:13:40 1994 Jamie Zawinski (jwz@lucid.com)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
135 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
136 ;; * call replace-match with fixed-case arg
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
137 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
138 ;; Thu Dec 16 21:56:45 1993 Jamie Zawinski (jwz@lucid.com)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
139 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
140 ;; * some more cleanup, doc, added provide
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
141 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
142 ;; Tue Mar 23 21:23:18 1993 Joe Wells (jbw at csd.bu.edu)
|
47939
|
143 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
144 ;; * Made mail-full-name-prefixes a user-customizable variable.
|
46255
|
145 ;; Allow passing the address as a buffer as well as a string.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
146 ;; Allow [ and ] as name characters (Finnish character set).
|
47939
|
147 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
148 ;; Mon Mar 22 21:20:56 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
149 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
150 ;; * Handle "null" addresses. Handle = used for spacing in mailbox
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
151 ;; name. Fix bug in handling of ROUTE-ADDR-type addresses that are
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
152 ;; missing their brackets. Handle uppercase "JR". Extract full
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
153 ;; names from X.400 addresses encoded in RFC-822. Fix bug in
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
154 ;; handling of multiple addresses where first has trailing comment.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
155 ;; Handle more kinds of telephone extension lead-ins.
|
47939
|
156 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
157 ;; Mon Mar 22 20:16:57 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
158 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
159 ;; * Handle HZ encoding for embedding GB encoded chinese characters.
|
47939
|
160 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
161 ;; Mon Mar 22 00:46:12 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
162 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
163 ;; * Fixed too broad matching of ham radio call signs. Fixed bug in
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
164 ;; handling an unmatched ' in a name string. Enhanced recognition
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
165 ;; of when . in the mailbox name terminates the name portion.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
166 ;; Narrowed conversion of . to space to only the necessary
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
167 ;; situation. Deal with VMS's stupid date stamps. Handle a unique
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
168 ;; way of introducing an alternate address. Fixed spacing bug I
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
169 ;; introduced in switching last name order. Fixed bug in handling
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
170 ;; address with ! and % but no @. Narrowed the cases in which
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
171 ;; certain trailing words are discarded.
|
47939
|
172 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
173 ;; Sun Mar 21 21:41:06 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
174 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
175 ;; * Fixed bugs in handling GROUP addresses. Certain words in the
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
176 ;; middle of a name no longer terminate it. Handle LISTSERV list
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
177 ;; names. Ignore comment field containing mailbox name.
|
47939
|
178 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
179 ;; Sun Mar 21 14:39:38 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
180 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
181 ;; * Moved variant-method code back into main function. Handle
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
182 ;; underscores as spaces in comments. Handle leading nickname. Add
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
183 ;; flag to ignore single-word names. Other changes.
|
47939
|
184 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
185 ;; Mon Feb 1 22:23:31 1993 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
186 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
187 ;; * Added in changes by Rod Whitby and Jamie Zawinski. This
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
188 ;; includes the flag mail-extr-guess-middle-initial and the fix for
|
7133
|
189 ;; handling multiple addresses correctly. (Whitby just changed
|
|
190 ;; a > to a <.)
|
47939
|
191 ;;
|
809
|
192 ;; Mon Apr 6 23:59:09 1992 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
193 ;;
|
809
|
194 ;; * Cleaned up some more. Release version 1.0 to world.
|
47939
|
195 ;;
|
809
|
196 ;; Sun Apr 5 19:39:08 1992 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
197 ;;
|
809
|
198 ;; * Cleaned up full name extraction extensively.
|
47939
|
199 ;;
|
809
|
200 ;; Sun Feb 2 14:45:24 1992 Joe Wells (jbw at bigbird.bu.edu)
|
47939
|
201 ;;
|
809
|
202 ;; * Total rewrite. Integrated mail-canonicalize-address into
|
|
203 ;; mail-extract-address-components. Now handles GROUP addresses more
|
|
204 ;; or less correctly. Better handling of lots of different cases.
|
47939
|
205 ;;
|
809
|
206 ;; Fri Jun 14 19:39:50 1991
|
|
207 ;; * Created.
|
|
208
|
|
209 ;;; Code:
|
|
210
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
211
|
20962
|
212 (defgroup mail-extr nil
|
|
213 "Extract full name and address from RFC 822 mail header."
|
|
214 :prefix "mail-extr-"
|
|
215 :group 'mail)
|
|
216
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
218 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
219 ;; User configuration variable definitions.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
220 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
221
|
20962
|
222 (defcustom mail-extr-guess-middle-initial nil
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
223 "*Whether to try to guess middle initial from mail address.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
224 If true, then when we see an address like \"John Smith <jqs@host.com>\"
|
20962
|
225 we will assume that \"John Q. Smith\" is the fellow's name."
|
|
226 :type 'boolean
|
|
227 :group 'mail-extr)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
228
|
47615
|
229 (defcustom mail-extr-ignore-single-names nil
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
230 "*Whether to ignore a name that is just a single word.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
231 If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
|
20962
|
232 we will act as though we couldn't find a full name in the address."
|
|
233 :type 'boolean
|
52916
|
234 :version "21.4"
|
20962
|
235 :group 'mail-extr)
|
809
|
236
|
57391
|
237 (defcustom mail-extr-ignore-realname-equals-mailbox-name t
|
|
238 "*Whether to ignore a name that is equal to the mailbox name.
|
|
239 If true, then when the address is like \"Single <single@address.com>\"
|
|
240 we will act as though we couldn't find a full name in the address."
|
|
241 :type 'boolean
|
|
242 :group 'mail-extr)
|
|
243
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
244 ;; Matches a leading title that is not part of the name (does not
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
245 ;; contribute to uniquely identifying the person).
|
20962
|
246 (defcustom mail-extr-full-name-prefixes
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
247 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
248 "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
249 "*Matches prefixes to the full name that identify a person's position.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
250 These are stripped from the full name because they do not contribute to
|
20962
|
251 uniquely identifying the person."
|
|
252 :type 'regexp
|
|
253 :group 'mail-extr)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
254
|
20962
|
255 (defcustom mail-extr-@-binds-tighter-than-! nil
|
|
256 "*Whether the local mail transport agent looks at ! before @."
|
|
257 :type 'boolean
|
|
258 :group 'mail-extr)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
259
|
20962
|
260 (defcustom mail-extr-mangle-uucp nil
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
261 "*Whether to throw away information in UUCP addresses
|
20962
|
262 by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
|
|
263 :type 'boolean
|
|
264 :group 'mail-extr)
|
809
|
265
|
|
266 ;;----------------------------------------------------------------------
|
|
267 ;; what orderings are meaningful?????
|
|
268 ;;(defvar mail-operator-precedence-list '(?! ?% ?@))
|
|
269 ;; Right operand of a % or a @ must be a domain name, period. No other
|
|
270 ;; operators allowed. Left operand of a @ is an address relative to that
|
|
271 ;; site.
|
|
272
|
|
273 ;; Left operand of a ! must be a domain name. Right operand is an
|
|
274 ;; arbitrary address.
|
|
275 ;;----------------------------------------------------------------------
|
|
276
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
277
|
809
|
278
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
279 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
280 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
281 ;; Constant definitions.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
282 ;;
|
809
|
283
|
|
284 ;; Any character that can occur in a name, not counting characters that
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
285 ;; separate parts of a multipart name (hyphen and period).
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
286 ;; Yes, there are weird people with digits in their names.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
287 ;; You will also notice the consideration for the
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
288 ;; Swedish/Finnish/Norwegian character set.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
289 (defconst mail-extr-all-letters-but-separators
|
25439
|
290 (purecopy "][[:alnum:]{|}'~`"))
|
809
|
291
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
292 ;; Any character that can occur in a name in an RFC822 address including
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
293 ;; the separator (hyphen and possibly period) for multipart names.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
294 ;; #### should . be in here?
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
295 (defconst mail-extr-all-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
296 (purecopy (concat mail-extr-all-letters-but-separators "---")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
297
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
298 ;; Any character that can start a name.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
299 ;; Keep this set as minimal as possible.
|
25439
|
300 (defconst mail-extr-first-letters (purecopy "[:alpha:]"))
|
809
|
301
|
|
302 ;; Any character that can end a name.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
303 ;; Keep this set as minimal as possible.
|
25439
|
304 (defconst mail-extr-last-letters (purecopy "[:alpha:]`'."))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
305
|
41159
|
306 (defconst mail-extr-leading-garbage "\\W+")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
307
|
47939
|
308 ;; (defconst mail-extr-non-name-chars
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
309 ;; (purecopy (concat "^" mail-extr-all-letters ".")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
310 ;; (defconst mail-extr-non-begin-name-chars
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
311 ;; (purecopy (concat "^" mail-extr-first-letters)))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
312 ;; (defconst mail-extr-non-end-name-chars
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
313 ;; (purecopy (concat "^" mail-extr-last-letters)))
|
809
|
314
|
47939
|
315 ;; Matches an initial not followed by both a period and a space.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
316 ;; (defconst mail-extr-bad-initials-pattern
|
47939
|
317 ;; (purecopy
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
318 ;; (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
319 ;; mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
|
809
|
320
|
|
321 ;; Matches periods used instead of spaces. Must not match the period
|
|
322 ;; following an initial.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
323 (defconst mail-extr-bad-dot-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
324 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
325 (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
326 mail-extr-all-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
327 mail-extr-last-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
328 mail-extr-first-letters)))
|
809
|
329
|
|
330 ;; Matches an embedded or leading nickname that should be removed.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
331 ;; (defconst mail-extr-nickname-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
332 ;; (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
333 ;; (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] "
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
334 ;; mail-extr-all-letters)))
|
809
|
335
|
|
336 ;; Matches the occurrence of a generational name suffix, and the last
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
337 ;; character of the preceding name. This is important because we want to
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
338 ;; keep such suffixes: they help to uniquely identify the person.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
339 ;; *** Perhaps this should be a user-customizable variable. However, the
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
340 ;; *** regular expression is fairly tricky to alter, so maybe not.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
341 (defconst mail-extr-full-name-suffix-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
342 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
343 (format
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
344 "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
345 mail-extr-all-letters mail-extr-all-letters)))
|
809
|
346
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
347 (defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))
|
809
|
348
|
|
349 ;; Matches a trailing uppercase (with other characters possible) acronym.
|
|
350 ;; Must not match a trailing uppercase last name or trailing initial
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
351 (defconst mail-extr-weird-acronym-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
352 (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
|
47939
|
353
|
809
|
354 ;; Matches a mixed-case or lowercase name (not an initial).
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
355 ;; #### Match Latin1 lower case letters here too?
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
356 ;; (defconst mail-extr-mixed-case-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
357 ;; (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
358 ;; (format
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
359 ;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
360 ;; mail-extr-all-letters mail-extr-last-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
361 ;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
362 ;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))
|
809
|
363
|
|
364 ;; Matches a trailing alternative address.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
365 ;; #### Match Latin1 letters here too?
|
47939
|
366 ;; #### Match _ before @ here too?
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
367 (defconst mail-extr-alternative-address-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
368 (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
|
809
|
369
|
|
370 ;; Matches a variety of trailing comments not including comma-delimited
|
|
371 ;; comments.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
372 (defconst mail-extr-trailing-comment-start-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
373 (purecopy " [-{]\\|--\\|[+@#></\;]"))
|
809
|
374
|
|
375 ;; Matches a name (not an initial).
|
|
376 ;; This doesn't force a word boundary at the end because sometimes a
|
|
377 ;; comment is separated by a `-' with no preceding space.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
378 (defconst mail-extr-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
379 (purecopy (format "\\b[%s][%s]*[%s]"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
380 mail-extr-first-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
381 mail-extr-all-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
382 mail-extr-last-letters)))
|
809
|
383
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
384 (defconst mail-extr-initial-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
385 (purecopy (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters)))
|
809
|
386
|
|
387 ;; Matches a single name before a comma.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
388 ;; (defconst mail-extr-last-name-first-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
389 ;; (purecopy (concat "\\`" mail-extr-name-pattern ",")))
|
809
|
390
|
|
391 ;; Matches telephone extensions.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
392 (defconst mail-extr-telephone-extension-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
393 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
394 "\\(\\([Ee]xt\\|\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+"))
|
809
|
395
|
|
396 ;; Matches ham radio call signs.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
397 ;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
398 ;; <mark@era.com>, Michael Covington <mcovingt@ai.uga.edu>.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
399 ;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
400 ;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
401 ;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
402 (defconst mail-extr-ham-call-sign-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
403 (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
404
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
405 ;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
406 ;; /KT == Temporary Technician (has CSC but not "real" license)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
407 ;; /AA == Temporary Advanced
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
408 ;; /AE == Temporary Extra
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
409 ;; /AG == Temporary General
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
410 ;; /R == repeater
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
411 ;; /# == stations operating out of home district
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
412 ;; I don't include these in the regexp above because I can't imagine
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
413 ;; anyone putting them with their name in an e-mail address.
|
809
|
414
|
|
415 ;; Matches normal single-part name
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
416 (defconst mail-extr-normal-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
417 (purecopy (format "\\b[%s][%s]+[%s]"
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
418 mail-extr-first-letters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
419 mail-extr-all-letters-but-separators
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
420 mail-extr-last-letters)))
|
809
|
421
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
422 ;; Matches a single word name.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
423 ;; (defconst mail-extr-one-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
424 ;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
|
47939
|
425
|
809
|
426 ;; Matches normal two names with missing middle initial
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
427 ;; The first name is not allowed to have a hyphen because this can cause
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
428 ;; false matches where the "middle initial" is actually the first letter
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
429 ;; of the second part of the first name.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
430 (defconst mail-extr-two-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
431 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
432 (concat "\\`\\(" mail-extr-normal-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
433 "\\|" mail-extr-initial-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
434 "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
435
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
436 (defconst mail-extr-listserv-list-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
437 (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
438
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
439 (defconst mail-extr-stupid-vms-date-stamp-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
440 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
441 "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
442
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
443 ;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
444 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
445 ;; In ASCII mode, a byte is interpreted as an ASCII character, unless a '~' is
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
446 ;; encountered. The character '~' is an escape character. By convention, it
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
447 ;; must be immediately followed ONLY by '~', '{' or '\n' (<LF>), with the
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
448 ;; following special meaning.
|
47939
|
449 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
450 ;; o The escape sequence '~~' is interpreted as a '~'.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
451 ;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
452 ;; o The escape sequence '~\n' is a line-continuation marker to be consumed
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
453 ;; with no output produced.
|
47939
|
454 ;;
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
455 ;; In GB mode, characters are interpreted two bytes at a time as (pure) GB
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
456 ;; codes until the escape-from-GB code '~}' is read. This code switches the
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
457 ;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}'
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
458 ;; ($7E7D) is outside the defined GB range.)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
459 (defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
460 (purecopy "~{\\([^~].\\|~[^\}]\\)+~}"))
|
809
|
461
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
462 ;; The leading optional lowercase letters are for a bastardized version of
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
463 ;; the encoding, as is the optional nature of the final slash.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
464 (defconst mail-extr-x400-encoded-address-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
465 (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
466
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
467 (defconst mail-extr-x400-encoded-address-field-pattern-format
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
468 (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
469
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
470 (defconst mail-extr-x400-encoded-address-surname-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
471 ;; S stands for Surname (family name).
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
472 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
473 (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
474
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
475 (defconst mail-extr-x400-encoded-address-given-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
476 ;; G stands for Given name.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
477 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
478 (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
479
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
480 (defconst mail-extr-x400-encoded-address-full-name-pattern
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
481 ;; PN stands for Personal Name. When used it represents the combination
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
482 ;; of the G and S fields.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
483 ;; "The one system I used having this field asked it with the prompt
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
484 ;; `Personal Name'. But they mapped it into G and S on outgoing real
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
485 ;; X.400 addresses. As they mapped G and S into PN on incoming..."
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
486 (purecopy
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
487 (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
488
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
489
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
490
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
491 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
492 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
493 ;; Syntax tables used for quick parsing.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
494 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
495
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
496 (defconst mail-extr-address-syntax-table (make-syntax-table))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
497 (defconst mail-extr-address-comment-syntax-table (make-syntax-table))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
498 (defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
499 (defconst mail-extr-address-text-comment-syntax-table (make-syntax-table))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
500 (defconst mail-extr-address-text-syntax-table (make-syntax-table))
|
41300
|
501 (mapc
|
|
502 (lambda (pair)
|
|
503 (let ((syntax-table (symbol-value (car pair))))
|
|
504 (dolist (item (cdr pair))
|
|
505 (if (eq 2 (length item))
|
|
506 ;; modifying syntax of a single character
|
|
507 (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
|
|
508 ;; modifying syntax of a range of characters
|
|
509 (let ((char (nth 0 item))
|
|
510 (bound (nth 1 item))
|
|
511 (syntax (nth 2 item)))
|
|
512 (while (<= char bound)
|
|
513 (modify-syntax-entry char syntax syntax-table)
|
|
514 (setq char (1+ char))))))))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
515 '((mail-extr-address-syntax-table
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
516 (?\000 ?\037 "w") ;control characters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
517 (?\040 " ") ;SPC
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
518 (?! ?~ "w") ;printable characters
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
519 (?\177 "w") ;DEL
|
809
|
520 (?\t " ")
|
|
521 (?\r " ")
|
|
522 (?\n " ")
|
|
523 (?\( ".")
|
|
524 (?\) ".")
|
|
525 (?< ".")
|
|
526 (?> ".")
|
|
527 (?@ ".")
|
|
528 (?, ".")
|
|
529 (?\; ".")
|
|
530 (?: ".")
|
|
531 (?\\ "\\")
|
|
532 (?\" "\"")
|
|
533 (?. ".")
|
|
534 (?\[ ".")
|
|
535 (?\] ".")
|
|
536 ;; % and ! aren't RFC822 characters, but it is convenient to pretend
|
|
537 (?% ".")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
538 (?! ".") ;; this needs to be word-constituent when not in .UUCP mode
|
809
|
539 )
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
540 (mail-extr-address-comment-syntax-table
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
541 (?\000 ?\377 "w")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
542 (?\040 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
543 (?\240 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
544 (?\t " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
545 (?\r " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
546 (?\n " ")
|
809
|
547 (?\( "\(\)")
|
|
548 (?\) "\)\(")
|
|
549 (?\\ "\\"))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
550 (mail-extr-address-domain-literal-syntax-table
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
551 (?\000 ?\377 "w")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
552 (?\040 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
553 (?\240 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
554 (?\t " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
555 (?\r " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
556 (?\n " ")
|
809
|
557 (?\[ "\(\]") ;??????
|
|
558 (?\] "\)\[") ;??????
|
|
559 (?\\ "\\"))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
560 (mail-extr-address-text-comment-syntax-table
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
561 (?\000 ?\377 "w")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
562 (?\040 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
563 (?\240 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
564 (?\t " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
565 (?\r " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
566 (?\n " ")
|
809
|
567 (?\( "\(\)")
|
|
568 (?\) "\)\(")
|
|
569 (?\[ "\(\]")
|
|
570 (?\] "\)\[")
|
|
571 (?\{ "\(\}")
|
|
572 (?\} "\)\{")
|
|
573 (?\\ "\\")
|
|
574 (?\" "\"")
|
|
575 ;; (?\' "\)\`")
|
|
576 ;; (?\` "\(\'")
|
|
577 )
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
578 (mail-extr-address-text-syntax-table
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
579 (?\000 ?\177 ".")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
580 (?\200 ?\377 "w")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
581 (?\040 " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
582 (?\t " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
583 (?\r " ")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
584 (?\n " ")
|
809
|
585 (?A ?Z "w")
|
|
586 (?a ?z "w")
|
|
587 (?- "w")
|
|
588 (?\} "w")
|
|
589 (?\{ "w")
|
|
590 (?| "w")
|
|
591 (?\' "w")
|
|
592 (?~ "w")
|
|
593 (?0 ?9 "w"))
|
|
594 ))
|
|
595
|
|
596
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
597 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
598 ;;
|
809
|
599 ;; Utility functions and macros.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
600 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
601
|
52916
|
602 ;; Fixme: There are Latin-1 nbsp below. If such characters should be
|
|
603 ;; included, this is the wrong thing to do -- it should use syntax (or
|
|
604 ;; regexp char classes).
|
|
605
|
37148
|
606 (defsubst mail-extr-skip-whitespace-forward ()
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
607 ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
|
51081
|
608 (skip-chars-forward " \t\n\r�"))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
609
|
37148
|
610 (defsubst mail-extr-skip-whitespace-backward ()
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
611 ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
|
51081
|
612 (skip-chars-backward " \t\n\r�"))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
613
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
614
|
37148
|
615 (defsubst mail-extr-undo-backslash-quoting (beg end)
|
|
616 (save-excursion
|
|
617 (save-restriction
|
|
618 (narrow-to-region beg end)
|
|
619 (goto-char (point-min))
|
|
620 ;; undo \ quoting
|
|
621 (while (search-forward "\\" nil t)
|
41300
|
622 (delete-char -1)
|
37148
|
623 (or (eobp)
|
|
624 (forward-char 1))))))
|
809
|
625
|
37148
|
626 (defsubst mail-extr-nuke-char-at (pos)
|
|
627 (save-excursion
|
|
628 (goto-char pos)
|
41300
|
629 (delete-char 1)
|
37148
|
630 (insert ?\ )))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
631
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
632 (put 'mail-extr-nuke-outside-range
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
633 'edebug-form-spec '(symbolp &optional form form atom))
|
809
|
634
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
635 (defmacro mail-extr-nuke-outside-range (list-symbol
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
636 beg-symbol end-symbol
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
637 &optional no-replace)
|
41300
|
638 "Delete all elements outside BEG..END in LIST.
|
|
639 LIST-SYMBOL names a variable holding a list of buffer positions
|
|
640 BEG-SYMBOL and END-SYMBOL name variables delimiting a range
|
|
641 Each element of LIST-SYMBOL which lies outside of the range is
|
|
642 deleted from the list.
|
|
643 Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
|
|
644 which lie outside of the range, one character at that position is
|
|
645 replaced with a SPC."
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
646 (or (memq no-replace '(t nil))
|
14029
|
647 (error "no-replace must be t or nil, evaluable at macroexpand-time"))
|
41300
|
648 `(let ((temp ,list-symbol)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
649 ch)
|
809
|
650 (while temp
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
651 (setq ch (car temp))
|
41300
|
652 (when (or (> ch ,end-symbol)
|
|
653 (< ch ,beg-symbol))
|
|
654 ,@(if no-replace
|
|
655 nil
|
|
656 `((mail-extr-nuke-char-at ch)))
|
|
657 (setcar temp nil))
|
809
|
658 (setq temp (cdr temp)))
|
41300
|
659 (setq ,list-symbol (delq nil ,list-symbol))))
|
809
|
660
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
661 (defun mail-extr-demarkerize (marker)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
662 ;; if arg is a marker, destroys the marker, then returns the old value.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
663 ;; otherwise returns the arg.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
664 (if (markerp marker)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
665 (let ((temp (marker-position marker)))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
666 (set-marker marker nil)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
667 temp)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
668 marker))
|
809
|
669
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
670 (defun mail-extr-markerize (pos)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
671 ;; coerces pos to a marker if non-nil.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
672 (if (or (markerp pos) (null pos))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
673 pos
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
674 (copy-marker pos)))
|
809
|
675
|
37148
|
676 (defsubst mail-extr-safe-move-sexp (arg)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
677 ;; Safely skip over one balanced sexp, if there is one. Return t if success.
|
37148
|
678 (condition-case error
|
|
679 (progn
|
|
680 (goto-char (or (scan-sexps (point) arg) (point)))
|
|
681 t)
|
|
682 (error
|
|
683 ;; #### kludge kludge kludge kludge kludge kludge kludge !!!
|
|
684 (if (string-equal (nth 1 error) "Unbalanced parentheses")
|
|
685 nil
|
|
686 (while t
|
|
687 (signal (car error) (cdr error)))))))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
688
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
689 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
690 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
691 ;; The main function to grind addresses
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
692 ;;
|
809
|
693
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
694 (defvar disable-initial-guessing-flag) ; dynamic assignment
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
695 (defvar cbeg) ; dynamic assignment
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
696 (defvar cend) ; dynamic assignment
|
56764
|
697 (defvar mail-extr-all-top-level-domains) ; Defined below.
|
809
|
698
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
699 ;;;###autoload
|
20285
|
700 (defun mail-extract-address-components (address &optional all)
|
|
701 "Given an RFC-822 address ADDRESS, extract full name and canonical address.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
702 Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
|
47615
|
703 If no name can be extracted, FULL-NAME will be nil. Also see
|
57391
|
704 `mail-extr-ignore-single-names' and `mail-extr-ignore-realname-equals-mailbox-name'.
|
20285
|
705
|
|
706 If the optional argument ALL is non-nil, then ADDRESS can contain zero
|
|
707 or more recipients, separated by commas, and we return a list of
|
|
708 the form ((FULL-NAME CANONICAL-ADDRESS) ...) with one element for
|
|
709 each recipient. If ALL is nil, then if ADDRESS contains more than
|
|
710 one recipients, all but the first is ignored.
|
|
711
|
37148
|
712 ADDRESS may be a string or a buffer. If it is a buffer, the visible
|
47615
|
713 \(narrowed) portion of the buffer will be interpreted as the address.
|
|
714 \(This feature exists so that the clever caller might be able to avoid
|
|
715 consing a string.)"
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
716 (let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
717 (extraction-buffer (get-buffer-create " *extract address components*"))
|
20285
|
718 value-list)
|
|
719
|
37148
|
720 (with-current-buffer (get-buffer-create extraction-buffer)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
721 (fundamental-mode)
|
923
|
722 (buffer-disable-undo extraction-buffer)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
723 (set-syntax-table mail-extr-address-syntax-table)
|
809
|
724 (widen)
|
|
725 (erase-buffer)
|
|
726 (setq case-fold-search nil)
|
47939
|
727
|
809
|
728 ;; Insert extra space at beginning to allow later replacement with <
|
|
729 ;; without having to move markers.
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
730 (insert ?\ )
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
731
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
732 ;; Insert the address itself.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
733 (cond ((stringp address)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
734 (insert address))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
735 ((bufferp address)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
736 (insert-buffer-substring address))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
737 (t
|
14029
|
738 (error "Invalid address: %s" address)))
|
16727
|
739
|
|
740 (set-text-properties (point-min) (point-max) nil)
|
20285
|
741
|
37148
|
742 (with-current-buffer (get-buffer-create canonicalization-buffer)
|
20285
|
743 (fundamental-mode)
|
|
744 (buffer-disable-undo canonicalization-buffer)
|
|
745 (setq case-fold-search nil))
|
|
746
|
47939
|
747
|
809
|
748 ;; Unfold multiple lines.
|
|
749 (goto-char (point-min))
|
|
750 (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
|
|
751 (replace-match "\\1 " t))
|
47939
|
752
|
20285
|
753 ;; Loop over addresses until we have as many as we want.
|
|
754 (while (and (or all (null value-list))
|
|
755 (progn (goto-char (point-min))
|
|
756 (skip-chars-forward " \t")
|
|
757 (not (eobp))))
|
|
758 (let (char
|
|
759 end-of-address
|
21477
|
760 <-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
|
20285
|
761 group-:-pos group-\;-pos route-addr-:-pos
|
|
762 record-pos-symbol
|
|
763 first-real-pos last-real-pos
|
|
764 phrase-beg phrase-end
|
|
765 cbeg cend ; dynamically set from -voodoo
|
|
766 quote-beg quote-end
|
|
767 atom-beg atom-end
|
|
768 mbox-beg mbox-end
|
|
769 \.-ends-name
|
|
770 temp
|
|
771 ;; name-suffix
|
|
772 fi mi li ; first, middle, last initial
|
|
773 saved-%-pos saved-!-pos saved-@-pos
|
|
774 domain-pos \.-pos insert-point
|
|
775 ;; mailbox-name-processed-flag
|
|
776 disable-initial-guessing-flag) ; dynamically set from -voodoo
|
|
777
|
37148
|
778 (set-syntax-table mail-extr-address-syntax-table)
|
20285
|
779 (goto-char (point-min))
|
|
780
|
|
781 ;; Insert extra space at beginning to allow later replacement with <
|
|
782 ;; without having to move markers.
|
|
783 (or (eq (following-char) ?\ )
|
|
784 (insert ?\ ))
|
|
785
|
|
786 ;; First pass grabs useful information about address.
|
|
787 (while (progn
|
|
788 (mail-extr-skip-whitespace-forward)
|
|
789 (not (eobp)))
|
|
790 (setq char (char-after (point)))
|
|
791 (or first-real-pos
|
|
792 (if (not (eq char ?\())
|
|
793 (setq first-real-pos (point))))
|
|
794 (cond
|
|
795 ;; comment
|
|
796 ((eq char ?\()
|
|
797 (set-syntax-table mail-extr-address-comment-syntax-table)
|
|
798 ;; only record the first non-empty comment's position
|
|
799 (if (and (not cbeg)
|
|
800 (save-excursion
|
|
801 (forward-char 1)
|
|
802 (mail-extr-skip-whitespace-forward)
|
|
803 (not (eq ?\) (char-after (point))))))
|
|
804 (setq cbeg (point)))
|
|
805 ;; TODO: don't record if unbalanced
|
|
806 (or (mail-extr-safe-move-sexp 1)
|
|
807 (forward-char 1))
|
|
808 (set-syntax-table mail-extr-address-syntax-table)
|
|
809 (if (and cbeg
|
|
810 (not cend))
|
|
811 (setq cend (point))))
|
|
812 ;; quoted text
|
|
813 ((eq char ?\")
|
|
814 ;; only record the first non-empty quote's position
|
|
815 (if (and (not quote-beg)
|
|
816 (save-excursion
|
|
817 (forward-char 1)
|
|
818 (mail-extr-skip-whitespace-forward)
|
|
819 (not (eq ?\" (char-after (point))))))
|
|
820 (setq quote-beg (point)))
|
|
821 ;; TODO: don't record if unbalanced
|
|
822 (or (mail-extr-safe-move-sexp 1)
|
|
823 (forward-char 1))
|
|
824 (if (and quote-beg
|
|
825 (not quote-end))
|
|
826 (setq quote-end (point))))
|
|
827 ;; domain literals
|
|
828 ((eq char ?\[)
|
|
829 (set-syntax-table mail-extr-address-domain-literal-syntax-table)
|
|
830 (or (mail-extr-safe-move-sexp 1)
|
|
831 (forward-char 1))
|
|
832 (set-syntax-table mail-extr-address-syntax-table))
|
|
833 ;; commas delimit addresses when outside < > pairs.
|
|
834 ((and (eq char ?,)
|
|
835 (or (and (null <-pos)
|
|
836 ;; Handle ROUTE-ADDR address that is missing its <.
|
|
837 (not (eq ?@ (char-after (1+ (point))))))
|
|
838 (and >-pos
|
|
839 ;; handle weird munged addresses
|
|
840 ;; BUG FIX: This test was reversed. Thanks to the
|
|
841 ;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
|
|
842 ;; for discovering this!
|
37148
|
843 (< (car (last <-pos)) (car >-pos)))))
|
20285
|
844 ;; The argument contains more than one address.
|
|
845 ;; Temporarily hide everything after this one.
|
37148
|
846 (setq end-of-address (copy-marker (1+ (point)) t))
|
20285
|
847 (narrow-to-region (point-min) (1+ (point)))
|
37148
|
848 (delete-char 1)
|
20285
|
849 (setq char ?\() ; HAVE I NO SHAME??
|
|
850 )
|
|
851 ;; record the position of various interesting chars, determine
|
|
852 ;; legality later.
|
|
853 ((setq record-pos-symbol
|
|
854 (cdr (assq char
|
|
855 '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
|
21477
|
856 (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
|
20285
|
857 (?% . %-pos) (?\; . \;-pos)))))
|
|
858 (set record-pos-symbol
|
|
859 (cons (point) (symbol-value record-pos-symbol)))
|
809
|
860 (forward-char 1))
|
20285
|
861 ((eq char ?.)
|
|
862 (forward-char 1))
|
|
863 ((memq char '(
|
|
864 ;; comment terminator illegal
|
|
865 ?\)
|
|
866 ;; domain literal terminator illegal
|
|
867 ?\]
|
|
868 ;; \ allowed only within quoted strings,
|
|
869 ;; domain literals, and comments
|
|
870 ?\\
|
|
871 ))
|
|
872 (mail-extr-nuke-char-at (point))
|
|
873 (forward-char 1))
|
|
874 (t
|
|
875 (forward-word 1)))
|
|
876 (or (eq char ?\()
|
|
877 ;; At the end of first address of a multiple address header.
|
|
878 (and (eq char ?,)
|
|
879 (eobp))
|
|
880 (setq last-real-pos (point))))
|
|
881
|
|
882 ;; Use only the leftmost <, if any. Replace all others with spaces.
|
|
883 (while (cdr <-pos)
|
|
884 (mail-extr-nuke-char-at (car <-pos))
|
|
885 (setq <-pos (cdr <-pos)))
|
|
886
|
|
887 ;; Use only the rightmost >, if any. Replace all others with spaces.
|
|
888 (while (cdr >-pos)
|
|
889 (mail-extr-nuke-char-at (nth 1 >-pos))
|
|
890 (setcdr >-pos (nthcdr 2 >-pos)))
|
|
891
|
|
892 ;; If multiple @s and a :, but no < and >, insert around buffer.
|
|
893 ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc
|
|
894 ;; This commonly happens on the UUCP "From " line. Ugh.
|
41300
|
895 (when (and (> (length @-pos) 1)
|
21477
|
896 (eq 1 (length colon-pos)) ;TODO: check if between last two @s
|
20285
|
897 (not \;-pos)
|
|
898 (not <-pos))
|
41300
|
899 (goto-char (point-min))
|
|
900 (delete-char 1)
|
|
901 (setq <-pos (list (point)))
|
|
902 (insert ?<))
|
20285
|
903
|
|
904 ;; If < but no >, insert > in rightmost possible position
|
41300
|
905 (when (and <-pos (null >-pos))
|
|
906 (goto-char (point-max))
|
|
907 (setq >-pos (list (point)))
|
|
908 (insert ?>))
|
20285
|
909
|
|
910 ;; If > but no <, replace > with space.
|
41300
|
911 (when (and >-pos (null <-pos))
|
|
912 (mail-extr-nuke-char-at (car >-pos))
|
|
913 (setq >-pos nil))
|
20285
|
914
|
|
915 ;; Turn >-pos and <-pos into non-lists
|
|
916 (setq >-pos (car >-pos)
|
|
917 <-pos (car <-pos))
|
809
|
918
|
20285
|
919 ;; Trim other punctuation lists of items outside < > pair to handle
|
|
920 ;; stupid MTAs.
|
41300
|
921 (when <-pos ; don't need to check >-pos also
|
|
922 ;; handle bozo software that violates RFC 822 by sticking
|
|
923 ;; punctuation marks outside of a < > pair
|
|
924 (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
|
|
925 ;; RFC 822 says nothing about these two outside < >, but
|
|
926 ;; remove those positions from the lists to make things
|
|
927 ;; easier.
|
|
928 (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
|
|
929 (mail-extr-nuke-outside-range %-pos <-pos >-pos t))
|
20285
|
930
|
|
931 ;; Check for : that indicates GROUP list and for : part of
|
|
932 ;; ROUTE-ADDR spec.
|
|
933 ;; Can't possibly be more than two :. Nuke any extra.
|
21477
|
934 (while colon-pos
|
|
935 (setq temp (car colon-pos)
|
|
936 colon-pos (cdr colon-pos))
|
20285
|
937 (cond ((and <-pos >-pos
|
|
938 (> temp <-pos)
|
|
939 (< temp >-pos))
|
|
940 (if (or route-addr-:-pos
|
|
941 (< (length @-pos) 2)
|
|
942 (> temp (car @-pos))
|
|
943 (< temp (nth 1 @-pos)))
|
|
944 (mail-extr-nuke-char-at temp)
|
|
945 (setq route-addr-:-pos temp)))
|
|
946 ((or (not <-pos)
|
|
947 (and <-pos
|
|
948 (< temp <-pos)))
|
|
949 (setq group-:-pos temp))))
|
|
950
|
|
951 ;; Nuke any ; that is in or to the left of a < > pair or to the left
|
|
952 ;; of a GROUP starting :. Also, there may only be one ;.
|
|
953 (while \;-pos
|
|
954 (setq temp (car \;-pos)
|
|
955 \;-pos (cdr \;-pos))
|
|
956 (cond ((and <-pos >-pos
|
|
957 (> temp <-pos)
|
|
958 (< temp >-pos))
|
|
959 (mail-extr-nuke-char-at temp))
|
|
960 ((and (or (not group-:-pos)
|
|
961 (> temp group-:-pos))
|
|
962 (not group-\;-pos))
|
|
963 (setq group-\;-pos temp))))
|
|
964
|
|
965 ;; Nuke unmatched GROUP syntax characters.
|
41300
|
966 (when (and group-:-pos (not group-\;-pos))
|
|
967 ;; *** Do I really need to erase it?
|
|
968 (mail-extr-nuke-char-at group-:-pos)
|
|
969 (setq group-:-pos nil))
|
|
970 (when (and group-\;-pos (not group-:-pos))
|
|
971 ;; *** Do I really need to erase it?
|
|
972 (mail-extr-nuke-char-at group-\;-pos)
|
|
973 (setq group-\;-pos nil))
|
20285
|
974
|
|
975 ;; Handle junk like ";@host.company.dom" that sendmail adds.
|
|
976 ;; **** should I remember comment positions?
|
41300
|
977 (when group-\;-pos
|
20285
|
978 ;; this is fine for now
|
|
979 (mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t)
|
|
980 (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t)
|
|
981 (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t)
|
|
982 (mail-extr-nuke-outside-range comma-pos group-:-pos group-\;-pos t)
|
|
983 (and last-real-pos
|
|
984 (> last-real-pos (1+ group-\;-pos))
|
|
985 (setq last-real-pos (1+ group-\;-pos)))
|
|
986 ;; *** This may be wrong:
|
|
987 (and cend
|
|
988 (> cend group-\;-pos)
|
|
989 (setq cend nil
|
|
990 cbeg nil))
|
|
991 (and quote-end
|
|
992 (> quote-end group-\;-pos)
|
|
993 (setq quote-end nil
|
|
994 quote-beg nil))
|
|
995 ;; This was both wrong and unnecessary:
|
|
996 ;;(narrow-to-region (point-min) group-\;-pos)
|
|
997
|
|
998 ;; *** The entire handling of GROUP addresses seems rather lame.
|
|
999 ;; *** It deserves a complete rethink, except that these addresses
|
|
1000 ;; *** are hardly ever seen.
|
41300
|
1001 )
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1002
|
20285
|
1003 ;; Any commas must be between < and : of ROUTE-ADDR. Nuke any
|
|
1004 ;; others.
|
47939
|
1005 ;; Hell, go ahead and nuke all of the commas.
|
20285
|
1006 ;; **** This will cause problems when we start handling commas in
|
|
1007 ;; the PHRASE part .... no it won't ... yes it will ... ?????
|
|
1008 (mail-extr-nuke-outside-range comma-pos 1 1)
|
|
1009
|
|
1010 ;; can only have multiple @s inside < >. The fact that some MTAs
|
|
1011 ;; put de-bracketed ROUTE-ADDRs in the UUCP-style "From " line is
|
|
1012 ;; handled above.
|
|
1013
|
|
1014 ;; Locate PHRASE part of ROUTE-ADDR.
|
41300
|
1015 (when <-pos
|
|
1016 (goto-char <-pos)
|
|
1017 (mail-extr-skip-whitespace-backward)
|
|
1018 (setq phrase-end (point))
|
|
1019 (goto-char (or ;;group-:-pos
|
|
1020 (point-min)))
|
|
1021 (mail-extr-skip-whitespace-forward)
|
|
1022 (if (< (point) phrase-end)
|
|
1023 (setq phrase-beg (point))
|
|
1024 (setq phrase-end nil)))
|
20285
|
1025
|
|
1026 ;; handle ROUTE-ADDRS with real ROUTEs.
|
|
1027 ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and
|
|
1028 ;; any % or ! must be semantically meaningless.
|
|
1029 ;; TODO: do this processing into canonicalization buffer
|
41300
|
1030 (when route-addr-:-pos
|
|
1031 (setq !-pos nil
|
|
1032 %-pos nil
|
|
1033 >-pos (copy-marker >-pos)
|
|
1034 route-addr-:-pos (copy-marker route-addr-:-pos))
|
|
1035 (goto-char >-pos)
|
|
1036 (insert-before-markers ?X)
|
|
1037 (goto-char (car @-pos))
|
|
1038 (while (setq @-pos (cdr @-pos))
|
|
1039 (delete-char 1)
|
|
1040 (setq %-pos (cons (point-marker) %-pos))
|
|
1041 (insert "%")
|
|
1042 (goto-char (1- >-pos))
|
|
1043 (save-excursion
|
|
1044 (insert-buffer-substring extraction-buffer
|
|
1045 (car @-pos) route-addr-:-pos)
|
|
1046 (delete-region (car @-pos) route-addr-:-pos))
|
|
1047 (or (cdr @-pos)
|
|
1048 (setq saved-@-pos (list (point)))))
|
|
1049 (setq @-pos saved-@-pos)
|
|
1050 (goto-char >-pos)
|
|
1051 (delete-char -1)
|
|
1052 (mail-extr-nuke-char-at route-addr-:-pos)
|
|
1053 (mail-extr-demarkerize route-addr-:-pos)
|
|
1054 (setq route-addr-:-pos nil
|
|
1055 >-pos (mail-extr-demarkerize >-pos)
|
|
1056 %-pos (mapcar 'mail-extr-demarkerize %-pos)))
|
20285
|
1057
|
|
1058 ;; de-listify @-pos
|
|
1059 (setq @-pos (car @-pos))
|
|
1060
|
|
1061 ;; TODO: remove comments in the middle of an address
|
|
1062
|
41300
|
1063 (with-current-buffer canonicalization-buffer
|
20285
|
1064 (widen)
|
|
1065 (erase-buffer)
|
|
1066 (insert-buffer-substring extraction-buffer)
|
|
1067
|
|
1068 (if <-pos
|
|
1069 (narrow-to-region (progn
|
|
1070 (goto-char (1+ <-pos))
|
|
1071 (mail-extr-skip-whitespace-forward)
|
|
1072 (point))
|
|
1073 >-pos)
|
|
1074 (if (and first-real-pos last-real-pos)
|
|
1075 (narrow-to-region first-real-pos last-real-pos)
|
|
1076 ;; ****** Oh no! What if the address is completely empty!
|
|
1077 ;; *** Is this correct?
|
41300
|
1078 (narrow-to-region (point-max) (point-max))))
|
20285
|
1079
|
|
1080 (and @-pos %-pos
|
|
1081 (mail-extr-nuke-outside-range %-pos (point-min) @-pos))
|
|
1082 (and %-pos !-pos
|
|
1083 (mail-extr-nuke-outside-range !-pos (point-min) (car %-pos)))
|
|
1084 (and @-pos !-pos (not %-pos)
|
|
1085 (mail-extr-nuke-outside-range !-pos (point-min) @-pos))
|
|
1086
|
|
1087 ;; Error condition:?? (and %-pos (not @-pos))
|
809
|
1088
|
20285
|
1089 ;; WARNING: THIS CODE IS DUPLICATED BELOW.
|
41300
|
1090 (when (and %-pos (not @-pos))
|
|
1091 (goto-char (car %-pos))
|
|
1092 (delete-char 1)
|
|
1093 (setq @-pos (point))
|
|
1094 (insert "@")
|
|
1095 (setq %-pos (cdr %-pos)))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1096
|
41300
|
1097 (when (and mail-extr-mangle-uucp !-pos)
|
|
1098 ;; **** I don't understand this save-restriction and the
|
|
1099 ;; narrow-to-region inside it. Why did I do that?
|
|
1100 (save-restriction
|
|
1101 (cond ((and @-pos
|
|
1102 mail-extr-@-binds-tighter-than-!)
|
|
1103 (goto-char @-pos)
|
|
1104 (setq %-pos (cons (point) %-pos)
|
|
1105 @-pos nil)
|
|
1106 (delete-char 1)
|
|
1107 (insert "%")
|
|
1108 (setq insert-point (point-max)))
|
|
1109 (mail-extr-@-binds-tighter-than-!
|
|
1110 (setq insert-point (point-max)))
|
|
1111 (%-pos
|
|
1112 (setq insert-point (car (last %-pos))
|
|
1113 saved-%-pos (mapcar 'mail-extr-markerize %-pos)
|
|
1114 %-pos nil
|
|
1115 @-pos (mail-extr-markerize @-pos)))
|
|
1116 (@-pos
|
|
1117 (setq insert-point @-pos)
|
|
1118 (setq @-pos (mail-extr-markerize @-pos)))
|
|
1119 (t
|
|
1120 (setq insert-point (point-max))))
|
|
1121 (narrow-to-region (point-min) insert-point)
|
|
1122 (setq saved-!-pos (car !-pos))
|
|
1123 (while !-pos
|
|
1124 (goto-char (point-max))
|
|
1125 (cond ((and (not @-pos)
|
|
1126 (not (cdr !-pos)))
|
|
1127 (setq @-pos (point))
|
|
1128 (insert-before-markers "@ "))
|
|
1129 (t
|
|
1130 (setq %-pos (cons (point) %-pos))
|
|
1131 (insert-before-markers "% ")))
|
|
1132 (backward-char 1)
|
|
1133 (insert-buffer-substring
|
|
1134 (current-buffer)
|
|
1135 (if (nth 1 !-pos)
|
|
1136 (1+ (nth 1 !-pos))
|
|
1137 (point-min))
|
|
1138 (car !-pos))
|
|
1139 (delete-char 1)
|
|
1140 (or (save-excursion
|
|
1141 (mail-extr-safe-move-sexp -1)
|
|
1142 (mail-extr-skip-whitespace-backward)
|
|
1143 (eq ?. (preceding-char)))
|
|
1144 (insert-before-markers
|
|
1145 (if (save-excursion
|
|
1146 (mail-extr-skip-whitespace-backward)
|
|
1147 (eq ?. (preceding-char)))
|
|
1148 ""
|
|
1149 ".")
|
|
1150 "uucp"))
|
|
1151 (setq !-pos (cdr !-pos))))
|
|
1152 (and saved-%-pos
|
|
1153 (setq %-pos (append (mapcar 'mail-extr-demarkerize
|
|
1154 saved-%-pos)
|
|
1155 %-pos)))
|
|
1156 (setq @-pos (mail-extr-demarkerize @-pos))
|
|
1157 (narrow-to-region (1+ saved-!-pos) (point-max)))
|
20285
|
1158
|
|
1159 ;; WARNING: THIS CODE IS DUPLICATED ABOVE.
|
41300
|
1160 (when (and %-pos (not @-pos))
|
|
1161 (goto-char (car %-pos))
|
|
1162 (delete-char 1)
|
|
1163 (setq @-pos (point))
|
|
1164 (insert "@")
|
|
1165 (setq %-pos (cdr %-pos)))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1166
|
41300
|
1167 (when (setq %-pos (nreverse %-pos)) ; implies @-pos valid
|
|
1168 (setq temp %-pos)
|
|
1169 (catch 'truncated
|
|
1170 (while temp
|
|
1171 (goto-char (or (nth 1 temp)
|
|
1172 @-pos))
|
|
1173 (mail-extr-skip-whitespace-backward)
|
|
1174 (save-excursion
|
|
1175 (mail-extr-safe-move-sexp -1)
|
|
1176 (setq domain-pos (point))
|
|
1177 (mail-extr-skip-whitespace-backward)
|
|
1178 (setq \.-pos (eq ?. (preceding-char))))
|
|
1179 (when (and \.-pos
|
|
1180 ;; #### string consing
|
|
1181 (let ((s (intern-soft
|
|
1182 (buffer-substring domain-pos (point))
|
|
1183 mail-extr-all-top-level-domains)))
|
|
1184 (and s (get s 'domain-name))))
|
|
1185 (narrow-to-region (point-min) (point))
|
|
1186 (goto-char (car temp))
|
|
1187 (delete-char 1)
|
|
1188 (setq @-pos (point))
|
|
1189 (setcdr temp nil)
|
|
1190 (setq %-pos (delq @-pos %-pos))
|
|
1191 (insert "@")
|
|
1192 (throw 'truncated t))
|
|
1193 (setq temp (cdr temp)))))
|
20285
|
1194 (setq mbox-beg (point-min)
|
|
1195 mbox-end (if %-pos (car %-pos)
|
|
1196 (or @-pos
|
41300
|
1197 (point-max))))
|
|
1198
|
|
1199 (when @-pos
|
|
1200 ;; Make the domain-name part lowercase since it's case
|
|
1201 ;; insensitive anyway.
|
|
1202 (downcase-region (1+ @-pos) (point-max))))
|
20285
|
1203
|
|
1204 ;; Done canonicalizing address.
|
|
1205 ;; We are now back in extraction-buffer.
|
|
1206
|
|
1207 ;; Decide what part of the address to search to find the full name.
|
|
1208 (cond (
|
|
1209 ;; Example: "First M. Last" <fml@foo.bar.dom>
|
|
1210 (and phrase-beg
|
|
1211 (eq quote-beg phrase-beg)
|
|
1212 (<= quote-end phrase-end))
|
|
1213 (narrow-to-region (1+ quote-beg) (1- quote-end))
|
|
1214 (mail-extr-undo-backslash-quoting (point-min) (point-max)))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1215
|
20285
|
1216 ;; Example: First Last <fml@foo.bar.dom>
|
|
1217 (phrase-beg
|
|
1218 (narrow-to-region phrase-beg phrase-end))
|
|
1219
|
|
1220 ;; Example: fml@foo.bar.dom (First M. Last)
|
|
1221 (cbeg
|
|
1222 (narrow-to-region (1+ cbeg) (1- cend))
|
|
1223 (mail-extr-undo-backslash-quoting (point-min) (point-max))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1224
|
20285
|
1225 ;; Deal with spacing problems
|
|
1226 (goto-char (point-min))
|
|
1227 ;;; (cond ((not (search-forward " " nil t))
|
|
1228 ;;; (goto-char (point-min))
|
|
1229 ;;; (cond ((search-forward "_" nil t)
|
|
1230 ;;; ;; Handle the *idiotic* use of underlines as spaces.
|
|
1231 ;;; ;; Example: fml@foo.bar.dom (First_M._Last)
|
|
1232 ;;; (goto-char (point-min))
|
|
1233 ;;; (while (search-forward "_" nil t)
|
|
1234 ;;; (replace-match " " t)))
|
|
1235 ;;; ((search-forward "." nil t)
|
|
1236 ;;; ;; Fix . used as space
|
|
1237 ;;; ;; Example: danj1@cb.att.com (daniel.jacobson)
|
|
1238 ;;; (goto-char (point-min))
|
|
1239 ;;; (while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
|
1240 ;;; (replace-match "\\1 \\2" t))))))
|
|
1241 )
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1242
|
20285
|
1243 ;; Otherwise we try to get the name from the mailbox portion
|
|
1244 ;; of the address.
|
|
1245 ;; Example: First_M_Last@foo.bar.dom
|
|
1246 (t
|
|
1247 ;; *** Work in canon buffer instead? No, can't. Hmm.
|
|
1248 (goto-char (point-max))
|
|
1249 (narrow-to-region (point) (point))
|
|
1250 (insert-buffer-substring canonicalization-buffer
|
|
1251 mbox-beg mbox-end)
|
|
1252 (goto-char (point-min))
|
|
1253
|
|
1254 ;; Example: First_Last.XXX@foo.bar.dom
|
|
1255 (setq \.-ends-name (re-search-forward "[_0-9]" nil t))
|
|
1256
|
|
1257 (goto-char (point-min))
|
|
1258
|
|
1259 (if (not mail-extr-mangle-uucp)
|
|
1260 (modify-syntax-entry ?! "w" (syntax-table)))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1261
|
20285
|
1262 (while (progn
|
|
1263 (mail-extr-skip-whitespace-forward)
|
|
1264 (not (eobp)))
|
|
1265 (setq char (char-after (point)))
|
|
1266 (cond
|
|
1267 ((eq char ?\")
|
|
1268 (setq quote-beg (point))
|
|
1269 (or (mail-extr-safe-move-sexp 1)
|
|
1270 ;; TODO: handle this error condition!!!!!
|
|
1271 (forward-char 1))
|
|
1272 ;; take into account deletions
|
|
1273 (setq quote-end (- (point) 2))
|
|
1274 (save-excursion
|
|
1275 (backward-char 1)
|
41300
|
1276 (delete-char 1)
|
20285
|
1277 (goto-char quote-beg)
|
|
1278 (or (eobp)
|
41300
|
1279 (delete-char 1)))
|
20285
|
1280 (mail-extr-undo-backslash-quoting quote-beg quote-end)
|
|
1281 (or (eq ?\ (char-after (point)))
|
|
1282 (insert " "))
|
|
1283 ;; (setq mailbox-name-processed-flag t)
|
|
1284 (setq \.-ends-name t))
|
|
1285 ((eq char ?.)
|
|
1286 (if (memq (char-after (1+ (point))) '(?_ ?=))
|
|
1287 (progn
|
|
1288 (forward-char 1)
|
41300
|
1289 (delete-char 1)
|
20285
|
1290 (insert ?\ ))
|
|
1291 (if \.-ends-name
|
|
1292 (narrow-to-region (point-min) (point))
|
41300
|
1293 (delete-char 1)
|
20285
|
1294 (insert " ")))
|
|
1295 ;; (setq mailbox-name-processed-flag t)
|
|
1296 )
|
|
1297 ((memq (char-syntax char) '(?. ?\\))
|
41300
|
1298 (delete-char 1)
|
20285
|
1299 (insert " ")
|
|
1300 ;; (setq mailbox-name-processed-flag t)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1301 )
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1302 (t
|
20285
|
1303 (setq atom-beg (point))
|
|
1304 (forward-word 1)
|
|
1305 (setq atom-end (point))
|
|
1306 (goto-char atom-beg)
|
|
1307 (save-restriction
|
|
1308 (narrow-to-region atom-beg atom-end)
|
|
1309 (cond
|
|
1310
|
|
1311 ;; Handle X.400 addresses encoded in RFC-822.
|
|
1312 ;; *** Shit! This has to handle the case where it is
|
|
1313 ;; *** embedded in a quote too!
|
|
1314 ;; *** Shit! The input is being broken up into atoms
|
|
1315 ;; *** by periods!
|
|
1316 ((looking-at mail-extr-x400-encoded-address-pattern)
|
|
1317
|
|
1318 ;; Copy the contents of the individual fields that
|
|
1319 ;; might hold name data to the beginning.
|
41300
|
1320 (mapc
|
|
1321 (lambda (field-pattern)
|
|
1322 (when
|
|
1323 (save-excursion
|
|
1324 (re-search-forward field-pattern nil t))
|
|
1325 (insert-buffer-substring (current-buffer)
|
|
1326 (match-beginning 1)
|
|
1327 (match-end 1))
|
|
1328 (insert " ")))
|
20285
|
1329 (list mail-extr-x400-encoded-address-given-name-pattern
|
|
1330 mail-extr-x400-encoded-address-surname-pattern
|
|
1331 mail-extr-x400-encoded-address-full-name-pattern))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1332
|
20285
|
1333 ;; Discard the rest, since it contains stuff like
|
|
1334 ;; routing information, not part of a name.
|
|
1335 (mail-extr-skip-whitespace-backward)
|
|
1336 (delete-region (point) (point-max))
|
|
1337
|
|
1338 ;; Handle periods used for spacing.
|
|
1339 (while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
|
1340 (replace-match "\\1 \\2" t))
|
|
1341
|
|
1342 ;; (setq mailbox-name-processed-flag t)
|
|
1343 )
|
|
1344
|
|
1345 ;; Handle normal addresses.
|
|
1346 (t
|
|
1347 (goto-char (point-min))
|
|
1348 ;; Handle _ and = used for spacing.
|
|
1349 (while (re-search-forward "\\([^_=]+\\)[_=]" nil t)
|
|
1350 (replace-match "\\1 " t)
|
|
1351 ;; (setq mailbox-name-processed-flag t)
|
|
1352 )
|
|
1353 (goto-char (point-max))))))))
|
|
1354
|
|
1355 ;; undo the dirty deed
|
|
1356 (if (not mail-extr-mangle-uucp)
|
|
1357 (modify-syntax-entry ?! "." (syntax-table)))
|
|
1358 ;;
|
|
1359 ;; If we derived the name from the mailbox part of the address,
|
|
1360 ;; and we only got one word out of it, don't treat that as a
|
|
1361 ;; name. "foo@bar" --> (nil "foo@bar"), not ("foo" "foo@bar")
|
|
1362 ;; (if (not mailbox-name-processed-flag)
|
|
1363 ;; (delete-region (point-min) (point-max)))
|
|
1364 ))
|
|
1365
|
|
1366 (set-syntax-table mail-extr-address-text-syntax-table)
|
|
1367
|
|
1368 (mail-extr-voodoo mbox-beg mbox-end canonicalization-buffer)
|
|
1369 (goto-char (point-min))
|
809
|
1370
|
20285
|
1371 ;; If name is "First Last" and userid is "F?L", then assume
|
|
1372 ;; the middle initial is the second letter in the userid.
|
|
1373 ;; Initial code by Jamie Zawinski <jwz@lucid.com>
|
|
1374 ;; *** Make it work when there's a suffix as well.
|
|
1375 (goto-char (point-min))
|
41300
|
1376 (when (and mail-extr-guess-middle-initial
|
|
1377 (not disable-initial-guessing-flag)
|
|
1378 (eq 3 (- mbox-end mbox-beg))
|
|
1379 (progn
|
|
1380 (goto-char (point-min))
|
|
1381 (looking-at mail-extr-two-name-pattern)))
|
|
1382 (setq fi (char-after (match-beginning 0))
|
|
1383 li (char-after (match-beginning 3)))
|
|
1384 (with-current-buffer canonicalization-buffer
|
|
1385 ;; char-equal is ignoring case here, so no need to upcase
|
|
1386 ;; or downcase.
|
|
1387 (let ((case-fold-search t))
|
|
1388 (and (char-equal fi (char-after mbox-beg))
|
|
1389 (char-equal li (char-after (1- mbox-end)))
|
|
1390 (setq mi (char-after (1+ mbox-beg))))))
|
|
1391 (when (and mi
|
|
1392 ;; TODO: use better table than syntax table
|
|
1393 (eq ?w (char-syntax mi)))
|
|
1394 (goto-char (match-beginning 3))
|
|
1395 (insert (upcase mi) ". ")))
|
20285
|
1396
|
|
1397 ;; Nuke name if it is the same as mailbox name.
|
|
1398 (let ((buffer-length (- (point-max) (point-min)))
|
|
1399 (i 0)
|
|
1400 (names-match-flag t))
|
41300
|
1401 (when (and (> buffer-length 0)
|
|
1402 (eq buffer-length (- mbox-end mbox-beg)))
|
|
1403 (goto-char (point-max))
|
|
1404 (insert-buffer-substring canonicalization-buffer
|
|
1405 mbox-beg mbox-end)
|
|
1406 (while (and names-match-flag
|
|
1407 (< i buffer-length))
|
|
1408 (or (eq (downcase (char-after (+ i (point-min))))
|
|
1409 (downcase
|
|
1410 (char-after (+ i buffer-length (point-min)))))
|
|
1411 (setq names-match-flag nil))
|
|
1412 (setq i (1+ i)))
|
|
1413 (delete-region (+ (point-min) buffer-length) (point-max))
|
57391
|
1414 (and names-match-flag
|
|
1415 mail-extr-ignore-realname-equals-mailbox-name
|
|
1416 (narrow-to-region (point) (point)))))
|
20285
|
1417
|
|
1418 ;; Nuke name if it's just one word.
|
|
1419 (goto-char (point-min))
|
|
1420 (and mail-extr-ignore-single-names
|
|
1421 (not (re-search-forward "[- ]" nil t))
|
|
1422 (narrow-to-region (point) (point)))
|
|
1423
|
|
1424 ;; Record the result
|
|
1425 (setq value-list
|
|
1426 (cons (list (if (not (= (point-min) (point-max)))
|
|
1427 (buffer-string))
|
41300
|
1428 (with-current-buffer canonicalization-buffer
|
20285
|
1429 (if (not (= (point-min) (point-max)))
|
|
1430 (buffer-string))))
|
|
1431 value-list))
|
|
1432
|
|
1433 ;; Unless one address is all we wanted,
|
|
1434 ;; delete this one from extraction-buffer
|
|
1435 ;; and get ready to extract the next address.
|
|
1436 (when all
|
|
1437 (if end-of-address
|
|
1438 (narrow-to-region 1 end-of-address)
|
|
1439 (widen))
|
|
1440 (delete-region (point-min) (point-max))
|
|
1441 (widen))
|
|
1442 )))
|
|
1443 (if all (nreverse value-list) (car value-list))
|
|
1444 ))
|
809
|
1445
|
56600
|
1446 (defcustom mail-extr-disable-voodoo "\\cj"
|
|
1447 "*If it is a regexp, names matching it will never be modified.
|
|
1448 If it is neither nil nor a string, modifying of names will never take
|
|
1449 place. It affects how `mail-extract-address-components' works."
|
|
1450 :type '(choice (regexp :size 0)
|
|
1451 (const :tag "Always enabled" nil)
|
|
1452 (const :tag "Always disabled" t))
|
|
1453 :group 'mail-extr)
|
|
1454
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1455 (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
|
56600
|
1456 (unless (and mail-extr-disable-voodoo
|
|
1457 (or (not (stringp mail-extr-disable-voodoo))
|
|
1458 (progn
|
|
1459 (goto-char (point-min))
|
|
1460 (re-search-forward mail-extr-disable-voodoo nil t))))
|
|
1461 (let ((word-count 0)
|
|
1462 (case-fold-search nil)
|
|
1463 mixed-case-flag lower-case-flag ;;upper-case-flag
|
|
1464 suffix-flag last-name-comma-flag
|
|
1465 ;;cbeg cend
|
|
1466 initial
|
|
1467 begin-again-flag
|
|
1468 drop-this-word-if-trailing-flag
|
|
1469 drop-last-word-if-trailing-flag
|
|
1470 word-found-flag
|
|
1471 this-word-beg last-word-beg
|
|
1472 name-beg name-end
|
|
1473 name-done-flag
|
|
1474 )
|
|
1475 (save-excursion
|
|
1476 (set-syntax-table mail-extr-address-text-syntax-table)
|
|
1477
|
|
1478 ;; Get rid of comments.
|
|
1479 (goto-char (point-min))
|
|
1480 (while (not (eobp))
|
|
1481 ;; Initialize for this iteration of the loop.
|
|
1482 (skip-chars-forward "^({[\"'`")
|
|
1483 (let ((cbeg (point)))
|
|
1484 (set-syntax-table mail-extr-address-text-comment-syntax-table)
|
|
1485 (if (memq (following-char) '(?\' ?\`))
|
|
1486 (search-forward "'" nil 'move
|
|
1487 (if (eq ?\' (following-char)) 2 1))
|
|
1488 (or (mail-extr-safe-move-sexp 1)
|
|
1489 (goto-char (point-max))))
|
|
1490 (set-syntax-table mail-extr-address-text-syntax-table)
|
|
1491 (when (eq (char-after cbeg) ?\()
|
|
1492 ;; Delete the comment itself.
|
|
1493 (delete-region cbeg (point))
|
|
1494 ;; Canonicalize whitespace where the comment was.
|
|
1495 (skip-chars-backward " \t")
|
|
1496 (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)")
|
|
1497 (replace-match "")
|
|
1498 (setq cbeg (point))
|
|
1499 (skip-chars-forward " \t")
|
|
1500 (if (bobp)
|
|
1501 (delete-region (point) cbeg)
|
|
1502 (just-one-space))))))
|
|
1503
|
|
1504 ;; This was moved above.
|
|
1505 ;; Fix . used as space
|
|
1506 ;; But it belongs here because it occurs not only as
|
|
1507 ;; rypens@reks.uia.ac.be (Piet.Rypens)
|
|
1508 ;; but also as
|
|
1509 ;; "Piet.Rypens" <rypens@reks.uia.ac.be>
|
|
1510 ;;(goto-char (point-min))
|
|
1511 ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
|
1512 ;; (replace-match "\\1 \\2" t))
|
18816
|
1513
|
56600
|
1514 (unless (search-forward " " nil t)
|
|
1515 (goto-char (point-min))
|
|
1516 (cond ((search-forward "_" nil t)
|
|
1517 ;; Handle the *idiotic* use of underlines as spaces.
|
|
1518 ;; Example: fml@foo.bar.dom (First_M._Last)
|
|
1519 (goto-char (point-min))
|
|
1520 (while (search-forward "_" nil t)
|
|
1521 (replace-match " " t)))
|
|
1522 ((search-forward "." nil t)
|
|
1523 ;; Fix . used as space
|
|
1524 ;; Example: danj1@cb.att.com (daniel.jacobson)
|
|
1525 (goto-char (point-min))
|
|
1526 (while (re-search-forward mail-extr-bad-dot-pattern nil t)
|
|
1527 (replace-match "\\1 \\2" t)))))
|
|
1528
|
|
1529 ;; Loop over the words (and other junk) in the name.
|
|
1530 (goto-char (point-min))
|
|
1531 (while (not name-done-flag)
|
|
1532
|
|
1533 (when word-found-flag
|
|
1534 ;; Last time through this loop we skipped over a word.
|
|
1535 (setq last-word-beg this-word-beg)
|
|
1536 (setq drop-last-word-if-trailing-flag
|
|
1537 drop-this-word-if-trailing-flag)
|
|
1538 (setq word-found-flag nil))
|
|
1539
|
|
1540 (when begin-again-flag
|
|
1541 ;; Last time through the loop we found something that
|
|
1542 ;; indicates we should pretend we are beginning again from
|
|
1543 ;; the start.
|
|
1544 (setq word-count 0)
|
|
1545 (setq last-word-beg nil)
|
|
1546 (setq drop-last-word-if-trailing-flag nil)
|
|
1547 (setq mixed-case-flag nil)
|
|
1548 (setq lower-case-flag nil)
|
|
1549 ;; (setq upper-case-flag nil)
|
|
1550 (setq begin-again-flag nil))
|
|
1551
|
|
1552 ;; Initialize for this iteration of the loop.
|
|
1553 (mail-extr-skip-whitespace-forward)
|
|
1554 (if (eq word-count 0) (narrow-to-region (point) (point-max)))
|
|
1555 (setq this-word-beg (point))
|
|
1556 (setq drop-this-word-if-trailing-flag nil)
|
|
1557
|
|
1558 ;; Decide what to do based on what we are looking at.
|
|
1559 (cond
|
|
1560
|
|
1561 ;; Delete title
|
|
1562 ((and (eq word-count 0)
|
|
1563 (looking-at mail-extr-full-name-prefixes))
|
|
1564 (goto-char (match-end 0))
|
|
1565 (narrow-to-region (point) (point-max)))
|
|
1566
|
|
1567 ;; Stop after name suffix
|
|
1568 ((and (>= word-count 2)
|
|
1569 (looking-at mail-extr-full-name-suffix-pattern))
|
|
1570 (mail-extr-skip-whitespace-backward)
|
|
1571 (setq suffix-flag (point))
|
|
1572 (if (eq ?, (following-char))
|
|
1573 (forward-char 1)
|
|
1574 (insert ?,))
|
|
1575 ;; Enforce at least one space after comma
|
|
1576 (or (eq ?\ (following-char))
|
|
1577 (insert ?\ ))
|
|
1578 (mail-extr-skip-whitespace-forward)
|
|
1579 (cond ((memq (following-char) '(?j ?J ?s ?S))
|
|
1580 (capitalize-word 1)
|
|
1581 (if (eq (following-char) ?.)
|
|
1582 (forward-char 1)
|
|
1583 (insert ?.)))
|
|
1584 (t
|
|
1585 (upcase-word 1)))
|
|
1586 (setq word-found-flag t)
|
|
1587 (setq name-done-flag t))
|
|
1588
|
|
1589 ;; Handle SCA names
|
|
1590 ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As"
|
|
1591 (goto-char (match-beginning 1))
|
|
1592 (narrow-to-region (point) (point-max))
|
|
1593 (setq begin-again-flag t))
|
|
1594
|
|
1595 ;; Check for initial last name followed by comma
|
|
1596 ((and (eq ?, (following-char))
|
|
1597 (eq word-count 1))
|
|
1598 (forward-char 1)
|
|
1599 (setq last-name-comma-flag t)
|
|
1600 (or (eq ?\ (following-char))
|
|
1601 (insert ?\ )))
|
|
1602
|
|
1603 ;; Stop before trailing comma-separated comment
|
|
1604 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
|
1605 ;; *** This case is redundant???
|
|
1606 ;;((eq ?, (following-char))
|
|
1607 ;; (setq name-done-flag t))
|
47939
|
1608
|
56600
|
1609 ;; Delete parenthesized/quoted comment/nickname
|
|
1610 ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
|
|
1611 (setq cbeg (point))
|
|
1612 (set-syntax-table mail-extr-address-text-comment-syntax-table)
|
|
1613 (cond ((memq (following-char) '(?\' ?\`))
|
|
1614 (or (search-forward "'" nil t
|
|
1615 (if (eq ?\' (following-char)) 2 1))
|
|
1616 (delete-char 1)))
|
|
1617 (t
|
|
1618 (or (mail-extr-safe-move-sexp 1)
|
|
1619 (goto-char (point-max)))))
|
|
1620 (set-syntax-table mail-extr-address-text-syntax-table)
|
|
1621 (setq cend (point))
|
|
1622 (cond
|
|
1623 ;; Handle case of entire name being quoted
|
|
1624 ((and (eq word-count 0)
|
|
1625 (looking-at " *\\'")
|
|
1626 (>= (- cend cbeg) 2))
|
|
1627 (narrow-to-region (1+ cbeg) (1- cend))
|
|
1628 (goto-char (point-min)))
|
|
1629 (t
|
|
1630 ;; Handle case of quoted initial
|
|
1631 (if (and (or (= 3 (- cend cbeg))
|
|
1632 (and (= 4 (- cend cbeg))
|
|
1633 (eq ?. (char-after (+ 2 cbeg)))))
|
|
1634 (not (looking-at " *\\'")))
|
|
1635 (setq initial (char-after (1+ cbeg)))
|
|
1636 (setq initial nil))
|
|
1637 (delete-region cbeg cend)
|
|
1638 (if initial
|
|
1639 (insert initial ". ")))))
|
|
1640
|
|
1641 ;; Handle *Stupid* VMS date stamps
|
|
1642 ((looking-at mail-extr-stupid-vms-date-stamp-pattern)
|
|
1643 (replace-match "" t))
|
|
1644
|
|
1645 ;; Handle Chinese characters.
|
|
1646 ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
|
|
1647 (goto-char (match-end 0))
|
|
1648 (setq word-found-flag t))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1649
|
56600
|
1650 ;; Skip initial garbage characters.
|
|
1651 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
|
|
1652 ((and (eq word-count 0)
|
|
1653 (looking-at mail-extr-leading-garbage))
|
|
1654 (goto-char (match-end 0))
|
|
1655 ;; *** Skip backward over these???
|
|
1656 ;; (skip-chars-backward "& \"")
|
|
1657 (narrow-to-region (point) (point-max)))
|
|
1658
|
|
1659 ;; Various stopping points
|
|
1660 ((or
|
|
1661
|
|
1662 ;; Stop before ALL CAPS acronyms, if preceded by mixed-case
|
|
1663 ;; words. Example: XT-DEM.
|
|
1664 (and (>= word-count 2)
|
|
1665 mixed-case-flag
|
|
1666 (looking-at mail-extr-weird-acronym-pattern)
|
|
1667 (not (looking-at mail-extr-roman-numeral-pattern)))
|
|
1668
|
|
1669 ;; Stop before trailing alternative address
|
|
1670 (looking-at mail-extr-alternative-address-pattern)
|
|
1671
|
|
1672 ;; Stop before trailing comment not introduced by comma
|
|
1673 ;; THIS CASE MUST BE AFTER AN EARLIER CASE.
|
|
1674 (looking-at mail-extr-trailing-comment-start-pattern)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1675
|
56600
|
1676 ;; Stop before telephone numbers
|
|
1677 (and (>= word-count 1)
|
|
1678 (looking-at mail-extr-telephone-extension-pattern)))
|
|
1679 (setq name-done-flag t))
|
|
1680
|
|
1681 ;; Delete ham radio call signs
|
|
1682 ((looking-at mail-extr-ham-call-sign-pattern)
|
|
1683 (delete-region (match-beginning 0) (match-end 0)))
|
|
1684
|
|
1685 ;; Fixup initials
|
|
1686 ((looking-at mail-extr-initial-pattern)
|
|
1687 (or (eq (following-char) (upcase (following-char)))
|
|
1688 (setq lower-case-flag t))
|
|
1689 (forward-char 1)
|
|
1690 (if (eq ?. (following-char))
|
|
1691 (forward-char 1)
|
|
1692 (insert ?.))
|
|
1693 (or (eq ?\ (following-char))
|
|
1694 (insert ?\ ))
|
|
1695 (setq word-found-flag t))
|
|
1696
|
|
1697 ;; Handle BITNET LISTSERV list names.
|
|
1698 ((and (eq word-count 0)
|
|
1699 (looking-at mail-extr-listserv-list-name-pattern))
|
|
1700 (narrow-to-region (match-beginning 1) (match-end 1))
|
|
1701 (setq word-found-flag t)
|
|
1702 (setq name-done-flag t))
|
47939
|
1703
|
56600
|
1704 ;; Handle & substitution, when & is last and is not first.
|
|
1705 ((and (> word-count 0)
|
|
1706 (eq ?\ (preceding-char))
|
|
1707 (eq (following-char) ?&)
|
|
1708 (eq (1+ (point)) (point-max)))
|
|
1709 (delete-char 1)
|
|
1710 (capitalize-region
|
|
1711 (point)
|
|
1712 (progn
|
|
1713 (insert-buffer-substring canonicalization-buffer
|
|
1714 mbox-beg mbox-end)
|
|
1715 (point)))
|
|
1716 (setq disable-initial-guessing-flag t)
|
|
1717 (setq word-found-flag t))
|
|
1718
|
|
1719 ;; Handle & between names, as in "Bob & Susie".
|
|
1720 ((and (> word-count 0) (eq (following-char) ?\&))
|
|
1721 (setq name-beg (point))
|
|
1722 (setq name-end (1+ name-beg))
|
|
1723 (setq word-found-flag t)
|
|
1724 (goto-char name-end))
|
|
1725
|
|
1726 ;; Regular name words
|
|
1727 ((looking-at mail-extr-name-pattern)
|
|
1728 (setq name-beg (point))
|
|
1729 (setq name-end (match-end 0))
|
|
1730
|
|
1731 ;; Certain words will be dropped if they are at the end.
|
|
1732 (and (>= word-count 2)
|
|
1733 (not lower-case-flag)
|
|
1734 (or
|
|
1735 ;; Trailing 4-or-more letter lowercase words preceded by
|
|
1736 ;; mixed case or uppercase words will be dropped.
|
|
1737 (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'")
|
|
1738 ;; Drop a trailing word which is terminated with a period.
|
|
1739 (eq ?. (char-after (1- name-end))))
|
|
1740 (setq drop-this-word-if-trailing-flag t))
|
|
1741
|
|
1742 ;; Set the flags that indicate whether we have seen a lowercase
|
|
1743 ;; word, a mixed case word, and an uppercase word.
|
|
1744 (if (re-search-forward "[[:lower:]]" name-end t)
|
|
1745 (if (progn
|
|
1746 (goto-char name-beg)
|
|
1747 (re-search-forward "[[:upper:]]" name-end t))
|
|
1748 (setq mixed-case-flag t)
|
|
1749 (setq lower-case-flag t))
|
|
1750 ;; (setq upper-case-flag t)
|
|
1751 )
|
|
1752
|
|
1753 (goto-char name-end)
|
|
1754 (setq word-found-flag t))
|
809
|
1755
|
56600
|
1756 ;; Allow a number as a word, if it doesn't mean anything else.
|
|
1757 ((looking-at "[0-9]+\\>")
|
|
1758 (setq name-beg (point))
|
|
1759 (setq name-end (match-end 0))
|
|
1760 (goto-char name-end)
|
|
1761 (setq word-found-flag t))
|
|
1762
|
|
1763 (t
|
|
1764 (setq name-done-flag t)
|
|
1765 ))
|
|
1766
|
|
1767 ;; Count any word that we skipped over.
|
|
1768 (if word-found-flag
|
|
1769 (setq word-count (1+ word-count))))
|
|
1770
|
|
1771 ;; If the last thing in the name is 2 or more periods, or one or more
|
|
1772 ;; other sentence terminators (but not a single period) then keep them
|
|
1773 ;; and the preceding word. This is for the benefit of whole sentences
|
|
1774 ;; in the name field: it's better behavior than dropping the last word
|
|
1775 ;; of the sentence...
|
|
1776 (if (and (not suffix-flag)
|
|
1777 (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'"))
|
|
1778 (goto-char (setq suffix-flag (point-max))))
|
47939
|
1779
|
56600
|
1780 ;; Drop everything after point and certain trailing words.
|
|
1781 (narrow-to-region (point-min)
|
|
1782 (or (and drop-last-word-if-trailing-flag
|
|
1783 last-word-beg)
|
|
1784 (point)))
|
47939
|
1785
|
56600
|
1786 ;; Xerox's mailers SUCK!!!!!!
|
|
1787 ;; We simply refuse to believe that any last name is PARC or ADOC.
|
|
1788 ;; If it looks like that is the last name, that there is no meaningful
|
|
1789 ;; here at all. Actually I guess it would be best to map patterns
|
|
1790 ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
|
|
1791 ;; actually know that that is what's going on.
|
|
1792 (unless suffix-flag
|
|
1793 (goto-char (point-min))
|
|
1794 (let ((case-fold-search t))
|
|
1795 (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
|
|
1796 (erase-buffer))))
|
47939
|
1797
|
56600
|
1798 ;; If last name first put it at end (but before suffix)
|
|
1799 (when last-name-comma-flag
|
|
1800 (goto-char (point-min))
|
|
1801 (search-forward ",")
|
|
1802 (setq name-end (1- (point)))
|
|
1803 (goto-char (or suffix-flag (point-max)))
|
|
1804 (or (eq ?\ (preceding-char))
|
|
1805 (insert ?\ ))
|
|
1806 (insert-buffer-substring (current-buffer) (point-min) name-end)
|
|
1807 (goto-char name-end)
|
|
1808 (skip-chars-forward "\t ,")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1809 (narrow-to-region (point) (point-max)))
|
47939
|
1810
|
56600
|
1811 ;; Delete leading and trailing junk characters.
|
|
1812 ;; *** This is probably completely unneeded now.
|
|
1813 ;;(goto-char (point-max))
|
|
1814 ;;(skip-chars-backward mail-extr-non-end-name-chars)
|
|
1815 ;;(if (eq ?. (following-char))
|
|
1816 ;; (forward-char 1))
|
|
1817 ;;(narrow-to-region (point)
|
|
1818 ;; (progn
|
|
1819 ;; (goto-char (point-min))
|
|
1820 ;; (skip-chars-forward mail-extr-non-begin-name-chars)
|
|
1821 ;; (point)))
|
47939
|
1822
|
56600
|
1823 ;; Compress whitespace
|
41300
|
1824 (goto-char (point-min))
|
56600
|
1825 (while (re-search-forward "[ \t\n]+" nil t)
|
|
1826 (replace-match (if (eobp) "" " ") t))
|
|
1827 ))))
|
809
|
1828
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1829
|
809
|
1830
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1831 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1832 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1833 ;; Table of top-level domain names.
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1834 ;;
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1835 ;; This is used during address canonicalization; be careful of format changes.
|
809
|
1836 ;; Keep in mind that the country abbreviations follow ISO-3166. There is
|
|
1837 ;; a U.S. FIPS that specifies a different set of two-letter country
|
|
1838 ;; abbreviations.
|
46273
|
1839 ;;
|
|
1840 ;; Updated by the RIPE Network Coordination Centre.
|
|
1841 ;;
|
|
1842 ;; Source: ISO 3166 Maintenance Agency
|
|
1843 ;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
|
|
1844 ;; http://www.iana.org/domain-names.htm
|
|
1845 ;; http://www.iana.org/cctld/cctld-whois.htm
|
|
1846 ;; Latest change: Mon Jul 8 14:21:59 CEST 2002
|
809
|
1847
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1848 (defconst mail-extr-all-top-level-domains
|
38363
|
1849 (let ((ob (make-vector 739 0)))
|
41300
|
1850 (mapc
|
|
1851 (lambda (x)
|
|
1852 (put (intern (downcase (car x)) ob)
|
|
1853 'domain-name
|
|
1854 (if (nth 2 x)
|
|
1855 (format (nth 2 x) (nth 1 x))
|
|
1856 (nth 1 x))))
|
8983
|
1857 '(
|
|
1858 ;; ISO 3166 codes:
|
20427
|
1859 ("ad" "Andorra")
|
8983
|
1860 ("ae" "United Arab Emirates")
|
38363
|
1861 ("af" "Afghanistan")
|
8983
|
1862 ("ag" "Antigua and Barbuda")
|
38363
|
1863 ("ai" "Anguilla")
|
8983
|
1864 ("al" "Albania")
|
20427
|
1865 ("am" "Armenia")
|
38363
|
1866 ("an" "Netherlands Antilles")
|
8983
|
1867 ("ao" "Angola")
|
|
1868 ("aq" "Antarctica") ; continent
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1869 ("ar" "Argentina" "Argentine Republic")
|
38363
|
1870 ("as" "American Samoa")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1871 ("at" "Austria" "The Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1872 ("au" "Australia")
|
38363
|
1873 ("aw" "Aruba")
|
8983
|
1874 ("az" "Azerbaijan")
|
20427
|
1875 ("ba" "Bosnia-Herzegovina")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1876 ("bb" "Barbados")
|
8983
|
1877 ("bd" "Bangladesh")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1878 ("be" "Belgium" "The Kingdom of %s")
|
8983
|
1879 ("bf" "Burkina Faso")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1880 ("bg" "Bulgaria")
|
8983
|
1881 ("bh" "Bahrain")
|
38363
|
1882 ("bi" "Burundi")
|
|
1883 ("bj" "Benin")
|
8983
|
1884 ("bm" "Bermuda")
|
38363
|
1885 ("bn" "Brunei Darussalam")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1886 ("bo" "Bolivia" "Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1887 ("br" "Brazil" "The Federative Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1888 ("bs" "Bahamas")
|
38363
|
1889 ("bt" "Bhutan")
|
|
1890 ("bv" "Bouvet Island")
|
8983
|
1891 ("bw" "Botswana")
|
|
1892 ("by" "Belarus")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1893 ("bz" "Belize")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1894 ("ca" "Canada")
|
38363
|
1895 ("cc" "Cocos (Keeling) Islands")
|
46273
|
1896 ("cd" "Congo" "The Democratic Republic of the %s")
|
38363
|
1897 ("cf" "Central African Republic")
|
8983
|
1898 ("cg" "Congo")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1899 ("ch" "Switzerland" "The Swiss Confederation")
|
38363
|
1900 ("ci" "Ivory Coast") ; Cote D'ivoire
|
|
1901 ("ck" "Cook Islands")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1902 ("cl" "Chile" "The Republic of %s")
|
8983
|
1903 ("cm" "Cameroon") ; In .fr domain
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1904 ("cn" "China" "The People's Republic of %s")
|
8983
|
1905 ("co" "Colombia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1906 ("cr" "Costa Rica" "The Republic of %s")
|
8983
|
1907 ("cu" "Cuba")
|
38363
|
1908 ("cv" "Cape Verde")
|
|
1909 ("cx" "Christmas Island")
|
8983
|
1910 ("cy" "Cyprus")
|
|
1911 ("cz" "Czech Republic")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1912 ("de" "Germany")
|
38363
|
1913 ("dj" "Djibouti")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1914 ("dk" "Denmark")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1915 ("dm" "Dominica")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1916 ("do" "Dominican Republic" "The %s")
|
8983
|
1917 ("dz" "Algeria")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1918 ("ec" "Ecuador" "The Republic of %s")
|
8983
|
1919 ("ee" "Estonia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1920 ("eg" "Egypt" "The Arab Republic of %s")
|
38363
|
1921 ("eh" "Western Sahara")
|
8983
|
1922 ("er" "Eritrea")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1923 ("es" "Spain" "The Kingdom of %s")
|
20427
|
1924 ("et" "Ethiopia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1925 ("fi" "Finland" "The Republic of %s")
|
38363
|
1926 ("fj" "Fiji")
|
|
1927 ("fk" "Falkland Islands (Malvinas)")
|
|
1928 ("fm" "Micronesia" "Federated States of %s")
|
8983
|
1929 ("fo" "Faroe Islands")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1930 ("fr" "France")
|
20427
|
1931 ("ga" "Gabon")
|
|
1932 ("gb" "United Kingdom")
|
8983
|
1933 ("gd" "Grenada")
|
|
1934 ("ge" "Georgia")
|
38363
|
1935 ("gf" "French Guiana")
|
|
1936 ("gh" "Ghana")
|
|
1937 ("gi" "Gibraltar")
|
20427
|
1938 ("gl" "Greenland")
|
|
1939 ("gm" "Gambia")
|
38363
|
1940 ("gn" "Guinea")
|
8983
|
1941 ("gp" "Guadeloupe (Fr.)")
|
38363
|
1942 ("gq" "Equatorial Guinea")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1943 ("gr" "Greece" "The Hellenic Republic (%s)")
|
46273
|
1944 ("gs" "South Georgia and The South Sandwich Islands")
|
8983
|
1945 ("gt" "Guatemala")
|
|
1946 ("gu" "Guam (U.S.)")
|
38363
|
1947 ("gw" "Guinea-Bissau")
|
|
1948 ("gy" "Guyana")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1949 ("hk" "Hong Kong")
|
46273
|
1950 ("hm" "Heard Island and Mcdonald Islands")
|
8983
|
1951 ("hn" "Honduras")
|
20427
|
1952 ("hr" "Croatia" "Croatia (Hrvatska)")
|
8983
|
1953 ("ht" "Haiti")
|
20427
|
1954 ("hu" "Hungary" "The Hungarian Republic")
|
8983
|
1955 ("id" "Indonesia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1956 ("ie" "Ireland")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1957 ("il" "Israel" "The State of %s")
|
38363
|
1958 ("im" "Isle of Man" "The %s") ; NOT in ISO 3166-1 of 2001-02-26
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1959 ("in" "India" "The Republic of %s")
|
38363
|
1960 ("io" "British Indian Ocean Territory")
|
|
1961 ("iq" "Iraq")
|
|
1962 ("ir" "Iran" "Islamic Republic of %s")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1963 ("is" "Iceland" "The Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1964 ("it" "Italy" "The Italian Republic")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1965 ("jm" "Jamaica")
|
20427
|
1966 ("jo" "Jordan")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1967 ("jp" "Japan")
|
8983
|
1968 ("ke" "Kenya")
|
38363
|
1969 ("kg" "Kyrgyzstan")
|
|
1970 ("kh" "Cambodia")
|
|
1971 ("ki" "Kiribati")
|
|
1972 ("km" "Comoros")
|
|
1973 ("kn" "Saint Kitts and Nevis")
|
|
1974 ("kp" "Korea (North)" "Democratic People's Republic of Korea")
|
|
1975 ("kr" "Korea (South)" "Republic of Korea")
|
8983
|
1976 ("kw" "Kuwait")
|
38363
|
1977 ("ky" "Cayman Islands")
|
46273
|
1978 ("kz" "Kazakhstan")
|
38363
|
1979 ("la" "Lao People's Democratic Republic")
|
8983
|
1980 ("lb" "Lebanon")
|
38363
|
1981 ("lc" "Saint Lucia")
|
8983
|
1982 ("li" "Liechtenstein")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1983 ("lk" "Sri Lanka" "The Democratic Socialist Republic of %s")
|
38363
|
1984 ("lr" "Liberia")
|
8983
|
1985 ("ls" "Lesotho")
|
|
1986 ("lt" "Lithuania")
|
|
1987 ("lu" "Luxembourg")
|
|
1988 ("lv" "Latvia")
|
38363
|
1989 ("ly" "Libyan Arab Jamahiriya")
|
8983
|
1990 ("ma" "Morocco")
|
20427
|
1991 ("mc" "Monaco")
|
|
1992 ("md" "Moldova" "The Republic of %s")
|
8983
|
1993 ("mg" "Madagascar")
|
38363
|
1994 ("mh" "Marshall Islands")
|
|
1995 ("mk" "Macedonia" "The Former Yugoslav Republic of %s")
|
8983
|
1996 ("ml" "Mali")
|
38363
|
1997 ("mm" "Myanmar")
|
|
1998 ("mn" "Mongolia")
|
46273
|
1999 ("mo" "Macao")
|
38363
|
2000 ("mp" "Northern Mariana Islands")
|
|
2001 ("mq" "Martinique")
|
|
2002 ("mr" "Mauritania")
|
|
2003 ("ms" "Montserrat")
|
8983
|
2004 ("mt" "Malta")
|
|
2005 ("mu" "Mauritius")
|
20427
|
2006 ("mv" "Maldives")
|
8983
|
2007 ("mw" "Malawi")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2008 ("mx" "Mexico" "The United Mexican States")
|
46273
|
2009 ("my" "Malaysia")
|
8983
|
2010 ("mz" "Mozambique")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2011 ("na" "Namibia")
|
8983
|
2012 ("nc" "New Caledonia (Fr.)")
|
|
2013 ("ne" "Niger") ; In .fr domain
|
38363
|
2014 ("nf" "Norfolk Island")
|
|
2015 ("ng" "Nigeria")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2016 ("ni" "Nicaragua" "The Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2017 ("nl" "Netherlands" "The Kingdom of the %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2018 ("no" "Norway" "The Kingdom of %s")
|
8983
|
2019 ("np" "Nepal") ; Via .in domain
|
38363
|
2020 ("nr" "Nauru")
|
20427
|
2021 ("nu" "Niue")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2022 ("nz" "New Zealand")
|
38363
|
2023 ("om" "Oman")
|
8983
|
2024 ("pa" "Panama")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2025 ("pe" "Peru")
|
46273
|
2026 ("pf" "French Polynesia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2027 ("pg" "Papua New Guinea")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2028 ("ph" "Philippines" "The Republic of the %s")
|
8983
|
2029 ("pk" "Pakistan")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2030 ("pl" "Poland")
|
38363
|
2031 ("pm" "Saint Pierre and Miquelon")
|
|
2032 ("pn" "Pitcairn")
|
8983
|
2033 ("pr" "Puerto Rico (U.S.)")
|
38363
|
2034 ("ps" "Palestinian Territory, Occupied")
|
13959
|
2035 ("pt" "Portugal" "The Portuguese Republic")
|
38363
|
2036 ("pw" "Palau")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2037 ("py" "Paraguay")
|
20427
|
2038 ("qa" "Qatar")
|
8983
|
2039 ("re" "Reunion (Fr.)") ; In .fr domain
|
|
2040 ("ro" "Romania")
|
38363
|
2041 ("ru" "Russia" "Russian Federation")
|
|
2042 ("rw" "Rwanda")
|
8983
|
2043 ("sa" "Saudi Arabia")
|
38363
|
2044 ("sb" "Solomon Islands")
|
8983
|
2045 ("sc" "Seychelles")
|
|
2046 ("sd" "Sudan")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2047 ("se" "Sweden" "The Kingdom of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2048 ("sg" "Singapore" "The Republic of %s")
|
38363
|
2049 ("sh" "Saint Helena")
|
8983
|
2050 ("si" "Slovenia")
|
38363
|
2051 ("sj" "Svalbard and Jan Mayen") ; In .no domain
|
8983
|
2052 ("sk" "Slovakia" "The Slovak Republic")
|
38363
|
2053 ("sl" "Sierra Leone")
|
20427
|
2054 ("sm" "San Marino")
|
8983
|
2055 ("sn" "Senegal")
|
38363
|
2056 ("so" "Somalia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2057 ("sr" "Suriname")
|
46273
|
2058 ("st" "Sao Tome and Principe")
|
38363
|
2059 ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
|
|
2060 ("sv" "El Salvador")
|
|
2061 ("sy" "Syrian Arab Republic")
|
8983
|
2062 ("sz" "Swaziland")
|
46273
|
2063 ("tc" "Turks and Caicos Islands")
|
38363
|
2064 ("td" "Chad")
|
|
2065 ("tf" "French Southern Territories")
|
8983
|
2066 ("tg" "Togo")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2067 ("th" "Thailand" "The Kingdom of %s")
|
38363
|
2068 ("tj" "Tajikistan")
|
|
2069 ("tk" "Tokelau")
|
46273
|
2070 ("tl" "East Timor")
|
38363
|
2071 ("tm" "Turkmenistan")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2072 ("tn" "Tunisia")
|
20427
|
2073 ("to" "Tonga")
|
38363
|
2074 ("tp" "East Timor")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2075 ("tr" "Turkey" "The Republic of %s")
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2076 ("tt" "Trinidad and Tobago")
|
38363
|
2077 ("tv" "Tuvalu")
|
|
2078 ("tw" "Taiwan" "%s, Province of China")
|
|
2079 ("tz" "Tanzania" "United Republic of %s")
|
8983
|
2080 ("ua" "Ukraine")
|
38363
|
2081 ("ug" "Uganda")
|
8318
|
2082 ("uk" "United Kingdom" "The %s of Great Britain and Northern Ireland")
|
38363
|
2083 ("um" "United States Minor Outlying Islands")
|
8983
|
2084 ("us" "United States" "The %s of America")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2085 ("uy" "Uruguay" "The Eastern Republic of %s")
|
38363
|
2086 ("uz" "Uzbekistan")
|
|
2087 ("va" "Holy See (Vatican City State)")
|
46273
|
2088 ("vc" "Saint Vincent and the Grenadines")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2089 ("ve" "Venezuela" "The Republic of %s")
|
38363
|
2090 ("vg" "Virgin Islands, British")
|
|
2091 ("vi" "Virgin Islands, U.S.")
|
8983
|
2092 ("vn" "Vietnam")
|
|
2093 ("vu" "Vanuatu")
|
38363
|
2094 ("wf" "Wallis and Futuna")
|
|
2095 ("ws" "Samoa")
|
|
2096 ("ye" "Yemen")
|
|
2097 ("yt" "Mayotte")
|
20427
|
2098 ("yu" "Yugoslavia" "Yugoslavia, AKA Serbia-Montenegro")
|
|
2099 ("za" "South Africa" "The Republic of %s")
|
38363
|
2100 ("zm" "Zambia")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2101 ("zw" "Zimbabwe" "Republic of %s")
|
46273
|
2102 ;; Generic Domains:
|
|
2103 ("aero" t "Air Transport Industry")
|
|
2104 ("biz" t "Businesses")
|
8983
|
2105 ("com" t "Commercial")
|
46273
|
2106 ("coop" t "Cooperative Associations")
|
|
2107 ("info" t "Info")
|
|
2108 ("museum" t "Museums")
|
|
2109 ("name" t "Individuals")
|
8983
|
2110 ("net" t "Network")
|
|
2111 ("org" t "Non-profit Organization")
|
46273
|
2112 ;;("pro" t "Credentialed professionals")
|
|
2113 ;;("bitnet" t "Because It's Time NET")
|
|
2114 ("gov" t "United States Government")
|
|
2115 ("edu" t "Educational")
|
|
2116 ("mil" t "United States Military")
|
|
2117 ("int" t "International Treaties")
|
|
2118 ;;("nato" t "North Atlantic Treaty Organization")
|
8983
|
2119 ("uucp" t "Unix to Unix CoPy")
|
46273
|
2120 ;; Infrastructure Domains:
|
|
2121 ("arpa" t "Advanced Research Projects Agency (U.S. DoD)")
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2122 ))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2123 ob))
|
809
|
2124
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2125 ;;;###autoload
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2126 (defun what-domain (domain)
|
8356
|
2127 "Convert mail domain DOMAIN to the country it corresponds to."
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2128 (interactive
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2129 (let ((completion-ignore-case t))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2130 (list (completing-read "Domain: "
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2131 mail-extr-all-top-level-domains nil t))))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2132 (or (setq domain (intern-soft (downcase domain)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2133 mail-extr-all-top-level-domains))
|
14029
|
2134 (error "No such domain"))
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2135 (message "%s: %s" (upcase (symbol-name domain)) (get domain 'domain-name)))
|
809
|
2136
|
|
2137
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2138 ;(let ((all nil))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2139 ; (mapatoms #'(lambda (x)
|
47939
|
2140 ; (if (and (boundp x)
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2141 ; (string-match "^mail-extr-" (symbol-name x)))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2142 ; (setq all (cons x all)))))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2143 ; (setq all (sort all #'string-lessp))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2144 ; (cons 'setq
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2145 ; (apply 'nconc (mapcar #'(lambda (x)
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2146 ; (list x (symbol-value x)))
|
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2147 ; all))))
|
809
|
2148
|
|
2149
|
7060
58d613f69b39
(mail-extr-all-top-level-domains): Renamed from all-top-level-domains.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2150 (provide 'mail-extr)
|
809
|
2151
|
52401
|
2152 ;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d
|
809
|
2153 ;;; mail-extr.el ends here
|