(report-emacs-bug): Mention major and minor modes.

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

diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index d6a1f9ffe1c155ae783c5e732950c49647bd0d47..1995933382f785b32387ee965618521c0e01506c 100644 (file)
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,4 +1,4 @@
-;;; 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, 2001
 ;;   Free Software Foundation, Inc.
 
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001
 ;;   Free Software Foundation, Inc.


@@ -29,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.)


@@ -61,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:


@@ -121,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


@@ -140,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.


@@ -169,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.
 


@@ -226,7 +226,7 @@ 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."
   "*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."


@@ -318,16 +318,16 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
 
 (defconst mail-extr-leading-garbage "\\W+")
 
 
 (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 +363,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 +376,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 +435,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 +459,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,24 +511,20 @@ 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
  '((mail-extr-address-syntax-table
     (?\000 ?\037 "w")                  ;control characters
     (?\040      " ")                   ;SPC


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

-(defsubst 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.
-  (delete-region (point) (+ (point) n)))
-

 (defsubst mail-extr-skip-whitespace-forward ()
   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
 (defsubst mail-extr-skip-whitespace-forward ()
   ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.

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

 
 (defsubst mail-extr-skip-whitespace-backward ()
   ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
 
 (defsubst mail-extr-skip-whitespace-backward ()
   ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.

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

 
 
 (defsubst mail-extr-undo-backslash-quoting (beg end)
 
 
 (defsubst mail-extr-undo-backslash-quoting (beg end)


@@ -639,14 +630,14 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
       (goto-char (point-min))
       ;; undo \ quoting
       (while (search-forward "\\" nil t)
       (goto-char (point-min))
       ;; undo \ quoting
       (while (search-forward "\\" nil t)

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

        (or (eobp)
            (forward-char 1))))))
 
 (defsubst mail-extr-nuke-char-at (pos)
   (save-excursion
     (goto-char pos)
        (or (eobp)
            (forward-char 1))))))
 
 (defsubst mail-extr-nuke-char-at (pos)
   (save-excursion
     (goto-char pos)

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

     (insert ?\ )))
 
 (put 'mail-extr-nuke-outside-range
     (insert ?\ )))
 
 (put 'mail-extr-nuke-outside-range


@@ -655,27 +646,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.


@@ -718,7 +710,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


@@ -727,9 +720,9 @@ 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
 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.)"
+\(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)


@@ -741,7 +734,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
       (widen)
       (erase-buffer)
       (setq case-fold-search nil)
       (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 ?\ )


@@ -761,12 +754,12 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        (buffer-disable-undo canonicalization-buffer)
        (setq case-fold-search nil))
 
        (buffer-disable-undo canonicalization-buffer)
        (setq case-fold-search nil))
 

-      
+

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


@@ -909,27 +902,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)


@@ -937,15 +928,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.


@@ -982,19 +973,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)


@@ -1018,11 +1008,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)


@@ -1032,57 +1022,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)


@@ -1097,8 +1085,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))


@@ -1110,118 +1097,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 (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))
-                          (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.


@@ -1295,10 +1283,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 " "))


@@ -1308,16 +1296,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)
                     )


@@ -1339,16 +1327,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))


@@ -1396,47 +1383,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))


@@ -1448,8 +1434,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))


@@ -1492,12 +1477,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.


@@ -1511,7 +1495,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


@@ -1522,60 +1506,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))


@@ -1597,13 +1580,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))


@@ -1611,13 +1594,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))


@@ -1625,7 +1608,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)))))


@@ -1649,16 +1632,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)


@@ -1667,33 +1650,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
           (and (>= word-count 1)
                (looking-at mail-extr-telephone-extension-pattern)))
          (setq name-done-flag t))
           ;; Stop before telephone numbers
           (and (>= word-count 1)
                (looking-at mail-extr-telephone-extension-pattern)))
          (setq name-done-flag t))

-        
+

         ;; Delete ham radio call signs
         ((looking-at mail-extr-ham-call-sign-pattern)
          (delete-region (match-beginning 0) (match-end 0)))
         ;; 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)))


@@ -1705,20 +1688,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


@@ -1739,7 +1722,7 @@ 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)
          ;; Certain words will be dropped if they are at the end.
          (and (>= word-count 2)
               (not lower-case-flag)


@@ -1750,7 +1733,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                ;; 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.
          (if (re-search-forward "[a-z]" name-end t)
          ;; Set the flags that indicate whether we have seen a lowercase
          ;; word, a mixed case word, and an uppercase word.
          (if (re-search-forward "[a-z]" name-end t)


@@ -1761,7 +1744,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
                (setq lower-case-flag t))
 ;;         (setq upper-case-flag t)
            )
                (setq lower-case-flag t))
 ;;         (setq upper-case-flag t)
            )

-         
+

          (goto-char name-end)
          (setq word-found-flag t))
 
          (goto-char name-end)
          (setq word-found-flag t))
 


@@ -1775,11 +1758,11 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
         (t
          (setq name-done-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


@@ -1794,32 +1777,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))


@@ -1831,7 +1814,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)


