From 0550c73148b23135de47229435205914d8080786 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 20 Aug 2023 16:20:54 +0200 Subject: [PATCH v2] ; Refine 'defcustom' types in 'package-vc' Only include VC backends that support cloning in the ':type' of 'package-vc-heuristic-alist' and 'package-vc-default-backend', and compute the list of relevant on demand to keep it fresh. * lisp/emacs-lisp/package-vc.el (package-vc--cloning-backend-p) (package-vc--update-backends): New functions. (package-vc--backend-type): New 'defconst'. (package-vc-heuristic-alist, package-vc-default-backend): Use it. --- lisp/emacs-lisp/package-vc.el | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index a3762d252b0..7c60c55d67f 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -62,6 +62,24 @@ package-vc (defconst package-vc--elpa-packages-version 1 "Version number of the package specification format understood by package-vc.") +(defun package-vc--cloning-backend-p (be) + "Return non-nil if the VC backend BE supports cloning repositories." + (or (vc-find-backend-function be 'clone) + (alist-get 'clone (get be 'vc-functions)))) + +(defun package-vc--update-backends (widget) + "Update WIDGET with VC backends suitable for cloning VCS repositories." + (widget-put widget :args + (seq-keep (lambda (be) + (when (package-vc--cloning-backend-p be) + (widget-convert (list 'const be)))) + vc-handled-backends)) + widget) + +(defconst package-vc--backend-type + '(choice :convert-widget package-vc--update-backends) + "The type of VC backends that support cloning package VCS repositories.") + (defcustom package-vc-heuristic-alist `((,(rx bos "http" (? "s") "://" (or (: (? "www.") "github.com" @@ -103,9 +121,7 @@ package-vc-heuristic-alist 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 (choice :tag "VC Backend" - ,@(mapcar (lambda (b) `(const ,b)) - vc-handled-backends))) + :value-type ,package-vc--backend-type) :version "29.1") (defcustom package-vc-default-backend 'Git @@ -116,8 +132,7 @@ package-vc-default-backend The value must be a member of `vc-handled-backends' that supports the `clone' VC function." - :type `(choice ,@(mapcar (lambda (b) (list 'const b)) - vc-handled-backends)) + :type package-vc--backend-type :version "29.1") (defcustom package-vc-register-as-project t -- 2.41.0