* bug#73357: [PATCH] Make vc-clone interactive
@ 2024-09-19 13:18 Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-09-19 13:36 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-09-19 13:18 UTC (permalink / raw)
To: 73357
[-- Attachment #1: Type: text/plain, Size: 123 bytes --]
Hi,
Cloning is used quite often, so I would like to have an interactive
command. A patch is attached to the email. WDYT?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Make vc-clone interactive --]
[-- Type: text/x-patch, Size: 3031 bytes --]
From 1fd3aa4b3afe4064bcc78787b99f4fa336e4031d Mon Sep 17 00:00:00 2001
Message-ID: <1fd3aa4b3afe4064bcc78787b99f4fa336e4031d.1726751543.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Thu, 19 Sep 2024 16:11:31 +0300
Subject: [PATCH] Make vc-clone interactive
* lisp/vc/vc.el (vc-clone): Make interactive.
(vc--remotes-history): New defvar.
---
lisp/vc/vc.el | 40 +++++++++++++++++++++++++++-------------
1 file changed, 27 insertions(+), 13 deletions(-)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 597a1622f5a..d3d3a302d45 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3804,6 +3804,8 @@ vc-check-headers
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
+(defvar vc--remotes-history)
+
(defun vc-clone (remote &optional backend directory rev)
"Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
If successful, return the string with the directory of the checkout;
@@ -3815,19 +3817,31 @@ vc-clone
backend in `vc-handled-backends' until one succeeds to clone REMOTE.
If REV is non-nil, it indicates a specific revision to check out after
cloning; the syntax of REV depends on what BACKEND accepts."
- (setq directory (expand-file-name (or 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 rev))
- (catch 'ok
- (dolist (backend vc-handled-backends)
- (ignore-error vc-not-supported
- (when-let ((res (vc-call-backend
- backend 'clone
- remote directory rev)))
- (throw 'ok res)))))))
+ (interactive
+ (list (read-string "Remote: " nil 'vc--remotes-history)
+ (intern (completing-read "Backend: " vc-handled-backends nil t))
+ (expand-file-name
+ (read-directory-name "Clone dir: "))
+ (read-string "Revision (RET if not needed): ")))
+ (let ((directory (expand-file-name (or directory default-directory)))
+ (rev (unless (string-empty-p rev) rev)))
+ (setq directory
+ (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (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 rev)))
+ (throw 'ok res)))))))
+ (when (file-directory-p directory)
+ (if (called-interactively-p 'interactive)
+ (find-file directory)
+ directory))))
(declare-function log-view-current-tag "log-view" (&optional pos))
(defun vc-default-last-change (_backend file line)
--
2.46.0
[-- Attachment #3: Type: text/plain, Size: 39 bytes --]
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-09-19 13:18 bug#73357: [PATCH] Make vc-clone interactive Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-09-19 13:36 ` Eli Zaretskii
2024-09-19 16:38 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-09-19 13:36 UTC (permalink / raw)
To: Aleksandr Vityazev; +Cc: 73357
> Date: Thu, 19 Sep 2024 16:18:16 +0300
> From: Aleksandr Vityazev via "Bug reports for GNU Emacs,
> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>
> Cloning is used quite often, so I would like to have an interactive
> command. A patch is attached to the email. WDYT?
Thanks, but making this function a command will take more than just
adding the interactive form. I think we need at least:
. mention that in interactive usage the command prompts for the
argument (why do we have to prompt for REV, btw?)
. announce the change in NEWS
. maybe update the user manual
. maybe make the command fall back to 'checkout' method if 'clone'
is not supported
> + (when (file-directory-p directory)
> + (if (called-interactively-p 'interactive)
> + (find-file directory)
> + directory))))
This changes the value returned by the function from what it did
before, no?
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-09-19 13:36 ` Eli Zaretskii
@ 2024-09-19 16:38 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-09-24 10:22 ` Philip Kaludercic
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-09-19 16:38 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 73357
[-- Attachment #1: Type: text/plain, Size: 1500 bytes --]
On 2024-09-19 16:36, Eli Zaretskii wrote:
>> Date: Thu, 19 Sep 2024 16:18:16 +0300
>> From: Aleksandr Vityazev via "Bug reports for GNU Emacs,
>> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>>
>> Cloning is used quite often, so I would like to have an interactive
>> command. A patch is attached to the email. WDYT?
>
> Thanks, but making this function a command will take more than just
> adding the interactive form. I think we need at least:
>
> . mention that in interactive usage the command prompts for the
> argument (why do we have to prompt for REV, btw?)
I clarified in the docstring. We can agree that we shouldn't prompt for REV
when cloning interactively, removed.
> . announce the change in NEWS
Announced but did not mark the news with +++ or ---.
> . maybe update the user manual
maybe if I have to, I'll do it.
> . maybe make the command fall back to 'checkout' method if 'clone'
> is not supported
it's worth thinking about, because I can't say for sure right now if
it's worth it. And how to do this when vc-checkout requires a file as an
argument.
>> + (when (file-directory-p directory)
>> + (if (called-interactively-p 'interactive)
>> + (find-file directory)
>> + directory))))
>
> This changes the value returned by the function from what it did
> before, no?
If the function is called from the code, it returns nil or the
directory, just like in the previous version. Or am I missing
something?
V2 patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Make vc-clone interactive --]
[-- Type: text/x-patch, Size: 3811 bytes --]
From b302b5c42e01fe0b6f7607128ed660babf55e35a Mon Sep 17 00:00:00 2001
Message-ID: <b302b5c42e01fe0b6f7607128ed660babf55e35a.1726762586.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Thu, 19 Sep 2024 16:11:31 +0300
Subject: [PATCH] Make vc-clone interactive
* lisp/vc/vc.el (vc-clone): Make interactive.
Mention this in the doc string.
(vc--remotes-history): New defvar.
* etc/NEWS: Announce it.
---
etc/NEWS | 7 +++++++
lisp/vc/vc.el | 42 ++++++++++++++++++++++++++++--------------
2 files changed, 35 insertions(+), 14 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index b52ad001a2e..db5f05c823c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -359,6 +359,13 @@ functionality of the standard 'xref' commands in TeX buffers. You can
restore the standard 'etags' backend with the 'M-x xref-etags-mode'
toggle.
+** VC
+
+*** 'vc-clone' is now an interactive command.
+When called interactively, 'vc-clone' now prompts for the address of the
+remote repository, the backend that will be used for cloning, as well as
+the directory where the repository will be cloned.
+
\f
* New Modes and Packages in Emacs 31.1
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 597a1622f5a..fc964803a02 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3804,6 +3804,8 @@ vc-check-headers
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
+(defvar vc--remotes-history)
+
(defun vc-clone (remote &optional backend directory rev)
"Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
If successful, return the string with the directory of the checkout;
@@ -3814,20 +3816,32 @@ vc-clone
If BACKEND is nil or omitted, the function iterates through every known
backend in `vc-handled-backends' until one succeeds to clone REMOTE.
If REV is non-nil, it indicates a specific revision to check out after
-cloning; the syntax of REV depends on what BACKEND accepts."
- (setq directory (expand-file-name (or 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 rev))
- (catch 'ok
- (dolist (backend vc-handled-backends)
- (ignore-error vc-not-supported
- (when-let ((res (vc-call-backend
- backend 'clone
- remote directory rev)))
- (throw 'ok res)))))))
+cloning; the syntax of REV depends on what BACKEND accepts.
+If called interactively, prompt for REMOTE, BACKEND and DIRECTORY in
+the minibuffer."
+ (interactive
+ (list (read-string "Remote: " nil 'vc--remotes-history)
+ (intern (completing-read "Backend: " vc-handled-backends nil t))
+ (expand-file-name
+ (read-directory-name "Clone dir: "))))
+ (let ((directory (expand-file-name (or directory default-directory))))
+ (setq directory
+ (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (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 rev)))
+ (throw 'ok res)))))))
+ (when (file-directory-p directory)
+ (if (called-interactively-p 'interactive)
+ (find-file directory)
+ directory))))
(declare-function log-view-current-tag "log-view" (&optional pos))
(defun vc-default-last-change (_backend file line)
--
2.46.0
[-- Attachment #3: Type: text/plain, Size: 38 bytes --]
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-09-19 16:38 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-09-24 10:22 ` Philip Kaludercic
2024-09-29 18:23 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 14+ messages in thread
From: Philip Kaludercic @ 2024-09-24 10:22 UTC (permalink / raw)
To: Aleksandr Vityazev; +Cc: Eli Zaretskii, 73357
Aleksandr Vityazev <avityazev@disroot.org> writes:
> On 2024-09-19 16:36, Eli Zaretskii wrote:
>
>>> Date: Thu, 19 Sep 2024 16:18:16 +0300
>>> From: Aleksandr Vityazev via "Bug reports for GNU Emacs,
>>> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>>>
>>> Cloning is used quite often, so I would like to have an interactive
>>> command. A patch is attached to the email. WDYT?
>>
>> Thanks, but making this function a command will take more than just
>> adding the interactive form. I think we need at least:
>>
>> . mention that in interactive usage the command prompts for the
>> argument (why do we have to prompt for REV, btw?)
>
> I clarified in the docstring. We can agree that we shouldn't prompt for REV
> when cloning interactively, removed.
>
>> . announce the change in NEWS
> Announced but did not mark the news with +++ or ---.
>> . maybe update the user manual
> maybe if I have to, I'll do it.
>> . maybe make the command fall back to 'checkout' method if 'clone'
>> is not supported
>
> it's worth thinking about, because I can't say for sure right now if
> it's worth it. And how to do this when vc-checkout requires a file as an
> argument.
>
>>> + (when (file-directory-p directory)
>>> + (if (called-interactively-p 'interactive)
>>> + (find-file directory)
>>> + directory))))
>>
>> This changes the value returned by the function from what it did
>> before, no?
>
> If the function is called from the code, it returns nil or the
> directory, just like in the previous version. Or am I missing
> something?
>
> V2 patch:
>
>>From b302b5c42e01fe0b6f7607128ed660babf55e35a Mon Sep 17 00:00:00 2001
> Message-ID: <b302b5c42e01fe0b6f7607128ed660babf55e35a.1726762586.git.avityazev@disroot.org>
> From: Aleksandr Vityazev <avityazev@disroot.org>
> Date: Thu, 19 Sep 2024 16:11:31 +0300
> Subject: [PATCH] Make vc-clone interactive
>
> * lisp/vc/vc.el (vc-clone): Make interactive.
> Mention this in the doc string.
> (vc--remotes-history): New defvar.
> * etc/NEWS: Announce it.
> ---
> etc/NEWS | 7 +++++++
> lisp/vc/vc.el | 42 ++++++++++++++++++++++++++++--------------
> 2 files changed, 35 insertions(+), 14 deletions(-)
>
> diff --git a/etc/NEWS b/etc/NEWS
> index b52ad001a2e..db5f05c823c 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -359,6 +359,13 @@ functionality of the standard 'xref' commands in TeX buffers. You can
> restore the standard 'etags' backend with the 'M-x xref-etags-mode'
> toggle.
>
> +** VC
> +
> +*** 'vc-clone' is now an interactive command.
> +When called interactively, 'vc-clone' now prompts for the address of the
> +remote repository, the backend that will be used for cloning, as well as
> +the directory where the repository will be cloned.
Try to avoid passive voice, as in "be used" and "be cloned".
> +
> \f
> * New Modes and Packages in Emacs 31.1
>
> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
> index 597a1622f5a..fc964803a02 100644
> --- a/lisp/vc/vc.el
> +++ b/lisp/vc/vc.el
> @@ -3804,6 +3804,8 @@ vc-check-headers
> (interactive)
> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
>
> +(defvar vc--remotes-history)
> +
> (defun vc-clone (remote &optional backend directory rev)
> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
> If successful, return the string with the directory of the checkout;
> @@ -3814,20 +3816,32 @@ vc-clone
> If BACKEND is nil or omitted, the function iterates through every known
> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
> If REV is non-nil, it indicates a specific revision to check out after
> -cloning; the syntax of REV depends on what BACKEND accepts."
> - (setq directory (expand-file-name (or 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 rev))
> - (catch 'ok
> - (dolist (backend vc-handled-backends)
> - (ignore-error vc-not-supported
> - (when-let ((res (vc-call-backend
> - backend 'clone
> - remote directory rev)))
> - (throw 'ok res)))))))
> +cloning; the syntax of REV depends on what BACKEND accepts.
> +If called interactively, prompt for REMOTE, BACKEND and DIRECTORY in
> +the minibuffer."
> + (interactive
> + (list (read-string "Remote: " nil 'vc--remotes-history)
> + (intern (completing-read "Backend: " vc-handled-backends nil t))
We could consider moving `package-vc-heuristic-alist' to vc so as to
provide some useful default when cloning.
> + (expand-file-name
Here also, I think it would make sense to re-use the same interface as
`package-vc-checkout' provides, by prompting for a not-yet existing
directory.
> + (read-directory-name "Clone dir: "))))
> + (let ((directory (expand-file-name (or directory default-directory))))
> + (setq directory
I think binding this in a `let*' expression would look nicer.
> + (if backend
> + (progn
> + (unless (memq backend vc-handled-backends)
> + (error "Unknown VC backend %s" backend))
> + (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 rev)))
> + (throw 'ok res)))))))
> + (when (file-directory-p directory)
> + (if (called-interactively-p 'interactive)
Perhaps we can add a FIND-FILE argument to the end, so that it is also
possible to open the directory from a script as well.
> + (find-file directory)
> + directory))))
I'd always return `directory', that seems simpler.
>
> (declare-function log-view-current-tag "log-view" (&optional pos))
> (defun vc-default-last-change (_backend file line)
> --
> 2.46.0
--
Philip Kaludercic on siskin
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-09-24 10:22 ` Philip Kaludercic
@ 2024-09-29 18:23 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-01 11:09 ` Philip Kaludercic
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-09-29 18:23 UTC (permalink / raw)
To: Philip Kaludercic; +Cc: Eli Zaretskii, 73357
[-- Attachment #1: Type: text/plain, Size: 6714 bytes --]
On 2024-09-24 10:22, Philip Kaludercic wrote:
> Aleksandr Vityazev <avityazev@disroot.org> writes:
>
>> On 2024-09-19 16:36, Eli Zaretskii wrote:
>>
>>>> Date: Thu, 19 Sep 2024 16:18:16 +0300
>>>> From: Aleksandr Vityazev via "Bug reports for GNU Emacs,
>>>> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>>>>
>>>> Cloning is used quite often, so I would like to have an interactive
>>>> command. A patch is attached to the email. WDYT?
>>>
>>> Thanks, but making this function a command will take more than just
>>> adding the interactive form. I think we need at least:
>>>
>>> . mention that in interactive usage the command prompts for the
>>> argument (why do we have to prompt for REV, btw?)
>>
>> I clarified in the docstring. We can agree that we shouldn't prompt for REV
>> when cloning interactively, removed.
>>
>>> . announce the change in NEWS
>> Announced but did not mark the news with +++ or ---.
>>> . maybe update the user manual
>> maybe if I have to, I'll do it.
>>> . maybe make the command fall back to 'checkout' method if 'clone'
>>> is not supported
>>
>> it's worth thinking about, because I can't say for sure right now if
>> it's worth it. And how to do this when vc-checkout requires a file as an
>> argument.
>>
>>>> + (when (file-directory-p directory)
>>>> + (if (called-interactively-p 'interactive)
>>>> + (find-file directory)
>>>> + directory))))
>>>
>>> This changes the value returned by the function from what it did
>>> before, no?
>>
>> If the function is called from the code, it returns nil or the
>> directory, just like in the previous version. Or am I missing
>> something?
>>
>> V2 patch:
>>
>>>From b302b5c42e01fe0b6f7607128ed660babf55e35a Mon Sep 17 00:00:00 2001
>> Message-ID: <b302b5c42e01fe0b6f7607128ed660babf55e35a.1726762586.git.avityazev@disroot.org>
>> From: Aleksandr Vityazev <avityazev@disroot.org>
>> Date: Thu, 19 Sep 2024 16:11:31 +0300
>> Subject: [PATCH] Make vc-clone interactive
>>
>> * lisp/vc/vc.el (vc-clone): Make interactive.
>> Mention this in the doc string.
>> (vc--remotes-history): New defvar.
>> * etc/NEWS: Announce it.
>> ---
>> etc/NEWS | 7 +++++++
>> lisp/vc/vc.el | 42 ++++++++++++++++++++++++++++--------------
>> 2 files changed, 35 insertions(+), 14 deletions(-)
>>
>> diff --git a/etc/NEWS b/etc/NEWS
>> index b52ad001a2e..db5f05c823c 100644
>> --- a/etc/NEWS
>> +++ b/etc/NEWS
>> @@ -359,6 +359,13 @@ functionality of the standard 'xref' commands in TeX buffers. You can
>> restore the standard 'etags' backend with the 'M-x xref-etags-mode'
>> toggle.
>>
>> +** VC
>> +
>> +*** 'vc-clone' is now an interactive command.
>> +When called interactively, 'vc-clone' now prompts for the address of the
>> +remote repository, the backend that will be used for cloning, as well as
>> +the directory where the repository will be cloned.
>
> Try to avoid passive voice, as in "be used" and "be cloned".
Fixed.
>
>> +
>> \f
>> * New Modes and Packages in Emacs 31.1
>>
>> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
>> index 597a1622f5a..fc964803a02 100644
>> --- a/lisp/vc/vc.el
>> +++ b/lisp/vc/vc.el
>> @@ -3804,6 +3804,8 @@ vc-check-headers
>> (interactive)
>> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
>>
>> +(defvar vc--remotes-history)
>> +
>> (defun vc-clone (remote &optional backend directory rev)
>> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
>> If successful, return the string with the directory of the checkout;
>> @@ -3814,20 +3816,32 @@ vc-clone
>> If BACKEND is nil or omitted, the function iterates through every known
>> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
>> If REV is non-nil, it indicates a specific revision to check out after
>> -cloning; the syntax of REV depends on what BACKEND accepts."
>> - (setq directory (expand-file-name (or 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 rev))
>> - (catch 'ok
>> - (dolist (backend vc-handled-backends)
>> - (ignore-error vc-not-supported
>> - (when-let ((res (vc-call-backend
>> - backend 'clone
>> - remote directory rev)))
>> - (throw 'ok res)))))))
>> +cloning; the syntax of REV depends on what BACKEND accepts.
>> +If called interactively, prompt for REMOTE, BACKEND and DIRECTORY in
>> +the minibuffer."
>> + (interactive
>> + (list (read-string "Remote: " nil 'vc--remotes-history)
>> + (intern (completing-read "Backend: " vc-handled-backends nil t))
>
> We could consider moving `package-vc-heuristic-alist' to vc so as to
> provide some useful default when cloning.
make sense, moved package-vc-heuristic-alist, package-vc--backend-type
and package-vc--guess-backend into vc
>
>> + (expand-file-name
>
> Here also, I think it would make sense to re-use the same interface as
> `package-vc-checkout' provides, by prompting for a not-yet existing
> directory.
I agree
>
>> + (read-directory-name "Clone dir: "))))
>> + (let ((directory (expand-file-name (or directory default-directory))))
>> + (setq directory
>
> I think binding this in a `let*' expression would look nicer.
also agree
>
>> + (if backend
>> + (progn
>> + (unless (memq backend vc-handled-backends)
>> + (error "Unknown VC backend %s" backend))
>> + (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 rev)))
>> + (throw 'ok res)))))))
>> + (when (file-directory-p directory)
>> + (if (called-interactively-p 'interactive)
>
> Perhaps we can add a FIND-FILE argument to the end, so that it is also
> possible to open the directory from a script as well.
might be useful, added and documented in doc string.
>
>> + (find-file directory)
>> + directory))))
>
> I'd always return `directory', that seems simpler.
Simpler, but it seems logical to switch to a directory when using it
interactively. I left it as it was.
>
>>
>> (declare-function log-view-current-tag "log-view" (&optional pos))
>> (defun vc-default-last-change (_backend file line)
>> --
>> 2.46.0
V3 patch:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Make vc-clone interactive --]
[-- Type: text/x-patch, Size: 14340 bytes --]
From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001
Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Sun, 29 Sep 2024 21:13:28 +0300
Subject: [PATCH] Make vc-clone interactive
* lisp/vc/vc.el (vc-clone): Make interactive. Add optional
argument FIND-FILE. Mention these changes in the doc string.
(vc--remotes-history): New defvar.
* lisp/emacs-lisp/package-vc (package-vc--backend-type,
package-vc-heuristic-alist, package-vc--guess-backend):
Rename and move to ...
(package-vc-default-backend): Set type to vc-backend-type.
(package-vc--clone, package-vc--read-package-name, package-vc-install,
package-vc-checkout): Use vc-guess-backend.
* lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
... here.
* etc/NEWS: Announce these changes.
---
etc/NEWS | 12 ++++
lisp/emacs-lisp/package-vc.el | 75 ++--------------------
lisp/vc/vc.el | 115 +++++++++++++++++++++++++++++-----
3 files changed, 118 insertions(+), 84 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index aaf3783f006..3722e12c01d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -444,6 +444,18 @@ toggle.
Putting (require 'midnight) in your init file no longer activates the
mode. Now, one needs to say (midnight-mode +1) instead.
+** VC
+
+*** 'vc-clone' is now an interactive command.
+When called interactively, 'vc-clone' now prompts for the remote
+repository address, the backend for cloning, if it has not been
+determined automatically according to the URL, and the directory to
+clone the repository into.
+
+*** 'vc-clone' now accepts an optional argument FIND-FILE.
+When the argument is non-nil, the function switches to a buffer visiting
+directory to which the repository was cloned.
+
\f
* New Modes and Packages in Emacs 31.1
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index e168096e153..82b450368d0 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -63,62 +63,6 @@ package-vc
(defconst package-vc--elpa-packages-version 1
"Version number of the package specification format understood by package-vc.")
-(defconst package-vc--backend-type
- `(choice :convert-widget
- ,(lambda (widget)
- (let (opts)
- (dolist (be vc-handled-backends)
- (when (or (vc-find-backend-function be 'clone)
- (alist-get 'clone (get be 'vc-functions)))
- (push (widget-convert (list 'const be)) opts)))
- (widget-put widget :args opts))
- widget))
- "The type of VC backends that support cloning package VCS repositories.")
-
-(defcustom package-vc-heuristic-alist
- `((,(rx bos "http" (? "s") "://"
- (or (: (? "www.") "github.com"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "codeberg.org"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: (? "www.") "gitlab" (+ "." (+ alnum))
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
- (or "r" "git") "/"
- (+ (or alnum "-" "." "_")) (? "/")))
- (or (? "/") ".git") eos)
- . Git)
- (,(rx bos "http" (? "s") "://"
- (or (: "hg.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Hg)
- (,(rx bos "http" (? "s") "://"
- (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Bzr))
- "Alist mapping repository URLs to VC backends.
-`package-vc-install' consults this alist to determine the VC
-backend from the repository URL when you call it without
-specifying a backend. Each element of the alist has the form
-\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
-the first association for which the URL of the repository matches
-the URL-REGEXP of the association. If no match is found,
-`package-vc-install' uses `package-vc-default-backend' instead."
- :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
- :value-type ,package-vc--backend-type)
- :version "29.1")
-
(defcustom package-vc-default-backend 'Git
"Default VC backend to use for cloning package repositories.
`package-vc-install' uses this backend when you specify neither
@@ -127,7 +71,7 @@ package-vc-default-backend
The value must be a member of `vc-handled-backends' that supports
the `clone' VC function."
- :type package-vc--backend-type
+ :type vc-backend-type
:version "29.1")
(defcustom package-vc-register-as-project t
@@ -626,13 +570,6 @@ package-vc--unpack-1
"")))
t))
-(defun package-vc--guess-backend (url)
- "Guess the VC backend for URL.
-This function will internally query `package-vc-heuristic-alist'
-and return nil if it cannot reasonably guess."
- (and url (alist-get url package-vc-heuristic-alist
- nil nil #'string-match-p)))
-
(declare-function project-remember-projects-under "project" (dir &optional recursive))
(defun package-vc--clone (pkg-desc pkg-spec dir rev)
@@ -646,7 +583,7 @@ package-vc--clone
(unless (file-exists-p dir)
(make-directory (file-name-directory dir) t)
(let ((backend (or (plist-get pkg-spec :vc-backend)
- (package-vc--guess-backend url)
+ (vc-guess-backend url)
(plist-get (alist-get (package-desc-archive pkg-desc)
package-vc--archive-data-alist
nil nil #'string=)
@@ -753,7 +690,7 @@ package-vc--read-package-name
;; pointing towards a repository, and use that as a backup
(and-let* ((extras (package-desc-extras (cadr pkg)))
(url (alist-get :url extras))
- ((package-vc--guess-backend url)))))))
+ ((vc-guess-backend url)))))))
(not allow-url)))
(defun package-vc--read-package-desc (prompt &optional installed)
@@ -917,7 +854,7 @@ package-vc-install
(cdr package)
rev))
((and-let* (((stringp package))
- (backend (or backend (package-vc--guess-backend package))))
+ (backend (or backend (vc-guess-backend package))))
(package-vc--unpack
(package-desc-create
:name (or name (intern (file-name-base package)))
@@ -930,7 +867,7 @@ package-vc-install
(or (package-vc--desc->spec (cadr desc))
(and-let* ((extras (package-desc-extras (cadr desc)))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data" package))
rev)))
@@ -958,7 +895,7 @@ package-vc-checkout
(let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
(and-let* ((extras (package-desc-extras pkg-desc))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data"
(package-desc-name pkg-desc)))))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 597a1622f5a..cd877bd8097 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -929,7 +929,69 @@ vc-find-revision-no-save
:type 'boolean
:version "27.1")
+(defconst vc-backend-type
+ `(choice :convert-widget
+ ,(lambda (widget)
+ (let (opts)
+ (dolist (be vc-handled-backends)
+ (when (or (vc-find-backend-function be 'clone)
+ (alist-get 'clone (get be 'vc-functions)))
+ (push (widget-convert (list 'const be)) opts)))
+ (widget-put widget :args opts))
+ widget))
+ "The type of VC backends that support cloning VCS repositories.")
+
+(defcustom vc-heuristic-alist
+ `((,(rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
+ (or "r" "git") "/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ (or (? "/") ".git") eos)
+ . Git)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "hg.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Hg)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Bzr))
+ "Alist mapping repository URLs to VC backends.
+`vc-clone' consults this alist to determine the VC
+backend from the repository URL when you call it without
+specifying a backend. Each element of the alist has the form
+\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
+the first association for which the URL of the repository matches
+the URL-REGEXP of the association."
+ :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
+ :value-type ,vc-backend-type)
+ :version "29.1")
+
\f
+(defun vc-guess-backend (url)
+ "Guess the VC backend for URL.
+This function will internally query `vc-heuristic-alist'
+and return nil if it cannot reasonably guess."
+ (and url (alist-get url vc-heuristic-alist
+ nil nil #'string-match-p)))
+
;; File property caching
(defun vc-clear-context ()
@@ -3804,7 +3866,9 @@ vc-check-headers
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
-(defun vc-clone (remote &optional backend directory rev)
+(defvar vc--remotes-history)
+
+(defun vc-clone (remote &optional backend directory rev find-file)
"Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
If successful, return the string with the directory of the checkout;
otherwise return nil.
@@ -3814,20 +3878,41 @@ vc-clone
If BACKEND is nil or omitted, the function iterates through every known
backend in `vc-handled-backends' until one succeeds to clone REMOTE.
If REV is non-nil, it indicates a specific revision to check out after
-cloning; the syntax of REV depends on what BACKEND accepts."
- (setq directory (expand-file-name (or 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 rev))
- (catch 'ok
- (dolist (backend vc-handled-backends)
- (ignore-error vc-not-supported
- (when-let ((res (vc-call-backend
- backend 'clone
- remote directory rev)))
- (throw 'ok res)))))))
+cloning; the syntax of REV depends on what BACKEND accepts.
+If FIND-FILE is non-nil, switches to a buffer visiting DIRECTORY to
+which the repository was cloned. It would be useful in scripts, but not
+in regular code.
+If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
+if BACKEND has not been automatically determined according to the REMOTE
+URL, in the minibuffer."
+ (interactive
+ (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
+ (backend (or (vc-guess-backend url)
+ (intern (completing-read
+ "Backend: " vc-handled-backends nil t)))))
+ (list url backend
+ (read-directory-name
+ "Clone into new or empty directory: " nil nil
+ (lambda (dir) (or (not (file-exists-p dir))
+ (directory-empty-p dir)))))))
+ (let* ((directory (expand-file-name (or directory default-directory)))
+ (backend (or backend (vc-guess-backend remote)))
+ (directory (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (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 rev)))
+ (throw 'ok res))))))))
+ (when (file-directory-p directory)
+ (if (or find-file (called-interactively-p 'interactive))
+ (find-file directory)
+ directory))))
(declare-function log-view-current-tag "log-view" (&optional pos))
(defun vc-default-last-change (_backend file line)
--
2.46.0
[-- Attachment #3: Type: text/plain, Size: 38 bytes --]
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-09-29 18:23 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-10-01 11:09 ` Philip Kaludercic
2024-10-06 14:50 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 14+ messages in thread
From: Philip Kaludercic @ 2024-10-01 11:09 UTC (permalink / raw)
To: Aleksandr Vityazev; +Cc: Eli Zaretskii, 73357
Aleksandr Vityazev <avityazev@disroot.org> writes:
[...]
>>> + (if backend
>>> + (progn
>>> + (unless (memq backend vc-handled-backends)
>>> + (error "Unknown VC backend %s" backend))
>>> + (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 rev)))
>>> + (throw 'ok res)))))))
>>> + (when (file-directory-p directory)
>>> + (if (called-interactively-p 'interactive)
>>
>> Perhaps we can add a FIND-FILE argument to the end, so that it is also
>> possible to open the directory from a script as well.
>
> might be useful, added and documented in doc string.
>
>>
>>> + (find-file directory)
>>> + directory))))
>>
>> I'd always return `directory', that seems simpler.
>
> Simpler, but it seems logical to switch to a directory when using it
> interactively. I left it as it was.
What I meant was to write
(defun vc-clone (... &optional ... open-dir)
(interactive (list ... t))
...
(when open-dir
(dired directory))
directory)
instead of
(defun vc-clone (... &optional ... open-dir)
(interactive (list ... t))
...
(if open-dir
(dired directory)
directory))
The advantage is that you can still request the directory to be opened
when invoked non-interactively, you avoid the ambiguity of
`called-interactively-p' and the return value is always of the same
type, and not sometimes whatever `find-file'/`dired' returns.
>>
>>>
>>> (declare-function log-view-current-tag "log-view" (&optional pos))
>>> (defun vc-default-last-change (_backend file line)
>>> --
>>> 2.46.0
>
> V3 patch:
>
> From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001
> Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org>
> From: Aleksandr Vityazev <avityazev@disroot.org>
> Date: Sun, 29 Sep 2024 21:13:28 +0300
> Subject: [PATCH] Make vc-clone interactive
>
> * lisp/vc/vc.el (vc-clone): Make interactive. Add optional
> argument FIND-FILE. Mention these changes in the doc string.
> (vc--remotes-history): New defvar.
> * lisp/emacs-lisp/package-vc (package-vc--backend-type,
> package-vc-heuristic-alist, package-vc--guess-backend):
> Rename and move to ...
> (package-vc-default-backend): Set type to vc-backend-type.
> (package-vc--clone, package-vc--read-package-name, package-vc-install,
> package-vc-checkout): Use vc-guess-backend.
> * lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
> ... here.
> * etc/NEWS: Announce these changes.
I think it would cleaner if we split this up into two commits:
1. Moving `package-vc-heuristic-alist',
2. Making `vc-clone' interactive.
> ---
> etc/NEWS | 12 ++++
> lisp/emacs-lisp/package-vc.el | 75 ++--------------------
> lisp/vc/vc.el | 115 +++++++++++++++++++++++++++++-----
> 3 files changed, 118 insertions(+), 84 deletions(-)
>
> diff --git a/etc/NEWS b/etc/NEWS
> index aaf3783f006..3722e12c01d 100644
> --- a/etc/NEWS
> +++ b/etc/NEWS
> @@ -444,6 +444,18 @@ toggle.
> Putting (require 'midnight) in your init file no longer activates the
> mode. Now, one needs to say (midnight-mode +1) instead.
>
> +** VC
> +
> +*** 'vc-clone' is now an interactive command.
> +When called interactively, 'vc-clone' now prompts for the remote
> +repository address, the backend for cloning, if it has not been
> +determined automatically according to the URL, and the directory to
> +clone the repository into.
> +
> +*** 'vc-clone' now accepts an optional argument FIND-FILE.
> +When the argument is non-nil, the function switches to a buffer visiting
> +directory to which the repository was cloned.
> +
> \f
> * New Modes and Packages in Emacs 31.1
>
> diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
> index e168096e153..82b450368d0 100644
> --- a/lisp/emacs-lisp/package-vc.el
> +++ b/lisp/emacs-lisp/package-vc.el
> @@ -63,62 +63,6 @@ package-vc
> (defconst package-vc--elpa-packages-version 1
> "Version number of the package specification format understood by package-vc.")
>
> -(defconst package-vc--backend-type
> - `(choice :convert-widget
> - ,(lambda (widget)
> - (let (opts)
> - (dolist (be vc-handled-backends)
> - (when (or (vc-find-backend-function be 'clone)
> - (alist-get 'clone (get be 'vc-functions)))
> - (push (widget-convert (list 'const be)) opts)))
> - (widget-put widget :args opts))
> - widget))
> - "The type of VC backends that support cloning package VCS repositories.")
> -
> -(defcustom package-vc-heuristic-alist
> - `((,(rx bos "http" (? "s") "://"
> - (or (: (? "www.") "github.com"
> - "/" (+ (or alnum "-" "." "_"))
> - "/" (+ (or alnum "-" "." "_")))
> - (: "codeberg.org"
> - "/" (+ (or alnum "-" "." "_"))
> - "/" (+ (or alnum "-" "." "_")))
> - (: (? "www.") "gitlab" (+ "." (+ alnum))
> - "/" (+ (or alnum "-" "." "_"))
> - "/" (+ (or alnum "-" "." "_")))
> - (: "git.sr.ht"
> - "/~" (+ (or alnum "-" "." "_"))
> - "/" (+ (or alnum "-" "." "_")))
> - (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
> - (or "r" "git") "/"
> - (+ (or alnum "-" "." "_")) (? "/")))
> - (or (? "/") ".git") eos)
> - . Git)
> - (,(rx bos "http" (? "s") "://"
> - (or (: "hg.sr.ht"
> - "/~" (+ (or alnum "-" "." "_"))
> - "/" (+ (or alnum "-" "." "_")))
> - (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
> - (+ (or alnum "-" "." "_")) (? "/")))
> - eos)
> - . Hg)
> - (,(rx bos "http" (? "s") "://"
> - (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
> - (+ (or alnum "-" "." "_")) (? "/")))
> - eos)
> - . Bzr))
> - "Alist mapping repository URLs to VC backends.
> -`package-vc-install' consults this alist to determine the VC
> -backend from the repository URL when you call it without
> -specifying a backend. Each element of the alist has the form
> -\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
> -the first association for which the URL of the repository matches
> -the URL-REGEXP of the association. If no match is found,
> -`package-vc-install' uses `package-vc-default-backend' instead."
> - :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
> - :value-type ,package-vc--backend-type)
> - :version "29.1")
> -
This should certainly be replaced by a `define-obsolete-variable-alias'!
> (defcustom package-vc-default-backend 'Git
> "Default VC backend to use for cloning package repositories.
> `package-vc-install' uses this backend when you specify neither
> @@ -127,7 +71,7 @@ package-vc-default-backend
>
> The value must be a member of `vc-handled-backends' that supports
> the `clone' VC function."
> - :type package-vc--backend-type
> + :type vc-backend-type
> :version "29.1")
>
> (defcustom package-vc-register-as-project t
> @@ -626,13 +570,6 @@ package-vc--unpack-1
> "")))
> t))
>
> -(defun package-vc--guess-backend (url)
> - "Guess the VC backend for URL.
> -This function will internally query `package-vc-heuristic-alist'
> -and return nil if it cannot reasonably guess."
> - (and url (alist-get url package-vc-heuristic-alist
> - nil nil #'string-match-p)))
> -
> (declare-function project-remember-projects-under "project" (dir &optional recursive))
>
> (defun package-vc--clone (pkg-desc pkg-spec dir rev)
> @@ -646,7 +583,7 @@ package-vc--clone
> (unless (file-exists-p dir)
> (make-directory (file-name-directory dir) t)
> (let ((backend (or (plist-get pkg-spec :vc-backend)
> - (package-vc--guess-backend url)
> + (vc-guess-backend url)
> (plist-get (alist-get (package-desc-archive pkg-desc)
> package-vc--archive-data-alist
> nil nil #'string=)
> @@ -753,7 +690,7 @@ package-vc--read-package-name
> ;; pointing towards a repository, and use that as a backup
> (and-let* ((extras (package-desc-extras (cadr pkg)))
> (url (alist-get :url extras))
> - ((package-vc--guess-backend url)))))))
> + ((vc-guess-backend url)))))))
> (not allow-url)))
>
> (defun package-vc--read-package-desc (prompt &optional installed)
> @@ -917,7 +854,7 @@ package-vc-install
> (cdr package)
> rev))
> ((and-let* (((stringp package))
> - (backend (or backend (package-vc--guess-backend package))))
> + (backend (or backend (vc-guess-backend package))))
> (package-vc--unpack
> (package-desc-create
> :name (or name (intern (file-name-base package)))
> @@ -930,7 +867,7 @@ package-vc-install
> (or (package-vc--desc->spec (cadr desc))
> (and-let* ((extras (package-desc-extras (cadr desc)))
> (url (alist-get :url extras))
> - (backend (package-vc--guess-backend url)))
> + (backend (vc-guess-backend url)))
> (list :vc-backend backend :url url))
> (user-error "Package `%s' has no VC data" package))
> rev)))
> @@ -958,7 +895,7 @@ package-vc-checkout
> (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
> (and-let* ((extras (package-desc-extras pkg-desc))
> (url (alist-get :url extras))
> - (backend (package-vc--guess-backend url)))
> + (backend (vc-guess-backend url)))
> (list :vc-backend backend :url url))
> (user-error "Package `%s' has no VC data"
> (package-desc-name pkg-desc)))))
> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
> index 597a1622f5a..cd877bd8097 100644
> --- a/lisp/vc/vc.el
> +++ b/lisp/vc/vc.el
> @@ -929,7 +929,69 @@ vc-find-revision-no-save
> :type 'boolean
> :version "27.1")
>
> +(defconst vc-backend-type
> + `(choice :convert-widget
> + ,(lambda (widget)
> + (let (opts)
> + (dolist (be vc-handled-backends)
> + (when (or (vc-find-backend-function be 'clone)
> + (alist-get 'clone (get be 'vc-functions)))
> + (push (widget-convert (list 'const be)) opts)))
> + (widget-put widget :args opts))
> + widget))
> + "The type of VC backends that support cloning VCS repositories.")
> +
> +(defcustom vc-heuristic-alist
> + `((,(rx bos "http" (? "s") "://"
> + (or (: (? "www.") "github.com"
> + "/" (+ (or alnum "-" "." "_"))
> + "/" (+ (or alnum "-" "." "_")))
> + (: "codeberg.org"
> + "/" (+ (or alnum "-" "." "_"))
> + "/" (+ (or alnum "-" "." "_")))
> + (: (? "www.") "gitlab" (+ "." (+ alnum))
> + "/" (+ (or alnum "-" "." "_"))
> + "/" (+ (or alnum "-" "." "_")))
> + (: "git.sr.ht"
> + "/~" (+ (or alnum "-" "." "_"))
> + "/" (+ (or alnum "-" "." "_")))
> + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
> + (or "r" "git") "/"
> + (+ (or alnum "-" "." "_")) (? "/")))
> + (or (? "/") ".git") eos)
> + . Git)
> + (,(rx bos "http" (? "s") "://"
> + (or (: "hg.sr.ht"
> + "/~" (+ (or alnum "-" "." "_"))
> + "/" (+ (or alnum "-" "." "_")))
> + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
> + (+ (or alnum "-" "." "_")) (? "/")))
> + eos)
> + . Hg)
> + (,(rx bos "http" (? "s") "://"
> + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
> + (+ (or alnum "-" "." "_")) (? "/")))
> + eos)
> + . Bzr))
> + "Alist mapping repository URLs to VC backends.
> +`vc-clone' consults this alist to determine the VC
> +backend from the repository URL when you call it without
> +specifying a backend. Each element of the alist has the form
> +\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
> +the first association for which the URL of the repository matches
> +the URL-REGEXP of the association."
> + :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
> + :value-type ,vc-backend-type)
> + :version "29.1")
> +
> \f
> +(defun vc-guess-backend (url)
> + "Guess the VC backend for URL.
> +This function will internally query `vc-heuristic-alist'
> +and return nil if it cannot reasonably guess."
> + (and url (alist-get url vc-heuristic-alist
> + nil nil #'string-match-p)))
> +
> ;; File property caching
>
> (defun vc-clear-context ()
> @@ -3804,7 +3866,9 @@ vc-check-headers
> (interactive)
> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
>
> -(defun vc-clone (remote &optional backend directory rev)
> +(defvar vc--remotes-history)
> +
> +(defun vc-clone (remote &optional backend directory rev find-file)
> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
> If successful, return the string with the directory of the checkout;
> otherwise return nil.
> @@ -3814,20 +3878,41 @@ vc-clone
> If BACKEND is nil or omitted, the function iterates through every known
> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
> If REV is non-nil, it indicates a specific revision to check out after
> -cloning; the syntax of REV depends on what BACKEND accepts."
> - (setq directory (expand-file-name (or 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 rev))
> - (catch 'ok
> - (dolist (backend vc-handled-backends)
> - (ignore-error vc-not-supported
> - (when-let ((res (vc-call-backend
> - backend 'clone
> - remote directory rev)))
> - (throw 'ok res)))))))
> +cloning; the syntax of REV depends on what BACKEND accepts.
> +If FIND-FILE is non-nil, switches to a buffer visiting DIRECTORY to
> +which the repository was cloned. It would be useful in scripts, but not
> +in regular code.
> +If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
> +if BACKEND has not been automatically determined according to the REMOTE
> +URL, in the minibuffer."
> + (interactive
> + (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
> + (backend (or (vc-guess-backend url)
> + (intern (completing-read
> + "Backend: " vc-handled-backends nil t)))))
> + (list url backend
> + (read-directory-name
> + "Clone into new or empty directory: " nil nil
> + (lambda (dir) (or (not (file-exists-p dir))
> + (directory-empty-p dir)))))))
> + (let* ((directory (expand-file-name (or directory default-directory)))
> + (backend (or backend (vc-guess-backend remote)))
> + (directory (if backend
> + (progn
> + (unless (memq backend vc-handled-backends)
> + (error "Unknown VC backend %s" backend))
> + (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 rev)))
> + (throw 'ok res))))))))
> + (when (file-directory-p directory)
When is this not true?
> + (if (or find-file (called-interactively-p 'interactive))
> + (find-file directory)
> + directory))))
>
> (declare-function log-view-current-tag "log-view" (&optional pos))
> (defun vc-default-last-change (_backend file line)
> --
> 2.46.0
--
Philip Kaludercic on icterid
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-01 11:09 ` Philip Kaludercic
@ 2024-10-06 14:50 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-12 12:06 ` Eli Zaretskii
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-10-06 14:50 UTC (permalink / raw)
To: Philip Kaludercic; +Cc: Eli Zaretskii, 73357
[-- Attachment #1: Type: text/plain, Size: 17979 bytes --]
On 2024-10-01 11:09, Philip Kaludercic wrote:
> Aleksandr Vityazev <avityazev@disroot.org> writes:
>
>
> [...]
>
>>>> + (if backend
>>>> + (progn
>>>> + (unless (memq backend vc-handled-backends)
>>>> + (error "Unknown VC backend %s" backend))
>>>> + (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 rev)))
>>>> + (throw 'ok res)))))))
>>>> + (when (file-directory-p directory)
>>>> + (if (called-interactively-p 'interactive)
>>>
>>> Perhaps we can add a FIND-FILE argument to the end, so that it is also
>>> possible to open the directory from a script as well.
>>
>> might be useful, added and documented in doc string.
>>
>>>
>>>> + (find-file directory)
>>>> + directory))))
>>>
>>> I'd always return `directory', that seems simpler.
>>
>> Simpler, but it seems logical to switch to a directory when using it
>> interactively. I left it as it was.
>
> What I meant was to write
>
> (defun vc-clone (... &optional ... open-dir)
> (interactive (list ... t))
> ...
> (when open-dir
> (dired directory))
> directory)
>
> instead of
>
> (defun vc-clone (... &optional ... open-dir)
> (interactive (list ... t))
> ...
> (if open-dir
> (dired directory)
> directory))
>
> The advantage is that you can still request the directory to be opened
> when invoked non-interactively, you avoid the ambiguity of
> `called-interactively-p' and the return value is always of the same
> type, and not sometimes whatever `find-file'/`dired' returns.
>
>>>
>>>>
>>>> (declare-function log-view-current-tag "log-view" (&optional pos))
>>>> (defun vc-default-last-change (_backend file line)
>>>> --
>>>> 2.46.0
>>
>> V3 patch:
>>
>> From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001
>> Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org>
>> From: Aleksandr Vityazev <avityazev@disroot.org>
>> Date: Sun, 29 Sep 2024 21:13:28 +0300
>> Subject: [PATCH] Make vc-clone interactive
>>
>> * lisp/vc/vc.el (vc-clone): Make interactive. Add optional
>> argument FIND-FILE. Mention these changes in the doc string.
>> (vc--remotes-history): New defvar.
>> * lisp/emacs-lisp/package-vc (package-vc--backend-type,
>> package-vc-heuristic-alist, package-vc--guess-backend):
>> Rename and move to ...
>> (package-vc-default-backend): Set type to vc-backend-type.
>> (package-vc--clone, package-vc--read-package-name, package-vc-install,
>> package-vc-checkout): Use vc-guess-backend.
>> * lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
>> ... here.
>> * etc/NEWS: Announce these changes.
>
> I think it would cleaner if we split this up into two commits:
>
> 1. Moving `package-vc-heuristic-alist',
> 2. Making `vc-clone' interactive.
>
done
>> ---
>> etc/NEWS | 12 ++++
>> lisp/emacs-lisp/package-vc.el | 75 ++--------------------
>> lisp/vc/vc.el | 115 +++++++++++++++++++++++++++++-----
>> 3 files changed, 118 insertions(+), 84 deletions(-)
>>
>> diff --git a/etc/NEWS b/etc/NEWS
>> index aaf3783f006..3722e12c01d 100644
>> --- a/etc/NEWS
>> +++ b/etc/NEWS
>> @@ -444,6 +444,18 @@ toggle.
>> Putting (require 'midnight) in your init file no longer activates the
>> mode. Now, one needs to say (midnight-mode +1) instead.
>>
>> +** VC
>> +
>> +*** 'vc-clone' is now an interactive command.
>> +When called interactively, 'vc-clone' now prompts for the remote
>> +repository address, the backend for cloning, if it has not been
>> +determined automatically according to the URL, and the directory to
>> +clone the repository into.
>> +
>> +*** 'vc-clone' now accepts an optional argument FIND-FILE.
>> +When the argument is non-nil, the function switches to a buffer visiting
>> +directory to which the repository was cloned.
>> +
>> \f
>> * New Modes and Packages in Emacs 31.1
>>
>> diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
>> index e168096e153..82b450368d0 100644
>> --- a/lisp/emacs-lisp/package-vc.el
>> +++ b/lisp/emacs-lisp/package-vc.el
>> @@ -63,62 +63,6 @@ package-vc
>> (defconst package-vc--elpa-packages-version 1
>> "Version number of the package specification format understood by package-vc.")
>>
>> -(defconst package-vc--backend-type
>> - `(choice :convert-widget
>> - ,(lambda (widget)
>> - (let (opts)
>> - (dolist (be vc-handled-backends)
>> - (when (or (vc-find-backend-function be 'clone)
>> - (alist-get 'clone (get be 'vc-functions)))
>> - (push (widget-convert (list 'const be)) opts)))
>> - (widget-put widget :args opts))
>> - widget))
>> - "The type of VC backends that support cloning package VCS repositories.")
>> -
>> -(defcustom package-vc-heuristic-alist
>> - `((,(rx bos "http" (? "s") "://"
>> - (or (: (? "www.") "github.com"
>> - "/" (+ (or alnum "-" "." "_"))
>> - "/" (+ (or alnum "-" "." "_")))
>> - (: "codeberg.org"
>> - "/" (+ (or alnum "-" "." "_"))
>> - "/" (+ (or alnum "-" "." "_")))
>> - (: (? "www.") "gitlab" (+ "." (+ alnum))
>> - "/" (+ (or alnum "-" "." "_"))
>> - "/" (+ (or alnum "-" "." "_")))
>> - (: "git.sr.ht"
>> - "/~" (+ (or alnum "-" "." "_"))
>> - "/" (+ (or alnum "-" "." "_")))
>> - (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
>> - (or "r" "git") "/"
>> - (+ (or alnum "-" "." "_")) (? "/")))
>> - (or (? "/") ".git") eos)
>> - . Git)
>> - (,(rx bos "http" (? "s") "://"
>> - (or (: "hg.sr.ht"
>> - "/~" (+ (or alnum "-" "." "_"))
>> - "/" (+ (or alnum "-" "." "_")))
>> - (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
>> - (+ (or alnum "-" "." "_")) (? "/")))
>> - eos)
>> - . Hg)
>> - (,(rx bos "http" (? "s") "://"
>> - (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
>> - (+ (or alnum "-" "." "_")) (? "/")))
>> - eos)
>> - . Bzr))
>> - "Alist mapping repository URLs to VC backends.
>> -`package-vc-install' consults this alist to determine the VC
>> -backend from the repository URL when you call it without
>> -specifying a backend. Each element of the alist has the form
>> -\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
>> -the first association for which the URL of the repository matches
>> -the URL-REGEXP of the association. If no match is found,
>> -`package-vc-install' uses `package-vc-default-backend' instead."
>> - :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
>> - :value-type ,package-vc--backend-type)
>> - :version "29.1")
>> -
>
> This should certainly be replaced by a
> `define-obsolete-variable-alias'!
Fixed
>
>> (defcustom package-vc-default-backend 'Git
>> "Default VC backend to use for cloning package repositories.
>> `package-vc-install' uses this backend when you specify neither
>> @@ -127,7 +71,7 @@ package-vc-default-backend
>>
>> The value must be a member of `vc-handled-backends' that supports
>> the `clone' VC function."
>> - :type package-vc--backend-type
>> + :type vc-backend-type
>> :version "29.1")
>>
>> (defcustom package-vc-register-as-project t
>> @@ -626,13 +570,6 @@ package-vc--unpack-1
>> "")))
>> t))
>>
>> -(defun package-vc--guess-backend (url)
>> - "Guess the VC backend for URL.
>> -This function will internally query `package-vc-heuristic-alist'
>> -and return nil if it cannot reasonably guess."
>> - (and url (alist-get url package-vc-heuristic-alist
>> - nil nil #'string-match-p)))
>> -
>> (declare-function project-remember-projects-under "project" (dir &optional recursive))
>>
>> (defun package-vc--clone (pkg-desc pkg-spec dir rev)
>> @@ -646,7 +583,7 @@ package-vc--clone
>> (unless (file-exists-p dir)
>> (make-directory (file-name-directory dir) t)
>> (let ((backend (or (plist-get pkg-spec :vc-backend)
>> - (package-vc--guess-backend url)
>> + (vc-guess-backend url)
>> (plist-get (alist-get (package-desc-archive pkg-desc)
>> package-vc--archive-data-alist
>> nil nil #'string=)
>> @@ -753,7 +690,7 @@ package-vc--read-package-name
>> ;; pointing towards a repository, and use that as a backup
>> (and-let* ((extras (package-desc-extras (cadr pkg)))
>> (url (alist-get :url extras))
>> - ((package-vc--guess-backend url)))))))
>> + ((vc-guess-backend url)))))))
>> (not allow-url)))
>>
>> (defun package-vc--read-package-desc (prompt &optional installed)
>> @@ -917,7 +854,7 @@ package-vc-install
>> (cdr package)
>> rev))
>> ((and-let* (((stringp package))
>> - (backend (or backend (package-vc--guess-backend package))))
>> + (backend (or backend (vc-guess-backend package))))
>> (package-vc--unpack
>> (package-desc-create
>> :name (or name (intern (file-name-base package)))
>> @@ -930,7 +867,7 @@ package-vc-install
>> (or (package-vc--desc->spec (cadr desc))
>> (and-let* ((extras (package-desc-extras (cadr desc)))
>> (url (alist-get :url extras))
>> - (backend (package-vc--guess-backend url)))
>> + (backend (vc-guess-backend url)))
>> (list :vc-backend backend :url url))
>> (user-error "Package `%s' has no VC data" package))
>> rev)))
>> @@ -958,7 +895,7 @@ package-vc-checkout
>> (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
>> (and-let* ((extras (package-desc-extras pkg-desc))
>> (url (alist-get :url extras))
>> - (backend (package-vc--guess-backend url)))
>> + (backend (vc-guess-backend url)))
>> (list :vc-backend backend :url url))
>> (user-error "Package `%s' has no VC data"
>> (package-desc-name pkg-desc)))))
>> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
>> index 597a1622f5a..cd877bd8097 100644
>> --- a/lisp/vc/vc.el
>> +++ b/lisp/vc/vc.el
>> @@ -929,7 +929,69 @@ vc-find-revision-no-save
>> :type 'boolean
>> :version "27.1")
>>
>> +(defconst vc-backend-type
>> + `(choice :convert-widget
>> + ,(lambda (widget)
>> + (let (opts)
>> + (dolist (be vc-handled-backends)
>> + (when (or (vc-find-backend-function be 'clone)
>> + (alist-get 'clone (get be 'vc-functions)))
>> + (push (widget-convert (list 'const be)) opts)))
>> + (widget-put widget :args opts))
>> + widget))
>> + "The type of VC backends that support cloning VCS repositories.")
>> +
>> +(defcustom vc-heuristic-alist
>> + `((,(rx bos "http" (? "s") "://"
>> + (or (: (? "www.") "github.com"
>> + "/" (+ (or alnum "-" "." "_"))
>> + "/" (+ (or alnum "-" "." "_")))
>> + (: "codeberg.org"
>> + "/" (+ (or alnum "-" "." "_"))
>> + "/" (+ (or alnum "-" "." "_")))
>> + (: (? "www.") "gitlab" (+ "." (+ alnum))
>> + "/" (+ (or alnum "-" "." "_"))
>> + "/" (+ (or alnum "-" "." "_")))
>> + (: "git.sr.ht"
>> + "/~" (+ (or alnum "-" "." "_"))
>> + "/" (+ (or alnum "-" "." "_")))
>> + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
>> + (or "r" "git") "/"
>> + (+ (or alnum "-" "." "_")) (? "/")))
>> + (or (? "/") ".git") eos)
>> + . Git)
>> + (,(rx bos "http" (? "s") "://"
>> + (or (: "hg.sr.ht"
>> + "/~" (+ (or alnum "-" "." "_"))
>> + "/" (+ (or alnum "-" "." "_")))
>> + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
>> + (+ (or alnum "-" "." "_")) (? "/")))
>> + eos)
>> + . Hg)
>> + (,(rx bos "http" (? "s") "://"
>> + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
>> + (+ (or alnum "-" "." "_")) (? "/")))
>> + eos)
>> + . Bzr))
>> + "Alist mapping repository URLs to VC backends.
>> +`vc-clone' consults this alist to determine the VC
>> +backend from the repository URL when you call it without
>> +specifying a backend. Each element of the alist has the form
>> +\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
>> +the first association for which the URL of the repository matches
>> +the URL-REGEXP of the association."
>> + :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
>> + :value-type ,vc-backend-type)
>> + :version "29.1")
>> +
>> \f
>> +(defun vc-guess-backend (url)
>> + "Guess the VC backend for URL.
>> +This function will internally query `vc-heuristic-alist'
>> +and return nil if it cannot reasonably guess."
>> + (and url (alist-get url vc-heuristic-alist
>> + nil nil #'string-match-p)))
>> +
>> ;; File property caching
>>
>> (defun vc-clear-context ()
>> @@ -3804,7 +3866,9 @@ vc-check-headers
>> (interactive)
>> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
>>
>> -(defun vc-clone (remote &optional backend directory rev)
>> +(defvar vc--remotes-history)
>> +
>> +(defun vc-clone (remote &optional backend directory rev find-file)
>> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
>> If successful, return the string with the directory of the checkout;
>> otherwise return nil.
>> @@ -3814,20 +3878,41 @@ vc-clone
>> If BACKEND is nil or omitted, the function iterates through every known
>> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
>> If REV is non-nil, it indicates a specific revision to check out after
>> -cloning; the syntax of REV depends on what BACKEND accepts."
>> - (setq directory (expand-file-name (or 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 rev))
>> - (catch 'ok
>> - (dolist (backend vc-handled-backends)
>> - (ignore-error vc-not-supported
>> - (when-let ((res (vc-call-backend
>> - backend 'clone
>> - remote directory rev)))
>> - (throw 'ok res)))))))
>> +cloning; the syntax of REV depends on what BACKEND accepts.
>> +If FIND-FILE is non-nil, switches to a buffer visiting DIRECTORY to
>> +which the repository was cloned. It would be useful in scripts, but not
>> +in regular code.
>> +If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
>> +if BACKEND has not been automatically determined according to the REMOTE
>> +URL, in the minibuffer."
>> + (interactive
>> + (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
>> + (backend (or (vc-guess-backend url)
>> + (intern (completing-read
>> + "Backend: " vc-handled-backends nil t)))))
>> + (list url backend
>> + (read-directory-name
>> + "Clone into new or empty directory: " nil nil
>> + (lambda (dir) (or (not (file-exists-p dir))
>> + (directory-empty-p dir)))))))
>> + (let* ((directory (expand-file-name (or directory default-directory)))
>> + (backend (or backend (vc-guess-backend remote)))
>> + (directory (if backend
>> + (progn
>> + (unless (memq backend vc-handled-backends)
>> + (error "Unknown VC backend %s" backend))
>> + (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 rev)))
>> + (throw 'ok res))))))))
>> + (when (file-directory-p directory)
>
> When is this not true?
When calling interactively, we can choose a path to a directory that
does not exist, then if the clone operation fails, a path that is not a
directory will be returned. If the cloning operation succeeds, it will
be true. This also applies if the directory already exists.
>
>> + (if (or find-file (called-interactively-p 'interactive))
>> + (find-file directory)
>> + directory))))
>>
>> (declare-function log-view-current-tag "log-view" (&optional pos))
>> (defun vc-default-last-change (_backend file line)
>> --
>> 2.46.0
V4 patches:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Move package-vc-heuristic-alist and related to vc.el --]
[-- Type: text/x-patch, Size: 10148 bytes --]
From 0f2d2f91ca9ecfdf42e891a462ce4aa75e77a0ad Mon Sep 17 00:00:00 2001
Message-ID: <0f2d2f91ca9ecfdf42e891a462ce4aa75e77a0ad.1728225805.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Sun, 6 Oct 2024 17:30:10 +0300
Subject: [PATCH] Move package-vc-heuristic-alist and related to vc.el
* lisp/emacs-lisp/package-vc (package-vc--backend-type,
package-vc-heuristic-alist, package-vc--guess-backend):
Rename and move to ...
(package-vc-heuristic-alist): Make obsolete.
(package-vc-default-backend): Set type to vc-backend-type.
(package-vc--clone, package-vc--read-package-name, package-vc-install,
package-vc-checkout): Use vc-guess-backend.
* lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
... here.
---
lisp/emacs-lisp/package-vc.el | 77 ++++-------------------------------
lisp/vc/vc.el | 62 ++++++++++++++++++++++++++++
2 files changed, 71 insertions(+), 68 deletions(-)
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index e168096e153..8746ebeb476 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -63,61 +63,9 @@ package-vc
(defconst package-vc--elpa-packages-version 1
"Version number of the package specification format understood by package-vc.")
-(defconst package-vc--backend-type
- `(choice :convert-widget
- ,(lambda (widget)
- (let (opts)
- (dolist (be vc-handled-backends)
- (when (or (vc-find-backend-function be 'clone)
- (alist-get 'clone (get be 'vc-functions)))
- (push (widget-convert (list 'const be)) opts)))
- (widget-put widget :args opts))
- widget))
- "The type of VC backends that support cloning package VCS repositories.")
-
-(defcustom package-vc-heuristic-alist
- `((,(rx bos "http" (? "s") "://"
- (or (: (? "www.") "github.com"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "codeberg.org"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: (? "www.") "gitlab" (+ "." (+ alnum))
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
- (or "r" "git") "/"
- (+ (or alnum "-" "." "_")) (? "/")))
- (or (? "/") ".git") eos)
- . Git)
- (,(rx bos "http" (? "s") "://"
- (or (: "hg.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Hg)
- (,(rx bos "http" (? "s") "://"
- (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Bzr))
- "Alist mapping repository URLs to VC backends.
-`package-vc-install' consults this alist to determine the VC
-backend from the repository URL when you call it without
-specifying a backend. Each element of the alist has the form
-\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
-the first association for which the URL of the repository matches
-the URL-REGEXP of the association. If no match is found,
-`package-vc-install' uses `package-vc-default-backend' instead."
- :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
- :value-type ,package-vc--backend-type)
- :version "29.1")
+(define-obsolete-variable-alias
+ 'package-vc-heuristic-alist
+ 'vc-heuristic-alist "31.1")
(defcustom package-vc-default-backend 'Git
"Default VC backend to use for cloning package repositories.
@@ -127,7 +75,7 @@ package-vc-default-backend
The value must be a member of `vc-handled-backends' that supports
the `clone' VC function."
- :type package-vc--backend-type
+ :type vc-backend-type
:version "29.1")
(defcustom package-vc-register-as-project t
@@ -626,13 +574,6 @@ package-vc--unpack-1
"")))
t))
-(defun package-vc--guess-backend (url)
- "Guess the VC backend for URL.
-This function will internally query `package-vc-heuristic-alist'
-and return nil if it cannot reasonably guess."
- (and url (alist-get url package-vc-heuristic-alist
- nil nil #'string-match-p)))
-
(declare-function project-remember-projects-under "project" (dir &optional recursive))
(defun package-vc--clone (pkg-desc pkg-spec dir rev)
@@ -646,7 +587,7 @@ package-vc--clone
(unless (file-exists-p dir)
(make-directory (file-name-directory dir) t)
(let ((backend (or (plist-get pkg-spec :vc-backend)
- (package-vc--guess-backend url)
+ (vc-guess-backend url)
(plist-get (alist-get (package-desc-archive pkg-desc)
package-vc--archive-data-alist
nil nil #'string=)
@@ -753,7 +694,7 @@ package-vc--read-package-name
;; pointing towards a repository, and use that as a backup
(and-let* ((extras (package-desc-extras (cadr pkg)))
(url (alist-get :url extras))
- ((package-vc--guess-backend url)))))))
+ ((vc-guess-backend url)))))))
(not allow-url)))
(defun package-vc--read-package-desc (prompt &optional installed)
@@ -917,7 +858,7 @@ package-vc-install
(cdr package)
rev))
((and-let* (((stringp package))
- (backend (or backend (package-vc--guess-backend package))))
+ (backend (or backend (vc-guess-backend package))))
(package-vc--unpack
(package-desc-create
:name (or name (intern (file-name-base package)))
@@ -930,7 +871,7 @@ package-vc-install
(or (package-vc--desc->spec (cadr desc))
(and-let* ((extras (package-desc-extras (cadr desc)))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data" package))
rev)))
@@ -958,7 +899,7 @@ package-vc-checkout
(let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
(and-let* ((extras (package-desc-extras pkg-desc))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data"
(package-desc-name pkg-desc)))))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 597a1622f5a..b27a3d3ed40 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -929,7 +929,69 @@ vc-find-revision-no-save
:type 'boolean
:version "27.1")
+(defconst vc-backend-type
+ `(choice :convert-widget
+ ,(lambda (widget)
+ (let (opts)
+ (dolist (be vc-handled-backends)
+ (when (or (vc-find-backend-function be 'clone)
+ (alist-get 'clone (get be 'vc-functions)))
+ (push (widget-convert (list 'const be)) opts)))
+ (widget-put widget :args opts))
+ widget))
+ "The type of VC backends that support cloning VCS repositories.")
+
+(defcustom vc-heuristic-alist
+ `((,(rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
+ (or "r" "git") "/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ (or (? "/") ".git") eos)
+ . Git)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "hg.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Hg)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Bzr))
+ "Alist mapping repository URLs to VC backends.
+`vc-clone' consults this alist to determine the VC
+backend from the repository URL when you call it without
+specifying a backend. Each element of the alist has the form
+\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
+the first association for which the URL of the repository matches
+the URL-REGEXP of the association."
+ :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
+ :value-type ,vc-backend-type)
+ :version "29.1")
+
\f
+(defun vc-guess-backend (url)
+ "Guess the VC backend for URL.
+This function will internally query `vc-heuristic-alist'
+and return nil if it cannot reasonably guess."
+ (and url (alist-get url vc-heuristic-alist
+ nil nil #'string-match-p)))
+
;; File property caching
(defun vc-clear-context ()
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH] Make vc-clone interactive --]
[-- Type: text/x-patch, Size: 4725 bytes --]
From d8c1074e4a75d3e6f523f47cb239e9c8ae26b3b7 Mon Sep 17 00:00:00 2001
Message-ID: <d8c1074e4a75d3e6f523f47cb239e9c8ae26b3b7.1728225805.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Sun, 6 Oct 2024 17:34:59 +0300
Subject: [PATCH] Make vc-clone interactive
* lisp/vc/vc.el (vc-clone): Make interactive. Add optional
argument OPEN-DIR. Mention these changes in the doc string.
(vc--remotes-history): New defvar.
* etc/NEWS: Announce these changes.
---
etc/NEWS | 12 ++++++++++++
lisp/vc/vc.el | 54 +++++++++++++++++++++++++++++++++++++--------------
2 files changed, 51 insertions(+), 15 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index d1bd469435f..8d902ccca5f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -494,6 +494,18 @@ instead.
---
*** Support 'electric-layout-mode'.
+** VC
+
+*** 'vc-clone' is now an interactive command.
+When called interactively, 'vc-clone' now prompts for the remote
+repository address, the backend for cloning, if it has not been
+determined automatically according to the URL, and the directory to
+clone the repository into.
+
+*** 'vc-clone' now accepts an optional argument OPEN-DIR.
+When the argument is non-nil, the function switches to a buffer visiting
+directory to which the repository was cloned.
+
\f
* New Modes and Packages in Emacs 31.1
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index b27a3d3ed40..2f1d7808e7a 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3866,7 +3866,9 @@ vc-check-headers
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
-(defun vc-clone (remote &optional backend directory rev)
+(defvar vc--remotes-history)
+
+(defun vc-clone (remote &optional backend directory rev open-dir)
"Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
If successful, return the string with the directory of the checkout;
otherwise return nil.
@@ -3876,20 +3878,42 @@ vc-clone
If BACKEND is nil or omitted, the function iterates through every known
backend in `vc-handled-backends' until one succeeds to clone REMOTE.
If REV is non-nil, it indicates a specific revision to check out after
-cloning; the syntax of REV depends on what BACKEND accepts."
- (setq directory (expand-file-name (or 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 rev))
- (catch 'ok
- (dolist (backend vc-handled-backends)
- (ignore-error vc-not-supported
- (when-let ((res (vc-call-backend
- backend 'clone
- remote directory rev)))
- (throw 'ok res)))))))
+cloning; the syntax of REV depends on what BACKEND accepts.
+If OPEN-DIR is non-nil, switches to a buffer visiting DIRECTORY to
+which the repository was cloned. It would be useful in scripts, but not
+in regular code.
+If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
+if BACKEND has not been automatically determined according to the REMOTE
+URL, in the minibuffer."
+ (interactive
+ (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
+ (backend (or (vc-guess-backend url)
+ (intern (completing-read
+ "Backend: " vc-handled-backends nil t)))))
+ (list url backend
+ (read-directory-name
+ "Clone into new or empty directory: " nil nil
+ (lambda (dir) (or (not (file-exists-p dir))
+ (directory-empty-p dir))))
+ nil t)))
+ (let* ((directory (expand-file-name (or directory default-directory)))
+ (backend (or backend (vc-guess-backend remote)))
+ (directory (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (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 rev)))
+ (throw 'ok res))))))))
+ (when (file-directory-p directory)
+ (when open-dir
+ (find-file directory))
+ directory)))
(declare-function log-view-current-tag "log-view" (&optional pos))
(defun vc-default-last-change (_backend file line)
--
2.46.0
[-- Attachment #4: Type: text/plain, Size: 38 bytes --]
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-06 14:50 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-10-12 12:06 ` Eli Zaretskii
2024-10-24 10:19 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 14+ messages in thread
From: Eli Zaretskii @ 2024-10-12 12:06 UTC (permalink / raw)
To: Aleksandr Vityazev, Dmitry Gutov; +Cc: philipk, 73357
> From: Aleksandr Vityazev <avityazev@disroot.org>
> Cc: Eli Zaretskii <eliz@gnu.org>, 73357@debbugs.gnu.org
> Date: Sun, 06 Oct 2024 17:50:54 +0300
>
> On 2024-10-01 11:09, Philip Kaludercic wrote:
>
> > Aleksandr Vityazev <avityazev@disroot.org> writes:
> >
> >
> > [...]
> >
> >>>> + (if backend
> >>>> + (progn
> >>>> + (unless (memq backend vc-handled-backends)
> >>>> + (error "Unknown VC backend %s" backend))
> >>>> + (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 rev)))
> >>>> + (throw 'ok res)))))))
> >>>> + (when (file-directory-p directory)
> >>>> + (if (called-interactively-p 'interactive)
> >>>
> >>> Perhaps we can add a FIND-FILE argument to the end, so that it is also
> >>> possible to open the directory from a script as well.
> >>
> >> might be useful, added and documented in doc string.
> >>
> >>>
> >>>> + (find-file directory)
> >>>> + directory))))
> >>>
> >>> I'd always return `directory', that seems simpler.
> >>
> >> Simpler, but it seems logical to switch to a directory when using it
> >> interactively. I left it as it was.
> >
> > What I meant was to write
> >
> > (defun vc-clone (... &optional ... open-dir)
> > (interactive (list ... t))
> > ...
> > (when open-dir
> > (dired directory))
> > directory)
> >
> > instead of
> >
> > (defun vc-clone (... &optional ... open-dir)
> > (interactive (list ... t))
> > ...
> > (if open-dir
> > (dired directory)
> > directory))
> >
> > The advantage is that you can still request the directory to be opened
> > when invoked non-interactively, you avoid the ambiguity of
> > `called-interactively-p' and the return value is always of the same
> > type, and not sometimes whatever `find-file'/`dired' returns.
> >
> >>>
> >>>>
> >>>> (declare-function log-view-current-tag "log-view" (&optional pos))
> >>>> (defun vc-default-last-change (_backend file line)
> >>>> --
> >>>> 2.46.0
> >>
> >> V3 patch:
> >>
> >> From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001
> >> Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org>
> >> From: Aleksandr Vityazev <avityazev@disroot.org>
> >> Date: Sun, 29 Sep 2024 21:13:28 +0300
> >> Subject: [PATCH] Make vc-clone interactive
> >>
> >> * lisp/vc/vc.el (vc-clone): Make interactive. Add optional
> >> argument FIND-FILE. Mention these changes in the doc string.
> >> (vc--remotes-history): New defvar.
> >> * lisp/emacs-lisp/package-vc (package-vc--backend-type,
> >> package-vc-heuristic-alist, package-vc--guess-backend):
> >> Rename and move to ...
> >> (package-vc-default-backend): Set type to vc-backend-type.
> >> (package-vc--clone, package-vc--read-package-name, package-vc-install,
> >> package-vc-checkout): Use vc-guess-backend.
> >> * lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
> >> ... here.
> >> * etc/NEWS: Announce these changes.
> >
> > I think it would cleaner if we split this up into two commits:
> >
> > 1. Moving `package-vc-heuristic-alist',
> > 2. Making `vc-clone' interactive.
> >
>
> done
>
> >> ---
> >> etc/NEWS | 12 ++++
> >> lisp/emacs-lisp/package-vc.el | 75 ++--------------------
> >> lisp/vc/vc.el | 115 +++++++++++++++++++++++++++++-----
> >> 3 files changed, 118 insertions(+), 84 deletions(-)
> >>
> >> diff --git a/etc/NEWS b/etc/NEWS
> >> index aaf3783f006..3722e12c01d 100644
> >> --- a/etc/NEWS
> >> +++ b/etc/NEWS
> >> @@ -444,6 +444,18 @@ toggle.
> >> Putting (require 'midnight) in your init file no longer activates the
> >> mode. Now, one needs to say (midnight-mode +1) instead.
> >>
> >> +** VC
> >> +
> >> +*** 'vc-clone' is now an interactive command.
> >> +When called interactively, 'vc-clone' now prompts for the remote
> >> +repository address, the backend for cloning, if it has not been
> >> +determined automatically according to the URL, and the directory to
> >> +clone the repository into.
> >> +
> >> +*** 'vc-clone' now accepts an optional argument FIND-FILE.
> >> +When the argument is non-nil, the function switches to a buffer visiting
> >> +directory to which the repository was cloned.
> >> +
> >> \f
> >> * New Modes and Packages in Emacs 31.1
> >>
> >> diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
> >> index e168096e153..82b450368d0 100644
> >> --- a/lisp/emacs-lisp/package-vc.el
> >> +++ b/lisp/emacs-lisp/package-vc.el
> >> @@ -63,62 +63,6 @@ package-vc
> >> (defconst package-vc--elpa-packages-version 1
> >> "Version number of the package specification format understood by package-vc.")
> >>
> >> -(defconst package-vc--backend-type
> >> - `(choice :convert-widget
> >> - ,(lambda (widget)
> >> - (let (opts)
> >> - (dolist (be vc-handled-backends)
> >> - (when (or (vc-find-backend-function be 'clone)
> >> - (alist-get 'clone (get be 'vc-functions)))
> >> - (push (widget-convert (list 'const be)) opts)))
> >> - (widget-put widget :args opts))
> >> - widget))
> >> - "The type of VC backends that support cloning package VCS repositories.")
> >> -
> >> -(defcustom package-vc-heuristic-alist
> >> - `((,(rx bos "http" (? "s") "://"
> >> - (or (: (? "www.") "github.com"
> >> - "/" (+ (or alnum "-" "." "_"))
> >> - "/" (+ (or alnum "-" "." "_")))
> >> - (: "codeberg.org"
> >> - "/" (+ (or alnum "-" "." "_"))
> >> - "/" (+ (or alnum "-" "." "_")))
> >> - (: (? "www.") "gitlab" (+ "." (+ alnum))
> >> - "/" (+ (or alnum "-" "." "_"))
> >> - "/" (+ (or alnum "-" "." "_")))
> >> - (: "git.sr.ht"
> >> - "/~" (+ (or alnum "-" "." "_"))
> >> - "/" (+ (or alnum "-" "." "_")))
> >> - (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
> >> - (or "r" "git") "/"
> >> - (+ (or alnum "-" "." "_")) (? "/")))
> >> - (or (? "/") ".git") eos)
> >> - . Git)
> >> - (,(rx bos "http" (? "s") "://"
> >> - (or (: "hg.sr.ht"
> >> - "/~" (+ (or alnum "-" "." "_"))
> >> - "/" (+ (or alnum "-" "." "_")))
> >> - (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
> >> - (+ (or alnum "-" "." "_")) (? "/")))
> >> - eos)
> >> - . Hg)
> >> - (,(rx bos "http" (? "s") "://"
> >> - (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
> >> - (+ (or alnum "-" "." "_")) (? "/")))
> >> - eos)
> >> - . Bzr))
> >> - "Alist mapping repository URLs to VC backends.
> >> -`package-vc-install' consults this alist to determine the VC
> >> -backend from the repository URL when you call it without
> >> -specifying a backend. Each element of the alist has the form
> >> -\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
> >> -the first association for which the URL of the repository matches
> >> -the URL-REGEXP of the association. If no match is found,
> >> -`package-vc-install' uses `package-vc-default-backend' instead."
> >> - :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
> >> - :value-type ,package-vc--backend-type)
> >> - :version "29.1")
> >> -
> >
> > This should certainly be replaced by a
> > `define-obsolete-variable-alias'!
>
> Fixed
> >
> >> (defcustom package-vc-default-backend 'Git
> >> "Default VC backend to use for cloning package repositories.
> >> `package-vc-install' uses this backend when you specify neither
> >> @@ -127,7 +71,7 @@ package-vc-default-backend
> >>
> >> The value must be a member of `vc-handled-backends' that supports
> >> the `clone' VC function."
> >> - :type package-vc--backend-type
> >> + :type vc-backend-type
> >> :version "29.1")
> >>
> >> (defcustom package-vc-register-as-project t
> >> @@ -626,13 +570,6 @@ package-vc--unpack-1
> >> "")))
> >> t))
> >>
> >> -(defun package-vc--guess-backend (url)
> >> - "Guess the VC backend for URL.
> >> -This function will internally query `package-vc-heuristic-alist'
> >> -and return nil if it cannot reasonably guess."
> >> - (and url (alist-get url package-vc-heuristic-alist
> >> - nil nil #'string-match-p)))
> >> -
> >> (declare-function project-remember-projects-under "project" (dir &optional recursive))
> >>
> >> (defun package-vc--clone (pkg-desc pkg-spec dir rev)
> >> @@ -646,7 +583,7 @@ package-vc--clone
> >> (unless (file-exists-p dir)
> >> (make-directory (file-name-directory dir) t)
> >> (let ((backend (or (plist-get pkg-spec :vc-backend)
> >> - (package-vc--guess-backend url)
> >> + (vc-guess-backend url)
> >> (plist-get (alist-get (package-desc-archive pkg-desc)
> >> package-vc--archive-data-alist
> >> nil nil #'string=)
> >> @@ -753,7 +690,7 @@ package-vc--read-package-name
> >> ;; pointing towards a repository, and use that as a backup
> >> (and-let* ((extras (package-desc-extras (cadr pkg)))
> >> (url (alist-get :url extras))
> >> - ((package-vc--guess-backend url)))))))
> >> + ((vc-guess-backend url)))))))
> >> (not allow-url)))
> >>
> >> (defun package-vc--read-package-desc (prompt &optional installed)
> >> @@ -917,7 +854,7 @@ package-vc-install
> >> (cdr package)
> >> rev))
> >> ((and-let* (((stringp package))
> >> - (backend (or backend (package-vc--guess-backend package))))
> >> + (backend (or backend (vc-guess-backend package))))
> >> (package-vc--unpack
> >> (package-desc-create
> >> :name (or name (intern (file-name-base package)))
> >> @@ -930,7 +867,7 @@ package-vc-install
> >> (or (package-vc--desc->spec (cadr desc))
> >> (and-let* ((extras (package-desc-extras (cadr desc)))
> >> (url (alist-get :url extras))
> >> - (backend (package-vc--guess-backend url)))
> >> + (backend (vc-guess-backend url)))
> >> (list :vc-backend backend :url url))
> >> (user-error "Package `%s' has no VC data" package))
> >> rev)))
> >> @@ -958,7 +895,7 @@ package-vc-checkout
> >> (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
> >> (and-let* ((extras (package-desc-extras pkg-desc))
> >> (url (alist-get :url extras))
> >> - (backend (package-vc--guess-backend url)))
> >> + (backend (vc-guess-backend url)))
> >> (list :vc-backend backend :url url))
> >> (user-error "Package `%s' has no VC data"
> >> (package-desc-name pkg-desc)))))
> >> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
> >> index 597a1622f5a..cd877bd8097 100644
> >> --- a/lisp/vc/vc.el
> >> +++ b/lisp/vc/vc.el
> >> @@ -929,7 +929,69 @@ vc-find-revision-no-save
> >> :type 'boolean
> >> :version "27.1")
> >>
> >> +(defconst vc-backend-type
> >> + `(choice :convert-widget
> >> + ,(lambda (widget)
> >> + (let (opts)
> >> + (dolist (be vc-handled-backends)
> >> + (when (or (vc-find-backend-function be 'clone)
> >> + (alist-get 'clone (get be 'vc-functions)))
> >> + (push (widget-convert (list 'const be)) opts)))
> >> + (widget-put widget :args opts))
> >> + widget))
> >> + "The type of VC backends that support cloning VCS repositories.")
> >> +
> >> +(defcustom vc-heuristic-alist
> >> + `((,(rx bos "http" (? "s") "://"
> >> + (or (: (? "www.") "github.com"
> >> + "/" (+ (or alnum "-" "." "_"))
> >> + "/" (+ (or alnum "-" "." "_")))
> >> + (: "codeberg.org"
> >> + "/" (+ (or alnum "-" "." "_"))
> >> + "/" (+ (or alnum "-" "." "_")))
> >> + (: (? "www.") "gitlab" (+ "." (+ alnum))
> >> + "/" (+ (or alnum "-" "." "_"))
> >> + "/" (+ (or alnum "-" "." "_")))
> >> + (: "git.sr.ht"
> >> + "/~" (+ (or alnum "-" "." "_"))
> >> + "/" (+ (or alnum "-" "." "_")))
> >> + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
> >> + (or "r" "git") "/"
> >> + (+ (or alnum "-" "." "_")) (? "/")))
> >> + (or (? "/") ".git") eos)
> >> + . Git)
> >> + (,(rx bos "http" (? "s") "://"
> >> + (or (: "hg.sr.ht"
> >> + "/~" (+ (or alnum "-" "." "_"))
> >> + "/" (+ (or alnum "-" "." "_")))
> >> + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
> >> + (+ (or alnum "-" "." "_")) (? "/")))
> >> + eos)
> >> + . Hg)
> >> + (,(rx bos "http" (? "s") "://"
> >> + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
> >> + (+ (or alnum "-" "." "_")) (? "/")))
> >> + eos)
> >> + . Bzr))
> >> + "Alist mapping repository URLs to VC backends.
> >> +`vc-clone' consults this alist to determine the VC
> >> +backend from the repository URL when you call it without
> >> +specifying a backend. Each element of the alist has the form
> >> +\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
> >> +the first association for which the URL of the repository matches
> >> +the URL-REGEXP of the association."
> >> + :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
> >> + :value-type ,vc-backend-type)
> >> + :version "29.1")
> >> +
> >> \f
> >> +(defun vc-guess-backend (url)
> >> + "Guess the VC backend for URL.
> >> +This function will internally query `vc-heuristic-alist'
> >> +and return nil if it cannot reasonably guess."
> >> + (and url (alist-get url vc-heuristic-alist
> >> + nil nil #'string-match-p)))
> >> +
> >> ;; File property caching
> >>
> >> (defun vc-clear-context ()
> >> @@ -3804,7 +3866,9 @@ vc-check-headers
> >> (interactive)
> >> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
> >>
> >> -(defun vc-clone (remote &optional backend directory rev)
> >> +(defvar vc--remotes-history)
> >> +
> >> +(defun vc-clone (remote &optional backend directory rev find-file)
> >> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
> >> If successful, return the string with the directory of the checkout;
> >> otherwise return nil.
> >> @@ -3814,20 +3878,41 @@ vc-clone
> >> If BACKEND is nil or omitted, the function iterates through every known
> >> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
> >> If REV is non-nil, it indicates a specific revision to check out after
> >> -cloning; the syntax of REV depends on what BACKEND accepts."
> >> - (setq directory (expand-file-name (or 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 rev))
> >> - (catch 'ok
> >> - (dolist (backend vc-handled-backends)
> >> - (ignore-error vc-not-supported
> >> - (when-let ((res (vc-call-backend
> >> - backend 'clone
> >> - remote directory rev)))
> >> - (throw 'ok res)))))))
> >> +cloning; the syntax of REV depends on what BACKEND accepts.
> >> +If FIND-FILE is non-nil, switches to a buffer visiting DIRECTORY to
> >> +which the repository was cloned. It would be useful in scripts, but not
> >> +in regular code.
> >> +If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
> >> +if BACKEND has not been automatically determined according to the REMOTE
> >> +URL, in the minibuffer."
> >> + (interactive
> >> + (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
> >> + (backend (or (vc-guess-backend url)
> >> + (intern (completing-read
> >> + "Backend: " vc-handled-backends nil t)))))
> >> + (list url backend
> >> + (read-directory-name
> >> + "Clone into new or empty directory: " nil nil
> >> + (lambda (dir) (or (not (file-exists-p dir))
> >> + (directory-empty-p dir)))))))
> >> + (let* ((directory (expand-file-name (or directory default-directory)))
> >> + (backend (or backend (vc-guess-backend remote)))
> >> + (directory (if backend
> >> + (progn
> >> + (unless (memq backend vc-handled-backends)
> >> + (error "Unknown VC backend %s" backend))
> >> + (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 rev)))
> >> + (throw 'ok res))))))))
> >> + (when (file-directory-p directory)
> >
> > When is this not true?
>
>
> When calling interactively, we can choose a path to a directory that
> does not exist, then if the clone operation fails, a path that is not a
> directory will be returned. If the cloning operation succeeds, it will
> be true. This also applies if the directory already exists.
>
> >
> >> + (if (or find-file (called-interactively-p 'interactive))
> >> + (find-file directory)
> >> + directory))))
> >>
> >> (declare-function log-view-current-tag "log-view" (&optional pos))
> >> (defun vc-default-last-change (_backend file line)
> >> --
> >> 2.46.0
>
> V4 patches:
Thanks.
Dmitry, any comments, or should I install this?
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-12 12:06 ` Eli Zaretskii
@ 2024-10-24 10:19 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-24 10:43 ` Philip Kaludercic
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-10-24 10:19 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: Dmitry Gutov, philipk, 73357
On 2024-10-12 15:06, Eli Zaretskii wrote:
>> From: Aleksandr Vityazev <avityazev@disroot.org>
>> Cc: Eli Zaretskii <eliz@gnu.org>, 73357@debbugs.gnu.org
>> Date: Sun, 06 Oct 2024 17:50:54 +0300
>>
>> On 2024-10-01 11:09, Philip Kaludercic wrote:
>>
>> > Aleksandr Vityazev <avityazev@disroot.org> writes:
>> >
>> >
>> > [...]
>> >
>> >>>> + (if backend
>> >>>> + (progn
>> >>>> + (unless (memq backend vc-handled-backends)
>> >>>> + (error "Unknown VC backend %s" backend))
>> >>>> + (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 rev)))
>> >>>> + (throw 'ok res)))))))
>> >>>> + (when (file-directory-p directory)
>> >>>> + (if (called-interactively-p 'interactive)
>> >>>
>> >>> Perhaps we can add a FIND-FILE argument to the end, so that it is also
>> >>> possible to open the directory from a script as well.
>> >>
>> >> might be useful, added and documented in doc string.
>> >>
>> >>>
>> >>>> + (find-file directory)
>> >>>> + directory))))
>> >>>
>> >>> I'd always return `directory', that seems simpler.
>> >>
>> >> Simpler, but it seems logical to switch to a directory when using it
>> >> interactively. I left it as it was.
>> >
>> > What I meant was to write
>> >
>> > (defun vc-clone (... &optional ... open-dir)
>> > (interactive (list ... t))
>> > ...
>> > (when open-dir
>> > (dired directory))
>> > directory)
>> >
>> > instead of
>> >
>> > (defun vc-clone (... &optional ... open-dir)
>> > (interactive (list ... t))
>> > ...
>> > (if open-dir
>> > (dired directory)
>> > directory))
>> >
>> > The advantage is that you can still request the directory to be opened
>> > when invoked non-interactively, you avoid the ambiguity of
>> > `called-interactively-p' and the return value is always of the same
>> > type, and not sometimes whatever `find-file'/`dired' returns.
>> >
>> >>>
>> >>>>
>> >>>> (declare-function log-view-current-tag "log-view" (&optional pos))
>> >>>> (defun vc-default-last-change (_backend file line)
>> >>>> --
>> >>>> 2.46.0
>> >>
>> >> V3 patch:
>> >>
>> >> From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001
>> >> Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org>
>> >> From: Aleksandr Vityazev <avityazev@disroot.org>
>> >> Date: Sun, 29 Sep 2024 21:13:28 +0300
>> >> Subject: [PATCH] Make vc-clone interactive
>> >>
>> >> * lisp/vc/vc.el (vc-clone): Make interactive. Add optional
>> >> argument FIND-FILE. Mention these changes in the doc string.
>> >> (vc--remotes-history): New defvar.
>> >> * lisp/emacs-lisp/package-vc (package-vc--backend-type,
>> >> package-vc-heuristic-alist, package-vc--guess-backend):
>> >> Rename and move to ...
>> >> (package-vc-default-backend): Set type to vc-backend-type.
>> >> (package-vc--clone, package-vc--read-package-name, package-vc-install,
>> >> package-vc-checkout): Use vc-guess-backend.
>> >> * lisp/vc/vc (vc-backend-type, vc-heuristic-alist, vc-guess-backend):
>> >> ... here.
>> >> * etc/NEWS: Announce these changes.
>> >
>> > I think it would cleaner if we split this up into two commits:
>> >
>> > 1. Moving `package-vc-heuristic-alist',
>> > 2. Making `vc-clone' interactive.
>> >
>>
>> done
>>
>> >> ---
>> >> etc/NEWS | 12 ++++
>> >> lisp/emacs-lisp/package-vc.el | 75 ++--------------------
>> >> lisp/vc/vc.el | 115 +++++++++++++++++++++++++++++-----
>> >> 3 files changed, 118 insertions(+), 84 deletions(-)
>> >>
>> >> diff --git a/etc/NEWS b/etc/NEWS
>> >> index aaf3783f006..3722e12c01d 100644
>> >> --- a/etc/NEWS
>> >> +++ b/etc/NEWS
>> >> @@ -444,6 +444,18 @@ toggle.
>> >> Putting (require 'midnight) in your init file no longer activates the
>> >> mode. Now, one needs to say (midnight-mode +1) instead.
>> >>
>> >> +** VC
>> >> +
>> >> +*** 'vc-clone' is now an interactive command.
>> >> +When called interactively, 'vc-clone' now prompts for the remote
>> >> +repository address, the backend for cloning, if it has not been
>> >> +determined automatically according to the URL, and the directory to
>> >> +clone the repository into.
>> >> +
>> >> +*** 'vc-clone' now accepts an optional argument FIND-FILE.
>> >> +When the argument is non-nil, the function switches to a buffer visiting
>> >> +directory to which the repository was cloned.
>> >> +
>> >> \f
>> >> * New Modes and Packages in Emacs 31.1
>> >>
>> >> diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
>> >> index e168096e153..82b450368d0 100644
>> >> --- a/lisp/emacs-lisp/package-vc.el
>> >> +++ b/lisp/emacs-lisp/package-vc.el
>> >> @@ -63,62 +63,6 @@ package-vc
>> >> (defconst package-vc--elpa-packages-version 1
>> >> "Version number of the package specification format understood by package-vc.")
>> >>
>> >> -(defconst package-vc--backend-type
>> >> - `(choice :convert-widget
>> >> - ,(lambda (widget)
>> >> - (let (opts)
>> >> - (dolist (be vc-handled-backends)
>> >> - (when (or (vc-find-backend-function be 'clone)
>> >> - (alist-get 'clone (get be 'vc-functions)))
>> >> - (push (widget-convert (list 'const be)) opts)))
>> >> - (widget-put widget :args opts))
>> >> - widget))
>> >> - "The type of VC backends that support cloning package VCS repositories.")
>> >> -
>> >> -(defcustom package-vc-heuristic-alist
>> >> - `((,(rx bos "http" (? "s") "://"
>> >> - (or (: (? "www.") "github.com"
>> >> - "/" (+ (or alnum "-" "." "_"))
>> >> - "/" (+ (or alnum "-" "." "_")))
>> >> - (: "codeberg.org"
>> >> - "/" (+ (or alnum "-" "." "_"))
>> >> - "/" (+ (or alnum "-" "." "_")))
>> >> - (: (? "www.") "gitlab" (+ "." (+ alnum))
>> >> - "/" (+ (or alnum "-" "." "_"))
>> >> - "/" (+ (or alnum "-" "." "_")))
>> >> - (: "git.sr.ht"
>> >> - "/~" (+ (or alnum "-" "." "_"))
>> >> - "/" (+ (or alnum "-" "." "_")))
>> >> - (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
>> >> - (or "r" "git") "/"
>> >> - (+ (or alnum "-" "." "_")) (? "/")))
>> >> - (or (? "/") ".git") eos)
>> >> - . Git)
>> >> - (,(rx bos "http" (? "s") "://"
>> >> - (or (: "hg.sr.ht"
>> >> - "/~" (+ (or alnum "-" "." "_"))
>> >> - "/" (+ (or alnum "-" "." "_")))
>> >> - (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
>> >> - (+ (or alnum "-" "." "_")) (? "/")))
>> >> - eos)
>> >> - . Hg)
>> >> - (,(rx bos "http" (? "s") "://"
>> >> - (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
>> >> - (+ (or alnum "-" "." "_")) (? "/")))
>> >> - eos)
>> >> - . Bzr))
>> >> - "Alist mapping repository URLs to VC backends.
>> >> -`package-vc-install' consults this alist to determine the VC
>> >> -backend from the repository URL when you call it without
>> >> -specifying a backend. Each element of the alist has the form
>> >> -\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
>> >> -the first association for which the URL of the repository matches
>> >> -the URL-REGEXP of the association. If no match is found,
>> >> -`package-vc-install' uses `package-vc-default-backend' instead."
>> >> - :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
>> >> - :value-type ,package-vc--backend-type)
>> >> - :version "29.1")
>> >> -
>> >
>> > This should certainly be replaced by a
>> > `define-obsolete-variable-alias'!
>>
>> Fixed
>> >
>> >> (defcustom package-vc-default-backend 'Git
>> >> "Default VC backend to use for cloning package repositories.
>> >> `package-vc-install' uses this backend when you specify neither
>> >> @@ -127,7 +71,7 @@ package-vc-default-backend
>> >>
>> >> The value must be a member of `vc-handled-backends' that supports
>> >> the `clone' VC function."
>> >> - :type package-vc--backend-type
>> >> + :type vc-backend-type
>> >> :version "29.1")
>> >>
>> >> (defcustom package-vc-register-as-project t
>> >> @@ -626,13 +570,6 @@ package-vc--unpack-1
>> >> "")))
>> >> t))
>> >>
>> >> -(defun package-vc--guess-backend (url)
>> >> - "Guess the VC backend for URL.
>> >> -This function will internally query `package-vc-heuristic-alist'
>> >> -and return nil if it cannot reasonably guess."
>> >> - (and url (alist-get url package-vc-heuristic-alist
>> >> - nil nil #'string-match-p)))
>> >> -
>> >> (declare-function project-remember-projects-under "project" (dir &optional recursive))
>> >>
>> >> (defun package-vc--clone (pkg-desc pkg-spec dir rev)
>> >> @@ -646,7 +583,7 @@ package-vc--clone
>> >> (unless (file-exists-p dir)
>> >> (make-directory (file-name-directory dir) t)
>> >> (let ((backend (or (plist-get pkg-spec :vc-backend)
>> >> - (package-vc--guess-backend url)
>> >> + (vc-guess-backend url)
>> >> (plist-get (alist-get (package-desc-archive pkg-desc)
>> >> package-vc--archive-data-alist
>> >> nil nil #'string=)
>> >> @@ -753,7 +690,7 @@ package-vc--read-package-name
>> >> ;; pointing towards a repository, and use that as a backup
>> >> (and-let* ((extras (package-desc-extras (cadr pkg)))
>> >> (url (alist-get :url extras))
>> >> - ((package-vc--guess-backend url)))))))
>> >> + ((vc-guess-backend url)))))))
>> >> (not allow-url)))
>> >>
>> >> (defun package-vc--read-package-desc (prompt &optional installed)
>> >> @@ -917,7 +854,7 @@ package-vc-install
>> >> (cdr package)
>> >> rev))
>> >> ((and-let* (((stringp package))
>> >> - (backend (or backend (package-vc--guess-backend package))))
>> >> + (backend (or backend (vc-guess-backend package))))
>> >> (package-vc--unpack
>> >> (package-desc-create
>> >> :name (or name (intern (file-name-base package)))
>> >> @@ -930,7 +867,7 @@ package-vc-install
>> >> (or (package-vc--desc->spec (cadr desc))
>> >> (and-let* ((extras (package-desc-extras (cadr desc)))
>> >> (url (alist-get :url extras))
>> >> - (backend (package-vc--guess-backend url)))
>> >> + (backend (vc-guess-backend url)))
>> >> (list :vc-backend backend :url url))
>> >> (user-error "Package `%s' has no VC data" package))
>> >> rev)))
>> >> @@ -958,7 +895,7 @@ package-vc-checkout
>> >> (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
>> >> (and-let* ((extras (package-desc-extras pkg-desc))
>> >> (url (alist-get :url extras))
>> >> - (backend (package-vc--guess-backend url)))
>> >> + (backend (vc-guess-backend url)))
>> >> (list :vc-backend backend :url url))
>> >> (user-error "Package `%s' has no VC data"
>> >> (package-desc-name pkg-desc)))))
>> >> diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
>> >> index 597a1622f5a..cd877bd8097 100644
>> >> --- a/lisp/vc/vc.el
>> >> +++ b/lisp/vc/vc.el
>> >> @@ -929,7 +929,69 @@ vc-find-revision-no-save
>> >> :type 'boolean
>> >> :version "27.1")
>> >>
>> >> +(defconst vc-backend-type
>> >> + `(choice :convert-widget
>> >> + ,(lambda (widget)
>> >> + (let (opts)
>> >> + (dolist (be vc-handled-backends)
>> >> + (when (or (vc-find-backend-function be 'clone)
>> >> + (alist-get 'clone (get be 'vc-functions)))
>> >> + (push (widget-convert (list 'const be)) opts)))
>> >> + (widget-put widget :args opts))
>> >> + widget))
>> >> + "The type of VC backends that support cloning VCS repositories.")
>> >> +
>> >> +(defcustom vc-heuristic-alist
>> >> + `((,(rx bos "http" (? "s") "://"
>> >> + (or (: (? "www.") "github.com"
>> >> + "/" (+ (or alnum "-" "." "_"))
>> >> + "/" (+ (or alnum "-" "." "_")))
>> >> + (: "codeberg.org"
>> >> + "/" (+ (or alnum "-" "." "_"))
>> >> + "/" (+ (or alnum "-" "." "_")))
>> >> + (: (? "www.") "gitlab" (+ "." (+ alnum))
>> >> + "/" (+ (or alnum "-" "." "_"))
>> >> + "/" (+ (or alnum "-" "." "_")))
>> >> + (: "git.sr.ht"
>> >> + "/~" (+ (or alnum "-" "." "_"))
>> >> + "/" (+ (or alnum "-" "." "_")))
>> >> + (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
>> >> + (or "r" "git") "/"
>> >> + (+ (or alnum "-" "." "_")) (? "/")))
>> >> + (or (? "/") ".git") eos)
>> >> + . Git)
>> >> + (,(rx bos "http" (? "s") "://"
>> >> + (or (: "hg.sr.ht"
>> >> + "/~" (+ (or alnum "-" "." "_"))
>> >> + "/" (+ (or alnum "-" "." "_")))
>> >> + (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
>> >> + (+ (or alnum "-" "." "_")) (? "/")))
>> >> + eos)
>> >> + . Hg)
>> >> + (,(rx bos "http" (? "s") "://"
>> >> + (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
>> >> + (+ (or alnum "-" "." "_")) (? "/")))
>> >> + eos)
>> >> + . Bzr))
>> >> + "Alist mapping repository URLs to VC backends.
>> >> +`vc-clone' consults this alist to determine the VC
>> >> +backend from the repository URL when you call it without
>> >> +specifying a backend. Each element of the alist has the form
>> >> +\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
>> >> +the first association for which the URL of the repository matches
>> >> +the URL-REGEXP of the association."
>> >> + :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
>> >> + :value-type ,vc-backend-type)
>> >> + :version "29.1")
>> >> +
>> >> \f
>> >> +(defun vc-guess-backend (url)
>> >> + "Guess the VC backend for URL.
>> >> +This function will internally query `vc-heuristic-alist'
>> >> +and return nil if it cannot reasonably guess."
>> >> + (and url (alist-get url vc-heuristic-alist
>> >> + nil nil #'string-match-p)))
>> >> +
>> >> ;; File property caching
>> >>
>> >> (defun vc-clear-context ()
>> >> @@ -3804,7 +3866,9 @@ vc-check-headers
>> >> (interactive)
>> >> (vc-call-backend (vc-backend buffer-file-name) 'check-headers))
>> >>
>> >> -(defun vc-clone (remote &optional backend directory rev)
>> >> +(defvar vc--remotes-history)
>> >> +
>> >> +(defun vc-clone (remote &optional backend directory rev find-file)
>> >> "Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
>> >> If successful, return the string with the directory of the checkout;
>> >> otherwise return nil.
>> >> @@ -3814,20 +3878,41 @@ vc-clone
>> >> If BACKEND is nil or omitted, the function iterates through every known
>> >> backend in `vc-handled-backends' until one succeeds to clone REMOTE.
>> >> If REV is non-nil, it indicates a specific revision to check out after
>> >> -cloning; the syntax of REV depends on what BACKEND accepts."
>> >> - (setq directory (expand-file-name (or 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 rev))
>> >> - (catch 'ok
>> >> - (dolist (backend vc-handled-backends)
>> >> - (ignore-error vc-not-supported
>> >> - (when-let ((res (vc-call-backend
>> >> - backend 'clone
>> >> - remote directory rev)))
>> >> - (throw 'ok res)))))))
>> >> +cloning; the syntax of REV depends on what BACKEND accepts.
>> >> +If FIND-FILE is non-nil, switches to a buffer visiting DIRECTORY to
>> >> +which the repository was cloned. It would be useful in scripts, but not
>> >> +in regular code.
>> >> +If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
>> >> +if BACKEND has not been automatically determined according to the REMOTE
>> >> +URL, in the minibuffer."
>> >> + (interactive
>> >> + (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
>> >> + (backend (or (vc-guess-backend url)
>> >> + (intern (completing-read
>> >> + "Backend: " vc-handled-backends nil t)))))
>> >> + (list url backend
>> >> + (read-directory-name
>> >> + "Clone into new or empty directory: " nil nil
>> >> + (lambda (dir) (or (not (file-exists-p dir))
>> >> + (directory-empty-p dir)))))))
>> >> + (let* ((directory (expand-file-name (or directory default-directory)))
>> >> + (backend (or backend (vc-guess-backend remote)))
>> >> + (directory (if backend
>> >> + (progn
>> >> + (unless (memq backend vc-handled-backends)
>> >> + (error "Unknown VC backend %s" backend))
>> >> + (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 rev)))
>> >> + (throw 'ok res))))))))
>> >> + (when (file-directory-p directory)
>> >
>> > When is this not true?
>>
>>
>> When calling interactively, we can choose a path to a directory that
>> does not exist, then if the clone operation fails, a path that is not a
>> directory will be returned. If the cloning operation succeeds, it will
>> be true. This also applies if the directory already exists.
>>
>> >
>> >> + (if (or find-file (called-interactively-p 'interactive))
>> >> + (find-file directory)
>> >> + directory))))
>> >>
>> >> (declare-function log-view-current-tag "log-view" (&optional pos))
>> >> (defun vc-default-last-change (_backend file line)
>> >> --
>> >> 2.46.0
>>
>> V4 patches:
>
> Thanks.
>
> Dmitry, any comments, or should I install this?
Just a gentle ping, any news on this bug?
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-24 10:19 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-10-24 10:43 ` Philip Kaludercic
2024-10-24 11:26 ` Sean Whitton
0 siblings, 1 reply; 14+ messages in thread
From: Philip Kaludercic @ 2024-10-24 10:43 UTC (permalink / raw)
To: Aleksandr Vityazev; +Cc: Dmitry Gutov, Eli Zaretskii, 73357
Aleksandr Vityazev <avityazev@disroot.org> writes:
[...]
>>> V4 patches:
>>
>> Thanks.
>>
>> Dmitry, any comments, or should I install this?
>
> Just a gentle ping, any news on this bug?
FWIW as the vc-clone author, I think we can apply it, but Dmitry is the
VC maintainer so he should have the last word.
--
Philip Kaludercic on icterid
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-24 10:43 ` Philip Kaludercic
@ 2024-10-24 11:26 ` Sean Whitton
2024-10-24 12:31 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 14+ messages in thread
From: Sean Whitton @ 2024-10-24 11:26 UTC (permalink / raw)
To: Philip Kaludercic, Aleksandr Vityazev; +Cc: Dmitry Gutov, Eli Zaretskii, 73357
Hello,
On Thu 24 Oct 2024 at 10:43am GMT, Philip Kaludercic wrote:
> Aleksandr Vityazev <avityazev@disroot.org> writes:
>
> [...]
>
>>>> V4 patches:
>>>
>>> Thanks.
>>>
>>> Dmitry, any comments, or should I install this?
>>
>> Just a gentle ping, any news on this bug?
>
> FWIW as the vc-clone author, I think we can apply it, but Dmitry is the
> VC maintainer so he should have the last word.
I'm the new VC maintainer.
Aleksandr, thank you for this. Some comments on v4:
- The commit message of the first patch doesn't completely follow the
guidelines in CONTRIBUTE. I think M-q will fix it.
- I also find the ... thing hard to read because it's separated by
other changes. Would you mind just writing out the changes twice?
- vc-heuristic-alist should probaby have ':version 31.1'
- Inserting vc-guess-backend right at the top doesn't seem right. There
is already a section "Code for deducing what fileset and backend to
assume".
- I think that vc-guess-backend should be called vc-guess-url-backend or
similar. 'vc-guess-backend' is too generic.
- I'm not really convinced by the OPEN-DIR argument. You specifically
say that it's for scripting purposes, but then, the script can just
call find-file :) Is there some reason why it's better as an
argument?
--
Sean Whitton
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-24 11:26 ` Sean Whitton
@ 2024-10-24 12:31 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-24 13:45 ` Sean Whitton
0 siblings, 1 reply; 14+ messages in thread
From: Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-10-24 12:31 UTC (permalink / raw)
To: Sean Whitton; +Cc: Dmitry Gutov, Philip Kaludercic, Eli Zaretskii, 73357
[-- Attachment #1: Type: text/plain, Size: 1836 bytes --]
On 2024-10-24 19:26, Sean Whitton wrote:
Hello,
> Hello,
>
> On Thu 24 Oct 2024 at 10:43am GMT, Philip Kaludercic wrote:
>
>> Aleksandr Vityazev <avityazev@disroot.org> writes:
>>
>> [...]
>>
>>>>> V4 patches:
>>>>
>>>> Thanks.
>>>>
>>>> Dmitry, any comments, or should I install this?
>>>
>>> Just a gentle ping, any news on this bug?
>>
>> FWIW as the vc-clone author, I think we can apply it, but Dmitry is the
>> VC maintainer so he should have the last word.
>
> I'm the new VC maintainer.
>
> Aleksandr, thank you for this. Some comments on v4:
>
> - The commit message of the first patch doesn't completely follow the
> guidelines in CONTRIBUTE. I think M-q will fix it.
fixed
> - I also find the ... thing hard to read because it's separated by
> other changes. Would you mind just writing out the changes twice?
fixed
> - vc-heuristic-alist should probaby have ':version 31.1'
fixed
> - Inserting vc-guess-backend right at the top doesn't seem right. There
> is already a section "Code for deducing what fileset and backend to
> assume".
Moved to suggested section
> - I think that vc-guess-backend should be called vc-guess-url-backend or
> similar. 'vc-guess-backend' is too generic.
Renamed to vc-guess-url-backend
> - I'm not really convinced by the OPEN-DIR argument. You specifically
> say that it's for scripting purposes, but then, the script can just
> call find-file :) Is there some reason why it's better as an
> argument?
I don't have a strong opinion on this. I originally proposed this:
(when (file-directory-p directory)
(if (called-interactively-p 'interactive)
(find-file directory)
directory))
The OPEN-DIR argument was suggested by Philip, and I agreed with him,
since the option is also good. I'm fine with both options, I'll do as
you say.
V5 patches:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Move package-vc-heuristic-alist and related to vc.el --]
[-- Type: text/x-patch, Size: 10640 bytes --]
From 7072d2002a4b0852ba6d133f1f4728fc7d25ccc6 Mon Sep 17 00:00:00 2001
Message-ID: <7072d2002a4b0852ba6d133f1f4728fc7d25ccc6.1729772961.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Thu, 24 Oct 2024 15:11:44 +0300
Subject: [PATCH] Move package-vc-heuristic-alist and related to vc.el
* lisp/emacs-lisp/package-vc (package-vc--backend-type)
(package-vc-heuristic-alist, package-vc--guess-backend): Rename
to vc-backend-type, vc-heuristic-alist, vc-guess-backend
accordingly and move into lisp/vc/vc.el.
(package-vc-heuristic-alist): Make obsolete.
(package-vc-default-backend): Set type to vc-backend-type.
(package-vc--clone, package-vc--read-package-name)
(package-vc-install, package-vc-checkout): Use vc-guess-backend.
* lisp/vc/vc (vc-backend-type, vc-heuristic-alist)
(vc-guess-backend): New defconst, defcustom and defun
accordingly. Rename and move here from
lisp/emacs-lisp/package-vc.el.
---
lisp/emacs-lisp/package-vc.el | 77 ++++-------------------------------
lisp/vc/vc.el | 62 ++++++++++++++++++++++++++++
2 files changed, 71 insertions(+), 68 deletions(-)
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 894bc9c8c37..6ea55c1baef 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -63,61 +63,9 @@ package-vc
(defconst package-vc--elpa-packages-version 1
"Version number of the package specification format understood by package-vc.")
-(defconst package-vc--backend-type
- `(choice :convert-widget
- ,(lambda (widget)
- (let (opts)
- (dolist (be vc-handled-backends)
- (when (or (vc-find-backend-function be 'clone)
- (alist-get 'clone (get be 'vc-functions)))
- (push (widget-convert (list 'const be)) opts)))
- (widget-put widget :args opts))
- widget))
- "The type of VC backends that support cloning package VCS repositories.")
-
-(defcustom package-vc-heuristic-alist
- `((,(rx bos "http" (? "s") "://"
- (or (: (? "www.") "github.com"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "codeberg.org"
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: (? "www.") "gitlab" (+ "." (+ alnum))
- "/" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
- (or "r" "git") "/"
- (+ (or alnum "-" "." "_")) (? "/")))
- (or (? "/") ".git") eos)
- . Git)
- (,(rx bos "http" (? "s") "://"
- (or (: "hg.sr.ht"
- "/~" (+ (or alnum "-" "." "_"))
- "/" (+ (or alnum "-" "." "_")))
- (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Hg)
- (,(rx bos "http" (? "s") "://"
- (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
- (+ (or alnum "-" "." "_")) (? "/")))
- eos)
- . Bzr))
- "Alist mapping repository URLs to VC backends.
-`package-vc-install' consults this alist to determine the VC
-backend from the repository URL when you call it without
-specifying a backend. Each element of the alist has the form
-\(URL-REGEXP . BACKEND). `package-vc-install' will use BACKEND of
-the first association for which the URL of the repository matches
-the URL-REGEXP of the association. If no match is found,
-`package-vc-install' uses `package-vc-default-backend' instead."
- :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
- :value-type ,package-vc--backend-type)
- :version "29.1")
+(define-obsolete-variable-alias
+ 'package-vc-heuristic-alist
+ 'vc-heuristic-alist "31.1")
(defcustom package-vc-default-backend 'Git
"Default VC backend to use for cloning package repositories.
@@ -127,7 +75,7 @@ package-vc-default-backend
The value must be a member of `vc-handled-backends' that supports
the `clone' VC function."
- :type package-vc--backend-type
+ :type vc-backend-type
:version "29.1")
(defcustom package-vc-register-as-project t
@@ -626,13 +574,6 @@ package-vc--unpack-1
"")))
t))
-(defun package-vc--guess-backend (url)
- "Guess the VC backend for URL.
-This function will internally query `package-vc-heuristic-alist'
-and return nil if it cannot reasonably guess."
- (and url (alist-get url package-vc-heuristic-alist
- nil nil #'string-match-p)))
-
(declare-function project-remember-projects-under "project" (dir &optional recursive))
(defun package-vc--clone (pkg-desc pkg-spec dir rev)
@@ -646,7 +587,7 @@ package-vc--clone
(unless (file-exists-p dir)
(make-directory (file-name-directory dir) t)
(let ((backend (or (plist-get pkg-spec :vc-backend)
- (package-vc--guess-backend url)
+ (vc-guess-url-backend url)
(plist-get (alist-get (package-desc-archive pkg-desc)
package-vc--archive-data-alist
nil nil #'string=)
@@ -753,7 +694,7 @@ package-vc--read-package-name
;; pointing towards a repository, and use that as a backup
(and-let* ((extras (package-desc-extras (cadr pkg)))
(url (alist-get :url extras))
- ((package-vc--guess-backend url)))))))
+ ((vc-guess-url-backend url)))))))
(not allow-url)))
(defun package-vc--read-package-desc (prompt &optional installed)
@@ -917,7 +858,7 @@ package-vc-install
(cdr package)
rev))
((and-let* (((stringp package))
- (backend (or backend (package-vc--guess-backend package))))
+ (backend (or backend (vc-guess-url-backend package))))
(package-vc--unpack
(package-desc-create
:name (or name (intern (file-name-base package)))
@@ -930,7 +871,7 @@ package-vc-install
(or (package-vc--desc->spec (cadr desc))
(and-let* ((extras (package-desc-extras (cadr desc)))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-url-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data" package))
rev)))
@@ -958,7 +899,7 @@ package-vc-checkout
(let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
(and-let* ((extras (package-desc-extras pkg-desc))
(url (alist-get :url extras))
- (backend (package-vc--guess-backend url)))
+ (backend (vc-guess-url-backend url)))
(list :vc-backend backend :url url))
(user-error "Package `%s' has no VC data"
(package-desc-name pkg-desc)))))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 6498b8522fd..8a8eb6fcfc7 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -944,6 +944,61 @@ vc-allow-rewriting-published-history
(const :tag "Allow without prompting" t))
:version "31.1")
+(defconst vc-backend-type
+ `(choice :convert-widget
+ ,(lambda (widget)
+ (let (opts)
+ (dolist (be vc-handled-backends)
+ (when (or (vc-find-backend-function be 'clone)
+ (alist-get 'clone (get be 'vc-functions)))
+ (push (widget-convert (list 'const be)) opts)))
+ (widget-put widget :args opts))
+ widget))
+ "The type of VC backends that support cloning VCS repositories.")
+
+(defcustom vc-heuristic-alist
+ `((,(rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
+ (or "r" "git") "/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ (or (? "/") ".git") eos)
+ . Git)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "hg.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Hg)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Bzr))
+ "Alist mapping repository URLs to VC backends.
+`vc-clone' consults this alist to determine the VC
+backend from the repository URL when you call it without
+specifying a backend. Each element of the alist has the form
+\(URL-REGEXP . BACKEND). `vc-clone' will use BACKEND of
+the first association for which the URL of the repository matches
+the URL-REGEXP of the association."
+ :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
+ :value-type ,vc-backend-type)
+ :version "31.1")
+
\f
;; File property caching
@@ -1033,6 +1088,13 @@ vc-backend-for-registration
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
+(defun vc-guess-url-backend (url)
+ "Guess the VC backend for URL.
+This function will internally query `vc-heuristic-alist'
+and return nil if it cannot reasonably guess."
+ (and url (alist-get url vc-heuristic-alist
+ nil nil #'string-match-p)))
+
;;;###autoload
(defun vc-responsible-backend (file &optional no-error)
"Return the name of a backend system that is responsible for FILE.
--
2.46.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: [PATCH] Make vc-clone interactive --]
[-- Type: text/x-patch, Size: 4787 bytes --]
From a64134c73086f5067d1f360dad0ab48267750fd1 Mon Sep 17 00:00:00 2001
Message-ID: <a64134c73086f5067d1f360dad0ab48267750fd1.1729772961.git.avityazev@disroot.org>
From: Aleksandr Vityazev <avityazev@disroot.org>
Date: Thu, 24 Oct 2024 15:19:34 +0300
Subject: [PATCH] Make vc-clone interactive
* lisp/vc/vc.el (vc-clone): Make interactive. Add optional
argument OPEN-DIR. Mention these changes in the doc string.
(vc--remotes-history): New defvar.
* etc/NEWS: Announce these changes.
---
etc/NEWS | 10 ++++++++++
lisp/vc/vc.el | 54 +++++++++++++++++++++++++++++++++++++--------------
2 files changed, 49 insertions(+), 15 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 64e4f22b9d3..12053fffc57 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -614,6 +614,16 @@ even though Emacs thinks it is dangerous.
So far, this applies only to using 'e' from Log View mode for Git.
+*** 'vc-clone' is now an interactive command.
+When called interactively, 'vc-clone' now prompts for the remote
+repository address, the backend for cloning, if it has not been
+determined automatically according to the URL, and the directory to
+clone the repository into.
+
+*** 'vc-clone' now accepts an optional argument OPEN-DIR.
+When the argument is non-nil, the function switches to a buffer visiting
+directory to which the repository was cloned.
+
\f
* New Modes and Packages in Emacs 31.1
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 8a8eb6fcfc7..975f7f40b15 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3876,7 +3876,9 @@ vc-check-headers
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
-(defun vc-clone (remote &optional backend directory rev)
+(defvar vc--remotes-history)
+
+(defun vc-clone (remote &optional backend directory rev open-dir)
"Clone repository REMOTE using version-control BACKEND, into DIRECTORY.
If successful, return the string with the directory of the checkout;
otherwise return nil.
@@ -3886,20 +3888,42 @@ vc-clone
If BACKEND is nil or omitted, the function iterates through every known
backend in `vc-handled-backends' until one succeeds to clone REMOTE.
If REV is non-nil, it indicates a specific revision to check out after
-cloning; the syntax of REV depends on what BACKEND accepts."
- (setq directory (expand-file-name (or 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 rev))
- (catch 'ok
- (dolist (backend vc-handled-backends)
- (ignore-error vc-not-supported
- (when-let* ((res (vc-call-backend
- backend 'clone
- remote directory rev)))
- (throw 'ok res)))))))
+cloning; the syntax of REV depends on what BACKEND accepts.
+If OPEN-DIR is non-nil, switches to a buffer visiting DIRECTORY to
+which the repository was cloned. It would be useful in scripts, but not
+in regular code.
+If called interactively, prompt for REMOTE, DIRECTORY and BACKEND,
+if BACKEND has not been automatically determined according to the REMOTE
+URL, in the minibuffer."
+ (interactive
+ (let* ((url (read-string "Remote: " nil 'vc--remotes-history))
+ (backend (or (vc-guess-url-backend url)
+ (intern (completing-read
+ "Backend: " vc-handled-backends nil t)))))
+ (list url backend
+ (read-directory-name
+ "Clone into new or empty directory: " nil nil
+ (lambda (dir) (or (not (file-exists-p dir))
+ (directory-empty-p dir))))
+ nil t)))
+ (let* ((directory (expand-file-name (or directory default-directory)))
+ (backend (or backend (vc-guess-url-backend remote)))
+ (directory (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (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 rev)))
+ (throw 'ok res))))))))
+ (when (file-directory-p directory)
+ (when open-dir
+ (find-file directory))
+ directory)))
(declare-function log-view-current-tag "log-view" (&optional pos))
(defun vc-default-last-change (_backend file line)
--
2.46.0
[-- Attachment #4: Type: text/plain, Size: 38 bytes --]
--
Best regards,
Aleksandr Vityazev
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-24 12:31 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-10-24 13:45 ` Sean Whitton
2024-10-24 14:19 ` Philip Kaludercic
0 siblings, 1 reply; 14+ messages in thread
From: Sean Whitton @ 2024-10-24 13:45 UTC (permalink / raw)
To: Aleksandr Vityazev
Cc: Dmitry Gutov, Philip Kaludercic, Eli Zaretskii, 73357-done
Hello,
On Thu 24 Oct 2024 at 03:31pm +03, Aleksandr Vityazev wrote:
> I don't have a strong opinion on this. I originally proposed this:
>
> (when (file-directory-p directory)
> (if (called-interactively-p 'interactive)
> (find-file directory)
> directory))
>
> The OPEN-DIR argument was suggested by Philip, and I agreed with him,
> since the option is also good. I'm fine with both options, I'll do as
> you say.
Sorry, I misread the code, ignore my comment here.
> V5 patches:
Installed, thanks.
I renamed vc-backend-type and vc-heuristic-alist to less generic names.
I also realised that vc-clone now can call vc-guess-url-backend even
when noninteractive, and it always returns DIRECTORY which it didn't
before, so I updated the commit message accordingly.
--
Sean Whitton
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#73357: [PATCH] Make vc-clone interactive
2024-10-24 13:45 ` Sean Whitton
@ 2024-10-24 14:19 ` Philip Kaludercic
0 siblings, 0 replies; 14+ messages in thread
From: Philip Kaludercic @ 2024-10-24 14:19 UTC (permalink / raw)
To: Sean Whitton; +Cc: Dmitry Gutov, Eli Zaretskii, 73357-done, Aleksandr Vityazev
Sean Whitton <spwhitton@spwhitton.name> writes:
> Hello,
>
> On Thu 24 Oct 2024 at 03:31pm +03, Aleksandr Vityazev wrote:
>
>> I don't have a strong opinion on this. I originally proposed this:
>>
>> (when (file-directory-p directory)
>> (if (called-interactively-p 'interactive)
>> (find-file directory)
>> directory))
>>
>> The OPEN-DIR argument was suggested by Philip, and I agreed with him,
>> since the option is also good. I'm fine with both options, I'll do as
>> you say.
>
> Sorry, I misread the code, ignore my comment here.
>
>> V5 patches:
>
> Installed, thanks.
>
> I renamed vc-backend-type and vc-heuristic-alist to less generic names.
>
> I also realised that vc-clone now can call vc-guess-url-backend even
> when noninteractive, and it always returns DIRECTORY which it didn't
> before, so I updated the commit message accordingly.
This is important, as package-vc calls vc-clone non-interactively.
--
Philip Kaludercic on siskin
^ permalink raw reply [flat|nested] 14+ messages in thread
end of thread, other threads:[~2024-10-24 14:19 UTC | newest]
Thread overview: 14+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-09-19 13:18 bug#73357: [PATCH] Make vc-clone interactive Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-09-19 13:36 ` Eli Zaretskii
2024-09-19 16:38 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-09-24 10:22 ` Philip Kaludercic
2024-09-29 18:23 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-01 11:09 ` Philip Kaludercic
2024-10-06 14:50 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-12 12:06 ` Eli Zaretskii
2024-10-24 10:19 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-24 10:43 ` Philip Kaludercic
2024-10-24 11:26 ` Sean Whitton
2024-10-24 12:31 ` Aleksandr Vityazev via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-10-24 13:45 ` Sean Whitton
2024-10-24 14:19 ` Philip Kaludercic
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).