Merge branch 'master' into cairo

1 files changed, 419 insertions, 179 deletions

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 583598ee10c..f770acd557e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -225,6 +225,30 @@ a package can run arbitrary code."
   :group 'package
   :version "24.1")
 
+(defcustom package-menu-hide-low-priority 'archive
+  "If non-nil, hide low priority packages from the packages menu.
+A package is considered low priority if there's another version
+of it available such that:
+    (a) the archive of the other package is higher priority than
+    this one, as per `package-archive-priorities';
+  or
+    (b) they both have the same archive priority but the other
+    package has a higher version number.
+
+This variable has three possible values:
+    nil: no packages are hidden;
+    archive: only criteria (a) is used;
+    t: both criteria are used.
+
+This variable has no effect if `package-menu--hide-obsolete' is
+nil, so it can be toggled with \\<package-menu-mode-map> \\[package-menu-hide-obsolete]."
+  :type '(choice (const :tag "Don't hide anything" nil)
+                 (const :tag "Hide per package-archive-priorities"
+                        archive)
+                 (const :tag "Hide per archive and version number" t))
+  :group 'package
+  :version "25.1")
+
 (defcustom package-archive-priorities nil
   "An alist of priorities for packages.
 
@@ -235,7 +259,9 @@ number from the archive with the highest priority is
 selected. When higher versions are available from archives with
 lower priorities, the user has to select those manually.
 
-Archives not in this list have the priority 0."
+Archives not in this list have the priority 0.
+
+See also `package-menu-hide-low-priority'."
   :type '(alist :key-type (string :tag "Archive name")
                 :value-type (integer :tag "Priority (default is 0)"))
   :risky t
@@ -467,6 +493,10 @@ This is, approximately, the inverse of `version-to-list'.
         (nth 1 keywords)
       keywords)))
 
