# HG changeset patch # User Katsumi Yamaoka # Date 1289089326 0 # Node ID b75e6634a1717a1050b83a1473b125b9dfe9fd36 # Parent 249a1455856acb29fb43c7531b0d37e2f8e6837d 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 -r 249a1455856a -r b75e6634a171 lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/ChangeLog Sun Nov 07 00:22:06 2010 +0000 @@ -1,9 +1,32 @@ +2010-11-06 Lars Magne Ingebrigtsen + + * 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 * 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 + + * 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 * nnir.el (gnus-summary-nnir-goto-thread): Limit work done by diff -r 249a1455856a -r b75e6634a171 lisp/gnus/gnus-ems.el --- a/lisp/gnus/gnus-ems.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/gnus-ems.el Sun Nov 07 00:22:06 2010 +0000 @@ -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 -r 249a1455856a -r b75e6634a171 lisp/gnus/gnus-int.el --- a/lisp/gnus/gnus-int.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/gnus-int.el Sun Nov 07 00:22:06 2010 +0000 @@ -503,11 +503,22 @@ (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 -r 249a1455856a -r b75e6634a171 lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/gnus-sum.el Sun Nov 07 00:22:06 2010 +0000 @@ -2061,6 +2061,7 @@ "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 @@ (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 @@ (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 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-inhibit-demon t) + (gnus-agent nil) (gnus-summary-ignore-duplicates t) - (gnus-inhibit-demon 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 -r 249a1455856a -r b75e6634a171 lisp/gnus/message.el --- a/lisp/gnus/message.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/message.el Sun Nov 07 00:22:06 2010 +0000 @@ -4482,6 +4482,8 @@ (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 -r 249a1455856a -r b75e6634a171 lisp/gnus/nnimap.el --- a/lisp/gnus/nnimap.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/nnimap.el Sun Nov 07 00:22:06 2010 +0000 @@ -1397,23 +1397,23 @@ 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 -r 249a1455856a -r b75e6634a171 lisp/gnus/nnir.el --- a/lisp/gnus/nnir.el Sat Nov 06 13:23:42 2010 -0700 +++ b/lisp/gnus/nnir.el Sun Nov 07 00:22:06 2010 +0000 @@ -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 @@ (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 @@ (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)