From: Tassilo Horn <tsdh@gnu.org>
To: emacs-devel@gnu.org
Subject: Re: A project-files implementation for Git projects
Date: Wed, 11 Sep 2019 22:01:38 +0200 [thread overview]
Message-ID: <87a7ba8uvx.fsf@gnu.org> (raw)
In-Reply-To: 87a7bbjdwe.fsf@gnu.org
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)))))
+\f
+
+(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
next prev parent reply other threads:[~2019-09-11 20:01 UTC|newest]
Thread overview: 94+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-09-06 9:19 A project-files implementation for Git projects Tassilo Horn
2019-09-06 12:52 ` Stefan Monnier
2019-09-10 6:25 ` Tassilo Horn
2019-09-10 12:56 ` Stefan Monnier
2019-09-10 13:39 ` Tassilo Horn
2019-09-10 13:56 ` Stefan Monnier
2019-09-11 11:00 ` Tassilo Horn
2019-09-11 20:01 ` Tassilo Horn [this message]
2019-09-13 20:38 ` Tassilo Horn
2019-09-14 0:29 ` Dmitry Gutov
2019-09-14 16:26 ` Tassilo Horn
2019-09-15 18:56 ` Dmitry Gutov
2019-09-16 2:27 ` Eli Zaretskii
2019-09-16 3:36 ` Dmitry Gutov
2019-09-16 15:25 ` Eli Zaretskii
2019-09-17 10:46 ` Dmitry Gutov
2019-09-17 12:03 ` Eli Zaretskii
2019-09-17 12:55 ` Dmitry Gutov
2019-09-17 13:14 ` Eli Zaretskii
2019-09-19 15:33 ` Dmitry Gutov
2019-09-19 17:29 ` Eli Zaretskii
2019-09-20 11:25 ` Dmitry Gutov
2019-09-20 12:59 ` Eli Zaretskii
2019-09-20 13:28 ` Dmitry Gutov
2019-09-20 13:45 ` Stefan Monnier
2019-09-20 13:54 ` Dmitry Gutov
2019-09-20 14:12 ` Michael Albinus
2019-09-20 14:30 ` Eli Zaretskii
2019-09-20 14:51 ` Dmitry Gutov
2019-09-20 15:04 ` Michael Albinus
2019-09-22 9:23 ` Dmitry Gutov
2019-09-20 14:55 ` Michael Albinus
2019-09-20 15:55 ` Eli Zaretskii
2019-09-20 15:01 ` Stefan Monnier
2019-09-20 15:59 ` Eli Zaretskii
2019-09-20 17:32 ` Stefan Monnier
2019-09-20 17:49 ` Eli Zaretskii
2019-09-20 18:04 ` Stefan Monnier
2019-09-20 14:23 ` Eli Zaretskii
2019-09-20 14:48 ` Dmitry Gutov
2019-09-16 13:32 ` Tassilo Horn
2019-09-17 11:06 ` Dmitry Gutov
2019-09-18 17:15 ` Tassilo Horn
2019-09-19 16:01 ` Dmitry Gutov
2019-09-22 8:56 ` Tassilo Horn
2019-09-22 9:37 ` Dmitry Gutov
2019-09-23 7:42 ` Tassilo Horn
2019-09-23 12:22 ` Dmitry Gutov
2019-09-27 16:17 ` Tassilo Horn
2019-09-30 0:09 ` Dmitry Gutov
2019-09-30 0:25 ` Stefan Monnier
2019-09-30 6:50 ` Dmitry Gutov
2019-09-30 17:09 ` Stefan Monnier
2019-10-01 8:19 ` Dmitry Gutov
2019-10-01 12:31 ` Stefan Monnier
2019-10-01 13:10 ` Stefan Monnier
2019-10-01 23:38 ` Dmitry Gutov
2019-10-03 9:25 ` Felician Nemeth
2019-10-03 10:32 ` Dmitry Gutov
2019-10-03 11:15 ` Felician Nemeth
2019-10-03 12:31 ` Dmitry Gutov
2019-10-03 14:39 ` Felician Nemeth
2019-10-03 14:42 ` Dmitry Gutov
2019-10-03 15:10 ` Felician Nemeth
2019-10-03 15:15 ` Dmitry Gutov
2019-10-01 8:11 ` Dmitry Gutov
2019-10-03 8:33 ` Tassilo Horn
2019-10-03 13:19 ` Dmitry Gutov
2019-10-03 17:15 ` Tassilo Horn
2019-10-03 22:49 ` Dmitry Gutov
2019-10-04 7:47 ` Tassilo Horn
2019-10-04 7:58 ` Tassilo Horn
2019-10-04 13:16 ` Dmitry Gutov
2019-10-04 8:49 ` Tassilo Horn
2019-10-04 12:57 ` Dmitry Gutov
2019-10-04 13:59 ` Tassilo Horn
2019-10-04 15:24 ` Dmitry Gutov
2019-10-04 12:16 ` Stefan Monnier
2019-10-04 13:08 ` Dmitry Gutov
2019-10-03 7:41 ` Tassilo Horn
2019-10-03 12:33 ` Dmitry Gutov
2019-10-03 12:51 ` Tassilo Horn
2019-10-04 5:52 ` Co-authoring and attribution in commit message (was: A project-files implementation for Git projects) Kévin Le Gouguec
2019-10-04 8:33 ` Co-authoring and attribution in commit message Dmitry Gutov
2019-10-04 21:36 ` Karl Fogel
2019-10-05 6:55 ` Eli Zaretskii
2019-10-03 23:02 ` A project-files implementation for Git projects Dmitry Gutov
2019-09-14 0:33 ` Dmitry Gutov
2019-09-14 16:43 ` Tassilo Horn
2019-09-15 8:29 ` Dmitry Gutov
2019-09-15 9:06 ` Dmitry Gutov
2019-09-10 13:57 ` Robert Pluim
2019-09-10 14:24 ` Dmitry Gutov
2019-09-10 14:41 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87a7ba8uvx.fsf@gnu.org \
--to=tsdh@gnu.org \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).