diff options
Diffstat (limited to 'lisp/gnus/gnus-search.el')
| -rw-r--r-- | lisp/gnus/gnus-search.el | 82 |
1 files changed, 50 insertions, 32 deletions
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 22c84bc39cf..12d9dacf132 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1066,7 +1066,9 @@ Responsible for handling and, or, and parenthetical expressions.") _srv query-spec groups) (let ((artlist [])) (dolist (group groups) - (let* ((gnus-newsgroup-selection (nnselect-get-artlist group)) + (let* ((gnus-newsgroup-selection + (or + (nnselect-get-artlist group) (nnselect-generate-artlist group))) (group-spec (nnselect-categorize (mapcar 'car @@ -2174,37 +2176,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)) |