Changes committed gnus/lisp (ChangeLog message.el)

Modified: ChangeLog message.el

(message-alter-recipients-discard-bogus-full-name): New function.
(message-alter-recipients-function): New variable.
(message-get-reply-headers): Use it.


Index: ChangeLog
diff -u gnus/lisp/ChangeLog:7.1801 gnus/lisp/ChangeLog:7.1802
--- ChangeLog:7.1801	Wed Mar 19 17:12:39 2008
+++ ChangeLog	Wed Mar 19 17:22:04 2008
@@ -1,5 +1,10 @@
 2008-03-19  Reiner Steib  <[email protected]>
 
+	* message.el (message-alter-recipients-discard-bogus-full-name): New
+	function.
+	(message-alter-recipients-function): New variable.
+	(message-get-reply-headers): Use it.
+
 	* mml.el (mml-menu): Add toggle for gnus-gcc-externalize-attachments.
 
 	* message.el (message-info): Handle EasyPG manual.
Index: message.el
diff -u gnus/lisp/message.el:7.247 gnus/lisp/message.el:7.248
--- message.el:7.247	Wed Mar 19 17:02:22 2008
+++ message.el	Wed Mar 19 17:22:04 2008
@@ -6313,6 +6313,29 @@
     (message-setup `((Newsgroups . ,(or newsgroups ""))
 		     (Subject . ,(or subject ""))))))
 
+(defun message-alter-recipients-discard-bogus-full-name (addrcell)
+  "Discard mail address in full names.
+When the full name in reply headers contains the mail
+address (e.g. \"foo@bar <foo@bar>\"), discard full name.
+ADDRCELL is a cons cell where the car is the mail address and the
+cdr is the complete address (full name and mail address)."
+  (if (string-match (concat (regexp-quote (car addrcell)) ".*"
+			    (regexp-quote (car addrcell)))
+		    (cdr addrcell))
+      (cons (car addrcell) (car addrcell))
+    addrcell))
+
+(defcustom message-alter-recipients-function nil
+  "Function called to allow alteration of reply header structures.
+It is called in `message-get-reply-headers' for each recipient.
+The function is called with one parameter, a cons cell ..."
+  :type '(choice (const :tag "None" nil)
+		 (const :tag "Discard bogus full name"
+			message-alter-recipients-discard-bogus-full-name)
+		 function)
+  :version "23.1" ;; No Gnus
+  :group 'message-headers)
+
 (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.
@@ -6413,7 +6436,11 @@
       (setq recipients
 	    (mapcar
 	     (lambda (addr)
-	       (cons (downcase (mail-strip-quoted-names addr)) addr))
+	       (if message-alter-recipients-function
+		   (funcall message-alter-recipients-function
+			    (cons (downcase (mail-strip-quoted-names addr))
+				  addr))
+		 (cons (downcase (mail-strip-quoted-names addr)) addr)))
 	     (message-tokenize-header recipients)))
       ;; Remove first duplicates.  (Why not all duplicates?  Is this a bug?)
       (let ((s recipients))