From debbugs-submit-bounces@debbugs.gnu.org Thu Sep 19 09:18:54 2024 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 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Thu Sep 19 09:36:44 2024 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 To: Aleksandr Vityazev In-Reply-To: <875xqrlr3b.fsf@disroot.org> (bug-gnu-emacs@gnu.org) Subject: Re: bug#73357: [PATCH] Make vc-clone interactive References: <875xqrlr3b.fsf@disroot.org> X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 73357 Cc: 73357@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: -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 debbugs-submit-bounces@debbugs.gnu.org Thu Sep 19 12:38:54 2024 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 To: Eli Zaretskii Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: 73357@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 (-) --=-=-= 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 debbugs-submit-bounces@debbugs.gnu.org Tue Sep 24 06:23:07 2024 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 To: Aleksandr Vityazev Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Eli Zaretskii , 73357@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: -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 debbugs-submit-bounces@debbugs.gnu.org Sun Sep 29 14:24:03 2024 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 To: Philip Kaludercic Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Eli Zaretskii , 73357@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 (-) --=-=-= 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 debbugs-submit-bounces@debbugs.gnu.org Tue Oct 01 10:14:05 2024 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 To: Aleksandr Vityazev Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Eli Zaretskii , 73357@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: -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 debbugs-submit-bounces@debbugs.gnu.org Sun Oct 06 10:51:11 2024 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 To: Philip Kaludercic Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Eli Zaretskii , 73357@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 (-) --=-=-= 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 debbugs-submit-bounces@debbugs.gnu.org Sat Oct 12 08:09:58 2024 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 To: Aleksandr Vityazev , Dmitry Gutov In-Reply-To: <87y131ffox.fsf@disroot.org> (message from Aleksandr Vityazev on Sun, 06 Oct 2024 17:50:54 +0300) Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: philipk@posteo.net, 73357@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: -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 debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 06:20:26 2024 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 To: Eli Zaretskii Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Dmitry Gutov , philipk@posteo.net, 73357@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 (-) 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 debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 06:44:24 2024 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 To: Aleksandr Vityazev Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Dmitry Gutov , Eli Zaretskii , 73357@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: -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 debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 07:27:04 2024 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 To: Philip Kaludercic , Aleksandr Vityazev Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Dmitry Gutov , Eli Zaretskii , 73357@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 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 debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 08:32:44 2024 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 To: Sean Whitton Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357 Cc: Dmitry Gutov , Philip Kaludercic , Eli Zaretskii , 73357@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 (-) --=-=-= 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 debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 09:46:30 2024 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 From debbugs-submit-bounces@debbugs.gnu.org Thu Oct 24 10:19:57 2024 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 To: Sean Whitton Subject: Re: bug#73357: [PATCH] Make vc-clone interactive 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-Debbugs-Envelope-To: 73357-done Cc: Dmitry Gutov , Eli Zaretskii , 73357-done@debbugs.gnu.org, Aleksandr Vityazev 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 From unknown Fri Jun 20 20:13:06 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Fri, 22 Nov 2024 12:24:11 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator