(rmail-get-new-mail): Don't reference

[gnu-emacs] / lisp / mail / mail-extr.el

diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 7a58699e095081f4569b394406fbc1bd3b9d759e..faa7ca1bb749a49043e6facd770f59b70780defd 100644 (file)
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,6 +1,7 @@
-;;; mail-extr.el --- extract full name and address from RFC 822 mail header.
+;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*-

 
 

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

 
 ;; Author: Joe Wells <jbw@cs.bu.edu>
 ;; Maintainer: FSF
 
 ;; Author: Joe Wells <jbw@cs.bu.edu>
 ;; Maintainer: FSF


@@ -28,11 +29,11 @@
 ;; The entry point of this code is
 ;;
 ;;    mail-extract-address-components: (address &optional all)
 ;; 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.
 ;;    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 
+;;    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.)
 ;;     (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.)


@@ -60,10 +61,10 @@
 ;; make sure you're not breaking functionality.  The test cases aren't included
 ;; because they are over 100K.
 ;;
 ;; 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 
+;; 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
 ;; 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 
+;; correspond to a real human full name, although we would prefer that

 ;; mail-extr would return the comment as-is.
 ;;
 ;; Features:
 ;; mail-extr would return the comment as-is.
 ;;
 ;; Features:


@@ -120,8 +121,8 @@
 ;; * insert documentation strings!
 ;; * handle X.400-gatewayed addresses according to RFC 1148.
 
 ;; * insert documentation strings!
 ;; * handle X.400-gatewayed addresses according to RFC 1148.
 

-;;; Change Log: 
-;; 
+;;; Change Log:
+;;

 ;; Thu Feb 17 17:57:33 1994  Jamie Zawinski (jwz@lucid.com)
 ;;
 ;;     * merged with jbw's latest version
 ;; Thu Feb 17 17:57:33 1994  Jamie Zawinski (jwz@lucid.com)
 ;;
 ;;     * merged with jbw's latest version


@@ -139,26 +140,26 @@
 ;;      * some more cleanup, doc, added provide
 ;;
 ;; Tue Mar 23 21:23:18 1993  Joe Wells  (jbw at csd.bu.edu)
 ;;      * 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.
 ;;     * Made mail-full-name-prefixes a user-customizable variable.

-;;        Allow passing the address as a buffer as well as as a string.
+;;        Allow passing the address as a buffer as well as a string.

 ;;        Allow [ and ] as name characters (Finnish character set).
 ;;        Allow [ and ] as name characters (Finnish character set).

-;; 
+;;

 ;; Mon Mar 22 21:20:56 1993  Joe Wells  (jbw at bigbird.bu.edu)
 ;; 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.
 ;;     * 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)
 ;; Mon Mar 22 20:16:57 1993  Joe Wells  (jbw at bigbird.bu.edu)

-;; 
+;;

 ;;     * Handle HZ encoding for embedding GB encoded chinese characters.
 ;;     * Handle HZ encoding for embedding GB encoded chinese characters.

-;; 
+;;

 ;; Mon Mar 22 00:46:12 1993  Joe Wells  (jbw at bigbird.bu.edu)
 ;; 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.
 ;;     * 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.


@@ -168,40 +169,40 @@
 ;;       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.
 ;;       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)
 ;; 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.
 ;;     * 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)
 ;; 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.
 ;;     * 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)
 ;; 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 <.)
 ;;     * 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)
 ;; Mon Apr  6 23:59:09 1992  Joe Wells  (jbw at bigbird.bu.edu)

-;; 
+;;

 ;;     * Cleaned up some more.  Release version 1.0 to world.
 ;;     * Cleaned up some more.  Release version 1.0 to world.

-;; 
+;;

 ;; Sun Apr  5 19:39:08 1992  Joe Wells  (jbw at bigbird.bu.edu)
 ;; Sun Apr  5 19:39:08 1992  Joe Wells  (jbw at bigbird.bu.edu)

-;; 
+;;

 ;;     * Cleaned up full name extraction extensively.
 ;;     * Cleaned up full name extraction extensively.

-;; 
+;;

 ;; Sun Feb  2 14:45:24 1992  Joe Wells  (jbw at bigbird.bu.edu)
 ;; 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.
 ;;     * 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.
 
 ;; Fri Jun 14 19:39:50 1991
 ;;     * Created.
 


@@ -225,11 +226,12 @@ we will assume that \"John Q. Smith\" is the fellow's name."
   :type 'boolean
   :group 'mail-extr)
 
   :type 'boolean
   :group 'mail-extr)
 

