Allow various Gnus and Message address variables to be functions

* doc/misc/gnus.texi (To From Newsgroups):
gnus-ignored-from-addresses can be a function.

* doc/misc/message.texi (Wide Reply):
message-dont-reply-to-names can be a function.

* lisp/gnus/gnus-icalendar.el (gnus-icalendar-identities):
message-alternative-emails can be a function.

* lisp/gnus/gnus-notifications.el (gnus-notifications):
message-alternative-emails can be a function (bug#22315).

* lisp/gnus/gnus-sum.el
(gnus-summary-from-or-to-or-newsgroups):
gnus-ignored-from-addresses can be a function (bug#22315).

7 files changed, 81 insertions, 47 deletions

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8dd0c1ba9d5..e6e3e7617ee 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/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
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 761fb772f46..fa4fa4398b4 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/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
@@ -1672,10 +1673,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
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS
index 4efb53e69c3..c1a5bd757c6 100644
--- a/etc/GNUS-NEWS
+++ b/etc/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/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 4faef063bba..050478bbc79 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -702,12 +702,14 @@ only makes sense to define names or email addresses."
 
 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
-                       gnus-ignored-from-addresses ; already regexp-quoted
-                       message-alternative-emails  ;
-                       (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
+         (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 message-alternative-emails) ; String or function.
+                  message-alternative-emails)
+                (mapcar #'regexp-quote gnus-icalendar-additional-identities)))))
 
 ;; TODO: make the template customizable
 (defmethod gnus-icalendar-event->gnus-calendar ((event gnus-icalendar-event) &optional reply-status)
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 54a75b69c85..5a116cc0f75 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/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/gnus-sum.el b/lisp/gnus/gnus-sum.el
index f2b2782a08c..bc31ce91346 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/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
@@ -3686,15 +3691,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/lisp/gnus/message.el b/lisp/gnus/message.el
index 77e471ffb5f..8a7ed4fffbe 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1358,8 +1358,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")
@@ -1368,7 +1370,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.
@@ -1694,17 +1699,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.
@@ -6867,9 +6875,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))
@@ -7151,7 +7170,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
   ;; <abraham@dina.kvl.dk>
   ;;
@@ -7183,12 +7202,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)
@@ -8214,16 +8235,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 (cl-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))