Rework gnus-search-indexed-parse-output

* lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output): Be more
careful about matching filesystem paths to Gnus group names; make
absolutely sure that we only return valid article numbers.

1 files changed, 43 insertions, 52 deletions

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 70bde264c11..898b57bcef8 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1351,68 +1351,59 @@ Returns a list of [group article score] vectors."
 
 (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
                                                 server query &optional groups)
-  (let ((prefix (slot-value engine 'remove-prefix))
-        (group-regexp (when groups
-                        (mapconcat
-                         (lambda (group-name)
-                           (mapconcat #'regexp-quote
-                                      (split-string
-                                       (gnus-group-real-name group-name)
-                                       "[.\\/]")
-                                      "[.\\\\/]"))
-                         groups
-                         "\\|")))
-        artlist vectors article group)
+  (let ((prefix (or (slot-value engine 'remove-prefix)
+                    ""))
+        artlist article group)
     (goto-char (point-min))
+    ;; Prep prefix, we want to at least be removing the root
+    ;; filesystem separator.
+    (when (stringp prefix)
+      (setq prefix (file-name-as-directory
+                    (expand-file-name prefix "/"))))
     (while (not (or (eobp)
                     (looking-at-p
                      "\\(?:[[:space:]\n]+\\)?Process .+ finished")))
       (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
         (when (and f-name
                    (file-readable-p f-name)
-                   (null (file-directory-p f-name))
-                   (or (null groups)
-                       (and (gnus-search-single-p query)
-                            (alist-get 'thread query))
-                       (string-match-p group-regexp f-name)))
-          (push (list f-name score) artlist))))
+                   (null (file-directory-p f-name)))
+          (setq group
+                (replace-regexp-in-string
+                 "[/\\]" "."
+                 (replace-regexp-in-string
+                  "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+                  (replace-regexp-in-string
+                   "\\`\\." ""
+                   (string-remove-prefix
+                    prefix (file-name-directory f-name))
+                   nil t)
+                  nil t)
+                 nil t))
+          (setq group (gnus-group-full-name group server))
+          (setq article (file-name-nondirectory f-name)
+                article
+                ;; TODO: Provide a cleaner way of producing final
+                ;; article numbers for the various backends.
+                (if (string-match-p "\\`[[:digit:]]+\\'" article)
+                    (string-to-number article)
+                  (nnmaildir-base-name-to-article-number
+                   (substring article 0 (string-match ":" article))
+                   group (string-remove-prefix "nnmaildir:" server))))
+          (when (and (numberp article)
+                     (or (null groups)
+                         (member group groups)))
+            (push (list f-name article group score)
+                  artlist)))))
     ;; Are we running an additional grep query?
     (when-let ((grep-reg (alist-get 'grep query)))
       (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
-    ;; Prep prefix.
-    (when (and prefix (null (string-empty-p prefix)))
-      (setq prefix (file-name-as-directory (expand-file-name prefix))))
-    ;; Turn (file-name score) into [group article score].
-    (pcase-dolist (`(,f-name ,score) artlist)
-      (setq article (file-name-nondirectory f-name)
-            group (file-name-directory f-name))
-      ;; Remove prefix.
-      (when prefix
-        (setq group (string-remove-prefix prefix group)))
-      ;; Break the directory name down until it's something that
-      ;; (probably) can be used as a group name.
-      (setq group
-            (replace-regexp-in-string
-             "[/\\]" "."
-             (replace-regexp-in-string
-              "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
-              (replace-regexp-in-string
-               "^[./\\]" ""
-               group nil t)
-              nil t)
-             nil t))
-
-      (push (vector (gnus-group-full-name group server)
-                    (if (string-match-p "\\`[[:digit:]]+\\'" article)
-                        (string-to-number article)
-                      (nnmaildir-base-name-to-article-number
-                       (substring article 0 (string-match ":" article))
-                       group (string-remove-prefix "nnmaildir:" server)))
-                    (if (numberp score)
-                        score
-                      (string-to-number score)))
-            vectors))
-    vectors))
+    ;; Munge into the list of vectors expected by nnselect.
+    (mapcar (pcase-lambda (`(,_ ,article ,group ,score))
+              (vector group article
+                      (if (numberp score)
+                          score
+                        (string-to-number score))))
+            artlist)))
 
 (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
   "Base implementation treats the whole line as a filename, and