-(defcustom mail-extr-ignore-single-names t
+(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
   "*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 "21.4"

   :group 'mail-extr)
 
 ;; Matches a leading title that is not part of the name (does not
   :group 'mail-extr)
 
 ;; Matches a leading title that is not part of the name (does not


@@ -272,27 +274,6 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; Constant definitions.
 ;;
 
 ;; Constant definitions.
 ;;
 

-;;           Codes in
-;; Names in  ISO 8859-1 Name
-;; ISO 10XXX ISO 8859-2 in
-;; ISO 6937  ISO 10646  RFC            Swedish
-;; etc.      Hex Oct    1345 TeX Split ASCII Description
-;; --------- ---------- ---- --- ----- ----- -------------------------------
-;; %a        E4  344    a:   \"a ae    {     latin small   a + diaeresis   d
-;; %o        F6  366    o:   \"o oe    |     latin small   o + diaeresis   v
-;; @a        E5  345    aa   \oa aa    }     latin small   a + ring above  e
-;; %u        FC  374    u:   \"u ue    ~     latin small   u + diaeresis   |
-;; /e        E9  351    e'   \'e       `     latin small   e + acute       i
-;; %A        C4  304    A:   \"A AE    [     latin capital a + diaeresis   D
-;; %O        D6  326    O:   \"O OE    \     latin capital o + diaeresis   V
-;; @A        C5  305    AA   \oA AA    ]     latin capital a + ring above  E
-;; %U        DC  334    U:   \"U UE    ^     latin capital u + diaeresis   \
-;; /E        C9  311    E'   \'E       @     latin capital e + acute       I
-
-;; NOTE: @a and @A are not in ISO 8859-2 (the codes mentioned above invoke
-;; /l and /L).  Some of this data was retrieved from
-;; listserv@jhuvm.hcf.jhu.edu.
-

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


@@ -315,19 +296,18 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; Keep this set as minimal as possible.
 (defconst mail-extr-last-letters (purecopy "[:alpha:]`'."))
 
 ;; Keep this set as minimal as possible.
 (defconst mail-extr-last-letters (purecopy "[:alpha:]`'."))
 

-(defconst mail-extr-leading-garbage
-  (purecopy (format "[^%s]+" mail-extr-first-letters)))
+(defconst mail-extr-leading-garbage "\\W+")

 
 

-;; (defconst mail-extr-non-name-chars 
+;; (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)))
 
 ;;   (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. 
+;; Matches an initial not followed by both a period and a space.

 ;; (defconst mail-extr-bad-initials-pattern
 ;; (defconst mail-extr-bad-initials-pattern

-;;   (purecopy 
+;;   (purecopy

 ;;    (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
 ;;            mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
 
 ;;    (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
 ;;            mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
 


@@ -363,7 +343,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; 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\\)"))
 ;; 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
 ;; Matches a mixed-case or lowercase name (not an initial).
 ;; #### Match Latin1 lower case letters here too?
 ;; (defconst mail-extr-mixed-case-name-pattern


@@ -376,7 +356,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 
 ;; Matches a trailing alternative address.
 ;; #### Match Latin1 letters here too?
 
 ;; Matches a trailing alternative address.
 ;; #### Match Latin1 letters here too?

-;; #### Match _ before @ here too?  
+;; #### Match _ before @ here too?

 (defconst mail-extr-alternative-address-pattern
   (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
 
 (defconst mail-extr-alternative-address-pattern
   (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
 


@@ -435,7 +415,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; Matches a single word name.
 ;; (defconst mail-extr-one-name-pattern
 ;;   (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
 ;; 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
 ;; 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


@@ -459,12 +439,12 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; encountered. The character '~' is an escape character. By convention, it
 ;; must be immediately followed ONLY by '~', '{' or '\n' (<LF>), with the
 ;; following special meaning.
 ;; 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.
 ;; 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 '~}'
 ;; 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 '~}'


@@ -511,31 +491,25 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 (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))
 (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))

-(mapcar
- (function
-  (lambda (pair)
-    (let ((syntax-table (symbol-value (car pair))))
-      (mapcar
-       (function
-       (lambda (item)
-         (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)))))))
-       (cdr pair)))))
+(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
  '((mail-extr-address-syntax-table
     (?\000 ?\037 "w")                  ;control characters
     (?\040      " ")                   ;SPC
     (?! ?~      "w")                   ;printable characters
     (?\177      "w")                   ;DEL

-    (?\200 ?\377 "w")                  ;high-bit-on characters
-    (?\240      " ")                   ;nobreakspace

     (?\t " ")
     (?\r " ")
     (?\n " ")
     (?\t " ")
     (?\r " ")
     (?\n " ")


@@ -618,37 +592,35 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 ;; Utility functions and macros.
 ;;
 
 ;; Utility functions and macros.
 ;;
 

-(defmacro mail-extr-delete-char (n)
-  ;; in v19, delete-char is compiled as a function call, but delete-region
-  ;; is byte-coded, so it's much much faster.
-  (list 'delete-region '(point) (list '+ '(point) n)))
+;; 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).

 
 

-(defmacro mail-extr-skip-whitespace-forward ()
+(defsubst mail-extr-skip-whitespace-forward ()

   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.

-  '(skip-chars-forward " \t\n\r\240"))
+  (skip-chars-forward " \t\n\r "))

 
 

-(defmacro mail-extr-skip-whitespace-backward ()
+(defsubst mail-extr-skip-whitespace-backward ()

   ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
   ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.

-  '(skip-chars-backward " \t\n\r\240"))
-
+  (skip-chars-backward " \t\n\r "))

 
 

-(defmacro 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)
-         (mail-extr-delete-char -1)
-         (or (eobp)
-             (forward-char 1))
-         )))))

 
 

-(defmacro mail-extr-nuke-char-at (pos)
-  (` (save-excursion
-       (goto-char (, pos))
-       (mail-extr-delete-char 1)
-       (insert ?\ ))))
+(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))
 
 (put 'mail-extr-nuke-outside-range
      'edebug-form-spec '(symbolp &optional form form atom))


@@ -656,27 +628,28 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 (defmacro mail-extr-nuke-outside-range (list-symbol
                                        beg-symbol end-symbol
                                        &optional no-replace)
 (defmacro mail-extr-nuke-outside-range (list-symbol
                                        beg-symbol end-symbol
                                        &optional no-replace)

-  ;; 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.
+  "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"))
   (or (memq no-replace '(t nil))
       (error "no-replace must be t or nil, evaluable at macroexpand-time"))

-  (` (let ((temp (, list-symbol))
+  `(let ((temp ,list-symbol)

           ch)
        (while temp
         (setq ch (car temp))
           ch)
        (while temp
         (setq ch (car temp))

-        (cond ((or (> ch (, end-symbol))
-                   (< ch (, beg-symbol)))
-               (,@ (if no-replace
-                       nil
-                     (` ((mail-extr-nuke-char-at ch)))))
-               (setcar temp nil)))
+        (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 temp (cdr temp)))

-       (setq (, list-symbol) (delq nil (, list-symbol))))))
+       (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.
 
 (defun mail-extr-demarkerize (marker)
   ;; if arg is a marker, destroys the marker, then returns the old value.


@@ -693,26 +666,18 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
       pos
     (copy-marker pos)))
 
       pos
     (copy-marker pos)))
 

-(defmacro mail-extr-last (list)
-  ;; Returns last element of LIST.
-  ;; Could be a subst.
-  (` (let ((list (, list)))
-       (while (not (null (cdr list)))
-        (setq list (cdr list)))
-       (car list))))
-  
-(defmacro mail-extr-safe-move-sexp (arg)
+(defsubst mail-extr-safe-move-sexp (arg)

   ;; Safely skip over one balanced sexp, if there is one.  Return t if success.
   ;; 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))))))))
+  (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)))))))

 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 \f
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;


@@ -727,7 +692,8 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 (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).
 (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.
+If no name can be extracted, FULL-NAME will be nil.  Also see
+`mail-extr-ignore-single-names'.

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


@@ -735,23 +701,22 @@ 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.
 
 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.)"
+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)
 
   (let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
        (extraction-buffer (get-buffer-create " *extract address components*"))
        value-list)
 

