From: Andrew G Cohen Date: Fri, 11 Sep 2020 01:02:09 +0000 (+0800) Subject: Clean up group-finding in Gnus nnir search X-Git-Tag: emacs-28.0.90~6134 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=206cff84bda2a7dd204a0da19e29abf389643f6b;p=emacs.git Clean up group-finding in Gnus nnir search This is part of removing code from nnir.el that isn't related to searching backends and therefore belongs somewhere else. * lisp/gnus/gnus-group.el (gnus-group-make-search-group) (gnus-group-read-ephemeral-search-group): Put the logic for determining the groups to search here, rather than in nnir. Improve documentation. * lisp/gnus/gnus-int.el (gnus-server-get-active): Renamed from 'nnir-get-active. * lisp/gnus/nnir.el (nnir-run-imap, nnir-run-find-grep): Use it. (nnir-get-active): Remove. (nnir-make-specs): Make obsolete. * lisp/gnus/nnselect.el (nnselect-group-server): Make obsolete in favor of 'gnus-group-server. --- diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index fcaa6d78595..1d614f8a8d4 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3166,30 +3166,67 @@ mail messages or news articles in files that have numeric names." (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(autoload 'nnir-make-specs "nnir") +(autoload 'nnir-read-parms "nnir") +(autoload 'nnir-server-to-search-engine "nnir") (autoload 'gnus-group-topic-name "gnus-topic") ;; Temporary to make group creation easier (defun gnus-group-make-search-group (nnir-extra-parms &optional specs) + "Make a group based on a search. +Prompt for a search query and determine the groups to search as +follows: if called from the *Server* buffer search all groups +belonging to the server on the current line; if called from the +*Group* buffer search any marked groups, or the group on the +current line, or all the groups under the current topic. Calling +with a prefix arg prompts for additional search-engine specific +constraints. A non-nil SPECS arg must be an alist with +`nnir-query-spec' and `nnir-group-spec' keys, and skips all +prompting." (interactive "P") (let ((name (gnus-read-group "Group name: "))) (with-current-buffer gnus-group-buffer - (gnus-group-make-group - name - (list 'nnselect "nnselect") - nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs))))))))) + (let* ((group-spec + (or + (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or + (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-make-group + name + (list 'nnselect "nnselect") + nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))))) (define-obsolete-function-alias 'gnus-group-make-nnir-group 'gnus-group-read-ephemeral-search-group "28.1") (defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs) - "Create an nnselect group based on a search. + "Read an nnselect group based on a search. Prompt for a search query and determine the groups to search as follows: if called from the *Server* buffer search all groups belonging to the server on the current line; if called from the @@ -3200,19 +3237,42 @@ constraints. A non-nil SPECS arg must be an alist with `nnir-query-spec' and `nnir-group-spec' keys, and skips all prompting." (interactive "P") - (gnus-group-read-ephemeral-group - (concat "nnselect-" (message-unique-id)) - (list 'nnselect "nnselect") - nil - (cons (current-buffer) gnus-current-window-configuration) - nil nil - (list - (cons 'nnselect-specs - (list - (cons 'nnselect-function 'nnir-run-query) - (cons 'nnselect-args - (nnir-make-specs nnir-extra-parms specs)))) - (cons 'nnselect-artlist nil)))) + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (cdr + (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) + (query-spec + (or (cdr (assq 'nnir-query-spec specs)) + (apply + 'append + (list (cons 'query + (read-string "Query: " nil 'nnir-search-history))) + (when nnir-extra-parms + (mapcar + (lambda (x) + (nnir-read-parms (nnir-server-to-search-engine (car x)))) + group-spec)))))) + (gnus-group-read-ephemeral-group + (concat "nnselect-" (message-unique-id)) + (list 'nnselect "nnselect") + nil + (cons (current-buffer) gnus-current-window-configuration) + nil nil + (list + (cons 'nnselect-specs + (list + (cons 'nnselect-function 'nnir-run-query) + (cons 'nnselect-args + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec))))) + (cons 'nnselect-artlist nil))))) (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index da385a18023..b8be766c84f 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -365,6 +365,48 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method 'request-list) (nth 1 gnus-command-method))) +(defun gnus-server-get-active (server &optional ignored) + "Return the active list for SERVER. +Groups matching the IGNORED regexp are excluded." + (let ((method (gnus-server-to-method server)) + groups) + (gnus-request-list method) + (with-current-buffer nntp-server-buffer + (let ((cur (current-buffer))) + (goto-char (point-min)) + (unless (or (null ignored) + (string= ignored "")) + (delete-matching-lines ignored)) + (if (eq (car method) 'nntp) + (while (not (eobp)) + (ignore-errors + (push (gnus-group-full-name + (buffer-substring + (point) + (progn + (skip-chars-forward "^ \t") + (point))) + method) + groups)) + (forward-line)) + (while (not (eobp)) + (ignore-errors + (push (if (eq (char-after) ?\") + (gnus-group-full-name (read cur) method) + (let ((p (point)) (name "")) + (skip-chars-forward "^ \t\\\\") + (setq name (buffer-substring p (point))) + (while (eq (char-after) ?\\) + (setq p (1+ (point))) + (forward-char 2) + (skip-chars-forward "^ \t\\\\") + (setq name (concat name (buffer-substring + p (point))))) + (gnus-group-full-name name method))) + groups)) + (forward-line))))) + groups)) + (defun gnus-finish-retrieve-group-infos (gnus-command-method infos data) "Read and update infos from GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index c46903a4584..168c994bae1 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -549,6 +549,7 @@ construct the vector entries." ;;; Search Engine Interfaces: +(autoload 'gnus-server-get-active "gnus-int") (autoload 'nnimap-change-group "nnimap") (declare-function nnimap-buffer "nnimap" ()) (declare-function nnimap-command "nnimap" (&rest args)) @@ -567,7 +568,8 @@ extensions." (cdr (assoc nnir-imap-default-search-key nnir-imap-search-arguments)))) (gnus-inhibit-demon t) - (groups (or groups (nnir-get-active srv)))) + (groups + (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) (message "Opening server %s" server) (apply 'vconcat @@ -1205,7 +1207,8 @@ construct path: search terms (see the variable (directory (cadr (assoc sym (cddr method)))) (regexp (cdr (assoc 'query query))) (grep-options (cdr (assoc 'grep-options query))) - (grouplist (or grouplist (nnir-get-active server)))) + (grouplist + (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups)))) (unless directory (error "No directory found in method specification of server %s" server)) @@ -1332,54 +1335,13 @@ environment unless NOT-GLOBAL is non-nil." ((and (not not-global) (boundp key)) (symbol-value key)) (t nil)))) -(autoload 'gnus-request-list "gnus-int") - -(defun nnir-get-active (srv) - "Return the active list for SRV." - (let ((method (gnus-server-to-method srv)) - groups) - (gnus-request-list method) - (with-current-buffer nntp-server-buffer - (let ((cur (current-buffer))) - (goto-char (point-min)) - (unless (or (null nnir-ignored-newsgroups) - (string= nnir-ignored-newsgroups "")) - (delete-matching-lines nnir-ignored-newsgroups)) - (if (eq (car method) 'nntp) - (while (not (eobp)) - (ignore-errors - (push (gnus-group-full-name - (buffer-substring - (point) - (progn - (skip-chars-forward "^ \t") - (point))) - method) - groups)) - (forward-line)) - (while (not (eobp)) - (ignore-errors - (push (if (eq (char-after) ?\") - (gnus-group-full-name (read cur) method) - (let ((p (point)) (name "")) - (skip-chars-forward "^ \t\\\\") - (setq name (buffer-substring p (point))) - (while (eq (char-after) ?\\) - (setq p (1+ (point))) - (forward-char 2) - (skip-chars-forward "^ \t\\\\") - (setq name (concat name (buffer-substring - p (point))))) - (gnus-group-full-name name method))) - groups)) - (forward-line))))) - groups)) - -(autoload 'nnselect-categorize "nnselect" nil nil) (autoload 'gnus-group-topic-name "gnus-topic" nil nil) (defvar gnus-group-marked) (defvar gnus-topic-alist) +(make-obsolete 'nnir-make-specs "This function should no longer +be used." "28.1") + (defun nnir-make-specs (nnir-extra-parms &optional specs) "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS. Query for the specs, or use SPECS." @@ -1387,12 +1349,12 @@ Query for the specs, or use SPECS." (or (cdr (assq 'nnir-group-spec specs)) (if (gnus-server-server-name) (list (list (gnus-server-server-name))) - (nnselect-categorize + (seq-group-by + (lambda (elt) (gnus-group-server elt)) (or gnus-group-marked (if (gnus-group-group-name) (list (gnus-group-group-name)) - (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))) - 'nnselect-group-server)))) + (cdr (assoc (gnus-group-topic-name) gnus-topic-alist)))))))) (query-spec (or (cdr (assq 'nnir-query-spec specs)) (apply @@ -1407,6 +1369,8 @@ Query for the specs, or use SPECS." (list (cons 'nnir-query-spec query-spec) (cons 'nnir-group-spec group-spec)))) +(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") + ;; The end. (provide 'nnir) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index b9769310eac..94dd93b354f 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -105,9 +105,7 @@ (gnus-uncompress-sequence artseq)) selection))) selection))) -(defun nnselect-group-server (group) - "Return the server for GROUP." - (gnus-group-server group)) +(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") ;; Data type article list.