Re: feature/package-vc has been merged

[Philip Kaludercic <philipk@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 2284 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> But for `package-vc` that's already the case since it has complete control
>>> over how the `<foo>-pkg.el` and the `<foo>-autoloads.el` are generated.
>>
>> ..., this is handled by `package-vc--unpack-1' which up until now did
>> not depend on a package specification, just a package description.  This
>> is so, so that it can be invoked by `package-vc-refresh' or
>> `package-vc-install-from-checkout' which all don't necessarily have
>> specifications.  It would be imaginable to store the specification in a
>> file like <PKG>-spec.eld, but there are too many files already so this
>> is just getting more and more messy.
>>
>> If you believe that this is not worth it or shortsighted on my part,
>> I'll implement the code necessary for what you suggest to work.
>
> Ah... so this is extra info stored in the `<pkg>-pkg.el` file but only
> for packages installed by `package-vc`.  So it's not expected to appear
> in `<pkg>-pkg.el` coming from ELPA repositories.  

Right.

>                                                   But then it should not
> be used in `package.el`, only in `package-vc-...` functions, right?

I have attached the entire patch below.  There are a few points where we
want to have regular package.el functions also respect :lisp-dir, but
these changes mostly consist of just replacing package-desc-dir with an
auxiliary function that returns the lisp directory.

> BTW, I'm beginning to sense that maybe instead of storing `:lisp-dir` in
> the package description (of package-vc-installed-packages), we
> should/could store there the whole package-spec.  This way
> `package-vc-refresh` can use the package-spec and throw away the rest of
> the package description.

That would also be possible, I'd have to think about it and try it out.

> For `package-vc-install-from-checkout`, we need to "invent" a package
> spec anyway, right?

Well no, because that function uses `package-vc--unpack-1' that is
invoked during the regular installation after all the information from
the specification has been made use of.  But even if that weren't the
case, we'd just use the "empty" specification in this case,  because the
argument to `package-vc-install-from-checkout' is a lisp directory to
begin with.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-specifying-a-lisp-dir-for-package-descriptions.patch --]
[-- Type: text/x-diff, Size: 11518 bytes --]

From 1eeca3607efcc08b3534e9bbdaa57d2bd62839ec Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 8 Nov 2022 23:45:35 +0100
Subject: [PATCH] Allow specifying a :lisp-dir for package descriptions

* lisp/emacs-lisp/package-vc.el (package-vc-repository-store): Remove
obsolete variable.
(package-vc--unpack-1): Respect :lisp-dir.
(package-vc--unpack): Add :lisp-dir to the package description if
necessary.
* lisp/emacs-lisp/package.el (package-lisp-dir): Add new inline
function.
(package--reload-previously-loaded): Use 'package-lisp-dir'.
(package-activate-1): Use 'package-lisp-dir'.
(package-generate-autoloads): Change first parameter from NAME to
PKG-DESC.
(package--make-autoloads-and-stuff): Use 'package-lisp-dir'.
(package--compile): Use 'package-lisp-dir'.
(package--native-compile-async): Use 'package-lisp-dir'.
(package--delete-directory): Remove 'package-vc-p' check and drop
second parameter.
(package-delete): Remove second argument when invoking
'package--delete-directory'.
(package-recompile): Use 'package-lisp-dir'.
---
 lisp/emacs-lisp/package-vc.el | 34 +++++-------------
 lisp/emacs-lisp/package.el    | 65 ++++++++++++++++++++---------------
 2 files changed, 46 insertions(+), 53 deletions(-)

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index f8948905ea..93a96abb68 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -100,12 +100,6 @@ package-vc-heuristic-alist
                                               vc-handled-backends)))
   :version "29.1")
 
-(defcustom package-vc-repository-store
-  (expand-file-name "emacs/vc-packages" (xdg-data-home))
-  "Directory used by to store repositories."
-  :type 'directory
-  :version "29.1")
-
 (defcustom package-vc-default-backend 'Git
   "Default VC backend used when cloning a package repository.
 If no repository type was specified or could be guessed by
@@ -386,7 +380,7 @@ package-vc--unpack-1
   ;; dependency list wasn't know beforehand, and they might have
   ;; to be installed explicitly.
   (let (deps)
-    (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+    (dolist (file (directory-files (package-lisp-dir pkg-desc) t "\\.el\\'" t))
       (with-temp-buffer
         (insert-file-contents file)
         (when-let* ((require-lines (lm-header-multiline "package-requires")))
@@ -402,10 +396,9 @@ package-vc--unpack-1
      (package-compute-transaction nil (delete-dups deps))))
 
   (let ((default-directory (file-name-as-directory pkg-dir))
-        (name (package-desc-name pkg-desc))
         (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir)))
     ;; Generate autoloads
-    (package-generate-autoloads name pkg-dir)
+    (package-generate-autoloads pkg-desc pkg-dir)
 
     ;; Generate package file
     (package-vc--generate-description-file pkg-desc pkg-file)
@@ -492,28 +485,17 @@ package-vc--unpack
   (pcase-let* (((map :url :lisp-dir) pkg-spec)
                (name (package-desc-name pkg-desc))
                (dirname (package-desc-full-name pkg-desc))
-               (pkg-dir (expand-file-name dirname package-user-dir))
-               (real-dir (if (null lisp-dir)
-                             pkg-dir
-                           (unless (file-exists-p package-vc-repository-store)
-                             (make-directory package-vc-repository-store t))
-                           (file-name-concat
-                            package-vc-repository-store
-                            ;; FIXME: We aren't sure this directory
-                            ;; will be unique, but we can try other
-                            ;; names to avoid an unnecessary error.
-                            (file-name-base url)))))
+               (pkg-dir (expand-file-name dirname package-user-dir)))
     (setf (package-desc-dir pkg-desc) pkg-dir)
     (when (file-exists-p pkg-dir)
       (if (yes-or-no-p "Overwrite previous checkout?")
-          (package--delete-directory pkg-dir pkg-desc)
+          (package--delete-directory pkg-dir)
         (error "There already exists a checkout for %s" name)))
-    (package-vc--clone pkg-desc pkg-spec real-dir rev)
-    (unless (eq pkg-dir real-dir)
-      ;; Link from the right position in `repo-dir' to the package
-      ;; directory in the ELPA store.
-      (make-symbolic-link (file-name-concat real-dir lisp-dir) pkg-dir))
+    (package-vc--clone pkg-desc pkg-spec pkg-dir rev)
 
