Function: mail-fetch-field

mail-fetch-field is an autoloaded and byte-compiled function defined in mail-utils.el.gz.

Signature

(mail-fetch-field FIELD-NAME &optional LAST ALL LIST DELETE)

Documentation

Return the value of the header field whose type is FIELD-NAME.

If second arg LAST is non-nil, use the last field of type FIELD-NAME. If third arg ALL is non-nil, concatenate all such fields with commas between. If 4th arg LIST is non-nil, return a list of all such fields. If 5th arg DELETE is non-nil, delete all header lines that are included in the result. The buffer should be narrowed to just the header, else false matches may be returned from the message body.

Source Code

;; Defined in /usr/src/emacs/lisp/mail/mail-utils.el.gz
;;;###autoload
(defun mail-fetch-field (field-name &optional last all list delete)
  "Return the value of the header field whose type is FIELD-NAME.
If second arg LAST is non-nil, use the last field of type FIELD-NAME.
If third arg ALL is non-nil, concatenate all such fields with commas between.
If 4th arg LIST is non-nil, return a list of all such fields.
If 5th arg DELETE is non-nil, delete all header lines that are
included in the result.
The buffer should be narrowed to just the header, else false
matches may be returned from the message body."
  (save-excursion
    (goto-char (point-min))
    (let ((case-fold-search t)
	  (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
      (if (or all list)
	  (let ((value (if all "")))
	    (while (re-search-forward name nil t)
	      (let ((opoint (point)))
		(while (progn (forward-line 1)
			      (looking-at "[ \t]")))
		;; Back up over newline, then trailing spaces or tabs
		(forward-char -1)
		(skip-chars-backward " \t" opoint)
		(if list
		    (setq value (cons (buffer-substring-no-properties
				       opoint (point))
				      value))
		  (setq value (concat value
				      (if (string= value "") "" ", ")
				      (buffer-substring-no-properties
				       opoint (point)))))
                (if delete
                    (delete-region (point-at-bol) (point)))))
	    (if list
		value
	      (and (not (string= value "")) value)))
	(if (re-search-forward name nil t)
	    (progn
	      (if last (while (re-search-forward name nil t)))
	      (let ((opoint (point)))
		(while (progn (forward-line 1)
			      (looking-at "[ \t]")))
		;; Back up over newline, then trailing spaces or tabs
		(forward-char -1)
		(skip-chars-backward " \t" opoint)
                (prog1
                    (buffer-substring-no-properties opoint (point))
                  (if delete
                      (delete-region (point-at-bol) (1+ (point))))))))))))