* bug#22315: [patch][gnus] allow functions for checking mails
@ 2016-01-05 18:56 Rasmus
2016-02-07 5:46 ` Lars Ingebrigtsen
0 siblings, 1 reply; 4+ messages in thread
From: Rasmus @ 2016-01-05 18:56 UTC (permalink / raw)
To: 22315
[-- Attachment #1: Type: text/plain, Size: 1234 bytes --]
Hi,
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 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ä!
[-- Attachment #2: 0001-Allow-message-alternative-emails-to-be-a-function.patch --]
[-- Type: text/x-diff, Size: 6663 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
[-- 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: 6623 bytes --]
From 8cd5f63a1582e55c2d7e310069ad36b3ed97e54c 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 3febb8e..c72bd64 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -14,6 +14,14 @@
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: 4652 bytes --]
From 208004b00ea4c063d653e6e495ee8c4b2c8f3b51 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 c72bd64..e0e7dea 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -14,6 +14,12 @@
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 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
^ permalink raw reply related [flat|nested] 4+ messages in thread
* bug#22315: [patch][gnus] allow functions for checking mails
2016-01-05 18:56 bug#22315: [patch][gnus] allow functions for checking mails Rasmus
@ 2016-02-07 5:46 ` Lars Ingebrigtsen
2016-02-07 11:59 ` Rasmus
0 siblings, 1 reply; 4+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-07 5:46 UTC (permalink / raw)
To: Rasmus; +Cc: 22315
Rasmus <rasmus@gmx.us> writes:
> 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:
Looks good. Do you have FSF copyright assignment papers on file with
the FSF?
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#22315: [patch][gnus] allow functions for checking mails
2016-02-07 5:46 ` Lars Ingebrigtsen
@ 2016-02-07 11:59 ` Rasmus
2016-02-08 2:29 ` Lars Ingebrigtsen
0 siblings, 1 reply; 4+ messages in thread
From: Rasmus @ 2016-02-07 11:59 UTC (permalink / raw)
To: 22315
Hi Lars,
>> 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:
>
> Looks good. Do you have FSF copyright assignment papers on file with
> the FSF?
Yes I do. See e.g. commit bb19b229f9c1c32ed8829f14f670bfd9d7ebe2a2 in
emacs.git which uses this email address.
Thanks,
Rasmus
--
Enough with the blah blah!
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#22315: [patch][gnus] allow functions for checking mails
2016-02-07 11:59 ` Rasmus
@ 2016-02-08 2:29 ` Lars Ingebrigtsen
0 siblings, 0 replies; 4+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-08 2:29 UTC (permalink / raw)
To: Rasmus; +Cc: 22315
Rasmus <rasmus@gmx.us> writes:
> Hi Lars,
>
>>> 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:
>>
>> Looks good. Do you have FSF copyright assignment papers on file with
>> the FSF?
>
> Yes I do. See e.g. commit bb19b229f9c1c32ed8829f14f670bfd9d7ebe2a2 in
> emacs.git which uses this email address.
Ok, I've now applied your patches to the trunk.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2016-02-08 2:29 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-01-05 18:56 bug#22315: [patch][gnus] allow functions for checking mails Rasmus
2016-02-07 5:46 ` Lars Ingebrigtsen
2016-02-07 11:59 ` Rasmus
2016-02-08 2:29 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
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 read-only IMAP folder(s) and NNTP newsgroup(s).