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.

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ede5f61181b64682e15ade166f43d4e5..21c7e7cfab154616b57994bd6a9ccc84b18449d4 100644 (file)
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -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

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index dcb52282656f62bb5418bdb86b6422410769912b..261e4c7aa470455cb1387171349fe06fa55c356a 100644 (file)
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -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")

diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 40d757380630afa2450a33c46e1586f869cb0a9e..25ca4ed55fdb165498cb456e1aa3cd4196b64856 100644 (file)
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -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

diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index d039bf3c6a39984d117413a6869d7aa35ecf9ba4..6ab07c1476def60e65d17540455c6f4df2b4e48d 100644 (file)
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -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)
 

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index c640ba0420eea502f17a3ada2254e4d190dea303..5c335ebfaa21291ac0c2fe5368e4149385910bc9 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -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:
 ;;