gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka <yamaoka@jpl.org>; 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 <larsi@gnus.org>.

5 files changed, 84 insertions, 5 deletions

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 @@
+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)
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."
               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 --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 @@
           (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 --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 @@
                    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 --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."
   :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 @@ The function is called with one parameter, a cons cell ..."
 
 (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 @@ want to get rid of this query permanently.")))
                 (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 @@ want to get rid of this query permanently.")))
         (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