Add new VC command `repository-url'
* lisp/vc/vc.el: Document repository-url command. * lisp/vc/vc-bzr.el (vc-bzr-repository-url): New defun. * lisp/vc/vc-git.el (vc-git-repository-url): New defun. * lisp/vc/vc-hg.el (vc-hg-repository-url): New defun. * lisp/vc/vc-svn.el (vc-svn-repository-url): New defun.
This commit is contained in:
parent
e96f78fca6
commit
4f92cf14f3
5 changed files with 35 additions and 1 deletions
|
@ -1316,6 +1316,15 @@ stream. Standard error output is discarded."
|
|||
vc-bzr-revision-keywords))
|
||||
string pred)))))
|
||||
|
||||
(defun vc-bzr-repository-url (file-or-dir)
|
||||
(let ((default-directory (vc-bzr-root file-or-dir)))
|
||||
(with-temp-buffer
|
||||
(vc-bzr-command "info" (current-buffer) 0 nil)
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "parent branch: \\(.*\\)$" nil t)
|
||||
(match-string 1)
|
||||
(error "Cannot determine Bzr repository URL")))))
|
||||
|
||||
(provide 'vc-bzr)
|
||||
|
||||
;;; vc-bzr.el ends here
|
||||
|
|
|
@ -101,6 +101,7 @@
|
|||
;; - rename-file (old new) OK
|
||||
;; - find-file-hook () OK
|
||||
;; - conflicted-files OK
|
||||
;; - repository-url (file-or-dir) OK
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
@ -1082,6 +1083,12 @@ This prompts for a branch to merge from."
|
|||
"DU" "AA" "UU"))
|
||||
(push (expand-file-name file directory) files)))))))
|
||||
|
||||
(defun vc-git-repository-url (file-or-dir)
|
||||
(let ((default-directory (vc-git-root file-or-dir)))
|
||||
(with-temp-buffer
|
||||
(vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
|
||||
(buffer-substring-no-properties (point-min) (1- (point-max))))))
|
||||
|
||||
;; Everywhere but here, follows vc-git-command, which uses vc-do-command
|
||||
;; from vc-dispatcher.
|
||||
(autoload 'vc-resynch-buffer "vc-dispatcher")
|
||||
|
|
|
@ -1525,6 +1525,13 @@ This function differs from vc-do-command in that it invokes
|
|||
(defun vc-hg-root (file)
|
||||
(vc-find-root file ".hg"))
|
||||
|
||||
(defun vc-hg-repository-url (file-or-dir)
|
||||
(let ((default-directory (vc-hg-root file-or-dir)))
|
||||
(with-temp-buffer
|
||||
(vc-hg-command (current-buffer) 0 nil
|
||||
"config" "paths.default")
|
||||
(buffer-substring-no-properties (point-min) (1- (point-max))))))
|
||||
|
||||
(provide 'vc-hg)
|
||||
|
||||
;;; vc-hg.el ends here
|
||||
|
|
|
@ -816,7 +816,14 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
|
|||
(push (match-string 1 loglines) vc-svn-revisions)
|
||||
(setq start (+ start (match-end 0)))
|
||||
(setq loglines (buffer-substring-no-properties start (point-max)))))
|
||||
vc-svn-revisions)))
|
||||
vc-svn-revisions)))
|
||||
|
||||
(defun vc-svn-repository-url (file-or-dir)
|
||||
(let ((default-directory (vc-svn-root file-or-dir)))
|
||||
(with-temp-buffer
|
||||
(vc-svn-command (current-buffer) 0 nil
|
||||
"info" "--show-item" "repos-root-url")
|
||||
(buffer-substring-no-properties (point-min) (1- (point-max))))))
|
||||
|
||||
(provide 'vc-svn)
|
||||
|
||||
|
|
|
@ -553,6 +553,10 @@
|
|||
;; Return the list of files where conflict resolution is needed in
|
||||
;; the project that contains DIR.
|
||||
;; FIXME: what should it do with non-text conflicts?
|
||||
;;
|
||||
;; - repository-url (file)
|
||||
;;
|
||||
;; Returns the URL of the repository of the current checkout.
|
||||
|
||||
;;; Changes from the pre-25.1 API:
|
||||
;;
|
||||
|
|
Loading…
Add table
Reference in a new issue