Function: gnus-extract-address-components

gnus-extract-address-components is a byte-compiled function defined in gnus-util.el.gz.

Signature

(gnus-extract-address-components FROM)

Documentation

Extract address components from a From header.

Given an RFC-822 (or later) address FROM, extract name and address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple solution than mail-header-parse-address, which works much better, but is slower.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-util.el.gz
(defun gnus-extract-address-components (from)
  "Extract address components from a From header.
Given an RFC-822 (or later) address FROM, extract name and address.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).  Much more simple
solution than `mail-header-parse-address', which works much better, but
is slower."
  (let (name address)
    ;; First find the address - the thing with the @ in it.  This may
    ;; not be accurate in mail addresses, but does the trick most of
    ;; the time in news messages.
    (cond (;; Check ``<foo@bar>'' first in order to handle the quite common
	   ;; form ``"abc@xyz" <foo@bar>'' (i.e. ``@'' as part of a comment)
	   ;; correctly.
	   (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from)
	   (setq address (substring from (match-beginning 1) (match-end 1))))
	  ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
	   (setq address (substring from (match-beginning 0) (match-end 0)))))
    ;; Then we check whether the "name <address>" format is used.
    (and address
	 ;; Linear white space is not required.
	 (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
	 (and (setq name (substring from 0 (match-beginning 0)))
	      ;; Strip any quotes from the name.
	      (string-match "^\".*\"$" name)
	      (setq name (substring name 1 (1- (match-end 0))))))
    ;; If not, then "address (name)" is used.
    (or name
	(and (string-match "(.+)" from)
	     (setq name (substring from (1+ (match-beginning 0))
				   (1- (match-end 0)))))
	(and (string-search "()" from)
	     (setq name address))
	;; XOVER might not support folded From headers.
	(and (string-match "(.*" from)
	     (setq name (substring from (1+ (match-beginning 0))
				   (match-end 0)))))
    (list (if (string= name "") nil name) (or address from))))