[Emacs-diffs] master 357ae5d: Allow various Gnus and Message address variables to be functions

[Lars Ingebrigtsen]

branch: master
commit 357ae5dba5faac5ff48ebb971cb29500f87f02a6
Author: Foo <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    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).
---
 doc/misc/gnus.texi              |   11 ++++---
 doc/misc/message.texi           |   13 ++++----
 etc/GNUS-NEWS                   |    2 +
 lisp/gnus/gnus-icalendar.el     |   14 +++++----
 lisp/gnus/gnus-notifications.el |    6 ++-
 lisp/gnus/gnus-sum.el           |   19 ++++++++----
 lisp/gnus/message.el            |   63 +++++++++++++++++++++++++-------------
 7 files changed, 81 insertions(+), 47 deletions(-)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8dd0c1b..e6e3e76 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
address@hidden header.  If this regexp matches the contents of the
address@hidden header, the value of the @code{To} or @code{Newsreader}
-headers are used instead.
+The @code{gnus-ignored-from-addresses} variable says when the
address@hidden 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 761fb77..fa4fa43 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
address@hidden 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 4efb53e..c1a5bd7 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 4faef06..050478b 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 54a75b6..5a116cc 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 f2b2782..bc31ce9 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 77e471f..8a7ed4f 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
   ;; <address@hidden>
   ;;
@@ -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))