Subject: bug#60418: [PATCH] Add :vc keyword to use-package

From: Tony Zorman <[email-masked]>
Date: Thu, 29 Dec 2022 19:43:40 +0100

Hi,

this is a complete (and clean) rewrite of my package [vc-use-package],
in order to properly integrate it with the Emacs core.  Basically, it
adds a new :vc keyword so one can leverage the 'package-vc-install*'
function(s) from within a use-package declaration.  For example,
specifying

    (use-package foo
      :vc (:url "bar")) 

would expand to (more or less, concentrating on the relevant part)

    (unless (package-installed-p 'foo)
      (package-vc-install '(foo :url "bar") nil))

This makes installing packages from remote sources a breeze.  There is
also support, via 'package-vc-install-from-checkout', for installing
local packages by additionally specifying a load path:

    (use-package foo
      :vc bar             ; optional name, use t or nil for foo
      :load-path "/path")
  ⇔
    (progn (eval-and-compile (add-to-list 'load-path <<path>>))
           (unless (package-installed-p 'bar)
             (package-vc-install-from-checkout <<path>> "bar"))
           …)

I don't know what the policy here is regarding sending multiple patches
in the same email, but since the second one is just adding
documentation, I didn't deem it "worth" a second mail.  Sorry (and do
let me know!) if this is disruptive to anyone.

Best,
  Tony

[vc-use-package]: https://github.com/slotThe/vc-use-package

>From 2aa5eed4186dab086684e8d0623b7f10cab07100 Mon Sep 17 00:00:00 2001
From: Tony Zorman <[email-masked]>
Date: Thu, 29 Dec 2022 11:05:04 +0100
Subject: [PATCH 1/2] Add :vc keyword to use-package

* lisp/use-package/use-package-core.el (use-package-keywords): Add :vc.
(use-package-handler/:load-path): Insert 'load-path' into 'state'.
(use-package-handler/:vc): Handler for the :vc keyword.
(use-package-normalize--vc-arg): Normalization for more complex
arguments to 'use-package-normalize/:vc', in order to make them
compatible with the specification of 'package-vc-selected-packages'.
(use-package-normalize/:vc): Normalizer for the :vc keyword.
(use-package): Document :vc.

* lisp/use-package/use-package-ensure.el (use-package-handler/:ensure):
Do not ensure a package when :vc is used in the declaration.

* test/lisp/use-package/use-package-tests.el (use-package-test/:vc-1):
(use-package-test/:vc-2):
(use-package-test/:vc-3):
(use-package-test/:vc-4):
(use-package-test-normalize/:vc):
Add tests for :vc.
---
 lisp/use-package/use-package-core.el       | 73 +++++++++++++++++++++-
 lisp/use-package/use-package-ensure.el     |  3 +-
 test/lisp/use-package/use-package-tests.el | 46 ++++++++++++++
 3 files changed, 119 insertions(+), 3 deletions(-)

diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el
index 1dee08e55b..71a03c419a 100644
--- a/lisp/use-package/use-package-core.el
+++ b/lisp/use-package/use-package-core.el
@@ -76,6 +76,7 @@ use-package-keywords
     :functions
     :preface
     :if :when :unless
+    :vc
     :no-require
     :catch
     :after
@@ -1151,7 +1152,8 @@ use-package-normalize/:load-path
     #'use-package-normalize-paths))
 
 (defun use-package-handler/:load-path (name _keyword arg rest state)
-  (let ((body (use-package-process-keywords name rest state)))
+  (let ((body (use-package-process-keywords name rest
+                (plist-put state :load-path arg))))
     (use-package-concat
      (mapcar #'(lambda (path)
                  `(eval-and-compile (add-to-list 'load-path ,path)))
@@ -1577,6 +1579,72 @@ use-package-handler/:config
      (when use-package-compute-statistics
        `((use-package-statistics-gather :config ',name t))))))
 
+;;;; :vc
+
+(defun use-package-handler/:vc (name _keyword arg rest state)
+  "Generate code for the :vc keyword."
+  (pcase-let ((body (use-package-process-keywords name rest state))
+              (local-path (car (plist-get state :load-path)))
+              (`(,name ,opts ,rev) arg))
+    (use-package-concat
+     `((unless (package-installed-p ',name)
+         ,(if local-path
+              `(package-vc-install-from-checkout ,local-path ,(symbol-name name))
+            `(package-vc-install ',(cons name opts) ,rev))))
+     body)))
+
+(defun use-package-normalize--vc-arg (arg)
+  "Normalize possible arguments to the :vc keyword.
+ARG is a cons-cell of approximately the form that
+`package-vc-selected-packages' accepts, plus an additional `:rev'
+keyword.
+
+Returns a list (NAME SPEC REV), where (NAME . SPEC) is compliant
+with `package-vc-selected-packages' and REV is a (possibly nil)
+revision."
+  (cl-flet* ((mk-string (s)
+	       (if (stringp s) s (symbol-name s)))
+             (mk-sym (s)
+               (if (stringp s) (intern s) s))
+	     (normalize (k v)
+               (when v
+	         (pcase k
+                   (:vc-backend (mk-sym v))
+                   (:rev (if (eq v :last-release) v (mk-string v)))
+                   (_ (mk-string v))))))
+    (pcase-let ((valid-kws '(:url :branch :lisp-dir :main-file :vc-backend :rev))
+                (`(,name . ,opts) arg))
+      (if (stringp opts)                ; (NAME . VERSION-STRING) ?
+          (list name opts)
+        ;; Error handling
+        (cl-loop for (k _) on opts by #'cddr
+                 if (not (member k valid-kws))
+                 do (use-package-error
+                     (format "Keyword :vc received unknown argument: %s. Supported keywords are: %s"
+                             k valid-kws)))
+        ;; Actual normalization
+        (list name
+              (cl-loop for (k v) on opts by #'cddr
+                       if (not (eq k :rev))
+                       nconc (list k (normalize k v)))
+              (normalize :rev (plist-get opts :rev)))))))
+
+(defun use-package-normalize/:vc (name _keyword args)
+  (let ((arg (car args)))
+    (pcase arg
+      ((or 'nil 't) (list name))                 ; guess name
+      ((pred symbolp) (list arg))                ; use this name
+      ((pred stringp) (list name arg))           ; version string + guess name
+      ((pred plistp)                             ; plist + guess name
+       (use-package-normalize--vc-arg (cons name arg)))
+      (`(,(pred symbolp) . ,(or (pred plistp)    ; plist/version string + name
+                                (pred stringp)))
+       (use-package-normalize--vc-arg arg))
+      (_ (use-package-error "Unrecognised argument to :vc.\
+ The keyword wants an argument of nil, t, a name of a package,\
+ or a cons-cell as accepted by `package-vc-selected-packages', where \
+ the accepted plist is augmented by a `:rev' keyword.")))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;; The main macro
@@ -1666,7 +1734,8 @@ use-package
                  (compare with `custom-set-variables').
 :custom-face     Call `custom-set-faces' with each face definition.
 :ensure          Loads the package using package.el if necessary.
-:pin             Pin the package to an archive."
+:pin             Pin the package to an archive.
+:vc              Integration with `package-vc.el'."
   (declare (indent defun))
   (unless (memq :disabled args)
     (macroexp-progn
diff --git a/lisp/use-package/use-package-ensure.el b/lisp/use-package/use-package-ensure.el
index dae0312dba..27d4f5ad4f 100644
--- a/lisp/use-package/use-package-ensure.el
+++ b/lisp/use-package/use-package-ensure.el
@@ -182,7 +182,8 @@ use-package-ensure-elpa
 
 ;;;###autoload
 (defun use-package-handler/:ensure (name _keyword ensure rest state)
-  (let* ((body (use-package-process-keywords name rest state)))
+  (let* ((body (use-package-process-keywords name rest state))
+         (ensure (unless (plist-member rest :vc) ensure)))
     ;; We want to avoid installing packages when the `use-package' macro is
     ;; being macro-expanded by elisp completion (see `lisp--local-variables'),
     ;; but still install packages when byte-compiling, to avoid requiring
diff --git a/test/lisp/use-package/use-package-tests.el b/test/lisp/use-package/use-package-tests.el
index e4586b04f2..4110f3a567 100644
--- a/test/lisp/use-package/use-package-tests.el
+++ b/test/lisp/use-package/use-package-tests.el
@@ -1951,6 +1951,52 @@ bind-key/845
     (should (eq (nth 1 binding) 'ignore))
     (should (eq (nth 2 binding) nil))))
 
+(ert-deftest use-package-test/:vc-1 ()
+  (match-expansion
+   (use-package foo :vc (:url "bar"))
+   `(unless (package-installed-p 'foo)
+      (package-vc-install '(foo :url "bar") nil))))
+
+(ert-deftest use-package-test/:vc-2 ()
+  (match-expansion
+   (use-package foo
+     :vc (baz . (:url "baz" :vc-backend "Git"
+                 :main-file qux.el :rev "rev-string")))
+   `(unless (package-installed-p 'baz)
+      (package-vc-install '(baz :url "baz" :vc-backend Git :main-file "qux.el")
+                          "rev-string"))))
+
+(ert-deftest use-package-test/:vc-3 ()
+  (match-expansion
+   (use-package foo :vc (bar . "baz"))
+   `(unless (package-installed-p 'bar)
+      (package-vc-install '(bar . "baz") nil))))
+
+(ert-deftest use-package-test/:vc-4 ()
+  (let ((load-path? '(pred (apply-partially
+                            #'string=
+                            (expand-file-name "bar" user-emacs-directory)))))
+    (match-expansion
+     (use-package foo :vc other-name :load-path "bar")
+     `(progn (eval-and-compile
+               (add-to-list 'load-path ,load-path?))
+             (unless (package-installed-p 'other-name)
+               (package-vc-install-from-checkout ,load-path? "other-name"))))))
+
+(ert-deftest use-package-test-normalize/:vc ()
+  (should (equal '(foo "version-string")
+                 (use-package-normalize/:vc 'foo :vc '("version-string"))))
+  (should (equal '(bar "version-string")
+                 (use-package-normalize/:vc 'foo :vc '((bar . "version-string")))))
+  (should (equal '(foo (:url "bar") "baz")
+                 (use-package-normalize/:vc 'foo :vc '((:url "bar" :rev "baz")))))
+  (should (equal '(foo)
+                 (use-package-normalize/:vc 'foo :vc '(t))))
+  (should (equal '(foo)
+                 (use-package-normalize/:vc 'foo :vc nil)))
+  (should (equal '(bar)
+                 (use-package-normalize/:vc 'foo :vc '(bar)))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; no-update-autoloads: t
-- 
2.39.0

>From 9e54b103366aaef8e303bf65787ad841c56483d1 Mon Sep 17 00:00:00 2001
From: Tony Zorman <[email-masked]>
Date: Thu, 29 Dec 2022 12:23:56 +0100
Subject: [PATCH 2/2] ; Document use-package's :vc keyword

* doc/misc/use-package.texi (Installing packages):
(Install package):
Add documentation for :vc and link to the related chapter in the Emacs
manual.

* etc/NEWS: Mention :vc keyword
---
 doc/misc/use-package.texi | 40 +++++++++++++++++++++++++++++++++++++--
 etc/NEWS                  | 10 ++++++++++
 2 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/doc/misc/use-package.texi b/doc/misc/use-package.texi
index c587d23d74..a4abbb77f9 100644
--- a/doc/misc/use-package.texi
+++ b/doc/misc/use-package.texi
@@ -1564,8 +1564,10 @@ Installing packages
 (@pxref{Package Installation,,, emacs, GNU Emacs Manual}).  The
 @code{use-package} macro provides the @code{:ensure} and @code{:pin}
 keywords that interface with that package manager to automatically
-install packages.  This is particularly useful if you use your init
-file on more than one system.
+install packages.  Further, the @code{:vc} keyword may be used to
+control how package sources are fetched (@pxref{Fetching Package
+Sources,,, emacs, GNU Emacs Manual}).  This is particularly useful if
+you use your init file on more than one system.
 
 @menu
 * Install package::
@@ -1617,6 +1619,40 @@ Install package
 You can override the above setting for a single package by adding
 @w{@code{:ensure nil}} to its declaration.
 
+@findex :vc
+The @code{:vc} keyword can be used to control how packages are
+fetched.  It accepts the same arguments as
+@code{package-vc-selected-packages}, except that a name need not
+explicitly given: it is inferred from the declaration.  Further, the
+accepted property list is augmented by a @code{:rev} keyword, which
+has the same shape as the @code{REV} argument to
+@code{package-vc-install}.
+
+For example,
+
+@lisp
+@group
+(use-package foo
+  :vc (:url "https://bar.com/foo"))
+@end group
+@end lisp
+
+would try—by invoking @code{package-vc-install}—to install the package
+@code{foo} from the specified remote.
+
+This can also be used for local packages, by combining it with the
+@code{:load-path} (@pxref{Load path}) keyword:
+
+@lisp
+@group
+(use-package foo
+  :vc t
+  :load-path "/path/to/foo/)
+@end group
+@end lisp
+
+The above dispatches to @code{package-vc-install-from-checkout}.
+
 @node Pinning packages
 @section Pinning packages using @code{:pin}
 @cindex installing package from specific archive
diff --git a/etc/NEWS b/etc/NEWS
index 83aa81eb4b..d8e8ed0dd2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -108,6 +108,16 @@ This command either fills a single paragraph in a defun, such as a
 doc-string, or a comment, or (re)indents the surrounding defun if
 point is not in a comment or a string.  It is by default bound to
 'M-q' in 'prog-mode' and all its descendants.
+
+** use-package
+
+*** New ':vc' keyword
+This keyword enables the user to control how packages are fetched by
+utilising 'package-vc.el'.  By default, it relays its arguments to
+'package-vc-install', but—when combined with the ':load-path'
+keyword—it can also call upon 'package-vc-install-from-checkout'
+instead.
+
 
 * New Modes and Packages in Emacs 30.1
 
-- 
2.39.0

-- 
Tony Zorman | https://tony-zorman.com/