branch: externals/vc-jj
commit 290cd89ad88e89d4dba7812ef121153b5d829870
Author: Rudi Schlatte <r...@constantly.at>
Commit: Rudi Schlatte <r...@constantly.at>
Try to make vc-dir more performant
Behavior change: do the same as vc-git and only display files in the
directory we're asked for. This is less useful than what we used to
have, but potentially more performant.
---
vc-jj-tests.el | 41 +++++++++++++++++++++--
vc-jj.el | 101 ++++++++++++++++++++++++++++++++++-----------------------
2 files changed, 98 insertions(+), 44 deletions(-)
diff --git a/vc-jj-tests.el b/vc-jj-tests.el
index ccfed7c0b1..63ee7df26d 100644
--- a/vc-jj-tests.el
+++ b/vc-jj-tests.el
@@ -73,12 +73,19 @@ is needed."
(let ((process-environment
(append (vc-jj-test-environment 0) process-environment)))
(vc-create-repo 'jj))
- ,@body)))
+ ;; On macOS, the generated filename "/var/folders/..." was in
+ ;; reality "/private/var/folders/...", which got unfolded by
+ ;; `vc-jj-root' within some tests -- do this here already
+ (let ((,name (vc-jj-root ,name))
+ (default-directory ,name))
+ ,@body))))
(ert-deftest vc-jj-test-add-file ()
(vc-jj-test-with-repo repo
(write-region "New file" nil "README")
- (should (eq (vc-state "README" 'jj) 'added))))
+ (should (eq (vc-state "README" 'jj) 'added))
+ (should (equal (vc-jj-dir-status-files repo nil (lambda (x y) x))
+ '(("README" added))))))
(ert-deftest vc-jj-test-added-tracked ()
(vc-jj-test-with-repo repo
@@ -86,7 +93,9 @@ is needed."
(vc-jj-checkin '("first-file") "First commit")
(write-region "In second commit" nil "second-file")
(should (eq (vc-jj-state "second-file") 'added))
- (should (eq (vc-jj-state "first-file") 'up-to-date))))
+ (should (eq (vc-jj-state "first-file") 'up-to-date))
+ (should (equal (vc-jj-dir-status-files repo nil (lambda (x y) x))
+ '(("second-file" added) ("first-file" up-to-date))))))
(ert-deftest vc-jj-test-conflict ()
(vc-jj-test-with-repo repo
@@ -149,5 +158,31 @@ is needed."
(should (eq (vc-jj-state "root-ignored.txt") 'added))
(should (eq (vc-jj-state "subdir/subdir-ignored.txt") 'added))))
+(ert-deftest vc-jj-list-files ()
+ (vc-jj-test-with-repo repo
+ (let (branch-1 branch-2 branch-merged)
+ ;; the root change id is always zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
+ (shell-command "jj new zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")
+ (write-region "Unconflicted" nil "unconflicted.txt")
+ (write-region "Branch 1" nil "conflicted.txt")
+ (make-directory "subdir")
+ (write-region "Branch 1" nil "subdir/conflicted.txt")
+ (setq branch-1 (vc-jj-working-revision "unconflicted.txt"))
+ (shell-command "jj new zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz")
+ (write-region "Unconflicted" nil "unconflicted.txt")
+ (write-region "Branch 2" nil "conflicted.txt")
+ (make-directory "subdir")
+ (write-region "Branch 2" nil "subdir/conflicted.txt")
+ (setq branch-2 (vc-jj-working-revision "unconflicted.txt"))
+ (shell-command (concat "jj new " branch-1 " " branch-2))
+ (write-region "Added" nil "added.txt")
+ (should (equal (vc-jj-dir-status-files repo nil (lambda (x y) x))
+ '(("conflicted.txt" conflict)
+ ("subdir/conflicted.txt" conflict)
+ ("added.txt" added)
+ ("unconflicted.txt" up-to-date))))
+ (should (equal (vc-jj-dir-status-files (expand-file-name "subdir/" repo)
nil (lambda (x y) x))
+ '(("conflicted.txt" conflict)))))))
+
(provide 'vc-jj-tests)
;;; vc-jj-tests.el ends here
diff --git a/vc-jj.el b/vc-jj.el
index dc45932a98..475041193c 100644
--- a/vc-jj.el
+++ b/vc-jj.el
@@ -150,14 +150,13 @@ process object in the asynchronous case."
;; - "jj diff --summary FILE" gets us modified (output starts with
;; "M ") or added (output starts with "A "), but no output could
;; be conflicted, ignored or unchanged
- (when-let* ((default-directory (vc-jj-root file))
- ;; (relative (file-relative-name file)) ;; done by
`vc-do-command'
- (conflicted-ignored
- (with-output-to-string
- (vc-jj-command standard-output 0 file "file" "list" "-T"
"conflict" "--")))
- (modified-added
- (with-output-to-string (vc-jj-command standard-output 0 file
- "diff" "--summary"
"--"))))
+ (let* ((default-directory (vc-jj-root file))
+ (conflicted-ignored
+ (with-output-to-string
+ (vc-jj-command standard-output 0 file "file" "list" "-T"
"conflict" "--")))
+ (modified-added
+ (with-output-to-string (vc-jj-command standard-output 0 file
+ "diff" "--summary" "--"))))
(cond
((string-empty-p conflicted-ignored) 'ignored)
((string= conflicted-ignored "true") 'conflict)
@@ -168,40 +167,60 @@ process object in the asynchronous case."
(defun vc-jj-dir-status-files (dir _files update-function)
"Calculate a list of (FILE STATE EXTRA) entries for DIR.
-The list is passed to UPDATE-FUNCTION."
- ;; TODO: could be async!
+Return the result result of applying UPDATE-FUNCTION to that list."
+ ;; This function is specified below the STATE-QUERYING FUNCTIONS
+ ;; header in the comments at the beginning of vc.el. The
+ ;; specification says the 'dir-status-files' backend function
+ ;; returns "a list of lists ... for FILES in DIR", which does not
+ ;; say anything about subdirectories. We follow the example of
+ ;; 'vc-git' and return the state of files in subdirectories of DIR
+ ;; as well (except for ignored files, since we don't want to cons up
+ ;; a list of every file below DIR).
+ ;;
+ ;; Unfortunately this function needs to do a lot of work:
+ ;; - There is no single jj command that gives us all the info we
+ ;; need, so we cannot run asynchronously.
+ ;; - jj prints filenames relative to the repository root, while we
+ ;; need them relative to DIR.
+ ;;
+ ;; TODO: we should use hash tables, since we're doing a lot of set
+ ;; operations, which are slow on lists.
(let* ((dir (expand-file-name dir))
- ;; TODO: Instead of the two `mapcan' calls, it should be more
- ;; efficient to write the output to a buffer and then search
- ;; for lines beginning with A or M, pushing them into a list.
- (changed-files (process-lines vc-jj-program "diff" "--summary" "--"
dir))
- (added (mapcan (lambda (file) (and (string-prefix-p "A " file)
- (list (substring file 2))))
- changed-files))
- (modified (mapcan (lambda (file) (and (string-prefix-p "M " file)
- (list (substring file 2))))
- changed-files))
- (files (mapcan (lambda (file) (list (substring file 2)))
changed-files))
- ;; The output of `jj resolve --list' is a list of file names
- ;; plus a free-text conflict description per line -- rather
- ;; than trying to be fancy and parsing each line (and getting
- ;; bugs with file names with spaces), use `string-prefix-p'
- ;; later. Note that 'jj resolve' errors when there are no
- ;; conflicts, which is harmless.
- (conflicted (process-lines-ignore-status vc-jj-program "resolve"
"--list")))
- (let ((result
- (mapcar
- (lambda (file)
- (let ((vc-state
- (cond ((seq-find
- (apply-partially #'string-prefix-p file)
conflicted)
- 'conflict)
- ((member file added) 'added)
- ((member file modified) 'edited)
- (t 'up-to-date))))
- (list file vc-state)))
- files)))
- (funcall update-function result nil))))
+ (default-directory dir)
+ (project-root (vc-jj-root dir))
+ (registered-files (process-lines vc-jj-program "file" "list" "--"
dir))
+ (ignored-files (seq-difference (cl-delete-if #'file-directory-p
+ (directory-files dir nil
nil t))
+ registered-files))
+ (changed (process-lines vc-jj-program "diff" "--summary" "--" dir))
+ (added-files (mapcan (lambda (entry)
+ (and (string-prefix-p "A " entry)
+ (list (substring entry 2))))
+ changed))
+ (modified-files (mapcan (lambda (entry)
+ (and (string-prefix-p "M " entry)
+ (list (substring entry 2))))
+ changed))
+ ;; The command below only prints conflicted files in DIR, but
+ ;; relative to project-root, hence the dance with
+ ;; expand-file-name / file-relative-name
+ (conflicted-files (mapcar (lambda (entry)
+ (file-relative-name (expand-file-name
entry project-root) dir))
+ (process-lines vc-jj-program
+ "file" "list"
+ "-T" "if(conflict, path ++
\"\\n\")" "--" dir)))
+ (unchanged-files (cl-remove-if (lambda (entry) (or (member entry
conflicted-files)
+ (member entry
modified-files)
+ (member entry
added-files)
+ (member entry
ignored-files)))
+ registered-files))
+ (result
+ (nconc (mapcar (lambda (entry) (list entry 'conflict))
conflicted-files)
+ (mapcar (lambda (entry) (list entry 'added)) added-files)
+ (mapcar (lambda (entry) (list entry 'edited)) modified-files)
+ (mapcar (lambda (entry) (list entry 'ignored)) ignored-files)
+ (mapcar (lambda (entry) (list entry 'up-to-date))
unchanged-files))))
+ (funcall update-function result nil)))
(defun vc-jj-dir-extra-headers (dir)
"Return extra headers for `vc-dir' when executed inside DIR.
