[Emacs-diffs] /srv/bzr/emacs/trunk r101252: gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka <address@hidden>; 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 <address@hidden>.

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 101252
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Tue 2010-08-31 23:26:23 +0000
message:
  gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by 
Katsumi Yamaoka <address@hidden>; 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 <address@hidden>.
modified:
  doc/misc/ChangeLog
  doc/misc/message.texi
  lisp/gnus/ChangeLog
  lisp/gnus/gnus-cite.el
  lisp/gnus/gnus-ems.el
  lisp/gnus/gnus-html.el
  lisp/gnus/message.el

=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog        2010-08-31 00:34:43 +0000
+++ b/doc/misc/ChangeLog        2010-08-31 23:26:23 +0000
@@ -1,3 +1,7 @@
+2010-08-31  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * message.texi (Wide Reply): Document message-prune-recipient-rules.
+
 2010-08-30  Lars Magne Ingebrigtsen  <address@hidden>
 
        * gnus.texi (Summary Mail Commands): Note that only the addresses from

=== modified file 'doc/misc/message.texi'
--- a/doc/misc/message.texi     2010-08-30 06:36:12 +0000
+++ b/doc/misc/message.texi     2010-08-31 23:26:23 +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.
 
address@hidden message-prune-recipient-rules
address@hidden 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 @address@hidden, but
address@hidden@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:
+
address@hidden
+(setq message-prune-recipient-rules
+      '(("^\\(address@hidden)@\\(.*\\)" "address@hidden")))
address@hidden code
+
+If, for instance, you want all wide replies that involve messages from
address@hidden@example.org} to go to that address, and nowhere else (i.e.,
+remove all other recipients if @address@hidden is in the
+recipient list:
+
address@hidden
+(setq message-prune-recipient-rules
+      '(("address@hidden" ".")))
address@hidden code
+
 @vindex message-wide-reply-confirm-recipients
 If @code{message-wide-reply-confirm-recipients} is address@hidden you
 will be asked to confirm that you want to reply to multiple

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2010-08-31 19:47:35 +0000
+++ b/lisp/gnus/ChangeLog       2010-08-31 23:26:23 +0000
@@ -1,3 +1,14 @@
+2010-08-31  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * 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  <address@hidden>
 
        * gnus-html.el: Require packages that define macros used in this file.
@@ -9,6 +20,9 @@
 
 2010-08-31  Katsumi Yamaoka  <address@hidden>
 
+       * 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)

=== modified file 'lisp/gnus/gnus-cite.el'
--- a/lisp/gnus/gnus-cite.el    2010-01-13 08:35:10 +0000
+++ b/lisp/gnus/gnus-cite.el    2010-08-31 23:26:23 +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'.

=== modified file 'lisp/gnus/gnus-ems.el'
--- a/lisp/gnus/gnus-ems.el     2010-08-31 13:28:02 +0000
+++ b/lisp/gnus/gnus-ems.el     2010-08-31 23:26:23 +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

=== modified file 'lisp/gnus/gnus-html.el'
--- a/lisp/gnus/gnus-html.el    2010-08-31 19:47:35 +0000
+++ b/lisp/gnus/gnus-html.el    2010-08-31 23:26:23 +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)

=== modified file 'lisp/gnus/message.el'
--- a/lisp/gnus/message.el      2010-08-31 04:21:18 +0000
+++ b/lisp/gnus/message.el      2010-08-31 23:26:23 +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