[Emacs-diffs] scratch/tsdh-vc-list-files 4ae2ac5: A list-files VC backend function / Use it in project-files

[Tassilo Horn]

branch: scratch/tsdh-vc-list-files
commit 4ae2ac594a7c2477e45e9f1ee71f790a871c8caf
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>

    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 4693d07..2fd4671 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 89f1fcc..905651f 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 9715aea..b089a97 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 c2a5a6f..4e153bd 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 3c50c8f..94d1fcc 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 4cac153..047b8ee 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