From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Tassilo Horn Newsgroups: gmane.emacs.devel Subject: Re: A project-files implementation for Git projects Date: Wed, 11 Sep 2019 22:01:38 +0200 Message-ID: <87a7ba8uvx.fsf@gnu.org> References: <8736h9rdc4.fsf@gnu.org> <87mufcfz1u.fsf@gnu.org> <87tv9kz2x6.fsf@gnu.org> <87a7bbjdwe.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="207306"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Sep 11 22:02:08 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1i88oZ-000rjB-Lu for ged-emacs-devel@m.gmane.org; Wed, 11 Sep 2019 22:02:07 +0200 Original-Received: from localhost ([::1]:55864 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i88oX-0003h5-TQ for ged-emacs-devel@m.gmane.org; Wed, 11 Sep 2019 16:02:05 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:38575) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i88oG-0003gu-6i for emacs-devel@gnu.org; Wed, 11 Sep 2019 16:01:51 -0400 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:50791) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1i88oE-0004h1-1S for emacs-devel@gnu.org; Wed, 11 Sep 2019 16:01:48 -0400 Original-Received: from auth1-smtp.messagingengine.com ([66.111.4.227]:51807) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256) (Exim 4.82) (envelope-from ) id 1i88oD-0002O1-NJ for emacs-devel@gnu.org; Wed, 11 Sep 2019 16:01:45 -0400 Original-Received: from compute7.internal (compute7.nyi.internal [10.202.2.47]) by mailauth.nyi.internal (Postfix) with ESMTP id 33A72222C4 for ; Wed, 11 Sep 2019 16:01:45 -0400 (EDT) Original-Received: from mailfrontend2 ([10.202.2.163]) by compute7.internal (MEProxy); Wed, 11 Sep 2019 16:01:45 -0400 X-ME-Sender: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedufedrtdefgdduudekucetufdoteggodetrfdotf fvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdfqfgfvpdfurfetoffkrfgpnffqhgen uceurghilhhouhhtmecufedttdenucenucfjughrpefhvffufhffkfgfgggtsehttdertd dtredtnecuhfhrohhmpefvrghsshhilhhoucfjohhrnhcuoehtshguhhesghhnuhdrohhr gheqnecukfhppeegiedrkedtrdejtddrvdehnecurfgrrhgrmhepmhgrihhlfhhrohhmpe hthhhorhhnodhmvghsmhhtphgruhhthhhpvghrshhonhgrlhhithihqdekieejfeekjeek gedqieefhedvleekqdhtshguhheppehgnhhurdhorhhgsehfrghsthhmrghilhdrfhhmne cuvehluhhsthgvrhfuihiivgeptd X-ME-Proxy: Original-Received: from thinkpad-t440p (p2e504619.dip0.t-ipconnect.de [46.80.70.25]) by mail.messagingengine.com (Postfix) with ESMTPA id 4BC04D60065 for ; Wed, 11 Sep 2019 16:01:42 -0400 (EDT) Mail-Followup-To: emacs-devel@gnu.org X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:239991 Archived-At: 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