From 2154219059a21d6aad2e7e390187d78029fff3d0 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 23 Oct 2022 18:04:55 +0200 Subject: [PATCH] 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 25ac10bd08e..61f8fb86ee5 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 5e826b9a286..8f00441e816 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 366ab9a4f7a..6137ce75ce4 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 3ea4c5d32cd..1fb91c6452a 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 ae6884bbaea..dfc84ba4d36 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 7f603093e11..a0a3ce2e6fd 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))))))) -- 2.39.5