diff options
author | Dmitry Gutov <dgutov@yandex.ru> | 2015-12-08 03:40:37 +0200 |
---|---|---|
committer | Dmitry Gutov <dgutov@yandex.ru> | 2015-12-08 03:40:37 +0200 |
commit | 5edb06e1e6aa09e0a997fff73dd914bc3f723630 (patch) | |
tree | 667e99d2e02257bc158fe3cf8a7d4f23c50eaec1 | |
parent | 87f5f31ee43bcf773da5ea765ecdf1a499fd8920 (diff) | |
download | emacs-scratch/project-directories-with-shallow.tar.gz |
Add method project-directory-shallow-pscratch/project-directories-with-shallow
-rw-r--r-- | lisp/progmodes/project.el | 33 | ||||
-rw-r--r-- | lisp/progmodes/xref.el | 22 |
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 |