VC: New support for other working trees

* 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.

1 files changed, 118 insertions, 1 deletions

diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el
index 82f28cdad3a..9f570ca0dd1 100644
--- a/test/lisp/vc/vc-tests/vc-tests.el
+++ b/test/lisp/vc/vc-tests/vc-tests.el
@@ -44,6 +44,7 @@
 ;; - latest-on-branch-p (file)
 ;; * checkout-model (files)                                     DONE
 ;; - mode-line-string (file)
+;; - other-working-trees ()                                     DONE
 
 ;; STATE-CHANGING FUNCTIONS
 ;;
@@ -65,6 +66,9 @@
 ;; - modify-change-comment (files rev comment)
 ;; - mark-resolved (files)
 ;; - find-admin-dir (file)
+;; - add-working-tree (directory)                               DONE
+;; - delete-working-tree (directory)                            DONE
+;; - move-working-tree (from to)                                DONE
 
 ;; HISTORY FUNCTIONS
 ;;
@@ -656,6 +660,103 @@ This checks also `vc-backend' and `vc-responsible-backend'."
         (ignore-errors
           (run-hooks 'vc-test--cleanup-hook))))))
 
+(defun vc-test--other-working-trees (backend)
+  "Test other working trees actions."
+  (ert-with-temp-directory tempdir
+    (let ((vc-handled-backends `(,backend))
+          (default-directory
+           (file-name-as-directory
+            (expand-file-name
+             (make-temp-name "vc-test") temporary-file-directory)))
+          (process-environment process-environment)
+          vc-test--cleanup-hook)
+      (unwind-protect
+          (progn
+            ;; Cleanup.
+            (add-hook
+             'vc-test--cleanup-hook
+             (let ((dir default-directory))
+               (lambda ()
+                 (delete-directory dir 'recursive)
+                 (dolist (name '("first" "second" "first"))
+                   (project-forget-project
+                    (expand-file-name name default-directory))))))
+
+            (let* ((first (file-name-as-directory
+                           (expand-file-name "first" default-directory)))
+                   (second (file-name-as-directory
+                            (expand-file-name "second" default-directory)))
+                   (third (file-name-as-directory
+                           (expand-file-name "third" default-directory)))
+                   (tmp-name (expand-file-name "foo" first)))
+
+              ;; Set up the first working tree.
+              (make-directory first t)
+              (let ((default-directory first))
+                (vc-test--create-repo-function backend)
+                (write-region "foo" nil tmp-name nil 'nomessage)
+                (vc-register `(,backend (,(file-name-nondirectory tmp-name)))))
+              (with-current-buffer (find-file-noselect tmp-name)
+                (vc-checkin (list (file-name-nondirectory tmp-name)) backend)
+                (insert "Testing other working trees")
+                (let (vc-async-checkin)
+                  (log-edit-done))
+
+                ;; Set up the second working tree.
+                ;; For the backends which do additional prompting (as
+                ;; specified in the API for this backend function) we
+                ;; need to stub that out.
+                (cl-ecase backend
+                  (Git (cl-letf (((symbol-function 'completing-read)
+                                  (lambda (&rest _ignore) "")))
+                         (vc-add-working-tree backend second)))
+                  (Hg (vc-add-working-tree backend second))))
+
+              ;; Test `known-other-working-trees'.
+              (with-current-buffer (find-file-noselect tmp-name)
+                (should
+                 (equal (list second)
+                        (vc-call-backend backend 'known-other-working-trees)))
+                (let ((default-directory second))
+                  (should
+                   (equal (list first)
+                          (vc-call-backend backend 'known-other-working-trees))))
+
+                ;; Test `move-working-tree'.
+                (vc-move-working-tree backend second third)
+                (should
+                 (equal (list third)
+                        (vc-call-backend backend 'known-other-working-trees)))
+                (should-not (file-directory-p second))
+                (should (file-directory-p third))
+                ;; Moving the first working tree is only supported
+                ;; for some backends.
+                (cl-ecase backend
+                  (Git
+                   (let ((default-directory third))
+                     (vc-move-working-tree backend first second))
+                   (let ((default-directory third))
+                     (should
+                      (equal (list second)
+                             (vc-call-backend backend
+                                              'known-other-working-trees))))
+                   (should-not (file-directory-p first))
+                   (should (file-directory-p second))
+                   (vc-move-working-tree backend second first))
+                  (Hg
+                   (let ((default-directory third))
+                     (should-error (vc-move-working-tree backend
+                                                         first second)))))
+
+                ;; Test `delete-working-tree'.
+                (let ((default-directory first))
+                  (vc-delete-working-tree backend third)
+                  (should-not (file-directory-p third))))))
+
+        ;; Save exit.
+        (ignore-errors
+          (run-hooks 'vc-test--cleanup-hook))))))
+
 ;; Create the test cases.
 
 (defun vc-test--rcs-enabled ()
@@ -794,7 +895,23 @@ This checks also `vc-backend' and `vc-responsible-backend'."
                           (eq system-type 'windows-nt)
                           noninteractive))
           (vc-test--version-diff ',backend))
-        ))))
+
+        (ert-deftest
+            ,(intern (format "vc-test-%s07-other-working-trees" backend-string)) ()
+          ,(format "Check other working trees functions for the %s backend."
+                   backend-string)
+          (skip-unless
+           (ert-test-passed-p
+            (ert-test-most-recent-result
+             (ert-get-test
+              ',(intern
+                 (format "vc-test-%s01-register" backend-string))))))
+          (skip-unless (memq ',backend '(Git Hg)))
+          (skip-when
+           (and (eq ',backend 'Hg)
+                (equal (car (process-lines-ignore-status "hg" "share"))
+                       "hg: unknown command 'share'")))
+          (vc-test--other-working-trees ',backend))))))
 
 (provide 'vc-tests)
 ;;; vc-tests.el ends here