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.

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 25ac10bd08e78a13d8a716920b2e070f04c196ab..61f8fb86ee525beac19f5e36644f58bc2226243c 100644 (file)
--- 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 5e826b9a2865f0e799b3bbe97294ffcfc6c88258..8f00441e816fb8b611bf1b7ac50535791923ebfe 100644 (file)
--- 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 366ab9a4f7a568b2dcd079ab93bd8b28444f97b5..6137ce75ce4eab89426e4bc3b3782e6423e67c81 100644 (file)
--- 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 3ea4c5d32cd86d794ef3d0a37c7c816758508b9f..1fb91c6452acc9080b6c569a18d4907d0b6e5802 100644 (file)
--- 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 ae6884bbaeafec9c70857a990b38150a85142b2d..dfc84ba4d36083e7891846b6a6430596b6a8e1fc 100644 (file)
--- 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 7f603093e111c352a0d140c7005e16cc4574a1b7..a0a3ce2e6fd66490fb8cac7459a28a42cbea85de 100644 (file)
--- 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)))))))
 
 \f