mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-01 09:51:22 -08:00
Code Issues Projects Releases Wiki Activity

Guess Git repositories from the URL header

Browse source 
* package-vc.el (package-vc-probable-repository-regexp): Add new user option.
(package-vc-sourced-packages-list): Add new function using
'package-vc-probable-repository-regexp'.
(package-vc-fetch): Use 'package-vc-sourced-packages-list'.
This commit is contained in:
Philip Kaludercic 2022-08-11 10:53:11 +02:00
parent d01445716d
commit 98381366b5
No known key found for this signature in database
GPG key ID: F2C3CC513DB89F66
1 changed files with 41 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -48,6 +48,25 @@
:group 'package
:version "29.1")
(defcustom package-vc-probable-repository-regexp
(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 "-" "." "_"))))
(or (? "/") ".git") eos)
"Regular expression matching URLs that are repositories."
:version "29.1"
:type 'regex)
(defun package-vc-commit (pkg)
"Extract the commit of a development package PKG."
(cl-assert (eq (package-desc-kind pkg) 'vc))
@ -177,6 +196,27 @@ The output is written out into PKG-FILE."
;; `activate-1', so that we use the byte-compiled definitions.
(package--reload-previously-loaded new-desc)))))
(defun package-vc-sourced-packages-list ()
"Generate a list of packages with VC data."
(seq-filter
(lambda (pkg)
(let ((extras (package-desc-extras (cadr pkg))))
(or (alist-get :vc extras)
;; If we have no explicit VC data, we can try a kind of
;; heuristic and use the URL header, that might already be
;; pointing towards a repository, and use that as a backup
(and-let* ((url (alist-get :url extras))
((string-match-p package-vc-probable-repository-regexp
url)))
;; XXX: Currently `package-vc-probable-repository-regexp'
;; only contains Git repositories, so we can infer the
;; repository type. This might work for now, but is not a
;; particularly resilient approach.
(setf (alist-get :vc (package-desc-extras (cadr pkg)))
(list 'Git url))
t))))
package-archive-contents))
(defun package-vc-fetch (name-or-url &optional name rev)
"Fetch the source of NAME-OR-URL.
If NAME-OR-URL is a URL, then the package will be downloaded from
@ -191,10 +231,7 @@ be requested using REV."
;; Initialize the package system to get the list of package
;; symbols for completion.
(package--archives-initialize)
(let* ((packages (seq-filter
(lambda (pkg)
(alist-get :vc (package-desc-extras (cadr pkg))))
package-archive-contents))
(let* ((packages (package-vc-sourced-packages-list))
(input (completing-read
"Fetch package source (name or URL): " packages))
(name (file-name-base input)))