gnus-int.el, nnimap.el, nnir.el: More improvements to thread-referral.

message.el (message-send-mail): Don't insert courtesy messages if the message already has List-Post and List-ID messages.
gnus-ems.el (gnus-put-image): Use a blank text as the insertion string to avoid making the From headers syntactically invalid.

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d287b07569ce1b381a70923f0e8d8f23d138d3be..5b2c0bb1e643ad863ac5ea84d1e303f8df8f9135 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,9 +1,32 @@
+2010-11-06  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * gnus-ems.el (gnus-put-image): Use a blank text as the insertion
+       string to avoid making the From headers syntactically invalid.
+
+       * message.el (message-send-mail): Don't insert courtesy messages if the
+       message already has List-Post and List-ID messages.
+
 2010-11-06  Glenn Morris  <rgm@gnu.org>
 
        * gnus-art.el (gnus-treat-article): Give dynamic local variables
        `condition', `type', `length' a prefix.
        (gnus-treat-predicate): Update for above name changes.
 
+2010-11-06  Andrew Cohen  <cohen@andy.bu.edu>
+
+       * nnir.el (gnus-summary-nnir-goto-thread): Remove function and
+       binding.  Handled by `gnus-summary-refer-thread' instead.
+       (nnir-warp-to-article): New backend function.
+
+       * nnimap.el (nnimap-request-thread): Force dependency updating.
+
+       * gnus-sum.el (gnus-fetch-headers): Allow more arguments.
+       (gnus-summary-refer-thread): Rework to improve thread-referral.
+
+       * gnus-int.el (gnus-warp-to-article): New function.
+
+       * gnus-sum.el (gnus-summary-article-map): Bind it.
+
 2010-11-04  Andrew Cohen  <cohen@andy.bu.edu>
 
        * nnir.el (gnus-summary-nnir-goto-thread): Limit work done by

diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 3a79e67801fd04f5406f15fbbc2128e2b1d0e0b9..d7d90767124fe6e737878e00b8057c6fb9d8afd6 100644 (file)
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -181,7 +181,7 @@
 
 (defun gnus-put-image (glyph &optional string category)
   (let ((point (point)))
-    (insert-image glyph (or string "*"))
+    (insert-image glyph (or string " "))
     (put-text-property point (point) 'gnus-image-category category)
     (unless string
       (put-text-property (1- (point)) (point)

diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index b344a5ef15ccc5d686e958747ec45127a44aa036..bcfff3479689c6a0c438e870e56192701301c654 100644 (file)
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -503,11 +503,22 @@ If BUFFER, insert the article in that group."
             (nth 1 gnus-command-method) buffer)))
 
 (defun gnus-request-thread (id)
-  "Request the thread containing the article specified by Message-ID id."
+  "Request the headers in the thread containing the article
+specified by Message-ID id."
   (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
     (funcall (gnus-get-function gnus-command-method 'request-thread)
             id)))
 
+(defun gnus-warp-to-article ()
+  "Warps from an article in a virtual group to the article in its
+real group. Does nothing on a real group."
+  (interactive)
+  (let ((gnus-command-method
+        (gnus-find-method-for-group gnus-newsgroup-name)))
+    (when (gnus-check-backend-function
+          'warp-to-article (car gnus-command-method))
+      (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+
 (defun gnus-request-head (article group)
   "Request the head of ARTICLE in GROUP."
   (let* ((gnus-command-method (gnus-find-method-for-group group))

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 2eedc07d10f708fdf9cffba98fce32d846cbf86a..ad2f5b6d9c6b85817fc29cfbc9c12248cfdc9c26 100644 (file)
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2061,6 +2061,7 @@ increase the score of each group you read."
   "D" gnus-summary-enter-digest-group
   "R" gnus-summary-refer-references
   "T" gnus-summary-refer-thread
+  "W" gnus-warp-to-article
   "g" gnus-summary-show-article
   "s" gnus-summary-isearch-article
   "P" gnus-summary-print-article
@@ -5468,7 +5469,7 @@ or a straight list of headers."
                          (substring subject (match-end 1)))))
          (mail-header-set-subject header subject))))))
 
-(defun gnus-fetch-headers (articles)
+(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
   "Fetch headers of ARTICLES."
   (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
     (gnus-message 5 "Fetching headers for %s..." name)
@@ -5477,16 +5478,17 @@ or a straight list of headers."
                (setq gnus-headers-retrieved-by
                      (gnus-retrieve-headers
                       articles gnus-newsgroup-name
-                      ;; We might want to fetch old headers, but
-                      ;; not if there is only 1 article.
-                      (and (or (and
-                                (not (eq gnus-fetch-old-headers 'some))
-                                (not (numberp gnus-fetch-old-headers)))
-                               (> (length articles) 1))
-                           gnus-fetch-old-headers))))
+                      (or limit
+                          ;; We might want to fetch old headers, but
+                          ;; not if there is only 1 article.
+                          (and (or (and
+                                    (not (eq gnus-fetch-old-headers 'some))
+                                    (not (numberp gnus-fetch-old-headers)))
+                                   (> (length articles) 1))
+                               gnus-fetch-old-headers)))))
            (gnus-get-newsgroup-headers-xover
-            articles nil nil gnus-newsgroup-name t)
-         (gnus-get-newsgroup-headers))
+            articles force-new dependencies gnus-newsgroup-name t)
+         (gnus-get-newsgroup-headers dependencies force-new))
       (gnus-message 5 "Fetching headers for %s...done" name))))
 
 (defun gnus-select-newsgroup (group &optional read-all select-articles)
@@ -8835,46 +8837,39 @@ fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
 fetch what's specified by the `gnus-refer-thread-limit'
 variable."
   (interactive "P")
