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.
This commit is contained in:
Philip Kaludercic 2022-10-23 18:04:55 +02:00
parent a0532e148c
commit 2154219059
No known key found for this signature in database
GPG key ID: F2C3CC513DB89F66
6 changed files with 29 additions and 22 deletions

View file

@ -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 ()

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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)))))))