@@ -1848,17 +1831,24 @@ 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
   (let ((ob (make-vector 739 0)))
 
 (defconst mail-extr-all-top-level-domains
   (let ((ob (make-vector 739 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)))))
+    (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")
      '(
        ;; ISO 3166 codes:
        ("ad" "Andorra")


@@ -1898,7 +1888,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("bz" "Belize")
        ("ca" "Canada")
        ("cc" "Cocos (Keeling) Islands")
        ("bz" "Belize")
        ("ca" "Canada")
        ("cc" "Cocos (Keeling) Islands")

-       ("cd" "The Democratic Republic of The Congo")
+       ("cd" "Congo"            "The Democratic Republic of the %s")

        ("cf" "Central African Republic")
        ("cg" "Congo")
        ("ch" "Switzerland"     "The Swiss Confederation")
        ("cf" "Central African Republic")
        ("cg" "Congo")
        ("ch" "Switzerland"     "The Swiss Confederation")


@@ -1946,13 +1936,13 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("gp" "Guadeloupe (Fr.)")
        ("gq" "Equatorial Guinea")
        ("gr" "Greece"          "The Hellenic Republic (%s)")
        ("gp" "Guadeloupe (Fr.)")
        ("gq" "Equatorial Guinea")
        ("gr" "Greece"          "The Hellenic Republic (%s)")

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

        ("gt" "Guatemala")
        ("gu" "Guam (U.S.)")
        ("gw" "Guinea-Bissau")
        ("gy" "Guyana")
        ("hk" "Hong Kong")
        ("gt" "Guatemala")
        ("gu" "Guam (U.S.)")
        ("gw" "Guinea-Bissau")
        ("gy" "Guyana")
        ("hk" "Hong Kong")

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

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


@@ -1980,7 +1970,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("kr" "Korea (South)"   "Republic of Korea")
        ("kw" "Kuwait")
        ("ky" "Cayman Islands")
        ("kr" "Korea (South)"   "Republic of Korea")
        ("kw" "Kuwait")
        ("ky" "Cayman Islands")

-       ("kz" "Kazakstan")
+       ("kz" "Kazakhstan")

        ("la" "Lao People's Democratic Republic")
        ("lb" "Lebanon")
        ("lc" "Saint Lucia")
        ("la" "Lao People's Democratic Republic")
        ("lb" "Lebanon")
        ("lc" "Saint Lucia")


@@ -2001,7 +1991,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("ml" "Mali")
        ("mm" "Myanmar")
        ("mn" "Mongolia")
        ("ml" "Mali")
        ("mm" "Myanmar")
        ("mn" "Mongolia")

-       ("mo" "Macau")
+       ("mo" "Macao")

        ("mp" "Northern Mariana Islands")
        ("mq" "Martinique")
        ("mr" "Mauritania")
        ("mp" "Northern Mariana Islands")
        ("mq" "Martinique")
        ("mr" "Mauritania")


@@ -2011,7 +2001,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("mv" "Maldives")
        ("mw" "Malawi")
        ("mx" "Mexico"          "The United Mexican States")
        ("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.)")
        ("mz" "Mozambique")
        ("na" "Namibia")
        ("nc" "New Caledonia (Fr.)")


@@ -2028,7 +2018,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("om" "Oman")
        ("pa" "Panama")
        ("pe" "Peru")
        ("om" "Oman")
        ("pa" "Panama")
        ("pe" "Peru")

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

        ("pg" "Papua New Guinea")
        ("ph" "Philippines"     "The Republic of the %s")
        ("pk" "Pakistan")
        ("pg" "Papua New Guinea")
        ("ph" "Philippines"     "The Republic of the %s")
        ("pk" "Pakistan")


@@ -2060,18 +2050,19 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("sn" "Senegal")
        ("so" "Somalia")
        ("sr" "Suriname")
        ("sn" "Senegal")
        ("so" "Somalia")
        ("sr" "Suriname")

-       ("st" "Sao Tome And Principe")
+       ("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")
        ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
        ("sv" "El Salvador")
        ("sy" "Syrian Arab Republic")
        ("sz" "Swaziland")

-       ("tc" "Turks And Caicos Islands")
+       ("tc" "Turks and Caicos Islands")

        ("td" "Chad")
        ("tf" "French Southern Territories")
        ("tg" "Togo")
        ("th" "Thailand"                "The Kingdom of %s")
        ("tj" "Tajikistan")
        ("tk" "Tokelau")
        ("td" "Chad")
        ("tf" "French Southern Territories")
        ("tg" "Togo")
        ("th" "Thailand"                "The Kingdom of %s")
        ("tj" "Tajikistan")
        ("tk" "Tokelau")

+       ("tl" "East Timor")

        ("tm" "Turkmenistan")
        ("tn" "Tunisia")
        ("to" "Tonga")
        ("tm" "Turkmenistan")
        ("tn" "Tunisia")
        ("to" "Tonga")


@@ -2089,7 +2080,7 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("uy" "Uruguay"         "The Eastern Republic of %s")
        ("uz" "Uzbekistan")
        ("va" "Holy See (Vatican City State)")
        ("uy" "Uruguay"         "The Eastern Republic of %s")
        ("uz" "Uzbekistan")
        ("va" "Holy See (Vatican City State)")

-       ("vc" "St. Vincent and the Grenadines")
+       ("vc" "Saint Vincent and the Grenadines")

        ("ve" "Venezuela"       "The Republic of %s")
        ("vg" "Virgin Islands, British")
        ("vi" "Virgin Islands, U.S.")
        ("ve" "Venezuela"       "The Republic of %s")
        ("vg" "Virgin Islands, British")
        ("vi" "Virgin Islands, U.S.")


@@ -2103,20 +2094,26 @@ ADDRESS may be a string or a buffer.  If it is a buffer, the visible
        ("za" "South Africa"    "The Republic of %s")
        ("zm" "Zambia")
        ("zw" "Zimbabwe"                "Republic of %s")
        ("za" "South Africa"    "The Republic of %s")
        ("zm" "Zambia")
        ("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))
 


@@ -2135,7 +2132,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))


@@ -2147,4 +2144,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