[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master bf986c1faf5 1/2: Improve gnus thread-referral
|
From: |
Andrew G Cohen |
|
Subject: |
master bf986c1faf5 1/2: Improve gnus thread-referral |
|
Date: |
Fri, 14 Apr 2023 20:23:13 -0400 (EDT) |
branch: master
commit bf986c1faf53f3abd260f72cb36d9143afac353d
Author: Andrew G Cohen <cohen@andy.bu.edu>
Commit: Andrew G Cohen <cohen@andy.bu.edu>
Improve gnus thread-referral
Allow thread referral to use search whenever possible, displaying the
results in the current summary buffer if possible and a new nnselect
buffer if not.
* lisp/gnus/nnimap.el (nnimap-request-thread): Obsolete function.
* lisp/gnus/gnus-search.el (gnus-search-thread): Allow detailed
specification of how/where to search. Add found articles to the
current summary buffer if possible, or create a new ephemeral nnselect
group if not.
* lisp/gnus/gnus-sum.el (gnus-refer-thread-use-search): Allow a list
of servers and groups to search.
(gnus-summary-refer-thread): Find thread-related articles by using a
backend-specific method, gnus-search, or retrieving nearby headers in
the current group.
* lisp/gnus/nnselect.el (nnselect-search-thread): Obsolete function.
(nnselect-request-thread): Allow thread referral from nnselect groups.
* doc/misc/gnus.texi (Finding the Parent): Document changes to thread
referral.
---
doc/misc/gnus.texi | 23 +++---
lisp/gnus/gnus-search.el | 78 ++++++++++++---------
lisp/gnus/gnus-sum.el | 117 +++++++++++++++++--------------
lisp/gnus/nnimap.el | 14 +---
lisp/gnus/nnselect.el | 177 ++++++++++++++++++++++++-----------------------
5 files changed, 218 insertions(+), 191 deletions(-)
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index f0d3c75d055..3790a9b12bf 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -10528,9 +10528,9 @@ article (@code{gnus-summary-refer-references}).
@kindex A T @r{(Summary)}
Display the full thread where the current article appears
(@code{gnus-summary-refer-thread}). By default this command looks for
-articles only in the current group. Some backends (currently only
-@code{nnimap}) know how to find articles in the thread directly. In
-other cases each header in the current group must be fetched and
+articles only in the current group. If the group belongs to a backend
+that has an associated search engine, articles are found by searching.
+In other cases each header in the current group must be fetched and
examined, so it usually takes a while. If you do it often, you may
consider setting @code{gnus-fetch-old-headers} to @code{invisible}
(@pxref{Filling In Threads}). This won't have any visible effects
@@ -10538,19 +10538,22 @@ normally, but it'll make this command work a whole
lot faster. Of
course, it'll make group entry somewhat slow.
@vindex gnus-refer-thread-use-search
-If @code{gnus-refer-thread-use-search} is non-@code{nil} then those backends
-that know how to find threads directly will search not just in the
-current group but all groups on the same server.
+If @code{gnus-refer-thread-use-search} is @code{nil} (the default)
+then thread-referral only looks for articles in the current group. If
+this variable is @code{t} the server to which the current group
+belongs is searched (provided that searching is available for the
+server's backend). If this variable is a list of servers, each server
+in the list is searched.
@vindex gnus-refer-thread-limit
The @code{gnus-refer-thread-limit} variable says how many old (i.e.,
articles before the first displayed in the current group) headers to
-fetch when doing this command. The default is 200. If @code{t}, all
-the available headers will be fetched. This variable can be overridden
-by giving the @kbd{A T} command a numerical prefix.
+fetch when referring a thread. The default is 500. If @code{t}, all
+the available headers will be fetched. This variable can be
+overridden by giving the @kbd{A T} command a numerical prefix.
@vindex gnus-refer-thread-limit-to-thread
-In most cases @code{gnus-refer-thread} adds any articles it finds to
+@code{gnus-summary-refer-thread} tries to add any articles it finds to
the current summary buffer. (When @code{gnus-refer-thread-use-search}
is true and the initial referral starts from a summary buffer for a
non-virtual group this may not be possible. In this case a new
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 22c84bc39cf..71980afa0ff 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -2174,37 +2174,53 @@ remaining string, then adds all that to the top-level
spec."
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(defun gnus-search-thread (header)
- "Make an nnselect group based on the thread containing the article
-header. The current server will be searched. If the registry is
-installed, the server that the registry reports the current
-article came from is also searched."
- (let* ((ids (cons (mail-header-id header)
- (split-string
- (or (mail-header-references header)
- ""))))
- (query
- (list (cons 'query (mapconcat (lambda (i)
- (format "id:%s" i))
- ids " or "))
- (cons 'thread t)))
- (server
- (list (list (gnus-method-to-server
- (gnus-find-method-for-group gnus-newsgroup-name)))))
- (registry-group (and
- (bound-and-true-p gnus-registry-enabled)
- (car (gnus-registry-get-id-key
- (mail-header-id header) 'group))))
- (registry-server
- (and registry-group
- (gnus-method-to-server
- (gnus-find-method-for-group registry-group)))))
- (when registry-server
- (cl-pushnew (list registry-server) server :test #'equal))
- (gnus-group-make-search-group nil (list
- (cons 'search-query-spec query)
- (cons 'search-group-spec server)))
- (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+(defun gnus-search-thread (header &optional group server)
+ "Find articles in the thread containing HEADER from GROUP on SERVER.
+If gnus-refer-thread-use-search is nil only the current group is
+checked for articles; if t all groups on the server containing
+the article's group will be searched; if a list then all servers
+in this list will be searched. If possible the newly found
+articles are added to the summary buffer; otherwise the full
+thread is displayed in a new ephemeral nnselect buffer."
+ (let* ((group (or group gnus-newsgroup-name))
+ (server (or server (gnus-group-server group)))
+ (query
+ (list
+ (cons 'query
+ (mapconcat (lambda (i) (format "id:%s" i))
+ (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header) "")))
+ " or "))
+ (cons 'thread t)))
+ (gnus-search-use-parsed-queries t))
+ (if (not gnus-refer-thread-use-search)
+ ;; Search only the current group and send the headers back to
+ ;; the caller to add to the summary buffer.
+ (gnus-fetch-headers
+ (sort
+ (mapcar (lambda (x) (elt x 1))
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec
+ (list (list server group))))))
+ #'<) nil t)
+ ;; Otherwise create an ephemeral search group. If we return to
+ ;; the current summary buffer after exiting the thread we would
+ ;; end up overwriting any changes we made, so we exit the
+ ;; current summary buffer first.
+ (gnus-summary-exit)
+ (gnus-group-read-ephemeral-search-group
+ nil
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec
+ (if (listp gnus-refer-thread-use-search)
+ gnus-refer-thread-use-search
+ (list (list server))))))
+ (if (gnus-id-to-article (mail-header-id header))
+ (gnus-summary-goto-subject
+ (gnus-id-to-article (mail-header-id header)))
+ (message "Thread search failed")))))
(defun gnus-search-get-active (srv)
(let ((method (gnus-server-to-method srv))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 16a85cefcc7..35e867a3508 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -80,6 +80,8 @@
(autoload 'nnselect-article-rsv "nnselect" nil nil)
(autoload 'nnselect-article-group "nnselect" nil nil)
(autoload 'gnus-nnselect-group-p "nnselect" nil nil)
+(autoload 'gnus-search-thread "gnus-search" nil nil)
+(autoload 'gnus-search-server-to-engine "gnus-search" nil nil)
(defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it.
@@ -141,12 +143,17 @@ If t, fetch all the available old headers."
'gnus-refer-thread-use-search "28.1")
(defcustom gnus-refer-thread-use-search nil
- "Search an entire server when referring threads.
-A nil value will only search for thread-related articles in the
-current group."
+ "Specify where to find articles when referring threads.
+A nil value restricts searches for thread-related articles to the
+current group; a value of t searches all groups on the server; a
+list of servers and groups (where each element is a list whose
+car is the server and whose cdr is a list of groups on this
+server or nil to search the entire server) searches these
+server/groups. This may usefully be set as a group parameter."
:version "28.1"
:group 'gnus-thread
- :type 'boolean)
+ :type '(restricted-sexp :match-alternatives
+ (listp 't 'nil)))
(defcustom gnus-refer-thread-limit-to-thread nil
"If non-nil referring a thread will limit the summary buffer to
@@ -9009,64 +9016,72 @@ Return the number of articles fetched."
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread.
-For backends that know how to search for threads (currently only
-`nnimap') a non-numeric prefix arg will search the entire server;
-without a prefix arg only the current group is searched. If the
-variable `gnus-refer-thread-use-search' is non-nil the prefix arg
-has the reverse meaning. If no backend-specific `request-thread'
-function is available fetch LIMIT (the numerical prefix) old
-headers. If LIMIT is non-numeric or nil fetch the number
-specified by the `gnus-refer-thread-limit' variable."
+A non-numeric prefix arg will search the entire server; without a
+prefix arg only the current group is searched. If the variable
+`gnus-refer-thread-use-search' is t the prefix arg has the
+reverse meaning. If searching is not enabled for the current
+group, fetch LIMIT (the numerical prefix) old headers. If LIMIT
+is non-numeric or nil fetch the number specified by the
+`gnus-refer-thread-limit' variable."
(interactive "P" gnus-summary-mode)
- (let* ((header (gnus-summary-article-header))
- (id (mail-header-id header))
- (gnus-inhibit-demon t)
- (gnus-summary-ignore-duplicates t)
- (gnus-read-all-available-headers t)
- (gnus-refer-thread-use-search
- (if (and (not (null limit)) (listp limit))
- (not gnus-refer-thread-use-search) gnus-refer-thread-use-search))
- (new-headers
- (if (gnus-check-backend-function
- 'request-thread gnus-newsgroup-name)
- (gnus-request-thread header gnus-newsgroup-name)
- (let* ((limit (if (numberp limit) (prefix-numeric-value limit)
- gnus-refer-thread-limit))
- (last (if (numberp limit)
- (min (+ (mail-header-number header)
- limit)
- gnus-newsgroup-highest)
- gnus-newsgroup-highest))
- (subject (gnus-simplify-subject
- (mail-header-subject header)))
- (refs (split-string (or (mail-header-references header)
- "")))
- (gnus-parse-headers-hook
+ (let* ((group gnus-newsgroup-name)
+ (header (gnus-summary-article-header))
+ (id (mail-header-id header))
+ (gnus-inhibit-demon t)
+ (gnus-summary-ignore-duplicates t)
+ (gnus-read-all-available-headers t)
+ (gnus-refer-thread-use-search
+ (if (or (null limit) (numberp limit))
+ gnus-refer-thread-use-search
+ (if (booleanp gnus-refer-thread-use-search)
+ (not gnus-refer-thread-use-search)
+ gnus-refer-thread-use-search)))
+ article-ids new-unreads
+ (new-headers
+ (cond
+ ;; If there is a backend-specific method, use it.
+ ((gnus-check-backend-function
+ 'request-thread group)
+ (gnus-request-thread header group))
+ ;; If a search engine is configured, use it.
+ ((ignore-errors
+ (gnus-search-server-to-engine (gnus-group-server group)))
+ (gnus-search-thread header))
+ ;; Otherwise just retrieve some headers.
+ (t
+ (let* ((limit (if (numberp limit)
+ limit
+ gnus-refer-thread-limit))
+ (last (if (numberp limit)
+ (min (+ (mail-header-number header) limit)
+ gnus-newsgroup-highest)
+ gnus-newsgroup-highest))
+ (subject (gnus-simplify-subject
+ (mail-header-subject header)))
+ (refs (split-string
+ (or (mail-header-references header) "")))
+ (gnus-parse-headers-hook
(let ((refs (append refs (list id subject))))
- (lambda ()
- (goto-char (point-min))
- (keep-lines (regexp-opt refs))))))
- (gnus-fetch-headers (list last) (if (numberp limit)
- (* 2 limit) limit)
- t))))
- article-ids new-unreads)
+ (lambda () (goto-char (point-min))
+ (keep-lines (regexp-opt refs))))))
+ (gnus-fetch-headers
+ (list last) (if (numberp limit) (* 2 limit) limit) t))))))
(when (listp new-headers)
(dolist (header new-headers)
- (push (mail-header-number header) article-ids))
+ (push (mail-header-number header) article-ids))
(setq article-ids (nreverse article-ids))
(setq new-unreads
- (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
+ (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
(setq gnus-newsgroup-unselected
- (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
+ (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
(setq gnus-newsgroup-unreads
- (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
+ (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
(setq gnus-newsgroup-headers
(gnus-delete-duplicate-headers
- (cl-merge
- 'list gnus-newsgroup-headers new-headers
- 'gnus-article-sort-by-number)))
+ (cl-merge 'list gnus-newsgroup-headers new-headers
+ 'gnus-article-sort-by-number)))
(setq gnus-newsgroup-articles
- (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
+ (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
(gnus-summary-limit-include-thread id
gnus-refer-thread-limit-to-thread)))
(gnus-summary-show-thread))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index de942993586..81449cb58b2 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1908,19 +1908,7 @@ If LIMIT, first try to limit the search to the N last
articles."
(autoload 'nnselect-search-thread "nnselect")
-(deffoo nnimap-request-thread (header &optional group server)
- (if gnus-refer-thread-use-search
- (nnselect-search-thread header)
- (when (nnimap-change-group group server)
- (let* ((cmd (nnimap-make-thread-query header))
- (result (with-current-buffer (nnimap-buffer)
- (nnimap-command "UID SEARCH %s" cmd))))
- (when result
- (gnus-fetch-headers
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH" (cdr result))))))
- nil t))))))
+(make-obsolete 'nnimap-request-thread 'gnus-search-thread "29.1")
(defun nnimap-change-group (group &optional server no-reconnect read-only)
"Change group to GROUP if non-nil.
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 4eaaffe34a5..3db083c0511 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -112,6 +112,7 @@
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
(make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1")
+(make-obsolete 'nnselect-search-thread 'gnus-search-thread "29.1")
;; Data type article list.
@@ -567,9 +568,9 @@ artlist; otherwise store the ARTLIST in the group
parameters."
(artnumber (nnselect-article-number article))
(gmark (gnus-request-update-mark artgroup artnumber mark)))
(when (and artnumber
- (memq mark gnus-auto-expirable-marks)
- (= mark gmark)
- (gnus-group-auto-expirable-p artgroup))
+ (memq mark gnus-auto-expirable-marks)
+ (= mark gmark)
+ (gnus-group-auto-expirable-p artgroup))
(setq gmark gnus-expirable-mark))
gmark))
@@ -656,57 +657,48 @@ artlist; otherwise store the ARTLIST in the group
parameters."
(deffoo nnselect-request-thread (header &optional group server)
(with-current-buffer gnus-summary-buffer
- (let ((group (nnselect-add-prefix group))
- ;; find the best group for the originating article. if its a
- ;; pseudo-article look for real articles in the same thread
- ;; and see where they come from.
- (artgroup (nnselect-article-group
- (if (> (mail-header-number header) 0)
- (mail-header-number header)
- (if (> (gnus-summary-article-number) 0)
- (gnus-summary-article-number)
- (let ((thread
- (gnus-id-to-thread (mail-header-id header))))
- (when thread
- (cl-some (lambda (x)
- (when (and x (> x 0)) x))
- (gnus-articles-in-thread thread)))))))))
- ;; Check if search-based thread referral is permitted, and
- ;; available.
- (if (and gnus-refer-thread-use-search
- (gnus-search-server-to-engine
- (gnus-method-to-server
- (gnus-find-method-for-group artgroup))))
- ;; If so we perform the query, massage the result, and return
- ;; the new headers back to the caller to incorporate into the
- ;; current summary buffer.
- (let* ((gnus-search-use-parsed-queries t)
+ (let* ((group (nnselect-add-prefix group))
+ ;; Find the best group for the originating article. If its
+ ;; a pseudo-article check for real articles in the same
+ ;; thread to see where they come from.
+ (artgroup
+ (nnselect-article-group
+ (cond
+ ((> (mail-header-number header) 0)
+ (mail-header-number header))
+ ((> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number))
+ (t (cl-some
+ (lambda (x) (when (and x (> x 0)) x))
+ (gnus-articles-in-thread
+ (gnus-id-to-thread (mail-header-id header))))))))
+ (server (or server (gnus-group-server artgroup))))
+ ;; Check if search-based thread referral is available.
+ (if (ignore-errors (gnus-search-server-to-engine server))
+ ;; We perform the query, massage the result, and return
+ ;; the new headers back to the caller to incorporate into
+ ;; the current summary buffer.
+ (let* ((gnus-search-use-parsed-queries t)
(group-spec
- (list (delq nil (list
- (or server (gnus-group-server artgroup))
- (unless gnus-refer-thread-use-search
- artgroup)))))
- (ids (cons (mail-header-id header)
- (split-string
- (or (mail-header-references header)
- ""))))
- (query-spec
- (list (cons 'query (mapconcat (lambda (i)
- (format "id:%s" i))
- ids " or "))
- (cons 'thread t)))
- (last (nnselect-artlist-length gnus-newsgroup-selection))
- (first (1+ last))
- (new-nnselect-artlist
- (gnus-search-run-query
- (list (cons 'search-query-spec query-spec)
- (cons 'search-group-spec group-spec))))
- old-arts seq
- headers)
- (mapc
+ (if (not gnus-refer-thread-use-search)
+ (list (list server artgroup))
+ (if (listp gnus-refer-thread-use-search)
+ gnus-refer-thread-use-search
+ (list (list server)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query-spec
+ (list (cons 'query
+ (mapconcat (lambda (i) (format "id:%s" i))
+ ids " or ")) (cons 'thread t)))
+ (last (nnselect-artlist-length gnus-newsgroup-selection))
+ (first (1+ last))
+ old-arts seq headers)
+ (mapc
(lambda (article)
- (if
- (setq seq
+ (if (setq seq
(cl-position
article
gnus-newsgroup-selection
@@ -714,48 +706,61 @@ artlist; otherwise store the ARTLIST in the group
parameters."
(lambda (x y)
(and (equal (nnselect-artitem-group x)
(nnselect-artitem-group y))
- (eql (nnselect-artitem-number x)
+ (eql (nnselect-artitem-number x)
(nnselect-artitem-number y))))))
(push (1+ seq) old-arts)
(setq gnus-newsgroup-selection
(vconcat gnus-newsgroup-selection (vector article)))
(cl-incf last)))
- new-nnselect-artlist)
- (setq headers
- (gnus-fetch-headers
- (append (sort old-arts #'<)
- (number-sequence first last))
- nil t))
- (nnselect-store-artlist group gnus-newsgroup-selection)
- (when (>= last first)
- (let (new-marks)
- (pcase-dolist (`(,artgroup . ,artids)
- (ids-by-group (number-sequence first last)))
- (pcase-dolist (`(,type . ,marked)
- (gnus-info-marks (gnus-get-info artgroup)))
- (setq marked (gnus-uncompress-sequence marked))
- (when (setq new-marks
- (delq nil
- (mapcar
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
+ (setq headers
+ (gnus-fetch-headers
+ (append (sort old-arts #'<) (number-sequence first last))
+ nil t))
+ (nnselect-store-artlist group gnus-newsgroup-selection)
+ (when (>= last first)
+ (let (new-marks)
+ (pcase-dolist (`(,artgroup . ,artids)
+ (ids-by-group (number-sequence first last)))
+ (pcase-dolist (`(,type . ,marked)
+ (gnus-info-marks (gnus-get-info artgroup)))
+ (when
+ (setq new-marks
+ (delq nil
+ (if (eq (gnus-article-mark-to-type type)
+ 'tuple)
+ (mapcar
+ (lambda (art)
+ (let ((mtup
+ (assq (cdr art) marked)))
+ (when mtup
+ (cons (car art) (cdr mtup)))))
+ artids)
+ (setq marked
+ (gnus-uncompress-sequence marked))
+ (mapcar
(lambda (art)
(when (memq (cdr art) marked)
(car art)))
- artids)))
- (nconc
- (symbol-value
- (intern
- (format "gnus-newsgroup-%s"
- (car (rassq type gnus-article-mark-lists)))))
- new-marks)))))
- (setq gnus-newsgroup-active
- (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))
- (gnus-set-active
- group
- (cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
- headers)
- ;; If we can't or won't use search, just warp to the original
- ;; group and punt back to gnus-summary-refer-thread.
- (and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
+ artids))))
+ (nconc
+ (symbol-value
+ (intern
+ (format "gnus-newsgroup-%s"
+ (car
+ (rassq type gnus-article-mark-lists)))))
+ new-marks)))))
+ (gnus-set-active
+ group
+ (setq
+ gnus-newsgroup-active
+ (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))))
+ headers)
+ ;; If we can't use search, just warp to the original group and
+ ;; punt back to gnus-summary-refer-thread.
+ (and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
(deffoo nnselect-close-group (group &optional _server)