From 4ae2ac594a7c2477e45e9f1ee71f790a871c8caf Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Wed, 11 Sep 2019 21:24:16 +0200 Subject: [PATCH] A list-files VC backend function / Use it in project-files * lisp/progmodes/project.el (project-vc-project-files-backends): New option. (project-files): An implementation for vc-handled projects. * lisp/vc/vc-bzr.el (vc-bzr-list-files): New function. * lisp/vc/vc-git.el (vc-git-list-files): New function. * lisp/vc/vc-hg.el (vc-hg-list-files): New function. * lisp/vc/vc-svn.el (vc-svn-list-files): New function. * lisp/vc/vc.el (vc-default-list-files): New function. --- lisp/progmodes/project.el | 33 ++++++++++++++++++++++++++++++++- lisp/vc/vc-bzr.el | 12 ++++++++++++ lisp/vc/vc-git.el | 9 +++++++++ lisp/vc/vc-hg.el | 12 ++++++++++++ lisp/vc/vc-svn.el | 14 +++++++++++++- lisp/vc/vc.el | 11 +++++++++++ 6 files changed, 89 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4693d07fa86..2fd4671e5bc 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -225,6 +225,26 @@ to find the list of ignores for each directory." :type '(repeat string) :safe 'listp) +(defcustom project-vc-project-files-backends '(Bzr Git Hg) + "List of vc backends which should be used by `project-files'. + +For projects using a backend in this list, `project-files' will +query the version control system for all tracked files instead of +using the \"find\" command. + +Note that this imposes some differences in semantics: + +- The vc backends list tracked files whereas \"find\" lists + existing files. + +- The performance differs vastly. The Git backend list files + very fast (and generally faster than \"find\") while the SVN + backend does so by querying the remote subversion server, i.e., + it requires a network connection and is slow." + :type `(set ,@(mapcar (lambda (b) `(const :tag ,(format "%s" b) ,b)) + vc-handled-backends)) + :version "27.1") + ;; FIXME: Using the current approach, major modes are supposed to set ;; this variable to a buffer-local value. So we don't have access to ;; the "external roots" of language A from buffers of language B, which @@ -277,9 +297,20 @@ backend implementation of `project-external-roots'.") (funcall project-vc-external-roots-function))) (project-roots project))) +(cl-defmethod project-files ((project (head vc)) &optional dirs) + "Implementation of `project-files' for version controlled projects." + (cl-mapcan + (lambda (dir) + (let ((backend (ignore-errors (vc-responsible-backend dir)))) + (if (and backend + (memq backend project-vc-project-files-backends)) + (vc-call-backend backend 'list-files dir) + (cl-call-next-method)))) + (or dirs (project-roots project)))) + (cl-defmethod project-ignores ((project (head vc)) dir) (let* ((root (cdr project)) - backend) + backend) (append (when (file-equal-p dir root) (setq backend (vc-responsible-backend root)) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 89f1fcce376..905651f2a0f 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1315,6 +1315,18 @@ stream. Standard error output is discarded." vc-bzr-revision-keywords)) string pred))))) +(defun vc-bzr-list-files (&optional dir _args) + (let ((default-directory (or dir default-directory))) + (mapcar + #'expand-file-name + (cl-remove-if #'string-empty-p + (split-string + (with-output-to-string + (with-current-buffer standard-output + (vc-bzr-command "ls" t 0 "." + "--null"))) + "\0"))))) + (provide 'vc-bzr) ;;; vc-bzr.el ends here diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 9715aea1fdc..b089a977470 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1706,6 +1706,15 @@ Returns nil if not possible." (1- (point-max))))))) (and name (not (string= name "undefined")) name)))) +(defun vc-git-list-files (&optional dir _args) + (let ((default-directory (or dir default-directory))) + (mapcar + #'expand-file-name + (cl-remove-if #'string-empty-p + (split-string + (vc-git--run-command-string nil "ls-files" "-z") + "\0"))))) + (provide 'vc-git) ;;; vc-git.el ends here diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c2a5a6f70c6..4e153bd92fb 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1457,6 +1457,18 @@ This function differs from vc-do-command in that it invokes (defun vc-hg-root (file) (vc-find-root file ".hg")) +(defun vc-hg-list-files (&optional dir _args) + (let ((default-directory (or dir default-directory))) + (mapcar + #'expand-file-name + (cl-remove-if #'string-empty-p + (split-string + (with-output-to-string + (with-current-buffer standard-output + (vc-hg-command t 0 "." + "files" "--print0"))) + "\0"))))) + (provide 'vc-hg) ;;; vc-hg.el ends here diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 3c50c8fff64..94d1fcc0364 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -807,7 +807,19 @@ Set file properties accordingly. If FILENAME is non-nil, return its status." (push (match-string 1 loglines) vc-svn-revisions) (setq start (+ start (match-end 0))) (setq loglines (buffer-substring-no-properties start (point-max))))) - vc-svn-revisions))) + vc-svn-revisions))) + +(defun vc-svn-list-files (&optional dir _args) + (let ((default-directory (or dir default-directory))) + (mapcar + #'expand-file-name + (cl-remove-if #'string-empty-p + (split-string + (with-output-to-string + (with-current-buffer standard-output + (vc-svn-command t 0 "." + "list" "--recursive"))) + "\n"))))) (provide 'vc-svn) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4cac1539289..047b8ee465f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3106,6 +3106,17 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it." (vc-file-tree-walk-internal dirf func args))))) (directory-files dir))))) + + +(defun vc-default-list-files (_backend &optional dir _args) + (let* ((default-directory (or dir default-directory)) + (inhibit-message t) + files) + (vc-file-tree-walk default-directory + (lambda (f) + (setq files (cons f files)))) + files)) + (provide 'vc) ;;; vc.el ends here -- 2.39.5