master e7f6bb3 1/2: Rework gnus-search-indexed-parse-output

[Eric Abrahamsen]

branch: master
commit e7f6bb38ddb71bfe08bdca87119ff13cd40ecf62
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    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.
---
 lisp/gnus/gnus-search.el | 95 ++++++++++++++++++++++--------------------------
 1 file changed, 43 insertions(+), 52 deletions(-)

diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 70bde26..898b57b 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