procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow various Gnus and Message address variables to be functions

Browse source 
* 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).
This commit is contained in:
Foo 2016-02-08 13:28:37 +11:00 • committed by Lars Ingebrigtsen
parent d0c2957609
commit 357ae5dba5
7 changed files with 81 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
doc/misc/gnus.texi
View file

@ -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

13
doc/misc/message.texi
View file

@ -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

2
etc/GNUS-NEWS
View file

@ -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

14
lisp/gnus/gnus-icalendar.el
View file

@ -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)

6
lisp/gnus/gnus-notifications.el
View file

@ -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)

19
lisp/gnus/gnus-sum.el
View file

@ -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)

63
lisp/gnus/message.el
View file

@ -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))