procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Aleksandr Vityazev 2024-10-24 15:11:44 +03:00 • committed by Sean Whitton
parent db587ae8ba
commit 98b02f56d1
2 changed files with 71 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

77
lisp/emacs-lisp/package-vc.el
View file

@ -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)))))