;;; Code:
\f
+(defgroup mail-extr nil
+ "Extract full name and address from RFC 822 mail header."
+ :prefix "mail-extr-"
+ :group 'mail)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; User configuration variable definitions.
;;
-(defvar mail-extr-guess-middle-initial nil
+(defcustom mail-extr-guess-middle-initial nil
"*Whether to try to guess middle initial from mail address.
If true, then when we see an address like \"John Smith <jqs@host.com>\"
-we will assume that \"John Q. Smith\" is the fellow's name.")
+we will assume that \"John Q. Smith\" is the fellow's name."
+ :type 'boolean
+ :group 'mail-extr)
-(defvar mail-extr-ignore-single-names t
+(defcustom mail-extr-ignore-single-names t
"*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.")
+we will act as though we couldn't find a full name in the address."
+ :type 'boolean
+ :group 'mail-extr)
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
-(defvar mail-extr-full-name-prefixes
+(defcustom mail-extr-full-name-prefixes
(purecopy
"\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
"*Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
-uniquely identifying the person.")
+uniquely identifying the person."
+ :type 'regexp
+ :group 'mail-extr)
-(defvar mail-extr-@-binds-tighter-than-! nil
- "*Whether the local mail transport agent looks at ! before @.")
+(defcustom mail-extr-@-binds-tighter-than-! nil
+ "*Whether the local mail transport agent looks at ! before @."
+ :type 'boolean
+ :group 'mail-extr)
-(defvar mail-extr-mangle-uucp nil
+(defcustom mail-extr-mangle-uucp nil
"*Whether to throw away information in UUCP addresses
-by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\".")
+by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
+ :type 'boolean
+ :group 'mail-extr)
;;----------------------------------------------------------------------
;; what orderings are meaningful?????
;; You will also notice the consideration for the
;; Swedish/Finnish/Norwegian character set.
(defconst mail-extr-all-letters-but-separators
- (purecopy "][A-Za-z{|}'~0-9`\200-\377"))
+ (purecopy "][A-Za-z{|}'~0-9`\240-\377"))
;; Any character that can occur in a name in an RFC822 address including
;; the separator (hyphen and possibly period) for multipart names.
;; Any character that can start a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-first-letters (purecopy "A-Za-z\200-\377"))
+(defconst mail-extr-first-letters (purecopy "A-Za-z\240-\377"))
;; Any character that can end a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-last-letters (purecopy "A-Za-z\200-\377`'."))
+(defconst mail-extr-last-letters (purecopy "A-Za-z\240-\377`'."))
(defconst mail-extr-leading-garbage
(purecopy (format "[^%s]+" mail-extr-first-letters)))
(not (eobp))))
(let (char
end-of-address
- <-pos >-pos @-pos :-pos comma-pos !-pos %-pos \;-pos
+ <-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos
group-:-pos group-\;-pos route-addr-:-pos
record-pos-symbol
first-real-pos last-real-pos
((setq record-pos-symbol
(cdr (assq char
'((?< . <-pos) (?> . >-pos) (?@ . @-pos)
- (?: . :-pos) (?, . comma-pos) (?! . !-pos)
+ (?: . colon-pos) (?, . comma-pos) (?! . !-pos)
(?% . %-pos) (?\; . \;-pos)))))
(set record-pos-symbol
(cons (point) (symbol-value record-pos-symbol)))
;; 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)
- (eq 1 (length :-pos)) ;TODO: check if between last two @s
+ (eq 1 (length colon-pos)) ;TODO: check if between last two @s
(not \;-pos)
(not <-pos))
(goto-char (point-min))
;; Check for : that indicates GROUP list and for : part of
;; ROUTE-ADDR spec.
;; Can't possibly be more than two :. Nuke any extra.
- (while :-pos
- (setq temp (car :-pos)
- :-pos (cdr :-pos))
+ (while colon-pos
+ (setq temp (car colon-pos)
+ colon-pos (cdr colon-pos))
(cond ((and <-pos >-pos
(> temp <-pos)
(< temp >-pos))
(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)
(if initial
(insert initial ". ")))))
- ;; Handle & substitution
- ;; This is turned off because an & from the passwd file
- ;; should not really get into a mail address without
- ;; being substituted, and people use it for other things.
-;;; ((and (or (bobp)
-;;; (eq ?\ (preceding-char)))
-;;; (looking-at "&\\( \\|\\'\\)"))
-;;; (mail-extr-delete-char 1)
-;;; (capitalize-region
-;;; (point)
-;;; (progn
-;;; (insert-buffer-substring canonicalization-buffer
-;;; mbox-beg mbox-end)
-;;; (point)))
-;;; (setq disable-initial-guessing-flag t)
-;;; (setq word-found-flag t))
-
;; Handle *Stupid* VMS date stamps
((looking-at mail-extr-stupid-vms-date-stamp-pattern)
(replace-match "" t))
(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)))
+ (mail-extr-delete-char 1)
+ (capitalize-region
+ (point)
+ (progn
+ (insert-buffer-substring canonicalization-buffer
+ mbox-beg mbox-end)
+ (point)))
+ (setq disable-initial-guessing-flag t)
+ (setq word-found-flag t))
+
+ ;; Handle & between names, as in "Bob & Susie".
+ ((and (> word-count 0) (eq (following-char) ?\&))
+ (setq name-beg (point))
+ (setq name-end (1+ name-beg))
+ (setq word-found-flag t)
+ (goto-char name-end))
+
;; Regular name words
((looking-at mail-extr-name-pattern)
(setq name-beg (point))
(nth 1 x)))))
'(
;; ISO 3166 codes:
+ ("ad" "Andorra")
("ae" "United Arab Emirates")
("ag" "Antigua and Barbuda")
("al" "Albania")
+ ("am" "Armenia")
("ao" "Angola")
("aq" "Antarctica") ; continent
("ar" "Argentina" "Argentine Republic")
("at" "Austria" "The Republic of %s")
("au" "Australia")
("az" "Azerbaijan")
+ ("ba" "Bosnia-Herzegovina")
("bb" "Barbados")
("bd" "Bangladesh")
("be" "Belgium" "The Kingdom of %s")
("eg" "Egypt" "The Arab Republic of %s")
("er" "Eritrea")
("es" "Spain" "The Kingdom of %s")
+ ("et" "Ethiopia")
("fi" "Finland" "The Republic of %s")
- ("fj" "Fiji")
("fo" "Faroe Islands")
("fr" "France")
- ("gb" "Great Britain")
+ ("ga" "Gabon")
+ ("gb" "United Kingdom")
("gd" "Grenada")
("ge" "Georgia")
("gf" "Guyana (Fr.)")
+ ("gj" "Fiji")
+ ("gl" "Greenland")
+ ("gm" "Gambia")
("gp" "Guadeloupe (Fr.)")
("gr" "Greece" "The Hellenic Republic (%s)")
("gt" "Guatemala")
("gu" "Guam (U.S.)")
("hk" "Hong Kong")
("hn" "Honduras")
- ("hr" "Croatia")
+ ("hr" "Croatia" "Croatia (Hrvatska)")
("ht" "Haiti")
- ("hu" "Hungary" "The Hungarian Republic") ;???
+ ("hu" "Hungary" "The Hungarian Republic")
("id" "Indonesia")
("ie" "Ireland")
("il" "Israel" "The State of %s")
+ ("im" "Isle of Man" "The %s")
("in" "India" "The Republic of %s")
("ir" "Iran")
("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")
("lu" "Luxembourg")
("lv" "Latvia")
("ma" "Morocco")
- ("md" "Moldova")
+ ("mc" "Monaco")
+ ("md" "Moldova" "The Republic of %s")
("mg" "Madagascar")
("mk" "Macedonia")
("ml" "Mali")
("mo" "Macau")
("mt" "Malta")
("mu" "Mauritius")
+ ("mv" "Maldives")
("mw" "Malawi")
("mx" "Mexico" "The United Mexican States")
("my" "Malaysia" "%s (changed to Myanmar?)") ;???
("nl" "Netherlands" "The Kingdom of the %s")
("no" "Norway" "The Kingdom of %s")
("np" "Nepal") ; Via .in domain
+ ("nu" "Niue")
("nz" "New Zealand")
("pa" "Panama")
("pe" "Peru")
("pr" "Puerto Rico (U.S.)")
("pt" "Portugal" "The Portuguese Republic")
("py" "Paraguay")
+ ("qa" "Qatar")
("re" "Reunion (Fr.)") ; In .fr domain
("ro" "Romania")
("ru" "Russian Federation")
("si" "Slovenia")
("sj" "Svalbard and Jan Mayen Is.") ; In .no domain
("sk" "Slovakia" "The Slovak Republic")
+ ("sm" "San Marino")
("sn" "Senegal")
("sr" "Suriname")
- ("su" "Soviet Union")
+ ("su" "U.S.S.R." "The Union of Soviet Socialist Republics")
("sz" "Swaziland")
("tg" "Togo")
("th" "Thailand" "The Kingdom of %s")
("tm" "Turkmenistan") ; In .su domain
("tn" "Tunisia")
+ ("to" "Tonga")
("tr" "Turkey" "The Republic of %s")
("tt" "Trinidad and Tobago")
("tw" "Taiwan")
("vi" "Virgin Islands (U.S.)")
("vn" "Vietnam")
("vu" "Vanuatu")
- ("yu" "Yugoslavia" "The Socialist Federal Republic of %s")
- ("za" "South Africa" "The Republic of %s (or Zambia? Zaire?)")
+ ("yu" "Yugoslavia" "Yugoslavia, AKA Serbia-Montenegro")
+ ("za" "South Africa" "The Republic of %s")
("zw" "Zimbabwe" "Republic of %s")
;; Special top-level domains:
("arpa" t "Advanced Research Projects Agency (U.S. DoD)")