-    (save-excursion
-      (set-buffer extraction-buffer)
+    (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)
       (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 extra space at beginning to allow later replacement with <
       ;; without having to move markers.
       (insert ?\ )


@@ -766,19 +731,17 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
       (set-text-properties (point-min) (point-max) nil)
 
 
       (set-text-properties (point-min) (point-max) nil)
 

-      (save-excursion
-       (set-buffer canonicalization-buffer)
+      (with-current-buffer (get-buffer-create canonicalization-buffer)

        (fundamental-mode)
        (buffer-disable-undo canonicalization-buffer)
        (fundamental-mode)
        (buffer-disable-undo canonicalization-buffer)

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

        (setq case-fold-search nil))
 
        (setq case-fold-search nil))
 

-      
+

       ;; Unfold multiple lines.
       (goto-char (point-min))
       (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
        (replace-match "\\1 " t))
       ;; 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))
       ;; Loop over addresses until we have as many as we want.
       (while (and (or all (null value-list))
                  (progn (goto-char (point-min))


@@ -804,6 +767,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
              ;;        mailbox-name-processed-flag
              disable-initial-guessing-flag) ; dynamically set from -voodoo
 
              ;;        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 <
          (goto-char (point-min))
 
          ;; Insert extra space at beginning to allow later replacement with <


@@ -868,12 +832,12 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                            ;; BUG FIX: This test was reversed.  Thanks to the
                            ;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
                            ;; for discovering this!
                            ;; BUG FIX: This test was reversed.  Thanks to the
                            ;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
                            ;; for discovering this!

-                           (< (mail-extr-last <-pos) (car >-pos)))))
+                           (< (car (last <-pos)) (car >-pos)))))

              ;; The argument contains more than one address.
              ;; Temporarily hide everything after this one.
              ;; The argument contains more than one address.
              ;; Temporarily hide everything after this one.

-             (setq end-of-address (copy-marker (1+ (point))))
+             (setq end-of-address (copy-marker (1+ (point)) t))

              (narrow-to-region (point-min) (1+ (point)))
              (narrow-to-region (point-min) (1+ (point)))

-             (mail-extr-delete-char 1)
+             (delete-char 1)

              (setq char ?\() ; HAVE I NO SHAME??
              )
             ;; record the position of various interesting chars, determine
              (setq char ?\() ; HAVE I NO SHAME??
              )
             ;; record the position of various interesting chars, determine


@@ -920,27 +884,25 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          ;; 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.
          ;; 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.

-         (cond ((and (> (length @-pos) 1)
+         (when (and (> (length @-pos) 1)

                      (eq 1 (length colon-pos)) ;TODO: check if between last two @s
                      (not \;-pos)
                      (not <-pos))
                      (eq 1 (length colon-pos)) ;TODO: check if between last two @s
                      (not \;-pos)
                      (not <-pos))

-                (goto-char (point-min))
-                (mail-extr-delete-char 1)
-                (setq <-pos (list (point)))
-                (insert ?<)))
+           (goto-char (point-min))
+           (delete-char 1)
+           (setq <-pos (list (point)))
+           (insert ?<))

 
          ;; If < but no >, insert > in rightmost possible position
 
          ;; If < but no >, insert > in rightmost possible position

-         (cond ((and <-pos
-                     (null >-pos))
-                (goto-char (point-max))
-                (setq >-pos (list (point)))
-                (insert ?>)))
+         (when (and <-pos (null >-pos))
+           (goto-char (point-max))
+           (setq >-pos (list (point)))
+           (insert ?>))

 
          ;; If > but no <, replace > with space.
 
          ;; If > but no <, replace > with space.

-         (cond ((and >-pos
-                     (null <-pos))
-                (mail-extr-nuke-char-at (car >-pos))
-                (setq >-pos nil)))
+         (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)
 
          ;; Turn >-pos and <-pos into non-lists
          (setq >-pos (car >-pos)


@@ -948,15 +910,15 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
          ;; Trim other punctuation lists of items outside < > pair to handle
          ;; stupid MTAs.
 
          ;; Trim other punctuation lists of items outside < > pair to handle
          ;; stupid MTAs.

-         (cond (<-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)))
+         (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.
 
          ;; Check for : that indicates GROUP list and for : part of
          ;; ROUTE-ADDR spec.


@@ -993,19 +955,18 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                   (setq group-\;-pos temp))))
 
          ;; Nuke unmatched GROUP syntax characters.
                   (setq group-\;-pos temp))))
 
          ;; Nuke unmatched GROUP syntax characters.

-         (cond ((and group-:-pos (not group-\;-pos))
-                ;; *** Do I really need to erase it?
-                (mail-extr-nuke-char-at group-:-pos)
-                (setq group-:-pos nil)))
-         (cond ((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))
+         (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?
 
          ;; Handle junk like ";@host.company.dom" that sendmail adds.
          ;; **** should I remember comment positions?

-         (cond
-          (group-\;-pos
+         (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)
            ;; 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)


@@ -1029,11 +990,11 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
            ;; *** The entire handling of GROUP addresses seems rather lame.
            ;; *** It deserves a complete rethink, except that these addresses
            ;; *** are hardly ever seen.
            ;; *** 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.
 
          ;; Any commas must be between < and : of ROUTE-ADDR.  Nuke any
          ;; others.

-         ;; Hell, go ahead an nuke all of the commas.
+         ;; 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)
          ;; **** 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)


@@ -1043,57 +1004,55 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          ;; handled above.
 
          ;; Locate PHRASE part of ROUTE-ADDR.
          ;; handled above.
 
          ;; Locate PHRASE part of ROUTE-ADDR.

-         (cond (<-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))))
+         (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
 
          ;; 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

-         (cond (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))
-                  (mail-extr-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)
-                (mail-extr-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))))
+         (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
 
 
          ;; de-listify @-pos
          (setq @-pos (car @-pos))
 
          ;; TODO: remove comments in the middle of an address
 

-         (save-excursion
-           (set-buffer canonicalization-buffer)
-
+         (with-current-buffer canonicalization-buffer

            (widen)
            (erase-buffer)
            (insert-buffer-substring extraction-buffer)
            (widen)
            (erase-buffer)
            (insert-buffer-substring extraction-buffer)


@@ -1108,8 +1067,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                  (narrow-to-region first-real-pos last-real-pos)
                ;; ****** Oh no!  What if the address is completely empty!
                ;; *** Is this correct?
                  (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))
-               ))
+               (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) @-pos))


