diff lisp/gnus/message.el @ 110073:38805092633e

gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka <[e-mail]>; gnus-html.el: Use gnus-process-plist and friends for compatibility; gnus-cite.el: New function to guess whether a long line is natural text or not; message.el: Implement message-prune-recipient-rules; by Lars Magne Ingebrigtsen <[e-mail]>.

--- a/lisp/gnus/message.el	Tue Aug 31 21:47:35 2010 +0200
+++ b/lisp/gnus/message.el	Tue Aug 31 23:26:23 2010 +0000
@@ -249,6 +249,14 @@
   :link '(custom-manual "(message)Message Headers")
   :type '(repeat sexp))
 
+(defcustom message-prune-recipient-rules nil
+  "Rules for how to prune the list of recipients when doing wide replies.
+This is a list of regexps and regexp matches."
+  :group 'message-mail
+  :group 'message-headers
+  :link '(custom-manual "(message)Wide Reply")
+  :type '(repeat regexp))
+
 (defcustom message-deletable-headers '(Message-ID Date Lines)
   "Headers to be deleted if they already exist and were generated by message previously."
   :group 'message-headers
@@ -6551,7 +6559,7 @@
 
 (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.
+    ;; 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
@@ -6677,6 +6685,8 @@
 		(if recip
 		    (setq recipients (delq recip recipients))))))))
 
+      (setq recipients (message-prune-recipients 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)))))
@@ -6690,6 +6700,22 @@
 	(push (cons 'Cc recipients) follow-to)))
     follow-to))
 
+(defun message-prune-recipients (recipients)
+  (dolist (rule message-prune-recipient-rules)
+    (let ((match (car rule))
+	  dup-match 
+	  address)
+      (dolist (recipient recipients)
+	(setq address (car recipient))
+	(when (string-match match address)
+	  (setq dup-match (replace-match (cadr rule) nil nil address))
+	  (dolist (recipient recipients)
+	    ;; Don't delete the address that triggered this.
+	    (when (and (not (eq address (car recipient)))
+		       (string-match dup-match (car recipient)))
+	      (setq recipients (delq recipient recipients))))))))
+  recipients)
+
 (defcustom message-simplify-subject-functions
   '(message-strip-list-identifiers
     message-strip-subject-re