Add command to start Emacs with specific packages
* lisp/emacs-lisp/package.el (package--dependencies): Extend function to handle and return package descriptors. (package-isolate): Add new command. * etc/NEWS: Announce new command.
This commit is contained in:
parent
fa9197fcb0
commit
41ff369917
2 changed files with 79 additions and 6 deletions
9
etc/NEWS
9
etc/NEWS
|
@ -514,6 +514,15 @@ project, that you can quickly select using 'project-switch-project'
|
|||
When non-nil, package specifications with side-effects for building
|
||||
software will be used when building a package.
|
||||
|
||||
---
|
||||
*** New command to start an inferior Emacs loading only specific packages.
|
||||
The new command 'package-isolate' will start a new Emacs process, as
|
||||
a sub-process of Emacs where you invoke the command, in a way that
|
||||
causes the new process to load only some of the installed packages.
|
||||
The command prompts for the packages to activate in this
|
||||
sub-process, and is intended for testing Emacs and/or the packages
|
||||
in a clean environment.
|
||||
|
||||
** Flymake
|
||||
|
||||
+++
|
||||
|
|
|
@ -2330,12 +2330,25 @@ from ELPA by either using `\\[package-upgrade]' or
|
|||
(mapc #'package-upgrade upgradeable))))
|
||||
|
||||
(defun package--dependencies (pkg)
|
||||
"Return a list of all dependencies PKG has.
|
||||
This is done recursively."
|
||||
;; Can we have circular dependencies? Assume "nope".
|
||||
(when-let* ((desc (cadr (assq pkg package-archive-contents)))
|
||||
(deps (mapcar #'car (package-desc-reqs desc))))
|
||||
(delete-dups (apply #'nconc deps (mapcar #'package--dependencies deps)))))
|
||||
"Return a list of all transitive dependencies of PKG.
|
||||
If PKG is a package descriptor, the return value is a list of
|
||||
package descriptors. If PKG is a symbol designating a package,
|
||||
the return value is a list of symbols designating packages."
|
||||
(when-let* ((desc (if (package-desc-p pkg) pkg
|
||||
(cadr (assq pkg package-archive-contents)))))
|
||||
;; Can we have circular dependencies? Assume "nope".
|
||||
(let ((all (named-let more ((pkg-desc desc))
|
||||
(let (deps)
|
||||
(dolist (req (package-desc-reqs pkg-desc))
|
||||
(setq deps (nconc
|
||||
(catch 'found
|
||||
(dolist (p (apply #'append (mapcar #'cdr (package--alist))))
|
||||
(when (and (string= (car req) (package-desc-name p))
|
||||
(version-list-<= (cadr req) (package-desc-version p)))
|
||||
(throw 'found (more p)))))
|
||||
deps)))
|
||||
(delete-dups (cons pkg-desc deps))))))
|
||||
(remq pkg (mapcar (if (package-desc-p pkg) #'identity #'package-desc-name) all)))))
|
||||
|
||||
(defun package-strip-rcs-id (str)
|
||||
"Strip RCS version ID from the version string STR.
|
||||
|
@ -2625,6 +2638,57 @@ will be deleted."
|
|||
removable))
|
||||
(message "Nothing to autoremove")))))
|
||||
|
||||
(defun package-isolate (packages &optional temp-init)
|
||||
"Start an uncustomised Emacs and only load a set of PACKAGES.
|
||||
If TEMP-INIT is non-nil, or when invoked with a prefix argument,
|
||||
the Emacs user directory is set to a temporary directory."
|
||||
(interactive
|
||||
(cl-loop for p in (cl-loop for p in (package--alist) append (cdr p))
|
||||
unless (package-built-in-p p)
|
||||
collect (cons (package-desc-full-name p) p) into table
|
||||
finally return
|
||||
(list (cl-loop for c in (completing-read-multiple
|
||||
"Isolate packages: " table
|
||||
nil t)
|
||||
collect (alist-get c table nil nil #'string=))
|
||||
current-prefix-arg)))
|
||||
(let* ((name (concat "package-isolate-"
|
||||
(mapconcat #'package-desc-full-name packages ",")))
|
||||
(all-packages (delete-consecutive-dups
|
||||
(sort (append packages (mapcan #'package--dependencies packages))
|
||||
(lambda (p0 p1)
|
||||
(string< (package-desc-name p0) (package-desc-name p1))))))
|
||||
initial-scratch-message package-load-list)
|
||||
(with-temp-buffer
|
||||
(insert ";; This is an isolated testing environment, with these packages enabled:\n\n")
|
||||
(dolist (package all-packages)
|
||||
(push (list (package-desc-name package)
|
||||
(package-version-join (package-desc-version package)))
|
||||
package-load-list)
|
||||
(insert ";; - " (package-desc-full-name package))
|
||||
(unless (memq package packages)
|
||||
(insert " (dependency)"))
|
||||
(insert "\n"))
|
||||
(insert "\n")
|
||||
(setq initial-scratch-message (buffer-string)))
|
||||
(apply #'start-process (concat "*" name "*") nil
|
||||
(list (expand-file-name invocation-name invocation-directory)
|
||||
"--quick" "--debug-init"
|
||||
"--init-directory" (if temp-init
|
||||
(make-temp-file name t)
|
||||
user-emacs-directory)
|
||||
(format "--eval=%S"
|
||||
`(progn
|
||||
(setq initial-scratch-message ,initial-scratch-message)
|
||||
|
||||
(require 'package)
|
||||
,@(mapcar
|
||||
(lambda (dir)
|
||||
`(add-to-list 'package-directory-list ,dir))
|
||||
(cons package-user-dir package-directory-list))
|
||||
(setq package-load-list ',package-load-list)
|
||||
(package-initialize)))))))
|
||||
|
||||
|
||||
;;;; Package description buffer.
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue