;;; mail-extr.el --- extract full name and address from RFC 822 mail header -*- coding: utf-8 -*-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1997, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1994, 1997, 2001-2011 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
;; Maintainer: FSF
;; Keywords: mail
+;; Package: mail-utils
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
(defvar disable-initial-guessing-flag) ; dynamic assignment
-(defvar cbeg) ; dynamic assignment
-(defvar cend) ; dynamic assignment
+(defvar mailextr-cbeg) ; dynamic assignment
+(defvar mailextr-cend) ; dynamic assignment
(defvar mail-extr-all-top-level-domains) ; Defined below.
;;;###autoload
record-pos-symbol
first-real-pos last-real-pos
phrase-beg phrase-end
- cbeg cend ; dynamically set from -voodoo
+ ;; Dynamically set in mail-extr-voodoo.
+ mailextr-cbeg mailextr-cend
quote-beg quote-end
atom-beg atom-end
mbox-beg mbox-end
((eq char ?\()
(set-syntax-table mail-extr-address-comment-syntax-table)
;; only record the first non-empty comment's position
- (if (and (not cbeg)
+ (if (and (not mailextr-cbeg)
(save-excursion
(forward-char 1)
(mail-extr-skip-whitespace-forward)
(not (eq ?\) (char-after (point))))))
- (setq cbeg (point)))
+ (setq mailextr-cbeg (point)))
;; TODO: don't record if unbalanced
(or (mail-extr-safe-move-sexp 1)
(forward-char 1))
(set-syntax-table mail-extr-address-syntax-table)
- (if (and cbeg
- (not cend))
- (setq cend (point))))
+ (if (and mailextr-cbeg
+ (not mailextr-cend))
+ (setq mailextr-cend (point))))
;; quoted text
((eq char ?\")
;; only record the first non-empty quote's position
(setq char ?\() ; HAVE I NO SHAME??
)
;; record the position of various interesting chars, determine
- ;; legality later.
+ ;; validity later.
((setq record-pos-symbol
(cdr (assq char
'((?< . <-pos) (?> . >-pos) (?@ . @-pos)
((eq char ?.)
(forward-char 1))
((memq char '(
- ;; comment terminator illegal
+ ;; comment terminator invalid
?\)
- ;; domain literal terminator illegal
+ ;; domain literal terminator invalid
?\]
;; \ allowed only within quoted strings,
;; domain literals, and comments
(> last-real-pos (1+ group-\;-pos))
(setq last-real-pos (1+ group-\;-pos)))
;; *** This may be wrong:
- (and cend
- (> cend group-\;-pos)
- (setq cend nil
- cbeg nil))
+ (and mailextr-cend
+ (> mailextr-cend group-\;-pos)
+ (setq mailextr-cend nil
+ mailextr-cbeg nil))
(and quote-end
(> quote-end group-\;-pos)
(setq quote-end nil
(narrow-to-region phrase-beg phrase-end))
;; Example: fml@foo.bar.dom (First M. Last)
- (cbeg
- (narrow-to-region (1+ cbeg) (1- cend))
+ (mailextr-cbeg
+ (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend))
(mail-extr-undo-backslash-quoting (point-min) (point-max))
;; Deal with spacing problems
(case-fold-search nil)
mixed-case-flag lower-case-flag ;;upper-case-flag
suffix-flag last-name-comma-flag
- ;;cbeg cend
initial
begin-again-flag
drop-this-word-if-trailing-flag
;; Delete parenthesized/quoted comment/nickname
((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
- (setq cbeg (point))
+ (setq mailextr-cbeg (point))
(set-syntax-table mail-extr-address-text-comment-syntax-table)
(cond ((memq (following-char) '(?\' ?\`))
(or (search-forward "'" nil t
(or (mail-extr-safe-move-sexp 1)
(goto-char (point-max)))))
(set-syntax-table mail-extr-address-text-syntax-table)
- (setq cend (point))
+ (setq mailextr-cend (point))
(cond
;; Handle case of entire name being quoted
((and (eq word-count 0)
(looking-at " *\\'")
- (>= (- cend cbeg) 2))
- (narrow-to-region (1+ cbeg) (1- cend))
+ (>= (- mailextr-cend mailextr-cbeg) 2))
+ (narrow-to-region (1+ mailextr-cbeg) (1- mailextr-cend))
(goto-char (point-min)))
(t
;; Handle case of quoted initial
- (if (and (or (= 3 (- cend cbeg))
- (and (= 4 (- cend cbeg))
- (eq ?. (char-after (+ 2 cbeg)))))
+ (if (and (or (= 3 (- mailextr-cend mailextr-cbeg))
+ (and (= 4 (- mailextr-cend mailextr-cbeg))
+ (eq ?. (char-after (+ 2 mailextr-cbeg)))))
(not (looking-at " *\\'")))
- (setq initial (char-after (1+ cbeg)))
+ (setq initial (char-after (1+ mailextr-cbeg)))
(setq initial nil))
- (delete-region cbeg cend)
+ (delete-region mailextr-cbeg mailextr-cend)
(if initial
(insert initial ". ")))))
;; 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
+;; Latest change: 2007/11/15
(defconst mail-extr-all-top-level-domains
(let ((ob (make-vector 739 0)))
(nth 1 x))))
'(
;; ISO 3166 codes:
+ ("ac" "Ascension Island")
("ad" "Andorra")
("ae" "United Arab Emirates")
("af" "Afghanistan")
("at" "Austria" "The Republic of %s")
("au" "Australia")
("aw" "Aruba")
+ ("ax" "Aland Islands")
("az" "Azerbaijan")
("ba" "Bosnia-Herzegovina")
("bb" "Barbados")
("bh" "Bahrain")
("bi" "Burundi")
("bj" "Benin")
+ ("bl" "Saint Barthelemy")
("bm" "Bermuda")
("bn" "Brunei Darussalam")
("bo" "Bolivia" "Republic of %s")
("er" "Eritrea")
("es" "Spain" "The Kingdom of %s")
("et" "Ethiopia")
+ ("eu" "European Union")
("fi" "Finland" "The Republic of %s")
("fj" "Fiji")
("fk" "Falkland Islands (Malvinas)")
("gd" "Grenada")
("ge" "Georgia")
("gf" "French Guiana")
+ ("gg" "Guernsey")
("gh" "Ghana")
("gi" "Gibraltar")
("gl" "Greenland")
("ir" "Iran" "Islamic Republic of %s")
("is" "Iceland" "The Republic of %s")
("it" "Italy" "The Italian Republic")
+ ("je" "Jersey")
("jm" "Jamaica")
("jo" "Jordan")
("jp" "Japan")
("ma" "Morocco")
("mc" "Monaco")
("md" "Moldova" "The Republic of %s")
+ ("me" "Montenegro")
+ ("mf" "Saint Martin (French part)")
("mg" "Madagascar")
("mh" "Marshall Islands")
("mk" "Macedonia" "The Former Yugoslav Republic of %s")
("qa" "Qatar")
("re" "Reunion (Fr.)") ; In .fr domain
("ro" "Romania")
+ ("rs" "Serbia")
("ru" "Russia" "Russian Federation")
("rw" "Rwanda")
("sa" "Saudi Arabia")
("zw" "Zimbabwe" "Republic of %s")
;; Generic Domains:
("aero" t "Air Transport Industry")
+ ("asia" t "Pan-Asia and Asia Pacific community")
("biz" t "Businesses")
+ ("cat" t "Catalan language and culture")
("com" t "Commercial")
("coop" t "Cooperative Associations")
("info" t "Info")
+ ("jobs" t "Employment")
+ ("mobi" t "Mobile products")
("museum" t "Museums")
("name" t "Individuals")
("net" t "Network")
("org" t "Non-profit Organization")
- ;;("pro" t "Credentialed professionals")
+ ("pro" t "Credentialed professionals")
+ ("tel" t "Contact data")
+ ("travel" t "Travel industry")
;;("bitnet" t "Because It's Time NET")
("gov" t "United States Government")
("edu" t "Educational")
\f
(provide 'mail-extr)
-;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d
;;; mail-extr.el ends here