Commit e7f6bb38 authored by Eric Abrahamsen's avatar Eric Abrahamsen
Browse files

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.
parent 0897ade8
...@@ -1351,68 +1351,59 @@ Returns a list of [group article score] vectors." ...@@ -1351,68 +1351,59 @@ Returns a list of [group article score] vectors."
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed) (cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
server query &optional groups) server query &optional groups)
(let ((prefix (slot-value engine 'remove-prefix)) (let ((prefix (or (slot-value engine 'remove-prefix)
(group-regexp (when groups ""))
(mapconcat artlist article group)
(lambda (group-name)
(mapconcat #'regexp-quote
(split-string
(gnus-group-real-name group-name)
"[.\\/]")
"[.\\\\/]"))
groups
"\\|")))
artlist vectors article group)
(goto-char (point-min)) (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) (while (not (or (eobp)
(looking-at-p (looking-at-p
"\\(?:[[:space:]\n]+\\)?Process .+ finished"))) "\\(?:[[:space:]\n]+\\)?Process .+ finished")))
(pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine))) (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
(when (and f-name (when (and f-name
(file-readable-p f-name) (file-readable-p f-name)
(null (file-directory-p f-name)) (null (file-directory-p f-name)))
(or (null groups) (setq group
(and (gnus-search-single-p query) (replace-regexp-in-string
(alist-get 'thread query)) "[/\\]" "."
(string-match-p group-regexp f-name))) (replace-regexp-in-string
(push (list f-name score) artlist)))) "/?\\(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? ;; Are we running an additional grep query?
(when-let ((grep-reg (alist-get 'grep query))) (when-let ((grep-reg (alist-get 'grep query)))
(setq artlist (gnus-search-grep-search engine artlist grep-reg))) (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
;; Prep prefix. ;; Munge into the list of vectors expected by nnselect.
(when (and prefix (null (string-empty-p prefix))) (mapcar (pcase-lambda (`(,_ ,article ,group ,score))
(setq prefix (file-name-as-directory (expand-file-name prefix)))) (vector group article
;; Turn (file-name score) into [group article score]. (if (numberp score)
(pcase-dolist (`(,f-name ,score) artlist) score
(setq article (file-name-nondirectory f-name) (string-to-number score))))
group (file-name-directory f-name)) artlist)))
;; 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))
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed)) (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
"Base implementation treats the whole line as a filename, and "Base implementation treats the whole line as a filename, and
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment