From bf986c1faf53f3abd260f72cb36d9143afac353d Mon Sep 17 00:00:00 2001 From: Andrew G Cohen Date: Tue, 22 Nov 2022 15:39:01 +0800 Subject: [PATCH] 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) -- 2.39.5