aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--doc/misc/ChangeLog4
-rw-r--r--doc/misc/message.texi31
-rw-r--r--lisp/gnus/ChangeLog14
-rw-r--r--lisp/gnus/gnus-cite.el18
-rw-r--r--lisp/gnus/gnus-ems.el21
-rw-r--r--lisp/gnus/gnus-html.el8
-rw-r--r--lisp/gnus/message.el28
7 files changed, 119 insertions, 5 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index ab84e78c74f..eb2adf7fd20 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
12010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * message.texi (Wide Reply): Document message-prune-recipient-rules.
4
12010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> 52010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 6
3 * gnus.texi (Summary Mail Commands): Note that only the addresses from 7 * gnus.texi (Summary Mail Commands): Note that only the addresses from
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 7f48cc9c8a3..fb39107d3a8 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -182,6 +182,37 @@ Addresses that match the @code{message-dont-reply-to-names} regular
182expression (or list of regular expressions) will be removed from the 182expression (or list of regular expressions) will be removed from the
183@code{Cc} header. A value of @code{nil} means exclude your name only. 183@code{Cc} header. A value of @code{nil} means exclude your name only.
184 184
185@vindex message-prune-recipient-rules
186@code{message-prune-recipient-rules} is used to prune the addresses
187used when doing a wide reply. It's meant to be used to remove
188duplicate addresses and the like. It's a list of lists, where the
189first element is a regexp to match the address to trigger the rule,
190and the second is a regexp that will be expanded based on the first,
191to match addresses to be pruned.
192
193It's complicated to explain, but it's easy to use.
194
195For instance, if you get an email from @samp{foo@example.org}, but
196@samp{foo@zot.example.org} is also in the @code{Cc} list, then your
197wide reply will go out to both these addresses, since they are unique.
198
199To avoid this, do something like the following:
200
201@code
202(setq message-prune-recipient-rules
203 '(("^\\([^@]+\\)@\\(.*\\)" "\\1@.*[.]\\2")))
204@end code
205
206If, for instance, you want all wide replies that involve messages from
207@samp{cvs@example.org} to go to that address, and nowhere else (i.e.,
208remove all other recipients if @samp{cvs@example.org} is in the
209recipient list:
210
211@code
212(setq message-prune-recipient-rules
213 '(("cvs@example.org" ".")))
214@end code
215
185@vindex message-wide-reply-confirm-recipients 216@vindex message-wide-reply-confirm-recipients
186If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you 217If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you
187will be asked to confirm that you want to reply to multiple 218will be asked to confirm that you want to reply to multiple
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index c5a03a18d55..cb96149e538 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,14 @@
12010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * message.el (message-prune-recipients): New function.
4 (message-prune-recipient-rules): New variable.
5
6 * gnus-cite.el (gnus-article-natural-long-line-p): New function to
7 guess whether a long line is natural text or not.
8
9 * gnus-html.el (gnus-html-schedule-image-fetching): Use
10 gnus-process-plist and friends for compatibility.
11
12010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> 122010-08-31 Stefan Monnier <monnier@iro.umontreal.ca>
2 13
3 * gnus-html.el: Require packages that define macros used in this file. 14 * gnus-html.el: Require packages that define macros used in this file.
@@ -9,6 +20,9 @@
9 20
102010-08-31 Katsumi Yamaoka <yamaoka@jpl.org> 212010-08-31 Katsumi Yamaoka <yamaoka@jpl.org>
11 22
23 * gnus-ems.el: Provide compatibility functions for
24 gnus-set-process-plist.
25
12 * gnus-sum.el (gnus-summary-stop-at-end-of-message) 26 * gnus-sum.el (gnus-summary-stop-at-end-of-message)
13 * gnus.el (gnus-valid-select-methods) 27 * gnus.el (gnus-valid-select-methods)
14 * message.el (message-send-mail-partially-limit) 28 * message.el (message-send-mail-partially-limit)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index adec9cfd725..9502bd819cc 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -552,6 +552,24 @@ If WIDTH (the numerical prefix), use that text width when filling."
552 gnus-cite-loose-attribution-alist nil 552 gnus-cite-loose-attribution-alist nil
553 gnus-cite-article nil))))) 553 gnus-cite-article nil)))))
554 554
555(defun gnus-article-natural-long-line-p ()
556 "Return true if the current line is long, and it's natural text."
557 (save-excursion
558 (beginning-of-line)
559 (and
560 ;; The line is long.
561 (> (- (line-end-position) (line-beginning-position))
562 (frame-width))
563 ;; It doesn't start with spaces.
564 (not (looking-at " "))
565 ;; Not cited text.
566 (let ((line-number (1+ (count-lines (point-min) (point))))
567 citep)
568 (dolist (elem gnus-cite-prefix-alist)
569 (when (member line-number (cdr elem))
570 (setq citep t)))
571 (not citep)))))
572
555(defun gnus-article-hide-citation (&optional arg force) 573(defun gnus-article-hide-citation (&optional arg force)
556 "Toggle hiding of all cited text except attribution lines. 574 "Toggle hiding of all cited text except attribution lines.
557See the documentation for `gnus-article-highlight-citation'. 575See the documentation for `gnus-article-highlight-citation'.
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 6b7d6a624a6..32b126a2713 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -305,6 +305,27 @@
305 (setq start end 305 (setq start end
306 end nil)))))) 306 end nil))))))
307 307
308(if (fboundp 'set-process-plist)
309 (progn
310 (defalias 'gnus-set-process-plist 'set-process-plist)
311 (defalias 'gnus-process-plist 'process-plist))
312 (defun gnus-set-process-plist (process plist)
313 "Replace the plist of PROCESS with PLIST. Returns PLIST."
314 (put 'gnus-process-plist process plist))
315 (defun gnus-process-plist (process)
316 "Return the plist of PROCESS."
317 ;; Remove those of dead processes from `gnus-process-plist'
318 ;; to prevent it from growing.
319 (let ((plist (symbol-plist 'gnus-process-plist))
320 proc)
321 (while (setq proc (car plist))
322 (if (and (processp proc)
323 (memq (process-status proc) '(open run)))
324 (setq plist (cddr plist))
325 (setcar plist (caddr plist))
326 (setcdr plist (or (cdddr plist) '(nil))))))
327 (get 'gnus-process-plist process)))
328
308(provide 'gnus-ems) 329(provide 'gnus-ems)
309 330
310;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb 331;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index bf26fb7e626..c64b9f5f0d1 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -158,16 +158,16 @@
158 url))) 158 url)))
159 (process-kill-without-query process) 159 (process-kill-without-query process)
160 (set-process-sentinel process 'gnus-html-curl-sentinel) 160 (set-process-sentinel process 'gnus-html-curl-sentinel)
161 (set-process-plist process (list 'images images 161 (gnus-set-process-plist process (list 'images images
162 'buffer buffer)))) 162 'buffer buffer))))
163 163
164(defun gnus-html-image-id (url) 164(defun gnus-html-image-id (url)
165 (expand-file-name (sha1 url) gnus-html-cache-directory)) 165 (expand-file-name (sha1 url) gnus-html-cache-directory))
166 166
167(defun gnus-html-curl-sentinel (process event) 167(defun gnus-html-curl-sentinel (process event)
168 (when (string-match "finished" event) 168 (when (string-match "finished" event)
169 (let* ((images (process-get process 'images)) 169 (let* ((images (gnus-process-get process 'images))
170 (buffer (process-get process 'buffer)) 170 (buffer (gnus-process-get process 'buffer))
171 (spec (pop images)) 171 (spec (pop images))
172 (file (gnus-html-image-id (car spec)))) 172 (file (gnus-html-image-id (car spec))))
173 (when (and (buffer-live-p buffer) 173 (when (and (buffer-live-p buffer)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index b4c40f89b61..2e27daca90b 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -249,6 +249,14 @@ included. Organization and User-Agent are optional."
249 :link '(custom-manual "(message)Message Headers") 249 :link '(custom-manual "(message)Message Headers")
250 :type '(repeat sexp)) 250 :type '(repeat sexp))
251 251
252(defcustom message-prune-recipient-rules nil
253 "Rules for how to prune the list of recipients when doing wide replies.
254This is a list of regexps and regexp matches."
255 :group 'message-mail
256 :group 'message-headers
257 :link '(custom-manual "(message)Wide Reply")
258 :type '(repeat regexp))
259
252(defcustom message-deletable-headers '(Message-ID Date Lines) 260(defcustom message-deletable-headers '(Message-ID Date Lines)
253 "Headers to be deleted if they already exist and were generated by message previously." 261 "Headers to be deleted if they already exist and were generated by message previously."
254 :group 'message-headers 262 :group 'message-headers
@@ -6551,7 +6559,7 @@ The function is called with one parameter, a cons cell ..."
6551 6559
6552(defun message-get-reply-headers (wide &optional to-address address-headers) 6560(defun message-get-reply-headers (wide &optional to-address address-headers)
6553 (let (follow-to mct never-mct to cc author mft recipients extra) 6561 (let (follow-to mct never-mct to cc author mft recipients extra)
6554 ;; Find all relevant headers we need. 6562 ;; Find all relevant headers we need.
6555 (save-restriction 6563 (save-restriction
6556 (message-narrow-to-headers-or-head) 6564 (message-narrow-to-headers-or-head)
6557 ;; Gmane renames "To". Look at "Original-To", too, if it is present in 6565 ;; 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.")))
6677 (if recip 6685 (if recip
6678 (setq recipients (delq recip recipients)))))))) 6686 (setq recipients (delq recip recipients))))))))
6679 6687
6688 (setq recipients (message-prune-recipients recipients))
6689
6680 ;; Build the header alist. Allow the user to be asked whether 6690 ;; Build the header alist. Allow the user to be asked whether
6681 ;; or not to reply to all recipients in a wide reply. 6691 ;; or not to reply to all recipients in a wide reply.
6682 (setq follow-to (list (cons 'To (cdr (pop recipients))))) 6692 (setq follow-to (list (cons 'To (cdr (pop recipients)))))
@@ -6690,6 +6700,22 @@ want to get rid of this query permanently.")))
6690 (push (cons 'Cc recipients) follow-to))) 6700 (push (cons 'Cc recipients) follow-to)))
6691 follow-to)) 6701 follow-to))
6692 6702
6703(defun message-prune-recipients (recipients)
6704 (dolist (rule message-prune-recipient-rules)
6705 (let ((match (car rule))
6706 dup-match
6707 address)
6708 (dolist (recipient recipients)
6709 (setq address (car recipient))
6710 (when (string-match match address)
6711 (setq dup-match (replace-match (cadr rule) nil nil address))
6712 (dolist (recipient recipients)
6713 ;; Don't delete the address that triggered this.
6714 (when (and (not (eq address (car recipient)))
6715 (string-match dup-match (car recipient)))
6716 (setq recipients (delq recipient recipients))))))))
6717 recipients)
6718
6693(defcustom message-simplify-subject-functions 6719(defcustom message-simplify-subject-functions
6694 '(message-strip-list-identifiers 6720 '(message-strip-list-identifiers
6695 message-strip-subject-re 6721 message-strip-subject-re