@@ -1121,118 +1079,119 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
            ;; Error condition:?? (and %-pos (not @-pos))
 
            ;; WARNING: THIS CODE IS DUPLICATED BELOW.
            ;; Error condition:?? (and %-pos (not @-pos))
 
            ;; WARNING: THIS CODE IS DUPLICATED BELOW.

-           (cond ((and %-pos
-                       (not @-pos))
-                  (goto-char (car %-pos))
-                  (mail-extr-delete-char 1)
-                  (setq @-pos (point))
-                  (insert "@")
-                  (setq %-pos (cdr %-pos))))
-
-           (if mail-extr-mangle-uucp
-               (cond (!-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)
-                               (mail-extr-delete-char 1)
-                               (insert "%")
-                               (setq insert-point (point-max)))
-                              (mail-extr-@-binds-tighter-than-!
-                               (setq insert-point (point-max)))
-                              (%-pos
-                               (setq insert-point (mail-extr-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))
-                          (mail-extr-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)))))
+           (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.
 
            ;; WARNING: THIS CODE IS DUPLICATED ABOVE.

-           (cond ((and %-pos
-                       (not @-pos))
-                  (goto-char (car %-pos))
-                  (mail-extr-delete-char 1)
-                  (setq @-pos (point))
-                  (insert "@")
-                  (setq %-pos (cdr %-pos))))
-
-           (setq %-pos (nreverse %-pos))
-           (cond (%-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))))
-                      (cond ((and \.-pos
-                                  ;; #### string consing
-                                  (let ((s (intern-soft
-                                            (buffer-substring domain-pos (point))
-                                            mail-extr-all-top-level-domains)))
-                                    (and s (get s 'domain-name))))
-                             (narrow-to-region (point-min) (point))
-                             (goto-char (car temp))
-                             (mail-extr-delete-char 1)
-                             (setq @-pos (point))
-                             (setcdr temp nil)
-                             (setq %-pos (delq @-pos %-pos))
-                             (insert "@")
-                             (throw 'truncated t)))
-                      (setq temp (cdr temp))))))
+           (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
+                            (let ((s (intern-soft
+                                      (buffer-substring domain-pos (point))
+                                      mail-extr-all-top-level-domains)))
+                              (and s (get s 'domain-name))))
+                   (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
            (setq mbox-beg (point-min)
                  mbox-end (if %-pos (car %-pos)
                             (or @-pos

-                                (point-max)))))
+                                (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.
 
          ;; Done canonicalizing address.
          ;; We are now back in extraction-buffer.


@@ -1306,10 +1265,10 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                     (setq quote-end (- (point) 2))
                     (save-excursion
                       (backward-char 1)
                     (setq quote-end (- (point) 2))
                     (save-excursion
                       (backward-char 1)

-                      (mail-extr-delete-char 1)
+                      (delete-char 1)

                       (goto-char quote-beg)
                       (or (eobp)
                       (goto-char quote-beg)
                       (or (eobp)

-                          (mail-extr-delete-char 1)))
+                          (delete-char 1)))

                     (mail-extr-undo-backslash-quoting quote-beg quote-end)
                     (or (eq ?\  (char-after (point)))
                         (insert " "))
                     (mail-extr-undo-backslash-quoting quote-beg quote-end)
                     (or (eq ?\  (char-after (point)))
                         (insert " "))


@@ -1319,16 +1278,16 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                     (if (memq (char-after (1+ (point))) '(?_ ?=))
                         (progn
                           (forward-char 1)
                     (if (memq (char-after (1+ (point))) '(?_ ?=))
                         (progn
                           (forward-char 1)

-                          (mail-extr-delete-char 1)
+                          (delete-char 1)

                           (insert ?\ ))
                       (if \.-ends-name
                           (narrow-to-region (point-min) (point))
                           (insert ?\ ))
                       (if \.-ends-name
                           (narrow-to-region (point-min) (point))

-                        (mail-extr-delete-char 1)
+                        (delete-char 1)

                         (insert " ")))
                     ;;          (setq mailbox-name-processed-flag t)
                     )
                    ((memq (char-syntax char) '(?. ?\\))
                         (insert " ")))
                     ;;          (setq mailbox-name-processed-flag t)
                     )
                    ((memq (char-syntax char) '(?. ?\\))

-                    (mail-extr-delete-char 1)
+                    (delete-char 1)

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


@@ -1350,16 +1309,15 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 
                         ;; Copy the contents of the individual fields that
                         ;; might hold name data to the beginning.
 
                         ;; Copy the contents of the individual fields that
                         ;; might hold name data to the beginning.

-                        (mapcar
-                         (function
-                          (lambda (field-pattern)
-                            (cond
-                             ((save-excursion
-                                (re-search-forward field-pattern nil t))
-                              (insert-buffer-substring (current-buffer)
-                                                       (match-beginning 1)
-                                                       (match-end 1))
-                              (insert " ")))))
+                        (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))
                          (list mail-extr-x400-encoded-address-given-name-pattern
                                mail-extr-x400-encoded-address-surname-pattern
                                mail-extr-x400-encoded-address-full-name-pattern))


@@ -1407,47 +1365,46 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          ;; Initial code by Jamie Zawinski <jwz@lucid.com>
          ;; *** Make it work when there's a suffix as well.
          (goto-char (point-min))
          ;; Initial code by Jamie Zawinski <jwz@lucid.com>
          ;; *** Make it work when there's a suffix as well.
          (goto-char (point-min))

-         (cond ((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)))
-                (save-excursion
-                  (set-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))))))
-                (cond ((and mi
-                            ;; TODO: use better table than syntax table
-                            (eq ?w (char-syntax mi)))
-                       (goto-char (match-beginning 3))
-                       (insert (upcase mi) ". ")))))
+         (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.
          (let ((buffer-length (- (point-max) (point-min)))
                (i 0)
                (names-match-flag t))
 
          ;; Nuke name if it is the same as mailbox name.
          (let ((buffer-length (- (point-max) (point-min)))
                (i 0)
                (names-match-flag t))

-           (cond ((and (> buffer-length 0)
-                       (eq buffer-length (- mbox-end mbox-beg)))
-                  (goto-char (point-max))
-                  (insert-buffer-substring canonicalization-buffer
-                                           mbox-beg mbox-end)
-                  (while (and names-match-flag
-                              (< i buffer-length))
-                    (or (eq (downcase (char-after (+ i (point-min))))
-                            (downcase
-                             (char-after (+ i buffer-length (point-min)))))
-                        (setq names-match-flag nil))
-                    (setq i (1+ i)))
-                  (delete-region (+ (point-min) buffer-length) (point-max))
-                  (if names-match-flag
-                      (narrow-to-region (point) (point))))))
+           (when (and (> buffer-length 0)
+                      (eq buffer-length (- mbox-end mbox-beg)))
+             (goto-char (point-max))
+             (insert-buffer-substring canonicalization-buffer
+                                      mbox-beg mbox-end)
+             (while (and names-match-flag
+                         (< i buffer-length))
+               (or (eq (downcase (char-after (+ i (point-min))))
+                       (downcase
+                        (char-after (+ i buffer-length (point-min)))))
+                   (setq names-match-flag nil))
+               (setq i (1+ i)))
+             (delete-region (+ (point-min) buffer-length) (point-max))
+             (if names-match-flag
+                 (narrow-to-region (point) (point)))))

 
          ;; Nuke name if it's just one word.
          (goto-char (point-min))
 
          ;; Nuke name if it's just one word.
          (goto-char (point-min))


@@ -1459,8 +1416,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          (setq value-list
                (cons (list (if (not (= (point-min) (point-max)))
                                (buffer-string))
          (setq value-list
                (cons (list (if (not (= (point-min) (point-max)))
                                (buffer-string))

-                           (save-excursion
-                             (set-buffer canonicalization-buffer)
+                           (with-current-buffer canonicalization-buffer

                              (if (not (= (point-min) (point-max)))
                                  (buffer-string))))
                      value-list))
                              (if (not (= (point-min) (point-max)))
                                  (buffer-string))))
                      value-list))


@@ -1503,12 +1459,11 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        (skip-chars-forward "^({[\"'`")
        (let ((cbeg (point)))
          (set-syntax-table mail-extr-address-text-comment-syntax-table)
        (skip-chars-forward "^({[\"'`")
        (let ((cbeg (point)))
          (set-syntax-table mail-extr-address-text-comment-syntax-table)

-         (cond ((memq (following-char) '(?\' ?\`))
-                (search-forward "'" nil 'move
-                                (if (eq ?\' (following-char)) 2 1)))
-               (t
-                (or (mail-extr-safe-move-sexp 1)
-                    (goto-char (point-max)))))
+         (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.
          (set-syntax-table mail-extr-address-text-syntax-table)
          (when (eq (char-after cbeg) ?\()
            ;; Delete the comment itself.


@@ -1522,7 +1477,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
              (if (bobp)
                  (delete-region (point) cbeg)
                (just-one-space))))))
              (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
       ;; This was moved above.
       ;; Fix . used as space
       ;; But it belongs here because it occurs not only as


@@ -1533,60 +1488,59 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
       ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
       ;;  (replace-match "\\1 \\2" t))
 
       ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
       ;;  (replace-match "\\1 \\2" t))
 

-      (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))))))
+      (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)
 
       ;; Loop over the words (and other junk) in the name.
       (goto-char (point-min))
       (while (not name-done-flag)

-       
-       (cond (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)))
-
-       (cond (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)
-              ))
-       
+
+       (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)
        ;; 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
        ;; 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)))
         ;; 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))
         ;; Stop after name suffix
         ((and (>= word-count 2)
               (looking-at mail-extr-full-name-suffix-pattern))


@@ -1608,13 +1562,13 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                 (upcase-word 1)))
          (setq word-found-flag t)
          (setq name-done-flag 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))
         ;; 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))
         ;; Check for initial last name followed by comma
         ((and (eq ?, (following-char))
               (eq word-count 1))


@@ -1622,13 +1576,13 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          (setq last-name-comma-flag t)
          (or (eq ?\  (following-char))
              (insert ?\ )))
          (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))
         ;; Stop before trailing comma-separated comment
         ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
         ;; *** This case is redundant???
         ;;((eq ?, (following-char))
         ;; (setq name-done-flag t))

