Subject: bug#22315: [patch][gnus] allow functions for checking mails

From: Rasmus <[email-masked]>
Date: Tue, 05 Jan 2016 19:56:35 +0100

Hi,

I use my mydomain.net for all my private mails.  As such my set of mail
accounts is basically "[email-masked]".  I reserve a couple of addresses
like [email-masked] for the local foo club's mailing list, though.
Thus, [email-masked] is not one of my emails.

Since Emacs doesn't have regexp look-ahead it's pretty difficult to bend
message-alternative-emails, message-dont-reply-to-names,
gnus-ignored-from-addresses to recognize the above rule.

The attached patches allow the three variables message-alternative-emails,
gnus-ignored-from-addresses and message-dont-reply-to-names to be
predicates.  Thus, I can solve my woes with this simple predicate:

    (defun rasmus/mailp (email)
      (let (case-fold-search)
      ;; rasmus/my-mails is known.
        (and (string-match-p rasmus/my-mails email)
             (not (string-match-p rasmus/ml-mails email)))))

Also, I don't know how changelog works for Gnus now (or whenever it moves
to emacs.git).  Also, I don’t know if the patch should be against gnus.git
or emacs.git.  The attached patches should work with the master branch of
gnus.git.

Thanks,
Rasmus

-- 
Tack, ni svenska vakttorn. Med plutonium tvingar vi dansken på knä!
>From ceb6d295ba62fc43344e514d1be1c264e968301c Mon Sep 17 00:00:00 2001
From: Rasmus <[email-masked]>
Date: Sat, 23 May 2015 13:29:56 +0200
Subject: [PATCH 1/3] Allow message-alternative-emails to be a function

---
 GNUS-NEWS              |  2 ++
 lisp/ChangeLog         |  7 +++++++
 lisp/gnus-icalendar.el |  5 +++--
 lisp/message.el        | 35 +++++++++++++++++++----------------
 texi/message.texi      |  8 ++++----
 5 files changed, 35 insertions(+), 22 deletions(-)

diff --git a/GNUS-NEWS b/GNUS-NEWS
index ee3584f..edaa2d5 100644
--- a/GNUS-NEWS
+++ b/GNUS-NEWS
@@ -9,6 +9,8 @@ For older news, see Gnus info node "New Features".
 
 * New features
 
+** message-alternative-emails can take a function as a value.
+
 ** nnimap can request and use the Gmail "X-GM-LABELS".
 
 ** New package `gnus-notifications.el' can send notifications when you
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6539a61..3febb8e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -12,6 +12,13 @@
 	* gnus-art.el (gnus-button-alist):
 	Also treat "‘" and "’" as quoting chars.
 
+2015-05-23  Rasmus Pank Roulund  <[email-masked]>
+
+	* message.el (message-alternative-emails): Allow function as value.
+	(message-use-alternative-email-as-from):
+	(message-is-yours-p): Allow function value for
+	`message-alternative-emails'
+
 2015-05-19  Paul Eggert  <[email-masked]>
 
 	* gnus-art.el (gnus-treat-strip-list-identifiers)
