Move package-vc-heuristic-alist and related to vc.el

* lisp/emacs-lisp/package-vc.el (package-vc--backend-type)
(package-vc-heuristic-alist, package-vc--guess-backend): Rename
to vc-cloneable-backends-custom-type, vc-clone-heuristic-alist
and vc-guess-url-backend respectively, and move to
lisp/vc/vc.el.  Make package-vc-heuristic-alist an obsolete
alias.
(package-vc--clone, package-vc--read-package-name)
(package-vc-install, package-vc-checkout): Use
vc-guess-url-backend.
* lisp/vc/vc.el (vc-cloneable-backends-custom-type)
(vc-clone-heuristic-alist, vc-guess-url-backend): New defconst,
defcustom and defun, respectively: renamed and moved here from
lisp/emacs-lisp/package-vc.el.

(cherry picked from commit 98b02f56d12f2f39a6667d33d50f9e551a267d6d)

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index e168096e1536835ffcf026f0a7cece4cfdfe53e3..445f52477b2c9dfa5be87697e5756c1cd858fbd8 100644 (file)
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -63,61 +63,9 @@
 (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-clone-heuristic-alist "31.1")
 
 (defcustom package-vc-default-backend 'Git
   "Default VC backend to use for cloning package repositories.
@@ -127,7 +75,7 @@ the backend nor a repository URL that's recognized via
 
 The value must be a member of `vc-handled-backends' that supports
 the `clone' VC function."
-  :type package-vc--backend-type
+  :type vc-cloneable-backends-custom-type
   :version "29.1")
 
 (defcustom package-vc-register-as-project t
@@ -626,13 +574,6 @@ documentation and marking the package as installed."
                  "")))
     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 @@ attribute in PKG-SPEC."
     (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 @@ VC packages that have already been installed."
                            ;; 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 @@ installs takes precedence."
      (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 @@ installs takes precedence."
        (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 @@ for the last released version of the package."
   (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 32c5e9ce794e51e85c0a9c658824314c329b8308..54e5d0ce067f6394884e07bb1ce16c0268fc30a6 100644 (file)
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -944,6 +944,61 @@ value other than `ask' if you have a strong grasp of the VCS in use."
                  (const :tag "Allow without prompting" t))
   :version "31.1")
 
+(defconst vc-cloneable-backends-custom-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-clone-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-cloneable-backends-custom-type)
+  :version "31.1")
+
 \f
 ;; File property caching
 
@@ -1033,6 +1088,13 @@ use."
        (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-clone-heuristic-alist'
+and return nil if it cannot reasonably guess."
+  (and url (alist-get url vc-clone-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.