+    (when lisp-dir
+      (push (cons :lisp-dir lisp-dir)
+            (package-desc-extras pkg-desc)))
     (package-vc--unpack-1 pkg-desc pkg-dir)))
 
 (defun package-vc--read-package-name (prompt &optional allow-url installed)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a7bcdd214c..bf6849af65 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -462,6 +462,15 @@ package-vc-p
   (inline-letevals (pkg-desc)
     (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))))
 
+(define-inline package-lisp-dir (pkg-desc)
+  "Return the directory with Lisp files for PKG-DESC."
+  (inline-letevals (pkg-desc)
+    (inline-quote
+     (let* ((extras (package-desc-extras ,pkg-desc))
+            (lisp-dir (alist-get :lisp-dir extras))
+            (dir (package-desc-dir ,pkg-desc)))
+       (file-name-directory (file-name-concat dir lisp-dir))))))
+
 (cl-defstruct (package-desc
                ;; Rename the default constructor from `make-package-desc'.
                (:constructor package-desc-create)
@@ -827,7 +836,7 @@ package--reload-previously-loaded
 byte-compilation of the new package to fail."
   (with-demoted-errors "Error in package--load-files-for-activation: %s"
     (let* (result
-           (dir (package-desc-dir pkg-desc))
+           (dir (package-lisp-dir pkg-desc))
            ;; A previous implementation would skip `dir' itself.
            ;; However, in normal use reloading from the same directory
            ;; never happens anyway, while in certain cases external to
@@ -891,7 +900,7 @@ package-activate-1
           (package--reload-previously-loaded pkg-desc))
         (with-demoted-errors "Error loading autoloads: %s"
           (load (package--autoloads-file-name pkg-desc) nil t))
-        (add-to-list 'load-path (directory-file-name pkg-dir)))
+        (add-to-list 'load-path (package-lisp-dir pkg-desc)))
       ;; Add info node.
       (when (file-exists-p (expand-file-name "dir" pkg-dir))
         ;; FIXME: not the friendliest, but simple.
@@ -1080,9 +1089,10 @@ package-autoload-ensure-default-file
 (defvar autoload-timestamps)
 (defvar version-control)
 
-(defun package-generate-autoloads (name pkg-dir)
-  "Generate autoloads in PKG-DIR for package named NAME."
-  (let* ((auto-name (format "%s-autoloads.el" name))
+(defun package-generate-autoloads (pkg-desc pkg-dir)
+  "Generate autoloads for PKG-DESC in PKG-DIR."
+  (let* ((name (package-desc-name pkg-desc))
+         (auto-name (format "%s-autoloads.el" name))
          ;;(ignore-name (concat name "-pkg.el"))
          (output-file (expand-file-name auto-name pkg-dir))
          ;; We don't need 'em, and this makes the output reproducible.
@@ -1090,17 +1100,29 @@ package-generate-autoloads
          (backup-inhibited t)
          (version-control 'never))
     (loaddefs-generate
-     pkg-dir output-file
-     nil
-     "(add-to-list 'load-path (directory-file-name
-                         (or (file-name-directory #$) (car load-path))))")
+     (package-lisp-dir pkg-desc)
+     output-file nil
+     (prin1-to-string
+      `(add-to-list
+        'load-path
+        ;; Add the directory that will contain the autoload file to
+        ;; the load path.  We don't hard-code `pkg-dir', to avoid
+        ;; issues if the package directory is moved around.
+        ,(if-let ((base '(or (and load-file-name (file-name-directory load-file-name))
+                             (car load-path)))
+                  (extras (package-desc-extras pkg-desc))
+                  (lisp-dir (alist-get :lisp-dir extras)))
+             ;; In case the package specification indicates that the lisp
+             ;; files are found in a subdirectory, append that directory.
+             `(expand-file-name ,lisp-dir ,base)
+           base))))
     (let ((buf (find-buffer-visiting output-file)))
       (when buf (kill-buffer buf)))
     auto-name))
 
 (defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
   "Generate autoloads, description file, etc., for PKG-DESC installed at PKG-DIR."
-  (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
+  (package-generate-autoloads pkg-desc pkg-dir)
   (let ((desc-file (expand-file-name (package--description-file pkg-dir)
                                      pkg-dir)))
     (unless (file-exists-p desc-file)
@@ -1118,7 +1140,7 @@ package--compile
   (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc))
         (warning-minimum-level :error)
         (load-path load-path))
-    (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
+    (byte-recompile-directory (package-lisp-dir pkg-desc) 0 t)))
 
 (defun package--native-compile-async (pkg-desc)
   "Native compile installed package PKG-DESC asynchronously.
@@ -1126,7 +1148,7 @@ package--native-compile-async
 `package-activate-1'."
   (when (native-comp-available-p)
     (let ((warning-minimum-level :error))
-      (native-compile-async (package-desc-dir pkg-desc) t))))
+      (native-compile-async (package-lisp-dir pkg-desc) t))))
 
 ;;;; Inferring package from current buffer
 (defun package-read-from-string (str)
@@ -2419,7 +2441,7 @@ package--newest-p
 
 (declare-function comp-el-to-eln-filename "comp.c")
 (defvar package-vc-repository-store)
-(defun package--delete-directory (dir pkg-desc)
+(defun package--delete-directory (dir)
   "Delete PKG-DESC directory DIR recursively.
 Clean-up the corresponding .eln files if Emacs is native
 compiled."
@@ -2427,18 +2449,7 @@ package--delete-directory
     (cl-loop
      for file in (directory-files-recursively dir "\\.el\\'")
      do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
-  (if (and (package-vc-p pkg-desc)
-           (require 'package-vc)   ;load `package-vc-repository-store'
-           (file-in-directory-p dir package-vc-repository-store))
-      (progn
-        (delete-directory
-         (expand-file-name
-          (car (file-name-split
-                (file-relative-name dir package-vc-repository-store)))
-          package-vc-repository-store)
-         t)
-        (delete-file (directory-file-name dir)))
-    (delete-directory dir t)))
+  (delete-directory dir t))
 
 
 (defun package-delete (pkg-desc &optional force nosave)
@@ -2493,7 +2504,7 @@ package-delete
                   (package-desc-name pkg-used-elsewhere-by)))
           (t
            (add-hook 'post-command-hook #'package-menu--post-refresh)
-           (package--delete-directory dir pkg-desc)
+           (package--delete-directory dir)
            ;; Remove NAME-VERSION.signed and NAME-readme.txt files.
            ;;
            ;; NAME-readme.txt files are no longer created, but they
@@ -2549,7 +2560,7 @@ package-recompile
     ;; load them (in case they contain byte code/macros that are now
     ;; invalid).
     (dolist (elc (directory-files-recursively
-                  (package-desc-dir pkg-desc) "\\.elc\\'"))
+                  (package-lisp-dir pkg-desc) "\\.elc\\'"))
       (delete-file elc))
     (package--compile pkg-desc)))
 
-- 
2.35.1