master ea3681575f 1/2: Convert Eshell globs ahead of time instead of doing it repeatedly

[Lars Ingebrigtsen]

branch: master
commit ea3681575f24ab6766931d0c86f080c52f2ce2d7
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 lisp/eshell/em-glob.el            | 204 +++++++++++++++++++++-----------------
 test/lisp/eshell/em-glob-tests.el |  15 +++
 2 files changed, 129 insertions(+), 90 deletions(-)

diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 52531ff893..8acdaee233 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 9976b32ffe..65f340a8da 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")