;;; mail-extr.el --- extract full name and address from RFC 822 mail header
;;; -*- coding: utf-8 -*-

;; Copyright (C) 1991-1994, 1997, 2001-2017 Free Software Foundation,
;; Inc.

;; Author: Joe Wells <jbw@cs.bu.edu>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: mail
;; Package: mail-utils

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; The entry point of this code is
;;
;;    mail-extract-address-components: (address &optional all)
;;
;;    Given an RFC-822 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.
;;    ADDRESS may be a string or a buffer.  If it is a buffer, the visible
;;     (narrowed) portion of the buffer will be interpreted as the address.
;;     (This feature exists so that the clever caller might be able to avoid
;;     consing a string.)
;;    If ADDRESS contains more than one RFC-822 address, only the first is
;;     returned.
;;
;;    If ALL is non-nil, that means return info about all the addresses
;;     that are found in ADDRESS.  The value is a list of elements of
;;     the form (FULL-NAME CANONICAL-ADDRESS), one per address.
;;
;; This code is more correct (and more heuristic) parser than the code in
;; rfc822.el.  And despite its size, it's fairly fast.
;;
;; There are two main benefits:
;;
;; 1. Higher probability of getting the correct full name for a human than
;;    any other package we know of.  (On the other hand, it will cheerfully
;;    mangle non-human names/comments.)
;; 2. Address part is put in a canonical form.
;;
;; The interface is not yet carved in stone; please give us suggestions.
;;
;; We have an extensive test-case collection of funny addresses if you want to
;; work with the code.  Developing this code requires frequent testing to
;; make sure you're not breaking functionality.  The test cases aren't included
;; because they are over 100K.
;;
;; If you find an address that mail-extr fails on, please send it to the
;; maintainer along with what you think the correct results should be.  We do
;; not consider it a bug if mail-extr mangles a comment that does not
;; correspond to a real human full name, although we would prefer that
;; mail-extr would return the comment as-is.
;;
;; Features:
;;
;; * Full name handling:
;;
;;   * knows where full names can be found in an address.
;;   * avoids using empty comments and quoted text.
;;   * extracts full names from mailbox names.
;;   * recognizes common formats for comments after a full name.
;;   * puts a period and a space after each initial.
;;   * understands & referring to the mailbox name, capitalized.
;;   * strips name prefixes like "Prof.", etc.
;;   * understands what characters can occur in names (not just letters).
;;   * figures out middle initial from mailbox name.
;;   * removes funny nicknames.
;;   * keeps suffixes such as Jr., Sr., III, etc.
;;   * reorders "Last, First" type names.
;;
;; * Address handling:
;;
;;   * parses rfc822 quoted text, comments, and domain literals.
;;   * parses rfc822 multi-line headers.
;;   * does something reasonable with rfc822 GROUP addresses.
;;   * handles many rfc822 noncompliant and garbage addresses.
;;   * canonicalizes addresses (after stripping comments/phrases outside <>).
;;     * converts ! addresses into .UUCP and %-style addresses.
;;     * converts rfc822 ROUTE addresses to %-style addresses.
;;     * truncates %-style addresses at leftmost fully qualified domain name.
;;     * handles local relative precedence of ! vs. % and @ (untested).
;;
;; It does almost no string creation.  It primarily uses the built-in
;; parsing routines with the appropriate syntax tables.  This should
;; result in greater speed.
;;
;; TODO:
;;
;; * handle all test cases.  (This will take forever.)
;; * software to pick the correct header to use (eg., "Senders-Name:").
;; * multiple addresses in the "From:" header (almost all of the necessary
;;   code is there).
;; * flag to not treat `,' as an address separator.  (This is useful when
;;   there is a "From:" header but no "Sender:" header, because then there
;;   is only allowed to be one address.)
;; * mailbox name does not necessarily contain full name.
;; * fixing capitalization when it's all upper or lowercase.  (Hard!)
;; * some of the domain literal handling is missing.  (But I've never even
;;   seen one of these in a mail address, so maybe no big deal.)
;; * arrange to have syntax tables byte-compiled.
;; * speed hacks.
;; * delete unused variables.
;; * arrange for testing with different relative precedences of ! vs. @
;;   and %.
;; * insert documentation strings!
;; * handle X.400-gatewayed addresses according to RFC 1148.

;;; Change Log:
;;
;; Thu Feb 17 17:57:33 1994  Jamie Zawinski (jwz@lucid.com)
;;
;;	* merged with jbw's latest version
;;
;; Wed Feb  9 21:56:27 1994  Jamie Zawinski (jwz@lucid.com)
;;
;;      * high-bit chars in comments weren't treated as word syntax
;;
;; Sat Feb  5 03:13:40 1994  Jamie Zawinski (jwz@lucid.com)
;;
;;      * call replace-match with fixed-case arg
;;
;; Thu Dec 16 21:56:45 1993  Jamie Zawinski (jwz@lucid.com)
;;
;;      * some more cleanup, doc, added provide
;;
;; Tue Mar 23 21:23:18 1993  Joe Wells  (jbw at csd.bu.edu)
;;
;; 	* Made mail-full-name-prefixes a user-customizable variable.
;;        Allow passing the address as a buffer as well as a string.
;;        Allow [ and ] as name characters (Finnish character set).
;;
;; Mon Mar 22 21:20:56 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Handle "null" addresses.  Handle = used for spacing in mailbox
;; 	  name.  Fix bug in handling of ROUTE-ADDR-type addresses that are
;; 	  missing their brackets.  Handle uppercase "JR".  Extract full
;; 	  names from X.400 addresses encoded in RFC-822.  Fix bug in
;;        handling of multiple addresses where first has trailing comment.
;;        Handle more kinds of telephone extension lead-ins.
;;
;; Mon Mar 22 20:16:57 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Handle HZ encoding for embedding GB encoded chinese characters.
;;
;; Mon Mar 22 00:46:12 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Fixed too broad matching of ham radio call signs.  Fixed bug in
;; 	  handling an unmatched ' in a name string.  Enhanced recognition
;; 	  of when . in the mailbox name terminates the name portion.
;; 	  Narrowed conversion of . to space to only the necessary
;; 	  situation.  Deal with VMS's stupid date stamps.  Handle a unique
;; 	  way of introducing an alternate address.  Fixed spacing bug I
;; 	  introduced in switching last name order.  Fixed bug in handling
;; 	  address with ! and % but no @.  Narrowed the cases in which
;; 	  certain trailing words are discarded.
;;
;; Sun Mar 21 21:41:06 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Fixed bugs in handling GROUP addresses.  Certain words in the
;; 	  middle of a name no longer terminate it.  Handle LISTSERV list
;;        names.  Ignore comment field containing mailbox name.
;;
;; Sun Mar 21 14:39:38 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Moved variant-method code back into main function.  Handle
;; 	underscores as spaces in comments.  Handle leading nickname.  Add
;; 	flag to ignore single-word names.  Other changes.
;;
;; Mon Feb  1 22:23:31 1993  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Added in changes by Rod Whitby and Jamie Zawinski.  This
;;        includes the flag mail-extr-guess-middle-initial and the fix for
;;        handling multiple addresses correctly.  (Whitby just changed
;;	  a > to a <.)
;;
;; Mon Apr  6 23:59:09 1992  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Cleaned up some more.  Release version 1.0 to world.
;;
;; Sun Apr  5 19:39:08 1992  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Cleaned up full name extraction extensively.
;;
;; Sun Feb  2 14:45:24 1992  Joe Wells  (jbw at bigbird.bu.edu)
;;
;; 	* Total rewrite.  Integrated mail-canonicalize-address into
;; 	mail-extract-address-components.  Now handles GROUP addresses more
;; 	or less correctly.  Better handling of lots of different cases.
;;
;; Fri Jun 14 19:39:50 1991
;;	* Created.

;;; Code:


(eval-and-compile
 (if (featurep 'xemacs) ;; Purespace obsolete in XEmacs.
     (define-compiler-macro purecopy (&whole form argument) argument)))

(eval-when-compile (require 'cl))

(defgroup mail-extr nil
  "Extract full name and address from RFC 822 mail header."
  :prefix "mail-extr-"
  :group 'mail)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; User configuration variable definitions.
;;

(defcustom mail-extr-guess-middle-initial nil
  "Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
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.
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
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@address.com>\"
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
;; contribute to uniquely identifying the person).
(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.
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 @."
  :type 'boolean
  :group 'mail-extr)

(defcustom mail-extr-mangle-uucp nil
  "Whether to throw away information in UUCP addresses
by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
  :type 'boolean
  :group 'mail-extr)

;;----------------------------------------------------------------------
;; what orderings are meaningful?????
;;(defvar mail-operator-precedence-list '(?! ?% ?@))
;; Right operand of a % or a @ must be a domain name, period.  No other
;; operators allowed.  Left operand of a @ is an address relative to that
;; site.

;; Left operand of a ! must be a domain name.  Right operand is an
;; arbitrary address.
;;----------------------------------------------------------------------



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Constant definitions.
;;

;; Any character that can occur in a name, not counting characters that
;; separate parts of a multipart name (hyphen and period).
;; Yes, there are weird people with digits in their names.
;; You will also notice the consideration for the
;; Swedish/Finnish/Norwegian character set.
(defconst mail-extr-all-letters-but-separators
    (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.
;; #### should . be in here?
(defconst mail-extr-all-letters
  (purecopy (concat mail-extr-all-letters-but-separators "---")))

;; Any character that can start a name.
;; Keep this set as minimal as possible.
(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 (if (string-match "[[:alpha:]]" "z")
				     (purecopy "[:alpha:]`'.")
				   (purecopy "[A-Za-z]`'."))) ;; XEmacs

(defconst mail-extr-leading-garbage "\\W+")

;; (defconst mail-extr-non-name-chars
;;   (purecopy (concat "^" mail-extr-all-letters ".")))
;; (defconst mail-extr-non-begin-name-chars
;;   (purecopy (concat "^" mail-extr-first-letters)))
;; (defconst mail-extr-non-end-name-chars
;;   (purecopy (concat "^" mail-extr-last-letters)))

;; Matches an initial not followed by both a period and a space.
;; (defconst mail-extr-bad-initials-pattern
;;   (purecopy
;;    (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
;;            mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))

;; Matches periods used instead of spaces.  Must not match the period
;; following an initial.
(defconst mail-extr-bad-dot-pattern
  (purecopy
   (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
	   mail-extr-all-letters
	   mail-extr-last-letters
	   mail-extr-first-letters)))

;; Matches an embedded or leading nickname that should be removed.
;; (defconst mail-extr-nickname-pattern
;;   (purecopy
;;    (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
;;            mail-extr-all-letters)))

;; Matches the occurrence of a generational name suffix, and the last
;; character of the preceding name.  This is important because we want to
;; keep such suffixes: they help to uniquely identify the person.
;; *** Perhaps this should be a user-customizable variable.  However, the
;; *** regular expression is fairly tricky to alter, so maybe not.
(defconst mail-extr-full-name-suffix-pattern
  (purecopy
   (format
    "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
    mail-extr-all-letters mail-extr-all-letters)))

(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))

;; Matches a trailing uppercase (with other characters possible) acronym.
;; Must not match a trailing uppercase last name or trailing initial
(defconst mail-extr-weird-acronym-pattern
  (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))

;; Matches a mixed-case or lowercase name (not an initial).
;; #### Match Latin1 lower case letters here too?
;; (defconst mail-extr-mixed-case-name-pattern
;;   (purecopy
;;    (format
;;     "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
;;     mail-extr-all-letters mail-extr-last-letters
;;     mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
;;     mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))

;; Matches a trailing alternative address.
;; #### Match Latin1 letters here too?
;; #### Match _ before @ here too?
(defconst mail-extr-alternative-address-pattern
  (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))

;; Matches a variety of trailing comments not including comma-delimited
;; comments.
(defconst mail-extr-trailing-comment-start-pattern
  (purecopy " [-{]\\|--\\|[+@#></\;]"))

;; Matches a name (not an initial).
;; This doesn't force a word boundary at the end because sometimes a
;; comment is separated by a `-' with no preceding space.
(defconst mail-extr-name-pattern
  (purecopy (format "\\b[%s][%s]*[%s]"
		    mail-extr-first-letters
		    mail-extr-all-letters
		    mail-extr-last-letters)))

(defconst mail-extr-initial-pattern
  (purecopy (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters)))

;; Matches a single name before a comma.
;; (defconst mail-extr-last-name-first-pattern
;;   (purecopy (concat "\\`" mail-extr-name-pattern ",")))

;; Matches telephone extensions.
(defconst mail-extr-telephone-extension-pattern
  (purecopy
   "\\(\\([Ee]xt\\|\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+"))

;; Matches ham radio call signs.
;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
;; <mark@era.com>, Michael Covington <mcovingt@ai.uga.edu>.
;; 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
  (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))

;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
;; /KT == Temporary Technician (has CSC but not "real" license)
;; /AA == Temporary Advanced
;; /AE == Temporary Extra
;; /AG == Temporary General
;; /R  == repeater
;; /#  == stations operating out of home district
;; I don't include these in the regexp above because I can't imagine
;; anyone putting them with their name in an e-mail address.

;; Matches normal single-part name
(defconst mail-extr-normal-name-pattern
  (purecopy (format "\\b[%s][%s]+[%s]"
		    mail-extr-first-letters
		    mail-extr-all-letters-but-separators
		    mail-extr-last-letters)))

;; Matches a single word name.
;; (defconst mail-extr-one-name-pattern
;;   (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))

