APPROVE COMMIT NOTE: This patch has been committed # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1490215414 0 # Wed Mar 22 20:43:34 2017 +0000 # Node ID 7c59d90e8c3957eb3dc3ac85e732c42ac448ed1f # Parent 93e16a72245c5ed1f649b92b905c117bec1e35fc Sync with current GNU version of mail-extr.el 2017-03-22 Aidan Kehoe <kehoea(a)parhasard.net&gt; * mail-extr.el: * mail-extr.el (if): * mail-extr.el (mail-extr-guess-middle-initial): * mail-extr.el (mail-extr-ignore-single-names): * mail-extr.el (mail-extr-ignore-realname-equals-mailbox-name): New. * mail-extr.el (mail-extr-full-name-prefixes): * mail-extr.el (mail-extr-＠-binds-tighter-than-!): * mail-extr.el (mail-extr-mangle-uucp): * mail-extr.el (mail-extr-all-letters-but-separators): * mail-extr.el (mail-extr-first-letters): * mail-extr.el (mail-extr-last-letters): Removed. * mail-extr.el (mail-extr-last-letter): New. * mail-extr.el (mail-extr-hz-embedded-gb-encoded-chinese-pattern): * mail-extr.el (lambda): * mail-extr.el (mailextr-cbeg): * mail-extr.el (cbeg): Removed. * mail-extr.el (cend): Removed. * mail-extr.el (mailextr-cbeg): New. * mail-extr.el (mailextr-cend): New. * mail-extr.el (mail-extr-all-top-level-domains)): New. * mail-extr.el (mail-extract-address-components): * mail-extr.el (mail-extr-voodoo): * mail-extr.el (mail-extr-disable-voodoo): New. * mail-extr.el (mail-extr-all-top-level-domains): Sync with current GNU version of this file. diff -r 93e16a72245c -r 7c59d90e8c39 ChangeLog --- a/ChangeLog Sun Nov 20 22:02:17 2016 +0000 +++ b/ChangeLog Wed Mar 22 20:43:34 2017 +0000 ＠＠ -1,3 +1,31 ＠＠ +2017-03-22 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * mail-extr.el: + * mail-extr.el (if): + * mail-extr.el (mail-extr-guess-middle-initial): + * mail-extr.el (mail-extr-ignore-single-names): + * mail-extr.el (mail-extr-ignore-realname-equals-mailbox-name): New. + * mail-extr.el (mail-extr-full-name-prefixes): + * mail-extr.el (mail-extr-＠-binds-tighter-than-!): + * mail-extr.el (mail-extr-mangle-uucp): + * mail-extr.el (mail-extr-all-letters-but-separators): + * mail-extr.el (mail-extr-first-letters): + * mail-extr.el (mail-extr-last-letters): Removed. + * mail-extr.el (mail-extr-last-letter): New. + * mail-extr.el (mail-extr-hz-embedded-gb-encoded-chinese-pattern): + * mail-extr.el (lambda): + * mail-extr.el (mailextr-cbeg): + * mail-extr.el (cbeg): Removed. + * mail-extr.el (cend): Removed. + * mail-extr.el (mailextr-cbeg): New. + * mail-extr.el (mailextr-cend): New. + * mail-extr.el (mail-extr-all-top-level-domains)): New. + * mail-extr.el (mail-extract-address-components): + * mail-extr.el (mail-extr-voodoo): + * mail-extr.el (mail-extr-disable-voodoo): New. + * mail-extr.el (mail-extr-all-top-level-domains): + Sync with current GNU version of this file. + 2016-11-20 Aidan Kehoe <kehoea(a)parhasard.net&gt; * mail-abbrevs.el (mail-aliases-setup): diff -r 93e16a72245c -r 7c59d90e8c39 mail-extr.el --- a/mail-extr.el Sun Nov 20 22:02:17 2016 +0000 +++ b/mail-extr.el Wed Mar 22 20:43:34 2017 +0000 ＠＠ -1,30 +1,27 ＠＠ ;;; mail-extr.el --- extract full name and address from RFC 822 mail header -;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 1991-1994, 1997, 2001-2017 Free Software Foundation, +;; Inc. ;; Author: Joe Wells <jbw(a)cs.bu.edu&gt; -;; Maintainer: FSF +;; Maintainer: emacs-devel(a)gnu.org ;; Keywords: mail - -;; This file is part of XEmacs. +;; Package: mail-utils -;; XEmacs is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; XEmacs is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Emacs 21.3 CVS as of 2004-06-10. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>;. ;;; Commentary: ＠＠ -211,6 +208,10 ＠＠ ;;; Code:  +(eval-and-compile + (if (featurep 'xemacs) ;; Purespace obsolete in XEmacs. + (define-compiler-macro purecopy (&whole form argument) argument))) + (defgroup mail-extr nil "Extract full name and address from RFC 822 mail header." :prefix "mail-extr-" ＠＠ -222,17 +223,25 ＠＠ ;; (defcustom mail-extr-guess-middle-initial nil - "*Whether to try to guess middle initial from mail address. + "Whether to try to guess middle initial from mail address. If true, then when we see an address like \"John Smith <jqs(a)host.com&gt;\&quot; we will assume that \"John Q. Smith\" is the fellow's name." :type 'boolean :group 'mail-extr) (defcustom mail-extr-ignore-single-names nil - "*Whether to ignore a name that is just a single word. + "Whether to ignore a name that is just a single word. If true, then when we see an address like \"Idiot <dumb(a)stupid.com&gt;\&quot; we will act as though we couldn't find a full name in the address." :type 'boolean + :version "22.1" + :group 'mail-extr) + +(defcustom mail-extr-ignore-realname-equals-mailbox-name t +"Whether to ignore a name that is equal to the mailbox name. +If true, then when the address is like \"Single <single(a)address.com&gt;\&quot; +we will act as though we couldn't find a full name in the address." + :type 'boolean :group 'mail-extr) ;; Matches a leading title that is not part of the name (does not ＠＠ -240,19 +249,19 ＠＠ (defcustom mail-extr-full-name-prefixes (purecopy "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]") - "*Matches prefixes to the full name that identify a person's position. + "Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to uniquely identifying the person." :type 'regexp :group 'mail-extr) (defcustom mail-extr-＠-binds-tighter-than-! nil - "*Whether the local mail transport agent looks at ! before ＠." + "Whether the local mail transport agent looks at ! before ＠." :type 'boolean :group 'mail-extr) (defcustom mail-extr-mangle-uucp nil - "*Whether to throw away information in UUCP addresses + "Whether to throw away information in UUCP addresses by translating things like \"foo!bar!baz＠host\" into \&quot;baz(a)bar.UUCP\&quot;.&quot; :type 'boolean :group 'mail-extr) ＠＠ -280,9 +289,11 ＠＠ ;; Yes, there are weird people with digits in their names. ;; You will also notice the consideration for the ;; Swedish/Finnish/Norwegian character set. -;; XEmacs: Add \200-\376 range (not \377 due to bug (?) in search.c...). (defconst mail-extr-all-letters-but-separators - (purecopy "][A-Za-z{|}'~0-9`\200-\376")) ;; XEmacs + (if (string-match "[[:alnum:]]" "z") + (purecopy "][[:alnum:]{|}'~`") + ;; XEmacs; support builds without [:alnum:] + "][A-Za-z{|}'~0-9`\200-\376")) ;; Any character that can occur in a name in an RFC822 address including ;; the separator (hyphen and possibly period) for multipart names. ＠＠ -292,11 +303,16 ＠＠ ;; Any character that can start a name. ;; Keep this set as minimal as possible. -(defconst mail-extr-first-letters (purecopy "A-Za-z")) ;; XEmacs +(defconst mail-extr-first-letters (if (string-match "[[:alpha:]]" "z") + ;; XEmacs; see above. + (purecopy "[:alpha:]") + "A-Za-z")) ;; Any character that can end a name. ;; Keep this set as minimal as possible. -(defconst mail-extr-last-letters (purecopy "[A-Za-z`'.")) ;; XEmacs +(defconst mail-extr-last-letters (if (string-match "[[:alpha:]]" "z") + (purecopy "[:alpha:]`'.") + (purecopy "[A-Za-z]`'."))) ;; XEmacs (defconst mail-extr-leading-garbage "\\W+") ＠＠ -325,7 +341,7 ＠＠ ;; Matches an embedded or leading nickname that should be removed. ;; (defconst mail-extr-nickname-pattern ;; (purecopy -;; (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] " +;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] " ;; mail-extr-all-letters))) ;; Matches the occurrence of a generational name suffix, and the last ＠＠ -391,7 +407,7 ＠＠ ;; Matches ham radio call signs. ;; Help from: Mat Maessen N2NJZ <maessm(a)rpi.edu&gt;, Mark Feit ;; <mark(a)era.com&gt;, Michael Covington <mcovingt(a)ai.uga.edu&gt;. -;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW +;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KD3FU KD6EUI KD6HBW ;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH ;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO (defconst mail-extr-ham-call-sign-pattern ＠＠ -452,7 +468,7 ＠＠ ;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}' ;; ($7E7D) is outside the defined GB range.) (defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern - (purecopy "~{\\([^~].\\|~[^\}]\\)+~}")) + (purecopy "~{\\([^~].\\|~[^}]\\)+~}")) ;; The leading optional lowercase letters are for a bastardized version of ;; the encoding, as is the optional nature of the final slash. ＠＠ -539,8 +555,8 ＠＠ (?\t " ") (?\r " ") (?\n " ") - (?\( "\(\)") - (?\) "\)\(") + (?\( "()") + (?\) ")(") (?\\ "\\")) (mail-extr-address-domain-literal-syntax-table (?\000 ?\377 "w") ＠＠ -549,8 +565,8 ＠＠ (?\t " ") (?\r " ") (?\n " ") - (?\[ "\(\]") ;?????? - (?\] "\)\[") ;?????? + (?\[ "(]") ;?????? + (?\] ")[") ;?????? (?\\ "\\")) (mail-extr-address-text-comment-syntax-table (?\000 ?\377 "w") ＠＠ -559,16 +575,16 ＠＠ (?\t " ") (?\r " ") (?\n " ") - (?\( "\(\)") - (?\) "\)\(") - (?\[ "\(\]") - (?\] "\)\[") - (?\{ "\(\}") - (?\} "\)\{") + (?\( "()") + (?\) ")(") + (?\[ "(]") + (?\] ")[") + (?\{ "(}") + (?\} "){") (?\\ "\\") (?\" "\"") - ;; (?\' "\)\`") - ;; (?\` "\(\'") + ;; (?\' ")`") + ;; (?\` "('") ) (mail-extr-address-text-syntax-table (?\000 ?\177 ".") ＠＠ -687,15 +703,17 ＠＠ ;; (defvar disable-initial-guessing-flag) ; dynamic assignment -(defvar cbeg) ; dynamic assignment -(defvar cend) ; dynamic assignment +(defvar mailextr-cbeg) ; dynamic assignment +(defvar mailextr-cend) ; dynamic assignment +(defvar mail-extr-all-top-level-domains) ; Defined below. ;;;###autoload (defun mail-extract-address-components (address &optional all) "Given an RFC-822 address ADDRESS, extract full name and canonical address. -Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). -If no name can be extracted, FULL-NAME will be nil. Also see -`mail-extr-ignore-single-names'. +Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no +name can be extracted, FULL-NAME will be nil. Also see +`mail-extr-ignore-single-names' and +`mail-extr-ignore-realname-equals-mailbox-name'. If the optional argument ALL is non-nil, then ADDRESS can contain zero or more recipients, separated by commas, and we return a list of ＠＠ -756,7 +774,8 ＠＠ record-pos-symbol first-real-pos last-real-pos phrase-beg phrase-end - cbeg cend ; dynamically set from -voodoo + ;; Dynamically set in mail-extr-voodoo. + mailextr-cbeg mailextr-cend quote-beg quote-end atom-beg atom-end mbox-beg mbox-end ＠＠ -790,19 +809,19 ＠＠ ((eq char ?\() (set-syntax-table mail-extr-address-comment-syntax-table) ;; only record the first non-empty comment's position - (if (and (not cbeg) + (if (and (not mailextr-cbeg) (save-excursion (forward-char 1) (mail-extr-skip-whitespace-forward) (not (eq ?\) (char-after (point)))))) - (setq cbeg (point))) + (setq mailextr-cbeg (point))) ;; TODO: don't record if unbalanced (or (mail-extr-safe-move-sexp 1) (forward-char 1)) (set-syntax-table mail-extr-address-syntax-table) - (if (and cbeg - (not cend)) - (setq cend (point)))) + (if (and mailextr-cbeg + (not mailextr-cend)) + (setq mailextr-cend (point)))) ;; quoted text ((eq char ?\") ;; only record the first non-empty quote's position ＠＠ -843,7 +862,7 ＠＠ (setq char ?\() ; HAVE I NO SHAME?? ) ;; record the position of various interesting chars, determine - ;; legality later. + ;; validity later. ((setq record-pos-symbol (cdr (assq char '((?< . <-pos) (?> . >-pos) (?＠ . ＠-pos) ＠＠ -855,9 +874,9 ＠＠ ((eq char ?.) (forward-char 1)) ((memq char '( - ;; comment terminator illegal + ;; comment terminator invalid ?\) - ;; domain literal terminator illegal + ;; domain literal terminator invalid ?\] ;; \ allowed only within quoted strings, ;; domain literals, and comments ＠＠ -866,7 +885,17 ＠＠ (mail-extr-nuke-char-at (point)) (forward-char 1)) (t - (forward-word 1))) + ;; Do `(forward-word 1)', recognizing non-ASCII characters + ;; except Latin-1 nbsp as words. + (while (progn + (skip-chars-forward "^\000-\177\240") + (and (not (eobp)) + (eq ?w (char-syntax (char-after))) + (progn + (forward-word 1) ; (forward-word-strictly 1) + (and (not (eobp)) + (> (char-after) ?\177) + (not (eq (char-after) ?\240))))))))) (or (eq char ?\() ;; At the end of first address of a multiple address header. (and (eq char ?,) ＠＠ -978,10 +1007,10 ＠＠ (> last-real-pos (1+ group-\;-pos)) (setq last-real-pos (1+ group-\;-pos))) ;; *** This may be wrong: - (and cend - (> cend group-\;-pos) - (setq cend nil - cbeg nil)) + (and mailextr-cend + (> mailextr-cend group-\;-pos) + (setq mailextr-cend nil + mailextr-cbeg nil)) (and quote-end (> quote-end group-\;-pos) (setq quote-end nil ＠＠ -1212,8 +1241,8 ＠＠ (narrow-to-region phrase-beg phrase-end)) ;; Example: fml(a)foo.bar.dom (First M. Last) - (cbeg - (narrow-to-region (1+ cbeg) (1- cend)) + (mailextr-cbeg + (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend)) (mail-extr-undo-backslash-quoting (point-min) (point-max)) ;; Deal with spacing problems ＠＠ -1295,7 +1324,7 ＠＠ ) (t (setq atom-beg (point)) - (forward-word 1) + (forward-word) ; (forward-word-strictly 1) (setq atom-end (point)) (goto-char atom-beg) (save-restriction ＠＠ -1389,24 +1418,26 ＠＠ (insert (upcase mi) ". "))) ;; Nuke name if it is the same as mailbox name. - (let ((buffer-length (- (point-max) (point-min))) - (i 0) - (names-match-flag t)) - (when (and (> buffer-length 0) - (eq buffer-length (- mbox-end mbox-beg))) - (goto-char (point-max)) - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (while (and names-match-flag - (< i buffer-length)) - (or (eq (downcase (char-after (+ i (point-min)))) - (downcase - (char-after (+ i buffer-length (point-min))))) - (setq names-match-flag nil)) - (setq i (1+ i))) - (delete-region (+ (point-min) buffer-length) (point-max)) - (if names-match-flag - (narrow-to-region (point) (point))))) + (when mail-extr-ignore-single-names + (let ((buffer-length (- (point-max) (point-min))) + (i 0) + (names-match-flag t)) + (when (and (> buffer-length 0) + (eq buffer-length (- mbox-end mbox-beg))) + (goto-char (point-max)) + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (while (and names-match-flag + (< i buffer-length)) + (or (eq (downcase (char-after (+ i (point-min)))) + (downcase + (char-after (+ i buffer-length (point-min))))) + (setq names-match-flag nil)) + (setq i (1+ i))) + (delete-region (+ (point-min) buffer-length) (point-max)) + (and names-match-flag + mail-extr-ignore-realname-equals-mailbox-name + (narrow-to-region (point) (point)))))) ;; Nuke name if it's just one word. (goto-char (point-min)) ＠＠ -1436,374 +1467,401 ＠＠ (if all (nreverse value-list) (car value-list)) )) -(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) - (let ((word-count 0) - (case-fold-search nil) - mixed-case-flag lower-case-flag ;;upper-case-flag - suffix-flag last-name-comma-flag - ;;cbeg cend - initial - begin-again-flag - drop-this-word-if-trailing-flag - drop-last-word-if-trailing-flag - word-found-flag - this-word-beg last-word-beg - name-beg name-end - name-done-flag - ) - (save-excursion - (set-syntax-table mail-extr-address-text-syntax-table) - - ;; Get rid of comments. - (goto-char (point-min)) - (while (not (eobp)) - ;; Initialize for this iteration of the loop. - (skip-chars-forward "^({[\"'`") - (let ((cbeg (point))) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (if (memq (following-char) '(?\' ?\`)) - (search-forward "'" nil 'move - (if (eq ?\' (following-char)) 2 1)) - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max)))) - (set-syntax-table mail-extr-address-text-syntax-table) - (when (eq (char-after cbeg) ?\() - ;; Delete the comment itself. - (delete-region cbeg (point)) - ;; Canonicalize whitespace where the comment was. - (skip-chars-backward " \t") - (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") - (replace-match "") - (setq cbeg (point)) - (skip-chars-forward " \t") - (if (bobp) - (delete-region (point) cbeg) - (just-one-space)))))) +(defcustom mail-extr-disable-voodoo "\\cj" + "If it is a regexp, names matching it will never be modified. +If it is neither nil nor a string, modifying of names will never take +place. It affects how `mail-extract-address-components' works." + :type '(choice (regexp :size 0) + (const :tag "Always enabled" nil) + (const :tag "Always disabled" t)) + :group 'mail-extr) - ;; This was moved above. - ;; Fix . used as space - ;; But it belongs here because it occurs not only as - ;; rypens(a)reks.uia.ac.be (Piet.Rypens) - ;; but also as - ;; "Piet.Rypens" <rypens(a)reks.uia.ac.be&gt; - ;;(goto-char (point-min)) - ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) - ;; (replace-match "\\1 \\2" t)) - - (unless (search-forward " " nil t) - (goto-char (point-min)) - (cond ((search-forward "_" nil t) - ;; Handle the *idiotic* use of underlines as spaces. - ;; Example: fml(a)foo.bar.dom (First_M._Last) - (goto-char (point-min)) - (while (search-forward "_" nil t) - (replace-match " " t))) - ((search-forward "." nil t) - ;; Fix . used as space - ;; Example: danj1(a)cb.att.com (daniel.jacobson) - (goto-char (point-min)) - (while (re-search-forward mail-extr-bad-dot-pattern nil t) - (replace-match "\\1 \\2" t))))) - - ;; Loop over the words (and other junk) in the name. - (goto-char (point-min)) - (while (not name-done-flag) +(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) + (unless (and mail-extr-disable-voodoo + (or (not (stringp mail-extr-disable-voodoo)) + (progn + (goto-char (point-min)) + (re-search-forward mail-extr-disable-voodoo nil t)))) + (let ((word-count 0) + (case-fold-search nil) + mixed-case-flag lower-case-flag ;;upper-case-flag + suffix-flag last-name-comma-flag + initial + begin-again-flag + drop-this-word-if-trailing-flag + drop-last-word-if-trailing-flag + word-found-flag + this-word-beg last-word-beg + name-beg name-end + name-done-flag + ) + (save-excursion + (set-syntax-table mail-extr-address-text-syntax-table) - (when word-found-flag - ;; Last time through this loop we skipped over a word. - (setq last-word-beg this-word-beg) - (setq drop-last-word-if-trailing-flag - drop-this-word-if-trailing-flag) - (setq word-found-flag nil)) + ;; Get rid of comments. + (goto-char (point-min)) + (while (not (eobp)) + ;; Initialize for this iteration of the loop. + (skip-chars-forward "^({[\"'`") + (let ((cbeg (point))) ;; Not used dynamically in this sexp + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (if (memq (following-char) '(?\' ?\`)) + (search-forward "'" nil 'move + (if (eq ?\' (following-char)) 2 1)) + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max)))) + (set-syntax-table mail-extr-address-text-syntax-table) + (when (eq (char-after cbeg) ?\() + ;; Delete the comment itself. + (delete-region cbeg (point)) + ;; Canonicalize whitespace where the comment was. + (skip-chars-backward " \t") + (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") + (replace-match "") + (setq cbeg (point)) + (skip-chars-forward " \t") + (if (bobp) + (delete-region (point) cbeg) + (just-one-space)))))) - (when begin-again-flag - ;; Last time through the loop we found something that - ;; indicates we should pretend we are beginning again from - ;; the start. - (setq word-count 0) - (setq last-word-beg nil) - (setq drop-last-word-if-trailing-flag nil) - (setq mixed-case-flag nil) - (setq lower-case-flag nil) - ;; (setq upper-case-flag nil) - (setq begin-again-flag nil)) + ;; This was moved above. + ;; Fix . used as space + ;; But it belongs here because it occurs not only as + ;; rypens(a)reks.uia.ac.be (Piet.Rypens) + ;; but also as + ;; "Piet.Rypens" <rypens(a)reks.uia.ac.be&gt; + ;;(goto-char (point-min)) + ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) + ;; (replace-match "\\1 \\2" t)) - ;; Initialize for this iteration of the loop. - (mail-extr-skip-whitespace-forward) - (if (eq word-count 0) (narrow-to-region (point) (point-max))) - (setq this-word-beg (point)) - (setq drop-this-word-if-trailing-flag nil) + (unless (search-forward " " nil t) + (goto-char (point-min)) + (cond ((search-forward "_" nil t) + ;; Handle the *idiotic* use of underlines as spaces. + ;; Example: fml(a)foo.bar.dom (First_M._Last) + (goto-char (point-min)) + (while (search-forward "_" nil t) + (replace-match " " t))) + ((search-forward "." nil t) + ;; Fix . used as space + ;; Example: danj1(a)cb.att.com (daniel.jacobson) + (goto-char (point-min)) + (while (re-search-forward mail-extr-bad-dot-pattern nil t) + (replace-match "\\1 \\2" t))))) - ;; Decide what to do based on what we are looking at. - (cond + ;; Loop over the words (and other junk) in the name. + (goto-char (point-min)) + (while (not name-done-flag) - ;; Delete title - ((and (eq word-count 0) - (looking-at mail-extr-full-name-prefixes)) - (goto-char (match-end 0)) + (when word-found-flag + ;; Last time through this loop we skipped over a word. + (setq last-word-beg this-word-beg) + (setq drop-last-word-if-trailing-flag + drop-this-word-if-trailing-flag) + (setq word-found-flag nil)) + + (when begin-again-flag + ;; Last time through the loop we found something that + ;; indicates we should pretend we are beginning again from + ;; the start. + (setq word-count 0) + (setq last-word-beg nil) + (setq drop-last-word-if-trailing-flag nil) + (setq mixed-case-flag nil) + (setq lower-case-flag nil) + ;; (setq upper-case-flag nil) + (setq begin-again-flag nil)) + + ;; Initialize for this iteration of the loop. + (mail-extr-skip-whitespace-forward) + (if (eq word-count 0) (narrow-to-region (point) (point-max))) + (setq this-word-beg (point)) + (setq drop-this-word-if-trailing-flag nil) + + ;; Decide what to do based on what we are looking at. + (cond + + ;; Delete title + ((and (eq word-count 0) + (looking-at mail-extr-full-name-prefixes)) + (goto-char (match-end 0)) + (narrow-to-region (point) (point-max))) + + ;; Stop after name suffix + ((and (>= word-count 2) + (looking-at mail-extr-full-name-suffix-pattern)) + (mail-extr-skip-whitespace-backward) + (setq suffix-flag (point)) + (if (eq ?, (following-char)) + (forward-char 1) + (insert ?,)) + ;; Enforce at least one space after comma + (or (eq ?\ (following-char)) + (insert ?\ )) + (mail-extr-skip-whitespace-forward) + (cond ((memq (following-char) '(?j ?J ?s ?S)) + (capitalize-word 1) + (if (eq (following-char) ?.) + (forward-char 1) + (insert ?.))) + (t + (upcase-word 1))) + (setq word-found-flag t) + (setq name-done-flag t)) + + ;; Handle SCA names + ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" + (goto-char (match-beginning 1)) + (narrow-to-region (point) (point-max)) + (setq begin-again-flag t)) + + ;; Check for initial last name followed by comma + ((and (eq ?, (following-char)) + (eq word-count 1)) + (forward-char 1) + (setq last-name-comma-flag t) + (or (eq ?\ (following-char)) + (insert ?\ ))) + + ;; Stop before trailing comma-separated comment + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ;; *** This case is redundant??? + ;;((eq ?, (following-char)) + ;; (setq name-done-flag t)) + + ;; Delete parenthesized/quoted comment/nickname + ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) + (setq mailextr-cbeg (point)) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (cond ((memq (following-char) '(?\' ?\`)) + (or (search-forward "'" nil t + (if (eq ?\' (following-char)) 2 1)) + (delete-char 1))) + (t + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max))))) + (set-syntax-table mail-extr-address-text-syntax-table) + (setq mailextr-cend (point)) + (cond + ;; Handle case of entire name being quoted + ((and (eq word-count 0) + (looking-at " *\\'") + (>= (- mailextr-cend mailextr-cbeg) 2)) + (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend)) + (goto-char (point-min))) + (t + ;; Handle case of quoted initial + (if (and (or (= 3 (- mailextr-cend mailextr-cbeg)) + (and (= 4 (- mailextr-cend mailextr-cbeg)) + (eq ?. (char-after (+ 2 mailextr-cbeg))))) + (not (looking-at " *\\'"))) + (setq initial (char-after (1+ mailextr-cbeg))) + (setq initial nil)) + (delete-region mailextr-cbeg mailextr-cend) + (if initial + (insert initial ". "))))) + + ;; Handle *Stupid* VMS date stamps + ((looking-at mail-extr-stupid-vms-date-stamp-pattern) + (replace-match "" t)) + + ;; Handle Chinese characters. + ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) + (goto-char (match-end 0)) + (setq word-found-flag t)) + + ;; Skip initial garbage characters. + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ((and (eq word-count 0) + (looking-at mail-extr-leading-garbage)) + (goto-char (match-end 0)) + ;; *** Skip backward over these??? + ;; (skip-chars-backward "& \"") + (narrow-to-region (point) (point-max))) + + ;; Various stopping points + ((or + + ;; Stop before ALL CAPS acronyms, if preceded by mixed-case + ;; words. Example: XT-DEM. + (and (>= word-count 2) + mixed-case-flag + (looking-at mail-extr-weird-acronym-pattern) + (not (looking-at mail-extr-roman-numeral-pattern))) + + ;; Stop before trailing alternative address + (looking-at mail-extr-alternative-address-pattern) + + ;; Stop before trailing comment not introduced by comma + ;; THIS CASE MUST BE AFTER AN EARLIER CASE. + (looking-at mail-extr-trailing-comment-start-pattern) + + ;; Stop before telephone numbers + (and (>= word-count 1) + (looking-at mail-extr-telephone-extension-pattern))) + (setq name-done-flag t)) + + ;; Delete ham radio call signs + ((looking-at mail-extr-ham-call-sign-pattern) + (delete-region (match-beginning 0) (match-end 0))) + + ;; Fixup initials + ((looking-at mail-extr-initial-pattern) + (or (eq (following-char) (upcase (following-char))) + (setq lower-case-flag t)) + (forward-char 1) + (if (eq ?. (following-char)) + (forward-char 1) + (insert ?.)) + (or (eq ?\ (following-char)) + (insert ?\ )) + (setq word-found-flag t)) + + ;; Handle BITNET LISTSERV list names. + ((and (eq word-count 0) + (looking-at mail-extr-listserv-list-name-pattern)) + (narrow-to-region (match-beginning 1) (match-end 1)) + (setq word-found-flag t) + (setq name-done-flag t)) + + ;; Handle & substitution, when & is last and is not first. + ((and (> word-count 0) + (eq ?\ (preceding-char)) + (eq (following-char) ?&) + (eq (1+ (point)) (point-max))) + (delete-char 1) + (capitalize-region + (point) + (progn + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (point))) + (setq disable-initial-guessing-flag t) + (setq word-found-flag t)) + + ;; Handle & between names, as in "Bob & Susie". + ((and (> word-count 0) (eq (following-char) ?\&)) + (setq name-beg (point)) + (setq name-end (1+ name-beg)) + (setq word-found-flag t) + (goto-char name-end)) + + ;; Regular name words + ((looking-at mail-extr-name-pattern) + (setq name-beg (point)) + (setq name-end (match-end 0)) + + ;; Certain words will be dropped if they are at the end. + (and (>= word-count 2) + (not lower-case-flag) + (or + ;; Trailing 4-or-more letter lowercase words preceded by + ;; mixed case or uppercase words will be dropped. + (looking-at (load-time-value + (if (string-match "[[:lower:]]" "z") + "[[:lower:]]\\{4,\\}[ \t]*\\'" + ;; XEmacs 21.4 + "[a-z][a-z][a-z][a-z]+[ \t]*\\'"))) + ;; Drop a trailing word which is terminated with a period. + (eq ?. (char-after (1- name-end)))) + (setq drop-this-word-if-trailing-flag t)) + + ;; Set the flags that indicate whether we have seen a lowercase + ;; word, a mixed case word, and an uppercase word. + (if (re-search-forward + (load-time-value (if (string-match "[[:lower:]]" "z") + "[[:lower:]]" + ;; XEmacs 21.4 + "[a-z]")) + name-end t) + (if (progn + (goto-char name-beg) + (re-search-forward + (load-time-value (if (string-match "[[:upper:]]" "Z") + "[[:upper:]]" + ;; XEmacs 21.4 + "[A-Z]")) + name-end t)) + (setq mixed-case-flag t) + (setq lower-case-flag t)) + ;; (setq upper-case-flag t) + ) + + (goto-char name-end) + (setq word-found-flag t)) + + ;; Allow a number as a word, if it doesn't mean anything else. + ((looking-at "[0-9]+\\>") + (setq name-beg (point)) + (setq name-end (match-end 0)) + (goto-char name-end) + (setq word-found-flag t)) + + (t + (setq name-done-flag t) + )) + + ;; Count any word that we skipped over. + (if word-found-flag + (setq word-count (1+ word-count)))) + + ;; If the last thing in the name is 2 or more periods, or one or more + ;; other sentence terminators (but not a single period) then keep them + ;; and the preceding word. This is for the benefit of whole sentences + ;; in the name field: it's better behavior than dropping the last word + ;; of the sentence... + (if (and (not suffix-flag) + (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) + (goto-char (setq suffix-flag (point-max)))) + + ;; Drop everything after point and certain trailing words. + (narrow-to-region (point-min) + (or (and drop-last-word-if-trailing-flag + last-word-beg) + (point))) + + ;; Xerox's mailers SUCK!!!!!! + ;; We simply refuse to believe that any last name is PARC or ADOC. + ;; If it looks like that is the last name, that there is no meaningful + ;; here at all. Actually I guess it would be best to map patterns + ;; like foo.hoser(a)xerox.com into foo(a)hoser.xerox.com, but I don't + ;; actually know that that is what's going on. + (unless suffix-flag + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") + (erase-buffer)))) + + ;; If last name first put it at end (but before suffix) + (when last-name-comma-flag + (goto-char (point-min)) + (search-forward ",") + (setq name-end (1- (point))) + (goto-char (or suffix-flag (point-max))) + (or (eq ?\ (preceding-char)) + (insert ?\ )) + (insert-buffer-substring (current-buffer) (point-min) name-end) + (goto-char name-end) + (skip-chars-forward "\t ,") (narrow-to-region (point) (point-max))) - ;; Stop after name suffix - ((and (>= word-count 2) - (looking-at mail-extr-full-name-suffix-pattern)) - (mail-extr-skip-whitespace-backward) - (setq suffix-flag (point)) - (if (eq ?, (following-char)) - (forward-char 1) - (insert ?,)) - ;; Enforce at least one space after comma - (or (eq ?\ (following-char)) - (insert ?\ )) - (mail-extr-skip-whitespace-forward) - (cond ((memq (following-char) '(?j ?J ?s ?S)) - (capitalize-word 1) - (if (eq (following-char) ?.) - (forward-char 1) - (insert ?.))) - (t - (upcase-word 1))) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle SCA names - ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" - (goto-char (match-beginning 1)) - (narrow-to-region (point) (point-max)) - (setq begin-again-flag t)) - - ;; Check for initial last name followed by comma - ((and (eq ?, (following-char)) - (eq word-count 1)) - (forward-char 1) - (setq last-name-comma-flag t) - (or (eq ?\ (following-char)) - (insert ?\ ))) - - ;; Stop before trailing comma-separated comment - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ;; *** This case is redundant??? - ;;((eq ?, (following-char)) - ;; (setq name-done-flag t)) - - ;; Delete parenthesized/quoted comment/nickname - ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) - (setq cbeg (point)) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (cond ((memq (following-char) '(?\' ?\`)) - (or (search-forward "'" nil t - (if (eq ?\' (following-char)) 2 1)) - (delete-char 1))) - (t - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max))))) - (set-syntax-table mail-extr-address-text-syntax-table) - (setq cend (point)) - (cond - ;; Handle case of entire name being quoted - ((and (eq word-count 0) - (looking-at " *\\'") - (>= (- cend cbeg) 2)) - (narrow-to-region (1+ cbeg) (1- cend)) - (goto-char (point-min))) - (t - ;; Handle case of quoted initial - (if (and (or (= 3 (- cend cbeg)) - (and (= 4 (- cend cbeg)) - (eq ?. (char-after (+ 2 cbeg))))) - (not (looking-at " *\\'"))) - (setq initial (char-after (1+ cbeg))) - (setq initial nil)) - (delete-region cbeg cend) - (if initial - (insert initial ". "))))) - - ;; Handle *Stupid* VMS date stamps - ((looking-at mail-extr-stupid-vms-date-stamp-pattern) - (replace-match "" t)) - - ;; Handle Chinese characters. - ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) - (goto-char (match-end 0)) - (setq word-found-flag t)) - - ;; Skip initial garbage characters. - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ((and (eq word-count 0) - (looking-at mail-extr-leading-garbage)) - (goto-char (match-end 0)) - ;; *** Skip backward over these??? - ;; (skip-chars-backward "& \"") - (narrow-to-region (point) (point-max))) - - ;; Various stopping points - ((or - - ;; Stop before ALL CAPS acronyms, if preceded by mixed-case - ;; words. Example: XT-DEM. - (and (>= word-count 2) - mixed-case-flag - (looking-at mail-extr-weird-acronym-pattern) - (not (looking-at mail-extr-roman-numeral-pattern))) - - ;; Stop before trailing alternative address - (looking-at mail-extr-alternative-address-pattern) - - ;; Stop before trailing comment not introduced by comma - ;; THIS CASE MUST BE AFTER AN EARLIER CASE. - (looking-at mail-extr-trailing-comment-start-pattern) - - ;; Stop before telephone numbers - (and (>= word-count 1) - (looking-at mail-extr-telephone-extension-pattern))) - (setq name-done-flag t)) - - ;; Delete ham radio call signs - ((looking-at mail-extr-ham-call-sign-pattern) - (delete-region (match-beginning 0) (match-end 0))) - - ;; Fixup initials - ((looking-at mail-extr-initial-pattern) - (or (eq (following-char) (upcase (following-char))) - (setq lower-case-flag t)) - (forward-char 1) - (if (eq ?. (following-char)) - (forward-char 1) - (insert ?.)) - (or (eq ?\ (following-char)) - (insert ?\ )) - (setq word-found-flag t)) + ;; Delete leading and trailing junk characters. + ;; *** This is probably completely unneeded now. + ;;(goto-char (point-max)) + ;;(skip-chars-backward mail-extr-non-end-name-chars) + ;;(if (eq ?. (following-char)) + ;; (forward-char 1)) + ;;(narrow-to-region (point) + ;; (progn + ;; (goto-char (point-min)) + ;; (skip-chars-forward mail-extr-non-begin-name-chars) + ;; (point))) - ;; Handle BITNET LISTSERV list names. - ((and (eq word-count 0) - (looking-at mail-extr-listserv-list-name-pattern)) - (narrow-to-region (match-beginning 1) (match-end 1)) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle & substitution, when & is last and is not first. - ((and (> word-count 0) - (eq ?\ (preceding-char)) - (eq (following-char) ?&) - (eq (1+ (point)) (point-max))) - (delete-char 1) - (capitalize-region - (point) - (progn - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (point))) - (setq disable-initial-guessing-flag t) - (setq word-found-flag t)) - - ;; Handle & between names, as in "Bob & Susie". - ((and (> word-count 0) (eq (following-char) ?\&)) - (setq name-beg (point)) - (setq name-end (1+ name-beg)) - (setq word-found-flag t) - (goto-char name-end)) - - ;; Regular name words - ((looking-at mail-extr-name-pattern) - (setq name-beg (point)) - (setq name-end (match-end 0)) - - ;; Certain words will be dropped if they are at the end. - (and (>= word-count 2) - (not lower-case-flag) - (or - ;; Trailing 4-or-more letter lowercase words preceded by - ;; mixed case or uppercase words will be dropped. - (looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'") ;; XEmacs - ;; Drop a trailing word which is terminated with a period. - (eq ?. (char-after (1- name-end)))) - (setq drop-this-word-if-trailing-flag t)) - - ;; Set the flags that indicate whether we have seen a lowercase - ;; word, a mixed case word, and an uppercase word. - (if (re-search-forward "[a-z]" name-end t) - (if (progn - (goto-char name-beg) - (re-search-forward "[A-Z]" name-end t)) - (setq mixed-case-flag t) - (setq lower-case-flag t)) -;; (setq upper-case-flag t) - ) - - (goto-char name-end) - (setq word-found-flag t)) - - ;; Allow a number as a word, if it doesn't mean anything else. - ((looking-at "[0-9]+\\>") - (setq name-beg (point)) - (setq name-end (match-end 0)) - (goto-char name-end) - (setq word-found-flag t)) - - (t - (setq name-done-flag t) - )) - - ;; Count any word that we skipped over. - (if word-found-flag - (setq word-count (1+ word-count)))) - - ;; If the last thing in the name is 2 or more periods, or one or more - ;; other sentence terminators (but not a single period) then keep them - ;; and the preceding word. This is for the benefit of whole sentences - ;; in the name field: it's better behavior than dropping the last word - ;; of the sentence... - (if (and (not suffix-flag) - (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) - (goto-char (setq suffix-flag (point-max)))) - - ;; Drop everything after point and certain trailing words. - (narrow-to-region (point-min) - (or (and drop-last-word-if-trailing-flag - last-word-beg) - (point))) - - ;; Xerox's mailers SUCK!!!!!! - ;; We simply refuse to believe that any last name is PARC or ADOC. - ;; If it looks like that is the last name, that there is no meaningful - ;; here at all. Actually I guess it would be best to map patterns - ;; like foo.hoser(a)xerox.com into foo(a)hoser.xerox.com, but I don't - ;; actually know that that is what's going on. - (unless suffix-flag + ;; Compress whitespace (goto-char (point-min)) - (let ((case-fold-search t)) - (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") - (erase-buffer)))) - - ;; If last name first put it at end (but before suffix) - (when last-name-comma-flag - (goto-char (point-min)) - (search-forward ",") - (setq name-end (1- (point))) - (goto-char (or suffix-flag (point-max))) - (or (eq ?\ (preceding-char)) - (insert ?\ )) - (insert-buffer-substring (current-buffer) (point-min) name-end) - (goto-char name-end) - (skip-chars-forward "\t ,") - (narrow-to-region (point) (point-max))) - - ;; Delete leading and trailing junk characters. - ;; *** This is probably completely unneeded now. - ;;(goto-char (point-max)) - ;;(skip-chars-backward mail-extr-non-end-name-chars) - ;;(if (eq ?. (following-char)) - ;; (forward-char 1)) - ;;(narrow-to-region (point) - ;; (progn - ;; (goto-char (point-min)) - ;; (skip-chars-forward mail-extr-non-begin-name-chars) - ;; (point))) - - ;; Compress whitespace - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match (if (eobp) "" " ") t)) - ))) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match (if (eobp) "" " ") t)) + ))))  ＠＠ -1822,7 +1880,7 ＠＠ ;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/... ;; http://www.iana.org/domain-names.htm ;; http://www.iana.org/cctld/cctld-whois.htm -;; Latest change: Mon Jul 8 14:21:59 CEST 2002 +;; Latest change: 2007/11/15 (defconst mail-extr-all-top-level-domains (let ((ob (make-vector 739 0))) ＠＠ -1835,6 +1893,7 ＠＠ (nth 1 x)))) '( ;; ISO 3166 codes: + ("ac" "Ascension Island") ("ad" "Andorra") ("ae" "United Arab Emirates") ("af" "Afghanistan") ＠＠ -1850,6 +1909,7 ＠＠ ("at" "Austria" "The Republic of %s") ("au" "Australia") ("aw" "Aruba") + ("ax" "Aland Islands") ("az" "Azerbaijan") ("ba" "Bosnia-Herzegovina") ("bb" "Barbados") ＠＠ -1860,6 +1920,7 ＠＠ ("bh" "Bahrain") ("bi" "Burundi") ("bj" "Benin") + ("bl" "Saint Barthelemy") ("bm" "Bermuda") ("bn" "Brunei Darussalam") ("bo" "Bolivia" "Republic of %s") ＠＠ -1901,6 +1962,7 ＠＠ ("er" "Eritrea") ("es" "Spain" "The Kingdom of %s") ("et" "Ethiopia") + ("eu" "European Union") ("fi" "Finland" "The Republic of %s") ("fj" "Fiji") ("fk" "Falkland Islands (Malvinas)") ＠＠ -1912,6 +1974,7 ＠＠ ("gd" "Grenada") ("ge" "Georgia") ("gf" "French Guiana") + ("gg" "Guernsey") ("gh" "Ghana") ("gi" "Gibraltar") ("gl" "Greenland") ＠＠ -1926,7 +1989,7 ＠＠ ("gw" "Guinea-Bissau") ("gy" "Guyana") ("hk" "Hong Kong") - ("hm" "Heard Island and Mcdonald Islands") + ("hm" "Heard Island and McDonald Islands") ("hn" "Honduras") ("hr" "Croatia" "Croatia (Hrvatska)") ("ht" "Haiti") ＠＠ -1941,6 +2004,7 ＠＠ ("ir" "Iran" "Islamic Republic of %s") ("is" "Iceland" "The Republic of %s") ("it" "Italy" "The Italian Republic") + ("je" "Jersey") ("jm" "Jamaica") ("jo" "Jordan") ("jp" "Japan") ＠＠ -1969,6 +2033,8 ＠＠ ("ma" "Morocco") ("mc" "Monaco") ("md" "Moldova" "The Republic of %s") + ("me" "Montenegro") + ("mf" "Saint Martin (French part)") ("mg" "Madagascar") ("mh" "Marshall Islands") ("mk" "Macedonia" "The Former Yugoslav Republic of %s") ＠＠ -2017,6 +2083,7 ＠＠ ("qa" "Qatar") ("re" "Reunion (Fr.)") ; In .fr domain ("ro" "Romania") + ("rs" "Serbia") ("ru" "Russia" "Russian Federation") ("rw" "Rwanda") ("sa" "Saudi Arabia") ＠＠ -2080,15 +2147,21 ＠＠ ("zw" "Zimbabwe" "Republic of %s") ;; Generic Domains: ("aero" t "Air Transport Industry") + ("asia" t "Pan-Asia and Asia Pacific community") ("biz" t "Businesses") + ("cat" t "Catalan language and culture") ("com" t "Commercial") ("coop" t "Cooperative Associations") ("info" t "Info") + ("jobs" t "Employment") + ("mobi" t "Mobile products") ("museum" t "Museums") ("name" t "Individuals") ("net" t "Network") ("org" t "Non-profit Organization") - ;;("pro" t "Credentialed professionals") + ("pro" t "Credentialed professionals") + ("tel" t "Contact data") + ("travel" t "Travel industry") ;;("bitnet" t "Because It's Time NET") ("gov" t "United States Government") ("edu" t "Educational") ＠＠ -2128,5 +2201,4 ＠＠  (provide 'mail-extr) -;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d ;;; mail-extr.el ends here -- ‘As I sat looking up at the Guinness ad, I could never figure out / How your man stayed up on the surfboard after forty pints of stout’ (C. Moore)