From a4a825df829670f824de9b15583972f6898e0e18 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 8 Oct 2022 00:13:55 +0200 Subject: [PATCH] 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 d9903b3ca3d..678b4f7a953 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 ad01dbc197e..2748adddfb6 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 -- 2.39.5