+(defun package-desc-priority (p)
+  "Return the priority of the archive of package-desc object P."
+  (package-archive-priority (package-desc-archive p)))
+
 ;; Package descriptor format used in finder-inf.el and package--builtins.
 (cl-defstruct (package--bi-desc
                (:constructor package-make-builtin (version summary))
@@ -866,6 +896,8 @@ untar into a directory named DIR; otherwise, signal an error."
   (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)
          (backup-inhibited t)
          (version-control 'never))
     (package-autoload-ensure-default-file generated-autoload-file)
@@ -1090,23 +1122,27 @@ function, call it with no arguments (instead of executing BODY),
 otherwise propagate the error.  For description of the other
 arguments see `package--with-work-buffer'."
   (declare (indent 3) (debug t))
-  `(if (or (not ,async)
-           (not (string-match-p "\\`https?:" ,location)))
-       (package--with-work-buffer ,location ,file ,@body)
-     (url-retrieve (concat ,location ,file)
-                   (lambda (status)
-                     (if (eq (car status) :error)
-                         (if (functionp ,async)
-                             (funcall ,async)
-                           (signal (cdar status) (cddr status)))
-                       (goto-char (point-min))
-                       (unless (search-forward "\n\n" nil 'noerror)
-                         (error "Invalid url response"))
-                       (delete-region (point-min) (point))
-                       ,@body)
-                     (kill-buffer (current-buffer)))
-                   nil
-                   'silent)))
+  (macroexp-let2* macroexp-copyable-p
+      ((async-1 async)
+       (file-1 file)
+       (location-1 location))
+    `(if (or (not ,async-1)
+             (not (string-match-p "\\`https?:" ,location-1)))
+         (package--with-work-buffer ,location-1 ,file-1 ,@body)
+       (url-retrieve (concat ,location-1 ,file-1)
+                     (lambda (status)
+                       (if (eq (car status) :error)
+                           (if (functionp ,async-1)
+                               (funcall ,async-1)
+                             (signal (cdar status) (cddr status)))
+                         (goto-char (point-min))
+                         (unless (search-forward "\n\n" nil 'noerror)
+                           (error "Invalid url response"))
+                         (delete-region (point-min) (point))
+                         ,@body)
+                       (kill-buffer (current-buffer)))
+                     nil
+                     'silent))))
 
 (defun package--check-signature-content (content string &optional sig-file)
   "Check signature CONTENT against STRING.
@@ -1195,6 +1231,8 @@ version higher than the one being used.  To check for package
 
 (defun package--build-compatibility-table ()
   "Build `package--compatibility-table' with `package--mapc'."
+  ;; Initialize the list of built-ins.
+  (require 'finder-inf nil t)
   ;; Build compat table.
   (setq package--compatibility-table (make-hash-table :test 'eq))
   (package--mapc #'package--add-to-compatibility-table))
@@ -1275,7 +1313,8 @@ Will throw an error if the archive version is too new."
   (let ((filename (expand-file-name file package-user-dir)))
     (when (file-exists-p filename)
       (with-temp-buffer
-        (insert-file-contents-literally filename)
+        (let ((coding-system-for-read 'utf-8))
+          (insert-file-contents filename))
         (let ((contents (read (current-buffer))))
           (if (> (car contents) package-archive-version)
               (error "Package archive version %d is higher than %d"
@@ -1311,9 +1350,12 @@ If successful, set `package-archive-contents'."
 (defun package-initialize (&optional no-activate)
   "Load Emacs Lisp packages, and activate them.
 The variable `package-load-list' controls which packages to load.
-If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+If optional arg NO-ACTIVATE is non-nil, don't activate packages.
+If `user-init-file' does not mention `(package-initialize)', add
+it to the file."
   (interactive)
   (setq package-alist nil)
+  (package--ensure-init-file)
   (package-load-all-descriptors)
   (package-read-all-archive-contents)
   (unless no-activate
@@ -1336,6 +1378,16 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
 (declare-function epg-configuration "epg-config" ())
 (declare-function epg-import-keys-from-file "epg" (context keys))
 
+(defvar package--silence nil)
+
+(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 minibuffer."
+  (apply #'message format args)
+  (when package--silence
+    (message nil)))
+
 ;;;###autoload
 (defun package-import-keyring (&optional file)
   "Import keys from FILE."
@@ -1346,9 +1398,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
     (with-file-modes 448
       (make-directory homedir t))
     (setf (epg-context-home-directory context) homedir)
-    (message "Importing %s..." (file-name-nondirectory file))
+    (package--message "Importing %s..." (file-name-nondirectory file))
     (epg-import-keys-from-file context file)
-    (message "Importing %s...done" (file-name-nondirectory file))))
+    (package--message "Importing %s...done" (file-name-nondirectory file))))
 
 (defvar package--post-download-archives-hook nil
   "Hook run after the archive contents are downloaded.
@@ -1364,8 +1416,8 @@ Once it's empty, run `package--post-download-archives-hook'."
         (remove entry package--downloads-in-progress))
   ;; If this was the last download, run the hook.
   (unless package--downloads-in-progress
-    (package--build-compatibility-table)
     (package-read-all-archive-contents)
+    (package--build-compatibility-table)
     ;; We message before running the hook, so the hook can give
     ;; messages as well.
     (message "Package refresh done")
@@ -1393,8 +1445,12 @@ similar to an entry in `package-alist'.  Save the cached copy to
           ;; If we care, check it (perhaps async) and *then* write the file.
           (package--check-signature
            location file content async
+           ;; This function will be called after signature checking.
            (lambda (&optional good-sigs)
              (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
+               ;; Even if the sig fails, this download is done, so
+               ;; remove it from the in-progress list.
+               (package--update-downloads-in-progress archive)
                (error "Unsigned archive `%s'" name))
              ;; Write out the archives file.
              (write-region content nil local-file nil 'silent)
@@ -1410,10 +1466,16 @@ This populates `package-archive-contents'.  If ASYNC is non-nil,
 perform the downloads asynchronously."
   ;; The downloaded archive contents will be read as part of
   ;; `package--update-downloads-in-progress'.
-  (setq package--downloads-in-progress package-archives)
+  (setq package--downloads-in-progress
+        (append package-archives
+                package--downloads-in-progress))
   (dolist (archive package-archives)
     (condition-case-unless-debug nil
-        (package--download-one-archive archive "archive-contents" async)
+        (package--download-one-archive
+         archive "archive-contents"
+         ;; Called if the async download fails
+         (when async
+           (lambda () (package--update-downloads-in-progress archive))))
       (error (message "Failed to download `%s' archive."
                (car archive))))))
 
@@ -1426,18 +1488,18 @@ and make them available for download.
 Optional argument ASYNC specifies whether to perform the
 downloads in the background."
   (interactive)
-  ;; FIXME: Do it asynchronously.
   (unless (file-exists-p package-user-dir)
     (make-directory package-user-dir t))
   (let ((default-keyring (expand-file-name "package-keyring.gpg"
-                                           data-directory)))
+                                           data-directory))
+        (package--silence 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
@@ -1479,7 +1541,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.
-                (message "Dependency cycle going through %S"
+                (package--message "Dependency cycle going through %S"
                          (package-desc-full-name already))
               (setq packages (delq already packages))
               (setq already nil))
@@ -1543,15 +1605,20 @@ Used to populate `package-selected-packages'."
              unless (memq name dep-list)
              collect name)))
 
+(defun package--save-selected-packages (value)
+  "Set and save `package-selected-packages' to VALUE."
+  (let ((save-silently package--silence))
+    (customize-save-variable
+     'package-selected-packages
+     (setq package-selected-packages value))))
+
 (defun package--user-selected-p (pkg)
   "Return non-nil if PKG is a package was installed by the user.
 PKG is a package name.
 This looks into `package-selected-packages', populating it first
 if it is still empty."
   (unless (consp package-selected-packages)
-    (customize-save-variable
-     'package-selected-packages
-     (setq package-selected-packages (package--find-non-dependencies))))
+    (package--save-selected-packages (package--find-non-dependencies)))
   (memq pkg package-selected-packages))
 
 (defun package--get-deps (pkg &optional only)
@@ -1644,43 +1711,58 @@ 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)
-  "Download and install a tar package."
+(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."
   ;; 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)))
-         (sig-file (concat file ".sig"))
-         good-signatures pkg-descs)
-    (package--with-work-buffer location file
-      (if (and package-check-signature
-               (not (member (package-desc-archive pkg-desc)
-                            package-unsigned-archives)))
-          (if (package--archive-file-exists-p location sig-file)
-              (setq good-signatures (package--check-signature location file))
-            (unless (eq package-check-signature 'allow-unsigned)
-              (error "Unsigned package: `%s'"
-                     (package-desc-name pkg-desc)))))
-      (package-unpack pkg-desc))
-    ;; Here the package has been installed successfully, mark it as
-    ;; signed if appropriate.
-    (when good-signatures
-      ;; Write out good signatures into NAME-VERSION.signed file.
-      (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
-                    nil
-                    (expand-file-name
-                     (concat (package-desc-full-name pkg-desc)
-                             ".signed")
-                     package-user-dir)
-                    nil 'silent)
-      ;; Update the old pkg-desc which will be shown on the description buffer.
-      (setf (package-desc-signed pkg-desc) t)
-      ;; Update the new (activated) pkg-desc as well.
-      (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
-      (if pkg-descs
-          (setf (package-desc-signed (car pkg-descs)) t)))))
+                       (package-desc-suffix pkg-desc))))
+    (package--with-work-buffer-async location file async
+      (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))
+        ;; If we care, check it and *then* write the file.
+        (let ((content (buffer-string)))
+          (package--check-signature
+           location file content async
+           ;; This function will be called after signature checking.
+           (lambda (&optional good-sigs)
+             (unless (or good-sigs (eq package-check-signature 'allow-unsigned))
+               ;; Even if the sig fails, this download is done, so
+               ;; remove it from the in-progress list.
+               (error "Unsigned package: `%s'"
+                 (package-desc-name pkg-desc)))
+             ;; Signature checked, unpack now.
+             (with-temp-buffer (insert content)
+                               (let ((save-silently async))
+                                 (package-unpack pkg-desc)))
+             ;; Here the package has been installed successfully, mark it as
+             ;; signed if appropriate.
+             (when good-sigs
+               ;; Write out good signatures into NAME-VERSION.signed file.
+               (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+                             nil
+                             (expand-file-name
+                              (concat (package-desc-full-name pkg-desc) ".signed")
+                              package-user-dir)
+                             nil 'silent)
+               ;; Update the old pkg-desc which will be shown on the description buffer.
+               (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)))))))))
 
 (defun package-installed-p (package &optional min-version)
   "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
@@ -1701,22 +1783,75 @@ 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)
+(defun package-download-transaction (packages &optional async callback)
   "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'."
-  (mapc #'package-install-from-archive packages))
+  (cond
+   (packages (package-install-from-archive
+              (car packages)
+              async
+              (lambda ()
+                (package-download-transaction (cdr packages))
+                (when (functionp callback)
+                  (funcall callback)))))
+   (callback (funcall callback))))
+
+(defun package--ensure-init-file ()
+  "Ensure that the user's init file calls `package-initialize'."
+  ;; Don't mess with the init-file from "emacs -Q".
+  (when user-init-file
+    (let* ((buffer (find-buffer-visiting user-init-file))
+           (contains-init
+            (if buffer
+                (with-current-buffer buffer
+                  (save-excursion
+                    (save-restriction
+                      (widen)
+                      (goto-char (point-min))
+                      (search-forward "(package-initialize)" nil 'noerror))))
+              (with-temp-buffer
+                (insert-file-contents user-init-file)
+                (goto-char (point-min))
+                (search-forward "(package-initialize)" nil 'noerror)))))
+      (unless contains-init
+        (with-current-buffer (or buffer
+                                 (let ((delay-mode-hooks t))
+                                   (find-file-noselect user-init-file)))
+          (save-excursion
+            (save-restriction
+              (widen)
+              (goto-char (point-min))
+              (insert
+               ";; Added by Package.el.  This must come before configurations of\n"
+               ";; installed packages.  Don't delete this line.  If you don't want it,\n"
+               ";; just comment it out by adding a semicolon to the start of the line.\n"
+               ";; You may delete these explanatory comments.\n"
+               "(package-initialize)\n")
+              (unless (looking-at-p "$")
+                (insert "\n"))
+              (let ((file-precious-flag t))
+                (save-buffer))
+              (unless buffer
+                (kill-buffer (current-buffer))))))))))
 
 ;;;###autoload
-(defun package-install (pkg &optional dont-select)
+(defun package-install (pkg &optional dont-select async callback)
   "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."
@@ -1741,17 +1876,16 @@ to install it but still mark it as selected."
                   (package-desc-name pkg)
                 pkg)))
     (unless (or dont-select (package--user-selected-p name))
-      (customize-save-variable 'package-selected-packages
-                               (cons name package-selected-packages))))
-  (if (package-desc-p pkg)
-      (if (package-installed-p pkg)
-          (message "`%s' is already installed" (package-desc-full-name pkg))
-        (package-download-transaction
-         (package-compute-transaction (list pkg)
-                                      (package-desc-reqs pkg))))
-    (package-download-transaction
-     (package-compute-transaction ()
-                                  (list (list pkg))))))
+      (package--save-selected-packages
+       (cons name package-selected-packages))))
+  (if-let ((transaction
+            (if (package-desc-p pkg)
+                (unless (package-installed-p pkg)
+                  (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))))
 
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
@@ -1800,8 +1934,8 @@ Downloads and installs required packages as needed."
     ;; Install the package itself.
     (package-unpack pkg-desc)
     (unless (package--user-selected-p name)
-      (customize-save-variable 'package-selected-packages
-                               (cons name package-selected-packages)))
+      (package--save-selected-packages
+       (cons name package-selected-packages)))
     pkg-desc))
 
 ;;;###autoload
@@ -1868,8 +2002,7 @@ If NOSAVE is non-nil, the package is not removed from
                ;; Don't deselect if this is an older version of an
                ;; upgraded package.
                (package--newest-p pkg-desc))
-      (customize-save-variable
-       'package-selected-packages (remove name package-selected-packages)))
+      (package--save-selected-packages (remove name package-selected-packages)))
     (cond ((not (string-prefix-p (file-name-as-directory
                                   (expand-file-name package-user-dir))
                                  (expand-file-name dir)))
@@ -1894,7 +2027,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))))
-           (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
+           (package--message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
 
 ;;;###autoload
 (defun package-reinstall (pkg)
@@ -2187,6 +2320,7 @@ will be deleted."
     (define-key map "x" 'package-menu-execute)
     (define-key map "h" 'package-menu-quick-help)
     (define-key map "?" 'package-menu-describe-package)
+    (define-key map "(" #'package-menu-hide-obsolete)
     (define-key map [menu-bar package-menu] (cons "Package" menu-map))
     (define-key menu-map [mq]
       '(menu-item "Quit" quit-window
@@ -2241,7 +2375,7 @@ will be deleted."
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
-(defvar-local package-menu--new-package-list nil
+(defvar package-menu--new-package-list nil
   "List of newly-available packages since `list-packages' was last called.")
 
 (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
@@ -2249,6 +2383,7 @@ will be deleted."
 Letters do not insert themselves; instead, they are commands.
 \\<package-menu-mode-map>
 \\{package-menu-mode-map}"
+  (setq mode-line-process '(package--downloads-in-progress ":Loading"))
   (setq tabulated-list-format
         `[("Package" 18 package-menu--name-predicate)
           ("Version" 13 nil)
@@ -2336,14 +2471,55 @@ of these dependencies, similar to the list returned by
       (let* ((ins (cadr (assq name package-alist)))
              (ins-v (if ins (package-desc-version ins))))
         (cond
-         ((or (null ins) (version-list-< ins-v version))
+         ;; Installed obsolete packages are handled in the `dir'
+         ;; clause above.  Here we handle available obsolete, which
+         ;; are displayed depending on `package-menu--hide-obsolete'.
+         ((and ins (version-list-<= version ins-v)) "avail-obso")
+         (t
           (if (memq name package-menu--new-package-list)
-              "new" "available"))
-         ((version-list-< version ins-v) "obsolete")
-         ((version-list-= version ins-v)
-          (if (not signed) "unsigned"
-            (if (package--user-selected-p name)
-                "installed" "dependency")))))))))
+              "new" "available"))))))))
+
+(defvar package-menu--hide-obsolete t
+  "Whether available obsolete packages should be hidden.
+Can be toggled with \\<package-menu-mode-map> \\[package-menu-hide-obsolete].
+Installed obsolete packages are always displayed.")
+
+(defun package-menu-hide-obsolete ()
+  "Toggle visibility of obsolete available packages."
+  (interactive)
+  (unless (derived-mode-p 'package-menu-mode)
+    (user-error "The current buffer is not a Package Menu"))
+  (setq package-menu--hide-obsolete
+        (not package-menu--hide-obsolete))
+  (message "%s available-obsolete packages" (if package-menu--hide-obsolete
+                                                "Hiding" "Displaying"))
+  (revert-buffer nil 'no-confirm))
+
+(defun package--remove-hidden (pkg-list)
+  "Filter PKG-LIST according to `package-archive-priorities'.
+PKG-LIST must be a list of package-desc objects sorted by
+decreasing version number.
+Return a list of packages tied for the highest priority according
+to their archives."
+  (when pkg-list
+    ;; The first is a variable toggled with
+    ;; `package-menu-hide-obsolete', the second is a static user
+    ;; option that defines *what* we hide.
+    (if (and package-menu--hide-obsolete
+             package-menu-hide-low-priority)
+        (let ((max-priority (package-desc-priority (car pkg-list)))
+              (out (list (pop pkg-list))))
+          (dolist (p pkg-list (nreverse out))
+            (let ((priority (package-desc-priority p)))
+              (cond
+               ((> priority max-priority)
+                (setq max-priority priority)
+                (setq out (list p)))
+               ;; This assumes pkg-list is sorted by version number.
+               ((and (= priority max-priority)
+                     (eq package-menu-hide-low-priority 'archive))
+                (push p out))))))
+      pkg-list)))
 
 (defun package-menu--refresh (&optional packages keywords)
   "Re-populate the `tabulated-list-entries'.
@@ -2374,10 +2550,11 @@ KEYWORDS should be nil or a list of keywords."
     (dolist (elt package-archive-contents)
       (setq name (car elt))
       (when (or (eq packages t) (memq name packages))
-        (dolist (pkg (cdr elt))
-          ;; Hide obsolete packages.
-          (when (and (not (package-installed-p (package-desc-name pkg)
-                                               (package-desc-version pkg)))
+        (dolist (pkg (package--remove-hidden (cdr elt)))
+          ;; Hide available obsolete packages.
+          (when (and (not (and package-menu--hide-obsolete
+                               (package-installed-p (package-desc-name pkg)
+                                                    (package-desc-version pkg))))
                      (package--has-keyword-p pkg keywords))
             (package--push pkg (package-desc-status pkg) info-list)))))
 
@@ -2387,11 +2564,11 @@ KEYWORDS should be nil or a list of keywords."
 
 (defun package-all-keywords ()
   "Collect all package keywords"
-  (let (keywords)
+  (let ((key-list))
     (package--mapc (lambda (desc)
-                     (let* ((desc-keywords (and desc (package-desc--keywords desc))))
-                       (setq keywords (append keywords desc-keywords)))))
-    keywords))
+                     (setq key-list (append (package-desc--keywords desc)
+                                            key-list))))
+    key-list))
 
 (defun package--mapc (function &optional packages)
   "Call FUNCTION for all known PACKAGES.
@@ -2430,12 +2607,14 @@ Built-in packages are converted with `package--from-builtin'."
   "Test if package DESC has any of the given KEYWORDS.
 When none are given, the package matches."
   (if keywords
-      (let* ((desc-keywords (and desc (package-desc--keywords desc)))
-             found)
-        (dolist (k keywords)
-          (when (and (not found)
-                     (member k desc-keywords))
-            (setq found t)))
+      (let ((desc-keywords (and desc (package-desc--keywords desc)))
+            found)
+        (while (and (not found) keywords)
+          (let ((k (pop keywords)))
+            (setq found
+                  (or (string= k (concat "arc:" (package-desc-archive desc)))
+                      (string= k (concat "status:" (package-desc-status desc)))
+                      (member k desc-keywords)))))
         found)
     t))
 
@@ -2468,6 +2647,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
          (face (pcase status
                  (`"built-in"  'font-lock-builtin-face)
                  (`"available" 'default)
+                 (`"avail-obso" 'font-lock-comment-face)
                  (`"new"       'bold)
                  (`"held"      'font-lock-constant-face)
                  (`"disabled"  'font-lock-warning-face)
@@ -2499,8 +2679,9 @@ This fetches the contents of each archive specified in
   (interactive)
   (unless (derived-mode-p 'package-menu-mode)
     (user-error "The current buffer is not a Package Menu"))
-  (package-refresh-contents)
-  (package-menu--generate t t))
+  (setq package-menu--old-archive-contents package-archive-contents)
+  (setq package-menu--new-package-list nil)
+  (package-refresh-contents package-menu-async))
 
 (defun package-menu-describe-package (&optional button)
   "Describe the current package.
@@ -2524,7 +2705,7 @@ If optional arg BUTTON is non-nil, describe its associated package."
 (defun package-menu-mark-install (&optional _num)
   "Mark a package for installation and move to the next line."
   (interactive "p")
-  (if (member (package-menu-get-status) '("available" "new" "dependency"))
+  (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
       (tabulated-list-put-tag "I" t)
     (forward-line)))
 
@@ -2549,10 +2730,31 @@ If optional arg BUTTON is non-nil, describe its associated package."
           (tabulated-list-put-tag "D" t)
         (forward-line 1)))))
 
+(defvar package--quick-help-keys
+  '(("install," "delete," "unmark," ("execute" . 1))
+    ("next," "previous")
+    ("refresh-contents," "g-redisplay," "filter," "(-toggle-obsolete" "help")))
+
+(defun package--prettify-quick-help-key (desc)
+  "Prettify DESC to be displayed as a help menu."
+  (if (listp desc)
+      (if (listp (cdr desc))
+          (mapconcat #'package--prettify-quick-help-key desc "   ")
+        (let ((place (cdr desc))
+              (out (car desc)))
+          ;; (setq out (propertize out 'face 'paradox-comment-face))
+          (add-text-properties place (1+ place)
+                               '(face (bold font-lock-function-name-face))
+                               out)
+          out))
+    (package--prettify-quick-help-key (cons desc 0))))
+
 (defun package-menu-quick-help ()
-  "Show short key binding help for package-menu-mode."
+  "Show short key binding help for `package-menu-mode'.
+The full list of keys can be viewed with \\[describe-mode]."
   (interactive)
-  (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
+  (message (mapconcat #'package--prettify-quick-help-key
+                      package--quick-help-keys "\n")))
 
 (define-obsolete-function-alias
   'package-menu-view-commentary 'package-menu-describe-package "24.1")
@@ -2579,8 +2781,7 @@ defaults to 0."
 This allows for easy comparison of package versions from
 different archives if archive priorities are meant to be taken in
 consideration."
-  (cons (package-archive-priority
-         (package-desc-archive pkg-desc))
+  (cons (package-desc-priority pkg-desc)
         (package-desc-version pkg-desc)))
 
 (defun package-menu--find-upgrades ()
@@ -2632,6 +2833,75 @@ call will upgrade the package."
                (length upgrades)
                (if (= (length upgrades) 1) "" "s")))))
 
+(defun package-menu--list-to-prompt (packages)
+  "Return a string listing PACKAGES that's usable in a prompt.
+PACKAGES is a list of `package-desc' objects.
+Formats the returned string to be usable in a minibuffer
+prompt (see `package-menu--prompt-transaction-p')."
+  (cond
+   ;; None
+   ((not packages) "")
+   ;; More than 1
+   ((cdr packages)
+    (format "these %d packages (%s)"
+      (length packages)
+      (mapconcat #'package-desc-full-name packages ", ")))
+   ;; Exactly 1
+   (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."
+  (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.
+  (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))))
+    ;; Once there are no more packages to install, proceed to
+    ;; deletion.
+    (let ((package--silence async))
+      (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)))
+
 (defun package-menu-execute (&optional noquery)
   "Perform marked Package Menu actions.
 Packages marked for installation are downloaded and installed;
@@ -2653,54 +2923,14 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
                 ((eq cmd ?I)
                  (push pkg-desc install-list))))
         (forward-line)))
-    (when install-list
-      (if (or
-           noquery
-           (yes-or-no-p
-            (if (= (length install-list) 1)
-                (format "Install package `%s'? "
-                        (package-desc-full-name (car install-list)))
-              (format "Install these %d packages (%s)? "
-                      (length install-list)
-                      (mapconcat #'package-desc-full-name
-                                 install-list ", ")))))
-          (mapc (lambda (p)
-                  ;; Don't mark as selected if it's a new version of
-                  ;; an installed package.
-                  (package-install p (and (not (package-installed-p p))
-                                          (package-installed-p
-                                           (package-desc-name p)))))
-                install-list)))
-    ;; Delete packages, prompting if necessary.
-    (when delete-list
-      (if (or
-           noquery
-           (yes-or-no-p
-           (if (= (length delete-list) 1)
-               (format "Delete package `%s'? "
-                       (package-desc-full-name (car delete-list)))
-             (format "Delete these %d packages (%s)? "
-                     (length delete-list)
-                     (mapconcat #'package-desc-full-name
-                                delete-list ", ")))))
-          (dolist (elt (package--sort-by-dependence delete-list))
-            (condition-case-unless-debug err
-                (package-delete elt)
-              (error (message (cadr err)))))
-        (error "Aborted")))
-    (if (not (or delete-list install-list))
-        (message "No operations specified.")
-      (when package-selected-packages
-        (let ((removable (package--removable-packages)))
-          (when (and removable
-                     (y-or-n-p
-                      (format "These %d packages are no longer needed, delete them (%s)? "
-                              (length removable)
-                              (mapconcat #'symbol-name removable ", "))))
-            ;; We know these are removable, so we can use force instead of sorting them.
-            (mapc (lambda (p) (package-delete (cadr (assq p package-alist)) 'force 'nosave))
-                  removable))))
-      (package-menu--generate t t))))
+    (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))))
 
 (defun package-menu--version-predicate (A B)
   (let ((vA (or (aref (cadr A) 1)  '(0)))
@@ -2716,8 +2946,11 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
            (package-menu--name-predicate A B))
           ((string= sA "new") t)
           ((string= sB "new") nil)
-          ((string= sA "available") t)
-          ((string= sB "available") nil)
+          ((string-prefix-p "avail" sA)
+           (if (string-prefix-p "avail" sB)
+               (package-menu--name-predicate A B)
+             t))
+          ((string-prefix-p "avail" sB) nil)
           ((string= sA "installed") t)
           ((string= sB "installed") nil)
           ((string= sA "dependency") t)
@@ -2749,7 +2982,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
   (string< (or (package-desc-archive (car A)) "")
            (or (package-desc-archive (car B)) "")))
 
-(defvar-local package-menu--old-archive-contents nil
+(defvar package-menu--old-archive-contents nil
   "`package-archive-contents' before the latest refresh.")
 
 (defun package-menu--populate-new-package-list ()
@@ -2773,9 +3006,8 @@ Store this list in `package-menu--new-package-list'."
 
 (defun package-menu--post-refresh ()
   "Check for new packages, revert the *Packages* buffer, and check for upgrades.
-This function is called after `package-refresh-contents' is done.
-It goes in `package--post-download-archives-hook', so that it
-works with async refresh as well."
+This function is called after `package-refresh-contents' and
+after `package-menu--perform-transaction'."
   (package-menu--populate-new-package-list)
   (let ((buf (get-buffer "*Packages*")))
     (when (buffer-live-p buf)
@@ -2785,10 +3017,10 @@ works with async refresh as well."
 
 (defcustom package-menu-async t
   "If non-nil, package-menu will use async operations when possible.
-Currently, only the refreshing of archive contents supports
-asynchronous operations.  Package transactions are still done
-synchronously."
+This includes refreshing archive contents as well as installing
+packages."
   :type 'boolean
+  :version "25.1"
   :group 'package)
 
 ;;;###autoload
@@ -2806,17 +3038,17 @@ The list is displayed in a buffer named `*Packages*'."
   (add-hook 'package--post-download-archives-hook
             #'package-menu--post-refresh)
 
-  (unless no-fetch
-    (setq package-menu--old-archive-contents package-archive-contents)
-    (setq package-menu--new-package-list nil)
-    ;; Fetch the remote list of packages.
-    (package-refresh-contents package-menu-async))
-
   ;; Generate the Package Menu.
   (let ((buf (get-buffer-create "*Packages*")))
     (with-current-buffer buf
       (package-menu-mode)
-      (package-menu--generate nil t))
+
+      ;; Fetch the remote list of packages.
+      (unless no-fetch (package-menu-refresh))
+
+      ;; If we're not async, this would be redundant.
+      (when package-menu-async
+        (package-menu--generate nil t)))
     ;; The package menu buffer has keybindings.  If the user types
     ;; `M-x list-packages', that suggests it should become current.
     (switch-to-buffer buf)))
@@ -2849,9 +3081,17 @@ shown."
 (defun package-menu-filter (keyword)
   "Filter the *Packages* buffer.
 Show only those items that relate to the specified KEYWORD.
+KEYWORD can be a string or a list of strings.  If it is a list, a
+package will be displayed if it matches any of the keywords.
+Interactively, it is a list of strings separated by commas.
+
 To restore the full package list, type `q'."
-  (interactive (list (completing-read "Keyword: " (package-all-keywords))))
-  (package-show-package-list t (list keyword)))
+  (interactive
+   (list (completing-read-multiple
+          "Keywords (comma separated): " (package-all-keywords))))
+  (package-show-package-list t (if (stringp keyword)
+                                   (list keyword)
+                                 keyword)))
 
 (defun package-list-packages-no-fetch ()
   "Display a list of packages.