;; Matches normal two names with missing middle initial
;; The first name is not allowed to have a hyphen because this can cause
;; false matches where the "middle initial" is actually the first letter
;; of the second part of the first name.
(defconst mail-extr-two-name-pattern
  (purecopy
   (concat "\\`\\(" mail-extr-normal-name-pattern
	   "\\|" mail-extr-initial-pattern
	   "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))

(defconst mail-extr-listserv-list-name-pattern
  (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))

(defconst mail-extr-stupid-vms-date-stamp-pattern
  (purecopy
   "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))

;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
;;
;; In ASCII mode, a byte is interpreted as an ASCII character, unless a '~' is
;; encountered. The character '~' is an escape character. By convention, it
;; must be immediately followed ONLY by '~', '{' or '\n' (<LF>), with the
;; following special meaning.
;;
;; o The escape sequence '~~' is interpreted as a '~'.
;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB.
;; o The escape sequence '~\n' is a line-continuation marker to be consumed
;;   with no output produced.
;;
;; In GB mode, characters are interpreted two bytes at a time as (pure) GB
;; codes until the escape-from-GB code '~}' is read. This code switches the
;; 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 "~{\\([^~].\\|~[^}]\\)+~}"))

;; The leading optional lowercase letters are for a bastardized version of
;; the encoding, as is the optional nature of the final slash.
(defconst mail-extr-x400-encoded-address-pattern
  (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))

(defconst mail-extr-x400-encoded-address-field-pattern-format
  (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))

(defconst mail-extr-x400-encoded-address-surname-pattern
  ;; S stands for Surname (family name).
  (purecopy
   (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))

(defconst mail-extr-x400-encoded-address-given-name-pattern
  ;; G stands for Given name.
  (purecopy
   (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))

(defconst mail-extr-x400-encoded-address-full-name-pattern
  ;; PN stands for Personal Name.  When used it represents the combination
  ;; of the G and S fields.
  ;; "The one system I used having this field asked it with the prompt
  ;; `Personal Name'.  But they mapped it into G and S on outgoing real
  ;; X.400 addresses.  As they mapped G and S into PN on incoming..."
  (purecopy
   (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Syntax tables used for quick parsing.
;;

(defconst mail-extr-address-syntax-table (make-syntax-table))
(defconst mail-extr-address-comment-syntax-table (make-syntax-table))
(defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table))
(defconst mail-extr-address-text-comment-syntax-table (make-syntax-table))
(defconst mail-extr-address-text-syntax-table (make-syntax-table))
(mapc
 (lambda (pair)
   (let ((syntax-table (symbol-value (car pair))))
     (dolist (item (cdr pair))
       (if (eq 2 (length item))
	   ;; modifying syntax of a single character
	   (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
	 ;; modifying syntax of a range of characters
	 (let ((char (nth 0 item))
	       (bound (nth 1 item))
	       (syntax (nth 2 item)))
	   (while (<= char bound)
	     (modify-syntax-entry char syntax syntax-table)
	     (setq char (1+ char))))))))
 '((mail-extr-address-syntax-table
    (?\000 ?\037 "w")			;control characters
    (?\040	 " ")			;SPC
    (?! ?~	 "w")			;printable characters
    (?\177	 "w")			;DEL
    (?\t " ")
    (?\r " ")
    (?\n " ")
    (?\( ".")
    (?\) ".")
    (?<  ".")
    (?>  ".")
    (?@  ".")
    (?,  ".")
    (?\; ".")
    (?:  ".")
    (?\\ "\\")
    (?\" "\"")
    (?.  ".")
    (?\[ ".")
    (?\] ".")
    ;; % and ! aren't RFC822 characters, but it is convenient to pretend
    (?%  ".")
    (?!  ".") ;; this needs to be word-constituent when not in .UUCP mode
    )
   (mail-extr-address-comment-syntax-table
    (?\000 ?\377 "w")
    (?\040 " ")
    (?\240 " ")
    (?\t " ")
    (?\r " ")
    (?\n " ")
    (?\( "()")
    (?\) ")(")
    (?\\ "\\"))
   (mail-extr-address-domain-literal-syntax-table
    (?\000 ?\377 "w")
    (?\040 " ")
    (?\240 " ")
    (?\t " ")
    (?\r " ")
    (?\n " ")
    (?\[ "(]")			;??????
    (?\] ")[")			;??????
    (?\\ "\\"))
   (mail-extr-address-text-comment-syntax-table
    (?\000 ?\377 "w")
    (?\040 " ")
    (?\240 " ")
    (?\t " ")
    (?\r " ")
    (?\n " ")
    (?\( "()")
    (?\) ")(")
    (?\[ "(]")
    (?\] ")[")
    (?\{ "(}")
    (?\} "){")
    (?\\ "\\")
    (?\" "\"")
    ;; (?\' ")`")
    ;; (?\` "('")
    )
   (mail-extr-address-text-syntax-table
    (?\000 ?\177 ".")
    (?\200 ?\377 "w")
    (?\040 " ")
    (?\t " ")
    (?\r " ")
    (?\n " ")
    (?A ?Z "w")
    (?a ?z "w")
    (?-    "w")
    (?\}   "w")
    (?\{   "w")
    (?|    "w")
    (?\'   "w")
    (?~    "w")
    (?0 ?9 "w"))
   ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Utility functions and macros.
;;

;; Fixme: There are Latin-1 nbsp below.  If such characters should be
;; included, this is the wrong thing to do -- it should use syntax (or
;; regexp char classes).

(defsubst mail-extr-skip-whitespace-forward ()
  ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
  (skip-chars-forward " \t\n\r\240"))

(defsubst mail-extr-skip-whitespace-backward ()
  ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
  (skip-chars-backward " \t\n\r\240"))


(defsubst mail-extr-undo-backslash-quoting (beg end)
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      ;; undo \ quoting
      (while (search-forward "\\" nil t)
	(delete-char -1)
	(or (eobp)
	    (forward-char 1))))))

(defsubst mail-extr-nuke-char-at (pos)
  (save-excursion
    (goto-char pos)
    (delete-char 1)
    (insert ?\ )))

(put 'mail-extr-nuke-outside-range
     'edebug-form-spec '(symbolp &optional form form atom))

(defmacro mail-extr-nuke-outside-range (list-symbol
					beg-symbol end-symbol
					&optional no-replace)
  "Delete all elements outside BEG..END in LIST.
LIST-SYMBOL names a variable holding a list of buffer positions
BEG-SYMBOL and END-SYMBOL name variables delimiting a range
Each element of LIST-SYMBOL which lies outside of the range is
 deleted from the list.
Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
 which lie outside of the range, one character at that position is
 replaced with a SPC."
  (or (memq no-replace '(t nil))
      (error "no-replace must be t or nil, evaluable at macroexpand-time"))
  `(let ((temp ,list-symbol)
	   ch)
       (while temp
	 (setq ch (car temp))
	 (when (or (> ch ,end-symbol)
		   (< ch ,beg-symbol))
	   ,@(if no-replace
		   nil
		 `((mail-extr-nuke-char-at ch)))
	   (setcar temp nil))
	 (setq temp (cdr temp)))
       (setq ,list-symbol (delq nil ,list-symbol))))

(defun mail-extr-demarkerize (marker)
  ;; if arg is a marker, destroys the marker, then returns the old value.
  ;; otherwise returns the arg.
  (if (markerp marker)
      (let ((temp (marker-position marker)))
	(set-marker marker nil)
	temp)
    marker))

(defun mail-extr-markerize (pos)
  ;; coerces pos to a marker if non-nil.
  (if (or (markerp pos) (null pos))
      pos
    (copy-marker pos)))

(defsubst mail-extr-safe-move-sexp (arg)
  ;; Safely skip over one balanced sexp, if there is one.  Return t if success.
  (condition-case error
      (progn
	(goto-char (or (scan-sexps (point) arg) (point)))
	t)
    (error
     ;; #### kludge kludge kludge kludge kludge kludge kludge !!!
     (if (string-equal (nth 1 error) "Unbalanced parentheses")
	 nil
       (while t
	 (signal (car error) (cdr error)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; The main function to grind addresses
;;

(defvar disable-initial-guessing-flag)	; 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' 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
the form ((FULL-NAME CANONICAL-ADDRESS) ...) with one element for
each recipient.  If ALL is nil, then if ADDRESS contains more than
one recipients, all but the first is ignored.

ADDRESS may be a string or a buffer.  If it is a buffer, the visible
\(narrowed) portion of the buffer will be interpreted as the address.
\(This feature exists so that the clever caller might be able to avoid
consing a string.)"
  (let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
	(extraction-buffer (get-buffer-create " *extract address components*"))
	value-list)

    (with-current-buffer (get-buffer-create extraction-buffer)
      (fundamental-mode)
      (buffer-disable-undo extraction-buffer)
      (set-syntax-table mail-extr-address-syntax-table)
      (widen)
      (erase-buffer)
      (setq case-fold-search nil)

      ;; Insert extra space at beginning to allow later replacement with <
      ;; without having to move markers.
      (insert ?\ )

      ;; Insert the address itself.
      (cond ((stringp address)
	     (insert address))
	    ((bufferp address)
	     (insert-buffer-substring address))
	    (t
	     (error "Invalid address: %s" address)))

      (set-text-properties (point-min) (point-max) nil)

      (with-current-buffer (get-buffer-create canonicalization-buffer)
	(fundamental-mode)
	(buffer-disable-undo canonicalization-buffer)
	(setq case-fold-search nil))


      ;; Unfold multiple lines.
      (goto-char (point-min))
      (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
	(replace-match "\\1 " t))

      ;; Loop over addresses until we have as many as we want.
      (while (and (or all (null value-list))
		  (progn (goto-char (point-min))
			 (skip-chars-forward " \t")
			 (not (eobp))))
	(let (char
	      end-of-address
	      <-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
	      group-:-pos group-\;-pos route-addr-:-pos
	      record-pos-symbol
	      first-real-pos last-real-pos
	      phrase-beg phrase-end
	      ;; Dynamically set in mail-extr-voodoo.
	      mailextr-cbeg mailextr-cend
	      quote-beg quote-end
	      atom-beg atom-end
	      mbox-beg mbox-end
	      \.-ends-name
	      temp
	      ;;	name-suffix
	      fi mi li			; first, middle, last initial
	      saved-%-pos saved-!-pos saved-@-pos
	      domain-pos \.-pos insert-point
	      ;;	mailbox-name-processed-flag
	      disable-initial-guessing-flag) ; dynamically set from -voodoo

	  (set-syntax-table mail-extr-address-syntax-table)
	  (goto-char (point-min))

	  ;; Insert extra space at beginning to allow later replacement with <
	  ;; without having to move markers.
	  (or (eq (following-char) ?\ )
	      (insert ?\ ))

	  ;; First pass grabs useful information about address.
	  (while (progn
		   (mail-extr-skip-whitespace-forward)
		   (not (eobp)))
	    (setq char (char-after (point)))
	    (or first-real-pos
		(if (not (eq char ?\())
		    (setq first-real-pos (point))))
	    (cond
	     ;; comment
	     ((eq char ?\()
	      (set-syntax-table mail-extr-address-comment-syntax-table)
	      ;; only record the first non-empty comment's position
	      (if (and (not mailextr-cbeg)
		       (save-excursion
			 (forward-char 1)
			 (mail-extr-skip-whitespace-forward)
			 (not (eq ?\) (char-after (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 mailextr-cbeg
		       (not mailextr-cend))
		  (setq mailextr-cend (point))))
	     ;; quoted text
	     ((eq char ?\")
	      ;; only record the first non-empty quote's position
	      (if (and (not quote-beg)
		       (save-excursion
			 (forward-char 1)
			 (mail-extr-skip-whitespace-forward)
			 (not (eq ?\" (char-after (point))))))
		  (setq quote-beg (point)))
	      ;; TODO: don't record if unbalanced
	      (or (mail-extr-safe-move-sexp 1)
		  (forward-char 1))
	      (if (and quote-beg
		       (not quote-end))
		  (setq quote-end (point))))
	     ;; domain literals
	     ((eq char ?\[)
	      (set-syntax-table mail-extr-address-domain-literal-syntax-table)
	      (or (mail-extr-safe-move-sexp 1)
		  (forward-char 1))
	      (set-syntax-table mail-extr-address-syntax-table))
	     ;; commas delimit addresses when outside < > pairs.
	     ((and (eq char ?,)
		   (or (and (null <-pos)
			    ;; Handle ROUTE-ADDR address that is missing its <.
			    (not (eq ?@ (char-after (1+ (point))))))
		       (and >-pos
			    ;; handle weird munged addresses
			    ;; BUG FIX: This test was reversed.  Thanks to the
			    ;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
			    ;; for discovering this!
			    (< (car (last <-pos)) (car >-pos)))))
	      ;; The argument contains more than one address.
	      ;; Temporarily hide everything after this one.
	      (setq end-of-address (copy-marker (1+ (point)) t))
	      (narrow-to-region (point-min) (1+ (point)))
	      (delete-char 1)
	      (setq char ?\() ; HAVE I NO SHAME??
	      )
	     ;; record the position of various interesting chars, determine
	     ;; validity later.
	     ((setq record-pos-symbol
		    (cdr (assq char
			       '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
				 (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
				 (?% . %-pos) (?\; . \;-pos)))))
	      (set record-pos-symbol
		   (cons (point) (symbol-value record-pos-symbol)))
	      (forward-char 1))
	     ((eq char ?.)
	      (forward-char 1))
	     ((memq char '(
			   ;; comment terminator invalid
			   ?\)
			   ;; domain literal terminator invalid
			   ?\]
			   ;; \ allowed only within quoted strings,
			   ;; domain literals, and comments
			   ?\\
			   ))
	      (mail-extr-nuke-char-at (point))
	      (forward-char 1))
	     (t
	      ;; 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 ?,)
		     (eobp))
		(setq last-real-pos (point))))

	  ;; Use only the leftmost <, if any.  Replace all others with spaces.
	  (while (cdr <-pos)
	    (mail-extr-nuke-char-at (car <-pos))
	    (setq <-pos (cdr <-pos)))

	  ;; Use only the rightmost >, if any.  Replace all others with spaces.
	  (while (cdr >-pos)
	    (mail-extr-nuke-char-at (nth 1 >-pos))
	    (setcdr >-pos (nthcdr 2 >-pos)))

	  ;; If multiple @s and a :, but no < and >, insert around buffer.
	  ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc
	  ;; This commonly happens on the UUCP "From " line.  Ugh.
	  (when (and (> (length @-pos) 1)
		      (eq 1 (length colon-pos))	;TODO: check if between last two @s
		      (not \;-pos)
		      (not <-pos))
	    (goto-char (point-min))
	    (delete-char 1)
	    (setq <-pos (list (point)))
	    (insert ?<))

	  ;; If < but no >, insert > in rightmost possible position
	  (when (and <-pos (null >-pos))
	    (goto-char (point-max))
	    (setq >-pos (list (point)))
	    (insert ?>))

	  ;; If > but no <, replace > with space.
	  (when (and >-pos (null <-pos))
	    (mail-extr-nuke-char-at (car >-pos))
	    (setq >-pos nil))

	  ;; Turn >-pos and <-pos into non-lists
	  (setq >-pos (car >-pos)
		<-pos (car <-pos))

	  ;; Trim other punctuation lists of items outside < > pair to handle
	  ;; stupid MTAs.
	  (when <-pos			; don't need to check >-pos also
	    ;; handle bozo software that violates RFC 822 by sticking
	    ;; punctuation marks outside of a < > pair
	    (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
	    ;; RFC 822 says nothing about these two outside < >, but
	    ;; remove those positions from the lists to make things
	    ;; easier.
	    (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
	    (mail-extr-nuke-outside-range %-pos <-pos >-pos t))

	  ;; Check for : that indicates GROUP list and for : part of
	  ;; ROUTE-ADDR spec.
	  ;; Can't possibly be more than two :.  Nuke any extra.
	  (while colon-pos
	    (setq temp (car colon-pos)
		  colon-pos (cdr colon-pos))
	    (cond ((and <-pos >-pos
			(> temp <-pos)
			(< temp >-pos))
		   (if (or route-addr-:-pos
			   (< (length @-pos) 2)
			   (> temp (car @-pos))
			   (< temp (nth 1 @-pos)))
		       (mail-extr-nuke-char-at temp)
		     (setq route-addr-:-pos temp)))
		  ((or (not <-pos)
		       (and <-pos
			    (< temp <-pos)))
		   (setq group-:-pos temp))))

	  ;; Nuke any ; that is in or to the left of a < > pair or to the left
	  ;; of a GROUP starting :.  Also, there may only be one ;.
	  (while \;-pos
	    (setq temp (car \;-pos)
		  \;-pos (cdr \;-pos))
	    (cond ((and <-pos >-pos
			(> temp <-pos)
			(< temp >-pos))
		   (mail-extr-nuke-char-at temp))
		  ((and (or (not group-:-pos)
			    (> temp group-:-pos))
			(not group-\;-pos))
		   (setq group-\;-pos temp))))

	  ;; Nuke unmatched GROUP syntax characters.
	  (when (and group-:-pos (not group-\;-pos))
	    ;; *** Do I really need to erase it?
	    (mail-extr-nuke-char-at group-:-pos)
	    (setq group-:-pos nil))
	  (when (and group-\;-pos (not group-:-pos))
	    ;; *** Do I really need to erase it?
	    (mail-extr-nuke-char-at group-\;-pos)
	    (setq group-\;-pos nil))

	  ;; Handle junk like ";@host.company.dom" that sendmail adds.
	  ;; **** should I remember comment positions?
	  (when group-\;-pos
	    ;; this is fine for now
	    (mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t)
	    (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t)
	    (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t)
	    (mail-extr-nuke-outside-range comma-pos group-:-pos group-\;-pos t)
	    (and last-real-pos
		 (> last-real-pos (1+ group-\;-pos))
		 (setq last-real-pos (1+ group-\;-pos)))
	    ;; *** This may be wrong:
	    (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
		       quote-beg nil))
	    ;; This was both wrong and unnecessary:
	    ;;(narrow-to-region (point-min) group-\;-pos)

	    ;; *** The entire handling of GROUP addresses seems rather lame.
	    ;; *** It deserves a complete rethink, except that these addresses
	    ;; *** are hardly ever seen.
	    )

	  ;; Any commas must be between < and : of ROUTE-ADDR.  Nuke any
	  ;; others.
	  ;; Hell, go ahead and nuke all of the commas.
	  ;; **** This will cause problems when we start handling commas in
	  ;; the PHRASE part .... no it won't ... yes it will ... ?????
	  (mail-extr-nuke-outside-range comma-pos 1 1)

	  ;; can only have multiple @s inside < >.  The fact that some MTAs
	  ;; put de-bracketed ROUTE-ADDRs in the UUCP-style "From " line is
	  ;; handled above.

	  ;; Locate PHRASE part of ROUTE-ADDR.
	  (when <-pos
	    (goto-char <-pos)
	    (mail-extr-skip-whitespace-backward)
	    (setq phrase-end (point))
	    (goto-char (or ;;group-:-pos
			(point-min)))
	    (mail-extr-skip-whitespace-forward)
	    (if (< (point) phrase-end)
		(setq phrase-beg (point))
	      (setq phrase-end nil)))

	  ;; handle ROUTE-ADDRS with real ROUTEs.
	  ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and
	  ;; any % or ! must be semantically meaningless.
	  ;; TODO: do this processing into canonicalization buffer
	  (when route-addr-:-pos
	    (setq !-pos nil
		  %-pos nil
		  >-pos (copy-marker >-pos)
		  route-addr-:-pos (copy-marker route-addr-:-pos))
	    (goto-char >-pos)
	    (insert-before-markers ?X)
	    (goto-char (car @-pos))
	    (while (setq @-pos (cdr @-pos))
	      (delete-char 1)
	      (setq %-pos (cons (point-marker) %-pos))
	      (insert "%")
	      (goto-char (1- >-pos))
	      (save-excursion
		(insert-buffer-substring extraction-buffer
					 (car @-pos) route-addr-:-pos)
		(delete-region (car @-pos) route-addr-:-pos))
	      (or (cdr @-pos)
		  (setq saved-@-pos (list (point)))))
	    (setq @-pos saved-@-pos)
	    (goto-char >-pos)
	    (delete-char -1)
	    (mail-extr-nuke-char-at route-addr-:-pos)
	    (mail-extr-demarkerize route-addr-:-pos)
	    (setq route-addr-:-pos nil
		  >-pos (mail-extr-demarkerize >-pos)
		  %-pos (mapcar 'mail-extr-demarkerize %-pos)))

	  ;; de-listify @-pos
	  (setq @-pos (car @-pos))

	  ;; TODO: remove comments in the middle of an address

	  (with-current-buffer canonicalization-buffer
	    (widen)
	    (erase-buffer)
	    (insert-buffer-substring extraction-buffer)

	    (if <-pos
		(narrow-to-region (progn
				    (goto-char (1+ <-pos))
				    (mail-extr-skip-whitespace-forward)
				    (point))
				  >-pos)
	      (if (and first-real-pos last-real-pos)
		  (narrow-to-region first-real-pos last-real-pos)
		;; ****** Oh no!  What if the address is completely empty!
		;; *** Is this correct?
		(narrow-to-region (point-max) (point-max))))

	    (and @-pos %-pos
		 (mail-extr-nuke-outside-range %-pos (point-min) @-pos))
	    (and %-pos !-pos
		 (mail-extr-nuke-outside-range !-pos (point-min) (car %-pos)))
	    (and @-pos !-pos (not %-pos)
		 (mail-extr-nuke-outside-range !-pos (point-min) @-pos))

	    ;; Error condition:?? (and %-pos (not @-pos))

	    ;; WARNING: THIS CODE IS DUPLICATED BELOW.
	    (when (and %-pos (not @-pos))
	      (goto-char (car %-pos))
	      (delete-char 1)
	      (setq @-pos (point))
	      (insert "@")
	      (setq %-pos (cdr %-pos)))

	    (when (and mail-extr-mangle-uucp !-pos)
	      ;; **** I don't understand this save-restriction and the
	      ;; narrow-to-region inside it.  Why did I do that?
	      (save-restriction
		(cond ((and @-pos
			    mail-extr-@-binds-tighter-than-!)
		       (goto-char @-pos)
		       (setq %-pos (cons (point) %-pos)
			     @-pos nil)
		       (delete-char 1)
		       (insert "%")
		       (setq insert-point (point-max)))
		      (mail-extr-@-binds-tighter-than-!
		       (setq insert-point (point-max)))
		      (%-pos
		       (setq insert-point (car (last %-pos))
			     saved-%-pos (mapcar 'mail-extr-markerize %-pos)
			     %-pos nil
			     @-pos (mail-extr-markerize @-pos)))
		      (@-pos
		       (setq insert-point @-pos)
		       (setq @-pos (mail-extr-markerize @-pos)))
		      (t
		       (setq insert-point (point-max))))
		(narrow-to-region (point-min) insert-point)
		(setq saved-!-pos (car !-pos))
		(while !-pos
		  (goto-char (point-max))
		  (cond ((and (not @-pos)
			      (not (cdr !-pos)))
			 (setq @-pos (point))
			 (insert-before-markers "@ "))
			(t
			 (setq %-pos (cons (point) %-pos))
			 (insert-before-markers "% ")))
		  (backward-char 1)
		  (insert-buffer-substring
		   (current-buffer)
		   (if (nth 1 !-pos)
		       (1+ (nth 1 !-pos))
		     (point-min))
		   (car !-pos))
		  (delete-char 1)
		  (or (save-excursion
			(mail-extr-safe-move-sexp -1)
			(mail-extr-skip-whitespace-backward)
			(eq ?. (preceding-char)))
		      (insert-before-markers
		       (if (save-excursion
			     (mail-extr-skip-whitespace-backward)
			     (eq ?. (preceding-char)))
			   ""
			 ".")
		       "uucp"))
		  (setq !-pos (cdr !-pos))))
	      (and saved-%-pos
		   (setq %-pos (append (mapcar 'mail-extr-demarkerize
					       saved-%-pos)
				       %-pos)))
	      (setq @-pos (mail-extr-demarkerize @-pos))
	      (narrow-to-region (1+ saved-!-pos) (point-max)))

	    ;; WARNING: THIS CODE IS DUPLICATED ABOVE.
	    (when (and %-pos (not @-pos))
	      (goto-char (car %-pos))
	      (delete-char 1)
	      (setq @-pos (point))
	      (insert "@")
	      (setq %-pos (cdr %-pos)))

	    (when (setq %-pos (nreverse %-pos))	; implies @-pos valid
	      (setq temp %-pos)
	      (catch 'truncated
		(while temp
		  (goto-char (or (nth 1 temp)
				 @-pos))
		  (mail-extr-skip-whitespace-backward)
		  (save-excursion
		    (mail-extr-safe-move-sexp -1)
		    (setq domain-pos (point))
		    (mail-extr-skip-whitespace-backward)
		    (setq \.-pos (eq ?. (preceding-char))))
		  (when (and \.-pos
			     ;; #### string consing
                             (gethash (buffer-substring domain-pos (point))
                                      mail-extr-all-top-level-domains))
		    (narrow-to-region (point-min) (point))
		    (goto-char (car temp))
		    (delete-char 1)
		    (setq @-pos (point))
		    (setcdr temp nil)
		    (setq %-pos (delq @-pos %-pos))
		    (insert "@")
		    (throw 'truncated t))
		  (setq temp (cdr temp)))))
	    (setq mbox-beg (point-min)
		  mbox-end (if %-pos (car %-pos)
			     (or @-pos
				 (point-max))))

	    (when @-pos
	      ;; Make the domain-name part lowercase since it's case
	      ;; insensitive anyway.
	      (downcase-region (1+ @-pos) (point-max))))

	  ;; Done canonicalizing address.
	  ;; We are now back in extraction-buffer.

	  ;; Decide what part of the address to search to find the full name.
	  (cond (
		 ;; Example: "First M. Last" <fml@foo.bar.dom>
		 (and phrase-beg
		      (eq quote-beg phrase-beg)
		      (<= quote-end phrase-end))
		 (narrow-to-region (1+ quote-beg) (1- quote-end))
		 (mail-extr-undo-backslash-quoting (point-min) (point-max)))

		;; Example: First Last <fml@foo.bar.dom>
		(phrase-beg
		 (narrow-to-region phrase-beg phrase-end))

		;; Example: fml@foo.bar.dom (First M. Last)
		(mailextr-cbeg
		 (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend))
		 (mail-extr-undo-backslash-quoting (point-min) (point-max))

		 ;; Deal with spacing problems
		 (goto-char (point-min))
;;;	     (cond ((not (search-forward " " nil t))
;;;		    (goto-char (point-min))
;;;		    (cond ((search-forward "_" nil t)
;;;			   ;; Handle the *idiotic* use of underlines as spaces.
;;;			   ;; Example: fml@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@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))))))
		 )

		;; Otherwise we try to get the name from the mailbox portion
		;; of the address.
		;; Example: First_M_Last@foo.bar.dom
		(t
		 ;; *** Work in canon buffer instead?  No, can't.  Hmm.
		 (goto-char (point-max))
		 (narrow-to-region (point) (point))
		 (insert-buffer-substring canonicalization-buffer
					  mbox-beg mbox-end)
		 (goto-char (point-min))

		 ;; Example: First_Last.XXX@foo.bar.dom
		 (setq \.-ends-name (re-search-forward "[_0-9]" nil t))

		 (goto-char (point-min))

		 (if (not mail-extr-mangle-uucp)
		     (modify-syntax-entry ?! "w" (syntax-table)))

		 (while (progn
			  (mail-extr-skip-whitespace-forward)
			  (not (eobp)))
		   (setq char (char-after (point)))
		   (cond
		    ((eq char ?\")
		     (setq quote-beg (point))
		     (or (mail-extr-safe-move-sexp 1)
			 ;; TODO: handle this error condition!!!!!
			 (forward-char 1))
		     ;; take into account deletions
		     (setq quote-end (- (point) 2))
		     (save-excursion
		       (backward-char 1)
		       (delete-char 1)
		       (goto-char quote-beg)
		       (or (eobp)
			   (delete-char 1)))
		     (mail-extr-undo-backslash-quoting quote-beg quote-end)
		     (or (eq ?\  (char-after (point)))
			 (insert " "))
		     ;;		 (setq mailbox-name-processed-flag t)
		     (setq \.-ends-name t))
		    ((eq char ?.)
		     (if (memq (char-after (1+ (point))) '(?_ ?=))
			 (progn
			   (forward-char 1)
			   (delete-char 1)
			   (insert ?\ ))
		       (if \.-ends-name
			   (narrow-to-region (point-min) (point))
			 (delete-char 1)
			 (insert " ")))
		     ;;		 (setq mailbox-name-processed-flag t)
		     )
		    ((memq (char-syntax char) '(?. ?\\))
		     (delete-char 1)
		     (insert " ")
		     ;;		 (setq mailbox-name-processed-flag t)
		     )
		    (t
		     (setq atom-beg (point))
		     (forward-word) ; (forward-word-strictly 1)
		     (setq atom-end (point))
		     (goto-char atom-beg)
		     (save-restriction
		       (narrow-to-region atom-beg atom-end)
		       (cond

			;; Handle X.400 addresses encoded in RFC-822.
			;; *** Shit!  This has to handle the case where it is
			;; *** embedded in a quote too!
			;; *** Shit!  The input is being broken up into atoms
			;; *** by periods!
			((looking-at mail-extr-x400-encoded-address-pattern)

			 ;; Copy the contents of the individual fields that
			 ;; might hold name data to the beginning.
			 (mapc
			  (lambda (field-pattern)
			    (when
				(save-excursion
				  (re-search-forward field-pattern nil t))
			      (insert-buffer-substring (current-buffer)
						       (match-beginning 1)
						       (match-end 1))
			      (insert " ")))
			  (list mail-extr-x400-encoded-address-given-name-pattern
				mail-extr-x400-encoded-address-surname-pattern
				mail-extr-x400-encoded-address-full-name-pattern))

			 ;; Discard the rest, since it contains stuff like
			 ;; routing information, not part of a name.
			 (mail-extr-skip-whitespace-backward)
			 (delete-region (point) (point-max))

			 ;; Handle periods used for spacing.
			 (while (re-search-forward mail-extr-bad-dot-pattern nil t)
			   (replace-match "\\1 \\2" t))

			 ;;		     (setq mailbox-name-processed-flag t)
			 )

			;; Handle normal addresses.
			(t
			 (goto-char (point-min))
			 ;; Handle _ and = used for spacing.
			 (while (re-search-forward "\\([^_=]+\\)[_=]" nil t)
			   (replace-match "\\1 " t)
			   ;;		       (setq mailbox-name-processed-flag t)
			   )
			 (goto-char (point-max))))))))

		 ;; undo the dirty deed
		 (if (not mail-extr-mangle-uucp)
		     (modify-syntax-entry ?! "." (syntax-table)))
		 ;;
		 ;; If we derived the name from the mailbox part of the address,
		 ;; and we only got one word out of it, don't treat that as a
		 ;; name.  "foo@bar" --> (nil "foo@bar"), not ("foo" "foo@bar")
		 ;; (if (not mailbox-name-processed-flag)
		 ;;     (delete-region (point-min) (point-max)))
		 ))

	  (set-syntax-table mail-extr-address-text-syntax-table)

	  (mail-extr-voodoo mbox-beg mbox-end canonicalization-buffer)
	  (goto-char (point-min))

	  ;; If name is "First Last" and userid is "F?L", then assume
	  ;; the middle initial is the second letter in the userid.
	  ;; Initial code by Jamie Zawinski <jwz@lucid.com>
	  ;; *** Make it work when there's a suffix as well.
	  (goto-char (point-min))
	  (when (and mail-extr-guess-middle-initial
		     (not disable-initial-guessing-flag)
		     (eq 3 (- mbox-end mbox-beg))
		     (progn
		       (goto-char (point-min))
		       (looking-at mail-extr-two-name-pattern)))
	    (setq fi (char-after (match-beginning 0))
		  li (char-after (match-beginning 3)))
	    (with-current-buffer canonicalization-buffer
	      ;; char-equal is ignoring case here, so no need to upcase
	      ;; or downcase.
	      (let ((case-fold-search t))
		(and (char-equal fi (char-after mbox-beg))
		     (char-equal li (char-after (1- mbox-end)))
		     (setq mi (char-after (1+ mbox-beg))))))
	    (when (and mi
		       ;; TODO: use better table than syntax table
		       (eq ?w (char-syntax mi)))
	      (goto-char (match-beginning 3))
	      (insert (upcase mi) ". ")))

	  ;; Nuke name if it is the same as mailbox name.
          (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))
	  (and mail-extr-ignore-single-names
	       (not (re-search-forward "[- ]" nil t))
	       (narrow-to-region (point) (point)))

	  ;; Record the result
	  (setq value-list
		(cons (list (if (not (= (point-min) (point-max)))
				(buffer-string))
			    (with-current-buffer canonicalization-buffer
			      (if (not (= (point-min) (point-max)))
				  (buffer-string))))
		      value-list))

	  ;; Unless one address is all we wanted,
	  ;; delete this one from extraction-buffer
	  ;; and get ready to extract the next address.
	  (when all
	    (if end-of-address
		(narrow-to-region 1 end-of-address)
	      (widen))
	    (delete-region (point-min) (point-max))
	    (widen))
	  )))
    (if all (nreverse value-list) (car value-list))
    ))

(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)

(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)

	;; 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))))))

	;; This was moved above.
	;; Fix . used as space
	;; But it belongs here because it occurs not only as
	;;   rypens@reks.uia.ac.be (Piet.Rypens)
	;; but also as
	;;   "Piet.Rypens" <rypens@reks.uia.ac.be>
	;;(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@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@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)

	  (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@xerox.com into foo@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)))

	;; 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))
	))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Table of top-level domain names.
;;
;; This is used during address canonicalization; be careful of format changes.
;; Keep in mind that the country abbreviations follow ISO-3166.  There is
;; a U.S. FIPS that specifies a different set of two-letter country
;; abbreviations.
;;
;; Updated by the RIPE Network Coordination Centre.
;;
;; Data last taken from IANA 2017-03-22, the following URL:
;; https://www.iana.org/domains/root/db
;;
;; In general the Wikipedia data seems to be better these days; e.g. the IANA
;; data often gives the name of a company that doesn't give any indication as
;; to the intended or actual use of the domain.

(defconst mail-extr-all-top-level-domains
    ((macro
      . (lambda (&rest details)
          (let ((ob (make-hash-table :test 'equal))
                (transform
                 (if (and (featurep 'mule) (not (featurep 'xemacs)))
                     #'(lambda (string)
                         ;; Sigh, good old GNU and its unibyte strings, which
                         ;; conflict with the ASCII escapes we're using to
                         ;; avoid problems with non-Mule XEmacs:
                         (decode-coding-string string 'iso-8859-1))
                   #'identity)))
            (mapc
             (lambda (x)
               (puthash (downcase (car x))
                        (funcall transform
                                 (if (find ?% (nth 2 x))
                                     (format (nth 2 x) (nth 1 x))
                                   (nth 1 x)))
                        ob))
             details)
            ob)))
     ;; ISO 3166 codes:
     ("ac" "Ascension Island")
     ("ad" "Andorra")
     ("ae" "United Arab Emirates")
     ("af" "Afghanistan")
     ("ag" "Antigua and Barbuda")
     ("ai" "Anguilla")
     ("al" "Albania")
     ("am" "Armenia")
     ("an" "Netherlands Antilles")
     ("ao" "Angola")
     ("aq" "Antarctica")		; continent
     ("ar" "Argentina"	"Argentine Republic")
     ("as" "American Samoa")
     ("at" "Austria"		"The Republic of %s")
     ("au" "Australia")
     ("aw" "Aruba")
     ("ax" "Aland Islands")
     ("az" "Azerbaijan")
     ("ba" "Bosnia-Herzegovina")
     ("bb" "Barbados")
     ("bd" "Bangladesh")
     ("be" "Belgium"		"The Kingdom of %s")
     ("bf" "Burkina Faso")
     ("bg" "Bulgaria")
     ("bh" "Bahrain")
     ("bi" "Burundi")
     ("bj" "Benin")
     ("bl" "Saint Barthelemy")
     ("bm" "Bermuda")
     ("bn" "Brunei Darussalam")
     ("bo" "Bolivia"		"Republic of %s")
     ("br" "Brazil"		"The Federative Republic of %s")
     ("bs" "Bahamas")
     ("bt" "Bhutan")
     ("bv" "Bouvet Island")
     ("bw" "Botswana")
     ("by" "Belarus")
     ("bz" "Belize")
     ("ca" "Canada")
     ("cc" "Cocos (Keeling) Islands")
     ("cd" "Congo"            "The Democratic Republic of the %s")
     ("cf" "Central African Republic")
     ("cg" "Congo")
     ("ch" "Switzerland"	"The Swiss Confederation")
     ("ci" "Ivory Coast")		; Cote D'ivoire
     ("ck" "Cook Islands")
     ("cl" "Chile"		"The Republic of %s")
     ("cm" "Cameroon")		; In .fr domain
     ("cn" "China"		"The People's Republic of %s")
     ("co" "Colombia")
     ("cr" "Costa Rica"	"The Republic of %s")
     ("cu" "Cuba")
     ("cv" "Cape Verde")
     ("cw" "Cura\347\343o")
     ("cx" "Christmas Island")
     ("cy" "Cyprus")
     ("cz" "Czech Republic")
     ("de" "Germany")
     ("dj" "Djibouti")
     ("dk" "Denmark")
     ("dm" "Dominica")
     ("do" "Dominican Republic"	"The %s")
     ("dz" "Algeria")
     ("ec" "Ecuador"		"The Republic of %s")
     ("ee" "Estonia")
     ("eg" "Egypt"		"The Arab Republic of %s")
     ("eh" "Western Sahara")
     ("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)")
     ("fm" "Micronesia"	"Federated States of %s")
     ("fo" "Faroe Islands")
     ("fr" "France")
     ("ga" "Gabon")
     ("gb" "United Kingdom")
     ("gd" "Grenada")
     ("ge" "Georgia")
     ("gf" "French Guiana")
     ("gg" "Guernsey")
     ("gh" "Ghana")
     ("gi" "Gibraltar")
     ("gl" "Greenland")
     ("gm" "Gambia")
     ("gn" "Guinea")
     ("gp" "Guadeloupe (Fr.)")
     ("gq" "Equatorial Guinea")
     ("gr" "Greece"		"The Hellenic Republic (%s)")
     ("gs" "South Georgia and The South Sandwich Islands")
     ("gt" "Guatemala")
     ("gu" "Guam (U.S.)")
     ("gw" "Guinea-Bissau")
     ("gy" "Guyana")
     ("hk" "Hong Kong")
     ("hm" "Heard Island and McDonald Islands")
     ("hn" "Honduras")
     ("hr" "Croatia"		"Croatia (Hrvatska)")
     ("ht" "Haiti")
     ("hu" "Hungary"		"The Hungarian Republic")
     ("id" "Indonesia")
     ("ie" "Ireland")
     ("il" "Israel"		"The State of %s")
     ("im" "Isle of Man"	"The %s") ; NOT in ISO 3166-1 of 2001-02-26
     ("in" "India"		"The Republic of %s")
     ("io" "British Indian Ocean Territory")
     ("iq" "Iraq")
     ("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")
     ("ke" "Kenya")
     ("kg" "Kyrgyzstan")
     ("kh" "Cambodia")
     ("ki" "Kiribati")
     ("km" "Comoros")
     ("kn" "Saint Kitts and Nevis")
     ("kp" "Korea (North)"	"Democratic People's Republic of Korea")
     ("kr" "Korea (South)"	"Republic of Korea")
     ("kw" "Kuwait")
     ("ky" "Cayman Islands")
     ("kz" "Kazakhstan")
     ("la" "Lao People's Democratic Republic")
     ("lb" "Lebanon")
     ("lc" "Saint Lucia")
     ("li" "Liechtenstein")
     ("lk" "Sri Lanka"	"The Democratic Socialist Republic of %s")
     ("lr" "Liberia")
     ("ls" "Lesotho")
     ("lt" "Lithuania")
     ("lu" "Luxembourg")
     ("lv" "Latvia")
     ("ly" "Libyan Arab Jamahiriya")
     ("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")
     ("ml" "Mali")
     ("mm" "Myanmar")
     ("mn" "Mongolia")
     ("mo" "Macao")
     ("mp" "Northern Mariana Islands")
     ("mq" "Martinique")
     ("mr" "Mauritania")
     ("ms" "Montserrat")
     ("mt" "Malta")
     ("mu" "Mauritius")
     ("mv" "Maldives")
     ("mw" "Malawi")
     ("mx" "Mexico"		"The United Mexican States")
     ("my" "Malaysia")
     ("mz" "Mozambique")
     ("na" "Namibia")
     ("nc" "New Caledonia (Fr.)")
     ("ne" "Niger")			; In .fr domain
     ("nf" "Norfolk Island")
     ("ng" "Nigeria")
     ("ni" "Nicaragua"	"The Republic of %s")
     ("nl" "Netherlands"	"The Kingdom of the %s")
     ("no" "Norway"		"The Kingdom of %s")
     ("np" "Nepal")			; Via .in domain
     ("nr" "Nauru")
     ("nu" "Niue")
     ("nz" "New Zealand")
     ("om" "Oman")
     ("pa" "Panama")
     ("pe" "Peru")
     ("pf" "French Polynesia")
     ("pg" "Papua New Guinea")
     ("ph" "Philippines"	"The Republic of the %s")
     ("pk" "Pakistan")
     ("pl" "Poland")
     ("pm" "Saint Pierre and Miquelon")
     ("pn" "Pitcairn")
     ("pr" "Puerto Rico (U.S.)")
     ("ps" "Palestinian Territory, Occupied")
     ("pt" "Portugal"		"The Portuguese Republic")
     ("pw" "Palau")
     ("py" "Paraguay")
     ("qa" "Qatar")
     ("re" "Reunion (Fr.)")		; In .fr domain
     ("ro" "Romania")
     ("rs" "Serbia")
     ("ru" "Russia"		"Russian Federation")
     ("rw" "Rwanda")
     ("sa" "Saudi Arabia")
     ("sb" "Solomon Islands")
     ("sc" "Seychelles")
     ("sd" "Sudan")
     ("se" "Sweden"		"The Kingdom of %s")
     ("sg" "Singapore"	"The Republic of %s")
     ("sh" "Saint Helena")
     ("si" "Slovenia")
     ("sj" "Svalbard and Jan Mayen")    ; In .no domain
     ("sk" "Slovakia"		"The Slovak Republic")
     ("sl" "Sierra Leone")
     ("sm" "San Marino")
     ("sn" "Senegal")
     ("so" "Somalia")
     ("sr" "Suriname")
     ("st" "Sao Tome and Principe")
     ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
     ("sv" "El Salvador")
     ("sx" "Sint Maarten")
     ("sy" "Syrian Arab Republic")
     ("sz" "Swaziland")
     ("tc" "Turks and Caicos Islands")
     ("td" "Chad")
     ("tf" "French Southern Territories")
     ("tg" "Togo")
     ("th" "Thailand"		"The Kingdom of %s")
     ("tj" "Tajikistan")
     ("tk" "Tokelau")
     ("tl" "East Timor")
     ("tm" "Turkmenistan")
     ("tn" "Tunisia")
     ("to" "Tonga")
     ("tp" "East Timor")
     ("tr" "Turkey"		"The Republic of %s")
     ("tt" "Trinidad and Tobago")
     ("tv" "Tuvalu")
     ("tw" "Taiwan"		"%s, Province of China")
     ("tz" "Tanzania"		"United Republic of %s")
     ("ua" "Ukraine")
     ("ug" "Uganda")
     ("uk" "United Kingdom"	"The %s of Great Britain and Northern Ireland")
     ("um" "United States Minor Outlying Islands")
     ("us" "United States"	"The %s of America")
     ("uy" "Uruguay"		"The Eastern Republic of %s")
     ("uz" "Uzbekistan")
     ("va" "Holy See (Vatican City State)")
     ("vc" "Saint Vincent and the Grenadines")
     ("ve" "Venezuela"	"The Republic of %s")
     ("vg" "Virgin Islands, British")
     ("vi" "Virgin Islands, U.S.")
     ("vn" "Vietnam")
     ("vu" "Vanuatu")
     ("wf" "Wallis and Futuna")
     ("ws" "Samoa")
     ("ye" "Yemen")
     ("yt" "Mayotte")
     ("yu" "Yugoslavia"	"Yugoslavia, AKA Serbia-Montenegro")
     ("za" "South Africa"	"The Republic of %s")
     ("zm" "Zambia")
     ("zw" "Zimbabwe"		"Republic of %s")
     ;; Generic Domains:
     ("aero" "Air Transport Industry")
     ("asia" "Pan-Asia and Asia Pacific community")
     ("biz" "Businesses")
     ("cat" "Catalan language and culture")
     ("com" "Commercial")
     ("coop" "Cooperative Associations")
     ("info" "Info")
     ("jobs" "Employment")
     ("mobi" "Mobile products")
     ("museum" "Museums")
     ("name" "Individuals")
     ("net" "Network")
     ("org" "Non-profit Organization")
     ("pro" "Credentialed professionals")
     ("tel" "Contact data")
     ("travel" "Travel industry")
     ;;("bitnet" "Because It's Time NET")
     ("gov" "United States Government")
     ("edu" "Educational")
     ("mil" "United States Military")
     ("int" "International Treaties")
     ;;("nato" "North Atlantic Treaty Organization")
     ("uucp" "Unix to Unix CoPy")
     ;; Infrastructure Domains:
     ("arpa" "Advanced Research Projects Agency (U.S. DoD)")

     ;; Generic codes
     ("aaa" "American Automobile Association, Inc.")
     ("aarp" "AARP")
     ("abarth" "Fiat Chrysler Automobiles N.V.")
     ("abb" "ABB Ltd")
     ("abbott" "Abbott Laboratories, Inc.")
     ("abbvie" "AbbVie Inc.")
     ("abc" "Disney Enterprises, Inc.")
     ("able" "Able Inc.")
     ("abogado" "Top Level Domain Holdings Limited")
     ("abudhabi" "Abu Dhabi Systems and Information Centre")
     ("academy" "Half Oaks, LLC")
     ("accenture" "Accenture plc")
     ("accountant" "dot Accountant Limited")
     ("accountants" "Knob Town, LLC")
     ("aco" "ACO Severin Ahlmann GmbH & Co. KG")
     ("active" "Active Network, LLC")
     ("actor" "United TLD Holdco Ltd.")
     ("adac" "Allgemeiner Deutscher Automobil-Club e.V. (ADAC)")
     ("ads" "Charleston Road Registry Inc.")
     ("adult" "ICM Registry AD LLC")
     ("aeg" "Aktiebolaget Electrolux")
     ("aetna" "Aetna Life Insurance Company")
     ("afamilycompany" "Johnson Shareholdings, Inc.")
     ("afl" "Australian Football League")
     ("africa" "ZA Central Registry NPC trading as Registry.Africa")
     ("agakhan" "Fondation Aga Khan (Aga Khan Foundation)")
     ("agency" "Steel Falls, LLC")
     ("aig" "American International Group, Inc.")
     ("aigo" "aigo Digital Technology Co,Ltd.")
     ("airbus" "Airbus S.A.S.")
     ("airforce" "United TLD Holdco Ltd.")
     ("airtel" "Bharti Airtel Limited")
     ("akdn" "Fondation Aga Khan (Aga Khan Foundation)")
     ("alfaromeo" "Fiat Chrysler Automobiles N.V.")
     ("alibaba" "Alibaba Group Holding Limited")
     ("alipay" "Alibaba Group Holding Limited")
     ("allfinanz" "Allfinanz Deutsche Verm\xf6gensberatung Aktiengesellschaft")
     ("allstate" "Allstate Fire and Casualty Insurance Company")
     ("ally" "Ally Financial Inc.")
     ("alsace" "REGION GRAND EST")
     ("alstom" "ALSTOM")
     ("americanexpress" "American Express Travel Related Services Company, Inc.")
     ("americanfamily" "AmFam, Inc.")
     ("amex" "American Express Travel Related Services Company, Inc.")
     ("amfam" "AmFam, Inc.")
     ("amica" "Amica Mutual Insurance Company")
     ("amsterdam" "Gemeente Amsterdam")
     ("analytics" "Campus IP LLC")
     ("android" "Charleston Road Registry Inc.")
     ("anquan" "QIHOO 360 TECHNOLOGY CO. LTD.")
     ("anz" "Australia and New Zealand Banking Group Limited")
     ("aol" "AOL Inc.")
     ("apartments" "June Maple, LLC")
     ("app" "Charleston Road Registry Inc.")
     ("apple" "Apple Inc.")
     ("aquarelle" "Aquarelle.com")
     ("aramco" "Aramco Services Company")
     ("archi" "STARTING DOT LIMITED")
     ("army" "United TLD Holdco Ltd.")
     ("art" "UK Creative Ideas Limited")
     ("arte" "Association Relative \340 la T\351l\351vision Europ\351enne G.E.I.E.")
     ("asda" "Wal-Mart Stores, Inc.")
     ("associates" "Baxter Hill, LLC")
     ("athleta" "The Gap, Inc.")
     ("attorney" "United TLD Holdco, Ltd")
     ("auction" "United TLD HoldCo, Ltd.")
     ("audi" "AUDI Aktiengesellschaft")
     ("audible" "Amazon Registry Services, Inc.")
     ("audio" "Uniregistry, Corp.")
     ("auspost" "Australian Postal Corporation")
     ("author" "Amazon Registry Services, Inc.")
     ("auto" "Cars Registry Limited")
     ("autos" "DERAutos, LLC")
     ("avianca" "Aerovias del Continente Americano S.A. Avianca")
     ("aws" "Amazon Registry Services, Inc.")
     ("axa" "AXA SA")
     ("azure" "Microsoft Corporation")
     ("baby" "Johnson & Johnson Services, Inc.")
     ("baidu" "Baidu, Inc.")
     ("banamex" "Citigroup Inc.")
     ("bananarepublic" "The Gap, Inc.")
     ("band" "United TLD Holdco, Ltd")
     ("bank" "fTLD Registry Services, LLC")
     ("bar" "Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable")
     ("barcelona" "Municipi de Barcelona")
     ("barclaycard" "Barclays Bank PLC")
     ("barclays" "Barclays Bank PLC")
     ("barefoot" "Gallo Vineyards, Inc.")
     ("bargains" "Half Hallow, LLC")
     ("baseball" "MLB Advanced Media DH, LLC")
     ("basketball" "F\351d\351ration Internationale de Basketball (FIBA)")
     ("bauhaus" "Werkhaus GmbH")
     ("bayern" "Bayern Connect GmbH")
     ("bbc" "British Broadcasting Corporation")
     ("bbt" "BB&T Corporation")
     ("bbva" "BANCO BILBAO VIZCAYA ARGENTARIA, S.A.")
     ("bcg" "The Boston Consulting Group, Inc.")
     ("bcn" "Municipi de Barcelona")
     ("beats" "Beats Electronics, LLC")
     ("beauty" "L'Or\351al")
     ("beer" "Top Level Domain Holdings Limited")
     ("bentley" "Bentley Motors Limited")
     ("berlin" "dotBERLIN GmbH & Co. KG")
     ("best" "BestTLD Pty Ltd")
     ("bestbuy" "BBY Solutions, Inc.")
     ("bet" "Afilias plc")
     ("bharti" "Bharti Enterprises (Holding) Private Limited")
     ("bible" "American Bible Society")
     ("bid" "dot Bid Limited")
     ("bike" "Grand Hollow, LLC")
     ("bing" "Microsoft Corporation")
     ("bingo" "Sand Cedar, LLC")
     ("bio" "STARTING DOT LIMITED")
     ("black" "Afilias plc")
     ("blackfriday" "Uniregistry, Corp.")
     ("blanco" "BLANCO GmbH + Co KG")
     ("blockbuster" "Dish DBS Corporation")
     ("blog" "Knock Knock WHOIS There, LLC")
     ("bloomberg" "Bloomberg IP Holdings LLC")
     ("blue" "Afilias plc")
     ("bms" "Bristol-Myers Squibb Company")
     ("bmw" "Bayerische Motoren Werke Aktiengesellschaft")
     ("bnl" "Banca Nazionale del Lavoro")
     ("bnpparibas" "BNP Paribas")
     ("boats" "DERBoats, LLC")
     ("boehringer" "Boehringer Ingelheim International GmbH")
     ("bofa" "NMS Services, Inc.")
     ("bom" "N\372cleo de Informa\347\343o e Coordena\347\343o do Ponto BR - NIC.br")
     ("bond" "Bond University Limited")
     ("boo" "Charleston Road Registry Inc.")
     ("book" "Amazon Registry Services, Inc.")
     ("booking" "Booking.com B.V.")
     ("boots" "THE BOOTS COMPANY PLC")
     ("bosch" "Robert Bosch GMBH")
     ("bostik" "Bostik SA")
     ("boston" "Boston TLD Management, LLC")
     ("bot" "Amazon Registry Services, Inc.")
     ("boutique" "Over Galley, LLC")
     ("box" "NS1 Limited")
     ("bradesco" "Banco Bradesco S.A.")
     ("bridgestone" "Bridgestone Corporation")
     ("broadway" "Celebrate Broadway, Inc.")
     ("broker" "DOTBROKER REGISTRY LTD")
     ("brother" "Brother Industries, Ltd.")
     ("brussels" "DNS.be vzw")
     ("budapest" "Top Level Domain Holdings Limited")
     ("bugatti" "Bugatti International SA")
     ("build" "Plan Bee LLC")
     ("builders" "Atomic Madison, LLC")
     ("business" "Spring Cross, LLC")
     ("buy" "Amazon Registry Services, INC")
     ("buzz" "DOTSTRATEGY CO.")
     ("bzh" "Association www.bzh")
     ("cab" "Half Sunset, LLC")
     ("cafe" "Pioneer Canyon, LLC")
     ("cal" "Charleston Road Registry Inc.")
     ("call" "Amazon Registry Services, Inc.")
     ("calvinklein" "PVH gTLD Holdings LLC")
     ("cam" "AC Webconnecting Holding B.V.")
     ("camera" "Atomic Maple, LLC")
     ("camp" "Delta Dynamite, LLC")
     ("cancerresearch" "Australian Cancer Research Foundation")
     ("canon" "Canon Inc.")
     ("capetown" "ZA Central Registry NPC trading as ZA Central Registry")
     ("capital" "Delta Mill, LLC")
     ("capitalone" "Capital One Financial Corporation")
     ("car" "Cars Registry Limited")
     ("caravan" "Caravan International, Inc.")
     ("cards" "Foggy Hollow, LLC")
     ("care" "Goose Cross, LLC")
     ("career" "dotCareer LLC")
     ("careers" "Wild Corner, LLC")
     ("cars" "Cars Registry Limited")
     ("cartier" "Richemont DNS Inc.")
     ("casa" "Top Level Domain Holdings Limited")
     ("case" "CNH Industrial N.V.")
     ("caseih" "CNH Industrial N.V.")
     ("cash" "Delta Lake, LLC")
     ("casino" "Binky Sky, LLC")
     ("catering" "New Falls. LLC")
     ("catholic" "Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)")
     ("cba" "COMMONWEALTH BANK OF AUSTRALIA")
     ("cbn" "The Christian Broadcasting Network, Inc.")
     ("cbre" "CBRE, Inc.")
     ("cbs" "CBS Domains Inc.")
     ("ceb" "The Corporate Executive Board Company")
     ("center" "Tin Mill, LLC")
     ("ceo" "CEOTLD Pty Ltd")
     ("cern" "European Organization for Nuclear Research (\"CERN\")")
     ("cfa" "CFA Institute")
     ("cfd" "DOTCFD REGISTRY LTD")
     ("chanel" "Chanel International B.V.")
     ("channel" "Charleston Road Registry Inc.")
     ("chase" "JPMorgan Chase Bank, National Association")
     ("chat" "Sand Fields, LLC")
     ("cheap" "Sand Cover, LLC")
     ("chintai" "CHINTAI Corporation")
     ("chloe" "Richemont DNS Inc.")
     ("christmas" "Uniregistry, Corp.")
     ("chrome" "Charleston Road Registry Inc.")
     ("chrysler" "FCA US LLC.")
     ("church" "Holly Fileds, LLC")
     ("cipriani" "Hotel Cipriani Srl")
     ("circle" "Amazon Registry Services, Inc.")
     ("cisco" "Cisco Technology, Inc.")
     ("citadel" "Citadel Domain LLC")
     ("citi" "Citigroup Inc.")
     ("citic" "CITIC Group Corporation")
     ("city" "Snow Sky, LLC")
     ("cityeats" "Lifestyle Domain Holdings, Inc.")
     ("claims" "Black Corner, LLC")
     ("cleaning" "Fox Shadow, LLC")
     ("click" "Uniregistry, Corp.")
     ("clinic" "Goose Park, LLC")
     ("clinique" "The Est\351e Lauder Companies Inc.")
     ("clothing" "Steel Lake, LLC")
     ("cloud" "ARUBA PEC S.p.A.")
     ("club" ".CLUB DOMAINS, LLC")
     ("clubmed" "Club M\351diterran\351e S.A.")
     ("coach" "Koko Island, LLC")
     ("codes" "Puff Willow, LLC")
     ("coffee" "Trixy Cover, LLC")
     ("college" "XYZ.COM LLC")
     ("cologne" "NetCologne Gesellschaft f\374r Telekommunikation mbH")
     ("comcast" "Comcast IP Holdings I, LLC")
     ("commbank" "COMMONWEALTH BANK OF AUSTRALIA")
     ("community" "Fox Orchard, LLC")
     ("company" "Silver Avenue, LLC")
     ("compare" "iSelect Ltd")
     ("computer" "Pine Mill, LLC")
     ("comsec" "VeriSign, Inc.")
     ("condos" "Pine House, LLC")
     ("construction" "Fox Dynamite, LLC")
     ("consulting" "United TLD Holdco, LTD.")
     ("contact" "Top Level Spectrum, Inc.")
     ("contractors" "Magic Woods, LLC")
     ("cooking" "Top Level Domain Holdings Limited")
     ("cookingchannel" "Lifestyle Domain Holdings, Inc.")
     ("cool" "Koko Lake, LLC")
     ("corsica" "Collectivit\351 Territoriale de Corse")
     ("country" "Top Level Domain Holdings Limited")
     ("coupon" "Amazon Registry Services, Inc.")
     ("coupons" "Black Island, LLC")
     ("courses" "OPEN UNIVERSITIES AUSTRALIA PTY LTD")
     ("credit" "Snow Shadow, LLC")
     ("creditcard" "Binky Frostbite, LLC")
     ("creditunion" "CUNA Performance Resources, LLC")
     ("cricket" "dot Cricket Limited")
     ("crown" "Crown Equipment Corporation")
     ("crs" "Federated Co-operatives Limited")
     ("cruise" "Viking River Cruises (Bermuda) Ltd.")
     ("cruises" "Spring Way, LLC")
     ("csc" "Alliance-One Services, Inc.")
     ("cuisinella" "SALM S.A.S.")
     ("cymru" "Nominet UK")
     ("cyou" "Beijing Gamease Age Digital Technology Co., Ltd.")
     ("dabur" "Dabur India Limited")
     ("dad" "Charleston Road Registry Inc.")
     ("dance" "United TLD Holdco Ltd.")
     ("data" "Dish DBS Corporation")
     ("date" "dot Date Limited")
     ("dating" "Pine Fest, LLC")
     ("datsun" "NISSAN MOTOR CO., LTD.")
     ("day" "Charleston Road Registry Inc.")
     ("dclk" "Charleston Road Registry Inc.")
     ("dds" "Minds + Machines Group Limited")
     ("deal" "Amazon Registry Services, Inc.")
     ("dealer" "Dealer Dot Com, Inc.")
     ("deals" "Sand Sunset, LLC")
     ("degree" "United TLD Holdco, Ltd")
     ("delivery" "Steel Station, LLC")
     ("dell" "Dell Inc.")
     ("deloitte" "Deloitte Touche Tohmatsu")
     ("delta" "Delta Air Lines, Inc.")
     ("democrat" "United TLD Holdco Ltd.")
     ("dental" "Tin Birch, LLC")
     ("dentist" "United TLD Holdco, Ltd")
     ("desi" "Desi Networks LLC")
     ("design" "Top Level Design, LLC")
     ("dev" "Charleston Road Registry Inc.")
     ("dhl" "Deutsche Post AG")
     ("diamonds" "John Edge, LLC")
     ("diet" "Uniregistry, Corp.")
     ("digital" "Dash Park, LLC")
     ("direct" "Half Trail, LLC")
     ("directory" "Extra Madison, LLC")
     ("discount" "Holly Hill, LLC")
     ("discover" "Discover Financial Services")
     ("dish" "Dish DBS Corporation")
     ("diy" "Lifestyle Domain Holdings, Inc.")
     ("dnp" "Dai Nippon Printing Co., Ltd.")
     ("docs" "Charleston Road Registry Inc.")
     ("doctor" "Brice Trail, LLC")
     ("dodge" "FCA US LLC.")
     ("dog" "Koko Mill, LLC")
     ("doha" "Communications Regulatory Authority (CRA)")
     ("domains" "Sugar Cross, LLC")
     ("doosan" "Retired")
     ("dot" "Dish DBS Corporation")
     ("download" "dot Support Limited")
     ("drive" "Charleston Road Registry Inc.")
     ("dtv" "Dish DBS Corporation")
     ("dubai" "Dubai Smart Government Department")
     ("duck" "Johnson Shareholdings, Inc.")
     ("dunlop" "The Goodyear Tire & Rubber Company")
     ("duns" "The Dun & Bradstreet Corporation")
     ("dupont" "E. I. du Pont de Nemours and Company")
     ("durban" "ZA Central Registry NPC trading as ZA Central Registry")
     ("dvag" "Deutsche Verm\366gensberatung Aktiengesellschaft DVAG")
     ("dvr" "Hughes Satellite Systems Corporation")
     ("earth" "Interlink Co., Ltd.")
     ("eat" "Charleston Road Registry Inc.")
     ("eco" "Big Room Inc.")
     ("edeka" "EDEKA Verband kaufm\344nnischer Genossenschaften e.V.")
     ("education" "Brice Way, LLC")
     ("email" "Spring Madison, LLC")
     ("emerck" "Merck KGaA")
     ("energy" "Binky Birch, LLC")
     ("engineer" "United TLD Holdco Ltd.")
     ("engineering" "Romeo Canyon")
     ("enterprises" "Snow Oaks, LLC")
     ("epost" "Deutsche Post AG")
     ("epson" "Seiko Epson Corporation")
     ("equipment" "Corn Station, LLC")
     ("ericsson" "Telefonaktiebolaget L M Ericsson")
     ("erni" "ERNI Group Holding AG")
     ("esq" "Charleston Road Registry Inc.")
     ("estate" "Trixy Park, LLC")
     ("esurance" "Esurance Insurance Company")
     ("eurovision" "European Broadcasting Union (EBU)")
     ("eus" "Puntueus Fundazioa")
     ("events" "Pioneer Maple, LLC")
     ("everbank" "EverBank")
     ("exchange" "Spring Falls, LLC")
     ("expert" "Magic Pass, LLC")
     ("exposed" "Victor Beach, LLC")
     ("express" "Sea Sunset, LLC")
     ("extraspace" "Extra Space Storage LLC")
     ("fage" "Fage International S.A.")
     ("fail" "Atomic Pipe, LLC")
     ("fairwinds" "FairWinds Partners, LLC")
     ("faith" "dot Faith Limited")
     ("family" "United TLD Holdco Ltd.")
     ("fan" "Asiamix Digital Ltd")
     ("fans" "Asiamix Digital Limited")
     ("farm" "Just Maple, LLC")
     ("farmers" "Farmers Insurance Exchange")
     ("fashion" "Top Level Domain Holdings Limited")
     ("fast" "Amazon Registry Services, Inc.")
     ("fedex" "Federal Express Corporation")
     ("feedback" "Top Level Spectrum, Inc.")
     ("ferrari" "Fiat Chrysler Automobiles N.V.")
     ("ferrero" "Ferrero Trading Lux S.A.")
     ("fiat" "Fiat Chrysler Automobiles N.V.")
     ("fidelity" "Fidelity Brokerage Services LLC")
     ("fido" "Rogers Communications Canada Inc.")
     ("film" "Motion Picture Domain Registry Pty Ltd")
     ("final" "N\372cleo de Informa\347\343o e Coordena\347\343o do Ponto BR - NIC.br")
     ("finance" "Cotton Cypress, LLC")
     ("financial" "Just Cover, LLC")
     ("fire" "Amazon Registry Services, Inc.")
     ("firestone" "Bridgestone Licensing Services, Inc.")
     ("firmdale" "Firmdale Holdings Limited")
     ("fish" "Fox Woods, LLC")
     ("fishing" "Top Level Domain Holdings Limited")
     ("fit" "Minds + Machines Group Limited")
     ("fitness" "Brice Orchard, LLC")
     ("flickr" "Yahoo! Domain Services Inc.")
     ("flights" "Fox Station, LLC")
     ("flir" "FLIR Systems, Inc.")
     ("florist" "Half Cypress, LLC")
     ("flowers" "Uniregistry, Corp.")
     ("flsmidth" "Retired")
     ("fly" "Charleston Road Registry Inc.")
     ("foo" "Charleston Road Registry Inc.")
     ("food" "Lifestyle Domain Holdings, Inc.")
     ("foodnetwork" "Lifestyle Domain Holdings, Inc.")
     ("football" "Foggy Farms, LLC")
     ("ford" "Ford Motor Company")
     ("forex" "DOTFOREX REGISTRY LTD")
     ("forsale" "United TLD Holdco, LLC")
     ("forum" "Fegistry, LLC")
     ("foundation" "John Dale, LLC")
     ("fox" "FOX Registry, LLC")
     ("free" "Amazon Registry Services, Inc.")
     ("fresenius" "Fresenius Immobilien-Verwaltungs-GmbH")
     ("frl" "FRLregistry B.V.")
     ("frogans" "OP3FT")
     ("frontdoor" "Lifestyle Domain Holdings, Inc.")
     ("frontier" "Frontier Communications Corporation")
     ("ftr" "Frontier Communications Corporation")
     ("fujitsu" "Fujitsu Limited")
     ("fujixerox" "Xerox DNHC LLC")
     ("fun" "DotSpace, Inc.")
     ("fund" "John Castle, LLC")
     ("furniture" "Lone Fields, LLC")
     ("futbol" "United TLD Holdco, Ltd.")
     ("fyi" "Silver Tigers, LLC")
     ("gal" "Asociaci\363n puntoGAL")
     ("gallery" "Sugar House, LLC")
     ("gallo" "Gallo Vineyards, Inc.")
     ("gallup" "Gallup, Inc.")
     ("game" "Uniregistry, Corp.")
     ("games" "United TLD Holdco Ltd.")
     ("gap" "The Gap, Inc.")
     ("garden" "Top Level Domain Holdings Limited")
     ("gbiz" "Charleston Road Registry Inc.")
     ("gdn" "Joint Stock Company \"Navigation-information systems\"")
     ("gea" "GEA Group Aktiengesellschaft")
     ("gent" "Combell nv")
     ("genting" "Resorts World Inc. Pte. Ltd.")
     ("george" "Wal-Mart Stores, Inc.")
     ("ggee" "GMO Internet, Inc.")
     ("gift" "Uniregistry, Corp.")
     ("gifts" "Goose Sky, LLC")
     ("gives" "United TLD Holdco Ltd.")
     ("giving" "Giving Limited")
     ("glade" "Johnson Shareholdings, Inc.")
     ("glass" "Black Cover, LLC")
     ("gle" "Charleston Road Registry Inc.")
     ("global" "Dot Global Domain Registry Limited")
     ("globo" "Globo Comunica\347\343o e Participa\347\365es S.A")
     ("gmail" "Charleston Road Registry Inc.")
     ("gmbh" "Extra Dynamite, LLC")
     ("gmo" "GMO Internet, Inc.")
     ("gmx" "1&1 Mail & Media GmbH")
     ("godaddy" "Go Daddy East, LLC")
     ("gold" "June Edge, LLC")
     ("goldpoint" "YODOBASHI CAMERA CO.,LTD.")
     ("golf" "Lone Falls, LLC")
     ("goo" "NTT Resonant Inc.")
     ("goodhands" "Allstate Fire and Casualty Insurance Company")
     ("goodyear" "The Goodyear Tire & Rubber Company")
     ("goog" "Charleston Road Registry Inc.")
     ("google" "Charleston Road Registry Inc.")
     ("gop" "Republican State Leadership Committee, Inc.")
     ("got" "Amazon Registry Services, Inc.")
     ("grainger" "Grainger Registry Services, LLC")
     ("graphics" "Over Madison, LLC")
     ("gratis" "Pioneer Tigers, LLC")
     ("green" "DotGreen Registry Limited")
     ("gripe" "Corn Sunset, LLC")
     ("group" "Romeo Town, LLC")
     ("guardian" "The Guardian Life Insurance Company of America")
     ("gucci" "Guccio Gucci S.p.a.")
     ("guge" "Charleston Road Registry Inc.")
     ("guide" "Snow Moon, LLC")
     ("guitars" "Uniregistry, Corp.")
     ("guru" "Pioneer Cypress, LLC")
     ("hair" "L'Oreal")
     ("hamburg" "Hamburg Top-Level-Domain GmbH")
     ("hangout" "Charleston Road Registry Inc.")
     ("haus" "United TLD Holdco, LTD.")
     ("hbo" "HBO Registry Services, Inc.")
     ("hdfc" "HOUSING DEVELOPMENT FINANCE CORPORATION LIMITED")
     ("hdfcbank" "HDFC Bank Limited")
     ("health" "DotHealth, LLC")
     ("healthcare" "Silver Glen, LLC")
     ("help" "Uniregistry, Corp.")
     ("helsinki" "City of Helsinki")
     ("here" "Charleston Road Registry Inc.")
     ("hermes" "Hermes International")
     ("hgtv" "Lifestyle Domain Holdings, Inc.")
     ("hiphop" "Uniregistry, Corp.")
     ("hisamitsu" "Hisamitsu Pharmaceutical Co.,Inc.")
     ("hitachi" "Hitachi, Ltd.")
     ("hiv" "Uniregistry, Corp.")
     ("hkt" "PCCW-HKT DataCom Services Limited")
     ("hockey" "Half Willow, LLC")
     ("holdings" "John Madison, LLC")
     ("holiday" "Goose Woods, LLC")
     ("homedepot" "Home Depot Product Authority, LLC")
     ("homegoods" "The TJX Companies, Inc.")
     ("homes" "DERHomes, LLC")
     ("homesense" "The TJX Companies, Inc.")
     ("honda" "Honda Motor Co., Ltd.")
     ("honeywell" "Honeywell GTLD LLC")
     ("horse" "Top Level Domain Holdings Limited")
     ("hospital" "Ruby Pike, LLC")
     ("host" "DotHost Inc.")
     ("hosting" "Uniregistry, Corp.")
     ("hot" "Amazon Registry Services, Inc.")
     ("hoteles" "Travel Reservations SRL")
     ("hotmail" "Microsoft Corporation")
     ("house" "Sugar Park, LLC")
     ("how" "Charleston Road Registry Inc.")
     ("hsbc" "HSBC Global Services (UK) Limited")
     ("htc" "HTC corporation")
     ("hughes" "Hughes Satellite Systems Corporation")
     ("hyatt" "Hyatt GTLD, L.L.C.")
     ("hyundai" "Hyundai Motor Company")
     ("ibm" "International Business Machines Corporation")
     ("icbc" "Industrial and Commercial Bank of China Limited")
     ("ice" "IntercontinentalExchange, Inc.")
     ("icu" "One.com A/S")
     ("ieee" "IEEE Global LLC")
     ("ifm" "ifm electronic gmbh")
     ("iinet" "Retired")
     ("ikano" "Ikano S.A.")
     ("imamat" "Fondation Aga Khan (Aga Khan Foundation)")
     ("imdb" "Amazon Registry Services, Inc.")
     ("immo" "Auburn Bloom, LLC")
     ("immobilien" "United TLD Holdco Ltd.")
     ("industries" "Outer House, LLC")
     ("infiniti" "NISSAN MOTOR CO., LTD.")
     ("ing" "Charleston Road Registry Inc.")
     ("ink" "Top Level Design, LLC")
     ("institute" "Outer Maple, LLC")
     ("insurance" "fTLD Registry Services LLC")
     ("insure" "Pioneer Willow, LLC")
     ("intel" "Intel Corporation")
     ("international" "Wild Way, LLC")
     ("intuit" "Intuit Administrative Services, Inc.")
     ("investments" "Holly Glen, LLC")
     ("ipiranga" "Ipiranga Produtos de Petroleo S.A.")
     ("irish" "Tin Mill LLC")
     ("iselect" "iSelect Ltd")
     ("ismaili" "Fondation Aga Khan (Aga Khan Foundation)")
     ("ist" "Istanbul Metropolitan Municipality")
     ("istanbul" "Istanbul Metropolitan Municipality")
     ("itau" "Itau Unibanco Holding S.A.")
     ("itv" "ITV Services Limited")
     ("iveco" "CNH Industrial N.V.")
     ("iwc" "Richemont DNS Inc.")
     ("jaguar" "Jaguar Land Rover Ltd")
     ("java" "Oracle Corporation")
     ("jcb" "JCB Co., Ltd.")
     ("jcp" "JCP Media, Inc.")
     ("jeep" "FCA US LLC.")
     ("jetzt" "Wild Frostbite, LLC")
     ("jewelry" "Wild Bloom, LLC")
     ("jio" "Affinity Names, Inc.")
     ("jlc" "Richemont DNS Inc.")
     ("jll" "Jones Lang LaSalle Incorporated")
     ("jmp" "Matrix IP LLC")
     ("jnj" "Johnson & Johnson Services, Inc.")
     ("joburg" "ZA Central Registry NPC trading as ZA Central Registry")
     ("jot" "Amazon Registry Services, Inc.")
     ("joy" "Amazon Registry Services, Inc.")
     ("jpmorgan" "JPMorgan Chase Bank, National Association")
     ("jprs" "Japan Registry Services Co., Ltd.")
     ("juegos" "Uniregistry, Corp.")
     ("juniper" "JUNIPER NETWORKS, INC.")
     ("kaufen" "United TLD Holdco Ltd.")
     ("kddi" "KDDI CORPORATION")
     ("kerryhotels" "Kerry Trading Co. Limited")
     ("kerrylogistics" "Kerry Trading Co. Limited")
     ("kerryproperties" "Kerry Trading Co. Limited")
     ("kfh" "Kuwait Finance House")
     ("kia" "KIA MOTORS CORPORATION")
     ("kim" "Afilias plc")
     ("kinder" "Ferrero Trading Lux S.A.")
     ("kindle" "Amazon Registry Services, Inc.")
     ("kitchen" "Just Goodbye, LLC")
     ("kiwi" "DOT KIWI LIMITED")
     ("koeln" "NetCologne Gesellschaft f\374r Telekommunikation mbH")
     ("komatsu" "Komatsu Ltd.")
     ("kosher" "Kosher Marketing Assets LLC")
     ("kpmg" "KPMG International Cooperative (KPMG International Genossenschaft)")
     ("kpn" "Koninklijke KPN N.V.")
     ("krd" "KRG Department of Information Technology")
     ("kred" "KredTLD Pty Ltd")
     ("kuokgroup" "Kerry Trading Co. Limited")
     ("kyoto" "Academic Institution: Kyoto Jyoho Gakuen")
     ("lacaixa" "CAIXA D'ESTALVIS I PENSIONS DE BARCELONA")
     ("ladbrokes" "LADBROKES INTERNATIONAL PLC")
     ("lamborghini" "Automobili Lamborghini S.p.A.")
     ("lamer" "The Est\351e Lauder Companies Inc.")
     ("lancaster" "LANCASTER")
     ("lancia" "Fiat Chrysler Automobiles N.V.")
     ("lancome" "L'Or\351al")
     ("land" "Pine Moon, LLC")
     ("landrover" "Jaguar Land Rover Ltd")
     ("lanxess" "LANXESS Corporation")
     ("lasalle" "Jones Lang LaSalle Incorporated")
     ("lat" "ECOM-LAC Federaci\363n de Latinoam\351rica y el Caribe para Internet y el Comercio Electr\363nico")
     ("latino" "Dish DBS Corporation")
     ("latrobe" "La Trobe University")
     ("law" "Minds + Machines Group Limited")
     ("lawyer" "United TLD Holdco, Ltd")
     ("lds" "IRI Domain Management, LLC")
     ("lease" "Victor Trail, LLC")
     ("leclerc" "A.C.D. LEC Association des Centres Distributeurs Edouard Leclerc")
     ("lefrak" "LeFrak Organization, Inc.")
     ("legal" "Blue Falls, LLC")
     ("lego" "LEGO Juris A/S")
     ("lexus" "TOYOTA MOTOR CORPORATION")
     ("lgbt" "Afilias plc")
     ("liaison" "Liaison Technologies, Incorporated")
     ("lidl" "Schwarz Domains und Services GmbH & Co. KG")
     ("life" "Trixy Oaks, LLC")
     ("lifeinsurance" "American Council of Life Insurers")
     ("lifestyle" "Lifestyle Domain Holdings, Inc.")
     ("lighting" "John McCook, LLC")
     ("like" "Amazon Registry Services, Inc.")
     ("lilly" "Eli Lilly and Company")
     ("limited" "Big Fest, LLC")
     ("limo" "Hidden Frostbite, LLC")
     ("lincoln" "Ford Motor Company")
     ("linde" "Linde Aktiengesellschaft")
     ("link" "Uniregistry, Corp.")
     ("lipsy" "Lipsy Ltd")
     ("live" "United TLD Holdco Ltd.")
     ("living" "Lifestyle Domain Holdings, Inc.")
     ("lixil" "LIXIL Group Corporation")
     ("loan" "dot Loan Limited")
     ("loans" "June Woods, LLC")
     ("locker" "Dish DBS Corporation")
     ("locus" "Locus Analytics LLC")
     ("loft" "Annco, Inc.")
     ("lol" "Uniregistry, Corp.")
     ("london" "Dot London Domains Limited")
     ("lotte" "Lotte Holdings Co., Ltd.")
     ("lotto" "Afilias plc")
     ("love" "Merchant Law Group LLP")
     ("lpl" "LPL Holdings, Inc.")
     ("lplfinancial" "LPL Holdings, Inc.")
     ("ltd" "Over Corner, LLC")
     ("ltda" "InterNetX Corp.")
     ("lundbeck" "H. Lundbeck A/S")
     ("lupin" "LUPIN LIMITED")
     ("luxe" "Top Level Domain Holdings Limited")
     ("luxury" "Luxury Partners LLC")
     ("macys" "Macys, Inc.")
     ("madrid" "Comunidad de Madrid")
     ("maif" "Mutuelle Assurance Instituteur France (MAIF)")
     ("maison" "Victor Frostbite, LLC")
     ("makeup" "L'Or\351al")
     ("man" "MAN SE")
     ("management" "John Goodbye, LLC")
     ("mango" "PUNTO FA S.L.")
     ("market" "United TLD Holdco, Ltd")
     ("marketing" "Fern Pass, LLC")
     ("markets" "DOTMARKETS REGISTRY LTD")
     ("marriott" "Marriott Worldwide Corporation")
     ("marshalls" "The TJX Companies, Inc.")
     ("maserati" "Fiat Chrysler Automobiles N.V.")
     ("mattel" "Mattel Sites, Inc.")
     ("mba" "Lone Hollow, LLC")
     ("mcd" "McDonald's Corporation")
     ("mcdonalds" "McDonald's Corporation")
     ("mckinsey" "McKinsey Holdings, Inc.")
     ("med" "Medistry LLC")
     ("media" "Grand Glen, LLC")
     ("meet" "Charleston Road Registry Inc.")
     ("melbourne" "The Crown in right of the State of Victoria, represented by its Department of State Development, Business and Innovation")
     ("meme" "Charleston Road Registry Inc.")
     ("memorial" "Dog Beach, LLC")
     ("men" "Exclusive Registry Limited")
     ("menu" "Wedding TLD2, LLC")
     ("meo" "MEO Servi\347os de Comunica\347\365es e Multim\351dia, S.A.")
     ("metlife" "MetLife Services and Solutions, LLC")
     ("miami" "Top Level Domain Holdings Limited")
     ("microsoft" "Microsoft Corporation")
     ("mini" "Bayerische Motoren Werke Aktiengesellschaft")
     ("mint" "Intuit Administrative Services, Inc.")
     ("mit" "Massachusetts Institute of Technology")
     ("mitsubishi" "Mitsubishi Corporation")
     ("mlb" "MLB Advanced Media DH, LLC")
     ("mls" "The Canadian Real Estate Association")
     ("mma" "MMA IARD")
     ("mobile" "Dish DBS Corporation")
     ("mobily" "GreenTech Consultancy Company W.L.L.")
     ("moda" "United TLD Holdco Ltd.")
     ("moe" "Interlink Co., Ltd.")
     ("moi" "Amazon Registry Services, Inc.")
     ("mom" "Uniregistry, Corp.")
     ("monash" "Monash University")
     ("money" "Outer McCook, LLC")
     ("monster" "Monster Worldwide, Inc.")
     ("montblanc" "Richemont DNS Inc.")
     ("mopar" "FCA US LLC.")
     ("mormon" "IRI Domain Management, LLC (\"Applicant\")")
     ("mortgage" "United TLD Holdco, Ltd")
     ("moscow" "Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID)")
     ("moto" "Motorola Trademark Holdings, LLC")
     ("motorcycles" "DERMotorcycles, LLC")
     ("mov" "Charleston Road Registry Inc.")
     ("movie" "New Frostbite, LLC")
     ("movistar" "Telef\363nica S.A.")
     ("msd" "MSD Registry Holdings, Inc.")
     ("mtn" "MTN Dubai Limited")
     ("mtpc" "Mitsubishi Tanabe Pharma Corporation")
     ("mtr" "MTR Corporation Limited")
     ("mutual" "Northwestern Mutual MU TLD Registry, LLC")
     ("mutuelle" "Retired")
     ("nab" "National Australia Bank Limited")
     ("nadex" "Nadex Domains, Inc")
     ("nagoya" "GMO Registry, Inc.")
     ("nationwide" "Nationwide Mutual Insurance Company")
     ("natura" "NATURA COSM\311TICOS S.A.")
     ("navy" "United TLD Holdco Ltd.")
     ("nba" "NBA REGISTRY, LLC")
     ("nec" "NEC Corporation")
     ("netbank" "COMMONWEALTH BANK OF AUSTRALIA")
     ("netflix" "Netflix, Inc.")
     ("network" "Trixy Manor, LLC")
     ("neustar" "NeuStar, Inc.")
     ("new" "Charleston Road Registry Inc.")
     ("newholland" "CNH Industrial N.V.")
     ("news" "United TLD Holdco Ltd.")
     ("next" "Next plc")
     ("nextdirect" "Next plc")
     ("nexus" "Charleston Road Registry Inc.")
     ("nfl" "NFL Reg Ops LLC")
     ("ngo" "Public Interest Registry")
     ("nhk" "Japan Broadcasting Corporation (NHK)")
     ("nico" "DWANGO Co., Ltd.")
     ("nike" "NIKE, Inc.")
     ("nikon" "NIKON CORPORATION")
     ("ninja" "United TLD Holdco Ltd.")
     ("nissan" "NISSAN MOTOR CO., LTD.")
     ("nissay" "Nippon Life Insurance Company")
     ("nokia" "Nokia Corporation")
     ("northwesternmutual" "Northwestern Mutual Registry, LLC")
     ("norton" "Symantec Corporation")
     ("now" "Amazon Registry Services, Inc.")
     ("nowruz" "Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.")
     ("nowtv" "Starbucks (HK) Limited")
     ("nra" "NRA Holdings Company, INC.")
     ("nrw" "Minds + Machines GmbH")
     ("ntt" "NIPPON TELEGRAPH AND TELEPHONE CORPORATION")
     ("nyc" "The City of New York by and through the New York City Department of Information Technology & Telecommunications")
     ("obi" "OBI Group Holding SE & Co. KGaA")
     ("observer" "Top Level Spectrum, Inc.")
     ("off" "Johnson Shareholdings, Inc.")
     ("office" "Microsoft Corporation")
     ("okinawa" "BRregistry, Inc.")
     ("olayan" "Crescent Holding GmbH")
     ("olayangroup" "Crescent Holding GmbH")
     ("oldnavy" "The Gap, Inc.")
     ("ollo" "Dish DBS Corporation")
     ("omega" "The Swatch Group Ltd")
     ("one" "One.com A/S")
     ("ong" "Public Interest Registry")
     ("onl" "I-REGISTRY Ltd., Niederlassung Deutschland")
     ("online" "DotOnline Inc.")
     ("onyourside" "Nationwide Mutual Insurance Company")
     ("ooo" "INFIBEAM INCORPORATION LIMITED")
     ("open" "American Express Travel Related Services Company, Inc.")
     ("oracle" "Oracle Corporation")
     ("orange" "Orange Brand Services Limited")
     ("organic" "Afilias plc")
     ("orientexpress" "Orient Express")
     ("origins" "The Est\351e Lauder Companies Inc.")
     ("osaka" "Interlink Co., Ltd.")
     ("otsuka" "Otsuka Holdings Co., Ltd.")
     ("ott" "Dish DBS Corporation")
     ("ovh" "OVH SAS")
     ("page" "Charleston Road Registry Inc.")
     ("pamperedchef" "The Pampered Chef, Ltd.")
     ("panasonic" "Panasonic Corporation")
     ("panerai" "Richemont DNS Inc.")
     ("paris" "City of Paris")
     ("pars" "Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.")
     ("partners" "Magic Glen, LLC")
     ("parts" "Sea Goodbye, LLC")
     ("party" "Blue Sky Registry Limited")
     ("passagens" "Travel Reservations SRL")
     ("pay" "Amazon Registry Services, Inc.")
     ("pccw" "PCCW Enterprises Limited")
     ("pet" "Afilias plc")
     ("pfizer" "Pfizer Inc.")
     ("pharmacy" "National Association of Boards of Pharmacy")
     ("philips" "Koninklijke Philips N.V.")
     ("phone" "Dish DBS Corporation")
     ("photo" "Uniregistry, Corp.")
     ("photography" "Sugar Glen, LLC")
     ("photos" "Sea Corner, LLC")
     ("physio" "PhysBiz Pty Ltd")
     ("piaget" "Richemont DNS Inc.")
     ("pics" "Uniregistry, Corp.")
     ("pictet" "Pictet Europe S.A.")
     ("pictures" "Foggy Sky, LLC")
     ("pid" "Top Level Spectrum, Inc.")
     ("pin" "Amazon Registry Services, Inc.")
     ("ping" "Ping Registry Provider, Inc.")
     ("pink" "Afilias plc")
     ("pioneer" "Pioneer Corporation")
     ("pizza" "Foggy Moon, LLC")
     ("place" "Snow Galley, LLC")
     ("play" "Charleston Road Registry Inc.")
     ("playstation" "Sony Computer Entertainment Inc.")
     ("plumbing" "Spring Tigers, LLC")
     ("plus" "Sugar Mill, LLC")
     ("pnc" "PNC Domain Co., LLC")
     ("pohl" "Deutsche Verm\366gensberatung Aktiengesellschaft DVAG")
     ("poker" "Afilias plc")
     ("politie" "Politie Nederland")
     ("porn" "ICM Registry PN LLC")
     ("pramerica" "Prudential Financial, Inc.")
     ("praxi" "Praxi S.p.A.")
     ("press" "DotPress Inc.")
     ("prime" "Amazon Registry Services, Inc.")
     ("prod" "Charleston Road Registry Inc.")
     ("productions" "Magic Birch, LLC")
     ("prof" "Charleston Road Registry Inc.")
     ("progressive" "Progressive Casualty Insurance Company")
     ("promo" "Afilias plc")
     ("properties" "Big Pass, LLC")
     ("property" "Uniregistry, Corp.")
     ("protection" "XYZ.COM LLC")
     ("pru" "Prudential Financial, Inc.")
     ("prudential" "Prudential Financial, Inc.")
     ("pub" "United TLD Holdco Ltd.")
     ("pwc" "PricewaterhouseCoopers LLP")
     ("qpon" "dotCOOL, Inc.")
     ("quebec" "PointQu\351bec Inc")
     ("quest" "Quest ION Limited")
     ("qvc" "QVC, Inc.")
     ("racing" "Premier Registry Limited")
     ("radio" "European Broadcasting Union (EBU)")
     ("raid" "Johnson Shareholdings, Inc.")
     ("read" "Amazon Registry Services, Inc.")
     ("realestate" "dotRealEstate LLC")
     ("realtor" "Real Estate Domains LLC")
     ("realty" "Fegistry, LLC")
     ("recipes" "Grand Island, LLC")
     ("red" "Afilias plc")
     ("redstone" "Redstone Haute Couture Co., Ltd.")
     ("redumbrella" "Travelers TLD, LLC")
     ("rehab" "United TLD Holdco Ltd.")
     ("reise" "Foggy Way, LLC")
     ("reisen" "New Cypress, LLC")
     ("reit" "National Association of Real Estate Investment Trusts, Inc.")
     ("reliance" "Reliance Industries Limited")
     ("ren" "Beijing Qianxiang Wangjing Technology Development Co., Ltd.")
     ("rent" "XYZ.COM LLC")
     ("rentals" "Big Hollow,LLC")
     ("repair" "Lone Sunset, LLC")
     ("report" "Binky Glen, LLC")
     ("republican" "United TLD Holdco Ltd.")
     ("rest" "Punto 2012 Sociedad Anonima Promotora de Inversion de Capital Variable")
     ("restaurant" "Snow Avenue, LLC")
     ("review" "dot Review Limited")
     ("reviews" "United TLD Holdco, Ltd.")
     ("rexroth" "Robert Bosch GMBH")
     ("rich" "I-REGISTRY Ltd., Niederlassung Deutschland")
     ("richardli" "Pacific Century Asset Management (HK) Limited")
     ("ricoh" "Ricoh Company, Ltd.")
     ("rightathome" "Johnson Shareholdings, Inc.")
     ("ril" "Reliance Industries Limited")
     ("rio" "Empresa Municipal de Inform\341tica SA - IPLANRIO")
     ("rip" "United TLD Holdco Ltd.")
     ("rmit" "Royal Melbourne Institute of Technology")
     ("rocher" "Ferrero Trading Lux S.A.")
     ("rocks" "United TLD Holdco, LTD.")
     ("rodeo" "Top Level Domain Holdings Limited")
     ("rogers" "Rogers Communications Canada Inc.")
     ("room" "Amazon Registry Services, Inc.")
     ("rsvp" "Charleston Road Registry Inc.")
     ("ruhr" "regiodot GmbH & Co. KG")
     ("run" "Snow Park, LLC")
     ("rwe" "RWE AG")
     ("ryukyu" "BRregistry, Inc.")
     ("saarland" "dotSaarland GmbH")
     ("safe" "Amazon Registry Services, Inc.")
     ("safety" "Safety Registry Services, LLC.")
     ("sakura" "SAKURA Internet Inc.")
     ("sale" "United TLD Holdco, Ltd")
     ("salon" "Outer Orchard, LLC")
     ("samsclub" "Wal-Mart Stores, Inc.")
     ("samsung" "SAMSUNG SDS CO., LTD")
     ("sandvik" "Sandvik AB")
     ("sandvikcoromant" "Sandvik AB")
     ("sanofi" "Sanofi")
     ("sap" "SAP AG")
     ("sapo" "MEO Servi\347os de Comunica\347\365es e Multim\351dia, S.A.")
     ("sarl" "Delta Orchard, LLC")
     ("sas" "Research IP LLC")
     ("save" "Amazon Registry Services, Inc.")
     ("saxo" "Saxo Bank A/S")
     ("sbi" "STATE BANK OF INDIA")
     ("sbs" "SPECIAL BROADCASTING SERVICE CORPORATION")
     ("sca" "SVENSKA CELLULOSA AKTIEBOLAGET SCA (publ)")
     ("scb" "The Siam Commercial Bank Public Company Limited (\"SCB\")")
     ("schaeffler" "Schaeffler Technologies AG & Co. KG")
     ("schmidt" "SALM S.A.S.")
     ("scholarships" "Scholarships.com, LLC")
     ("school" "Little Galley, LLC")
     ("schule" "Outer Moon, LLC")
     ("schwarz" "Schwarz Domains und Services GmbH & Co. KG")
     ("science" "dot Science Limited")
     ("scjohnson" "Johnson Shareholdings, Inc.")
     ("scor" "SCOR SE")
     ("scot" "Dot Scot Registry Limited")
     ("seat" "SEAT, S.A. (Sociedad Unipersonal)")
     ("secure" "Amazon Registry Services, Inc.")
     ("security" "XYZ.COM LLC")
     ("seek" "Seek Limited")
     ("select" "iSelect Ltd")
     ("sener" "Sener Ingenier\355a y Sistemas, S.A.")
     ("services" "Fox Castle, LLC")
     ("ses" "SES")
     ("seven" "Seven West Media Ltd")
     ("sew" "SEW-EURODRIVE GmbH & Co KG")
     ("sex" "ICM Registry SX LLC")
     ("sexy" "Uniregistry, Corp.")
     ("sfr" "Societe Francaise du Radiotelephone - SFR")
     ("shangrila" "Shangri-La International Hotel Management Limited")
     ("sharp" "Sharp Corporation")
     ("shaw" "Shaw Cablesystems G.P.")
     ("shell" "Shell Information Technology International Inc")
     ("shia" "Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.")
     ("shiksha" "Afilias plc")
     ("shoes" "Binky Galley, LLC")
     ("shop" "GMO Registry, Inc.")
     ("shopping" "Over Keep, LLC")
     ("shouji" "QIHOO 360 TECHNOLOGY CO. LTD.")
     ("show" "Snow Beach, LLC")
     ("showtime" "CBS Domains Inc.")
     ("shriram" "Shriram Capital Ltd.")
     ("silk" "Amazon Registry Services, Inc.")
     ("sina" "Sina Corporation")
     ("singles" "Fern Madison, LLC")
     ("site" "DotSite Inc.")
     ("ski" "STARTING DOT LIMITED")
     ("skin" "L'Or\351al")
     ("sky" "Sky International AG")
     ("skype" "Microsoft Corporation")
     ("sling" "Hughes Satellite Systems Corporation")
     ("smart" "Smart Communications, Inc. (SMART)")
     ("smile" "Amazon Registry Services, Inc.")
     ("sncf" "SNCF (Soci\351t\351 Nationale des Chemins de fer Francais)")
     ("soccer" "Foggy Shadow, LLC")
     ("social" "United TLD Holdco Ltd.")
     ("softbank" "SoftBank Group Corp.")
     ("software" "United TLD Holdco, Ltd")
     ("sohu" "Sohu.com Limited")
     ("solar" "Ruby Town, LLC")
     ("solutions" "Silver Cover, LLC")
     ("song" "Amazon Registry Services, Inc.")
     ("sony" "Sony Corporation")
     ("soy" "Charleston Road Registry Inc.")
     ("space" "DotSpace Inc.")
     ("spiegel" "SPIEGEL-Verlag Rudolf Augstein GmbH & Co. KG")
     ("spot" "Amazon Registry Services, Inc.")
     ("spreadbetting" "DOTSPREADBETTING REGISTRY LTD")
     ("srl" "InterNetX Corp.")
     ("srt" "FCA US LLC.")
     ("stada" "STADA Arzneimittel AG")
     ("staples" "Staples, Inc.")
     ("star" "Star India Private Limited")
     ("starhub" "StarHub Limited")
     ("statebank" "STATE BANK OF INDIA")
     ("statefarm" "State Farm Mutual Automobile Insurance Company")
     ("statoil" "Statoil ASA")
     ("stc" "Saudi Telecom Company")
     ("stcgroup" "Saudi Telecom Company")
     ("stockholm" "Stockholms kommun")
     ("storage" "Self Storage Company LLC")
     ("store" "DotStore Inc.")
     ("stream" "dot Stream Limited")
     ("studio" "United TLD Holdco Ltd.")
     ("study" "OPEN UNIVERSITIES AUSTRALIA PTY LTD")
     ("style" "Binky Moon, LLC")
     ("sucks" "Vox Populi Registry Ltd.")
     ("supplies" "Atomic Fields, LLC")
     ("supply" "Half Falls, LLC")
     ("support" "Grand Orchard, LLC")
     ("surf" "Top Level Domain Holdings Limited")
     ("surgery" "Tin Avenue, LLC")
     ("suzuki" "SUZUKI MOTOR CORPORATION")
     ("swatch" "The Swatch Group Ltd")
     ("swiftcover" "Swiftcover Insurance Services Limited")
     ("swiss" "Swiss Confederation")
     ("sydney" "State of New South Wales, Department of Premier and Cabinet")
     ("symantec" "Symantec Corporation")
     ("systems" "Dash Cypress, LLC")
     ("tab" "Tabcorp Holdings Limited")
     ("taipei" "Taipei City Government")
     ("talk" "Amazon Registry Services, Inc.")
     ("taobao" "Alibaba Group Holding Limited")
     ("target" "Target Domain Holdings, LLC")
     ("tatamotors" "Tata Motors Ltd")
     ("tatar" "Limited Liability Company \"Coordination Center of Regional Domain of Tatarstan Republic\"")
     ("tattoo" "Uniregistry, Corp.")
     ("tax" "Storm Orchard, LLC")
     ("taxi" "Pine Falls, LLC")
     ("tci" "Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.")
     ("tdk" "TDK Corporation")
     ("team" "Atomic Lake, LLC")
     ("tech" "Dot Tech LLC")
     ("technology" "Auburn Falls, LLC")
     ("telecity" "TelecityGroup International Limited")
     ("telefonica" "Telef\363nica S.A.")
     ("temasek" "Temasek Holdings (Private) Limited")
     ("tennis" "Cotton Bloom, LLC")
     ("teva" "Teva Pharmaceutical Industries Limited")
     ("thd" "Home Depot Product Authority, LLC")
     ("theater" "Blue Tigers, LLC")
     ("theatre" "XYZ.COM LLC")
     ("tiaa" "Teachers Insurance and Annuity Association of America")
     ("tickets" "Accent Media Limited")
     ("tienda" "Victor Manor, LLC")
     ("tiffany" "Tiffany and Company")
     ("tips" "Corn Willow, LLC")
     ("tires" "Dog Edge, LLC")
     ("tirol" "punkt Tirol GmbH")
     ("tjmaxx" "The TJX Companies, Inc.")
     ("tjx" "The TJX Companies, Inc.")
     ("tkmaxx" "The TJX Companies, Inc.")
     ("tmall" "Alibaba Group Holding Limited")
     ("today" "Pearl Woods, LLC")
     ("tokyo" "GMO Registry, Inc.")
     ("tools" "Pioneer North, LLC")
     ("top" "Jiangsu Bangning Science & Technology Co.,Ltd.")
     ("toray" "Toray Industries, Inc.")
     ("toshiba" "TOSHIBA Corporation")
     ("total" "Total SA")
     ("tours" "Sugar Station, LLC")
     ("town" "Koko Moon, LLC")
     ("toyota" "TOYOTA MOTOR CORPORATION")
     ("toys" "Pioneer Orchard, LLC")
     ("trade" "Elite Registry Limited")
     ("trading" "DOTTRADING REGISTRY LTD")
     ("training" "Wild Willow, LLC")
     ("travelchannel" "Lifestyle Domain Holdings, Inc.")
     ("travelers" "Travelers TLD, LLC")
     ("travelersinsurance" "Travelers TLD, LLC")
     ("trust" "Artemis Internet Inc")
     ("trv" "Travelers TLD, LLC")
     ("tube" "Latin American Telecom LLC")
     ("tui" "TUI AG")
     ("tunes" "Amazon Registry Services, Inc.")
     ("tushu" "Amazon Registry Services, Inc.")
     ("tvs" "T V SUNDRAM IYENGAR & SONS PRIVATE LIMITED")
     ("ubank" "National Australia Bank Limited")
     ("ubs" "UBS AG")
     ("uconnect" "FCA US LLC.")
     ("unicom" "China United Network Communications Corporation Limited")
     ("university" "Little Station, LLC")
     ("uno" "Dot Latin LLC")
     ("uol" "UBN INTERNET LTDA.")
     ("ups" "UPS Market Driver, Inc.")
     ("vacations" "Atomic Tigers, LLC")
     ("vana" "Lifestyle Domain Holdings, Inc.")
     ("vanguard" "The Vanguard Group, Inc.")
     ("vegas" "Dot Vegas, Inc.")
     ("ventures" "Binky Lake, LLC")
     ("verisign" "VeriSign, Inc.")
     ("versicherung" "TLD-BOX Registrydienstleistungen GmbH")
     ("vet" "United TLD Holdco, Ltd")
     ("viajes" "Black Madison, LLC")
     ("video" "United TLD Holdco, Ltd")
     ("vig" "VIENNA INSURANCE GROUP AG Wiener Versicherung Gruppe")
     ("viking" "Viking River Cruises (Bermuda) Ltd.")
     ("villas" "New Sky, LLC")
     ("vin" "Holly Shadow, LLC")
     ("vip" "Minds + Machines Group Limited")
     ("virgin" "Virgin Enterprises Limited")
     ("visa" "Visa Worldwide Pte. Limited")
     ("vision" "Koko Station, LLC")
     ("vista" "Vistaprint Limited")
     ("vistaprint" "Vistaprint Limited")
     ("viva" "Saudi Telecom Company")
     ("vivo" "Telefonica Brasil S.A.")
     ("vlaanderen" "DNS.be vzw")
     ("vodka" "Top Level Domain Holdings Limited")
     ("volkswagen" "Volkswagen Group of America Inc.")
     ("volvo" "Volvo Holding Sverige Aktiebolag")
     ("vote" "Monolith Registry LLC")
     ("voting" "Valuetainment Corp.")
     ("voto" "Monolith Registry LLC")
     ("voyage" "Ruby House, LLC")
     ("vuelos" "Travel Reservations SRL")
     ("wales" "Nominet UK")
     ("walmart" "Wal-Mart Stores, Inc.")
     ("walter" "Sandvik AB")
     ("wang" "Zodiac Wang Limited")
     ("wanggou" "Amazon Registry Services, Inc.")
     ("warman" "Weir Group IP Limited")
     ("watch" "Sand Shadow, LLC")
     ("watches" "Richemont DNS Inc.")
     ("weather" "International Business Machines Corporation")
     ("weatherchannel" "International Business Machines Corporation")
     ("webcam" "dot Webcam Limited")
     ("weber" "Saint-Gobain Weber SA")
     ("website" "DotWebsite Inc.")
     ("wed" "Atgron, Inc.")
     ("wedding" "Top Level Domain Holdings Limited")
     ("weibo" "Sina Corporation")
     ("weir" "Weir Group IP Limited")
     ("whoswho" "Who's Who Registry")
     ("wien" "punkt.wien GmbH")
     ("wiki" "Top Level Design, LLC")
     ("williamhill" "William Hill Organization Limited")
     ("win" "First Registry Limited")
     ("windows" "Microsoft Corporation")
     ("wine" "June Station, LLC")
     ("winners" "The TJX Companies, Inc.")
     ("wme" "William Morris Endeavor Entertainment, LLC")
     ("wolterskluwer" "Wolters Kluwer N.V.")
     ("woodside" "Woodside Petroleum Limited")
     ("work" "Top Level Domain Holdings Limited")
     ("works" "Little Dynamite, LLC")
     ("world" "Bitter Fields, LLC")
     ("wow" "Amazon Registry Services, Inc.")
     ("wtc" "World Trade Centers Association, Inc.")
     ("wtf" "Hidden Way, LLC")
     ("xbox" "Microsoft Corporation")
     ("xerox" "Xerox DNHC LLC")
     ("xfinity" "Comcast IP Holdings I, LLC")
     ("xihuan" "QIHOO 360 TECHNOLOGY CO. LTD.")
     ("xin" "Elegant Leader Limited")
     ("xyz" "XYZ.COM LLC")
     ("yachts" "DERYachts, LLC")
     ("yahoo" "Yahoo! Domain Services Inc.")
     ("yamaxun" "Amazon Registry Services, Inc.")
     ("yandex" "YANDEX, LLC")
     ("yodobashi" "YODOBASHI CAMERA CO.,LTD.")
     ("yoga" "Top Level Domain Holdings Limited")
     ("yokohama" "GMO Registry, Inc.")
     ("you" "Amazon Registry Services, Inc.")
     ("youtube" "Charleston Road Registry Inc.")
     ("yun" "QIHOO 360 TECHNOLOGY CO. LTD.")
     ("zappos" "Amazon Registry Services, Inc.")
     ("zara" "Industria de Dise\361o Textil, S.A. (INDITEX, S.A.)")
     ("zero" "Amazon Registry Services, Inc.")
     ("zip" "Charleston Road Registry Inc.")
     ("zippo" "Zadco Company")
     ("zone" "Outer Falls, LLC")
     ("zuerich" "Kanton Z\374rich (Canton of Zurich)")

     ("post" "Universal Postal Union")
     ("xxx" "ICM Registry LLC")))

     ;; ##### XEmacs; Non-ASCII domains not yet included because of the
     ;; ##### persisting frustrating necessity for non-Mule support. Note also
     ;; ##### that this file cannot have non-ASCII outside comments for
     ;; ##### related reasons to do with the byte compiler.

     ;;; Non-ASCII country domains:

;     ("한국" "KISA (Korea Internet & Security Agency)")
;     ("ভাৰত" "Not assigned")
;     ("ভারত" "National Internet Exchange of India")
;     ("বাংলা" "Posts and Telecommunications Division")
;     ("қаз" "Association of IT Companies of Kazakhstan")
;     ("срб" "Serbian National Internet Domain Registry (RNIDS)")
;     ("бг" "Imena.BG AD")
;     ("бел" "Reliable Software, Ltd.")
;     ("சிங்கப்பூர்" "Singapore Network Information Centre (SGNIC) Pte Ltd")
;     ("мкд" "Macedonian Academic Research Network Skopje")
;     ("ею" "EURid vzw/asbl")
;     ("中国" "China Internet Network Information Center (CNNIC)")
;     ("中國" "China Internet Network Information Center (CNNIC)")
;     ("భారత్" "National Internet Exchange of India")
;     ("ලංකා" "LK Domain Registry")
;     ("ભારત" "National Internet Exchange of India")
;     ("भारतम्" "Not assigned")
;     ("भारत" "National Internet Exchange of India")
;     ("भारोत" "Not assigned")
;     ("укр" "Ukrainian Network Information Centre (UANIC), Inc.")
;     ("香港" "Hong Kong Internet Registration Corporation Ltd.")
;     ("台湾" "Taiwan Network Information Center (TWNIC)")
;     ("台灣" "Taiwan Network Information Center (TWNIC)")
;     ("мон" "Datacom Co.,Ltd")
;     (".الجزائر‎" "CERIST")
;     (".عمان‎" "Telecommunications Regulatory Authority (TRA)")
;     (".ایران‎" "Institute for Research in Fundamental Sciences (IPM)")
;     (".امارات‎" "Telecommunications Regulatory Authority (TRA)")
;     (".پاکستان‎" "National Telecommunication Corporation")
;     (".الاردن‎" "National Information Technology Center (NITC)")
;     (".بارت‎" "Not assigned")
;     (".بھارت‎" "National Internet Exchange of India")
;     (".المغرب‎" "Agence Nationale de Réglementation des Télécommunications (ANRT)")
;     (".السعودية‎" "Communications and Information Technology Commission")
;     (".ڀارت‎" "Not assigned")
;     (".سودان‎" "Sudan Internet Society")
;     (".عراق‎" "Communications and Media Commission (CMC)")
;     (".مليسيا‎" "MYNIC Berhad")
;     ("澳門" "Bureau of Telecommunications Regulation (DSRT)")
;     ("გე" "Information Technologies Development Center (ITDC)")
;     ("ไทย" "Thai Network Information Center Foundation")
;     (".سورية‎" "National Agency for Network Services (NANS)")
;     ("рф" "Coordination Center for TLD RU")
;     (".تونس‎" "Agence Tunisienne d'Internet")
;     ("ελ" "ICS-FORTH GR")
;     ("ഭാരതം" "Not assigned")
;     ("ਭਾਰਤ" "National Internet Exchange of India")
;     (".مصر‎" "National Telecommunication Regulatory Authority - NTRA")
;     (".قطر‎" "Communications Regulatory Authority")
;     ("இலங்கை" "LK Domain Registry")
;     ("இந்தியா" "National Internet Exchange of India")
;     ("հայ" "\"Internet Society\" Non-governmental Organization")
;     ("新加坡" "Singapore Network Information Centre (SGNIC) Pte Ltd")
;     (".فلسطين‎" "Ministry of Telecom & Information Technology (MTIT)")

      ;; Non-country non-ASCII domain names.
;     ("कॉम" "VeriSign Sarl")
;     ("セール" "Amazon Registry Services, Inc.")
;     ("佛山" "Guangzhou YU Wei Information Technology Co., Ltd.")
;     ("慈善" "Excellent First Limited")
;     ("集团" "Eagle Horizon Limited")
;     ("在线" "TLD REGISTRY LIMITED")
;     ("大众汽车" "Volkswagen (China) Investment Co., Ltd.")
;     ("点看" "VeriSign Sarl")
;     ("คอม" "VeriSign Sarl")
;     ("八卦" "Zodiac Gemini Ltd")
;     ("公益" "China Organizational Name Administration Center")
;     ("公司" "Computer Network Information Center of Chinese Academy of Sciences （China Internet Network Information Center）")
;     ("香格里拉" "Shangri‐La International Hotel Management Limited")
;     ("网站" "Global Website TLD Asia Limited")
;     ("移动" "Afilias plc")
;     ("我爱你" "Tycoon Treasure Limited")
;     ("москва" "Foundation for Assistance for Internet Technologies and Infrastructure Development (FAITID)")
;     ("католик" "Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)")
;     ("онлайн" "CORE Association")
;     ("сайт" "CORE Association")
;     ("联通" "China United Network Communications Corporation Limited")
;     ("时尚" "RISE VICTORY LIMITED")
;     ("微博" "Sina Corporation")
;     ("淡马锡" "Temasek Holdings (Private) Limited")
;     ("ファッション" "Amazon Registry Services, Inc.")
;     ("орг" "Public Interest Registry")
;     ("नेट" "VeriSign Sarl")
;     ("ストア" "Amazon Registry Services, Inc.")
;     ("삼성" "SAMSUNG SDS CO., LTD")
;     ("商标" "HU YI GLOBAL INFORMATION RESOURCES(HOLDING) COMPANY.HONGKONG LIMITED")
;     ("商店" "Wild Island, LLC")
;     ("商城" "Zodiac Aquarius Limited")
;     ("дети" "The Foundation for Network Initiatives “The Smart Internet”")
;     ("ポイント" "Amazon Registry Services, Inc.")
;     ("新闻" "Xinhua News Agency Guangdong Branch 新华通讯社广东分社")
;     ("工行" "Industrial and Commercial Bank of China Limited")
;     ("家電" "Amazon Registry Services, Inc.")
;     ("中文网" "TLD REGISTRY LIMITED")
;     ("中信" "CITIC Group Corporation")
;     ("娱乐" "Will Bloom, LLC")
;     ("谷歌" "Charleston Road Registry Inc.")
;     ("電訊盈科" "PCCW Enterprises Limited")
;     ("购物" "Minds + Machines Group Limited")
;     ("クラウド" "Amazon Registry Services, Inc.")
;     ("通販" "Amazon Registry Services, Inc.")
;     ("网店" "Zodiac Taurus Ltd.")
;     ("संगठन" "Public Interest Registry")
;     ("餐厅" "HU YI GLOBAL INFORMATION RESOURCES (HOLDING) COMPANY. HONGKONG LIMITED")
;     ("网络" "Computer Network Information Center of Chinese Academy of Sciences （China Internet Network Information Center）")
;     ("ком" "VeriSign Sarl")
;     ("诺基亚" "Nokia Corporation")
;     ("食品" "Amazon Registry Services, Inc.")
;     ("飞利浦" "Koninklijke Philips N.V.")
;     ("手表" "Richemont DNS Inc.")
;     ("手机" "Beijing RITT-Net Technology Development Co., Ltd")
;     ("닷컴" "VeriSign Sarl")
;     ("政府" "Net-Chinese Co., Ltd.")
;     ("机构" "Public Interest Registry")
;     ("组织机构" "Public Interest Registry")
;     ("健康" "Stable Tone Limited")
;     ("рус" "Rusnames Limited")
;     ("珠宝" "Richemont DNS Inc.")
;     ("大拿" "VeriSign Sarl")
;     ("みんな" "Charleston Road Registry Inc.")
;     ("グーグル" "Charleston Road Registry Inc.")
;     ("世界" "Stable Tone Limited")
;     ("書籍" "Amazon Registry Services, Inc.")
;     ("网址" "KNET Co., Ltd")
;     ("닷넷" "VeriSign Sarl")
;     ("コム" "VeriSign Sarl")
;     ("天主教" "Pontificium Consilium de Comunicationibus Socialibus (PCCS) (Pontifical Council for Social Communication)")
;     ("游戏" "Spring Fields, LLC")
;     ("vermögensberater" "Deutsche Vermögensberatung Aktiengesellschaft DVAG")
;     ("vermögensberatung" "Deutsche Vermögensberatung Aktiengesellschaft DVAG")
;     ("企业" "Dash McCook, LLC")
;     ("信息" "Beijing Tele-info Network Technology Co., Ltd.")
;     ("嘉里大酒店" "Kerry Trading Co. Limited")
;     ("嘉里" "Kerry Trading Co. Limited")
;     ("广东" "Guangzhou YU Wei Information Technology Co., Ltd.")
;     ("政务" "China Organizational Name Administration Center")
;     ("xperia" "Sony Mobile Communications AB")
               
;;;###autoload
(defun what-domain (domain)
  "Convert mail domain DOMAIN to the country it corresponds to."
  (interactive
   (let ((completion-ignore-case t)
         (table (if (fboundp 'exact-minibuffer-completion-p)
                    ;; XEmacs 21.4. Kludge; cons up a table at completion
                    ;; time. This is fine, #'what-domain isn't called
                    ;; interactively that often.
                    (let (alist)
                      (maphash #'(lambda (key value) (push (cons key t) alist))
                               mail-extr-all-top-level-domains)
                      alist)
                  mail-extr-all-top-level-domains)))
     (list (completing-read "Domain: " table nil t))))
  (let ((value (gethash (downcase domain) mail-extr-all-top-level-domains)))
    (or value (error "No such domain"))
    (message "%s: %s" (upcase domain) value)))


;(let ((all nil))
;  (mapatoms #'(lambda (x)
;		(if (and (boundp x)
;			 (string-match "^mail-extr-" (symbol-name x)))
;		    (setq all (cons x all)))))
;  (setq all (sort all #'string-lessp))
;  (cons 'setq
;	(apply 'nconc (mapcar #'(lambda (x)
;				  (list x (symbol-value x)))
;			      all))))


(provide 'mail-extr)

;;; mail-extr.el ends here
