From 1eeca3607efcc08b3534e9bbdaa57d2bd62839ec Mon Sep 17 00:00:00 2001 From: Philip Kaludercic 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