diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 233 |
1 files changed, 154 insertions, 79 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5fe018700a4..e23a61c58a4 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -378,10 +378,8 @@ If so, and variable `package-check-signature' is `allow-unsigned', return `allow-unsigned', otherwise return the value of variable `package-check-signature'." (if (eq package-check-signature 'allow-unsigned) - (progn - (require 'epg-config) - (and (epg-find-configuration 'OpenPGP) - 'allow-unsigned)) + (and (epg-find-configuration 'OpenPGP) + 'allow-unsigned) package-check-signature)) (defcustom package-unsigned-archives nil @@ -611,7 +609,7 @@ package." (package-archive-priority (package-desc-archive pkg-desc))) (defun package--parse-elpaignore (pkg-desc) - "Return the of regular expression to match files ignored by PKG-DESC." + "Return a list of regular expressions to match files ignored by PKG-DESC." (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc))) (ignore (expand-file-name ".elpaignore" pkg-dir)) files) @@ -903,13 +901,7 @@ correspond to previously loaded files." (when reload (package--reload-previously-loaded pkg-desc)) (with-demoted-errors "Error loading autoloads: %s" - (load (package--autoloads-file-name pkg-desc) nil t)) - ;; FIXME: Since 2013 (commit 4fac34cee97a), the autoload files take - ;; care of changing the `load-path', so maybe it's time to - ;; remove this fallback code? - (unless (or (member (file-name-as-directory pkg-dir) load-path) - (member (directory-file-name pkg-dir) load-path)) - (add-to-list 'load-path pkg-dir))) + (load (package--autoloads-file-name pkg-desc) nil t))) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. @@ -970,7 +962,6 @@ Newer versions are always activated, regardless of FORCE." "Untar the current buffer. This uses `tar-untar-buffer' from Tar mode. All files should untar into a directory named DIR; otherwise, signal an error." - (require 'tar-mode) (tar-mode) ;; Make sure everything extracts into DIR. (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) @@ -1200,7 +1191,7 @@ boundaries." ;; the earliest in version 31.1. The idea is to phase out the ;; requirement for a "footer line" without unduly impacting users ;; on earlier Emacs versions. See Bug#26490 for more details. - (unless (search-forward (concat ";;; " file-name ".el ends here")) + (unless (search-forward (concat ";;; " file-name ".el ends here") nil 'move) (lwarn '(package package-format) :warning "Package lacks a terminating comment")) ;; Try to include a trailing newline. @@ -1228,8 +1219,8 @@ boundaries." :url website :keywords keywords :maintainer - ;; For backward compatibility, use a single string if there's only - ;; one maintainer (the most common case). + ;; For backward compatibility, use a single cons-cell if + ;; there's only one maintainer (the most common case). (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints))) :authors (lm-authors))))) @@ -1237,15 +1228,14 @@ boundaries." "Read a `define-package' form in current buffer. Return the pkg-desc, with desc-kind set to KIND." (goto-char (point-min)) - (unwind-protect - (let* ((pkg-def-parsed (read (current-buffer))) - (pkg-desc - (when (eq (car pkg-def-parsed) 'define-package) - (apply #'package-desc-from-define - (append (cdr pkg-def-parsed)))))) - (when pkg-desc - (setf (package-desc-kind pkg-desc) kind) - pkg-desc)))) + (let* ((pkg-def-parsed (read (current-buffer))) + (pkg-desc + (when (eq (car pkg-def-parsed) 'define-package) + (apply #'package-desc-from-define + (append (cdr pkg-def-parsed)))))) + (when pkg-desc + (setf (package-desc-kind pkg-desc) kind) + pkg-desc))) (declare-function tar-get-file-descriptor "tar-mode" (file)) (declare-function tar--extract "tar-mode" (descriptor)) @@ -1992,8 +1982,11 @@ Used to populate `package-selected-packages'." (defun package--save-selected-packages (&optional value) "Set and save `package-selected-packages' to VALUE." - (when value - (setq package-selected-packages value)) + (when (or value after-init-time) + ;; It is valid to set it to nil, for example when the last package + ;; is uninstalled. But it shouldn't be done at init time, to + ;; avoid overwriting configurations that haven't yet been loaded. + (setq package-selected-packages (sort value #'string<))) (if after-init-time (customize-save-variable 'package-selected-packages package-selected-packages) (add-hook 'after-init-hook #'package--save-selected-packages))) @@ -2268,25 +2261,26 @@ had been enabled." ;;;###autoload (defun package-upgrade (name) - "Upgrade package NAME if a newer version exists. - -Currently, packages which are part of the Emacs distribution -cannot be upgraded that way. To enable upgrades of such a -package using this command, first upgrade the package to a -newer version from ELPA by using `\\<package-menu-mode-map>\\[package-menu-mark-install]' after `\\[list-packages]'." + "Upgrade package NAME if a newer version exists." (interactive (list (completing-read - "Upgrade package: " (package--upgradeable-packages) nil t))) + "Upgrade package: " (package--upgradeable-packages t) nil t))) (let* ((package (if (symbolp name) name (intern name))) - (pkg-desc (cadr (assq package package-alist)))) - (if (package-vc-p pkg-desc) + (pkg-desc (cadr (assq package package-alist))) + (package-install-upgrade-built-in (not pkg-desc))) + ;; `pkg-desc' will be nil when the package is an "active built-in". + (if (and pkg-desc (package-vc-p pkg-desc)) (package-vc-upgrade pkg-desc) - (package-delete pkg-desc 'force 'dont-unselect) - (package-install package 'dont-select)))) - -(defun package--upgradeable-packages () + (when pkg-desc + (package-delete pkg-desc 'force 'dont-unselect)) + (package-install package + ;; An active built-in has never been "selected" + ;; before. Mark it as installed explicitly. + (and pkg-desc 'dont-select))))) + +(defun package--upgradeable-packages (&optional include-builtins) ;; Initialize the package system to get the list of package ;; symbols for completion. (package--archives-initialize) @@ -2297,11 +2291,21 @@ newer version from ELPA by using `\\<package-menu-mode-map>\\[package-menu-mark- (or (let ((available (assq (car elt) package-archive-contents))) (and available - (version-list-< - (package-desc-version (cadr elt)) - (package-desc-version (cadr available))))) - (package-vc-p (cadr (assq (car elt) package-alist))))) - package-alist))) + (or (and + include-builtins + (not (package-desc-version (cadr elt)))) + (version-list-< + (package-desc-version (cadr elt)) + (package-desc-version (cadr available)))))) + (package-vc-p (cadr elt)))) + (if include-builtins + (append package-alist + (mapcan + (lambda (elt) + (when (not (assq (car elt) package-alist)) + (list (list (car elt) (package--from-builtin elt))))) + package--builtins)) + package-alist)))) ;;;###autoload (defun package-upgrade-all (&optional query) @@ -2311,8 +2315,9 @@ interactively, QUERY is always true. Currently, packages which are part of the Emacs distribution are not upgraded by this command. To enable upgrading such a package -using this command, first upgrade the package to a newer version -from ELPA by using `\\<package-menu-mode-map>\\[package-menu-mark-install]' after `\\[list-packages]'." +using this command, first upgrade the package to a newer version +from ELPA by either using `\\[package-upgrade]' or +`\\<package-menu-mode-map>\\[package-menu-mark-install]' after `\\[list-packages]'." (interactive (list (not noninteractive))) (package-refresh-contents) (let ((upgradeable (package--upgradeable-packages))) @@ -2328,12 +2333,25 @@ from ELPA by using `\\<package-menu-mode-map>\\[package-menu-mark-install]' afte (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. @@ -2469,7 +2487,9 @@ 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\\'") + for file in (directory-files-recursively dir + ;; Exclude lockfiles + (rx bos (or (and "." (not "#")) (not ".")) (* nonl) ".el" eos)) do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) (if (file-symlink-p (directory-file-name dir)) (delete-file (directory-file-name dir)) @@ -2501,8 +2521,12 @@ If NOSAVE is non-nil, the package is not removed from nil t))) (list (cdr (assoc package-name package-table)) current-prefix-arg nil)))) - (let ((dir (package-desc-dir pkg-desc)) - (name (package-desc-name pkg-desc)) + (let* ((dir (package-desc-dir pkg-desc)) + (name (package-desc-name pkg-desc)) + (new-package-alist (let ((pkgs (assq name package-alist))) + (if (null (remove pkg-desc (cdr pkgs))) + (remq pkgs package-alist) + package-alist))) pkg-used-elsewhere-by) ;; If the user is trying to delete this package, they definitely ;; don't want it marked as selected, so we remove it from @@ -2521,7 +2545,8 @@ If NOSAVE is non-nil, the package is not removed from (package-desc-full-name pkg-desc))) ((and (null force) (setq pkg-used-elsewhere-by - (package--used-elsewhere-p pkg-desc))) + (let ((package-alist new-package-alist)) + (package--used-elsewhere-p pkg-desc)))) ;See bug#65475 ;; Don't delete packages used as dependency elsewhere. (error "Package `%s' is used by `%s' as dependency, not deleting" (package-desc-full-name pkg-desc) @@ -2542,10 +2567,7 @@ If NOSAVE is non-nil, the package is not removed from (when (file-exists-p file) (delete-file file)))) ;; Update package-alist. - (let ((pkgs (assq name package-alist))) - (delete pkg-desc pkgs) - (unless (cdr pkgs) - (setq package-alist (delq pkgs package-alist)))) + (setq package-alist new-package-alist) (package--quickstart-maybe-refresh) (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) @@ -2623,6 +2645,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. @@ -2738,7 +2811,8 @@ Helper function for `describe-package'." (status (if desc (package-desc-status desc) "orphan")) (incompatible-reason (package--incompatible-p desc)) (signed (if desc (package-desc-signed desc))) - (maintainer (cdr (assoc :maintainer extras))) + (maintainers (or (cdr (assoc :maintainers extras)) + (list (cdr (assoc :maintainer extras))))) (authors (cdr (assoc :authors extras))) (news (and-let* (pkg-dir ((not built-in)) @@ -2873,19 +2947,21 @@ Helper function for `describe-package'." 'action 'package-keyword-button-action) (insert " ")) (insert "\n")) - (when maintainer - (package--print-help-section "Maintainer") - (package--print-email-button maintainer)) - (when authors + (when maintainers + (unless (proper-list-p maintainers) + (setq maintainers (list maintainers))) (package--print-help-section - (if (= (length authors) 1) - "Author" - "Authors")) - (package--print-email-button (pop authors)) - ;; If there's more than one author, indent the rest correctly. - (dolist (name authors) - (insert (make-string 13 ?\s)) - (package--print-email-button name))) + (if (cdr maintainers) "Maintainers" "Maintainer")) + (dolist (maintainer maintainers) + (when (bolp) + (insert (make-string 13 ?\s))) + (package--print-email-button maintainer))) + (when authors + (package--print-help-section (if (cdr authors) "Authors" "Author")) + (dolist (author authors) + (when (bolp) + (insert (make-string 13 ?\s))) + (package--print-email-button author))) (let* ((all-pkgs (append (cdr (assq name package-alist)) (cdr (assq name package-archive-contents)) (let ((bi (assq name package--builtins))) @@ -3146,8 +3222,7 @@ The most useful commands here are: `[("Package" ,package-name-column-width package-menu--name-predicate) ("Version" ,package-version-column-width package-menu--version-predicate) ("Status" ,package-status-column-width package-menu--status-predicate) - ,@(if (cdr package-archives) - `(("Archive" ,package-archive-column-width package-menu--archive-predicate))) + ("Archive" ,package-archive-column-width package-menu--archive-predicate) ("Description" 0 package-menu--description-predicate)]) (setq tabulated-list-padding 2) (setq tabulated-list-sort-key (cons "Status" nil)) @@ -3587,9 +3662,8 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (package-desc-version pkg))) 'font-lock-face face) ,(propertize status 'font-lock-face face) - ,@(if (cdr package-archives) - (list (propertize (or (package-desc-archive pkg) "") - 'font-lock-face face))) + ,(propertize (or (package-desc-archive pkg) "") + 'font-lock-face face) ,(propertize (package-desc-summary pkg) 'font-lock-face 'package-description)]))) @@ -4645,6 +4719,7 @@ will be signaled in that case." (package--print-email-button maint) (string-trim (substring-no-properties (buffer-string)))))))) +;;;###autoload (defun package-report-bug (desc) "Prepare a message to send to the maintainers of a package. DESC must be a `package-desc' object." |