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.

4 files changed, 205 insertions, 181 deletions

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)