Function: ietf-drums-parse-address

ietf-drums-parse-address is a byte-compiled function defined in ietf-drums.el.gz.

Signature

(ietf-drums-parse-address STRING &optional DECODE)

Documentation

Parse STRING and return a MAILBOX / DISPLAY-NAME pair.

STRING here is supposed to be an RFC822(bis) mail address, and will commonly look like, for instance:

  "=?utf-8?Q?Andr=C3=A9?= <andre@example.com>"

If you have an already-decoded address, like

  "André <andre@example.com>"

this function can't be used to parse that. Instead, use mail-header-parse-address-lax to make a guess at what's the name and what's the address.

If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(that's the "=?utf...q...=?") stuff.

Aliases

mail-header-parse-address

Source Code

;; Defined in /usr/src/emacs/lisp/mail/ietf-drums.el.gz
(defun ietf-drums-parse-address (string &optional decode)
  "Parse STRING and return a MAILBOX / DISPLAY-NAME pair.
STRING here is supposed to be an RFC822(bis) mail address, and
will commonly look like, for instance:

  \"=?utf-8?Q?Andr=C3=A9?= <andre@example.com>\"

If you have an already-decoded address, like

  \"André <andre@example.com>\"

this function can't be used to parse that.  Instead, use
`mail-header-parse-address-lax' to make a guess at what's the
name and what's the address.

If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(that's the \"=?utf...q...=?\") stuff."
  (when decode
    (require 'rfc2047))
  (with-temp-buffer
    (let (display-name mailbox c display-string)
      (ietf-drums-init string)
      (while (not (eobp))
	(setq c (char-after))
        ;; If we have an uneven number of quote characters,
        ;; `forward-sexp' will fail.  In these cases, just delete the
        ;; final of these quote characters.
        (when (and (eq c ?\")
                   (not
                    (save-excursion
                      (ignore-errors
                        (forward-sexp 1)
                        t))))
          (delete-char 1)
          (setq c (char-after)))
	(cond
	 ((or (eq c ? )
	      (eq c ?\t))
	  (forward-char 1))
	 ((eq c ?\()
	  (forward-sexp 1))
	 ((eq c ?\")
	  (push (buffer-substring
		 (1+ (point)) (progn (forward-sexp 1) (1- (point))))
		display-name))
	 ((looking-at (concat "[" ietf-drums-atext-token "@" "]"))
	  (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
		display-name))
	 ((eq c ?<)
	  (setq mailbox
		(ietf-drums-remove-whitespace
		 (ietf-drums-remove-comments
		  (buffer-substring
		   (1+ (point))
		   (progn (forward-sexp 1) (1- (point))))))))
	 (t
	  (forward-char 1))))
      ;; If we found no display-name, then we look for comments.
      (if display-name
	  (setq display-string
		(mapconcat #'identity (reverse display-name) " "))
	(setq display-string (ietf-drums-get-comment string)))
      (if (not mailbox)
	  (when (and display-string
		     (string-search "@" display-string))
	    (cons
	     (mapconcat #'identity (nreverse display-name) "")
	     (ietf-drums-get-comment string)))
	(cons mailbox (if (and decode display-string)
                          (rfc2047-decode-string display-string)
                        display-string))))))