X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/f4ad42936e0b83caca91389a977d7258b69ed40a..b0eb66823f12c85d04e36ddd0e58e20c0a0694db:/lisp/emacs-lisp/package.el?ds=sidebyside diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index db61ababd6..6fecd9a837 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -341,7 +341,7 @@ This variable is fed automatically by Emacs when installing a new package. This variable is used by `package-autoremove' to decide which packages are no longer needed. You can use it to (re)install packages on other machines -by running `package-user-selected-packages-install'. +by running `package-install-selected-packages'. To check if a package is contained in this list here, use `package--user-selected-p', as it may populate the variable with @@ -350,8 +350,9 @@ a sane initial value." (defcustom package-menu-async t "If non-nil, package-menu will use async operations when possible. -This includes refreshing archive contents as well as installing -packages." +Currently, only the refreshing of archive contents supports +asynchronous operations. Package transactions are still done +synchronously." :type 'boolean :version "25.1") @@ -586,9 +587,10 @@ updates `package-alist'." (dolist (dir (cons package-user-dir package-directory-list)) (when (file-directory-p dir) (dolist (subdir (directory-files dir)) - (let ((pkg-dir (expand-file-name subdir dir))) - (when (file-directory-p pkg-dir) - (package-load-descriptor pkg-dir))))))) + (unless (equal subdir "..") + (let ((pkg-dir (expand-file-name subdir dir))) + (when (file-directory-p pkg-dir) + (package-load-descriptor pkg-dir)))))))) (defun define-package (_name-string _version-string &optional _docstring _requirements @@ -888,14 +890,12 @@ untar into a directory named DIR; otherwise, signal an error." (defvar generated-autoload-file) (defvar version-control) -(defvar package--silence nil) - (defun package-generate-autoloads (name pkg-dir) (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) ;; Silence `autoload-generate-file-autoloads'. - (noninteractive package--silence) + (noninteractive inhibit-message) (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) @@ -915,10 +915,13 @@ untar into a directory named DIR; otherwise, signal an error." ) ;;;; Compilation +(defvar warning-minimum-level) (defun package--compile (pkg-desc) "Byte-compile installed package PKG-DESC." - (package-activate-1 pkg-desc) - (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)) + (let ((warning-minimum-level :error) + (save-silently inhibit-message)) + (package-activate-1 pkg-desc) + (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) ;;;; Inferring package from current buffer (defun package-read-from-string (str) @@ -956,7 +959,7 @@ is wrapped around any parts requiring it." deps)))) (declare-function lm-header "lisp-mnt" (header)) -(declare-function lm-homepage "lisp-mnt" ()) +(declare-function lm-homepage "lisp-mnt" (&optional file)) (defun package-buffer-info () "Return a `package-desc' describing the package in the current buffer. @@ -1078,7 +1081,7 @@ The return result is a `package-desc'." (declare-function epg-verify-string "epg" (context signature &optional signed-text)) (declare-function epg-context-result-for "epg" (context name)) -(declare-function epg-signature-status "epg" (signature)) +(declare-function epg-signature-status "epg" (signature) t) (declare-function epg-signature-to-string "epg" (signature)) (defun package--display-verify-error (context sig-file) @@ -1345,6 +1348,9 @@ If successful, set `package-archive-contents'." ;; available on disk. (defvar package--initialized nil) +(defvar package--init-file-ensured nil + "Whether we know the init file has package-initialize.") + ;;;###autoload (defun package-initialize (&optional no-activate) "Load Emacs Lisp packages, and activate them. @@ -1354,7 +1360,11 @@ If `user-init-file' does not mention `(package-initialize)', add it to the file." (interactive) (setq package-alist nil) - (package--ensure-init-file) + (if (equal user-init-file load-file-name) + ;; If `package-initialize' is being called as part of loading + ;; the init file, it's obvious we don't need to ensure-init. + (setq package--init-file-ensured t) + (package--ensure-init-file)) (package-load-all-descriptors) (package-read-all-archive-contents) (unless no-activate @@ -1377,13 +1387,6 @@ it to the file." (declare-function epg-configuration "epg-config" ()) (declare-function epg-import-keys-from-file "epg" (context keys)) -(defun package--message (format &rest args) - "Like `message', except sometimes don't print to minibuffer. -If the variable `package--silence' is non-nil, the message is not -displayed on the echo area." - (let ((inhibit-message package--silence)) - (apply #'message format args))) - ;;;###autoload (defun package-import-keyring (&optional file) "Import keys from FILE." @@ -1394,9 +1397,9 @@ displayed on the echo area." (with-file-modes 448 (make-directory homedir t)) (setf (epg-context-home-directory context) homedir) - (package--message "Importing %s..." (file-name-nondirectory file)) + (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) - (package--message "Importing %s...done" (file-name-nondirectory file)))) + (message "Importing %s...done" (file-name-nondirectory file)))) (defvar package--post-download-archives-hook nil "Hook run after the archive contents are downloaded. @@ -1488,14 +1491,14 @@ downloads in the background." (make-directory package-user-dir t)) (let ((default-keyring (expand-file-name "package-keyring.gpg" data-directory)) - (package--silence async)) + (inhibit-message async)) (when (and package-check-signature (file-exists-p default-keyring)) (condition-case-unless-debug error (progn (epg-check-configuration (epg-configuration)) (package-import-keyring default-keyring)) - (error (message "Cannot import default keyring: %S" (cdr error))))) - (package--download-and-read-archives async))) + (error (message "Cannot import default keyring: %S" (cdr error)))))) + (package--download-and-read-archives async)) ;;; Dependency Management @@ -1537,7 +1540,7 @@ SEEN is used internally to detect infinite recursion." ;; we re-add it (along with its dependencies) at an earlier place ;; below (bug#16994). (if (memq already seen) ;Avoid inf-loop on dependency cycles. - (package--message "Dependency cycle going through %S" + (message "Dependency cycle going through %S" (package-desc-full-name already)) (setq packages (delq already packages)) (setq already nil)) @@ -1603,7 +1606,7 @@ Used to populate `package-selected-packages'." (defun package--save-selected-packages (value) "Set and save `package-selected-packages' to VALUE." - (let ((save-silently package--silence)) + (let ((save-silently inhibit-message)) (customize-save-variable 'package-selected-packages (setq package-selected-packages value)))) @@ -1645,21 +1648,25 @@ These are packages which are neither contained in unless (memq p needed) collect p))) -(defun package--used-elsewhere-p (pkg-desc &optional pkg-list) +(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all) "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST. Return the first package found in PKG-LIST of which PKG is a -dependency. +dependency. If ALL is non-nil, return all such packages instead. When not specified, PKG-LIST defaults to `package-alist' with PKG-DESC entry removed." (unless (string= (package-desc-status pkg-desc) "obsolete") - (let ((pkg (package-desc-name pkg-desc))) - (cl-loop with alist = (or pkg-list - (remove (assq pkg package-alist) - package-alist)) - for p in alist thereis - (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p)))) - (car p)))))) + (let* ((pkg (package-desc-name pkg-desc)) + (alist (or pkg-list + (remove (assq pkg package-alist) + package-alist)))) + (if all + (cl-loop for p in alist + if (assq pkg (package-desc-reqs (cadr p))) + collect (cadr p)) + (cl-loop for p in alist thereis + (and (assq pkg (package-desc-reqs (cadr p))) + (cadr p))))))) (defun package--sort-deps-in-alist (package only) "Return a list of dependencies for PACKAGE sorted by dependency. @@ -1707,30 +1714,26 @@ if all the in-between dependencies are also in PACKAGE-LIST." "Return the archive containing the package NAME." (cdr (assoc (package-desc-archive desc) package-archives))) -(defun package-install-from-archive (pkg-desc &optional async callback) - "Download and install a tar package. -If ASYNC is non-nil, perform the download asynchronously. -If CALLBACK is non-nil, call it with no arguments once the -operation is done." +(defun package-install-from-archive (pkg-desc) + "Download and install a tar package." ;; This won't happen, unless the archive is doing something wrong. (when (eq (package-desc-kind pkg-desc) 'dir) (error "Can't install directory package from archive")) (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) (package-desc-suffix pkg-desc)))) - (package--with-work-buffer-async location file async + (package--with-work-buffer location file (if (or (not package-check-signature) (member (package-desc-archive pkg-desc) package-unsigned-archives)) ;; If we don't care about the signature, unpack and we're ;; done. - (progn (let ((save-silently async)) - (package-unpack pkg-desc)) - (funcall callback)) + (let ((save-silently t)) + (package-unpack pkg-desc)) ;; If we care, check it and *then* write the file. (let ((content (buffer-string))) (package--check-signature - location file content async + location file content nil ;; This function will be called after signature checking. (lambda (&optional good-sigs) (unless (or good-sigs (eq package-check-signature 'allow-unsigned)) @@ -1740,7 +1743,7 @@ operation is done." (package-desc-name pkg-desc))) ;; Signature checked, unpack now. (with-temp-buffer (insert content) - (let ((save-silently async)) + (let ((save-silently t)) (package-unpack pkg-desc))) ;; Here the package has been installed successfully, mark it as ;; signed if appropriate. @@ -1756,9 +1759,7 @@ operation is done." (setf (package-desc-signed pkg-desc) t) ;; Update the new (activated) pkg-desc as well. (when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) - (setf (package-desc-signed (car pkg-descs)) t))) - (when (functionp callback) - (funcall callback))))))))) + (setf (package-desc-signed (car pkg-descs)) t)))))))))) (defun package-installed-p (package &optional min-version) "Return true if PACKAGE, of MIN-VERSION or newer, is installed. @@ -1779,30 +1780,24 @@ If PACKAGE is a package-desc object, MIN-VERSION is ignored." ;; Also check built-in packages. (package-built-in-p package min-version)))) -(defun package-download-transaction (packages &optional async callback) +(defun package-download-transaction (packages) "Download and install all the packages in PACKAGES. PACKAGES should be a list of package-desc. -If ASYNC is non-nil, perform the downloads asynchronously. -If CALLBACK is non-nil, call it with no arguments once the -entire operation is done. - This function assumes that all package requirements in PACKAGES are satisfied, i.e. that PACKAGES is computed using `package-compute-transaction'." - (cond - (packages (package-install-from-archive - (car packages) - async - (lambda () - (package-download-transaction (cdr packages)) - (when (functionp callback) - (funcall callback))))) - (callback (funcall callback)))) + (mapc #'package-install-from-archive packages)) (defun package--ensure-init-file () - "Ensure that the user's init file calls `package-initialize'." + "Ensure that the user's init file has `package-initialize'. +`package-initialize' doesn't have to be called, as long as it is +present somewhere in the file, even as a comment. If it is not, +add a call to it along with some explanatory comments." ;; Don't mess with the init-file from "emacs -Q". - (when user-init-file + (when (and (stringp user-init-file) + (not package--init-file-ensured) + (file-readable-p user-init-file) + (file-writable-p user-init-file)) (let* ((buffer (find-buffer-visiting user-init-file)) (contains-init (if buffer @@ -1840,19 +1835,17 @@ using `package-compute-transaction'." (let ((file-precious-flag t)) (save-buffer)) (unless buffer - (kill-buffer (current-buffer)))))))))) + (kill-buffer (current-buffer))))))))) + (setq package--init-file-ensured t)) ;;;###autoload -(defun package-install (pkg &optional dont-select async callback) +(defun package-install (pkg &optional dont-select) "Install the package PKG. PKG can be a package-desc or the package name of one the available packages in an archive in `package-archives'. Interactively, prompt for its name. If called interactively or if DONT-SELECT nil, add PKG to `package-selected-packages'. -If ASYNC is non-nil, perform the downloads asynchronously. -If CALLBACK is non-nil, call it with no arguments once the -entire operation is done. If PKG is a package-desc and it is already installed, don't try to install it but still mark it as selected." @@ -1885,8 +1878,8 @@ to install it but still mark it as selected." (package-compute-transaction (list pkg) (package-desc-reqs pkg))) (package-compute-transaction () (list (list pkg)))))) - (package-download-transaction transaction async callback) - (package--message "`%s' is already installed" (package-desc-full-name pkg)))) + (package-download-transaction transaction) + (message "`%s' is already installed" (package-desc-full-name pkg)))) (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. @@ -2016,7 +2009,7 @@ If NOSAVE is non-nil, the package is not removed from ;; 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) - pkg-used-elsewhere-by)) + (package-desc-name pkg-used-elsewhere-by))) (t (delete-directory dir t t) ;; Remove NAME-VERSION.signed file. @@ -2028,7 +2021,7 @@ If NOSAVE is non-nil, the package is not removed from (delete pkg-desc pkgs) (unless (cdr pkgs) (setq package-alist (delq pkgs package-alist)))) - (package--message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) + (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))) ;;;###autoload (defun package-reinstall (pkg) @@ -2116,6 +2109,7 @@ will be deleted." (name (if desc (package-desc-name desc) pkg)) (pkg-dir (if desc (package-desc-dir desc))) (reqs (if desc (package-desc-reqs desc))) + (required-by (if desc (package--used-elsewhere-p desc nil 'all))) (version (if desc (package-desc-version desc))) (archive (if desc (package-desc-archive desc))) (extras (and desc (package-desc-extras desc))) @@ -2144,20 +2138,27 @@ will be deleted." "Installed" (capitalize status)) ;FIXME: Why comment-face? 'font-lock-face 'font-lock-comment-face)) - (insert " in `") + (insert " in ‘") ;; Todo: Add button for uninstalling. (help-insert-xref-button (abbreviate-file-name (file-name-as-directory pkg-dir)) 'help-package-def pkg-dir) (if (and (package-built-in-p name) (not (package-built-in-p name version))) - (insert "',\n shadowing a " + (insert "’,\n shadowing a " (propertize "built-in package" 'font-lock-face 'font-lock-builtin-face)) - (insert "'")) + (insert "’")) (if signed (insert ".") - (insert " (unsigned)."))) + (insert " (unsigned).")) + (when (and (package-desc-p desc) + (not required-by) + (package-installed-p desc)) + (insert " ") + (package-make-button "Delete" + 'action #'package-delete-button-action + 'package-desc desc))) (incompatible-reason (insert (propertize "Incompatible" 'face font-lock-warning-face) " because it depends on ") @@ -2201,6 +2202,19 @@ will be deleted." (help-insert-xref-button text 'help-package name) (insert reason))) (insert "\n"))) + (when required-by + (insert (propertize "Required by" 'font-lock-face 'bold) ": ") + (let ((first t)) + (dolist (pkg required-by) + (let ((text (package-desc-full-name pkg))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package + (package-desc-name pkg)))) + (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) ": " (if desc (package-desc-summary desc)) "\n") (when homepage @@ -2288,6 +2302,14 @@ will be deleted." (revert-buffer nil t) (goto-char (point-min))))) +(defun package-delete-button-action (button) + (let ((pkg-desc (button-get button 'package-desc))) + (when (y-or-n-p (format "Delete package `%s'? " + (package-desc-full-name pkg-desc))) + (package-delete pkg-desc) + (revert-buffer nil t) + (goto-char (point-min))))) + (defun package-keyword-button-action (button) (let ((pkg-keyword (button-get button 'package-keyword))) (package-show-package-list t (list pkg-keyword)))) @@ -2379,12 +2401,17 @@ will be deleted." (defvar package-menu--new-package-list nil "List of newly-available packages since `list-packages' was last called.") +(defvar package-menu--transaction-status nil + "Mode-line status of ongoing package transaction.") + (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" "Major mode for browsing a list of packages. Letters do not insert themselves; instead, they are commands. \\ \\{package-menu-mode-map}" - (setq mode-line-process '(package--downloads-in-progress ":Loading")) + (setq mode-line-process '((package--downloads-in-progress ":Loading") + (package-menu--transaction-status + package-menu--transaction-status))) (setq tabulated-list-format `[("Package" 18 package-menu--name-predicate) ("Version" 13 nil) @@ -2460,7 +2487,9 @@ of these dependencies, similar to the list returned by (t "disabled")))) (dir ;One of the installed packages. (cond - ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted") + ((not (file-exists-p dir)) "deleted") + ;; Not inside `package-user-dir'. + ((not (file-in-directory-p dir package-user-dir)) "external") ((eq pkg-desc (cadr (assq name package-alist))) (if (not signed) "unsigned" (if (package--user-selected-p name) @@ -2665,6 +2694,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (let* ((status (package-desc-status pkg)) (face (pcase status (`"built-in" 'font-lock-builtin-face) + (`"external" 'font-lock-builtin-face) (`"available" 'default) (`"avail-obso" 'font-lock-comment-face) (`"new" 'bold) @@ -2782,7 +2812,7 @@ The full list of keys can be viewed with \\[describe-mode]." (defun package-menu-get-status () (let* ((id (tabulated-list-get-id)) - (entry (and id (assq id tabulated-list-entries)))) + (entry (and id (assoc id tabulated-list-entries)))) (if entry (aref (cadr entry) 2) ""))) @@ -2826,15 +2856,15 @@ consideration." (push (cons name avail-pkg) upgrades)))) upgrades)) -(defun package-menu-mark-upgrades () +(defvar package-menu--mark-upgrades-pending nil + "Whether mark-upgrades is waiting for a refresh to finish.") + +(defun package-menu--mark-upgrades-1 () "Mark all upgradable packages in the Package Menu. -For each installed package with a newer version available, place -an (I)nstall flag on the available version and a (D)elete flag on -the installed version. A subsequent \\[package-menu-execute] -call will upgrade the package." - (interactive) +Implementation of `package-menu-mark-upgrades'." (unless (derived-mode-p 'package-menu-mode) (error "The current buffer is not a Package Menu")) + (setq package-menu--mark-upgrades-pending nil) (let ((upgrades (package-menu--find-upgrades))) (if (null upgrades) (message "No packages to upgrade.") @@ -2851,8 +2881,24 @@ call will upgrade the package." (t (package-menu-mark-delete)))))) (message "%d package%s marked for upgrading." - (length upgrades) - (if (= (length upgrades) 1) "" "s"))))) + (length upgrades) + (if (= (length upgrades) 1) "" "s"))))) + +(defun package-menu-mark-upgrades () + "Mark all upgradable packages in the Package Menu. +For each installed package with a newer version available, place +an (I)nstall flag on the available version and a (D)elete flag on +the installed version. A subsequent \\[package-menu-execute] +call will upgrade the package. + +If there's an async refresh operation in progress, the flags will +be placed as part of `package-menu--post-refresh' instead of +immediately." + (interactive) + (if (not package--downloads-in-progress) + (package-menu--mark-upgrades-1) + (setq package-menu--mark-upgrades-pending t) + (message "Waiting for refresh to finish..."))) (defun package-menu--list-to-prompt (packages) "Return a string listing PACKAGES that's usable in a prompt. @@ -2871,57 +2917,77 @@ prompt (see `package-menu--prompt-transaction-p')." (t (format "package `%s'" (package-desc-full-name (car packages)))))) -(defun package-menu--prompt-transaction-p (install delete) - "Prompt the user about installing INSTALL and deleting DELETE. -INSTALL and DELETE are lists of `package-desc'. Either may be -nil, but not both." +(defun package-menu--prompt-transaction-p (delete install upgrade) + "Prompt the user about DELETE, INSTALL, and UPGRADE. +DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects. +Either may be nil, but not all." + (y-or-n-p + (concat + (when delete "Delete ") + (package-menu--list-to-prompt delete) + (when (and delete install) + (if upgrade "; " "; and ")) + (when install "Install ") + (package-menu--list-to-prompt install) + (when (and upgrade (or install delete)) "; and ") + (when upgrade "Upgrade ") + (package-menu--list-to-prompt upgrade) + "? "))) + +(defun package-menu--partition-transaction (install delete) + "Return an alist describing an INSTALL DELETE transaction. +Alist contains three entries, upgrade, delete, and install, each +with a list of package names. + +The upgrade entry contains any `package-desc' objects in INSTALL +whose name coincides with an object in DELETE. The delete and +the install entries are the same as DELETE and INSTALL with such +objects removed." (let* ((upg (cl-intersection install delete :key #'package-desc-name)) (ins (cl-set-difference install upg :key #'package-desc-name)) (del (cl-set-difference delete upg :key #'package-desc-name))) - (y-or-n-p - (concat - (when del "Delete ") - (package-menu--list-to-prompt del) - (when (and del ins) - (if upg "; " "; and ")) - (when ins "Install ") - (package-menu--list-to-prompt ins) - (when (and upg (or ins del)) "; and ") - (when upg "Upgrade ") - (package-menu--list-to-prompt upg) - "? ")))) - -(defun package-menu--perform-transaction (install-list delete-list &optional async) - "Install packages in INSTALL-LIST and delete DELETE-LIST. -If ASYNC is non-nil, perform the installation downloads -asynchronously." - ;; While there are packages to install, call `package-install' on - ;; the next one and defer deletion to the callback function. + `((delete . ,del) (install . ,ins) (upgrade . ,upg)))) + +(defun package-menu--perform-transaction (install-list delete-list) + "Install packages in INSTALL-LIST and delete DELETE-LIST." (if install-list - (let* ((pkg (car install-list)) - (rest (cdr install-list)) - ;; Don't mark as selected if it's a new version of an - ;; installed package. - (dont-mark (and (not (package-installed-p pkg)) - (package-installed-p - (package-desc-name pkg))))) - (package-install - pkg dont-mark async - (lambda () (package-menu--perform-transaction rest delete-list async)))) + (let ((status-format (format ":Installing %%d/%d" + (length install-list))) + (i 0) + (package-menu--transaction-status)) + (dolist (pkg install-list) + (setq package-menu--transaction-status + (format status-format (cl-incf i))) + (force-mode-line-update) + (redisplay 'force) + ;; Don't mark as selected, `package-menu-execute' already + ;; does that. + (package-install pkg 'dont-select))) ;; Once there are no more packages to install, proceed to ;; deletion. - (let ((package--silence async)) + (let ((package-menu--transaction-status ":Deleting")) + (force-mode-line-update) + (redisplay 'force) (dolist (elt (package--sort-by-dependence delete-list)) (condition-case-unless-debug err - (package-delete elt) - (error (message (cadr err))))) - (when package-selected-packages - (when-let ((removable (package--removable-packages))) - (package--message "These %d packages are no longer needed, type `M-x package-autoremove' to remove them (%s)" - (length removable) - (mapconcat #'symbol-name removable ", "))))) - (message "Transaction done") - (package-menu--post-refresh))) + (let ((inhibit-message t)) + (package-delete elt nil 'nosave)) + (error (message (cadr err)))))))) + +(defun package--update-selected-packages (add remove) + "Update the `package-selected-packages' list according to ADD and REMOVE. +ADD and REMOVE must be disjoint lists of package names (or +`package-desc' objects) to be added and removed to the selected +packages list, respectively." + (dolist (p add) + (cl-pushnew (if (package-desc-p p) (package-desc-name p) p) + package-selected-packages)) + (dolist (p remove) + (setq package-selected-packages + (remove (if (package-desc-p p) (package-desc-name p) p) + package-selected-packages))) + (when (or add remove) + (package--save-selected-packages package-selected-packages))) (defun package-menu-execute (&optional noquery) "Perform marked Package Menu actions. @@ -2946,12 +3012,30 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (forward-line))) (unless (or delete-list install-list) (user-error "No operations specified")) - (when (or noquery - (package-menu--prompt-transaction-p install-list delete-list)) - (message "Transaction started") - ;; This calls `package-menu--generate' after everything's done. - (package-menu--perform-transaction - install-list delete-list package-menu-async)))) + (let-alist (package-menu--partition-transaction install-list delete-list) + (when (or noquery + (package-menu--prompt-transaction-p .delete .install .upgrade)) + (let ((message-template + (concat "Package menu: Operation %s [" + (when .delete (format "Delet__ %s" (length .delete))) + (when (and .delete .install) "; ") + (when .install (format "Install__ %s" (length .install))) + (when (and .upgrade (or .install .delete)) "; ") + (when .upgrade (format "Upgrad__ %s" (length .upgrade))) + "]"))) + (message (replace-regexp-in-string "__" "ing" message-template) "started") + ;; Packages being upgraded are not marked as selected. + (package--update-selected-packages .install .delete) + (package-menu--perform-transaction install-list delete-list) + (when package-selected-packages + (if-let ((removable (package--removable-packages))) + (message "Package menu: Operation finished. %d packages %s" + (length removable) + "are no longer needed, type `M-x package-autoremove' to remove them") + (message (replace-regexp-in-string "__" "ed" message-template) + "finished")))) + ;; This calls `package-menu--generate'. + (package-menu--post-refresh))))) (defun package-menu--version-predicate (A B) (let ((vA (or (aref (cadr A) 1) '(0))) @@ -2980,6 +3064,8 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." ((string= sB "unsigned") nil) ((string= sA "held") t) ((string= sB "held") nil) + ((string= sA "external") t) + ((string= sB "external") nil) ((string= sA "built-in") t) ((string= sB "built-in") nil) ((string= sA "obsolete") t) @@ -3030,8 +3116,11 @@ after `package-menu--perform-transaction'." (let ((buf (get-buffer "*Packages*"))) (when (buffer-live-p buf) (with-current-buffer buf - (revert-buffer nil 'noconfirm)))) - (package-menu--find-and-notify-upgrades)) + (run-hooks 'tabulated-list-revert-hook) + (tabulated-list-print 'remember 'update) + (if package-menu--mark-upgrades-pending + (package-menu--mark-upgrades-1) + (package-menu--find-and-notify-upgrades)))))) ;;;###autoload (defun list-packages (&optional no-fetch)