From: Philip Kaludercic <philipk@posteo.net>
Date: Thu, 11 Aug 2022 08:53:11 +0000 (+0200)
Subject: Guess Git repositories from the URL header
X-Git-Tag: emacs-29.0.90~1616^2~307^2~98
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=98381366b5fce7f54cd10545f051906fe9240f10;p=emacs.git

Guess Git repositories from the URL header

* 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'.
---

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index a6694edc9fc..bd02dcb0721 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -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)))