From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/39424 Path: main.gmane.org!not-for-mail From: prj@po.cwru.edu (Paul Jarc) Newsgroups: gmane.emacs.gnus.general Subject: wacky message-get-reply-headers logic Date: Thu, 18 Oct 2001 18:06:33 -0400 Organization: What did you have in mind? A short, blunt, human pyramid? Sender: owner-ding@hpc.uh.edu Message-ID: NNTP-Posting-Host: coloc-standby.netfonds.no Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1035175129 27762 80.91.224.250 (21 Oct 2002 04:38:49 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Mon, 21 Oct 2002 04:38:49 +0000 (UTC) Return-Path: Original-Received: (qmail 10351 invoked from network); 18 Oct 2001 22:07:48 -0000 Original-Received: from malifon.math.uh.edu (mail@129.7.128.13) by mastaler.com with SMTP; 18 Oct 2001 22:07:48 -0000 Original-Received: from sina.hpc.uh.edu ([129.7.128.10] ident=lists) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 15uLJb-0005cw-00; Thu, 18 Oct 2001 17:06:59 -0500 Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Thu, 18 Oct 2001 17:06:37 -0500 (CDT) Original-Received: from sclp3.sclp.com (qmailr@sclp3.sclp.com [209.196.61.66]) by sina.hpc.uh.edu (8.9.3/8.9.3) with SMTP id RAA09801 for ; Thu, 18 Oct 2001 17:06:20 -0500 (CDT) Original-Received: (qmail 10319 invoked by alias); 18 Oct 2001 22:06:36 -0000 Original-Received: (qmail 10314 invoked from network); 18 Oct 2001 22:06:36 -0000 Original-Received: from multivac.student.cwru.edu (HELO multivac.cwru.edu) (qmail-remote@129.22.96.25) by gnus.org with SMTP; 18 Oct 2001 22:06:36 -0000 Original-Received: (qmail 20876 invoked by uid 500); 18 Oct 2001 22:06:55 -0000 Mail-Followup-To: ding@gnus.org Original-To: ding@gnus.org Mail-Copies-To: never Original-Lines: 12 User-Agent: Gnus/5.090004 (Oort Gnus v0.04) Emacs/20.7 Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:39424 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:39424 --=-=-= This patch makes message-get-reply-headers much easier to read, by rearranging the logic and adding some comments. I think it fixes a bug or two as well, but it's hard to tell, since the old logic is so hard to understand. :) Anyway, if I introduced any new bugs or inadvertently copied some old ones (note the comment "Is this a bug?"), they should be much easier to fix now. My paperwork is now on file with the FSF. paul --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=message.patch Content-Description: message.el logic sanity Index: lisp/message.el =================================================================== RCS file: /usr/local/cvsroot/gnus/lisp/message.el,v retrieving revision 6.131 diff -u -r6.131 message.el --- lisp/message.el 2001/10/17 17:53:42 6.131 +++ lisp/message.el 2001/10/18 21:55:57 @@ -4078,14 +4078,15 @@ (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 ccalist) + (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") + (setq to (message-fetch-field "to") cc (message-fetch-field "cc") mct (message-fetch-field "mail-copies-to") - reply-to (message-fetch-field "reply-to") - mrt (message-fetch-field "mail-reply-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"))) @@ -4097,24 +4098,17 @@ (setq mct nil)) ((or (equal (downcase mct) "always") (equal (downcase mct) "poster")) - (setq mct (or mrt reply-to from))))) + (setq mct author)))) - (if (and (not mft) - (or (not wide) - to-address)) - (progn - (setq follow-to (list (cons 'To (or to-address mrt reply-to from)))) - (when (and (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 - (concat "Obey Mail-Followup-To? ") t "\ + (save-match-data + ;; 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 @@ -4135,45 +4129,49 @@ 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 ", ". + (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 (defun message-reply (&optional to-address wide) --=-=-=--