Announcements and discussions for Gnus, the GNU Emacs Usenet newsreader
 help / color / mirror / Atom feed
* [patches] allow functions some variables
@ 2015-05-24 13:15 Rasmus
  2015-05-30 13:42 ` Rasmus
  0 siblings, 1 reply; 2+ messages in thread
From: Rasmus @ 2015-05-24 13:15 UTC (permalink / raw)
  To: info-gnus-english

[-- Attachment #1: Type: text/plain, Size: 1229 bytes --]

Hi,

[Note, I'm posting to this list since I've accumulated too many "spam
 point" to post on ding....]

I use my mydomain.net for all my private mails.  As such my set of mail
accounts is basically ".*@mydomain.net".  I reserve a couple of addresses
like foo@mydomain.net for the local foo club's mailing list, though.
Thus, foo@mydomain.net 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 fact.

The attached patches allow these three variables to be functions.  Thus, I
can solve my IDing woes with this simple predicate:

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

I have no clue how to test this on Xemacs.  But I guess worst case David's
bot will pick it up...

There could still be more bugs, of course.

Also, I don't know how changelog works for Gnus now.  Is the changelog
still maintained?  Or is it auto-generated like in Emacs.git?

Thanks,
Rasmus

-- 
Evidence suggests Snowden used a powerful tool called monospaced fonts

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-message-alternative-emails-to-be-a-function.patch --]
[-- Type: text/x-diff, Size: 6424 bytes --]

From c4254c0c90f2e20b5c7f20331f6ea9a5e6fe06dc Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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".
 \f
 * 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 223fdd2..3aeb28a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2015-05-23  Rasmus Pank Roulund  <emacs@pank.eu>
+
+	* 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  <eggert@cs.ucla.edu>
 
 	* 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..d47a004 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
   ;; <abraham@dina.kvl.dk>
   ;;
@@ -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
+                               until (string-match-p message-alternative-emails email)
+                               finally 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Allow-gnus-ignored-from-addresses-to-be-a-function.patch --]
[-- Type: text/x-diff, Size: 6619 bytes --]

From b9b4512fbf912fb0167c8e97bed361184b1f3997 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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".
 \f
 * 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 3aeb28a..adf2b8b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,13 @@
 2015-05-23  Rasmus Pank Roulund  <emacs@pank.eu>
 
+	* 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  <emacs@pank.eu>
+
 	* 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-Allow-message-dont-reply-to-names-to-be-a-function.patch --]
[-- Type: text/x-diff, Size: 4648 bytes --]

From 83eccbd36b4f839f4d25b260d9d8a391679202d0 Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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".
 \f
 * 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 adf2b8b..347a6b1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
 2015-05-23  Rasmus Pank Roulund  <emacs@pank.eu>
 
+	* 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  <emacs@pank.eu>
+
 	* 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 d47a004..3d82828 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




^ permalink raw reply	[flat|nested] 2+ messages in thread

* Re: [patches] allow functions some variables
  2015-05-24 13:15 [patches] allow functions some variables Rasmus
@ 2015-05-30 13:42 ` Rasmus
  0 siblings, 0 replies; 2+ messages in thread
From: Rasmus @ 2015-05-30 13:42 UTC (permalink / raw)
  To: info-gnus-english

[-- Attachment #1: Type: text/plain, Size: 157 bytes --]

Hi,

> The attached patches allow these three variables to be functions.

There was a bug in the first patch.

Thanks,
Rasmus

-- 
May the Force be with you

[-- Attachment #2: 0001-Allow-message-alternative-emails-to-be-a-function.patch --]
[-- Type: text/x-diff, Size: 6501 bytes --]

From ceb6d295ba62fc43344e514d1be1c264e968301c Mon Sep 17 00:00:00 2001
From: Rasmus <rasmus@gmx.us>
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".
 \f
 * 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  <emacs@pank.eu>
+
+	* 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  <eggert@cs.ucla.edu>
 
 	* 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
   ;; <abraham@dina.kvl.dk>
   ;;
@@ -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




^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2015-05-30 13:42 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-05-24 13:15 [patches] allow functions some variables Rasmus
2015-05-30 13:42 ` Rasmus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).