master 206cff8: Clean up group-finding in Gnus nnir search

[Andrew G Cohen]

branch: master
commit 206cff84bda2a7dd204a0da19e29abf389643f6b
Author: Andrew G Cohen <cohen@andy.bu.edu>
Commit: Andrew G Cohen <cohen@andy.bu.edu>

    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.
---
 lisp/gnus/gnus-group.el | 110 +++++++++++++++++++++++++++++++++++++-----------
 lisp/gnus/gnus-int.el   |  42 ++++++++++++++++++
 lisp/gnus/nnir.el       |  62 ++++++---------------------
 lisp/gnus/nnselect.el   |   4 +-
 4 files changed, 141 insertions(+), 77 deletions(-)

diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index fcaa6d7..1d614f8 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 da385a1..b8be766 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 c46903a..168c994 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 b976931..94dd93b 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.