mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Small fixes to gnus-search output parsing of indexed engines

Browse source 
* lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output): When
filtering for desired groups, accept any of [.\/] as potential segment
delimiters. Later on, filesystem path separators will be interpreted
as dots (".") when constructing group names. Also, make sure we use
`expand-file-name' on the prefix, and just use `string-remove-prefix'
to get rid of it.
This commit is contained in:
Eric Abrahamsen 2020-11-19 16:32:41 -08:00
parent edd949a3eb
commit 8b7fa9e663
1 changed files with 14 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
lisp/gnus/gnus-search.el
View file

@ -1365,10 +1365,13 @@ Returns a list of [group article score] vectors."
server query &optional groups)
(let ((prefix (slot-value engine 'remove-prefix))
(group-regexp (when groups
(regexp-opt
(mapcar
(lambda (x) (gnus-group-real-name x))
groups))))
(mapconcat
(lambda (x)
(replace-regexp-in-string
;; Accept any of [.\/] as path separators.
"[.\\/]" "[.\\\\/]"
(gnus-group-real-name x)))
groups "\\|")))
artlist vectors article group)
(goto-char (point-min))
(while (not (eobp))
@ -1383,16 +1386,16 @@ Returns a list of [group article score] vectors."
;; 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))
(setq article (file-name-nondirectory f-name)
group (file-name-directory f-name))
;; Remove prefix.
(when (and prefix
(file-name-absolute-p prefix)
(string-match (concat "^"
(file-name-as-directory prefix))
f-name))
(setq group (replace-match "" t t (file-name-directory f-name))))
(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