-        
+

         ;; Delete parenthesized/quoted comment/nickname
         ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
          (setq cbeg (point))
         ;; Delete parenthesized/quoted comment/nickname
         ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
          (setq cbeg (point))


@@ -1636,7 +1590,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          (cond ((memq (following-char) '(?\' ?\`))
                 (or (search-forward "'" nil t
                                     (if (eq ?\' (following-char)) 2 1))
          (cond ((memq (following-char) '(?\' ?\`))
                 (or (search-forward "'" nil t
                                     (if (eq ?\' (following-char)) 2 1))

-                    (mail-extr-delete-char 1)))
+                    (delete-char 1)))

                (t
                 (or (mail-extr-safe-move-sexp 1)
                     (goto-char (point-max)))))
                (t
                 (or (mail-extr-safe-move-sexp 1)
                     (goto-char (point-max)))))


@@ -1660,16 +1614,16 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
            (delete-region cbeg cend)
            (if initial
                (insert initial ". ")))))
            (delete-region cbeg cend)
            (if initial
                (insert initial ". ")))))

-        
+

         ;; Handle *Stupid* VMS date stamps
         ((looking-at mail-extr-stupid-vms-date-stamp-pattern)
          (replace-match "" t))
         ;; Handle *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))
         ;; 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)
         ;; Skip initial garbage characters.
         ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
         ((and (eq word-count 0)


@@ -1678,32 +1632,33 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          ;; *** Skip backward over these???
          ;; (skip-chars-backward "& \"")
          (narrow-to-region (point) (point-max)))
          ;; *** Skip backward over these???
          ;; (skip-chars-backward "& \"")
          (narrow-to-region (point) (point-max)))