+  (gnus-warp-to-article)
   (let ((id (mail-header-id (gnus-summary-article-header)))
-       (subject (gnus-simplify-subject
-                 (mail-header-subject (gnus-summary-article-header))))
-       (refs (split-string (or (mail-header-references
-                                (gnus-summary-article-header)) "")))
-       (gnus-summary-ignore-duplicates t)
        (gnus-inhibit-demon t)
+       (gnus-agent nil)
+       (gnus-summary-ignore-duplicates t)
        (gnus-read-all-available-headers t)
        (limit (if limit (prefix-numeric-value limit)
                 gnus-refer-thread-limit)))
-    (if  (gnus-check-backend-function 'request-thread gnus-newsgroup-name)
-       (setq gnus-newsgroup-headers
-             (gnus-merge 'list
-                         gnus-newsgroup-headers
-                         (gnus-request-thread id)
-                         'gnus-article-sort-by-number))
-      (unless (eq gnus-fetch-old-headers 'invisible)
-       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
-       ;;      Retrieve the headers and read them in.
-       (if (numberp limit)
-           (gnus-retrieve-headers
-            (list (min
-                   (+ (mail-header-number
-                       (gnus-summary-article-header))
-                      limit)
-                   gnus-newsgroup-end))
-            gnus-newsgroup-name (* limit 2))
-         ;; gnus-refer-thread-limit is t, i.e. fetch _all_
-         ;; headers.
-         (gnus-retrieve-headers (list gnus-newsgroup-end)
-                                gnus-newsgroup-name limit)
-         (gnus-message 5 "Fetching headers for %s...done"
-                       gnus-newsgroup-name))))
-    (when (eq gnus-headers-retrieved-by 'nov)
-      ;; might as well restrict the headers to the relevant ones. this
-      ;; should save time when building threads.
-      (with-current-buffer nntp-server-buffer
-       (goto-char (point-min))
-       (keep-lines (regexp-opt (append refs (list id subject)))))
-      (gnus-build-all-threads))
+    (setq gnus-newsgroup-headers
+         (gnus-merge
+          'list gnus-newsgroup-headers
+          (if (gnus-check-backend-function
+               'request-thread gnus-newsgroup-name)
+              (gnus-request-thread id)
+            (let* ((last (if (numberp limit)
+                             (min (+ (mail-header-number
+                                      (gnus-summary-article-header))
+                                     limit)
+                                  gnus-newsgroup-highest)
+                           gnus-newsgroup-highest))
+                   (subject (gnus-simplify-subject
+                             (mail-header-subject
+                              (gnus-summary-article-header))))
+                   (refs (split-string (or (mail-header-references
+                                            (gnus-summary-article-header))
+                                           "")))
+                   (gnus-parse-headers-hook
+                    (lambda () (goto-char (point-min))
+                      (keep-lines
+                       (regexp-opt (append refs (list id subject)))))))
+              (gnus-fetch-headers (list last) (if (numberp limit)
+                                                  (* 2 limit) limit) t)))
+          'gnus-article-sort-by-number))
     (gnus-summary-limit-include-thread id)))
 
 (defun gnus-summary-refer-article (message-id)

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index cc793dfcf9a9c8d53cc5ceedf278b8b4b2e2dd81..722ef430298a1504e79cbd7d969503eb5352eb0f 100644 (file)
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4482,6 +4482,8 @@ This function could be useful in `message-setup-hook'."
              (save-restriction
                (message-narrow-to-headers)
                (and news
+                    (not (message-fetch-field "List-Post"))
+                    (not (message-fetch-field "List-ID"))
                     (or (message-fetch-field "cc")
                         (message-fetch-field "bcc")
                         (message-fetch-field "to"))

diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 65d5af964e575e942ee5dbd0381aadc3608c6e09..67e2c91c3a27a2c9a8c709db56ec2936b864b5e4 100644 (file)
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1397,23 +1397,23 @@ textual parts.")
   nil)
 
 (deffoo nnimap-request-thread (id)
-    (let* ((refs (split-string
-              (or (mail-header-references (gnus-summary-article-header))
-                  "")))
-          (cmd (let ((value
-                      (format
-                       "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
-                       id id)))
-                 (dolist (refid refs value)
-                   (setq value (format
-                                "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
-                                refid refid value)))))
-          (result
-           (with-current-buffer (nnimap-buffer)
-             (nnimap-command  "UID SEARCH %s" cmd))))
-      (gnus-fetch-headers (and (car result)
-          (delete 0 (mapcar #'string-to-number
-                            (cdr (assoc "SEARCH" (cdr result)))))))))
+  (let* ((refs (split-string
+               (or (mail-header-references (gnus-summary-article-header))
+                   "")))
+        (cmd (let ((value
+                    (format
+                     "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+                     id id)))
+               (dolist (refid refs value)
+                 (setq value (format
+                              "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+                              refid refid value)))))
+        (result (with-current-buffer (nnimap-buffer)
+                  (nnimap-command  "UID SEARCH %s" cmd))))
+    (gnus-fetch-headers
+     (and (car result) (delete 0 (mapcar #'string-to-number
+                                        (cdr (assoc "SEARCH" (cdr result))))))
+     nil t)))
 
 (defun nnimap-possibly-change-group (group server)
   (let ((open-result t))

diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 326de6e3ac889c6dffb0ee7dccafe925055f3f4d..ae6b903c04766c117548d539cbc15af610213397 100644 (file)
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -41,9 +41,10 @@
 ;; Retrieval Status Value (score).
 
 ;; When looking at the retrieval result (in the Summary buffer) you
-;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
-;; article.  You will be teleported into the group this article came
-;; from, showing the thread this article is part of.
+;; can type `A W' (aka M-x gnus-warp-article RET) on an article.  You
+;; will be warped into the group this article came from. Typing `A W'
+;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
+;; also show the thread this article is part of.
 
 ;; The Lisp setup may involve setting a few variables and setting up the
 ;; search engine. You can define the variables in the server definition
@@ -473,56 +474,6 @@ result, `gnus-retrieve-headers' will be called instead.")
      (cons (current-buffer) gnus-current-window-configuration)
      nil)))
 
-;; Summary mode commands.
-
-(defun gnus-summary-nnir-goto-thread ()
-  "Only applies to nnir groups.  Go to group this article came from
-and show thread that contains this article."
-  (interactive)
-  (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
-    (error "Can't execute this command unless in nnir group"))
-  (let* ((cur (gnus-summary-article-number))
-         (group (nnir-artlist-artitem-group nnir-artlist cur))
-         (backend-number (nnir-artlist-artitem-number nnir-artlist cur))
-        (id (mail-header-id (gnus-summary-article-header)))
-        (refs (split-string
-               (mail-header-references (gnus-summary-article-header)))))
-    (if (eq (car (gnus-find-method-for-group group)) 'nnimap)
-       (progn
-         (nnimap-possibly-change-group (gnus-group-short-name group) nil)
-         (with-current-buffer (nnimap-buffer)
-           (let* ((cmd
-                   (let ((value
-                          (format
-                           "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
-                           id id)))
-                     (dolist (refid refs value)
-                       (setq value
-                             (format
-                              "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
-                              refid refid value)))))
-                  (result (nnimap-command "UID SEARCH %s" cmd)))
-             (gnus-summary-read-group-1
-              group t t gnus-summary-buffer nil
-              (and (car result)
-                   (delete 0 (mapcar
-                              #'string-to-number
-                              (cdr (assoc "SEARCH" (cdr result))))))))))
-      (gnus-summary-read-group-1 group t t gnus-summary-buffer
-                                nil (list backend-number))
-      (gnus-summary-refer-thread))))
-
-
-(if (fboundp 'eval-after-load)
-    (eval-after-load "gnus-sum"
-      '(define-key gnus-summary-goto-map
-         "T" 'gnus-summary-nnir-goto-thread))
-  (add-hook 'gnus-summary-mode-hook
-            (function (lambda ()
-                        (define-key gnus-summary-goto-map
-                          "T" 'gnus-summary-nnir-goto-thread)))))
-
-
 
 ;; Gnus backend interface functions.
 
@@ -656,6 +607,13 @@ and show thread that contains this article."
          (gnus-group-real-name to-newsgroup))) ; Is this move internal
     ))
 
+(deffoo nnir-warp-to-article ()
+  (let* ((cur (gnus-summary-article-number))
+         (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur))
+         (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
+    (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
+                              nil (list backend-number))))
+
 (nnoo-define-skeleton nnir)