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:
parent
a0532e148c
commit
2154219059
6 changed files with 29 additions and 22 deletions
|
@ -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 ()
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))))))
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue