Add method project-directory-shallow-pscratch/project-directories-with-shallow

2 files changed, 40 insertions, 15 deletions

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 5394e8afadd..a1b9374dae5 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -100,6 +100,13 @@ end it with `/'.  DIR must be one of `project-directories' or
     vc-directory-exclusion-list)
    grep-find-ignored-files))
 
+(cl-defgeneric project-directory-shallow-p (_project _dir)
+  "Return non-nil if DIR's subdirectories should be skipped.
+
+If this method returns nil, a consumer should traverse DIR's
+contents recursively when listing or searching through files."
+  nil)
+
 (defgroup project-vc nil
   "Project implementation using the VC package."
   :group 'tools)
@@ -174,16 +181,22 @@ implementation of `project-library-roots'.")
 
 (defun project-directories-in-categories (project &rest categories)
   (project-combine-directories
+   project
    (cl-delete-if
     (lambda (dir)
       (cl-set-difference categories (project-directory-categories project dir)))
     (project-directories project))))
 
-(defun project-combine-directories (dirs)
+(defun project-combine-directories (project dirs)
   "Return a sorted and culled list of directory names in PROJECT.
 It takes DIRS, removes non-existing directories, as well as
-directories a parent of whose is already in the list."
-  (let* ((dirs (sort
+directories a parent of whose is already in the list (if the
+parent is not shallow)."
+  (let* ((deep-dirs (cl-delete-if
+                     (lambda (dir)
+                       (project-directory-shallow-p project dir))
+                     dirs))
+         (dirs (sort
                 (mapcar
                  (lambda (dir)
                    (file-name-as-directory (expand-file-name dir)))
@@ -192,16 +205,21 @@ directories a parent of whose is already in the list."
          (ref dirs))
     ;; Delete subdirectories from the list.
     (while (cdr ref)
-      (if (string-prefix-p (car ref) (cadr ref))
+      (if (and (string-prefix-p (car ref) (cadr ref))
+               (member (car ref) deep-dirs))
           (setcdr ref (cddr ref))
         (setq ref (cdr ref))))
     (cl-delete-if-not #'file-exists-p dirs)))
 
-(defun project-subtract-directories (files dirs)
+(defun project-subtract-directories (project files dirs)
   "Return a list of elements from FILES that are outside of DIRS.
 DIRS must contain directory names."
   ;; Sidestep the issue of expanded/abbreviated file names here.
-  (cl-set-difference files dirs :test #'file-in-directory-p))
+  (cl-set-difference files dirs
+                     :test
+                     (lambda (file dir)
+                       (and (file-in-directory-p file dir)
+                            (not (project-directory-shallow-p project dir))))))
 
 (defun project--value-in-dir (var dir)
   (with-temp-buffer
@@ -249,7 +267,8 @@ pattern to search for."
          (xrefs (cl-mapcan
                  (lambda (dir)
                    (xref-collect-matches regexp files dir
-                                         (project-ignores project dir)))
+                                         (project-ignores project dir)
+                                         (project-directory-shallow-p project dir)))
                  dirs)))
     (unless xrefs
       (user-error "No matches for: %s" regexp))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b86074f99c0..bc6303b6ee6 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -240,10 +240,12 @@ be found, return nil.
 The default implementation uses `semantic-symref-tool-alist' to
 find a search tool; by default, this uses \"find | grep\" in the
 `project-current' roots."
-  (cl-mapcan
-   (lambda (dir)
-     (xref-collect-references identifier dir))
-   (project-directories-in-categories (project-current t))))
+  (let ((project (project-current t)))
+    (cl-mapcan
+     (lambda (dir)
+       (xref-collect-references identifier dir
+                                (project-directory-shallow-p project dir)))
+     (project-directories-in-categories project))))
 
 (cl-defgeneric xref-backend-apropos (backend pattern)
   "Find all symbols that match PATTERN.
@@ -833,11 +835,13 @@ and just use etags."
 (declare-function semantic-find-file-noselect "semantic/fw")
 (declare-function grep-expand-template "grep")
 
-(defun xref-collect-references (symbol dir)
+(defun xref-collect-references (symbol dir &optional shallow)
   "Collect references to SYMBOL inside DIR.
 This function uses the Semantic Symbol Reference API, see
 `semantic-symref-find-references-by-name' for details on which
 tools are used, and when."
+  ;; FIXME: Apparently we'll have to support SHALLOW inside
+  ;; semantic-symref tools now.
   (cl-assert (directory-name-p dir))
   (require 'semantic/symref)
   (defvar semantic-symref-tool)
@@ -855,7 +859,7 @@ tools are used, and when."
       (mapc #'kill-buffer
             (cl-set-difference (buffer-list) orig-buffers)))))
 
-(defun xref-collect-matches (regexp files dir ignores)
+(defun xref-collect-matches (regexp files dir ignores &optional shallow)
   "Collect matches for REGEXP inside FILES in DIR.
 FILES is a string with glob patterns separated by spaces.
 IGNORES is a list of glob patterns."
@@ -868,7 +872,7 @@ IGNORES is a list of glob patterns."
                                                        grep-find-template t t))
          (grep-highlight-matches nil)
          (command (xref--rgrep-command (xref--regexp-to-extended regexp)
-                                       files dir ignores))
+                                       files dir ignores shallow))
          (orig-buffers (buffer-list))
          (buf (get-buffer-create " *xref-grep*"))
          (grep-re (caar grep-regexp-alist))
@@ -888,7 +892,7 @@ IGNORES is a list of glob patterns."
       (mapc #'kill-buffer
             (cl-set-difference (buffer-list) orig-buffers)))))
 
-(defun xref--rgrep-command (regexp files dir ignores)
+(defun xref--rgrep-command (regexp files dir ignores shallow)
   (require 'find-dired)      ; for `find-name-arg'
   (defvar grep-find-template)
   (defvar find-name-arg)
@@ -905,6 +909,8 @@ IGNORES is a list of glob patterns."
            (shell-quote-argument ")"))
    dir
    (concat
+    (when shallow
+      " -maxdepth 1 ")
     (shell-quote-argument "(")
     " -path "
     (mapconcat