diff --git a/lisp/gnus-icalendar.el b/lisp/gnus-icalendar.el
index dc423d8..be5b732 100644
--- a/lisp/gnus-icalendar.el
+++ b/lisp/gnus-icalendar.el
@@ -704,9 +704,10 @@ These will be used to retrieve the RSVP information from ical events."
   (apply #'append
          (mapcar (lambda (x) (if (listp x) x (list x)))
                  (list user-full-name (regexp-quote user-mail-address)
-                       ; NOTE: these can be lists
+                       ;; NOTE: these can be lists
                        gnus-ignored-from-addresses ; already regexp-quoted
-                       message-alternative-emails  ;
+                       (unless (functionp message-alternative-emails)  ; String or function.
+                         message-alternative-emails)
                        (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
 
 ;; TODO: make the template customizable
diff --git a/lisp/message.el b/lisp/message.el
index 2bc8116..d219a41 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1734,17 +1734,20 @@ should be sent in several parts.  If it is nil, the size is unlimited."
 		 (integer 1000000)))
 
 (defcustom message-alternative-emails nil
-  "*Regexp matching alternative email addresses.
+  "*Regexp or predicate function matching alternative email addresses.
 The first address in the To, Cc or From headers of the original
 article matching this variable is used as the From field of
 outgoing messages.
 
+If a function, an email string is passed as the argument.
+
 This variable has precedence over posting styles and anything that runs
 off `message-setup-hook'."
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "Always use primary" nil)
-		 regexp))
+		 regexp
+                 function))
 
 (defcustom message-hierarchical-addresses nil
   "A list of hierarchical mail address definitions.
@@ -7248,7 +7251,7 @@ want to get rid of this query permanently."))
 If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
 are yours except those that have Cancel-Lock header not belonging to you.
 Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
-regexp to match all of yours addresses."
+to match all of yours addresses."
   ;; Canlock-logic as suggested by Per Abrahamsen
   ;; <[email-masked]>
   ;;
@@ -7280,12 +7283,14 @@ regexp to match all of yours addresses."
 		 (downcase (car (mail-header-parse-address
 				 (message-make-from))))))
 	   ;; Email address in From field matches
-	   ;; 'message-alternative-emails' regexp
+	   ;; 'message-alternative-emails' regexp or function.
 	   (and from
 		message-alternative-emails
-		(string-match
-		 message-alternative-emails
-		 (car (mail-header-parse-address from))))))))))
+                (cond ((functionp message-alternative-emails)
+                       (funcall message-alternative-emails
+                                (mail-header-parse-address from)))
+                      (t (string-match message-alternative-emails
+                                       (car (mail-header-parse-address from))))))))))))
 
 ;;;###autoload
 (defun message-cancel-news (&optional arg)
@@ -8320,16 +8325,14 @@ From headers in the original article."
   (require 'mail-utils)
   (let* ((fields '("To" "Cc" "From"))
 	 (emails
-	  (split-string
+	  (message-tokenize-header
 	   (mail-strip-quoted-names
-	    (mapconcat 'message-fetch-reply-field fields ","))
-	   "[ \f\t\n\r\v,]+"))
-	 email)
-    (while emails
-      (if (string-match message-alternative-emails (car emails))
-	  (setq email (car emails)
-		emails nil))
-      (pop emails))
+	    (mapconcat 'message-fetch-reply-field fields ","))))
+	 (email (cond ((functionp message-alternative-emails)
+                       (car (remove-if-not message-alternative-emails emails)))
+                      (t (loop for email in emails
+                               if (string-match-p message-alternative-emails email)
+                               return email)))))
     (unless (or (not email) (equal email user-mail-address))
       (message-remove-header "From")
       (goto-char (point-max))
diff --git a/texi/message.texi b/texi/message.texi
index b7aa6bf..1b18a04 100644
--- a/texi/message.texi
+++ b/texi/message.texi
@@ -1523,10 +1523,10 @@ trailing old subject.  In this case,
 
 @item message-alternative-emails
 @vindex message-alternative-emails
-Regexp matching alternative email addresses.  The first address in the
-To, Cc or From headers of the original article matching this variable is
-used as the From field of outgoing messages, replacing the default From
-value.
+Regexp or predicate function matching alternative email addresses.
+The first address in the To, Cc or From headers of the original
+article matching this variable is used as the From field of outgoing
+messages, replacing the default From value.
 
 For example, if you have two secondary email addresses john@@home.net
 and john.doe@@work.com and want to use them in the From field when
-- 
2.4.1

>From 8cd5f63a1582e55c2d7e310069ad36b3ed97e54c Mon Sep 17 00:00:00 2001
From: Rasmus <[email-masked]>
Date: Sat, 23 May 2015 14:39:36 +0200
Subject: [PATCH 2/3] Allow gnus-ignored-from-addresses to be a function

---
 GNUS-NEWS                  |  2 ++
 lisp/ChangeLog             |  8 ++++++++
 lisp/gnus-icalendar.el     |  3 ++-
 lisp/gnus-notifications.el |  6 ++++--
 lisp/gnus-sum.el           | 19 +++++++++++++------
 texi/gnus.texi             | 11 ++++++-----
 6 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/GNUS-NEWS b/GNUS-NEWS
index edaa2d5..dce7eda 100644
--- a/GNUS-NEWS
+++ b/GNUS-NEWS
@@ -9,6 +9,8 @@ For older news, see Gnus info node "New Features".
 
 * New features
 
+** gnus-ignored-from-addresses can take a function as a value.
+
 ** message-alternative-emails can take a function as a value.
 
 ** nnimap can request and use the Gmail "X-GM-LABELS".
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3febb8e..c72bd64 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -14,6 +14,14 @@
 
 2015-05-23  Rasmus Pank Roulund  <[email-masked]>
 
+	* gnus-sum.el (gnus-ignored-from-addresses): Allow function as value.
+	* gnus-notifications.el (gnus-notifications):
+	* gnus-icalendar.el (gnus-icalendar-identities):
+	* gnus-sum.el (gnus-ignored-from-addresses): Allow function value for
+	`gnus-ignored-from-addresses'.
+
+2015-05-23  Rasmus Pank Roulund  <[email-masked]>
+
 	* message.el (message-alternative-emails): Allow function as value.
 	(message-use-alternative-email-as-from):
 	(message-is-yours-p): Allow function value for
diff --git a/lisp/gnus-icalendar.el b/lisp/gnus-icalendar.el
index be5b732..734f1bf 100644
--- a/lisp/gnus-icalendar.el
+++ b/lisp/gnus-icalendar.el
@@ -705,7 +705,8 @@ These will be used to retrieve the RSVP information from ical events."
          (mapcar (lambda (x) (if (listp x) x (list x)))
                  (list user-full-name (regexp-quote user-mail-address)
                        ;; NOTE: these can be lists
-                       gnus-ignored-from-addresses ; already regexp-quoted
+                       (unless (functionp gnus-ignored-from-addresses) ; String or function.
+                         gnus-ignored-from-addresses)                  ; Already regexp-quoted if string.
                        (unless (functionp message-alternative-emails)  ; String or function.
                          message-alternative-emails)
                        (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
diff --git a/lisp/gnus-notifications.el b/lisp/gnus-notifications.el
index f73aac1..2172c2f 100644
--- a/lisp/gnus-notifications.el
+++ b/lisp/gnus-notifications.el
@@ -180,8 +180,10 @@ This is typically a function to add in
                   ;; Ignore mails from ourselves
                   (unless (and gnus-ignored-from-addresses
                                address
-                               (gnus-string-match-p gnus-ignored-from-addresses
-                                                    address))
+                               (cond ((functionp gnus-ignored-from-addresses)
+                                      (funcall gnus-ignored-from-addresses address))
+                                     (t (gnus-string-match-p (gnus-ignored-from-addresses)
+                                                             address))))
                     (let* ((photo-file (gnus-notifications-get-photo-file address))
                            (notification-id (gnus-notifications-notify
                                              (or (car address-components) address)
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 37a707e..8bc08a1 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -1171,14 +1171,19 @@ which it may alter in any way."
        (not (string= user-mail-address ""))
        (regexp-quote user-mail-address))
   "*From headers that may be suppressed in favor of To headers.
-This can be a regexp or a list of regexps."
+This can be a regexp, a list of regexps or a function.
+
+If a function, an email string is passed as the argument."
   :version "21.1"
   :group 'gnus-summary
   :type '(choice regexp
-		 (repeat :tag "Regexp List" regexp)))
+		 (repeat :tag "Regexp List" regexp)
+                 function))
 
 (defsubst gnus-ignored-from-addresses ()
-  (gmm-regexp-concat gnus-ignored-from-addresses))
+  (cond ((functionp gnus-ignored-from-addresses)
+         gnus-ignored-from-addresses)
+        (t (gmm-regexp-concat gnus-ignored-from-addresses))))
 
 (defcustom gnus-summary-to-prefix "-> "
   "*String prefixed to the To field in the summary line when
@@ -3685,15 +3690,17 @@ buffer that was in action when the last article was fetched."
 
 (defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
   (let ((mail-parse-charset gnus-newsgroup-charset)
-	(ignored-from-addresses (gnus-ignored-from-addresses))
 	;; Is it really necessary to do this next part for each summary line?
 	;; Luckily, doesn't seem to slow things down much.
 	(mail-parse-ignored-charsets
 	 (with-current-buffer gnus-summary-buffer
 	   gnus-newsgroup-ignored-charsets)))
     (or
-     (and ignored-from-addresses
-	  (string-match ignored-from-addresses gnus-tmp-from)
+     (and gnus-ignored-from-addresses
+          (cond ((functionp gnus-ignored-from-addresses)
+                 (funcall gnus-ignored-from-addresses
+                          (mail-strip-quoted-names gnus-tmp-from)))
+                (t (string-match (gnus-ignored-from-addresses) gnus-tmp-from)))
 	  (let ((extra-headers (mail-header-extra header))
 		to
 		newsgroups)
diff --git a/texi/gnus.texi b/texi/gnus.texi
index b190184..84543d7 100644
--- a/texi/gnus.texi
+++ b/texi/gnus.texi
@@ -5042,11 +5042,12 @@ access the @code{X-Newsreader} header:
 
 @item
 @vindex gnus-ignored-from-addresses
-The @code{gnus-ignored-from-addresses} variable says when the @samp{%f}
-summary line spec returns the @code{To}, @code{Newsreader} or
-@code{From} header.  If this regexp matches the contents of the
-@code{From} header, the value of the @code{To} or @code{Newsreader}
-headers are used instead.
+The @code{gnus-ignored-from-addresses} variable says when the
+@samp{%f} summary line spec returns the @code{To}, @code{Newsreader}
+or @code{From} header.  The variable may be a regexp or a predicate
+function.  If this matches the contents of the @code{From}
+header, the value of the @code{To} or @code{Newsreader} headers are
+used instead.
 
 To distinguish regular articles from those where the @code{From} field
 has been swapped, a string is prefixed to the @code{To} or
-- 
2.4.1

>From 208004b00ea4c063d653e6e495ee8c4b2c8f3b51 Mon Sep 17 00:00:00 2001
From: Rasmus <[email-masked]>
Date: Sat, 23 May 2015 15:42:28 +0200
Subject: [PATCH 3/3] Allow message-dont-reply-to-names to be a function

---
 GNUS-NEWS         |  2 ++
 lisp/ChangeLog    |  6 ++++++
 lisp/message.el   | 28 ++++++++++++++++++++++------
 texi/message.texi |  5 +++--
 4 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/GNUS-NEWS b/GNUS-NEWS
index dce7eda..2c29a75 100644
--- a/GNUS-NEWS
+++ b/GNUS-NEWS
@@ -9,6 +9,8 @@ For older news, see Gnus info node "New Features".
 
 * New features
 
+** message-dont-reply-to-names can take a function as a value.
+
 ** gnus-ignored-from-addresses can take a function as a value.
 
 ** message-alternative-emails can take a function as a value.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c72bd64..e0e7dea 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -14,6 +14,12 @@
 
 2015-05-23  Rasmus Pank Roulund  <[email-masked]>
 
+	* message.el (message-dont-reply-to-names): Allow function as value.
+	(message-dont-reply-to-names, message-get-reply-headers): Allow
+	function value for `message-dont-reply-to-names'.
+
+2015-05-23  Rasmus Pank Roulund  <[email-masked]>
+
 	* gnus-sum.el (gnus-ignored-from-addresses): Allow function as value.
 	* gnus-notifications.el (gnus-notifications):
 	* gnus-icalendar.el (gnus-icalendar-identities):
diff --git a/lisp/message.el b/lisp/message.el
index d219a41..000ef70 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1398,8 +1398,10 @@ If nil, you might be asked to input the charset."
 (defcustom message-dont-reply-to-names
   (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names)
   "*Addresses to prune when doing wide replies.
-This can be a regexp or a list of regexps.  Also, a value of nil means
-exclude your own user name only."
+This can be a regexp, a list of regexps or a predicate function.
+Also, a value of nil means exclude your own user name only.
+
+If a function email is passed as the argument."
   :version "24.3"
   :group 'message
   :link '(custom-manual "(message)Wide Reply")
@@ -1408,7 +1410,10 @@ exclude your own user name only."
 		 (repeat :tag "Regexp List" regexp)))
 
 (defsubst message-dont-reply-to-names ()
-  (gmm-regexp-concat message-dont-reply-to-names))
+  (cond ((functionp message-dont-reply-to-names)
+         message-dont-reply-to-names)
+        ((stringp message-dont-reply-to-names)
+         (gmm-regexp-concat message-dont-reply-to-names))))
 
 (defvar message-shoot-gnksa-feet nil
   "*A list of GNKSA feet you are allowed to shoot.
@@ -6967,9 +6972,20 @@ want to get rid of this query permanently.")))
       ;; Squeeze whitespace.
       (while (string-match "[ \t][ \t]+" recipients)
 	(setq recipients (replace-match " " t t recipients)))
-      ;; Remove addresses that match `mail-dont-reply-to-names'.
-      (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
-	(setq recipients (mail-dont-reply-to recipients)))
+      ;; Remove addresses that match `message-dont-reply-to-names'.
+      (setq recipients
+            (cond ((functionp message-dont-reply-to-names)
+                   (mapconcat
+                    'identity
+                    (delq nil
+                          (mapcar (lambda (mail)
+                                    (unless (funcall message-dont-reply-to-names
+                                                     (mail-strip-quoted-names mail))
+                                      mail))
+                                  (message-tokenize-header recipients)))
+                    ", "))
+                  (t (let ((mail-dont-reply-to-names (message-dont-reply-to-names)))
+                       (mail-dont-reply-to recipients)))))
       ;; Perhaps "Mail-Copies-To: never" removed the only address?
       (if (string-equal recipients "")
 	  (setq recipients author))
diff --git a/texi/message.texi b/texi/message.texi
index 1b18a04..2e7fee0 100644
--- a/texi/message.texi
+++ b/texi/message.texi
@@ -185,8 +185,9 @@ but you can change the behavior to suit your needs by fiddling with the
 
 @vindex message-dont-reply-to-names
 Addresses that match the @code{message-dont-reply-to-names} regular
-expression (or list of regular expressions) will be removed from the
-@code{Cc} header. A value of @code{nil} means exclude your name only.
+expression (or list of regular expressions or a predicate function)
+will be removed from the @code{Cc} header. A value of @code{nil} means
+exclude your name only.
 
 @vindex message-prune-recipient-rules
 @code{message-prune-recipient-rules} is used to prune the addresses
-- 
2.4.1