From: Tassilo Horn <tsdh@gnu.org>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: RFC: Automatic setup for bug-reference-mode
Date: Sun, 14 Jun 2020 18:30:26 +0200 [thread overview]
Message-ID: <87tuzdsj8d.fsf@gnu.org> (raw)
In-Reply-To: <87h7vd3cbs.fsf@gnu.org> (Tassilo Horn's message of "Sun, 14 Jun 2020 17:18:47 +0200")
[-- Attachment #1: Type: text/plain, Size: 506 bytes --]
Tassilo Horn <tsdh@gnu.org> writes:
>>> + (let* ((backend (vc-responsible-backend (buffer-file-name) t))
>>> + (url (pcase backend
>>> + ('Git (string-trim
>>> + (shell-command-to-string
>>> + "git ls-remote --get-url"))))))
>>
>> This should be moved to a new VC function.
Ok, I have implemented a new repository-url VC command for all VC
systems I have installed and were able to test: Git, Hg, Bzr, and SVN.
Looks right?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-VC-command-repository-url.patch --]
[-- Type: text/x-patch, Size: 3788 bytes --]
From f117a8517dc32330aa9ed32f531b68daba2d7b62 Mon Sep 17 00:00:00 2001
From: Tassilo Horn <tsdh@gnu.org>
Date: Sun, 14 Jun 2020 18:24:14 +0200
Subject: [PATCH] New VC command repository-url
---
lisp/vc/vc-bzr.el | 8 ++++++++
lisp/vc/vc-git.el | 7 +++++++
lisp/vc/vc-hg.el | 7 +++++++
lisp/vc/vc-svn.el | 9 ++++++++-
lisp/vc/vc.el | 4 ++++
5 files changed, 34 insertions(+), 1 deletion(-)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index e5d307e7ed..504d3dcdda 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1316,6 +1316,14 @@ vc-bzr-revision-completion-table
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) nil nil)
+ (goto-char (point-min))
+ (when (re-search-forward "parent branch: \\(.*\\)$")
+ (match-string 1)))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index dcb5228265..8c9feb0e9d 100644
--- 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 @@ vc-git-conflicted-files
"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--call (current-buffer) "ls-remote" "--get-url")
+ (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 40d7573806..b5cdf5a3a2 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1525,6 +1525,13 @@ vc-hg-command
(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) nil 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 d039bf3c6a..c439082390 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -816,7 +816,14 @@ vc-svn-revision-table
(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) nil 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 c640ba0420..5c335ebfaa 100644
--- 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:
;;
--
2.27.0
[-- Attachment #3: Type: text/plain, Size: 14 bytes --]
Bye,
Tassilo
next prev parent reply other threads:[~2020-06-14 16:30 UTC|newest]
Thread overview: 26+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-06-14 9:37 RFC: Automatic setup for bug-reference-mode Tassilo Horn
2020-06-14 12:13 ` Basil L. Contovounesios
2020-06-14 12:56 ` Tassilo Horn
2020-06-14 14:56 ` Basil L. Contovounesios
2020-06-14 14:22 ` Stefan Monnier
2020-06-14 15:18 ` Tassilo Horn
2020-06-14 16:30 ` Tassilo Horn [this message]
2020-06-14 18:08 ` Basil L. Contovounesios
2020-06-14 18:40 ` Stefan Monnier
2020-06-14 18:57 ` Basil L. Contovounesios
2020-06-14 19:43 ` Tassilo Horn
2020-06-14 19:41 ` Dmitry Gutov
2020-06-14 20:39 ` Tassilo Horn
2020-06-14 20:51 ` Dmitry Gutov
2020-06-14 21:03 ` Basil L. Contovounesios
2020-06-15 6:23 ` VC repository-url command (was: RFC: Automatic setup for bug-reference-mode) Tassilo Horn
2020-06-15 11:33 ` VC repository-url command Basil L. Contovounesios
2020-06-15 9:56 ` RFC: Automatic setup for bug-reference-mode Stephen Leake
2020-06-15 10:21 ` Tassilo Horn
2020-06-17 21:35 ` Juri Linkov
2020-06-17 22:10 ` Dmitry Gutov
2020-06-18 6:06 ` Tassilo Horn
2020-06-18 9:46 ` Dmitry Gutov
2020-06-18 13:37 ` Tassilo Horn
2020-06-18 14:28 ` Dmitry Gutov
2020-06-15 10:57 ` Tassilo Horn
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tuzdsj8d.fsf@gnu.org \
--to=tsdh@gnu.org \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).