summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJim Porter <jporterbugs@gmail.com>2022-06-24 08:39:42 -0700
committerLars Ingebrigtsen <larsi@gnus.org>2022-06-26 16:52:36 +0200
commitea3681575f24ab6766931d0c86f080c52f2ce2d7 (patch)
treeb34466ad22ff94bd3a26aa0d9e98e43b78393d67
parent598d7c5d1c10bfb161cb53aa76d480864414487c (diff)
downloademacs-ea3681575f24ab6766931d0c86f080c52f2ce2d7.tar.gz
Convert Eshell globs ahead of time instead of doing it repeatedly
* lisp/eshell/em-glob.el (eshell-glob-recursive): New variable. (eshell-glob-convert-1, eshell-glob-convert): New functions. (eshell-extended-glob): Use 'eshell-glob-convert'. (eshell-glob-entries): Adapt function to use pre-converted globs. * test/lisp/eshell-em-glob-tests.el (em-glob-test/match-dot-files): New test.
-rw-r--r--lisp/eshell/em-glob.el204
-rw-r--r--test/lisp/eshell/em-glob-tests.el15
2 files changed, 129 insertions, 90 deletions
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 52531ff8939..8acdaee2331 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -183,6 +183,10 @@ interpretation."
(defvar eshell-glob-matches)
(defvar message-shown)
+(defvar eshell-glob-recursive-alist
+ '(("**/" . recurse)
+ ("***/" . recurse-symlink)))
+
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:
@@ -232,6 +236,74 @@ resulting regular expression."
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
+(defun eshell-glob-convert-1 (glob &optional last)
+ "Convert a GLOB matching a single element of a file name to regexps.
+If LAST is non-nil, this glob is the last element of a file name.
+
+The result is a pair of regexps, the first for file names to
+include, and the second for ones to exclude."
+ (let ((len (length glob)) (index 1) (incl glob) excl)
+ ;; We can't use `directory-file-name' because it strips away text
+ ;; properties in the string.
+ (let ((last (1- (length incl))))
+ (when (eq (aref incl last) ?/)
+ (setq incl (substring incl 0 last))))
+ ;; Split the glob if it contains a negation like x~y.
+ (while (and (eq incl glob)
+ (setq index (string-search "~" glob index)))
+ (if (or (get-text-property index 'escaped glob)
+ (or (= (1+ index) len)))
+ (setq index (1+ index))
+ (setq incl (substring glob 0 index)
+ excl (substring glob (1+ index)))))
+ (setq incl (eshell-glob-regexp incl)
+ excl (and excl (eshell-glob-regexp excl)))
+ ;; Exclude dot files if requested.
+ (if (or eshell-glob-include-dot-files
+ (eq (aref glob 0) ?.))
+ (unless (or eshell-glob-include-dot-dot
+ (not last))
+ (setq excl (if excl
+ (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
+ "\\`\\.\\.?\\'")))
+ (setq excl (if excl
+ (concat "\\(\\`\\.\\|" excl "\\)")
+ "\\`\\.")))
+ (cons incl excl)))
+
+(defun eshell-glob-convert (glob)
+ "Convert an Eshell glob-pattern GLOB to regexps.
+The result is a list, where the first element is the base
+directory to search in, and the second is a list containing
+elements of the following forms:
+
+* Regexp pairs as generated by `eshell-glob-convert-1'.
+
+* `recurse', indicating that searches should recurse into
+ subdirectories.
+
+* `recurse-symlink', like `recurse', but also following symlinks."
+ (let ((globs (eshell-split-path glob))
+ start-dir result last-saw-recursion)
+ (if (and (cdr globs)
+ (file-name-absolute-p (car globs)))
+ (setq start-dir (car globs)
+ globs (cdr globs))
+ (setq start-dir "."))
+ (while globs
+ (if-let ((recurse (cdr (assoc (car globs)
+ eshell-glob-recursive-alist))))
+ (if last-saw-recursion
+ (setcar result recurse)
+ (push recurse result)
+ (setq last-saw-recursion t))
+ (push (eshell-glob-convert-1 (car globs) (null (cdr globs)))
+ result)
+ (setq last-saw-recursion nil))
+ (setq globs (cdr globs)))
+ (list (file-name-as-directory start-dir)
+ (nreverse result))))
+
(defun eshell-extended-glob (glob)
"Return a list of files matched by GLOB.
If no files match, signal an error (if `eshell-error-if-no-glob'
@@ -247,14 +319,10 @@ syntax. Things that are not supported are:
Mainly they are not supported because file matching is done with Emacs
regular expressions, and these cannot support the above constructs."
- (let ((paths (eshell-split-path glob))
+ (let ((globs (eshell-glob-convert glob))
eshell-glob-matches message-shown)
(unwind-protect
- (if (and (cdr paths)
- (file-name-absolute-p (car paths)))
- (eshell-glob-entries (file-name-as-directory (car paths))
- (cdr paths))
- (eshell-glob-entries (file-name-as-directory ".") paths))
+ (apply #'eshell-glob-entries globs)
(if message-shown
(message nil)))
(or (and eshell-glob-matches (sort eshell-glob-matches #'string<))
@@ -263,94 +331,50 @@ regular expressions, and these cannot support the above constructs."
glob))))
;; FIXME does this really need to abuse eshell-glob-matches, message-shown?
-(defun eshell-glob-entries (path globs &optional recurse-p)
- "Glob the entries in PATH, possibly recursing if RECURSE-P is non-nil."
+(defun eshell-glob-entries (path globs)
+ "Match the entries in PATH against GLOBS.
+GLOBS is a list of globs as converted by `eshell-glob-convert',
+which see."
(let* ((entries (ignore-errors
- (file-name-all-completions "" path)))
- (case-fold-search eshell-glob-case-insensitive)
- (glob (car globs))
- (len (length glob))
- dirs rdirs
- incl excl
- name isdir pathname)
- (while (cond
- ((and (= len 3) (equal glob "**/"))
- (setq recurse-p 2
- globs (cdr globs)
- glob (car globs)
- len (length glob)))
- ((and (= len 4) (equal glob "***/"))
- (setq recurse-p 3
- globs (cdr globs)
- glob (car globs)
- len (length glob)))))
- (if (and recurse-p (not glob))
- (error "`**/' cannot end a globbing pattern"))
- (let ((index 1))
- (setq incl glob)
- (while (and (eq incl glob)
- (setq index (string-search "~" glob index)))
- (if (or (get-text-property index 'escaped glob)
- (or (= (1+ index) len)))
- (setq index (1+ index))
- (setq incl (substring glob 0 index)
- excl (substring glob (1+ index))))))
- ;; can't use `directory-file-name' because it strips away text
- ;; properties in the string
- (let ((len (1- (length incl))))
- (if (eq (aref incl len) ?/)
- (setq incl (substring incl 0 len)))
- (when excl
- (setq len (1- (length excl)))
- (if (eq (aref excl len) ?/)
- (setq excl (substring excl 0 len)))))
- (setq incl (eshell-glob-regexp incl)
- excl (and excl (eshell-glob-regexp excl)))
- (if (or eshell-glob-include-dot-files
- (eq (aref glob 0) ?.))
- (unless (or eshell-glob-include-dot-dot
- (cdr globs))
- (setq excl (if excl
- (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
- "\\`\\.\\.?\\'")))
- (setq excl (if excl
- (concat "\\(\\`\\.\\|" excl "\\)")
- "\\`\\.")))
+ (file-name-all-completions "" path)))
+ (case-fold-search eshell-glob-case-insensitive)
+ glob glob-remainder recurse-p)
+ (if (rassq (car globs) eshell-glob-recursive-alist)
+ (setq recurse-p (car globs)
+ glob (cadr globs)
+ glob-remainder (cddr globs))
+ (setq glob (car globs)
+ glob-remainder (cdr globs)))
(when (and recurse-p eshell-glob-show-progress)
(message "Building file list...%d so far: %s"
- (length eshell-glob-matches) path)
+ (length eshell-glob-matches) path)
(setq message-shown t))
- (if (equal path "./") (setq path ""))
- (while entries
- (setq name (car entries)
- len (length name)
- isdir (eq (aref name (1- len)) ?/))
- (if (let ((fname (directory-file-name name)))
- (and (not (and excl (string-match excl fname)))
- (string-match incl fname)))
- (if (cdr globs)
- (if isdir
- (setq dirs (cons (concat path name) dirs)))
- (setq eshell-glob-matches
- (cons (concat path name) eshell-glob-matches))))
- (if (and recurse-p isdir
- (or (> len 3)
- (not (or (and (= len 2) (equal name "./"))
- (and (= len 3) (equal name "../")))))
- (setq pathname (concat path name))
- (not (and (= recurse-p 2)
- (file-symlink-p
- (directory-file-name pathname)))))
- (setq rdirs (cons pathname rdirs)))
- (setq entries (cdr entries)))
- (setq dirs (nreverse dirs)
- rdirs (nreverse rdirs))
- (while dirs
- (eshell-glob-entries (car dirs) (cdr globs))
- (setq dirs (cdr dirs)))
- (while rdirs
- (eshell-glob-entries (car rdirs) globs recurse-p)
- (setq rdirs (cdr rdirs)))))
+ (when (equal path "./") (setq path ""))
+ (let ((incl (car glob))
+ (excl (cdr glob))
+ dirs rdirs)
+ (dolist (name entries)
+ (let* ((len (length name))
+ (isdir (eq (aref name (1- len)) ?/))
+ pathname)
+ (when (let ((fname (directory-file-name name)))
+ (and (not (and excl (string-match excl fname)))
+ (string-match incl fname)))
+ (if glob-remainder
+ (when isdir
+ (push (concat path name) dirs))
+ (push (concat path name) eshell-glob-matches)))
+ (when (and recurse-p isdir
+ (not (member name '("./" "../")))
+ (setq pathname (concat path name))
+ (not (and (eq recurse-p 'recurse)
+ (file-symlink-p
+ (directory-file-name pathname)))))
+ (push pathname rdirs))))
+ (dolist (dir (nreverse dirs))
+ (eshell-glob-entries dir glob-remainder))
+ (dolist (rdir (nreverse rdirs))
+ (eshell-glob-entries rdir globs)))))
(provide 'em-glob)
diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el
index 9976b32ffe7..65f340a8dad 100644
--- a/test/lisp/eshell/em-glob-tests.el
+++ b/test/lisp/eshell/em-glob-tests.el
@@ -160,6 +160,21 @@ component ending in \"symlink\" is treated as a symbolic link."
(should (equal (eshell-extended-glob "[[:digit:]]##~4?")
'("1" "12" "123")))))
+(ert-deftest em-glob-test/match-dot-files ()
+ "Test that dot files are matched correctly."
+ (with-fake-files '("foo.el" ".emacs")
+ (should (equal (eshell-extended-glob ".*")
+ '("../" "./" ".emacs")))
+ (let (eshell-glob-include-dot-dot)
+ (should (equal (eshell-extended-glob ".*")
+ '(".emacs"))))
+ (let ((eshell-glob-include-dot-files t))
+ (should (equal (eshell-extended-glob "*")
+ '("../" "./" ".emacs" "foo.el")))
+ (let (eshell-glob-include-dot-dot)
+ (should (equal (eshell-extended-glob "*")
+ '(".emacs" "foo.el")))))))
+
(ert-deftest em-glob-test/no-matches ()
"Test behavior when a glob fails to match any files."
(with-fake-files '("foo.el" "bar.el")