-        
+

         ;; Various stopping points
         ((or
         ;; 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 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 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 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
           ;; Stop before telephone numbers

-          (looking-at mail-extr-telephone-extension-pattern))
+          (and (>= word-count 1)
+               (looking-at mail-extr-telephone-extension-pattern)))

          (setq name-done-flag t))
          (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)))
         ;; 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)))
         ;; Fixup initials
         ((looking-at mail-extr-initial-pattern)
          (or (eq (following-char) (upcase (following-char)))


@@ -1715,20 +1670,20 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
          (or (eq ?\  (following-char))
              (insert ?\ ))
          (setq word-found-flag t))
          (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 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)))
         ;; Handle & substitution, when & is last and is not first.
         ((and (> word-count 0)
               (eq ?\  (preceding-char))
               (eq (following-char) ?&)
               (eq (1+ (point)) (point-max)))

-         (mail-extr-delete-char 1)
+         (delete-char 1)

          (capitalize-region
           (point)
           (progn
          (capitalize-region
           (point)
           (progn


@@ -1749,40 +1704,47 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
         ((looking-at mail-extr-name-pattern)
          (setq name-beg (point))
          (setq name-end (match-end 0))
         ((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
          ;; Certain words will be dropped if they are at the end.
          (and (>= word-count 2)
               (not lower-case-flag)
               (or

-               ;; A trailing 4-or-more letter lowercase words preceded by
+               ;; Trailing 4-or-more letter lowercase words preceded by

                ;; mixed case or uppercase words will be dropped.
                ;; mixed case or uppercase words will be dropped.

-               (looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'")
+               (looking-at "[[:lower:]]\\{4,\\}[ \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))
                ;; 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.
          ;; Set the flags that indicate whether we have seen a lowercase
          ;; word, a mixed case word, and an uppercase word.

-         (if (re-search-forward "[a-z]" name-end t)
+         (if (re-search-forward "[[:lower:]]" name-end t)

              (if (progn
                    (goto-char name-beg)
              (if (progn
                    (goto-char name-beg)

-                   (re-search-forward "[A-Z]" name-end t))
+                   (re-search-forward "[[:upper:]]" name-end t))

                  (setq mixed-case-flag t)
                (setq lower-case-flag t))
 ;;         (setq upper-case-flag 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)
          ))
          (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))))
        ;; 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
       ;; 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


@@ -1797,32 +1759,32 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                        (or (and drop-last-word-if-trailing-flag
                                 last-word-beg)
                            (point)))
                        (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.
       ;; 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.

-      (cond ((not suffix-flag)
-            (goto-char (point-min))
-            (let ((case-fold-search t))
-              (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
-                  (erase-buffer)))))
+      (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)
 
       ;; If last name first put it at end (but before suffix)

-      (cond (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))))
-      
+      (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))
       ;; Delete leading and trailing junk characters.
       ;; *** This is probably completely unneeded now.
       ;;(goto-char (point-max))


@@ -1834,7 +1796,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
       ;;                    (goto-char (point-min))
       ;;                    (skip-chars-forward mail-extr-non-begin-name-chars)
       ;;                    (point)))
       ;;                    (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)
       ;; Compress whitespace
       (goto-char (point-min))
       (while (re-search-forward "[ \t\n]+" nil t)


@@ -1851,29 +1813,41 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 ;; 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.
 ;; 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.
+;;
+;; Source: ISO 3166 Maintenance Agency
+;; http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/list-en1-semic.txt
+;; http://www.iana.org/domain-names.htm
+;; http://www.iana.org/cctld/cctld-whois.htm
+;; Latest change: Mon Jul  8 14:21:59 CEST 2002

 
 (defconst mail-extr-all-top-level-domains
 
 (defconst mail-extr-all-top-level-domains

-  (let ((ob (make-vector 509 0)))
-    (mapcar
-     (function
-      (lambda (x)
-       (put (intern (downcase (car x)) ob)
-            'domain-name
-            (if (nth 2 x)
-                (format (nth 2 x) (nth 1 x))
-              (nth 1 x)))))
+  (let ((ob (make-vector 739 0)))
+    (mapc
+     (lambda (x)
+       (put (intern (downcase (car x)) ob)
+           'domain-name
+           (if (nth 2 x)
+               (format (nth 2 x) (nth 1 x))
+             (nth 1 x))))

      '(
        ;; ISO 3166 codes:
        ("ad" "Andorra")
        ("ae" "United Arab Emirates")
      '(
        ;; ISO 3166 codes:
        ("ad" "Andorra")
        ("ae" "United Arab Emirates")

+       ("af" "Afghanistan")

        ("ag" "Antigua and Barbuda")
        ("ag" "Antigua and Barbuda")

+       ("ai" "Anguilla")

        ("al" "Albania")
        ("am" "Armenia")
        ("al" "Albania")
        ("am" "Armenia")

+       ("an" "Netherlands Antilles")

        ("ao" "Angola")
        ("aq" "Antarctica")             ; continent
        ("ar" "Argentina"       "Argentine Republic")
        ("ao" "Angola")
        ("aq" "Antarctica")             ; continent
        ("ar" "Argentina"       "Argentine Republic")

+       ("as" "American Samoa")

        ("at" "Austria"         "The Republic of %s")
        ("au" "Australia")
        ("at" "Austria"         "The Republic of %s")
        ("au" "Australia")

+       ("aw" "Aruba")

        ("az" "Azerbaijan")
        ("ba" "Bosnia-Herzegovina")
        ("bb" "Barbados")
        ("az" "Azerbaijan")
        ("ba" "Bosnia-Herzegovina")
        ("bb" "Barbados")


@@ -1882,27 +1856,38 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("bf" "Burkina Faso")
        ("bg" "Bulgaria")
        ("bh" "Bahrain")
        ("bf" "Burkina Faso")
        ("bg" "Bulgaria")
        ("bh" "Bahrain")

+       ("bi" "Burundi")
+       ("bj" "Benin")

        ("bm" "Bermuda")
        ("bm" "Bermuda")

+       ("bn" "Brunei Darussalam")

        ("bo" "Bolivia"         "Republic of %s")
        ("br" "Brazil"          "The Federative Republic of %s")
        ("bs" "Bahamas")
        ("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")
        ("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")
        ("cg" "Congo")
        ("ch" "Switzerland"     "The Swiss Confederation")

-       ("ci" "Ivory Coast")
+       ("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")
        ("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")

-       ("cs" "Czechoslovakia")

        ("cu" "Cuba")
        ("cu" "Cuba")

+       ("cv" "Cape Verde")
+       ("cx" "Christmas Island")

        ("cy" "Cyprus")
        ("cz" "Czech Republic")
        ("de" "Germany")
        ("cy" "Cyprus")
        ("cz" "Czech Republic")
        ("de" "Germany")

+       ("dj" "Djibouti")

        ("dk" "Denmark")
        ("dm" "Dominica")
        ("do" "Dominican Republic"      "The %s")
        ("dk" "Denmark")
        ("dm" "Dominica")
        ("do" "Dominican Republic"      "The %s")


@@ -1910,25 +1895,36 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("ec" "Ecuador"         "The Republic of %s")
        ("ee" "Estonia")
        ("eg" "Egypt"           "The Arab Republic of %s")
        ("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")
        ("fi" "Finland"         "The Republic of %s")
        ("er" "Eritrea")
        ("es" "Spain"           "The Kingdom of %s")
        ("et" "Ethiopia")
        ("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")
        ("fo" "Faroe Islands")
        ("fr" "France")
        ("ga" "Gabon")
        ("gb" "United Kingdom")
        ("gd" "Grenada")
        ("ge" "Georgia")

-       ("gf" "Guyana (Fr.)")
-       ("gj" "Fiji")
+       ("gf" "French Guiana")
+       ("gh" "Ghana")
+       ("gi" "Gibraltar")

        ("gl" "Greenland")
        ("gm" "Gambia")
        ("gl" "Greenland")
        ("gm" "Gambia")

+       ("gn" "Guinea")

        ("gp" "Guadeloupe (Fr.)")
        ("gp" "Guadeloupe (Fr.)")

+       ("gq" "Equatorial Guinea")

        ("gr" "Greece"          "The Hellenic Republic (%s)")
        ("gr" "Greece"          "The Hellenic Republic (%s)")

+       ("gs" "South Georgia and The South Sandwich Islands")

        ("gt" "Guatemala")
        ("gu" "Guam (U.S.)")
        ("gt" "Guatemala")
        ("gu" "Guam (U.S.)")

+       ("gw" "Guinea-Bissau")
+       ("gy" "Guyana")

        ("hk" "Hong Kong")
        ("hk" "Hong Kong")

+       ("hm" "Heard Island and Mcdonald Islands")

        ("hn" "Honduras")
        ("hr" "Croatia"         "Croatia (Hrvatska)")
        ("ht" "Haiti")
        ("hn" "Honduras")
        ("hr" "Croatia"         "Croatia (Hrvatska)")
        ("ht" "Haiti")


@@ -1936,112 +1932,170 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("id" "Indonesia")
        ("ie" "Ireland")
        ("il" "Israel"          "The State of %s")
        ("id" "Indonesia")
        ("ie" "Ireland")
        ("il" "Israel"          "The State of %s")

-       ("im" "Isle of Man"     "The %s")
+       ("im" "Isle of Man"     "The %s") ; NOT in ISO 3166-1 of 2001-02-26

        ("in" "India"           "The Republic of %s")
        ("in" "India"           "The Republic of %s")

-       ("ir" "Iran")
+       ("io" "British Indian Ocean Territory")
+       ("iq" "Iraq")
+       ("ir" "Iran"            "Islamic Republic of %s")

        ("is" "Iceland"         "The Republic of %s")
        ("it" "Italy"           "The Italian Republic")
        ("jm" "Jamaica")
        ("jo" "Jordan")
        ("jp" "Japan")
        ("ke" "Kenya")
        ("is" "Iceland"         "The Republic of %s")
        ("it" "Italy"           "The Italian Republic")
        ("jm" "Jamaica")
        ("jo" "Jordan")
        ("jp" "Japan")
        ("ke" "Kenya")

-       ("kn" "St. Kitts, Nevis, and Anguilla")
-       ("kp" "Korea (North)")
-       ("kr" "Korea (South)")
+       ("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")
        ("kw" "Kuwait")

+       ("ky" "Cayman Islands")

        ("kz" "Kazakhstan")
        ("kz" "Kazakhstan")

+       ("la" "Lao People's Democratic Republic")

        ("lb" "Lebanon")
        ("lb" "Lebanon")

-       ("lc" "St. Lucia")
+       ("lc" "Saint Lucia")

        ("li" "Liechtenstein")
        ("lk" "Sri Lanka"       "The Democratic Socialist Republic of %s")
        ("li" "Liechtenstein")
        ("lk" "Sri Lanka"       "The Democratic Socialist Republic of %s")

+       ("lr" "Liberia")

        ("ls" "Lesotho")
        ("lt" "Lithuania")
        ("lu" "Luxembourg")
        ("lv" "Latvia")
        ("ls" "Lesotho")
        ("lt" "Lithuania")
        ("lu" "Luxembourg")
        ("lv" "Latvia")

+       ("ly" "Libyan Arab Jamahiriya")

        ("ma" "Morocco")
        ("mc" "Monaco")
        ("md" "Moldova"         "The Republic of %s")
        ("mg" "Madagascar")
        ("ma" "Morocco")
        ("mc" "Monaco")
        ("md" "Moldova"         "The Republic of %s")
        ("mg" "Madagascar")

-       ("mk" "Macedonia")
+       ("mh" "Marshall Islands")
+       ("mk" "Macedonia"       "The Former Yugoslav Republic of %s")

        ("ml" "Mali")
        ("ml" "Mali")

-       ("mo" "Macau")
+       ("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")
        ("mt" "Malta")
        ("mu" "Mauritius")
        ("mv" "Maldives")
        ("mw" "Malawi")
        ("mx" "Mexico"          "The United Mexican States")

-       ("my" "Malaysia"                "%s (changed to Myanmar?)")             ;???
+       ("my" "Malaysia")

        ("mz" "Mozambique")
        ("na" "Namibia")
        ("nc" "New Caledonia (Fr.)")
        ("ne" "Niger")                  ; In .fr domain
        ("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
        ("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")
        ("nu" "Niue")
        ("nz" "New Zealand")

+       ("om" "Oman")

        ("pa" "Panama")
        ("pe" "Peru")
        ("pa" "Panama")
        ("pe" "Peru")

-       ("pf" "Polynesia (Fr.)")
+       ("pf" "French Polynesia")

        ("pg" "Papua New Guinea")
        ("ph" "Philippines"     "The Republic of the %s")
        ("pk" "Pakistan")
        ("pl" "Poland")
        ("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.)")
        ("pr" "Puerto Rico (U.S.)")

+       ("ps" "Palestinian Territory, Occupied")

        ("pt" "Portugal"                "The Portuguese Republic")
        ("pt" "Portugal"                "The Portuguese Republic")

+       ("pw" "Palau")

        ("py" "Paraguay")
        ("qa" "Qatar")
        ("re" "Reunion (Fr.)")          ; In .fr domain
        ("ro" "Romania")
        ("py" "Paraguay")
        ("qa" "Qatar")
        ("re" "Reunion (Fr.)")          ; In .fr domain
        ("ro" "Romania")

-       ("ru" "Russian Federation")
+       ("ru" "Russia"          "Russian Federation")
+       ("rw" "Rwanda")

        ("sa" "Saudi Arabia")
        ("sa" "Saudi Arabia")

+       ("sb" "Solomon Islands")

        ("sc" "Seychelles")
        ("sd" "Sudan")
        ("se" "Sweden"          "The Kingdom of %s")
        ("sg" "Singapore"       "The Republic of %s")
        ("sc" "Seychelles")
        ("sd" "Sudan")
        ("se" "Sweden"          "The Kingdom of %s")
        ("sg" "Singapore"       "The Republic of %s")

+       ("sh" "Saint Helena")

        ("si" "Slovenia")
        ("si" "Slovenia")

-       ("sj" "Svalbard and Jan Mayen Is.") ; In .no domain
+       ("sj" "Svalbard and Jan Mayen") ; In .no domain

        ("sk" "Slovakia"                "The Slovak Republic")
        ("sk" "Slovakia"                "The Slovak Republic")

+       ("sl" "Sierra Leone")

        ("sm" "San Marino")
        ("sn" "Senegal")
        ("sm" "San Marino")
        ("sn" "Senegal")

+       ("so" "Somalia")

        ("sr" "Suriname")
        ("sr" "Suriname")

-       ("su" "U.S.S.R."                "The Union of Soviet Socialist Republics")
+       ("st" "Sao Tome and Principe")
+       ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
+       ("sv" "El Salvador")
+       ("sy" "Syrian Arab Republic")

        ("sz" "Swaziland")
        ("sz" "Swaziland")

+       ("tc" "Turks and Caicos Islands")
+       ("td" "Chad")
+       ("tf" "French Southern Territories")

        ("tg" "Togo")
        ("th" "Thailand"                "The Kingdom of %s")
        ("tg" "Togo")
        ("th" "Thailand"                "The Kingdom of %s")

-       ("tm" "Turkmenistan")           ; In .su domain
+       ("tj" "Tajikistan")
+       ("tk" "Tokelau")
+       ("tl" "East Timor")
+       ("tm" "Turkmenistan")

        ("tn" "Tunisia")
        ("to" "Tonga")
        ("tn" "Tunisia")
        ("to" "Tonga")

+       ("tp" "East Timor")

        ("tr" "Turkey"          "The Republic of %s")
        ("tt" "Trinidad and Tobago")
        ("tr" "Turkey"          "The Republic of %s")
        ("tt" "Trinidad and Tobago")

-       ("tw" "Taiwan")
+       ("tv" "Tuvalu")
+       ("tw" "Taiwan"          "%s, Province of China")
+       ("tz" "Tanzania"                "United Republic of %s")

        ("ua" "Ukraine")
        ("ua" "Ukraine")

+       ("ug" "Uganda")

        ("uk" "United Kingdom"  "The %s of Great Britain and Northern Ireland")
        ("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")
        ("us" "United States"   "The %s of America")
        ("uy" "Uruguay"         "The Eastern Republic of %s")

-       ("vc" "St. Vincent and the Grenadines")
+       ("uz" "Uzbekistan")
+       ("va" "Holy See (Vatican City State)")
+       ("vc" "Saint Vincent and the Grenadines")

        ("ve" "Venezuela"       "The Republic of %s")
        ("ve" "Venezuela"       "The Republic of %s")

-       ("vi" "Virgin Islands (U.S.)")
+       ("vg" "Virgin Islands, British")
+       ("vi" "Virgin Islands, U.S.")

        ("vn" "Vietnam")
        ("vu" "Vanuatu")
        ("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")
        ("yu" "Yugoslavia"      "Yugoslavia, AKA Serbia-Montenegro")
        ("za" "South Africa"    "The Republic of %s")

+       ("zm" "Zambia")

        ("zw" "Zimbabwe"                "Republic of %s")
        ("zw" "Zimbabwe"                "Republic of %s")

-       ;; Special top-level domains:
-       ("arpa" t               "Advanced Research Projects Agency (U.S. DoD)")
-       ("bitnet" t             "Because It's Time NET")
+       ;; Generic Domains:
+       ("aero" t                "Air Transport Industry")
+       ("biz" t                 "Businesses")

        ("com" t                        "Commercial")
        ("com" t                        "Commercial")

-       ("edu" t                        "Educational")
-       ("gov" t                        "Government (U.S.)")
-       ("int" t                        "International (NATO)")
-       ("mil" t                        "Military (U.S.)")
-       ("nato" t               "North Atlantic Treaty Organization")
+       ("coop" t                "Cooperative Associations")
+       ("info" t                "Info")
+       ("museum" t              "Museums")
+       ("name" t                "Individuals")

        ("net" t                        "Network")
        ("org" t                        "Non-profit Organization")
        ("net" t                        "Network")
        ("org" t                        "Non-profit Organization")

-       ;;("unter-dom" t                "? (Ger.)")
+       ;;("pro" t                 "Credentialed professionals")
+       ;;("bitnet" t           "Because It's Time NET")
+       ("gov" t                        "United States Government")
+       ("edu" t                        "Educational")
+       ("mil" t                        "United States Military")
+       ("int" t                        "International Treaties")
+       ;;("nato" t             "North Atlantic Treaty Organization")

        ("uucp" t               "Unix to Unix CoPy")
        ("uucp" t               "Unix to Unix CoPy")

-       ;;("fipnet" nil         "?")
+       ;; Infrastructure Domains:
+       ("arpa" t               "Advanced Research Projects Agency (U.S. DoD)")

        ))
     ob))
 
        ))
     ob))
 


@@ -2060,7 +2114,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 \f
 ;(let ((all nil))
 ;  (mapatoms #'(lambda (x)
 \f
 ;(let ((all nil))
 ;  (mapatoms #'(lambda (x)

-;              (if (and (boundp x) 
+;              (if (and (boundp x)

 ;                       (string-match "^mail-extr-" (symbol-name x)))
 ;                  (setq all (cons x all)))))
 ;  (setq all (sort all #'string-lessp))
 ;                       (string-match "^mail-extr-" (symbol-name x)))
 ;                  (setq all (cons x all)))))
 ;  (setq all (sort all #'string-lessp))


@@ -2072,4 +2126,5 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
 \f
 (provide 'mail-extr)
 
 \f
 (provide 'mail-extr)
 

+;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d

 ;;; mail-extr.el ends here
 ;;; mail-extr.el ends here