Respect :lisp-dir in package specs by loading a sub-directory

* 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--delete-directory): Check if a
directory is a symbolic link.
This commit is contained in:
Philip Kaludercic 2022-11-08 23:45:35 +01:00
commit d67b66f8ab
2 changed files with 38 additions and 44 deletions

View file

@ -49,7 +49,6 @@
(require 'lisp-mnt)
(require 'vc)
(require 'seq)
(require 'xdg)
(defgroup package-vc nil
"Manage packages from VC checkouts."
@ -100,12 +99,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
@ -390,7 +383,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")))
@ -406,10 +399,26 @@ 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)
(let* ((name (package-desc-name pkg-desc))
(auto-name (format "%s-autoloads.el" name))
(extras (package-desc-extras pkg-desc))
(lisp-dir (alist-get :lisp-dir extras)))
(package-generate-autoloads
name (file-name-concat pkg-dir lisp-dir))
(when lisp-dir
(write-region
(with-temp-buffer
(insert ";; Autoload indirection for package-vc\n\n")
(prin1 `(load (expand-file-name
,(file-name-concat lisp-dir auto-name)
(or (and load-file-name
(file-name-directory load-file-name))
(car load-path))))
(current-buffer))
(buffer-string))
nil (expand-file-name auto-name pkg-dir))))
;; Generate package file
(package-vc--generate-description-file pkg-desc pkg-file)
@ -496,28 +505,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)

View file

@ -1090,10 +1090,15 @@ 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))))")
pkg-dir 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.
(or (and load-file-name (file-name-directory load-file-name))
(car load-path)))))
(let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@ -2419,7 +2424,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,17 +2432,8 @@ 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)))
(if (file-symlink-p (directory-file-name dir))
(delete-file (directory-file-name dir))
(delete-directory dir t)))
@ -2493,7 +2489,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