Commit 2cdd366f authored by Katsumi Yamaoka's avatar Katsumi Yamaoka
Browse files

gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by...

gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka <yamaoka@jpl.org>; gnus-html.el: Use gnus-process-plist and friends for compatibility; gnus-cite.el: New function to guess whether a long line is natural text or not; message.el: Implement message-prune-recipient-rules; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
parent 2d217ead
2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.texi (Wide Reply): Document message-prune-recipient-rules.
2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Summary Mail Commands): Note that only the addresses from
......
......@@ -182,6 +182,37 @@ 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.
@vindex message-prune-recipient-rules
@code{message-prune-recipient-rules} is used to prune the addresses
used when doing a wide reply. It's meant to be used to remove
duplicate addresses and the like. It's a list of lists, where the
first element is a regexp to match the address to trigger the rule,
and the second is a regexp that will be expanded based on the first,
to match addresses to be pruned.
It's complicated to explain, but it's easy to use.
For instance, if you get an email from @samp{foo@example.org}, but
@samp{foo@zot.example.org} is also in the @code{Cc} list, then your
wide reply will go out to both these addresses, since they are unique.
To avoid this, do something like the following:
@code
(setq message-prune-recipient-rules
'(("^\\([^@]+\\)@\\(.*\\)" "\\1@.*[.]\\2")))
@end code
If, for instance, you want all wide replies that involve messages from
@samp{cvs@example.org} to go to that address, and nowhere else (i.e.,
remove all other recipients if @samp{cvs@example.org} is in the
recipient list:
@code
(setq message-prune-recipient-rules
'(("cvs@example.org" ".")))
@end code
@vindex message-wide-reply-confirm-recipients
If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you
will be asked to confirm that you want to reply to multiple
......
2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
* message.el (message-prune-recipients): New function.
(message-prune-recipient-rules): New variable.
* gnus-cite.el (gnus-article-natural-long-line-p): New function to
guess whether a long line is natural text or not.
* gnus-html.el (gnus-html-schedule-image-fetching): Use
gnus-process-plist and friends for compatibility.
2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca>
* gnus-html.el: Require packages that define macros used in this file.
......@@ -9,6 +20,9 @@
2010-08-31 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-ems.el: Provide compatibility functions for
gnus-set-process-plist.
* gnus-sum.el (gnus-summary-stop-at-end-of-message)
* gnus.el (gnus-valid-select-methods)
* message.el (message-send-mail-partially-limit)
......
......@@ -552,6 +552,24 @@ If WIDTH (the numerical prefix), use that text width when filling."
gnus-cite-loose-attribution-alist nil
gnus-cite-article nil)))))
(defun gnus-article-natural-long-line-p ()
"Return true if the current line is long, and it's natural text."
(save-excursion
(beginning-of-line)
(and
;; The line is long.
(> (- (line-end-position) (line-beginning-position))
(frame-width))
;; It doesn't start with spaces.
(not (looking-at " "))
;; Not cited text.
(let ((line-number (1+ (count-lines (point-min) (point))))
citep)
(dolist (elem gnus-cite-prefix-alist)
(when (member line-number (cdr elem))
(setq citep t)))
(not citep)))))
(defun gnus-article-hide-citation (&optional arg force)
"Toggle hiding of all cited text except attribution lines.
See the documentation for `gnus-article-highlight-citation'.
......
......@@ -305,6 +305,27 @@
(setq start end
end nil))))))
(if (fboundp 'set-process-plist)
(progn
(defalias 'gnus-set-process-plist 'set-process-plist)
(defalias 'gnus-process-plist 'process-plist))
(defun gnus-set-process-plist (process plist)
"Replace the plist of PROCESS with PLIST. Returns PLIST."
(put 'gnus-process-plist process plist))
(defun gnus-process-plist (process)
"Return the plist of PROCESS."
;; Remove those of dead processes from `gnus-process-plist'
;; to prevent it from growing.
(let ((plist (symbol-plist 'gnus-process-plist))
proc)
(while (setq proc (car plist))
(if (and (processp proc)
(memq (process-status proc) '(open run)))
(setq plist (cddr plist))
(setcar plist (caddr plist))
(setcdr plist (or (cdddr plist) '(nil))))))
(get 'gnus-process-plist process)))
(provide 'gnus-ems)
;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb
......
......@@ -158,16 +158,16 @@
url)))
(process-kill-without-query process)
(set-process-sentinel process 'gnus-html-curl-sentinel)
(set-process-plist process (list 'images images
'buffer buffer))))
(gnus-set-process-plist process (list 'images images
'buffer buffer))))
(defun gnus-html-image-id (url)
(expand-file-name (sha1 url) gnus-html-cache-directory))
(defun gnus-html-curl-sentinel (process event)
(when (string-match "finished" event)
(let* ((images (process-get process 'images))
(buffer (process-get process 'buffer))
(let* ((images (gnus-process-get process 'images))
(buffer (gnus-process-get process 'buffer))
(spec (pop images))
(file (gnus-html-image-id (car spec))))
(when (and (buffer-live-p buffer)
......
......@@ -249,6 +249,14 @@ included. Organization and User-Agent are optional."
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
(defcustom message-prune-recipient-rules nil
"Rules for how to prune the list of recipients when doing wide replies.
This is a list of regexps and regexp matches."
:group 'message-mail
:group 'message-headers
:link '(custom-manual "(message)Wide Reply")
:type '(repeat regexp))
(defcustom message-deletable-headers '(Message-ID Date Lines)
"Headers to be deleted if they already exist and were generated by message previously."
:group 'message-headers
......@@ -6551,7 +6559,7 @@ The function is called with one parameter, a cons cell ..."
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
;; Gmane renames "To". Look at "Original-To", too, if it is present in
......@@ -6677,6 +6685,8 @@ want to get rid of this query permanently.")))
(if recip
(setq recipients (delq recip recipients))))))))
(setq recipients (message-prune-recipients recipients))
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
......@@ -6690,6 +6700,22 @@ want to get rid of this query permanently.")))
(push (cons 'Cc recipients) follow-to)))
follow-to))
(defun message-prune-recipients (recipients)
(dolist (rule message-prune-recipient-rules)
(let ((match (car rule))
dup-match
address)
(dolist (recipient recipients)
(setq address (car recipient))
(when (string-match match address)
(setq dup-match (replace-match (cadr rule) nil nil address))
(dolist (recipient recipients)
;; Don't delete the address that triggered this.
(when (and (not (eq address (car recipient)))
(string-match dup-match (car recipient)))
(setq recipients (delq recipient recipients))))))))
recipients)
(defcustom message-simplify-subject-functions
'(message-strip-list-identifiers
message-strip-subject-re
......
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