diff options
| -rw-r--r-- | doc/misc/ChangeLog | 4 | ||||
| -rw-r--r-- | doc/misc/message.texi | 31 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/gnus/gnus-cite.el | 18 | ||||
| -rw-r--r-- | lisp/gnus/gnus-ems.el | 21 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 28 |
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 @@ | |||
| 1 | 2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * message.texi (Wide Reply): Document message-prune-recipient-rules. | ||
| 4 | |||
| 1 | 2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | 2010-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 | |||
| 182 | expression (or list of regular expressions) will be removed from the | 182 | expression (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 | ||
| 187 | used when doing a wide reply. It's meant to be used to remove | ||
| 188 | duplicate addresses and the like. It's a list of lists, where the | ||
| 189 | first element is a regexp to match the address to trigger the rule, | ||
| 190 | and the second is a regexp that will be expanded based on the first, | ||
| 191 | to match addresses to be pruned. | ||
| 192 | |||
| 193 | It's complicated to explain, but it's easy to use. | ||
| 194 | |||
| 195 | For 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 | ||
| 197 | wide reply will go out to both these addresses, since they are unique. | ||
| 198 | |||
| 199 | To avoid this, do something like the following: | ||
| 200 | |||
| 201 | @code | ||
| 202 | (setq message-prune-recipient-rules | ||
| 203 | '(("^\\([^@]+\\)@\\(.*\\)" "\\1@.*[.]\\2"))) | ||
| 204 | @end code | ||
| 205 | |||
| 206 | If, 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., | ||
| 208 | remove all other recipients if @samp{cvs@example.org} is in the | ||
| 209 | recipient 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 |
| 186 | If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you | 217 | If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you |
| 187 | will be asked to confirm that you want to reply to multiple | 218 | will 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 @@ | |||
| 1 | 2010-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 | |||
| 1 | 2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> | 12 | 2010-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 | ||
| 10 | 2010-08-31 Katsumi Yamaoka <yamaoka@jpl.org> | 21 | 2010-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. |
| 557 | See the documentation for `gnus-article-highlight-citation'. | 575 | See 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. | ||
| 254 | This 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 |