feature/package+vc a4a825df82 9/9: Clone packages into a separate directory

[Philip Kaludercic]

branch: feature/package+vc
commit a4a825df829670f824de9b15583972f6898e0e18
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Clone packages into a separate directory
    
    * lisp/emacs-lisp/package-vc.el (package-vc-repository-store): Add new
    user option.
    (package-vc-unpack): Use 'package-vc-repository-store'.
    * lisp/emacs-lisp/package.el (package--delete-directory): Check and
    handle source packages.
    (package-delete): Invoke 'package--delete-directory' with an
    additional argument.
---
 lisp/emacs-lisp/package-vc.el | 33 +++++++++++++++++++++++++++------
 lisp/emacs-lisp/package.el    | 21 +++++++++++++++++----
 2 files changed, 44 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index d9903b3ca3..678b4f7a95 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -44,6 +44,7 @@
 (require 'lisp-mnt)
 (require 'vc)
 (require 'seq)
+(require 'xdg)
 
 (defgroup package-vc nil
   "Manage packages from VC checkouts."
@@ -89,6 +90,12 @@
                                               vc-handled-backends)))
   :version "29.1")
 
+(defcustom package-vc-repository-store
+  (expand-file-name "emacs/vc-packages" (xdg-data-home))
+  "Directory used by `package-vc-unpack' to store repositories."
+  :type 'directory
+  :version "29.1")
+
 (defun package-vc-commit (pkg)
   "Extract the commit of a development package PKG."
   (cl-assert (package-vc-p pkg))
@@ -150,25 +157,39 @@ The output is written out into PKG-FILE."
 
 (defun package-vc-unpack (pkg-desc)
   "Install the package described by PKG-DESC."
+  (unless (file-exists-p package-vc-repository-store)
+    (make-directory package-vc-repository-store t))
   (let* ((name (package-desc-name pkg-desc))
          (dirname (package-desc-full-name pkg-desc))
          (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)
+          (package--delete-directory pkg-dir pkg-desc)
         (error "There already exists a checkout for %s" name)))
     (pcase-let* ((attr (package-desc-extras pkg-desc))
                  (`(,backend ,repo ,dir ,branch)
                   (or (alist-get :upstream attr)
-                      (error "Source package has no repository"))))
-      (make-directory (file-name-directory pkg-dir) t)
+                      (error "Source package has no repository")))
+                 (repo-dir (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 repo))))
+
+      ;; Clone the repository into `repo-dir'.
+      (make-directory (file-name-directory repo-dir) t)
       (unless (setf (car (alist-get :upstream attr))
-                    (vc-clone backend repo pkg-dir))
+                    (vc-clone backend repo repo-dir))
         (error "Failed to clone %s from %s" name repo))
-      (when-let ((rev (or (alist-get :rev attr) branch)))
+
+      ;; Link from the right position in `repo-dir' to the package
+      ;; directory in the ELPA store.
+      (make-symbolic-link (file-name-concat repo-dir dir) pkg-dir)
+      (when-let ((default-directory repo-dir)
+                 (rev (or (alist-get :rev attr) branch)))
         (vc-retrieve-tag pkg-dir rev))
-      (when dir (setq pkg-dir (file-name-concat pkg-dir dir)))
 
       ;; In case the package was installed directly from source, the
       ;; dependency list wasn't know beforehand, and they might have
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index ad01dbc197..2748adddfb 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2407,15 +2407,28 @@ installed), maybe you need to 
\\[package-refresh-contents]")
          pkg))
 
 (declare-function comp-el-to-eln-filename "comp.c")
-(defun package--delete-directory (dir)
-  "Delete DIR recursively.
+(defvar package-vc-repository-store)
+(defun package--delete-directory (dir pkg-desc)
+  "Delete PKG-DESC directory DIR recursively.
 Clean-up the corresponding .eln files if Emacs is native
 compiled."
   (when (featurep 'native-compile)
     (cl-loop
      for file in (directory-files-recursively dir "\\.el\\'")
      do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
-  (delete-directory dir t))
+  (cond
+   ((not (package-vc-p pkg-desc))
+    (delete-directory dir t))
+   ((progn
+      (require 'package-vc)          ;load `package-vc-repository-store'
+      (file-in-directory-p dir package-vc-repository-store))
+    (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)))))
 
 (defun package-delete (pkg-desc &optional force nosave)
   "Delete package PKG-DESC.
@@ -2469,7 +2482,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)
+           (package--delete-directory dir pkg-desc)
            ;; Remove NAME-VERSION.signed and NAME-readme.txt files.
            ;;
            ;; NAME-readme.txt files are no longer created, but they