diff options
Diffstat (limited to 'lisp/emacs-lisp/package.el')
| -rw-r--r-- | lisp/emacs-lisp/package.el | 180 |
1 files changed, 92 insertions, 88 deletions
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index be3b85f3179..b9a8dacab15 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -837,11 +837,15 @@ PKG-DESC is a `package-desc' object." (unless (equal file result) (throw 'done result)))))) -(defun package--reload-previously-loaded (pkg-desc) +(defun package--reload-previously-loaded (pkg-desc &optional warn) "Force reimportation of files in PKG-DESC already present in `load-history'. New editions of files contain macro definitions and redefinitions, the overlooking of which would cause -byte-compilation of the new package to fail." +byte-compilation of the new package to fail. +If WARN is a string, display a warning (using WARN as a format string) +before reloading the files. WARN must have two %-sequences +corresponding to package name (a symbol) and a list of files loaded (as +sexps)." (with-demoted-errors "Error in package--load-files-for-activation: %s" (let* (result (dir (package-desc-dir pkg-desc)) @@ -858,25 +862,29 @@ byte-compilation of the new package to fail." (cl-remove-if-not #'stringp (mapcar #'car load-history))))) (dolist (file files) - (when-let ((library (package--library-stem - (file-relative-name file dir))) - (canonical (locate-library library nil effective-path)) - (truename (file-truename canonical)) - ;; Normally, all files in a package are compiled by - ;; now, but don't assume that. E.g. different - ;; versions can add or remove `no-byte-compile'. - (altname (if (string-suffix-p ".el" truename) - (replace-regexp-in-string - "\\.el\\'" ".elc" truename t) - (replace-regexp-in-string - "\\.elc\\'" ".el" truename t))) - (found (or (member truename history) - (and (not (string= altname truename)) - (member altname history)))) - (recent-index (length found))) + (when-let* ((library (package--library-stem + (file-relative-name file dir))) + (canonical (locate-library library nil effective-path)) + (truename (file-truename canonical)) + ;; Normally, all files in a package are compiled by + ;; now, but don't assume that. E.g. different + ;; versions can add or remove `no-byte-compile'. + (altname (if (string-suffix-p ".el" truename) + (replace-regexp-in-string + "\\.el\\'" ".elc" truename t) + (replace-regexp-in-string + "\\.elc\\'" ".el" truename t))) + (found (or (member truename history) + (and (not (string= altname truename)) + (member altname history)))) + (recent-index (length found))) (unless (equal (file-name-base library) (format "%s-autoloads" (package-desc-name pkg-desc))) (push (cons (expand-file-name library dir) recent-index) result)))) + (when (and result warn) + (display-warning 'package + (format warn (package-desc-name pkg-desc) + (mapcar #'car result)))) (mapc (lambda (c) (load (car c) nil t)) (sort result (lambda (x y) (< (cdr x) (cdr y)))))))) @@ -904,8 +912,11 @@ correspond to previously loaded files." (if (listp package--quickstart-pkgs) ;; We're only collecting the set of packages to activate! (push pkg-desc package--quickstart-pkgs) - (when reload - (package--reload-previously-loaded pkg-desc)) + (when (or reload (assq name package--builtin-versions)) + (package--reload-previously-loaded + pkg-desc (unless reload + "Package %S is activated too late. +The following files have already been loaded: %S"))) (with-demoted-errors "Error loading autoloads: %s" (load (package--autoloads-file-name pkg-desc) nil t))) ;; Add info node. @@ -1157,6 +1168,7 @@ Signal an error if the entire string was not used." (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-package-requires "lisp-mnt" (&optional file)) +(declare-function lm-package-version "lisp-mnt" (&optional file)) (declare-function lm-website "lisp-mnt" (&optional file)) (declare-function lm-keywords-list "lisp-mnt" (&optional file)) (declare-function lm-maintainers "lisp-mnt" (&optional file)) @@ -1172,37 +1184,16 @@ boundaries." (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) (error "Package lacks a file header")) (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) - (start (line-beginning-position))) + (desc (match-string-no-properties 2))) (require 'lisp-mnt) - ;; This warning was added in Emacs 27.1, and should be removed at - ;; 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") nil 'move) - ;; Starting in Emacs 30.1, avoid warning if the minimum Emacs - ;; version is specified as 30.1 or later. - (let ((min-emacs (cadar (seq-filter (lambda (x) (eq (car x) 'emacs)) - (lm-package-requires))))) - (when (or (null min-emacs) - (version< min-emacs "30.1")) - (lwarn '(package package-format) :warning - "Package lacks a terminating comment")))) - ;; Try to include a trailing newline. - (forward-line) - (narrow-to-region start (point)) - ;; Use some headers we've invented to drive the process. - (let* (;; Prefer Package-Version; if defined, the package author - ;; probably wants us to use it. Otherwise try Version. - (version-info - (or (lm-header "package-version") (lm-header "version"))) + (let* ((version-info (lm-package-version)) (pkg-version (package-strip-rcs-id version-info)) (keywords (lm-keywords-list)) (website (lm-website))) (unless pkg-version - (if version-info - (error "Unrecognized package version: %s" version-info) - (error "Package lacks a \"Version\" or \"Package-Version\" header"))) + (if version-info + (error "Unrecognized package version: %s" version-info) + (error "Package lacks a \"Version\" or \"Package-Version\" header"))) (package-desc-from-define file-name pkg-version desc (lm-package-requires) @@ -1755,7 +1746,7 @@ The variable `package-load-list' controls which packages to load." (setq file (expand-file-name file)) (let ((context (epg-make-context 'OpenPGP))) (when package-gnupghome-dir - (with-file-modes 448 + (with-file-modes #o700 (make-directory package-gnupghome-dir t)) (setf (epg-context-home-directory context) package-gnupghome-dir)) (message "Importing %s..." (file-name-nondirectory file)) @@ -1833,10 +1824,11 @@ Populate `package-archive-contents' with the result. If optional argument ASYNC is non-nil, perform the downloads asynchronously." (dolist (archive package-archives) - (condition-case-unless-debug nil + (condition-case-unless-debug err (package--download-one-archive archive "archive-contents" async) - (error (message "Failed to download `%s' archive." - (car archive)))))) + (error (message "Failed to download `%s' archive: %s" + (car archive) + (error-message-string err)))))) (defvar package-refresh-contents-hook (list #'package--download-and-read-archives) "List of functions to call to refresh the package archive. @@ -1850,8 +1842,11 @@ For each archive configured in the variable `package-archives', inform Emacs about the latest versions of all packages it offers, and make them available for download. Optional argument ASYNC specifies whether to perform the -downloads in the background." - (interactive) +downloads in the background. This is always the case when the command +is invoked interactively." + (interactive (list t)) + (when async + (message "Refreshing package contents...")) (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) (let ((default-keyring (expand-file-name "package-keyring.gpg" @@ -1860,7 +1855,8 @@ downloads in the background." (when (and (package-check-signature) (file-exists-p default-keyring)) (condition-case-unless-debug error (package-import-keyring default-keyring) - (error (message "Cannot import default keyring: %S" (cdr error)))))) + (error (message "Cannot import default keyring: %s" + (error-message-string error)))))) (run-hook-with-args 'package-refresh-contents-hook async)) @@ -2200,8 +2196,9 @@ built-in package with a (possibly newer) version from a package archive." ;;;###autoload (defun package-install (pkg &optional dont-select) "Install the package PKG. -PKG can be a `package-desc' or a symbol naming one of the -available packages in an archive in `package-archives'. + +PKG can be a `package-desc', or a symbol naming one of the available +packages in an archive in `package-archives'. Mark the installed package as selected by adding it to `package-selected-packages'. @@ -2233,6 +2230,7 @@ had been enabled." package-archive-contents) nil t)) nil))) + (cl-check-type pkg (or symbol package-desc)) (package--archives-initialize) (add-hook 'post-command-hook #'package-menu--post-refresh) (let ((name (if (package-desc-p pkg) @@ -2260,21 +2258,22 @@ had been enabled." ;;;###autoload (defun package-upgrade (name) - "Upgrade package NAME if a newer version exists." + "Upgrade package NAME if a newer version exists. + +NAME should be a symbol." (interactive - (list (completing-read - "Upgrade package: " (package--upgradeable-packages t) nil t))) - (let* ((package (if (symbolp name) - name - (intern name))) - (pkg-desc (cadr (assq package package-alist))) + (list (intern (completing-read + "Upgrade package: " + (package--upgradeable-packages t) nil t)))) + (cl-check-type name symbol) + (let* ((pkg-desc (cadr (assq name 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) (when pkg-desc (package-delete pkg-desc 'force 'dont-unselect)) - (package-install package + (package-install name ;; An active built-in has never been "selected" ;; before. Mark it as installed explicitly. (and pkg-desc 'dont-select))))) @@ -2442,9 +2441,10 @@ directory." (defun package-install-selected-packages (&optional noconfirm) "Ensure packages in `package-selected-packages' are installed. If some packages are not installed, propose to install them. -If optional argument NOCONFIRM is non-nil, don't ask for -confirmation to install packages." - (interactive) + +If optional argument NOCONFIRM is non-nil, or when invoked with a prefix +argument, don't ask for confirmation to install packages." + (interactive "P") (package--archives-initialize) ;; We don't need to populate `package-selected-packages' before ;; using here, because the outcome is the same either way (nothing @@ -2621,26 +2621,31 @@ are invalid due to changed byte-code, macros or the like." (package-recompile pkg-desc)))) ;;;###autoload -(defun package-autoremove () +(defun package-autoremove (&optional noconfirm) "Remove packages that are no longer needed. Packages that are no more needed by other packages in `package-selected-packages' and their dependencies -will be deleted." - (interactive) +will be deleted. + +If optional argument NOCONFIRM is non-nil, or when invoked with a prefix +argument, don't ask for confirmation to install packages." + (interactive "P") ;; If `package-selected-packages' is nil, it would make no sense to ;; try to populate it here, because then `package-autoremove' will ;; do absolutely nothing. - (when (or package-selected-packages + (when (or noconfirm + package-selected-packages (yes-or-no-p (format-message "`package-selected-packages' is empty! Really remove ALL packages? "))) (let ((removable (package--removable-packages))) (if removable - (when (y-or-n-p - (format "Packages to delete: %d (%s), proceed? " - (length removable) - (mapconcat #'symbol-name removable " "))) + (when (or noconfirm + (y-or-n-p + (format "Packages to delete: %d (%s), proceed? " + (length removable) + (mapconcat #'symbol-name removable " ")))) (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) t)) removable)) @@ -2663,7 +2668,7 @@ in a clean environment." (list (cl-loop for c in (completing-read-multiple - "Packages to isolate, as comma-separated list: " table + "Packages to isolate: " table nil t) collect (alist-get c table nil nil #'string=)) current-prefix-arg))) @@ -2702,7 +2707,7 @@ in a clean environment." `(add-to-list 'package-directory-list ,dir)) (cons package-user-dir package-directory-list)) (setq package-load-list ',package-load-list) - (package-initialize))))))) + (package-activate-all))))))) ;;;; Package description buffer. @@ -2819,7 +2824,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))) - (maintainers (cdr (assoc :maintainer extras))) + (maintainers (or (cdr (assoc :maintainer extras)) + (cdr (assoc :maintainers extras)))) (authors (cdr (assoc :authors extras))) (news (and-let* (pkg-dir ((not built-in)) @@ -2870,7 +2876,7 @@ Helper function for `describe-package'." 'action #'package-delete-button-action 'package-desc desc))) (incompatible-reason - (insert (propertize "Incompatible" 'font-lock-face font-lock-warning-face) + (insert (propertize "Incompatible" 'font-lock-face 'font-lock-warning-face) " because it depends on ") (if (stringp incompatible-reason) (insert "Emacs " incompatible-reason ".") @@ -3980,7 +3986,7 @@ Return nil if there were no errors; non-nil otherwise." (package-menu--transaction-status)) (dolist (pkg install-list) (setq package-menu--transaction-status - (format status-format (cl-incf i))) + (format status-format (incf i))) (force-mode-line-update) (redisplay 'force) ;; Don't mark as selected, `package-menu-execute' already @@ -3995,8 +4001,9 @@ Return nil if there were no errors; non-nil otherwise." (package-delete elt nil 'nosave)) (error (push (package-desc-full-name elt) errors) - (message "Error trying to delete `%s': %S" - (package-desc-full-name elt) err))))) + (message "Error trying to delete `%s': %s" + (package-desc-full-name elt) + (error-message-string err)))))) errors)) (defun package--update-selected-packages (add remove) @@ -4286,7 +4293,7 @@ string, show all packages. When called interactively, prompt for ARCHIVE. To specify several archives, type their names separated by commas." (interactive (list (completing-read-multiple - "Filter by archive (comma separated): " + "Filter by archive: " (mapcar #'car package-archives))) package-menu-mode) (package--ensure-package-menu-mode) @@ -4330,7 +4337,7 @@ or \"built-in\" or \"obsolete\". When called interactively, prompt for KEYWORD. To specify several keywords, type them separated by commas." (interactive (list (completing-read-multiple - "Keywords (comma separated): " + "Keywords: " (package-all-keywords))) package-menu-mode) (package--ensure-package-menu-mode) @@ -4522,7 +4529,7 @@ of an installed ELPA package. The return value is a string (or nil in case we can't find it). It works in more cases if the call is in the file which contains the `Version:' header." - ;; In a sense, this is a lie, but it does just what we want: precompute + ;; In a sense, this is a lie, but it does just what we want: precomputes ;; the version at compile time and hardcodes it into the .elc file! (declare (pure t)) ;; Hack alert! @@ -4543,10 +4550,7 @@ the `Version:' header." (unless (file-readable-p mainfile) (setq mainfile file)) (when (file-readable-p mainfile) (require 'lisp-mnt) - (with-temp-buffer - (insert-file-contents mainfile) - (or (lm-header "package-version") - (lm-header "version"))))))))) + (lm-package-version mainfile))))))) ;;;; Quickstart: precompute activation actions for faster start up. |