X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5df4f04cd32af723742c81095b38ae83b3c2b462..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/mail/mail-extr.el diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 18bbb60e3a..5164ea1bfe 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1,11 +1,12 @@ ;;; 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, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1991-1994, 1997, 2001-2015 Free Software Foundation, +;; Inc. ;; Author: Joe Wells -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: mail +;; Package: mail-utils ;; This file is part of GNU Emacs. @@ -218,14 +219,14 @@ ;; (defcustom mail-extr-guess-middle-initial nil - "*Whether to try to guess middle initial from mail address. + "Whether to try to guess middle initial from mail address. If true, then when we see an address like \"John Smith \" we will assume that \"John Q. Smith\" is the fellow's name." :type 'boolean :group 'mail-extr) (defcustom mail-extr-ignore-single-names nil - "*Whether to ignore a name that is just a single word. + "Whether to ignore a name that is just a single word. If true, then when we see an address like \"Idiot \" we will act as though we couldn't find a full name in the address." :type 'boolean @@ -244,19 +245,19 @@ we will act as though we couldn't find a full name in the address." (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. + "Matches prefixes to the full name that identify a person's position. These are stripped from the full name because they do not contribute to uniquely identifying the person." :type 'regexp :group 'mail-extr) (defcustom mail-extr-@-binds-tighter-than-! nil - "*Whether the local mail transport agent looks at ! before @." + "Whether the local mail transport agent looks at ! before @." :type 'boolean :group 'mail-extr) (defcustom mail-extr-mangle-uucp nil - "*Whether to throw away information in UUCP addresses + "Whether to throw away information in UUCP addresses by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." :type 'boolean :group 'mail-extr) @@ -394,7 +395,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." ;; Matches ham radio call signs. ;; Help from: Mat Maessen N2NJZ , Mark Feit ;; , Michael Covington . -;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW +;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KD3FU KD6EUI KD6HBW ;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH ;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO (defconst mail-extr-ham-call-sign-pattern @@ -690,8 +691,8 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL ;; (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 @@ -761,7 +762,8 @@ consing a string.)" 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 @@ -795,19 +797,19 @@ consing a string.)" ((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 @@ -993,10 +995,10 @@ consing a string.)" (> 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 @@ -1227,8 +1229,8 @@ consing a string.)" (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 @@ -1453,7 +1455,7 @@ consing a string.)" )) (defcustom mail-extr-disable-voodoo "\\cj" - "*If it is a regexp, names matching it will never be modified. + "If it is a regexp, names matching it will never be modified. If it is neither nil nor a string, modifying of names will never take place. It affects how `mail-extract-address-components' works." :type '(choice (regexp :size 0) @@ -1471,7 +1473,6 @@ place. It affects how `mail-extract-address-components' works." (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 @@ -1617,7 +1618,7 @@ place. It affects how `mail-extract-address-components' works." ;; 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 @@ -1627,23 +1628,23 @@ place. It affects how `mail-extract-address-components' works." (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 ". "))))) @@ -1961,7 +1962,7 @@ place. It affects how `mail-extract-address-components' works." ("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") @@ -2173,5 +2174,4 @@ place. It affects how `mail-extract-address-components' works." (provide 'mail-extr) -;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d ;;; mail-extr.el ends here