Add optional remote-name argument to VC repository-url command

* lisp/vc/vc.el: Document new remote-name argument of VC
repository-url command.
* lisp/vc/vc-git.el (vc-git-repository-url): Add and use new arg.
* lisp/vc/vc-hg.el (vc-hg-repository-url): Add and use new arg.
* lisp/vc/vc-bzr.el (vc-bzr-repository-url): Add new arg but ignore
it.
* lisp/vc/vc-svn.el (vc-svn-repository-url): Add new arg but ignore
it.

diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 21c7e7cfab154616b57994bd6a9ccc84b18449d4..f98730ed22136685c81c29cabc6fc0bd4e0489f5 100644 (file)
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1316,7 +1316,7 @@ stream.  Standard error output is discarded."
                                              vc-bzr-revision-keywords))
                             string pred)))))
 
-(defun vc-bzr-repository-url (file-or-dir)
+(defun vc-bzr-repository-url (file-or-dir &optional _remote-name)
   (let ((default-directory (vc-bzr-root file-or-dir)))
     (with-temp-buffer
       (vc-bzr-command "info" (current-buffer) 0 nil)

diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 261e4c7aa470455cb1387171349fe06fa55c356a..636f9dfd0ca81356bc8051cf63046aa969c2b642 100644 (file)
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1083,10 +1083,11 @@ 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)
+(defun vc-git-repository-url (file-or-dir &optional remote-name)
   (let ((default-directory (vc-git-root file-or-dir)))
     (with-temp-buffer
-      (vc-git-command (current-buffer) 0 nil "remote" "get-url" "origin")
+      (vc-git-command (current-buffer) 0 nil "remote" "get-url"
+                      (or remote-name "origin"))
       (buffer-substring-no-properties (point-min) (1- (point-max))))))
 
 ;; Everywhere but here, follows vc-git-command, which uses vc-do-command

diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 25ca4ed55fdb165498cb456e1aa3cd4196b64856..95ced7b8d092bba86d03c02094f6aa35df20f7a4 100644 (file)
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1525,11 +1525,12 @@ 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)
+(defun vc-hg-repository-url (file-or-dir &optional remote-name)
   (let ((default-directory (vc-hg-root file-or-dir)))
     (with-temp-buffer
       (vc-hg-command (current-buffer) 0 nil
-                     "config" "paths.default")
+                     "config"
+                     (concat "paths." (or remote-name "default")))
       (buffer-substring-no-properties (point-min) (1- (point-max))))))
 
 (provide 'vc-hg)

diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 6ab07c1476def60e65d17540455c6f4df2b4e48d..e108b3a340fdd605f27af11714d65bf1c42e6da7 100644 (file)
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -818,7 +818,7 @@ Set file properties accordingly.  If FILENAME is non-nil, return its status."
           (setq loglines (buffer-substring-no-properties start (point-max)))))
       vc-svn-revisions)))
 
-(defun vc-svn-repository-url (file-or-dir)
+(defun vc-svn-repository-url (file-or-dir &optional _remote-name)
   (let ((default-directory (vc-svn-root file-or-dir)))
     (with-temp-buffer
       (vc-svn-command (current-buffer) 0 nil

diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 5c335ebfaa21291ac0c2fe5368e4149385910bc9..ce947d21f95cb582b35eba3ad81d698a1ab63bbc 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -554,9 +554,12 @@
 ;;   the project that contains DIR.
 ;;   FIXME: what should it do with non-text conflicts?
 ;;
-;; - repository-url (file)
+;; - repository-url (file-or-dir &optional remote-name)
 ;;
-;;   Returns the URL of the repository of the current checkout.
+;;   Returns the URL of the repository of the current checkout
+;;   containing FILE-OR-DIR.  The optional REMOTE-NAME specifies the
+;;   remote (in Git parlance) whose URL is to be returned.  It has
+;;   only a meaning for distributed VCS and is ignored otherwise.
 
 ;;; Changes from the pre-25.1 API:
 ;;