From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 19 Sep 2024 13:19:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: 73357@debbugs.gnu.org X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.172675193425345 (code B ref -1); Thu, 19 Sep 2024 13:19:01 +0000 Received: (at submit) by debbugs.gnu.org; 19 Sep 2024 13:18:54 +0000 Received: from localhost ([127.0.0.1]:60051 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srH3d-0006ai-KR for submit@debbugs.gnu.org; Thu, 19 Sep 2024 09:18:53 -0400 Received: from lists.gnu.org ([209.51.188.17]:52064) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srH3a-0006aa-PI for submit@debbugs.gnu.org; Thu, 19 Sep 2024 09:18:51 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1srH3I-0001RF-Hy for bug-gnu-emacs@gnu.org; Thu, 19 Sep 2024 09:18:32 -0400 Received: from layka.disroot.org ([178.21.23.139]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1srH3F-00023m-61 for bug-gnu-emacs@gnu.org; Thu, 19 Sep 2024 09:18:32 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id 4C80F203B8 for ; Thu, 19 Sep 2024 15:18:25 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id IB60tyztwGIP for ; Thu, 19 Sep 2024 15:18:24 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1726751904; bh=HnaePYTWo29Q8bUG9B70ORU9BnR0yQ5OgSy5JKQAv7M=; h=From:To:Subject:Date; b=WeVs9c3bvcczyvT3ZFxLJlvYNXDJhRC8Zlxsn7IvznFtwsb/L/aQTzqJwGALMWgnN STv5TaKMw6G6Ara1x+hm8s96vPzdvTd8WNdHepVrYZFewTy5NCUCp9p3/4EDLzW3TD l6PHGWBkLd74GQV4KYOiU1oYG6iYFkj2hPJyCOg5p0Zq1IvBRVZgtuu2j7u17hqytT QsdwZdm8xazBOcQ3WCjAWMQOJpCz0Dkr/yzFRq23tNW9Zgcz4RGL4jXa5sP/mpx+LH WTVmtpy7U8S0LccV32V1k0SkkKIX0epdY3NKfCxTIclym//OgfIVy/kxAq92SR3FVm RTVPBOLYDyeqw== From: Aleksandr Vityazev Date: Thu, 19 Sep 2024 16:18:16 +0300 Message-ID: <875xqrlr3b.fsf@disroot.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=178.21.23.139; envelope-from=avityazev@disroot.org; helo=layka.disroot.org X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) --=-=-= Content-Type: text/plain Hi, Cloning is used quite often, so I would like to have an interactive command. A patch is attached to the email. WDYT? --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From 1fd3aa4b3afe4064bcc78787b99f4fa336e4031d Mon Sep 17 00:00:00 2001 Message-ID: <1fd3aa4b3afe4064bcc78787b99f4fa336e4031d.1726751543.git.avityazev@disroot.org> From: Aleksandr Vityazev 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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Eli Zaretskii Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 19 Sep 2024 13:37:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Aleksandr Vityazev Cc: 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172675300429865 (code B ref 73357); Thu, 19 Sep 2024 13:37:02 +0000 Received: (at 73357) by debbugs.gnu.org; 19 Sep 2024 13:36:44 +0000 Received: from localhost ([127.0.0.1]:60069 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srHKt-0007ld-F8 for submit@debbugs.gnu.org; Thu, 19 Sep 2024 09:36:43 -0400 Received: from eggs.gnu.org ([209.51.188.92]:51878) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srHKq-0007lM-Q7 for 73357@debbugs.gnu.org; Thu, 19 Sep 2024 09:36:42 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1srHKS-0004oZ-T7; Thu, 19 Sep 2024 09:36:16 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=pgejusYwEaAwSe3J6aIjECFv8EA7jNMZ1aB+k0mQte4=; b=ixZK2zlOhlyf tmpGGMz2vGNknBuc0gcNFhi7Pj41Ni0pf4hRJFtGnlg5gLm5uLD/mKO2DUG1pgv0C/f01zbjkDJ55 T4dOmwz2CMz9fYNMBLC5wE9ZWcvNCojdjy9FMDUhm/zNIA9FyVP83aIqyGU2uRh3bpg+tkPvCz/cS jG5g3/QyZiKmWKuRgVyIOGE7CH8gRtQaGr+djX2tWyg9lTjYOk+jNgD9/BmrAFPlf7aVIGctZQVEW QIjj7bNQ/uDa6Fi4bH+zohTiMjJ23s4EDHCUREmnlD70LfHF9hyb7Ur9PHJiy7l2dBa5NiBXCJrbM MPt9SFwOVI0Mg+jmmDOdKg==; Date: Thu, 19 Sep 2024 16:36:12 +0300 Message-Id: <86ploz935f.fsf@gnu.org> From: Eli Zaretskii In-Reply-To: <875xqrlr3b.fsf@disroot.org> (bug-gnu-emacs@gnu.org) References: <875xqrlr3b.fsf@disroot.org> X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > 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" > > 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? From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 19 Sep 2024 16:39:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Eli Zaretskii Cc: 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.17267639345751 (code B ref 73357); Thu, 19 Sep 2024 16:39:02 +0000 Received: (at 73357) by debbugs.gnu.org; 19 Sep 2024 16:38:54 +0000 Received: from localhost ([127.0.0.1]:33416 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srKBA-0001Ug-TI for submit@debbugs.gnu.org; Thu, 19 Sep 2024 12:38:54 -0400 Received: from layka.disroot.org ([178.21.23.139]:46036) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srKB8-0001UU-MU for 73357@debbugs.gnu.org; Thu, 19 Sep 2024 12:38:51 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id B8B8723E07; Thu, 19 Sep 2024 18:38:30 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id ZMsiiGqRkitu; Thu, 19 Sep 2024 18:38:30 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1726763910; bh=9xJC9zeo/SHxsxQ80ntdtonbXMBCEZyWC7YCwD5sucM=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=lPfCTIZ/Gx1OAxPhBYVcAelgob/fy6RdsE1X2h6Vd5y3mG4/BCFr1KelbnQ3xhuPg Qz3xwsgbjAsKpT7kvS2C2xQuyqAjaw+Ld5RGYIv+h6MxhH6Kjt6yRv0Cm8OWI1TdTs g4lyPCfp6IAXwYTl3b8IOP20WVR4qTC6OHWK7NVpxiiWi08k4yEQCOFOQ8Y0//G3S6 UMJdDDkaBRJ8OmBFJCxEy9c9wHAWCCr54b0O0kvzyLB5cl8mys8HPteSgVLTBwpOFJ rYKO5Ssa+tSp4spzMYScbEo9zeeTycoXB6Ljr3A0hsQJPDs1ipGWXhNuxhdw/Wsi0X nqVfYWd0kg2HA== From: Aleksandr Vityazev In-Reply-To: <86ploz935f.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 19 Sep 2024 16:36:12 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> Date: Thu, 19 Sep 2024 19:38:24 +0300 Message-ID: <87y13nk39b.fsf@disroot.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain 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" >> >> 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: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From b302b5c42e01fe0b6f7607128ed660babf55e35a Mon Sep 17 00:00:00 2001 Message-ID: From: Aleksandr Vityazev 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. + * 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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 24 Sep 2024 10:24:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Aleksandr Vityazev Cc: Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172717338730266 (code B ref 73357); Tue, 24 Sep 2024 10:24:02 +0000 Received: (at 73357) by debbugs.gnu.org; 24 Sep 2024 10:23:07 +0000 Received: from localhost ([127.0.0.1]:45367 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1st2hH-0007s3-22 for submit@debbugs.gnu.org; Tue, 24 Sep 2024 06:23:07 -0400 Received: from mout02.posteo.de ([185.67.36.66]:45493) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1st2hF-0007rR-3A for 73357@debbugs.gnu.org; Tue, 24 Sep 2024 06:23:06 -0400 Received: from submission (posteo.de [185.67.36.169]) by mout02.posteo.de (Postfix) with ESMTPS id E98F9240103 for <73357@debbugs.gnu.org>; Tue, 24 Sep 2024 12:22:33 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1727173353; bh=sJUp9bVoBLlu5xktUahoChc95DcLzpfr3pnlIEvQ5ak=; h=From:To:Cc:Subject:Autocrypt:OpenPGP:Date:Message-ID:MIME-Version: Content-Type:From; b=eEwV7j9MBMb+NBWTlR9rCrs+HXWK41ndPXfybKYqDD6SqfgUbXRCH4g1CRgKIEzPh T65DJG5D5Bz6fz5QvBx8x9QCYg5ww5v/VfAjpCCkrKxSnCvCG6f7f+ihUkqszqyvlq 9dgCDoZme7NUCqV9c8Zo2Ieqc3fhTbqwxDTxeF4Jlabc7phyc7dlXsoBYLu3PQV1N2 +NqBEMnH4L5YAyn3sxY1/oQrN6U8ECg/jYFHxCANEdn9X6q0AZBWvd9OKbtW7Rw8O9 GxzhcZl+kgfKj/IEJWDtCjPBj0vtkSv0boAIXzD9sWQav5+3w4RrwxwA2zsGEo/5jm EK8OFce11xf6Q== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4XCbX91JB5z9rxS; Tue, 24 Sep 2024 12:22:32 +0200 (CEST) From: Philip Kaludercic In-Reply-To: <87y13nk39b.fsf@disroot.org> (Aleksandr Vityazev's message of "Thu, 19 Sep 2024 19:38:24 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> Autocrypt: addr=philipk@posteo.net; keydata= mDMEZBBQQhYJKwYBBAHaRw8BAQdAHJuofBrfqFh12uQu0Yi7mrl525F28eTmwUDflFNmdui0QlBo aWxpcCBLYWx1ZGVyY2ljIChnZW5lcmF0ZWQgYnkgYXV0b2NyeXB0LmVsKSA8cGhpbGlwa0Bwb3N0 ZW8ubmV0PoiWBBMWCAA+FiEEDg7HY17ghYlni8XN8xYDWXahwukFAmQQUEICGwMFCQHhM4AFCwkI BwIGFQoJCAsCBBYCAwECHgECF4AACgkQ8xYDWXahwulikAEA77hloUiSrXgFkUVJhlKBpLCHUjA0 mWZ9j9w5d08+jVwBAK6c4iGP7j+/PhbkxaEKa4V3MzIl7zJkcNNjHCXmvFcEuDgEZBBQQhIKKwYB BAGXVQEFAQEHQI5NLiLRjZy3OfSt1dhCmFyn+fN/QKELUYQetiaoe+MMAwEIB4h+BBgWCAAmFiEE Dg7HY17ghYlni8XN8xYDWXahwukFAmQQUEICGwwFCQHhM4AACgkQ8xYDWXahwukm+wEA8cml4JpK NeAu65rg+auKrPOP6TP/4YWRCTIvuYDm0joBALw98AMz7/qMHvSCeU/hw9PL6u6R2EScxtpKnWof z4oM OpenPGP: id=philipk@posteo.net; url="https://keys.openpgp.org/vks/v1/by-email/philipk@posteo.net"; preference=signencrypt Date: Tue, 24 Sep 2024 10:22:31 +0000 Message-ID: <87ed59tkpk.fsf@posteo.net> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Aleksandr Vityazev 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" >>> >>> 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: > From: Aleksandr Vityazev > 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". > + > > * 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 From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 29 Sep 2024 18:25:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Philip Kaludercic Cc: Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172763424313156 (code B ref 73357); Sun, 29 Sep 2024 18:25:02 +0000 Received: (at 73357) by debbugs.gnu.org; 29 Sep 2024 18:24:03 +0000 Received: from localhost ([127.0.0.1]:41599 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1suyaP-0003Pw-Rb for submit@debbugs.gnu.org; Sun, 29 Sep 2024 14:24:03 -0400 Received: from layka.disroot.org ([178.21.23.139]:54252) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1suyaG-0003PY-U5 for 73357@debbugs.gnu.org; Sun, 29 Sep 2024 14:23:58 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id E1A4E23D78; Sun, 29 Sep 2024 20:23:19 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id p9450ufxugi2; Sun, 29 Sep 2024 20:23:18 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1727634198; bh=swsAFUZWWJjWqtMLPtoTkIr9JPBpkNI+/Bf3ihxrO7k=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=MuQFSDaH6/KKPbSMXTQLJknioR8ppDtIuWP/OFbZLMheXIjI9yv0oWGWUfGktoXgt NogrC8E+XURLUSna0HiKKcYue10rWRdxeGQXlTCW4/o3k6CHCk/2xCTIfWEolmfx/M EngIXFKJZqXdu+XtSqpI6UAAYWGP9KYHMatfJ8R4FNEjpcZWcaJsJLKfmHGwWDiNFx 6zmf5XiL5acfzqWKxw1wDeIbOQ04J9cstSov0OGI8i3GEpsquOhO/0QQ6Jqe3WUGBg M4zfnwGP/4o5Rw8JLOF/V5RlmP4K8l8Vl1s9avBeYOx7ezB8B3GYMSosGpf32Nx4bw HJ/YX8zZtSQqg== From: Aleksandr Vityazev In-Reply-To: <87ed59tkpk.fsf@posteo.net> (Philip Kaludercic's message of "Tue, 24 Sep 2024 10:22:31 +0000") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> Date: Sun, 29 Sep 2024 21:23:13 +0300 Message-ID: <871q12fhf2.fsf@disroot.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain On 2024-09-24 10:22, Philip Kaludercic wrote: > Aleksandr Vityazev 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" >>>> >>>> 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: >> From: Aleksandr Vityazev >> 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. > >> + >> >> * 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: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From 6d5dbb1d1354d7476caaeeecfe15b8fd6335490a Mon Sep 17 00:00:00 2001 Message-ID: <6d5dbb1d1354d7476caaeeecfe15b8fd6335490a.1727634026.git.avityazev@disroot.org> From: Aleksandr Vityazev 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. + * 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") + +(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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 01 Oct 2024 14:15:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Aleksandr Vityazev Cc: Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.17277920456471 (code B ref 73357); Tue, 01 Oct 2024 14:15:01 +0000 Received: (at 73357) by debbugs.gnu.org; 1 Oct 2024 14:14:05 +0000 Received: from localhost ([127.0.0.1]:51554 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svddc-0001gJ-2a for submit@debbugs.gnu.org; Tue, 01 Oct 2024 10:14:05 -0400 Received: from mout01.posteo.de ([185.67.36.65]:38409) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1svddX-0001fj-Bi for 73357@debbugs.gnu.org; Tue, 01 Oct 2024 10:14:02 -0400 Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 7267F240028 for <73357@debbugs.gnu.org>; Tue, 1 Oct 2024 13:09:14 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1727780954; bh=YgY0zKMz9U0Ow9QZ4IEP18WHLFn2pYIvBxmmBbvPErY=; h=From:To:Cc:Subject:Date:Message-ID:MIME-Version:Content-Type: From; b=DT+oOarnHMmVt7DLeigM5gUdc03TAfwXNthcKKt1dhK9SDYDFB6mgtKRmhn5ojcPC emlcLRyJDVTHRKzgI76Kn8Mrg3wzDX7wwoNDNSVspnf0Ndwsg/SjRFktCjxzu5mrQL KQj12iZ67YLe8xoqlx3Q5oUyeB03TNEM9TlxbMs9cqLns1br9Jdrb1HxI213K/TyKS JP/plkCYJLja1sIssRWWVaazupbSPk4/KimG4TV/o4hvMDLDSpLwWyNf/aGgGSADhL lYFjG935Pq3m1s+GD5I3huVbp9ucpaMn6uLkY0WaHD92MhT0TRxUvM+P3ZwZP90cww KH+zaBlG60a8A== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4XHwDn47jfz6ty1; Tue, 1 Oct 2024 13:09:13 +0200 (CEST) From: Philip Kaludercic In-Reply-To: <871q12fhf2.fsf@disroot.org> (Aleksandr Vityazev's message of "Sun, 29 Sep 2024 21:23:13 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> X-Hashcash: 1:20:241001:73357@debbugs.gnu.org::28rw8L1vNMZ80mmD:c4z X-Hashcash: 1:20:241001:eliz@gnu.org::GGXWfTkMdTn24f5H:IHw X-Hashcash: 1:20:241001:avityazev@disroot.org::aeFRVFCYP5fcNTJo:4WDG Date: Tue, 01 Oct 2024 11:09:12 +0000 Message-ID: <87jzesulk7.fsf@posteo.net> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Aleksandr Vityazev 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 > 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. > + > > * 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") > + > > +(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 From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 06 Oct 2024 14:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Philip Kaludercic Cc: Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172822627122797 (code B ref 73357); Sun, 06 Oct 2024 14:52:02 +0000 Received: (at 73357) by debbugs.gnu.org; 6 Oct 2024 14:51:11 +0000 Received: from localhost ([127.0.0.1]:41925 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxSbF-0005vZ-PE for submit@debbugs.gnu.org; Sun, 06 Oct 2024 10:51:11 -0400 Received: from layka.disroot.org ([178.21.23.139]:55030) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sxSbC-0005vO-Sl for 73357@debbugs.gnu.org; Sun, 06 Oct 2024 10:51:09 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id 58D3D23DEE; Sun, 6 Oct 2024 16:50:59 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id adVpKTylsuQn; Sun, 6 Oct 2024 16:50:57 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1728226257; bh=bx/OVUkermvlJre4wO0L3WtGm4gM3TIbZm8Mm8gjOhM=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=NO7dasjBxDwE9FJqOLPF90EzG768oxd8xhfmGgB+1UjizEU1fCDmMpUKNR/e+FFIB g26RPleCc98xbJp6llXV5NntJYMgE5f1D6YEGRacZYMhk1NIcrZALSrr3C3ymPT8YJ w9B2BtdVJiH8bRwjJK1PAwe56SrFGUiJBdPPiDSHlGbdfOLDecvETJEk/7wYGYJ8Tw KuzwQOhFieYRdynMh/dASfAfZbm90z6VIDceiYguTX3U1+eegEglx/7FvB+svWff6W e/fglZjUQIrmI0EfGFgrvIuyKNSBWwvRv1irD5OCCr+20TmZoZc3p0Vu3tUJZtuwSD LL3pW5PeNKJgQ== From: Aleksandr Vityazev In-Reply-To: <87jzesulk7.fsf@posteo.net> (Philip Kaludercic's message of "Tue, 01 Oct 2024 11:09:12 +0000") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> Date: Sun, 06 Oct 2024 17:50:54 +0300 Message-ID: <87y131ffox.fsf@disroot.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain On 2024-10-01 11:09, Philip Kaludercic wrote: > Aleksandr Vityazev 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 >> 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. >> + >> >> * 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") >> + >> >> +(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: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Move-package-vc-heuristic-alist-and-related-to-vc.patch Content-Description: [PATCH] Move package-vc-heuristic-alist and related to vc.el >From 0f2d2f91ca9ecfdf42e891a462ce4aa75e77a0ad Mon Sep 17 00:00:00 2001 Message-ID: <0f2d2f91ca9ecfdf42e891a462ce4aa75e77a0ad.1728225805.git.avityazev@disroot.org> From: Aleksandr Vityazev 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") + +(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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From d8c1074e4a75d3e6f523f47cb239e9c8ae26b3b7 Mon Sep 17 00:00:00 2001 Message-ID: From: Aleksandr Vityazev 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. + * 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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Eli Zaretskii Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 12 Oct 2024 12:10:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Aleksandr Vityazev , Dmitry Gutov Cc: philipk@posteo.net, 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.17287349986672 (code B ref 73357); Sat, 12 Oct 2024 12:10:01 +0000 Received: (at 73357) by debbugs.gnu.org; 12 Oct 2024 12:09:58 +0000 Received: from localhost ([127.0.0.1]:40394 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1szawX-0001jW-IL for submit@debbugs.gnu.org; Sat, 12 Oct 2024 08:09:58 -0400 Received: from eggs.gnu.org ([209.51.188.92]:39504) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1szawS-0001ic-Nk for 73357@debbugs.gnu.org; Sat, 12 Oct 2024 08:09:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1szatZ-0001iH-FM; Sat, 12 Oct 2024 08:06:53 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=4JqoaK+fiOCWWHySs1mImOCuYlOYnT6+039wud56vHM=; b=VclUfZku8/O0 6N+UidssXrFQSmdUNSLUaaOwAAXkgzx8MqZs3xnkwrMKn6beoUOpI43bRpaLg0hdGpjLVooqH0Uoc pxpudTDA8xkBQAX941WX9mS23FP6deckPP8Eb/8Iwfu2HMrqvhLZymqRgGEPh3qUn692HeBSgXFpk wL/eMWWs0Zq1qRZjpPYt71GKJofaKMJWvpP5dHvWjPJf7f1Y1YDXR+kWV8hr/GdcNS4TviWQSH9oX 71snB6cxZ509twBYOMAjdh5GxY8Ojss+74IHrwBwcSWPubeG41kAy7ZC7a5x+qzfjyIrkJ8L0kkGY spPGxyMhmZ4ftpkwMdYi3Q==; Date: Sat, 12 Oct 2024 15:06:49 +0300 Message-Id: <86msj9wmna.fsf@gnu.org> From: Eli Zaretskii In-Reply-To: <87y131ffox.fsf@disroot.org> (message from Aleksandr Vityazev on Sun, 06 Oct 2024 17:50:54 +0300) References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) > From: Aleksandr Vityazev > Cc: Eli Zaretskii , 73357@debbugs.gnu.org > Date: Sun, 06 Oct 2024 17:50:54 +0300 > > On 2024-10-01 11:09, Philip Kaludercic wrote: > > > Aleksandr Vityazev 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 > >> 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. > >> + > >> > >> * 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") > >> + > >> > >> +(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? From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 24 Oct 2024 10:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Eli Zaretskii Cc: Dmitry Gutov , philipk@posteo.net, 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172976522611535 (code B ref 73357); Thu, 24 Oct 2024 10:21:02 +0000 Received: (at 73357) by debbugs.gnu.org; 24 Oct 2024 10:20:26 +0000 Received: from localhost ([127.0.0.1]:33772 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ux7-0002zy-I9 for submit@debbugs.gnu.org; Thu, 24 Oct 2024 06:20:26 -0400 Received: from layka.disroot.org ([178.21.23.139]:36752) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ux4-0002zn-T2 for 73357@debbugs.gnu.org; Thu, 24 Oct 2024 06:20:24 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id 00CCE24FB5; Thu, 24 Oct 2024 12:19:44 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id muN6x-Msm9mP; Thu, 24 Oct 2024 12:19:42 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1729765182; bh=y2Jw6Cf3acyZnEFyQ8C2yJdrNUYk3sQzM4Y644U4z9I=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=STO0MD63HZ51d4YXQaHPS7Ui2AZk6HR313PfnarIJR7vSn4mGvCfMKyMp7o9StPa+ LjbG+wUwXlXdxfCqHdMzcRsKD1fAZTI68pETlQXZL3rS1Z/BQrbx+UJKp0bXkoWgyn nA94w0FZwc7eXUtgJ73PcVWVkR+OlmOmu0iRF+D+DbHM/cxVnP1hKeyLwyHuNcS+0h wD81OY5CNfu/yja8iTvrItzng4ZXRBvEfFjE+BncbGq0mGXJocKOmk2uI53peONjUs Fkw8xxVTJP9CNEgoyVVdETStLH0H8Lv85IL2V6J+UJeSkILrt6xaEYqhnZgMnuia+b cbzTNP/tzwMvA== From: Aleksandr Vityazev In-Reply-To: <86msj9wmna.fsf@gnu.org> (Eli Zaretskii's message of "Sat, 12 Oct 2024 15:06:49 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> Date: Thu, 24 Oct 2024 13:19:39 +0300 Message-ID: <874j516bwk.fsf@disroot.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) On 2024-10-12 15:06, Eli Zaretskii wrote: >> From: Aleksandr Vityazev >> Cc: Eli Zaretskii , 73357@debbugs.gnu.org >> Date: Sun, 06 Oct 2024 17:50:54 +0300 >> >> On 2024-10-01 11:09, Philip Kaludercic wrote: >> >> > Aleksandr Vityazev 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 >> >> 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. >> >> + >> >> >> >> * 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") >> >> + >> >> >> >> +(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 From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 24 Oct 2024 10:45:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Aleksandr Vityazev Cc: Dmitry Gutov , Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172976666416146 (code B ref 73357); Thu, 24 Oct 2024 10:45:02 +0000 Received: (at 73357) by debbugs.gnu.org; 24 Oct 2024 10:44:24 +0000 Received: from localhost ([127.0.0.1]:33827 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3vKJ-0004CM-TM for submit@debbugs.gnu.org; Thu, 24 Oct 2024 06:44:24 -0400 Received: from mout02.posteo.de ([185.67.36.66]:33121) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3vKH-0004C5-Ob for 73357@debbugs.gnu.org; Thu, 24 Oct 2024 06:44:22 -0400 Received: from submission (posteo.de [185.67.36.169]) by mout02.posteo.de (Postfix) with ESMTPS id B35BC240101 for <73357@debbugs.gnu.org>; Thu, 24 Oct 2024 12:43:42 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1729766623; bh=7n9f8YASS/9pD1uur/6MLc7Br6YFvP8U8c19KfAaxJQ=; h=From:To:Cc:Subject:Date:Message-ID:MIME-Version:Content-Type: From; b=OMPUXL/db+B7yc8n2pYdOh0Yg6MUxmd46/t0YFCq7Ra6C1rbCriMIIsGr+jOJvJga s/AxTQxUVS8vSdIqlZ4ACWYxdpCfIP5tHokJAtCjNzOJS0Djl/thCKldPDkprI5yOL 1KwR2LKJPR9miyvBXoqL63OTquznZIjnxPE19PmaSl+LT1dtTPjuYvgy/cXzNcCubP qxODbt/4j6lUBatuz2+H9oCUkIXHWWbvnvs6D6o/sg3aFM4jUdtUOhDomk6sM5jisC aC7kPaDKb/fSTRD5kYJBZB1akoV9xC0IbgUN90t4vdLpWIsx/cCSwuxgfm8odZwxmc LSfUt7sQ3/WyQ== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4XZ2Zj4WGxz6txy; Thu, 24 Oct 2024 12:43:41 +0200 (CEST) From: Philip Kaludercic In-Reply-To: <874j516bwk.fsf@disroot.org> (Aleksandr Vityazev's message of "Thu, 24 Oct 2024 13:19:39 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> <874j516bwk.fsf@disroot.org> X-Hashcash: 1:20:241024:73357@debbugs.gnu.org::sdBm6y/OF2VPwjHv:j/x X-Hashcash: 1:20:241024:avityazev@disroot.org::vSYMV4JZ1XxjO0Hh:0OtH X-Hashcash: 1:20:241024:dmitry@gutov.dev::vu/2FfgRwK4H5WFq:1pQz X-Hashcash: 1:20:241024:eliz@gnu.org::W3b0ofMAFr+mTFCv:4d3T Date: Thu, 24 Oct 2024 10:43:41 +0000 Message-ID: <87sesl93xe.fsf@posteo.net> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Aleksandr Vityazev 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 From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Sean Whitton Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 24 Oct 2024 11:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Philip Kaludercic , Aleksandr Vityazev Cc: Dmitry Gutov , Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.172976922424080 (code B ref 73357); Thu, 24 Oct 2024 11:28:02 +0000 Received: (at 73357) by debbugs.gnu.org; 24 Oct 2024 11:27:04 +0000 Received: from localhost ([127.0.0.1]:33892 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3vzc-0006GK-FN for submit@debbugs.gnu.org; Thu, 24 Oct 2024 07:27:04 -0400 Received: from sendmail.purelymail.com ([34.202.193.197]:37506) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3vzZ-0006Fm-Hc for 73357@debbugs.gnu.org; Thu, 24 Oct 2024 07:27:03 -0400 DKIM-Signature: a=rsa-sha256; b=Oa7nLeoHyYPL/GTY2wVpRaztRB2zJfiTRQbXCox3LPafps/zYtclhHazUedA2nPLfpMD1SBTmqDYZVklu3R+ivCwEywvotshYc/FsuVyHI8cuEs1u5kO+SsNpWxZryuAI1+6tmQJ6wQVG5mwHgEi/RUQs7hzctqZkvVYqZtj2s+jf7ErmvNI+szNJhZcphp2/3W09H+CvFZWKt6XRwOn//yFhQbOpKy44MYAzCuMBeH8xIVY0tmUXrRnFRqOHYzlVERA/peKMwgjyP/FIEEtaYADyN6K25GlGTlbJNvKRy289GY6Zqi8baXujwrKO2K+zjI7BUmIbB7tc7bg0eGiMg==; s=purelymail2; d=spwhitton.name; v=1; bh=YLQxKiABoO1TS2fLk+v/2HD+pkIvERVJI4X+NDLruTU=; h=Received:Received:From:To:Subject:Date; DKIM-Signature: a=rsa-sha256; b=qC3laULbhe0Ug73UgimiVSnz9JctOCsBjFPB0gzglHsQHWr/bHfLM9vmIfPcBcAdyRqfaPe1tPkP0ueiPinQEijcfCIxbbR3kj1M1S/JZtvwySH9fDd52YqBwBjzZh2opeR6gPn8nMJCW7AsqrHlzeuwXP5mK5LTt7AKF1fLZmOeRgWDtGpvhvh2tMiZXwXjBnDIQj/W2GB2+UR541b33dvoWB/c2sFZ+ZPpsxEsvjuihr619mPlvBwOdadsRQjBwy0UdH8vLfDGHkM5f4AxHw5T90vHgwPi74YNOXdvl5TsVQvVrPIwprAU7DqGmNEnQmaXYrm/FO9tQqA1AfCLgA==; s=purelymail2; d=purelymail.com; v=1; bh=YLQxKiABoO1TS2fLk+v/2HD+pkIvERVJI4X+NDLruTU=; h=Feedback-ID:Received:Received:From:To:Subject:Date; Feedback-ID: 20115:3760:null:purelymail X-Pm-Original-To: 73357@debbugs.gnu.org Received: by smtp.purelymail.com (Purelymail SMTP) with ESMTPSA id -1200676560; (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Thu, 24 Oct 2024 11:26:23 +0000 (UTC) Received: by melete.silentflame.com (Postfix, from userid 1000) id E5B667ED51F; Thu, 24 Oct 2024 19:26:19 +0800 (CST) From: Sean Whitton In-Reply-To: <87sesl93xe.fsf@posteo.net> (Philip Kaludercic's message of "Thu, 24 Oct 2024 10:43:41 +0000") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> <874j516bwk.fsf@disroot.org> <87sesl93xe.fsf@posteo.net> Date: Thu, 24 Oct 2024 19:26:19 +0800 Message-ID: <87a5et4u90.fsf@melete.silentflame.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hello, On Thu 24 Oct 2024 at 10:43am GMT, Philip Kaludercic wrote: > Aleksandr Vityazev 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 From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Aleksandr Vityazev Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 24 Oct 2024 12:33:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Sean Whitton Cc: Dmitry Gutov , Philip Kaludercic , Eli Zaretskii , 73357@debbugs.gnu.org Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.17297731643123 (code B ref 73357); Thu, 24 Oct 2024 12:33:01 +0000 Received: (at 73357) by debbugs.gnu.org; 24 Oct 2024 12:32:44 +0000 Received: from localhost ([127.0.0.1]:33972 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3x19-0000oH-22 for submit@debbugs.gnu.org; Thu, 24 Oct 2024 08:32:44 -0400 Received: from layka.disroot.org ([178.21.23.139]:35794) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3x12-0000no-Sy for 73357@debbugs.gnu.org; Thu, 24 Oct 2024 08:32:42 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id 4B07A251D2; Thu, 24 Oct 2024 14:32:04 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id I5mbncc0DtHA; Thu, 24 Oct 2024 14:32:02 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1729773122; bh=ar8LYfFIUoKtcy45ZbcQHeh6BEV6NUUADZyqAJdU4bE=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=FbNjNV01K1OBjyL7s9ZsUQavr/E3bewpYaowPeWzWqxNg4z5dRQKqaSkZc6A5R9r9 WP/y+D/SUF+6Y2tm3TE2WVoEn3RaX/cLEq6LWRYk7TtEHktTb4/M2gc9v7UEpiq/2a KlWVAVf9u+BCLN0AFGDibslUTeEMjWA5VFEOMQsOqXcITNK2fkCz2z6ESkcQfWDtZp wh613NcMbRFoBHjY+bB3c8FoPdPx/3TFYQNN/Z0Ibyo2k4oumgrK2rBd9/LbmP78TF bY5cPY5m09ahN6hJtiIaLs2i8NwoRE4REVTtOgWdaXz2FU/okxSMSbPHhNgsb+y3N7 kg5lStqHlfJGA== From: Aleksandr Vityazev In-Reply-To: <87a5et4u90.fsf@melete.silentflame.com> (Sean Whitton's message of "Thu, 24 Oct 2024 19:26:19 +0800") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> <874j516bwk.fsf@disroot.org> <87sesl93xe.fsf@posteo.net> <87a5et4u90.fsf@melete.silentflame.com> Date: Thu, 24 Oct 2024 15:31:59 +0300 Message-ID: <87wmhx4r7k.fsf@disroot.org> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain 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 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: --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Move-package-vc-heuristic-alist-and-related-to-vc.patch Content-Description: [PATCH] Move package-vc-heuristic-alist and related to vc.el >From 7072d2002a4b0852ba6d133f1f4728fc7d25ccc6 Mon Sep 17 00:00:00 2001 Message-ID: <7072d2002a4b0852ba6d133f1f4728fc7d25ccc6.1729772961.git.avityazev@disroot.org> From: Aleksandr Vityazev 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") + ;; 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From a64134c73086f5067d1f360dad0ab48267750fd1 Mon Sep 17 00:00:00 2001 Message-ID: From: Aleksandr Vityazev 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. + * 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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- From unknown Sat Aug 16 16:23:56 2025 MIME-Version: 1.0 X-Mailer: MIME-tools 5.505 (Entity 5.505) X-Loop: help-debbugs@gnu.org From: help-debbugs@gnu.org (GNU bug Tracking System) To: Aleksandr Vityazev Subject: bug#73357: closed (Re: bug#73357: [PATCH] Make vc-clone interactive) Message-ID: References: <87ikth3989.fsf@melete.silentflame.com> <875xqrlr3b.fsf@disroot.org> X-Gnu-PR-Message: they-closed 73357 X-Gnu-PR-Package: emacs X-Gnu-PR-Keywords: patch Reply-To: 73357@debbugs.gnu.org Date: Thu, 24 Oct 2024 13:47:02 +0000 Content-Type: multipart/mixed; boundary="----------=_1729777622-17291-1" This is a multi-part message in MIME format... ------------=_1729777622-17291-1 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset="utf-8" Your bug report #73357: [PATCH] Make vc-clone interactive which was filed against the emacs package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 73357@debbugs.gnu.org. --=20 73357: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D73357 GNU Bug Tracking System Contact help-debbugs@gnu.org with problems ------------=_1729777622-17291-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at 73357-done) by debbugs.gnu.org; 24 Oct 2024 13:46:30 +0000 Received: from localhost ([127.0.0.1]:34139 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3yAY-0004Tl-6b for submit@debbugs.gnu.org; Thu, 24 Oct 2024 09:46:30 -0400 Received: from sendmail.purelymail.com ([34.202.193.197]:39908) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3yAU-0004TS-Eu for 73357-done@debbugs.gnu.org; Thu, 24 Oct 2024 09:46:28 -0400 DKIM-Signature: a=rsa-sha256; b=vv+XpblNts5EGjKzibV3+eD/JsczNDhianPOpWQvnEfpq/Ox1c1zqJv344d/yHi1jpRSdyOaK1YSJMBrDXnKVnJ1M2MDg1GMmJEu3p1CVO3rLODx+Zi1iAxX9ldS8e2mIYep5D74Jps+5EK5FqmhSv7JC0nI/oinhPXPB+ShsvrgLeCrwG6ojyCYNnZcZpqhUAokzunObAnC/u1ATZqAvkosFHcQxbCSoR4a3HSMBvIcrIW2YfODxJxzOH/k1uk4wINrRasaCknYkH9y7eKFSl/Kqnu1vihQouTuYWY9nfkmIzLLN/WDG9KdIR92CrcxomN+hGZ4+6G+tgT2Lz8p7g==; s=purelymail2; d=spwhitton.name; v=1; bh=hG3tz2swUhost+4onXtuEw+GE40gEeUgR7nRih/wcys=; h=Received:Received:From:To:Subject:Date; DKIM-Signature: a=rsa-sha256; b=DP67CYIt7hP3kys3fdu2916CgZML2oiVFJnNZAyLUEQ5EEZpxoEZuy2GEhSxa7p57jtHW3C/ozSJGswtbm+SMimIXi1yOIj7/6+gNI5XOk1NAOeXBmc5ySD3DLKnzHkLRTEBsNRdODg1njFQggvGH0gkFggxiR25faFANK2GiC014FqVyhwVoaw7EsHBPF5iSPbDCRycvczJyd6TtL2K+Nf6gZAAWO3znA8NNzQzfFfdIqm2an9lpNCzIKBQEpjJ5KkMkALkxexeveXoWTj94ZMWOUXmDO7eY1ezI2aSW6O0UU+P05CI19WRTHbVfugcIQyFmT9Rjlx7eWpuAEPMHg==; s=purelymail2; d=purelymail.com; v=1; bh=hG3tz2swUhost+4onXtuEw+GE40gEeUgR7nRih/wcys=; h=Feedback-ID:Received:Received:From:To:Subject:Date; Feedback-ID: 20115:3760:null:purelymail X-Pm-Original-To: 73357-done@debbugs.gnu.org Received: by smtp.purelymail.com (Purelymail SMTP) with ESMTPSA id -219221376; (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Thu, 24 Oct 2024 13:45:47 +0000 (UTC) Received: by melete.silentflame.com (Postfix, from userid 1000) id 725767ED9AA; Thu, 24 Oct 2024 21:45:42 +0800 (CST) From: Sean Whitton To: Aleksandr Vityazev Subject: Re: bug#73357: [PATCH] Make vc-clone interactive In-Reply-To: <87wmhx4r7k.fsf@disroot.org> (Aleksandr Vityazev's message of "Thu, 24 Oct 2024 15:31:59 +0300") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> <874j516bwk.fsf@disroot.org> <87sesl93xe.fsf@posteo.net> <87a5et4u90.fsf@melete.silentflame.com> <87wmhx4r7k.fsf@disroot.org> Date: Thu, 24 Oct 2024 21:45:42 +0800 Message-ID: <87ikth3989.fsf@melete.silentflame.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 73357-done Cc: Dmitry Gutov , Philip Kaludercic , Eli Zaretskii , 73357-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 ------------=_1729777622-17291-1 Content-Type: message/rfc822 Content-Disposition: inline Content-Transfer-Encoding: 7bit Received: (at submit) by debbugs.gnu.org; 19 Sep 2024 13:18:54 +0000 Received: from localhost ([127.0.0.1]:60051 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srH3d-0006ai-KR for submit@debbugs.gnu.org; Thu, 19 Sep 2024 09:18:53 -0400 Received: from lists.gnu.org ([209.51.188.17]:52064) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1srH3a-0006aa-PI for submit@debbugs.gnu.org; Thu, 19 Sep 2024 09:18:51 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1srH3I-0001RF-Hy for bug-gnu-emacs@gnu.org; Thu, 19 Sep 2024 09:18:32 -0400 Received: from layka.disroot.org ([178.21.23.139]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1srH3F-00023m-61 for bug-gnu-emacs@gnu.org; Thu, 19 Sep 2024 09:18:32 -0400 Received: from mail01.disroot.lan (localhost [127.0.0.1]) by disroot.org (Postfix) with ESMTP id 4C80F203B8 for ; Thu, 19 Sep 2024 15:18:25 +0200 (CEST) X-Virus-Scanned: SPAM Filter at disroot.org Received: from layka.disroot.org ([127.0.0.1]) by localhost (disroot.org [127.0.0.1]) (amavis, port 10024) with ESMTP id IB60tyztwGIP for ; Thu, 19 Sep 2024 15:18:24 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=disroot.org; s=mail; t=1726751904; bh=HnaePYTWo29Q8bUG9B70ORU9BnR0yQ5OgSy5JKQAv7M=; h=From:To:Subject:Date; b=WeVs9c3bvcczyvT3ZFxLJlvYNXDJhRC8Zlxsn7IvznFtwsb/L/aQTzqJwGALMWgnN STv5TaKMw6G6Ara1x+hm8s96vPzdvTd8WNdHepVrYZFewTy5NCUCp9p3/4EDLzW3TD l6PHGWBkLd74GQV4KYOiU1oYG6iYFkj2hPJyCOg5p0Zq1IvBRVZgtuu2j7u17hqytT QsdwZdm8xazBOcQ3WCjAWMQOJpCz0Dkr/yzFRq23tNW9Zgcz4RGL4jXa5sP/mpx+LH WTVmtpy7U8S0LccV32V1k0SkkKIX0epdY3NKfCxTIclym//OgfIVy/kxAq92SR3FVm RTVPBOLYDyeqw== From: Aleksandr Vityazev To: bug-gnu-emacs@gnu.org Subject: [PATCH] Make vc-clone interactive Date: Thu, 19 Sep 2024 16:18:16 +0300 Message-ID: <875xqrlr3b.fsf@disroot.org> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=178.21.23.139; envelope-from=avityazev@disroot.org; helo=layka.disroot.org X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) --=-=-= Content-Type: text/plain Hi, Cloning is used quite often, so I would like to have an interactive command. A patch is attached to the email. WDYT? --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Make-vc-clone-interactive.patch Content-Description: [PATCH] Make vc-clone interactive >From 1fd3aa4b3afe4064bcc78787b99f4fa336e4031d Mon Sep 17 00:00:00 2001 Message-ID: <1fd3aa4b3afe4064bcc78787b99f4fa336e4031d.1726751543.git.avityazev@disroot.org> From: Aleksandr Vityazev 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 --=-=-= Content-Type: text/plain -- Best regards, Aleksandr Vityazev --=-=-=-- ------------=_1729777622-17291-1-- From unknown Sat Aug 16 16:23:56 2025 X-Loop: help-debbugs@gnu.org Subject: bug#73357: [PATCH] Make vc-clone interactive Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 24 Oct 2024 14:20:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch To: Sean Whitton Cc: Dmitry Gutov , Eli Zaretskii , 73357-done@debbugs.gnu.org, Aleksandr Vityazev Received: via spool by 73357-done@debbugs.gnu.org id=D73357.172977959724779 (code D ref 73357); Thu, 24 Oct 2024 14:20:01 +0000 Received: (at 73357-done) by debbugs.gnu.org; 24 Oct 2024 14:19:57 +0000 Received: from localhost ([127.0.0.1]:35812 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ygv-0006Rb-4G for submit@debbugs.gnu.org; Thu, 24 Oct 2024 10:19:57 -0400 Received: from mout01.posteo.de ([185.67.36.65]:50935) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1t3ygs-0006RL-9c for 73357-done@debbugs.gnu.org; Thu, 24 Oct 2024 10:19:56 -0400 Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 85190240027 for <73357-done@debbugs.gnu.org>; Thu, 24 Oct 2024 16:19:17 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1729779557; bh=BuqSMHPHgpJh6a5ln0IFb/FIejRCe65V4Wt01AQdLFs=; h=From:To:Cc:Subject:Autocrypt:OpenPGP:Date:Message-ID:MIME-Version: Content-Type:From; b=UzKPQmpQdF/WHERGdjN38xZ9i+s6YVRloWnJ2wX8dmOyJpOpLlwYh+9zOx1PTQ7M+ 1Fn2+gV1CfCsbuXjs2AVMZ5GZsXQvFis6JB2psyUDVXRzjZz0GakU+vfe8E/Wk05pu H/2JFXC3Cy095aHloaw7LqUZreLUrriLq0Pzc8ZzQFkEIKEMe7OeFzmz092GaiQ/AM PyhcwKBpNaFz6UZKBlJpoB9dW5Ssja+V6cxwrNFVI9C6ZmqydjjmRd+6HaNtj8XDyH FOzYViO7rZVf8v4vnNKto5cgCcdmgAIFidAXgHi2ZQqpMyg/ZEB0rEaJ2C0kAjOhWx k/GSGYZFryLmw== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4XZ7MR6bX8z9rxG; Thu, 24 Oct 2024 16:19:15 +0200 (CEST) From: Philip Kaludercic In-Reply-To: <87ikth3989.fsf@melete.silentflame.com> (Sean Whitton's message of "Thu, 24 Oct 2024 21:45:42 +0800") References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> <87jzesulk7.fsf@posteo.net> <87y131ffox.fsf@disroot.org> <86msj9wmna.fsf@gnu.org> <874j516bwk.fsf@disroot.org> <87sesl93xe.fsf@posteo.net> <87a5et4u90.fsf@melete.silentflame.com> <87wmhx4r7k.fsf@disroot.org> <87ikth3989.fsf@melete.silentflame.com> Autocrypt: addr=philipk@posteo.net; keydata= mDMEZBBQQhYJKwYBBAHaRw8BAQdAHJuofBrfqFh12uQu0Yi7mrl525F28eTmwUDflFNmdui0QlBo aWxpcCBLYWx1ZGVyY2ljIChnZW5lcmF0ZWQgYnkgYXV0b2NyeXB0LmVsKSA8cGhpbGlwa0Bwb3N0 ZW8ubmV0PoiWBBMWCAA+FiEEDg7HY17ghYlni8XN8xYDWXahwukFAmQQUEICGwMFCQHhM4AFCwkI BwIGFQoJCAsCBBYCAwECHgECF4AACgkQ8xYDWXahwulikAEA77hloUiSrXgFkUVJhlKBpLCHUjA0 mWZ9j9w5d08+jVwBAK6c4iGP7j+/PhbkxaEKa4V3MzIl7zJkcNNjHCXmvFcEuDgEZBBQQhIKKwYB BAGXVQEFAQEHQI5NLiLRjZy3OfSt1dhCmFyn+fN/QKELUYQetiaoe+MMAwEIB4h+BBgWCAAmFiEE Dg7HY17ghYlni8XN8xYDWXahwukFAmQQUEICGwwFCQHhM4AACgkQ8xYDWXahwukm+wEA8cml4JpK NeAu65rg+auKrPOP6TP/4YWRCTIvuYDm0joBALw98AMz7/qMHvSCeU/hw9PL6u6R2EScxtpKnWof z4oM OpenPGP: id=philipk@posteo.net; url="https://keys.openpgp.org/vks/v1/by-email/philipk@posteo.net"; preference=signencrypt Date: Thu, 24 Oct 2024 14:19:15 +0000 Message-ID: <877c9xlh24.fsf@posteo.net> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -3.3 (---) Sean Whitton 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