feature/package+vc 2154219059 4/4: Immediately check out the right branch or revision

[Philip Kaludercic]

branch: feature/package+vc
commit 2154219059a21d6aad2e7e390187d78029fff3d0
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Immediately check out the right branch or revision
    
    * lisp/emacs-lisp/package-vc.el (package-vc-unpack) Use REV to avoid
    checking out the wrong branch/revision first.
    * lisp/vc/vc-bzr.el: Handle REV.
    * lisp/vc/vc-git.el: Handle REV.
    * lisp/vc/vc-hg.el: Handle REV.
    * lisp/vc/vc-svn.el: Handle REV.
    * lisp/vc/vc.el: Make BACKEND optional and add REV.
---
 lisp/emacs-lisp/package-vc.el | 16 ++++++----------
 lisp/vc/vc-bzr.el             |  6 ++++--
 lisp/vc/vc-git.el             |  6 ++++--
 lisp/vc/vc-hg.el              |  7 +++++--
 lisp/vc/vc-svn.el             |  7 +++++--
 lisp/vc/vc.el                 |  9 +++++----
 6 files changed, 29 insertions(+), 22 deletions(-)

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 25ac10bd08..61f8fb86ee 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -336,8 +336,7 @@ the `:brach' attribute in PKG-SPEC."
       (if (yes-or-no-p "Overwrite previous checkout?")
           (package--delete-directory pkg-dir pkg-desc)
         (error "There already exists a checkout for %s" name)))
-    (pcase-let* ((extras (package-desc-extras pkg-desc))
-                 ((map :url :branch :lisp-dir) pkg-spec)
+    (pcase-let* (((map :url :branch :lisp-dir) pkg-spec)
                  (repo-dir
                   (if (null lisp-dir)
                       pkg-dir
@@ -353,18 +352,15 @@ the `:brach' attribute in PKG-SPEC."
       ;; Clone the repository into `repo-dir' if necessary
       (unless (file-exists-p repo-dir)
         (make-directory (file-name-directory repo-dir) t)
-        (unless (vc-clone (or (alist-get :vc-backend extras)
-                              package-vc-default-backend)
-                          url repo-dir)
-          (error "Failed to clone %s from %s" name url)))
+        (let ((backend (and url (alist-get url package-vc-heusitic-alist
+                                           nil nil #'string-match-p))))
+          (unless (vc-clone url backend repo-dir (or rev branch))
+            (error "Failed to clone %s from %s" name url))))
 
       (unless (eq pkg-dir repo-dir)
         ;; Link from the right position in `repo-dir' to the package
         ;; directory in the ELPA store.
-        (make-symbolic-link (file-name-concat repo-dir lisp-dir) pkg-dir))
-      (when-let* ((default-directory repo-dir) (rev (or rev branch)))
-        (vc-retrieve-tag pkg-dir rev)))
-
+        (make-symbolic-link (file-name-concat repo-dir lisp-dir) pkg-dir)))
     (package-vc-unpack-1 pkg-desc pkg-dir)))
 
 (defun package-vc-sourced-packages-list ()
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 5e826b9a28..8f00441e81 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -532,8 +532,10 @@ in the branch repository (or whose status not be 
determined)."
     (add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t)
     (vc-message-unresolved-conflicts buffer-file-name)))
 
-(defun vc-bzr-clone (remote directory)
-  (vc-bzr-command nil 0 '() "branch" remote directory)
+(defun vc-bzr-clone (remote directory rev)
+  (if rev
+      (vc-bzr-command nil 0 '() "branch" "-r" rev remote directory)
+    (vc-bzr-command nil 0 '() "branch" remote directory))
   directory)
 
 (defun vc-bzr-version-dirstate (dir)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 366ab9a4f7..6137ce75ce 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1268,8 +1268,10 @@ This prompts for a branch to merge from."
       (add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local))
     (vc-message-unresolved-conflicts buffer-file-name)))
 
-(defun vc-git-clone (remote directory)
-  (vc-git--out-ok "clone" remote directory)
+(defun vc-git-clone (remote directory rev)
+  (if rev
+      (vc-git--out-ok "clone" "--branch" rev remote directory)
+    (vc-git--out-ok "clone" remote directory))
   directory)
 
 ;;; HISTORY FUNCTIONS
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 3ea4c5d32c..1fb91c6452 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1250,8 +1250,11 @@ REV is the revision to check out into WORKFILE."
     (add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t)
     (vc-message-unresolved-conflicts buffer-file-name)))
 
-(defun vc-hg-clone (remote directory)
-  (vc-hg-command nil 0 '() "clone" remote directory)
+(defun vc-hg-clone (remote directory rev)
+  (if rev
+      (vc-hg-command nil 0 '() "clone" "--rev" rev remote directory)
+    (vc-hg-command nil 0 '() "clone" remote directory))
+
   directory)
 
 ;; Modeled after the similar function in vc-bzr.el
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index ae6884bbae..dfc84ba4d3 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -817,8 +817,11 @@ Set file properties accordingly.  If FILENAME is non-nil, 
return its status."
                       "info" "--show-item" "repos-root-url")
       (buffer-substring-no-properties (point-min) (1- (point-max))))))
 
-(defun vc-svn-clone (remote directory)
-  (vc-svn-command nil 0 '() "checkout" remote directory)
+(defun vc-svn-clone (remote directory rev)
+  (if rev
+      (vc-svn-command nil 0 '() "checkout" "--revision" rev remote directory)
+    (vc-svn-command nil 0 '() "checkout" remote directory))
+
   (file-name-concat directory "trunk"))
 
 (provide 'vc-svn)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 7f603093e1..a0a3ce2e6f 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3560,24 +3560,25 @@ to provide the `find-revision' operation instead."
   (interactive)
   (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
 
-(defun vc-clone (backend remote &optional directory)
+(defun vc-clone (remote &optional backend directory rev)
   "Use BACKEND to clone REMOTE into DIRECTORY.
 If successful, returns the a string with the directory of the
 checkout.  If BACKEND is nil, iterate through every known backend
-in `vc-handled-backends' until one succeeds."
+in `vc-handled-backends' until one succeeds.  If REV is non-nil,
+it indicates a specific revision to check out."
   (unless directory
     (setq directory default-directory))
   (if backend
       (progn
         (unless (memq backend vc-handled-backends)
           (error "Unknown VC backend %s" backend))
-        (vc-call-backend backend 'clone remote directory))
+        (vc-call-backend backend 'clone remote directory rev))
     (catch 'ok
       (dolist (backend vc-handled-backends)
         (ignore-error vc-not-supported
           (when-let ((res (vc-call-backend
                            backend 'clone
-                           remote directory)))
+                           remote directory rev)))
             (throw 'ok res)))))))