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.

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)