mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

VC: New support for other working trees

Browse source 
* lisp/vc/vc-git.el (vc-git--read-start-point): New function,
factored out of vc-git-create-tag.
(vc-git-create-tag): Use it.
(vc-git--worktrees, vc-git-known-other-working-trees)
(vc-git-add-working-tree, vc-git-delete-working-tree)
(vc-git-move-working-tree):
* lisp/vc/vc-hg.el (vc-hg-known-other-working-trees)
(vc-hg-add-working-tree, vc-hg--shared-p)
(vc-hg-delete-working-tree, vc-hg-move-working-tree): New
functions.
* lisp/vc/vc.el: Define API for known-other-working-tree,
add-working-tree, delete-working-tree and move-working-tree
backend functions.
(vc-dir-status-files): New function.
(project-current-directory-override): Declare.
(dired-rename-subdir): Autoload.
(vc-add-working-tree, vc-switch-working-tree)
(vc-delete-working-tree, vc-move-working-tree): New commands.
* lisp/vc/vc-hooks.el (vc-prefix-map): Bind them under C-x v.

* doc/emacs/vc1-xtra.texi (Other Working Trees): New node.
* etc/NEWS: Announce the new commands.

* test/lisp/vc/vc-tests/vc-tests.el
(vc-test--other-working-trees): New function.
(vc-test-git07-other-working-trees)
(vc-test-hg07-other-working-trees): New tests.

* lisp/ldefs-boot.el: Regenerate.
This commit is contained in:
Sean Whitton 2025-07-25 19:34:04 +01:00
parent 08ca6caa0a
commit 50ffb29d0b
10 changed files with 637 additions and 147 deletions
Download patch file Download diff file Expand all files Collapse all files

53
lisp/vc/vc-hg.el
View file

@ -1217,7 +1217,7 @@ It is based on `log-edit-mode', and has Hg-specific extensions.")
(defalias 'vc-hg-async-checkins #'always)
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-backend-checkin'.
"Hg-specific version of `vc-BACKEND-checkin'.
REV is ignored."
(let ((args (nconc (list "commit" "-m")
(vc-hg--extract-headers comment))))
@ -1681,6 +1681,57 @@ Intended for use via the `vc-hg--async-command' wrapper."
(concat "paths." (or remote-name "default")))
(buffer-substring-no-properties (point-min) (1- (point-max))))))
(defun vc-hg-known-other-working-trees ()
;; Mercurial doesn't maintain records of shared repositories.
;; The first repository knows nothing about shares created from it,
;; and each share only has a reference back to the first repository.
;;
;; Therefore, to support the VC API for other working trees, Emacs
;; needs to maintain records of its own about other working trees.
;; Rather than create something new our strategy is to rely on
;; project.el's knowledge of existing projects.
;; Note that this relies on code calling `vc-hg-add-working-tree'
;; registering the resultant working tree with project.el.
(let* ((our-root (vc-hg-root default-directory))
(our-sp (expand-file-name ".hg/sharedpath" our-root))
our-store shares)
(if (file-exists-p our-sp)
(with-temp-buffer
(insert-file-contents-literally our-sp)
(setq our-store (string-trim (buffer-string)))
(push (abbreviate-file-name (file-name-directory our-store))
shares))
(setq our-store (expand-file-name ".hg" our-root)))
(dolist (root (project-known-project-roots))
(when-let* (((not (equal root our-root)))
(sp (expand-file-name ".hg/sharedpath" root))
((file-exists-p sp)))
(with-temp-buffer
(insert-file-contents-literally sp)
(when (equal our-store (buffer-string))
(push root shares)))))
shares))
(defun vc-hg-add-working-tree (directory)
(vc-hg-command nil 0 nil "share"
(vc-hg-root default-directory)
(expand-file-name directory)))
(defun vc-hg--shared-p (directory)
(file-exists-p (expand-file-name ".hg/sharedpath" directory)))
(defun vc-hg-delete-working-tree (directory)
(if (vc-hg--shared-p directory)
(delete-directory directory t t)
(user-error "\
Cannot delete first working tree because this would break other working trees")))
(defun vc-hg-move-working-tree (from to)
(if (vc-hg--shared-p from)
(rename-file from (directory-file-name to) 1)
(user-error "\
Cannot relocate first working tree because this would break other working trees")))
(provide 'vc-hg)
;;; vc-hg.el ends here