[Emacs-diffs] scratch/tsdh-vc-list-files 8992bc7 1/2: ; more on vc list-files

[Tassilo Horn]

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

    ; more on vc list-files
---
 lisp/progmodes/project.el |  5 +++--
 lisp/vc/vc-git.el         | 25 +++++++++++++++++++------
 lisp/vc/vc-hg.el          | 33 ++++++++++++++++++++++-----------
 lisp/vc/vc.el             | 27 +++++++++++++++++++++++----
 4 files changed, 67 insertions(+), 23 deletions(-)

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index dab2683..b1ba00e 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -225,7 +225,7 @@ to find the list of ignores for each directory."
   :type '(repeat string)
   :safe 'listp)
 
-(defcustom project-vc-project-files-backends '(Bzr Git Hg SVN)
+(defcustom project-vc-project-files-backends '(Git Hg)
   "List of vc backends which should be used by `project-files'.
 
 For projects using a backend in this list, `project-files' will
@@ -302,7 +302,8 @@ backend implementation of `project-external-roots'.")
      (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)
+           (vc-call-backend backend 'list-files
+                            dir t project-vc-ignores)
          (cl-call-next-method))))
    (or dirs (project-roots project))))
 
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index abb5012..f8c5fd9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1709,14 +1709,27 @@ Returns nil if not possible."
 
 (declare-function cl-remove-if "cl-seq")
 
-(defun vc-git-list-files (&optional dir)
-  (let ((default-directory (or dir default-directory)))
+(defun vc-git-list-files (&optional dir
+                                    include-unregistered
+                                    extra-ignores)
+  (let ((default-directory (or dir default-directory))
+        (args '("-z")))
+    (when include-unregistered
+      (setq args (append args '("-c" "-o" "--exclude-standard"))))
+    (when extra-ignores
+      (setq args (append args
+                         (cons "--"
+                               (mapcar
+                                (lambda (i)
+                                  (format ":!:%s" i))
+                                extra-ignores)))))
     (mapcar
      #'expand-file-name
-     (cl-remove-if #'string-empty-p
-                   (split-string
-                    (vc-git--run-command-string nil "ls-files" "-z")
-                    "\0")))))
+     (cl-remove-if
+      #'string-empty-p
+      (split-string
+       (apply #'vc-git--run-command-string nil "ls-files" args)
+       "\0")))))
 
 (provide 'vc-git)
 
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 5b3493d..a9b6485 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1458,17 +1458,28 @@ 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)
-  (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")))))
+(defun vc-hg-list-files (&optional dir
+                                   include-unregistered
+                                   extra-ignores)
+  (let ((default-directory (or dir default-directory))
+        args
+        files)
+    (when include-unregistered
+      (setq args (nconc args '("--all"))))
+    (when extra-ignores
+      (setq args (nconc args
+                        (mapcan
+                         (lambda (i)
+                           (list "--exclude" i))
+                         (copy-list extra-ignores)))))
+    (with-temp-buffer
+      (apply #'vc-hg-command t 0 "."
+             "status" args)
+      (goto-char (point-min))
+      (while (re-search-forward "^[?C]\s+\\(.*\\)$" nil t)
+        (setq files (cons (expand-file-name (match-string 1))
+                          files))))
+    (nreverse files)))
 
 (provide 'vc-hg)
 
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index c8b0488..90899d2 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3108,13 +3108,32 @@ Invoke FUNC f ARGS on each VC-managed file f underneath 
it."
 
 
 
-(defun vc-default-list-files (_backend &optional dir)
+(defun vc--glob-pattern-to-regex (glob)
+  (replace-regexp-in-string
+   "\\?" "."
+   (replace-regexp-in-string
+    "\\*" ".*"
+    (replace-regexp-in-string "\\." "\\\\." glob))))
+
+(defun vc--any-string-match-p (str regexes)
+  (catch 'match
+    (dolist (regex regexes)
+      (when (string-match-p regex str)
+        (throw 'match t)))))
+
+(defun vc-default-list-files (_backend &optional dir
+                                       _include-unregistered
+                                       extra-ignores)
+  ;; FIXME: We collect only tracked files and ignore
+  ;; include-unregistered.
   (let* ((default-directory (or dir default-directory))
          (inhibit-message t)
          files)
-    (vc-file-tree-walk default-directory
-                       (lambda (f)
-                         (setq files (cons f files))))
+    (vc-file-tree-walk
+     default-directory
+     (lambda (f)
+       (unless (vc--any-string-match-p f extra-ignores)
+         (setq files (cons f files)))))
     files))
 
 (provide 'vc)