# HG changeset patch # User Katsumi Yamaoka # Date 1283297183 0 # Node ID 38805092633e8e8503d86865f1c0c48fdd1ab175 # Parent 1a236d9dcc237fe5953be946cb1fdab7e9da4c70 gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka ; 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 . diff -r 1a236d9dcc23 -r 38805092633e doc/misc/ChangeLog --- a/doc/misc/ChangeLog Tue Aug 31 21:47:35 2010 +0200 +++ b/doc/misc/ChangeLog Tue Aug 31 23:26:23 2010 +0000 @@ -1,3 +1,7 @@ +2010-08-31 Lars Magne Ingebrigtsen + + * message.texi (Wide Reply): Document message-prune-recipient-rules. + 2010-08-30 Lars Magne Ingebrigtsen * gnus.texi (Summary Mail Commands): Note that only the addresses from diff -r 1a236d9dcc23 -r 38805092633e doc/misc/message.texi --- a/doc/misc/message.texi Tue Aug 31 21:47:35 2010 +0200 +++ b/doc/misc/message.texi Tue Aug 31 23:26:23 2010 +0000 @@ -182,6 +182,37 @@ 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 diff -r 1a236d9dcc23 -r 38805092633e lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Tue Aug 31 21:47:35 2010 +0200 +++ b/lisp/gnus/ChangeLog Tue Aug 31 23:26:23 2010 +0000 @@ -1,3 +1,14 @@ +2010-08-31 Lars Magne Ingebrigtsen + + * 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 * gnus-html.el: Require packages that define macros used in this file. @@ -9,6 +20,9 @@ 2010-08-31 Katsumi Yamaoka + * 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) diff -r 1a236d9dcc23 -r 38805092633e lisp/gnus/gnus-cite.el --- a/lisp/gnus/gnus-cite.el Tue Aug 31 21:47:35 2010 +0200 +++ b/lisp/gnus/gnus-cite.el Tue Aug 31 23:26:23 2010 +0000 @@ -552,6 +552,24 @@ 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'. diff -r 1a236d9dcc23 -r 38805092633e lisp/gnus/gnus-ems.el --- a/lisp/gnus/gnus-ems.el Tue Aug 31 21:47:35 2010 +0200 +++ b/lisp/gnus/gnus-ems.el Tue Aug 31 23:26:23 2010 +0000 @@ -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 diff -r 1a236d9dcc23 -r 38805092633e lisp/gnus/gnus-html.el --- a/lisp/gnus/gnus-html.el Tue Aug 31 21:47:35 2010 +0200 +++ b/lisp/gnus/gnus-html.el Tue Aug 31 23:26:23 2010 +0000 @@ -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) diff -r 1a236d9dcc23 -r 38805092633e lisp/gnus/message.el --- a/lisp/gnus/message.el Tue Aug 31 21:47:35 2010 +0200 +++ b/lisp/gnus/message.el Tue Aug 31 23:26:23 2010 +0000 @@ -249,6 +249,14 @@ :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 @@ (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 @@ (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 @@ (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