Commit 357ae5db authored by Foo's avatar Foo Committed by Lars Ingebrigtsen
Browse files

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).
parent d0c29576
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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)
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment