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: