From 4c7a257628bf9d402c38edef0f327aba9f8a4b51 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 22 Oct 2001 11:54:57 +0000 Subject: [PATCH] >>>>> In <1003713514.29396.1@cvs.m17n.org> >>>>> m17n CVS administrator wrote: > Log Message: > Synch with Oort Gnus (the function `message-get-reply-headers' has not > been synch'ed yet). * message.el (message-get-reply-headers): Synch with Oort Gnus. --- lisp/message.el | 194 +++++++++++++++++++++++++------------------------------ 1 file changed, 88 insertions(+), 106 deletions(-) diff --git a/lisp/message.el b/lisp/message.el index 2874b51..4083b53 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4772,91 +4772,67 @@ OTHER-HEADERS is an alist of header/value pairs." (Subject . ,(or subject "")))))) (defun message-get-reply-headers (wide &optional to-address) - (let (follow-to mct never-mct from to cc reply-to mrt mft) + (let (follow-to mct never-mct to cc author mft recipients) ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (when message-use-mail-copies-to - (message-fetch-field "mail-copies-to")) - reply-to (message-fetch-field "reply-to") - mrt (when message-use-mail-reply-to - (message-fetch-field "mail-reply-to")) - mft (when (and (not (or to-address mrt reply-to)) - message-use-mail-followup-to) - (message-fetch-field "mail-followup-to"))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond - ((and (or (equal (downcase mct) "never") - (equal (downcase mct) "nobody"))) - (when (or (not (eq message-use-mail-copies-to 'ask)) - (message-y-or-n-p - (concat "Obey Mail-Copies-To: never? ") t "\ + (let ((mrt (when message-use-mail-reply-to + (message-fetch-field "mail-reply-to"))) + (reply-to (message-fetch-field "reply-to"))) + (setq to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (when message-use-mail-copies-to + (message-fetch-field "mail-copies-to")) + author (or mrt + reply-to + (message-fetch-field "from") + "") + mft (when (and (not (or to-address mrt reply-to)) + message-use-mail-followup-to) + (message-fetch-field "mail-followup-to")))) + + (save-match-data + ;; Handle special values of Mail-Copies-To. + (when mct + (cond ((or (equal (downcase mct) "never") + (equal (downcase mct) "nobody")) + (when (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: never? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' directs you not to send your response to the author.")) - (setq never-mct t)) - (setq mct nil)) - ((and (or (equal (downcase mct) "always") - (equal (downcase mct) "poster"))) - (if (or (not (eq message-use-mail-copies-to 'ask)) - (message-y-or-n-p - (concat "Obey Mail-Copies-To: always? ") t "\ + (setq never-mct t)) + (setq mct nil)) + ((or (equal (downcase mct) "always") + (equal (downcase mct) "poster")) + (if (or (not (eq message-use-mail-copies-to 'ask)) + (message-y-or-n-p + (concat "Obey Mail-Copies-To: always? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' sends a copy of your response to the author.")) - (setq mct (or mrt reply-to from)) - (setq mct nil))) - ((and (eq message-use-mail-copies-to 'ask) - (not (message-y-or-n-p - (concat "Obey Mail-Copies-To: " mct " ? ") t "\ + (setq mct author) + (setq mct nil))) + ((and (eq message-use-mail-copies-to 'ask) + (not (message-y-or-n-p + (concat "Obey Mail-Copies-To: " mct " ? ") t "\ You should normally obey the Mail-Copies-To: header. `Mail-Copies-To: " mct "' sends a copy of your response to " (if (string-match "," mct) "the specified addresses" "that address") "."))) - (setq mct nil)))) - - ;; Handle Mail-Followup-To. - (when (and mft - (eq message-use-mail-followup-to 'ask) - (not (message-y-or-n-p - (concat "Obey Mail-Followup-To: " mft "? ") t "\ -You should normally obey the Mail-Followup-To: header. - - `Mail-Followup-To: " mft "' -directs your response to " (if (string-match "," mft) - "the specified addresses" - "that address only") ". - -A typical situation where Mail-Followup-To is used is when the author thinks -that further discussion should take place only in " - (if (string-match "," mft) - "the specified mailing lists" - "that mailing list") "."))) - (setq mft nil)) + (setq mct nil)))) - (if (and (not mft) - (or (not wide) - to-address)) - (progn - (setq follow-to (list (cons 'To - (or to-address mrt reply-to mft from)))) - (when (and wide mct - (not (member (cons 'To mct) follow-to))) - (push (cons 'Cc mct) follow-to))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (if (and mft - wide - (or (not (eq message-use-mail-followup-to 'ask)) - (message-y-or-n-p "Obey Mail-Followup-To? " t "\ + ;; Build (textual) list of new recipient addresses. + (cond + ((not wide) + (setq recipients (concat ", " author))) + ((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 @@ -4877,43 +4853,49 @@ fragmented and very difficult to follow. Also, some source/announcement lists are not intended for discussion; responses here are directed to other addresses."))) - (insert mft) - (unless never-mct - (insert (or mrt reply-to from ""))) - (insert (if to (concat (if (bolp) "" ", ") to) "")) - (insert (if mct (concat (if (bolp) "" ", ") mct) "")) - (insert (if cc (concat (if (bolp) "" ", ") cc) ""))) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " " t t)) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer)))) - (goto-char (point-min)) - ;; Perhaps "Mail-Copies-To: never" removed the only address? - (when (eobp) - (insert (or mrt reply-to from ""))) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-string)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (let ((ccs (cons 'Cc (mapconcat - (lambda (addr) (cdr addr)) ccalist ", ")))) - (when (string-match "^ +" (cdr ccs)) - (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to))) - ;; Allow the user to be asked whether or not to reply to all - ;; recipients in a wide reply. - (if (and ccalist wide message-wide-reply-confirm-recipients - (not (y-or-n-p "Reply to all recipients? "))) - (setq follow-to (delq (assoc 'Cc follow-to) follow-to))))) + (setq recipients (concat ", " mft))) + (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)))) + (t + (setq recipients (if never-mct "" (concat ", " author))) + (if to (setq recipients (concat recipients ", " to))) + (if cc (setq recipients (concat recipients ", " cc))) + (if mct (setq recipients (concat recipients ", " mct))))) + ;; Strip the leading ", ". + (unless (string= recipients "") + (setq recipients (substring recipients 2))) + ;; Squeeze whitespace. + (while (string-match "[ \t][ \t]+" recipients) + (setq recipients (replace-match " " t t recipients))) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (let ((rmail-dont-reply-to-names message-dont-reply-to-names)) + (setq recipients (rmail-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 ") ...). + (setq recipients + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (message-tokenize-header recipients))) + ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) + (let ((s recipients)) + (while s + (setq recipients (delq (assoc (car (pop s)) s) recipients)))) + ;; Build the header alist. Allow the user to be asked whether + ;; or not to reply to all recipients in a wide reply. + (setq follow-to (list (cons 'To (cdr (pop recipients))))) + (when (and recipients + (or (not message-wide-reply-confirm-recipients) + (y-or-n-p "Reply to all recipients? "))) + (setq recipients (mapconcat + (lambda (addr) (cdr addr)) recipients ", ")) + (if (string-match "^ +" recipients) + (setq recipients (substring recipients (match-end 0)))) + (push (cons 'Cc recipients) follow-to))) follow-to)) ;;;###autoload -- 1.7.10.4