wacky message-get-reply-headers logic

wacky message-get-reply-headers logic

[Paul Jarc]

[-- Attachment #1: Type: text/plain, Size: 429 bytes --]

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: message.el logic sanity --]
[-- Type: text/x-patch, Size: 6014 bytes --]

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 <foo@bar>") ...).
+      (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)

Re: wacky message-get-reply-headers logic

[Paul Jarc]

I wrote:
> This patch [...]

Oops, forgot the Changelog entry:
	* message.el (message-get-reply-headers): restructure the
	logic and add comments.
Can someone commit this?  (Or is there anything wrong with it?)


paul

Re: wacky message-get-reply-headers logic

[Kai Großjohann]

prj@po.cwru.edu (Paul Jarc) writes:

> Can someone commit this?  (Or is there anything wrong with it?)

Committed.  (We're sure to get bug reports if anything is wrong :-)

kai
-- 
Lisp is kinda like tpircstsoP