scratch/package-vc-fixes 1eeca3607e 13/16: Allow specifying a :lisp-dir for package descriptions

[Philip Kaludercic]

branch: scratch/package-vc-fixes
commit 1eeca3607efcc08b3534e9bbdaa57d2bd62839ec
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    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 @@
                                               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 @@ documentation and marking the package as installed."
   ;; 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 @@ documentation and marking the package as installed."
      (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 @@ checkout.  This overrides the `:branch' attribute in 
PKG-SPEC."
   (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 @@ synchronously."
   (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 @@ redefinitions, the overlooking of which would cause
 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 @@ correspond to previously loaded files."
           (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 @@ untar into a directory named DIR; otherwise, signal an 
error."
 (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 @@ untar into a directory named DIR; otherwise, signal an 
error."
          (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 @@ This assumes that `pkg-desc' has already been activated 
with
   (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 @@ This assumes that `pkg-desc' has already been activated 
with
 `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 @@ installed), maybe you need to 
\\[package-refresh-contents]")
 
 (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 @@ compiled."
     (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 @@ If NOSAVE is non-nil, the package is not removed from
                   (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 @@ object."
     ;; 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)))