From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Philip Kaludercic Newsgroups: gmane.emacs.bugs Subject: bug#73357: [PATCH] Make vc-clone interactive Date: Tue, 01 Oct 2024 11:09:12 +0000 Message-ID: <87jzesulk7.fsf@posteo.net> References: <875xqrlr3b.fsf@disroot.org> <86ploz935f.fsf@gnu.org> <87y13nk39b.fsf@disroot.org> <87ed59tkpk.fsf@posteo.net> <871q12fhf2.fsf@disroot.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="15228"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Eli Zaretskii , 73357@debbugs.gnu.org To: Aleksandr Vityazev Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Oct 01 16:48:58 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1sveBN-0003hX-69 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 01 Oct 2024 16:48:57 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sveAS-0003MD-0g; Tue, 01 Oct 2024 10:48:01 -0400 Original-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 1sve9Z-0002gx-ML for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2024 10:47:11 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sve9Z-0004OU-DJ for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2024 10:47:05 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=h7DVOvE2gV1aEV5Ioo//r5/3joghQyVxvflT3ZDJwRQ=; b=mOHSdIIgwXeYmAZjvjX/8kQGQxWzbIUfMbC5pn/xu6YcRRkocCt4mSGV0wwFxRU3sJYgV+YyE+oRH050VEkyAEPhegRyBtSh4D9ZEkmyAAZf2NaT+hXWD7W9Z4ZYzqfke/1jg5kWTFzTHcvszLGUBM7Zw+xF9pgVAhjzQYHrwauxS5lbJlYwgc5NGPscwC946tWufyeo6YGqD7AO8tKl/Kn3rF+nqKZTG7jHp16tAynlHYpMtvnTU6XZHL141YBoW3wOqMZTTKggCIx46WOFFMiLtFFOjAwq0JHFJV+M4OIZcjxuACAJdEXZMhmtc7y9oz9Y6J/Sd9M4xfxhIxHx0w==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1svdeX-0001h4-U2 for bug-gnu-emacs@gnu.org; Tue, 01 Oct 2024 10:15:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Philip Kaludercic Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 01 Oct 2024 14:15:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 73357 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 73357-submit@debbugs.gnu.org id=B73357.17277920456471 (code B ref 73357); Tue, 01 Oct 2024 14:15:01 +0000 Original-Received: (at 73357) by debbugs.gnu.org; 1 Oct 2024 14:14:05 +0000 Original-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 Original-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 Original-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== Original-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) In-Reply-To: <871q12fhf2.fsf@disroot.org> (Aleksandr Vityazev's message of "Sun, 29 Sep 2024 21:23:13 +0300") 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:292760 Archived-At: 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