bug#13321: 24.3.0.50; Gmail error when replying from Gnus to github

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

Hi Katsumi,

Katsumi Yamaoka <yamaoka@jpl.org> writes:

> thierry.volpiatto@gmail.com wrote:
>> Katsumi Yamaoka <yamaoka@jpl.org> writes:
>>> Please let me say that a wide reply doesn't contain the author
>>> of an original mail in the recipient list is a bug.  To exclude
>>> an invalid address from a wide reply is not a feature;
>
>> It is not excluded in the patch, it is added to "cc" only if "wide" is
>> specified.
> [...]
>> Please have a look at the mail examples I sent in other posts.
>
> Hm, I haven't gotten it yet.  Could you try replying to a mail
> attached in this message as well (copy it to a mail group and do
> F)?
>
> [...]
>> The point is that with the patch I sent + the headers of the rejected
>> mail and the original mail where I reply to, you will be able to
>> understand what happen and fix it.
>
> Ok, I'll surely try it.

Here the whole patch:

diff --git a/lisp/message.el b/lisp/message.el
index 21847ac..d92c9ae 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -6753,8 +6753,7 @@ The function is called with one parameter, a cons cell ..."
       ;; message-header-synonyms.
       (setq to (or (message-fetch-field "to")
 		   (and (loop for synonym in message-header-synonyms
-			      when (memq 'Original-To synonym)
-			      return t)
+			      thereis (memq 'Original-To synonym))
 			(message-fetch-field "original-to")))
 	    cc (message-fetch-field "cc")
 	    extra (when message-extra-wide-headers
@@ -6764,16 +6763,15 @@ The function is called with one parameter, a cons cell ..."
 			       ", "))
 	    mct (message-fetch-field "mail-copies-to")
 	    author (or (message-fetch-field "mail-reply-to")
-		       (message-fetch-field "reply-to"))
+		       (message-fetch-field "reply-to")
+		       (message-fetch-field "from") "")
 	    mft (and message-use-mail-followup-to
 		     (message-fetch-field "mail-followup-to")))
       ;; Make sure this message goes to the author if this is a wide
       ;; reply, since Reply-To address may be a list address a mailing
       ;; list server added.
       (when (and wide author)
-	(setq cc (concat author ", " cc)))
-      (when (or wide (not author))
-	(setq author (or (message-fetch-field "from") ""))))
+	(setq cc (concat author ", " cc))))
 
     ;; Handle special values of Mail-Copies-To.
     (when mct
@@ -6829,13 +6827,9 @@ 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)))
+	(loop for h in `(,to ,cc ,extra ,mct)
+	      for recip = (and recipients (not (string= recipients "")))
+	      when h do (setq recipients (concat recipients (and recip ", ") h)))))
       ;; Squeeze whitespace.
       (while (string-match "[ \t][ \t]+" recipients)
 	(setq recipients (replace-match " " t t recipients)))
@@ -6854,31 +6848,20 @@ want to get rid of this query permanently.")))
 			    (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 all duplicates.
+	     (loop with recip for mess in (message-tokenize-header recipients)
+		   unless (member mess recip) collect mess into recip
+		   finally return recip)))
 
       ;; 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
+              (loop for (r . a) in recipients
+                    for assoc = (cdr (assoc r message-hierarchical-addresses))
+                    when assoc append assoc into recip
+                    unless (or (member r recip) (assoc r results))
+                    collect (cons r a) into results finally return results)))
 
       (setq recipients (message-prune-recipients recipients))
 

-- 
Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997