[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: A project-files implementation for Git projects
From: |
Tassilo Horn |
Subject: |
Re: A project-files implementation for Git projects |
Date: |
Wed, 11 Sep 2019 22:01:38 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) |
Hi again,
here is a working solution for a VC list-files function. I've added
implementations for Git, Hg, Bzr, and SVN plus a default implementation
which probably does the right thing for all other handled VC backends.
I guess Monotone also has the ability to quickly list all tracked files
but I haven't been able to install it.
The default implementation is quite slow and so is the SVN version which
fetches the file listing from the remote SVN server.
I also added a vc `project-files' implementation which uses the VC
list-files feature for backends in a new list-valued defcustom
`project-vc-project-files-backends'.
Comments welcome!
--8<---------------cut here---------------start------------->8---
6 files changed, 102 insertions(+), 3 deletions(-)
lisp/progmodes/project.el | 33 ++++++++++++++++++++++++++++++++-
lisp/vc/vc-bzr.el | 16 ++++++++++++++++
lisp/vc/vc-git.el | 14 +++++++++++++-
lisp/vc/vc-hg.el | 13 +++++++++++++
lisp/vc/vc-svn.el | 18 +++++++++++++++++-
lisp/vc/vc.el | 11 +++++++++++
modified lisp/progmodes/project.el
@@ -225,6 +225,26 @@ project-vc-ignores
: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 @@ 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))
modified lisp/vc/vc-bzr.el
@@ -45,6 +45,8 @@ vc-bzr-checkout-model
;;; Code:
+(require 'subr-x) ; for string-empty-p
+
(eval-when-compile
(require 'cl-lib)
(require 'vc-dispatcher)
@@ -1315,6 +1317,20 @@ vc-bzr-revision-completion-table
vc-bzr-revision-keywords))
string pred)))))
+(declare-function cl-remove-if "cl-seq")
+
+(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
modified lisp/vc/vc-git.el
@@ -102,9 +102,10 @@
;;; Code:
+(require 'subr-x) ; for string-trim-right, string-empty-p
+
(eval-when-compile
(require 'cl-lib)
- (require 'subr-x) ; for string-trim-right
(require 'vc)
(require 'vc-dir))
@@ -1706,6 +1707,17 @@ vc-git-symbolic-commit
(1- (point-max)))))))
(and name (not (string= name "undefined")) name))))
+(declare-function cl-remove-if "cl-seq")
+
+(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
modified lisp/vc/vc-hg.el
@@ -102,6 +102,7 @@
;;; Code:
(require 'cl-lib)
+(require 'subr-x)
(eval-when-compile
(require 'vc)
@@ -1457,6 +1458,18 @@ vc-hg-command
(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
modified lisp/vc/vc-svn.el
@@ -28,7 +28,9 @@
;;; Code:
+(require 'subr-x)
(eval-when-compile
+ (require 'cl-lib)
(require 'vc))
;; Clear up the cache to force vc-call to check again and discover
@@ -807,7 +809,21 @@ vc-svn-revision-table
(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)))
+
+(declare-function cl-remove-if "cl-seq")
+
+(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)
modified lisp/vc/vc.el
@@ -3106,6 +3106,17 @@ vc-file-tree-walk-internal
(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
--8<---------------cut here---------------end--------------->8---
Bye,
Tassilo
- A project-files implementation for Git projects, Tassilo Horn, 2019/09/06
- Re: A project-files implementation for Git projects, Stefan Monnier, 2019/09/06
- Re: A project-files implementation for Git projects, Tassilo Horn, 2019/09/10
- Re: A project-files implementation for Git projects, Stefan Monnier, 2019/09/10
- Re: A project-files implementation for Git projects, Tassilo Horn, 2019/09/10
- Re: A project-files implementation for Git projects, Stefan Monnier, 2019/09/10
- Re: A project-files implementation for Git projects, Tassilo Horn, 2019/09/11
- Re: A project-files implementation for Git projects,
Tassilo Horn <=
- Re: A project-files implementation for Git projects, Tassilo Horn, 2019/09/13
- Re: A project-files implementation for Git projects, Dmitry Gutov, 2019/09/13
- Re: A project-files implementation for Git projects, Tassilo Horn, 2019/09/14
- Re: A project-files implementation for Git projects, Dmitry Gutov, 2019/09/15
- Re: A project-files implementation for Git projects, Eli Zaretskii, 2019/09/15
- Re: A project-files implementation for Git projects, Dmitry Gutov, 2019/09/15
- Re: A project-files implementation for Git projects, Eli Zaretskii, 2019/09/16
- Re: A project-files implementation for Git projects, Dmitry Gutov, 2019/09/17
- Re: A project-files implementation for Git projects, Eli Zaretskii, 2019/09/17
- Re: A project-files implementation for Git projects, Dmitry Gutov, 2019/09/17