Function: message-get-reply-headers
message-get-reply-headers is a byte-compiled function defined in
message.el.gz.
Signature
(message-get-reply-headers WIDE &optional TO-ADDRESS ADDRESS-HEADERS)
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/message.el.gz
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
;; Gmane renames "To". Look at "Original-To", too, if it is present in
;; message-header-synonyms.
(setq to (or (message-fetch-field "to")
(and (cl-loop for synonym in message-header-synonyms
when (memq 'Original-To synonym)
return t)
(message-fetch-field "original-to")))
cc (message-fetch-field "cc")
extra (when message-extra-wide-headers
(mapconcat #'identity
(mapcar #'message-fetch-field
message-extra-wide-headers)
", "))
mct (message-fetch-field "mail-copies-to")
author (or (message-fetch-field "mail-reply-to")
(message-fetch-field "reply-to")
(message-fetch-field "from")
"")
mft (and message-use-mail-followup-to
(message-fetch-field "mail-followup-to"))))
;; Handle special values of Mail-Copies-To.
(when mct
(cond ((or (equal (downcase mct) "never")
(equal (downcase mct) "nobody"))
(setq never-mct t)
(setq mct nil))
((or (equal (downcase mct) "always")
(equal (downcase mct) "poster"))
(setq mct author))))
(save-match-data
;; Build (textual) list of new recipient addresses.
(cond
(to-address
(setq recipients (concat ", " to-address))
;; If the author explicitly asked for a copy, we don't deny it to them.
(if mct (setq recipients (concat recipients ", " mct))))
((not wide)
(setq recipients (concat ", " author)))
(address-headers
(dolist (header address-headers)
(let ((value (message-fetch-field header)))
(when value
(setq recipients (concat recipients ", " value))))))
((and mft
(string-match "[^ \t,]" mft)
(or (not (eq message-use-mail-followup-to 'ask))
(message-y-or-n-p "Obey Mail-Followup-To? " t "\
You should normally obey the Mail-Followup-To: header. In this
article, it has the value of
" mft "
which directs your response to " (if (string-search "," mft)
"the specified addresses"
"that address only") ".
Most commonly, Mail-Followup-To is used by a mailing list poster to
express that responses should be sent to just the list, and not the
poster as well.
If a message is posted to several mailing lists, Mail-Followup-To may
also be used to direct the following discussion to one list only,
because discussions that are spread over several lists tend to be
fragmented and very difficult to follow.
Also, some source/announcement lists are not intended for discussion;
responses here are directed to other addresses.
You may customize the variable `message-use-mail-followup-to', if you
want to get rid of this query permanently.")))
(setq recipients (concat ", " mft)))
(t
(setq recipients (if never-mct "" (concat ", " author)))
(if to (setq recipients (concat recipients ", " to)))
(if cc (setq recipients (concat recipients ", " cc)))
(if extra (setq recipients (concat recipients ", " extra)))
(if mct (setq recipients (concat recipients ", " mct)))))
(if (>= (length recipients) 2)
;; Strip the leading ", ".
(setq recipients (substring recipients 2)))
;; Squeeze whitespace.
(while (string-match "[ \t][ \t]+" recipients)
(setq recipients (replace-match " " t t recipients)))
;; Remove addresses that match `message-dont-reply-to-names'.
(setq recipients
(cond ((functionp message-dont-reply-to-names)
(mapconcat
#'identity
(delq nil
(mapcar (lambda (mail)
(unless (funcall message-dont-reply-to-names
(mail-strip-quoted-names mail))
mail))
(message-tokenize-header recipients)))
", "))
(t (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
(mail-dont-reply-to recipients)))))
;; Perhaps "Mail-Copies-To: never" removed the only address?
(if (string-equal recipients "")
(setq recipients author))
;; Convert string to a list of (("foo@bar" . "Name <Foo@BAR>") ...).
(setq recipients
(mapcar
(lambda (addr)
(if message-alter-recipients-function
(funcall message-alter-recipients-function
(cons (downcase (mail-strip-quoted-names addr))
addr))
(cons (downcase (mail-strip-quoted-names addr)) addr)))
(message-tokenize-header recipients)))
;; Remove all duplicates.
(let ((s recipients))
(while s
(let ((address (car (pop s))))
(while (assoc address s)
(setq recipients (delq (assoc address s) recipients)
s (delq (assoc address s) s))))))
;; Remove hierarchical lists that are contained within each other,
;; if message-hierarchical-addresses is defined.
(when message-hierarchical-addresses
(let ((plain-addrs (mapcar #'car recipients))
subaddrs recip)
(while plain-addrs
(setq subaddrs (assoc (car plain-addrs)
message-hierarchical-addresses)
plain-addrs (cdr plain-addrs))
(when subaddrs
(setq subaddrs (cdr subaddrs))
(while subaddrs
(setq recip (assoc (car subaddrs) recipients)
subaddrs (cdr subaddrs))
(if recip
(setq recipients (delq recip recipients))))))))
(setq recipients (message-prune-recipients recipients))
(setq recipients
(cl-loop for (id . address) in recipients
collect (cons id (message--alter-repeat-address address))))
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(when (or (< (length recipients) 2)
(not message-wide-reply-confirm-recipients)
(y-or-n-p "Reply to all recipients? "))
(if never-mct
;; The author has requested never to get a (wide)
;; response, so put everybody else into the To header.
;; This avoids looking as if we're To-in somebody else in
;; specific, and just Cc-in the rest.
(setq follow-to (list
(cons 'To
(mapconcat #'cdr recipients ", "))))
;; Put the first recipient in the To header.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
;; Put the rest of the recipients in Cc.
(when recipients
(setq recipients (mapconcat #'cdr recipients ", "))
(if (string-match "^ +" recipients)
(setq recipients (substring recipients (match-end 0))))
(push (cons 'Cc recipients) follow-to)))))
follow-to))