Mercurial > emacs

--- 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  <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
--- 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
--- 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  <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)
--- 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'.
--- 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
--- 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)
--- 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