merge from trunk

1 files changed, 2506 insertions, 881 deletions

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index add73fd4bde..2962da5a917 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1,6 +1,6 @@
 ;;; package.el --- Simple package system for Emacs  -*- lexical-binding:t -*-
 
-;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
 
 ;; Author: Tom Tromey <tromey@redhat.com>
 ;;         Daniel Hackney <dan@haxney.org>
@@ -113,8 +113,6 @@
 
 ;;; ToDo:
 
-;; - a trust mechanism, since compiling a package can run arbitrary code.
-;;   For example, download package signatures and check that they match.
 ;; - putting info dirs at the start of the info path means
 ;;   users see a weird ordering of categories.  OTOH we want to
 ;;   override later entries.  maybe emacs needs to enforce
@@ -163,15 +161,20 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'subr-x))
 (eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'epg))      ;For setf accessors.
 
 (require 'tabulated-list)
+(require 'macroexp)
 
 (defgroup package nil
   "Manager for Emacs Lisp packages."
   :group 'applications
   :version "24.1")
 
+
+;;; Customization options
 ;;;###autoload
 (defcustom package-enable-at-startup t
   "Whether to activate installed packages when Emacs starts.
@@ -182,7 +185,6 @@ and before `after-init-hook'.  Activation is not done if
 Even if the value is nil, you can type \\[package-initialize] to
 activate the package system at any time."
   :type 'boolean
-  :group 'package
   :version "24.1")
 
 (defcustom package-load-list '(all)
@@ -200,16 +202,8 @@ If VERSION is a string, only that version is ever loaded.
 If VERSION is nil, the package is not loaded (it is \"disabled\")."
   :type '(repeat symbol)
   :risky t
-  :group 'package
   :version "24.1")
 
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-(declare-function url-http-parse-response "url-http" ())
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-(defvar url-http-end-of-headers)
-
 (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
   "An alist of archives from which to fetch.
 The default value points to the GNU Emacs package repository.
@@ -226,37 +220,72 @@ a package can run arbitrary code."
   :type '(alist :key-type (string :tag "Archive name")
                 :value-type (string :tag "URL or directory name"))
   :risky t
-  :group 'package
   :version "24.1")
 
-(defcustom package-pinned-packages nil
-  "An alist of packages that are pinned to a specific archive
-
-Each element has the form (SYM . ID).
- SYM is a package, as a symbol.
- ID is an archive name. This should correspond to an
- entry in `package-archives'.
+(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-packages' is
+nil, so it can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding]."
+  :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))
+  :version "25.1")
+
+(defcustom package-archive-priorities nil
+  "An alist of priorities for packages.
+
+Each element has the form (ARCHIVE-ID . PRIORITY).
+
+When installing packages, the package with the highest version
+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.
+
+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
+  :version "25.1")
 
-If the archive of name ID does not contain the package SYM, no
-other location will be considered, which will make the
-package unavailable."
+(defcustom package-pinned-packages nil
+  "An alist of packages that are pinned to specific archives.
+This can be useful if you have multiple package archives enabled,
+and want to control which archive a given package gets installed from.
+
+Each element of the alist has the form (PACKAGE . ARCHIVE), where:
+ PACKAGE is a symbol representing a package
+ ARCHIVE is a string representing an archive (it should be the car of
+an element in `package-archives', e.g. \"gnu\").
+
+Adding an entry to this variable means that only ARCHIVE will be
+considered as a source for PACKAGE.  If other archives provide PACKAGE,
+they are ignored (for this package).  If ARCHIVE does not contain PACKAGE,
+the package will be unavailable."
   :type '(alist :key-type (symbol :tag "Package")
                 :value-type (string :tag "Archive name"))
+  ;; I don't really see why this is risky...
+  ;; I suppose it could prevent you receiving updates for a package,
+  ;; via an entry (PACKAGE . NON-EXISTING).  Which could be an issue
+  ;; if PACKAGE has a known vulnerability that is fixed in newer versions.
   :risky t
-  :group 'package
   :version "24.4")
 
-(defconst package-archive-version 1
-  "Version number of the package archive understood by this file.
-Lower version numbers than this will probably be understood as well.")
-
-;; We don't prime the cache since it tends to get out of date.
-(defvar package-archive-contents nil
-  "Cache of the contents of the Emacs Lisp Package Archive.
-This is an alist mapping package names (symbols) to
-non-empty lists of `package-desc' structures.")
-(put 'package-archive-contents 'risky-local-variable t)
-
 (defcustom package-user-dir (locate-user-emacs-file "elpa")
   "Directory containing the user's Emacs Lisp packages.
 The directory name should be absolute.
@@ -264,7 +293,6 @@ Apart from this directory, Emacs also looks for system-wide
 packages in `package-directory-list'."
   :type 'directory
   :risky t
-  :group 'package
   :version "24.1")
 
 (defcustom package-directory-list
@@ -272,8 +300,8 @@ packages in `package-directory-list'."
   (let (result)
     (dolist (f load-path)
       (and (stringp f)
-	   (equal (file-name-nondirectory f) "site-lisp")
-	   (push (expand-file-name "elpa" f) result)))
+           (equal (file-name-nondirectory f) "site-lisp")
+           (push (expand-file-name "elpa" f) result)))
     (nreverse result))
   "List of additional directories containing Emacs Lisp packages.
 Each directory name should be absolute.
@@ -282,9 +310,60 @@ These directories contain packages intended for system-wide; in
 contrast, `package-user-dir' contains packages for personal use."
   :type '(repeat directory)
   :risky t
-  :group 'package
   :version "24.1")
 
+(defvar epg-gpg-program)
+
+(defcustom package-check-signature
+  (if (progn (require 'epg-config) (executable-find epg-gpg-program))
+      'allow-unsigned)
+  "Non-nil means to check package signatures when installing.
+The value `allow-unsigned' means to still install a package even if
+it is unsigned.
+
+This also applies to the \"archive-contents\" file that lists the
+contents of the archive."
+  :type '(choice (const nil :tag "Never")
+                 (const allow-unsigned :tag "Allow unsigned")
+                 (const t :tag "Check always"))
+  :risky t
+  :version "24.4")
+
+(defcustom package-unsigned-archives nil
+  "List of archives where we do not check for package signatures."
+  :type '(repeat (string :tag "Archive name"))
+  :risky t
+  :version "24.4")
+
+(defcustom package-selected-packages nil
+  "Store here packages installed explicitly by user.
+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-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
+a sane initial value."
+  :type '(repeat symbol))
+
+(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."
+  :type 'boolean
+  :version "25.1")
+
+
+;;; `package-desc' object definition
+;; This is the struct used internally to represent packages.
+;; Functions that deal with packages should generally take this object
+;; as an argument.  In some situations (e.g. commands that query the
+;; user) it makes sense to take the package name as a symbol instead,
+;; but keep in mind there could be multiple `package-desc's with the
+;; same name.
 (defvar package--default-summary "No description available.")
 
 (cl-defstruct (package-desc
@@ -296,7 +375,7 @@ contrast, `package-user-dir' contains packages for personal use."
                (:constructor
                 package-desc-from-define
                 (name-string version-string &optional summary requirements
-                 &key kind archive &allow-other-keys
+                 &rest rest-plist
                  &aux
                  (name (intern name-string))
                  (version (version-to-list version-string))
@@ -305,7 +384,21 @@ contrast, `package-user-dir' contains packages for personal use."
                                          (version-to-list (cadr elt))))
                                (if (eq 'quote (car requirements))
                                    (nth 1 requirements)
-                                 requirements))))))
+                                 requirements)))
+                 (kind (plist-get rest-plist :kind))
+                 (archive (plist-get rest-plist :archive))
+                 (extras (let (alist)
+                           (while rest-plist
+                             (unless (memq (car rest-plist) '(:kind :archive))
+                               (let ((value (cadr rest-plist)))
+                                 (when value
+                                   (push (cons (car rest-plist)
+                                               (if (eq (car-safe value) 'quote)
+                                                   (cadr value)
+                                                 value))
+                                         alist))))
+                             (setq rest-plist (cddr rest-plist)))
+                           alist)))))
   "Structure containing information about an individual package.
 Slots:
 
@@ -314,29 +407,71 @@ Slots:
 `version' Version of the package, as a version list.
 
 `summary' Short description of the package, typically taken from
-	the first line of the file.
+        the first line of the file.
 
 `reqs'	Requirements of the package. A list of (PACKAGE
-	VERSION-LIST) naming the dependent package and the minimum
-	required version.
+        VERSION-LIST) naming the dependent package and the minimum
+        required version.
 
 `kind'	The distribution format of the package. Currently, it is
-	either `single' or `tar'.
+        either `single' or `tar'.
 
 `archive' The name of the archive (as a string) whence this
-	package came.
+        package came.
 
 `dir'	The directory where the package is installed (if installed),
-	`builtin' if it is built-in, or nil otherwise."
+        `builtin' if it is built-in, or nil otherwise.
+
+`extras' Optional alist of additional keyword-value pairs.
+
+`signed' Flag to indicate that the package is signed by provider."
   name
   version
   (summary package--default-summary)
   reqs
   kind
   archive
-  dir)
+  dir
+  extras
+  signed)
+
+(defun package--from-builtin (bi-desc)
+  (package-desc-create :name (pop bi-desc)
+                       :version (package--bi-desc-version bi-desc)
+                       :summary (package--bi-desc-summary bi-desc)
+                       :dir 'builtin))
 
 ;; Pseudo fields.
+(defun package-version-join (vlist)
+  "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+  (if (null vlist)
+      ""
+    (let ((str-list (list "." (int-to-string (car vlist)))))
+      (dolist (num (cdr vlist))
+        (cond
+         ((>= num 0)
+          (push (int-to-string num) str-list)
+          (push "." str-list))
+         ((< num -4)
+          (error "Invalid version list `%s'" vlist))
+         (t
+          ;; pre, or beta, or alpha
+          (cond ((equal "." (car str-list))
+                 (pop str-list))
+                ((not (string-match "[0-9]+" (car str-list)))
+                 (error "Invalid version list `%s'" vlist)))
+          (push (cond ((= num -1) "pre")
+                      ((= num -2) "beta")
+                      ((= num -3) "alpha")
+                      ((= num -4) "snapshot"))
+                str-list))))
+      (if (equal "." (car str-list))
+          (pop str-list))
+      (apply 'concat (nreverse str-list)))))
+
 (defun package-desc-full-name (pkg-desc)
   (format "%s-%s"
           (package-desc-name pkg-desc)
@@ -346,8 +481,19 @@ Slots:
   (pcase (package-desc-kind pkg-desc)
     (`single ".el")
     (`tar ".tar")
+    (`dir "")
     (kind (error "Unknown package kind: %s" kind))))
 
+(defun package-desc--keywords (pkg-desc)
+  (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc)))))
+    (if (eq (car-safe keywords) 'quote)
+        (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))
@@ -356,6 +502,13 @@ Slots:
   reqs
   summary)
 
+
+;;; Installed packages
+;; The following variables store information about packages present in
+;; the system.  The most important of these is `package-alist'.  The
+;; command `package-initialize' is also closely related to this
+;; section, but it is left for a later section because it also affects
+;; other stuff.
 (defvar package--builtins nil
   "Alist of built-in packages.
 The actual value is initialized by loading the library
@@ -382,46 +535,44 @@ loaded and/or activated, customize `package-load-list'.")
   "List of the names of currently activated packages.")
 (put 'package-activated-list 'risky-local-variable t)
 
-(defun package-version-join (vlist)
-  "Return the version string corresponding to the list VLIST.
-This is, approximately, the inverse of `version-to-list'.
-\(Actually, it returns only one of the possible inverses, since
-`version-to-list' is a many-to-one operation.)"
-  (if (null vlist)
-      ""
-    (let ((str-list (list "." (int-to-string (car vlist)))))
-      (dolist (num (cdr vlist))
-	(cond
-	 ((>= num 0)
-	  (push (int-to-string num) str-list)
-	  (push "." str-list))
-	 ((< num -3)
-	  (error "Invalid version list `%s'" vlist))
-	 (t
-	  ;; pre, or beta, or alpha
-	  (cond ((equal "." (car str-list))
-		 (pop str-list))
-		((not (string-match "[0-9]+" (car str-list)))
-		 (error "Invalid version list `%s'" vlist)))
-	  (push (cond ((= num -1) "pre")
-		      ((= num -2) "beta")
-		      ((= num -3) "alpha"))
-		str-list))))
-      (if (equal "." (car str-list))
-	  (pop str-list))
-      (apply 'concat (nreverse str-list)))))
+;;;; Populating `package-alist'.
+;; The following functions are called on each installed package by
+;; `package-load-all-descriptors', which ultimately populates the
+;; `package-alist' variable.
+(defun package-process-define-package (exp)
+  (when (eq (car-safe exp) 'define-package)
+    (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
+           (name (package-desc-name new-pkg-desc))
+           (version (package-desc-version new-pkg-desc))
+           (old-pkgs (assq name package-alist)))
+      (if (null old-pkgs)
+          ;; If there's no old package, just add this to `package-alist'.
+          (push (list name new-pkg-desc) package-alist)
+        ;; If there is, insert the new package at the right place in the list.
+        (while
+            (if (and (cdr old-pkgs)
+                     (version-list-< version
+                                     (package-desc-version (cadr old-pkgs))))
+                (setq old-pkgs (cdr old-pkgs))
+              (push new-pkg-desc (cdr old-pkgs))
+              nil)))
+      new-pkg-desc)))
 
 (defun package-load-descriptor (pkg-dir)
   "Load the description file in directory PKG-DIR."
   (let ((pkg-file (expand-file-name (package--description-file pkg-dir)
-                                    pkg-dir)))
+                                    pkg-dir))
+        (signed-file (concat pkg-dir ".signed")))
     (when (file-exists-p pkg-file)
       (with-temp-buffer
         (insert-file-contents pkg-file)
         (goto-char (point-min))
-        (let ((pkg-desc (package-process-define-package
-                         (read (current-buffer)) pkg-file)))
+        (let ((pkg-desc (or (package-process-define-package
+                             (read (current-buffer)))
+                            (error "Can't find define-package in %s" pkg-file))))
           (setf (package-desc-dir pkg-desc) pkg-dir)
+          (if (file-exists-p signed-file)
+              (setf (package-desc-signed pkg-desc) t))
           pkg-desc)))))
 
 (defun package-load-all-descriptors ()
@@ -436,10 +587,29 @@ 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
+                                    &rest _extra-properties)
+  "Define a new package.
+NAME-STRING is the name of the package, as a string.
+VERSION-STRING is the version of the package, as a string.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+  ;; FIXME: Placeholder!  Should we keep it?
+  (error "Don't call me!"))
 
+
+;;; Package activation
+;; Section for functions used by `package-activate', which see.
 (defun package-disabled-p (pkg-name version)
   "Return whether PKG-NAME at VERSION can be activated.
 The decision is made according to `package-load-list'.
@@ -455,50 +625,123 @@ Return the max version (as a string) if the package is held at a lower version."
              force))
           (t (error "Invalid element in `package-load-list'")))))
 
-(defun package-activate-1 (pkg-desc)
+(defun package-built-in-p (package &optional min-version)
+  "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+  (if (package-desc-p package) ;; was built-in and then was converted
+      (eq 'builtin (package-desc-dir package))
+    (let ((bi (assq package package--builtin-versions)))
+      (cond
+       (bi (version-list-<= min-version (cdr bi)))
+       ((remove 0 min-version) nil)
+       (t
+        (require 'finder-inf nil t) ; For `package--builtins'.
+        (assq package package--builtins))))))
+
+(defun package--autoloads-file-name (pkg-desc)
+  "Return the absolute name of the autoloads file, sans extension.
+PKG-DESC is a `package-desc' object."
+  (expand-file-name
+   (format "%s-autoloads" (package-desc-name pkg-desc))
+   (package-desc-dir pkg-desc)))
+
+(defun package--activate-autoloads-and-load-path (pkg-desc)
+  "Load the autoloads file and add package dir to `load-path'.
+PKG-DESC is a `package-desc' object."
+  (let* ((old-lp load-path)
+         (pkg-dir (package-desc-dir pkg-desc))
+         (pkg-dir-dir (file-name-as-directory pkg-dir)))
+    (with-demoted-errors "Error loading autoloads: %s"
+      (load (package--autoloads-file-name pkg-desc) nil t))
+    (when (and (eq old-lp load-path)
+               (not (or (member pkg-dir load-path)
+                        (member pkg-dir-dir load-path))))
+      ;; Old packages don't add themselves to the `load-path', so we have to
+      ;; do it ourselves.
+      (push pkg-dir load-path))))
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+
+(defun package-activate-1 (pkg-desc &optional reload)
+  "Activate package given by PKG-DESC, even if it was already active.
+If RELOAD is non-nil, also `load' any files inside the package which
+correspond to previously loaded files (those returned by
+`package--list-loaded-files')."
   (let* ((name (package-desc-name pkg-desc))
-	 (pkg-dir (package-desc-dir pkg-desc)))
+         (pkg-dir (package-desc-dir pkg-desc)))
     (unless pkg-dir
       (error "Internal error: unable to find directory for `%s'"
-	     (package-desc-full-name pkg-desc)))
+             (package-desc-full-name pkg-desc)))
+    (let* ((loaded-files-list (when reload
+                                (package--list-loaded-files pkg-dir))))
+      ;; Add to load path, add autoloads, and activate the package.
+      (package--activate-autoloads-and-load-path pkg-desc)
+      ;; Call `load' on all files in `pkg-dir' already present in
+      ;; `load-history'.  This is done so that macros in these files are updated
+      ;; to their new definitions.  If another package is being installed which
+      ;; depends on this new definition, not doing this update would cause
+      ;; compilation errors and break the installation.
+      (with-demoted-errors "Error in package-activate-1: %s"
+        (mapc (lambda (feature) (load feature nil t))
+              ;; Skip autoloads file since we already evaluated it above.
+              (remove (file-truename (package--autoloads-file-name pkg-desc))
+                      loaded-files-list))))
     ;; Add info node.
     (when (file-exists-p (expand-file-name "dir" pkg-dir))
       ;; FIXME: not the friendliest, but simple.
       (require 'info)
       (info-initialize)
       (push pkg-dir Info-directory-list))
-    ;; Add to load path, add autoloads, and activate the package.
-    (push pkg-dir load-path)
-    (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)
     (push name package-activated-list)
     ;; Don't return nil.
     t))
 
-(defun package-built-in-p (package &optional min-version)
-  "Return true if PACKAGE is built-in to Emacs.
-Optional arg MIN-VERSION, if non-nil, should be a version list
-specifying the minimum acceptable version."
-  (let ((bi (assq package package--builtin-versions)))
-    (cond
-     (bi (version-list-<= min-version (cdr bi)))
-     (min-version nil)
-     (t
-      (require 'finder-inf nil t) ; For `package--builtins'.
-      (assq package package--builtins)))))
-
-(defun package--from-builtin (bi-desc)
-  (package-desc-create :name (pop bi-desc)
-                       :version (package--bi-desc-version bi-desc)
-                       :summary (package--bi-desc-summary bi-desc)
-                       :dir 'builtin))
-
-;; This function goes ahead and activates a newer version of a package
-;; if an older one was already activated.  This is not ideal; we'd at
-;; least need to check to see if the package has actually been loaded,
-;; and not merely activated.
+(declare-function find-library-name "find-func" (library))
+
+(defun package--list-loaded-files (dir)
+  "Recursively list all files in DIR which correspond to loaded features.
+Returns the `file-name-sans-extension' of each file, relative to
+DIR, sorted by most recently loaded last."
+  (let* ((history (delq nil
+                        (mapcar (lambda (x)
+                                  (let ((f (car x)))
+                                    (and f (file-name-sans-extension f))))
+                                load-history)))
+         (dir (file-truename dir))
+         ;; List all files that have already been loaded.
+         (list-of-conflicts
+          (delq
+           nil
+           (mapcar
+               (lambda (x) (let* ((file (file-relative-name x dir))
+                             ;; Previously loaded file, if any.
+                             (previous
+                              (ignore-errors
+                                (file-name-sans-extension
+                                 (file-truename (find-library-name file)))))
+                             (pos (when previous (member previous history))))
+                        ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
+                        (when pos
+                          (cons (file-name-sans-extension file) (length pos)))))
+             (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
+    ;; Turn the list of (FILENAME . POS) back into a list of features.  Files in
+    ;; subdirectories are returned relative to DIR (so not actually features).
+    (let ((default-directory (file-name-as-directory dir)))
+      (mapcar (lambda (x) (file-truename (car x)))
+        (sort list-of-conflicts
+              ;; Sort the files by ascending HISTORY-POSITION.
+              (lambda (x y) (< (cdr x) (cdr y))))))))
+
+;;;; `package-activate'
+;; This function activates a newer version of a package if an older
+;; one was already activated.  It also loads a features of this
+;; package which were already loaded.
 (defun package-activate (package &optional force)
   "Activate package PACKAGE.
-If FORCE is true, (re-)activate it if it's already activated."
+If FORCE is true, (re-)activate it if it's already activated.
+Newer versions are always activated, regardless of FORCE."
   (let ((pkg-descs (cdr (assq package package-alist))))
     ;; Check if PACKAGE is available in `package-alist'.
     (while
@@ -521,85 +764,23 @@ If FORCE is true, (re-)activate it if it's already activated."
              (fail (catch 'dep-failure
                      ;; Activate its dependencies recursively.
                      (dolist (req (package-desc-reqs pkg-vec))
-                       (unless (package-activate (car req) (cadr req))
+                       (unless (package-activate (car req))
                          (throw 'dep-failure req))))))
-	(if fail
-	    (warn "Unable to activate package `%s'.
+        (if fail
+            (warn "Unable to activate package `%s'.
 Required package `%s-%s' is unavailable"
-		  package (car fail) (package-version-join (cadr fail)))
-	  ;; If all goes well, activate the package itself.
-	  (package-activate-1 pkg-vec)))))))
-
-(defun define-package (_name-string _version-string
-                                    &optional _docstring _requirements
-                                    &rest _extra-properties)
-  "Define a new package.
-NAME-STRING is the name of the package, as a string.
-VERSION-STRING is the version of the package, as a string.
-DOCSTRING is a short description of the package, a string.
-REQUIREMENTS is a list of dependencies on other packages.
- Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
- where OTHER-VERSION is a string.
-
-EXTRA-PROPERTIES is currently unused."
-  ;; FIXME: Placeholder!  Should we keep it?
-  (error "Don't call me!"))
-
-(defun package-process-define-package (exp origin)
-  (unless (eq (car-safe exp) 'define-package)
-    (error "Can't find define-package in %s" origin))
-  (let* ((new-pkg-desc (apply #'package-desc-from-define (cdr exp)))
-         (name (package-desc-name new-pkg-desc))
-         (version (package-desc-version new-pkg-desc))
-         (old-pkgs (assq name package-alist)))
-    (if (null old-pkgs)
-        ;; If there's no old package, just add this to `package-alist'.
-        (push (list name new-pkg-desc) package-alist)
-      ;; If there is, insert the new package at the right place in the list.
-      (while
-          (if (and (cdr old-pkgs)
-                   (version-list-< version
-                                   (package-desc-version (cadr old-pkgs))))
-              (setq old-pkgs (cdr old-pkgs))
-            (push new-pkg-desc (cdr old-pkgs))
-            nil)))
-    new-pkg-desc))
-
-;; From Emacs 22, but changed so it adds to load-path.
-(defun package-autoload-ensure-default-file (file)
-  "Make sure that the autoload file FILE exists and if not create it."
-  (unless (file-exists-p file)
-    (write-region
-     (concat ";;; " (file-name-nondirectory file)
-	     " --- automatically extracted autoloads\n"
-	     ";;\n"
-	     ";;; Code:\n"
-             "(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))\n"
-	     "\n;; Local Variables:\n"
-	     ";; version-control: never\n"
-	     ";; no-byte-compile: t\n"
-	     ";; no-update-autoloads: t\n"
-	     ";; End:\n"
-	     ";;; " (file-name-nondirectory file)
-	     " ends here\n")
-     nil file))
-  file)
+                  package (car fail) (package-version-join (cadr fail)))
+          ;; If all goes well, activate the package itself.
+          (package-activate-1 pkg-vec force)))))))
 
-(defvar generated-autoload-file)
-(defvar version-control)
-
-(defun package-generate-autoloads (name pkg-dir)
-  (require 'autoload)         ;Load before we let-bind generated-autoload-file!
-  (let* ((auto-name (format "%s-autoloads.el" name))
-	 ;;(ignore-name (concat name "-pkg.el"))
-	 (generated-autoload-file (expand-file-name auto-name pkg-dir))
-	 (version-control 'never))
-    (package-autoload-ensure-default-file generated-autoload-file)
-    (update-directory-autoloads pkg-dir)
-    (let ((buf (find-buffer-visiting generated-autoload-file)))
-      (when buf (kill-buffer buf)))
-    auto-name))
+
+;;; Installation -- Local operations
+;; This section contains a variety of features regarding installing a
+;; package to/from disk.  This includes autoload generation,
+;; unpacking, compiling, as well as defining a package from the
+;; current buffer.
 
+;;;; Unpacking
 (defvar tar-parse-info)
 (declare-function tar-untar-buffer "tar-mode" ())
 (declare-function tar-header-name "tar-mode" (tar-header) t)
@@ -613,50 +794,41 @@ untar into a directory named DIR; otherwise, signal an error."
   (tar-mode)
   ;; Make sure everything extracts into DIR.
   (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
-	(case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+        (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
     (dolist (tar-data tar-parse-info)
       (let ((name (expand-file-name (tar-header-name tar-data))))
-	(or (string-match regexp name)
-	    ;; Tarballs created by some utilities don't list
-	    ;; directories with a trailing slash (Bug#13136).
-	    (and (string-equal dir name)
-		 (eq (tar-header-link-type tar-data) 5))
-	    (error "Package does not untar cleanly into directory %s/" dir)))))
+        (or (string-match regexp name)
+            ;; Tarballs created by some utilities don't list
+            ;; directories with a trailing slash (Bug#13136).
+            (and (string-equal dir name)
+                 (eq (tar-header-link-type tar-data) 5))
+            (error "Package does not untar cleanly into directory %s/" dir)))))
   (tar-untar-buffer))
 
-(defun package-generate-description-file (pkg-desc pkg-dir)
-  "Create the foo-pkg.el file for single-file packages."
-  (let* ((name (package-desc-name pkg-desc))
-         (pkg-file (expand-file-name (package--description-file pkg-dir)
-                                     pkg-dir)))
-    (let ((print-level nil)
-          (print-quoted t)
-          (print-length nil))
-      (write-region
-       (concat
-        (prin1-to-string
-         (list 'define-package
-               (symbol-name name)
-               (package-version-join (package-desc-version pkg-desc))
-               (package-desc-summary pkg-desc)
-               (let ((requires (package-desc-reqs pkg-desc)))
-                 (list 'quote
-                       ;; Turn version lists into string form.
-                       (mapcar
-                        (lambda (elt)
-                          (list (car elt)
-                                (package-version-join (cadr elt))))
-                        requires)))))
-        "\n")
-       nil
-       pkg-file))))
-
+(defun package--alist-to-plist-args (alist)
+  (mapcar 'macroexp-quote
+          (apply #'nconc
+                 (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))))
 (defun package-unpack (pkg-desc)
   "Install the contents of the current buffer as a package."
   (let* ((name (package-desc-name pkg-desc))
          (dirname (package-desc-full-name pkg-desc))
-	 (pkg-dir (expand-file-name dirname package-user-dir)))
+         (pkg-dir (expand-file-name dirname package-user-dir)))
     (pcase (package-desc-kind pkg-desc)
+      (`dir
+       (make-directory pkg-dir t)
+       (let ((file-list
+              (directory-files
+               default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
+         (dolist (source-file file-list)
+           (let ((target-el-file
+                  (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
+             (copy-file source-file target-el-file t)))
+         ;; Now that the files have been installed, this package is
+         ;; indistinguishable from a `tar' or a `single'. Let's make
+         ;; things simple by ensuring we're one of them.
+         (setf (package-desc-kind pkg-desc)
+               (if (> (length file-list) 1) 'tar 'single))))
       (`tar
        (make-directory package-user-dir t)
        ;; FIXME: should we delete PKG-DIR if it exists?
@@ -679,23 +851,269 @@ untar into a directory named DIR; otherwise, signal an error."
     (package-activate name 'force)
     pkg-dir))
 
+(defun package-generate-description-file (pkg-desc pkg-file)
+  "Create the foo-pkg.el file for single-file packages."
+  (let* ((name (package-desc-name pkg-desc)))
+    (let ((print-level nil)
+          (print-quoted t)
+          (print-length nil))
+      (write-region
+       (concat
+        ";;; -*- no-byte-compile: t -*-\n"
+        (prin1-to-string
+         (nconc
+          (list 'define-package
+                (symbol-name name)
+                (package-version-join (package-desc-version pkg-desc))
+                (package-desc-summary pkg-desc)
+                (let ((requires (package-desc-reqs pkg-desc)))
+                  (list 'quote
+                        ;; Turn version lists into string form.
+                        (mapcar
+                         (lambda (elt)
+                           (list (car elt)
+                                 (package-version-join (cadr elt))))
+                         requires))))
+          (package--alist-to-plist-args
+           (package-desc-extras pkg-desc))))
+        "\n")
+       nil pkg-file nil 'silent))))
+
+;;;; Autoload
+;; From Emacs 22, but changed so it adds to load-path.
+(defun package-autoload-ensure-default-file (file)
+  "Make sure that the autoload file FILE exists and if not create it."
+  (unless (file-exists-p file)
+    (write-region
+     (concat ";;; " (file-name-nondirectory file)
+             " --- automatically extracted autoloads\n"
+             ";;\n"
+             ";;; Code:\n"
+             ;; `load-path' should contain only directory names
+             "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n"
+             "\n;; Local Variables:\n"
+             ";; version-control: never\n"
+             ";; no-byte-compile: t\n"
+             ";; no-update-autoloads: t\n"
+             ";; End:\n"
+             ";;; " (file-name-nondirectory file)
+             " ends here\n")
+     nil file nil 'silent))
+  file)
+
+(defvar generated-autoload-file)
+(defvar version-control)
+
+(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 inhibit-message)
+         (backup-inhibited t)
+         (version-control 'never))
+    (package-autoload-ensure-default-file generated-autoload-file)
+    (update-directory-autoloads pkg-dir)
+    (let ((buf (find-buffer-visiting generated-autoload-file)))
+      (when buf (kill-buffer buf)))
+    auto-name))
+
 (defun package--make-autoloads-and-stuff (pkg-desc pkg-dir)
   "Generate autoloads, description file, etc.. for PKG-DESC installed at PKG-DIR."
   (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir)
-  (let ((desc-file (package--description-file pkg-dir)))
+  (let ((desc-file (expand-file-name (package--description-file pkg-dir)
+                                     pkg-dir)))
     (unless (file-exists-p desc-file)
-      (package-generate-description-file pkg-desc pkg-dir)))
+      (package-generate-description-file pkg-desc desc-file)))
   ;; FIXME: Create foo.info and dir file from foo.texi?
   )
 
+;;;; 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)
+        (load-path load-path))
+    (package--activate-autoloads-and-load-path pkg-desc)
+    (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
+
+;;;; Inferring package from current buffer
+(defun package-read-from-string (str)
+  "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+  (let* ((read-data (read-from-string str))
+         (more-left
+          (condition-case nil
+              ;; The call to `ignore' suppresses a compiler warning.
+              (progn (ignore (read-from-string
+                              (substring str (cdr read-data))))
+                     t)
+            (end-of-file nil))))
+    (if more-left
+        (error "Can't read whole string")
+      (car read-data))))
+
+(defun package--prepare-dependencies (deps)
+  "Turn DEPS into an acceptable list of dependencies.
+
+Any parts missing a version string get a default version string
+of \"0\" (meaning any version) and an appropriate level of lists
+is wrapped around any parts requiring it."
+  (cond
+   ((not (listp deps))
+    (error "Invalid requirement specifier: %S" deps))
+   (t (mapcar (lambda (dep)
+                (cond
+                 ((symbolp dep) `(,dep "0"))
+                 ((stringp dep)
+                  (error "Invalid requirement specifier: %S" dep))
+                 ((and (listp dep) (null (cdr dep)))
+                  (list (car dep) "0"))
+                 (t dep)))
+              deps))))
+
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-homepage "lisp-mnt" (&optional file))
+(declare-function lm-maintainer "lisp-mnt" (&optional file))
+(declare-function lm-authors "lisp-mnt" (&optional file))
+
+(defun package-buffer-info ()
+  "Return a `package-desc' describing the package in the current buffer.
+
+If the buffer does not contain a conforming package, signal an
+error.  If there is a package, narrow the buffer to the file's
+boundaries."
+  (goto-char (point-min))
+  (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)))
+    (unless (search-forward (concat ";;; " file-name ".el ends here"))
+      (error "Package lacks a terminating comment"))
+    ;; Try to include a trailing newline.
+    (forward-line)
+    (narrow-to-region start (point))
+    (require 'lisp-mnt)
+    ;; Use some headers we've invented to drive the process.
+    (let* ((requires-str (lm-header "package-requires"))
+           ;; Prefer Package-Version; if defined, the package author
+           ;; probably wants us to use it.  Otherwise try Version.
+           (pkg-version
+            (or (package-strip-rcs-id (lm-header "package-version"))
+                (package-strip-rcs-id (lm-header "version"))))
+           (homepage (lm-homepage)))
+      (unless pkg-version
+        (error
+            "Package lacks a \"Version\" or \"Package-Version\" header"))
+      (package-desc-from-define
+       file-name pkg-version desc
+       (if requires-str
+           (package--prepare-dependencies
+            (package-read-from-string requires-str)))
+       :kind 'single
+       :url homepage
+       :maintainer (lm-maintainer)
+       :authors (lm-authors)))))
+
+(defun package--read-pkg-desc (kind)
+  "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))))
+
+(declare-function tar-get-file-descriptor "tar-mode" (file))
+(declare-function tar--extract "tar-mode" (descriptor))
+
+(defun package-tar-file-info ()
+  "Find package information for a tar file.
+The return result is a `package-desc'."
+  (cl-assert (derived-mode-p 'tar-mode))
+  (let* ((dir-name (file-name-directory
+                    (tar-header-name (car tar-parse-info))))
+         (desc-file (package--description-file dir-name))
+         (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
+    (unless tar-desc
+      (error "No package descriptor file found"))
+    (with-current-buffer (tar--extract tar-desc)
+      (unwind-protect
+          (or (package--read-pkg-desc 'tar)
+              (error "Can't find define-package in %s"
+                (tar-header-name tar-desc)))
+        (kill-buffer (current-buffer))))))
+
+(defun package-dir-info ()
+  "Find package information for a directory.
+The return result is a `package-desc'."
+  (cl-assert (derived-mode-p 'dired-mode))
+  (let* ((desc-file (package--description-file default-directory)))
+    (if (file-readable-p desc-file)
+        (with-temp-buffer
+          (insert-file-contents desc-file)
+          (package--read-pkg-desc 'dir))
+      (let ((files (directory-files default-directory t "\\.el\\'" t))
+            info)
+        (while files
+          (with-temp-buffer
+            (insert-file-contents (pop files))
+            ;; When we find the file with the data,
+            (when (setq info (ignore-errors (package-buffer-info)))
+              ;; stop looping,
+              (setq files nil)
+              ;; set the 'dir kind,
+              (setf (package-desc-kind info) 'dir))))
+        ;; and return the info.
+        info))))
 
+
+;;; Communicating with Archives
+;; Set of low-level functions for communicating with archives and
+;; signature checking.
 (defun package--write-file-no-coding (file-name)
   (let ((buffer-file-coding-system 'no-conversion))
-    (write-region (point-min) (point-max) file-name)))
+    (write-region (point-min) (point-max) file-name nil 'silent)))
+
+(declare-function url-http-file-exists-p "url-http" (url))
+
+(defun package--archive-file-exists-p (location file)
+  (let ((http (string-match "\\`https?:" location)))
+    (if http
+        (progn
+          (require 'url-http)
+          (url-http-file-exists-p (concat location file)))
+      (file-exists-p (expand-file-name file location)))))
+
+(declare-function epg-make-context "epg"
+                  (&optional protocol armor textmode include-certs
+                             cipher-algorithm
+                             digest-algorithm
+                             compress-algorithm))
+(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) t)
+(declare-function epg-signature-to-string "epg" (signature))
+
+(defun package--display-verify-error (context sig-file)
+  (unless (equal (epg-context-error-output context) "")
+    (with-output-to-temp-buffer "*Error*"
+      (with-current-buffer standard-output
+        (if (epg-context-result-for context 'verify)
+            (insert (format "Failed to verify signature %s:\n" sig-file)
+                    (mapconcat #'epg-signature-to-string
+                               (epg-context-result-for context 'verify)
+                               "\n"))
+          (insert (format "Error while verifying signature %s:\n" sig-file)))
+        (insert "\nCommand output:\n" (epg-context-error-output context))))))
 
 (defmacro package--with-work-buffer (location file &rest body)
   "Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -707,61 +1125,436 @@ This macro retrieves FILE from LOCATION into a temporary buffer,
 and evaluates BODY while that buffer is current.  This work
 buffer is killed afterwards.  Return the last value in BODY."
   (declare (indent 2) (debug t))
-  `(let* ((http (string-match "\\`https?:" ,location))
-	  (buffer
-	   (if http
-	       (url-retrieve-synchronously (concat ,location ,file))
-	     (generate-new-buffer "*package work buffer*"))))
-     (prog1
-	 (with-current-buffer buffer
-	   (if http
-	       (progn (package-handle-response)
-		      (re-search-forward "^$" nil 'move)
-		      (forward-char)
-		      (delete-region (point-min) (point)))
-	     (unless (file-name-absolute-p ,location)
-	       (error "Archive location %s is not an absolute file name"
-		      ,location))
-	     (insert-file-contents (expand-file-name ,file ,location)))
-	   ,@body)
-       (kill-buffer buffer))))
-
-(defun package-handle-response ()
-  "Handle the response from a `url-retrieve-synchronously' call.
-Parse the HTTP response and throw if an error occurred.
-The url package seems to require extra processing for this.
-This should be called in a `save-excursion', in the download buffer.
-It will move point to somewhere in the headers."
-  ;; We assume HTTP here.
-  (require 'url-http)
-  (let ((response (url-http-parse-response)))
-    (when (or (< response 200) (>= response 300))
-      (error "Error during download request:%s"
-	     (buffer-substring-no-properties (point) (line-end-position))))))
+  `(with-temp-buffer
+     (if (string-match-p "\\`https?:" ,location)
+         (url-insert-file-contents (concat ,location ,file))
+       (unless (file-name-absolute-p ,location)
+         (error "Archive location %s is not an absolute file name"
+           ,location))
+       (insert-file-contents (expand-file-name ,file ,location)))
+     ,@body))
+
+(defmacro package--with-work-buffer-async (location file async &rest body)
+  "Run BODY in a buffer containing the contents of FILE at LOCATION.
+If ASYNC is non-nil, and if it is possible, run BODY
+asynchronously.  If an error is encountered and ASYNC is a
+function, call it with no arguments (instead of executing BODY).
+If it returns non-nil, or if it wasn't a function, propagate the
+error.
+
+For a description of the other arguments see
+`package--with-work-buffer'."
+  (declare (indent 3) (debug t))
+  (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)
+       ;; This `condition-case' is to catch connection errors.
+       (condition-case error-signal
+           (url-retrieve (concat ,location-1 ,file-1)
+                         ;; This is to catch execution errors.
+                         (lambda (status)
+                           (condition-case error-signal
+                               (progn
+                                 (when-let ((er (plist-get status :error)))
+                                   (error "Error retrieving: %s %S" (concat ,location-1 ,file-1) er))
+                                 (goto-char (point-min))
+                                 (unless (search-forward "\n\n" nil 'noerror)
+                                   (error "Invalid url response in buffer %s"
+                                          (current-buffer)))
+                                 (delete-region (point-min) (point))
+                                 ,@body
+                                 (kill-buffer (current-buffer)))
+                             (error (when (if (functionp ,async-1) (funcall ,async-1) t)
+                                      (signal (car error-signal) (cdr error-signal))))))
+                         nil
+                         'silent)
+         (error (when (if (functionp ,async-1) (funcall ,async-1) t)
+                  (message "Error contacting: %s" (concat ,location-1 ,file-1))
+                  (signal (car error-signal) (cdr error-signal))))))))
+
+(defun package--check-signature-content (content string &optional sig-file)
+  "Check signature CONTENT against STRING.
+SIG-FILE is the name of the signature file, used when signaling
+errors."
+  (let* ((context (epg-make-context 'OpenPGP))
+         (homedir (expand-file-name "gnupg" package-user-dir)))
+    (setf (epg-context-home-directory context) homedir)
+    (condition-case error
+        (epg-verify-string context content string)
+      (error (package--display-verify-error context sig-file)
+        (signal (car error) (cdr error))))
+    (let (good-signatures had-fatal-error)
+      ;; The .sig file may contain multiple signatures.  Success if one
+      ;; of the signatures is good.
+      (dolist (sig (epg-context-result-for context 'verify))
+        (if (eq (epg-signature-status sig) 'good)
+            (push sig good-signatures)
+          ;; If package-check-signature is allow-unsigned, don't
+          ;; signal error when we can't verify signature because of
+          ;; missing public key.  Other errors are still treated as
+          ;; fatal (bug#17625).
+          (unless (and (eq package-check-signature 'allow-unsigned)
+                       (eq (epg-signature-status sig) 'no-pubkey))
+            (setq had-fatal-error t))))
+      (when (and (null good-signatures) had-fatal-error)
+        (package--display-verify-error context sig-file)
+        (error "Failed to verify signature %s" sig-file))
+      good-signatures)))
+
+(defun package--check-signature (location file &optional string async callback)
+  "Check signature of the current buffer.
+Download the signature file from LOCATION by appending \".sig\"
+to FILE.
+GnuPG keyring is located under \"gnupg\" in `package-user-dir'.
+STRING is the string to verify, it defaults to `buffer-string'.
+If ASYNC is non-nil, the download of the signature file is
+done asynchronously.
+
+If the signature is verified and CALLBACK was provided, CALLBACK
+is `funcall'ed with the list of good signatures as argument (the
+list can be empty).  If the signatures file is not found,
+CALLBACK is called with no arguments."
+  (let ((sig-file (concat file ".sig"))
+        (string (or string (buffer-string))))
+    (condition-case nil
+        (package--with-work-buffer-async
+            location sig-file (when async (or callback t))
+          (let ((sig (package--check-signature-content
+                      (buffer-string) string sig-file)))
+            (when callback (funcall callback sig))
+            sig))
+      (file-error (funcall callback)))))
 
-(defun package-install-from-archive (pkg-desc)
-  "Download and install a tar package."
-  (let ((location (package-archive-base pkg-desc))
-	(file (concat (package-desc-full-name pkg-desc)
-                      (package-desc-suffix pkg-desc))))
-    (package--with-work-buffer location file
-      (package-unpack pkg-desc))))
+
+;;; Packages on Archives
+;; The following variables store information about packages available
+;; from archives.  The most important of these is
+;; `package-archive-contents' which is initially populated by the
+;; function `package-read-all-archive-contents' from a cache on disk.
+;; The `package-initialize' command is also closely related to this
+;; section, but it has its own section.
+(defconst package-archive-version 1
+  "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+  "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to
+non-empty lists of `package-desc' structures.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defvar package--compatibility-table nil
+  "Hash table connecting package names to their compatibility.
+Each key is a symbol, the name of a package.
+
+The value is either nil, representing an incompatible package, or
+a version list, representing the highest compatible version of
+that package which is available.
+
+A package is considered incompatible if it requires an Emacs
+version higher than the one being used.  To check for package
+\(in)compatibility, don't read this table directly, use
+`package--incompatible-p' which also checks dependencies.")
+
+(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))
+
+(defun package--add-to-compatibility-table (pkg)
+  "If PKG is compatible (without dependencies), add to the compatibility table.
+PKG is a package-desc object.
+Only adds if its version is higher than what's already stored in
+the table."
+  (unless (package--incompatible-p pkg 'shallow)
+    (let* ((name (package-desc-name pkg))
+           (version (or (package-desc-version pkg) '(0)))
+           (table-version (gethash name package--compatibility-table)))
+      (when (or (not table-version)
+                (version-list-< table-version version))
+        (puthash name version package--compatibility-table)))))
+
+;; Package descriptor objects used inside the "archive-contents" file.
+;; Changing this defstruct implies changing the format of the
+;; "archive-contents" files.
+(cl-defstruct (package--ac-desc
+               (:constructor package-make-ac-desc (version reqs summary kind extras))
+               (:copier nil)
+               (:type vector))
+  version reqs summary kind extras)
+
+(defun package--append-to-alist (pkg-desc alist)
+  "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+  (let* ((name (package-desc-name pkg-desc))
+         (priority-version (package-desc-priority-version pkg-desc))
+         (existing-packages (assq name alist)))
+    (if (not existing-packages)
+        (cons (list name pkg-desc)
+              alist)
+      (while (if (and (cdr existing-packages)
+                      (version-list-< priority-version
+                                      (package-desc-priority-version
+                                       (cadr existing-packages))))
+                 (setq existing-packages (cdr existing-packages))
+               (push pkg-desc (cdr existing-packages))
+               nil))
+      alist)))
+
+(defun package--add-to-archive-contents (package archive)
+  "Add the PACKAGE from the given ARCHIVE if necessary.
+PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
+Also, add the originating archive to the `package-desc' structure."
+  (let* ((name (car package))
+         (version (package--ac-desc-version (cdr package)))
+         (pkg-desc
+          (package-desc-create
+           :name name
+           :version version
+           :reqs (package--ac-desc-reqs (cdr package))
+           :summary (package--ac-desc-summary (cdr package))
+           :kind (package--ac-desc-kind (cdr package))
+           :archive archive
+           :extras (and (> (length (cdr package)) 4)
+                        ;; Older archive-contents files have only 4
+                        ;; elements here.
+                        (package--ac-desc-extras (cdr package)))))
+         (pinned-to-archive (assoc name package-pinned-packages)))
+    ;; Skip entirely if pinned to another archive.
+    (when (not (and pinned-to-archive
+                    (not (equal (cdr pinned-to-archive) archive))))
+      (setq package-archive-contents
+            (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--read-archive-file (file)
+  "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+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
+        (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"
+                (car contents) package-archive-version))
+          (cdr contents))))))
+
+(defun package-read-archive-contents (archive)
+  "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+  ;; Version 1 of 'archive-contents' is identical to our internal
+  ;; representation.
+  (let* ((contents-file (format "archives/%s/archive-contents" archive))
+         (contents (package--read-archive-file contents-file)))
+    (when contents
+      (dolist (package contents)
+        (package--add-to-archive-contents package archive)))))
+
+(defvar package--old-archive-priorities nil
+  "Store currently used `package-archive-priorities'.
+This is the value of `package-archive-priorities' last time
+`package-read-all-archive-contents' was called.  It can be used
+by arbitrary functions to decide whether it is necessary to call
+it again.")
+
+(defun package-read-all-archive-contents ()
+  "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+  (setq package-archive-contents nil)
+  (setq package--old-archive-priorities package-archive-priorities)
+  (dolist (archive package-archives)
+    (package-read-archive-contents (car archive))))
 
+;;;; Package Initialize
+;; A bit of a milestone.  This brings together some of the above
+;; sections and populates all relevant lists of packages from contents
+;; available on disk.
 (defvar package--initialized nil)
 
-(defun package-installed-p (package &optional min-version)
-  "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
-MIN-VERSION should be a version list."
-  (unless package--initialized (error "package.el is not yet initialized!"))
-    (or
-     (let ((pkg-descs (cdr (assq package package-alist))))
-       (and pkg-descs
-            (version-list-<= min-version
-                             (package-desc-version (car pkg-descs)))))
-     ;; Also check built-in packages.
-     (package-built-in-p package min-version)))
+(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.
+The variable `package-load-list' controls which packages to load.
+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.
+If called as part of loading `user-init-file', set
+`package-enable-at-startup' to nil, to prevent accidentally
+loading packages twice."
+  (interactive)
+  (setq package-alist nil)
+  (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
+            ;; And likely we don't need to run it again after init.
+            package-enable-at-startup nil)
+    (package--ensure-init-file))
+  (package-load-all-descriptors)
+  (package-read-all-archive-contents)
+  (unless no-activate
+    (dolist (elt package-alist)
+      (package-activate (car elt))))
+  (setq package--initialized t)
+  ;; This uses `package--mapc' so it must be called after
+  ;; `package--initialized' is t.
+  (package--build-compatibility-table))
+
+
+;;;; Populating `package-archive-contents' from archives
+;; This subsection populates the variables listed above from the
+;; actual archives, instead of from a local cache.
+(defvar package--downloads-in-progress nil
+  "List of in-progress asynchronous downloads.")
+
+(declare-function epg-check-configuration "epg-config"
+                  (config &optional minimum-version))
+(declare-function epg-configuration "epg-config" ())
+(declare-function epg-import-keys-from-file "epg" (context keys))
+
+;;;###autoload
+(defun package-import-keyring (&optional file)
+  "Import keys from FILE."
+  (interactive "fFile: ")
+  (setq file (expand-file-name file))
+  (let ((context (epg-make-context 'OpenPGP))
+        (homedir (expand-file-name "gnupg" package-user-dir)))
+    (with-file-modes 448
+      (make-directory homedir t))
+    (setf (epg-context-home-directory context) homedir)
+    (message "Importing %s..." (file-name-nondirectory file))
+    (epg-import-keys-from-file context file)
+    (message "Importing %s...done" (file-name-nondirectory file))))
+
+(defvar package--post-download-archives-hook nil
+  "Hook run after the archive contents are downloaded.
+Don't run this hook directly.  It is meant to be run as part of
+`package--update-downloads-in-progress'.")
+(put 'package--post-download-archives-hook 'risky-local-variable t)
+
+(defun package--update-downloads-in-progress (entry)
+  "Remove ENTRY from `package--downloads-in-progress'.
+Once it's empty, run `package--post-download-archives-hook'."
+  ;; Keep track of the downloading progress.
+  (setq package--downloads-in-progress
+        (remove entry package--downloads-in-progress))
+  ;; If this was the last download, run the hook.
+  (unless package--downloads-in-progress
+    (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")
+    (run-hooks 'package--post-download-archives-hook)))
+
+(defun package--download-one-archive (archive file &optional async)
+  "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'.  Save the cached copy to
+\"archives/NAME/FILE\" in `package-user-dir'."
+  (package--with-work-buffer-async (cdr archive) file async
+    (let* ((location (cdr archive))
+           (name (car archive))
+           (content (buffer-string))
+           (dir (expand-file-name (format "archives/%s" name) package-user-dir))
+           (local-file (expand-file-name file dir)))
+      (when (listp (read-from-string content))
+        (make-directory dir t)
+        (if (or (not package-check-signature)
+                (member archive package-unsigned-archives))
+            ;; If we don't care about the signature, save the file and
+            ;; we're done.
+            (progn (write-region content nil local-file nil 'silent)
+                   (package--update-downloads-in-progress archive))
+          ;; 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)
+             ;; Write out good signatures into archive-contents.signed file.
+             (when good-sigs
+               (write-region (mapconcat #'epg-signature-to-string good-sigs "\n")
+                             nil (concat local-file ".signed") nil 'silent))
+             (package--update-downloads-in-progress archive)
+             ;; If we got this far, either everything worked or we don't mind
+             ;; not signing, so tell `package--with-work-buffer-async' to not
+             ;; propagate errors.
+             nil)))))))
+
+(defun package--download-and-read-archives (&optional async)
+  "Download descriptions of all `package-archives' and read them.
+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'.
+  (dolist (archive package-archives)
+    (cl-pushnew archive package--downloads-in-progress
+                :test #'equal))
+  (dolist (archive package-archives)
+    (condition-case-unless-debug nil
+        (package--download-one-archive
+         archive "archive-contents"
+         ;; Called if the async download fails
+         (when async
+           ;; The t at the end means to propagate connection errors.
+           (lambda () (package--update-downloads-in-progress archive) t)))
+      (error (message "Failed to download `%s' archive."
+               (car archive))))))
+
+;;;###autoload
+(defun package-refresh-contents (&optional async)
+  "Download descriptions of all configured ELPA packages.
+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)
+  (unless (file-exists-p package-user-dir)
+    (make-directory package-user-dir t))
+  (let ((default-keyring (expand-file-name "package-keyring.gpg"
+                                           data-directory))
+        (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))
 
-(defun package-compute-transaction (packages requirements)
+
+;;; Dependency Management
+;; Calculating the full transaction necessary for an installation,
+;; keeping track of which packages were installed strictly as
+;; dependencies, and determining which packages cannot be removed
+;; because they are dependencies.
+(defun package-compute-transaction (packages requirements &optional seen)
   "Return a list of packages to be installed, including PACKAGES.
 PACKAGES should be a list of `package-desc'.
 
@@ -773,7 +1566,9 @@ version of that package.
 This function recursively computes the requirements of the
 packages in REQUIREMENTS, and returns a list of all the packages
 that must be installed.  Packages that are already installed are
-not included in this list."
+not included in this list.
+
+SEEN is used internally to detect infinite recursion."
   ;; FIXME: We really should use backtracking to explore the whole
   ;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1
   ;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0:
@@ -781,27 +1576,35 @@ not included in this list."
   ;; older bar-1.3).
   (dolist (elt requirements)
     (let* ((next-pkg (car elt))
-	   (next-version (cadr elt))
+           (next-version (cadr elt))
            (already ()))
       (dolist (pkg packages)
         (if (eq next-pkg (package-desc-name pkg))
             (setq already pkg)))
-      (cond
-       (already
-        (if (version-list-< next-version (package-desc-version already))
-            ;; Move to front, so it gets installed early enough (bug#14082).
-            (setq packages (cons already (delq already packages)))
-          (error "Need package `%s-%s', but only %s is available"
+      (when already
+        (if (version-list-<= next-version (package-desc-version already))
+            ;; `next-pkg' is already in `packages', but its position there
+            ;; means it might be installed too late: remove it from there, so
+            ;; 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-desc-full-name already))
+              (setq packages (delq already packages))
+              (setq already nil))
+          (error "Need package `%s-%s', but only %s is being installed"
                  next-pkg (package-version-join next-version)
                  (package-version-join (package-desc-version already)))))
-
+      (cond
+       (already nil)
        ((package-installed-p next-pkg next-version) nil)
 
        (t
-	;; A package is required, but not installed.  It might also be
-	;; blocked via `package-load-list'.
-	(let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
+        ;; A package is required, but not installed.  It might also be
+        ;; blocked via `package-load-list'.
+        (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
               (found nil)
+              (found-something nil)
               (problem nil))
           (while (and pkg-descs (not found))
             (let* ((pkg-desc (pop pkg-descs))
@@ -809,124 +1612,228 @@ not included in this list."
                    (disabled (package-disabled-p next-pkg version)))
               (cond
                ((version-list-< version next-version)
-                (error
-                 "Need package `%s-%s', but only %s is available"
-                 next-pkg (package-version-join next-version)
-                 (package-version-join version)))
+                ;; pkg-descs is sorted by priority, not version, so
+                ;; don't error just yet.
+                (unless found-something
+                  (setq found-something (package-version-join version))))
                (disabled
                 (unless problem
                   (setq problem
                         (if (stringp disabled)
-                            (format "Package `%s' held at version %s, \
-but version %s required"
-                                    next-pkg disabled
-                                    (package-version-join next-version))
-                          (format "Required package '%s' is disabled"
-                                  next-pkg)))))
+                            (format-message
+                             "Package `%s' held at version %s, but version %s required"
+                             next-pkg disabled
+                             (package-version-join next-version))
+                          (format-message "Required package `%s' is disabled"
+                                          next-pkg)))))
                (t (setq found pkg-desc)))))
-	  (unless found
-            (if problem
-                (error problem)
-              (error "Package `%s-%s' is unavailable"
-                     next-pkg (package-version-join next-version))))
-	  (setq packages
-		(package-compute-transaction (cons found packages)
-					     (package-desc-reqs found))))))))
+          (unless found
+            (cond
+             (problem (error "%s" problem))
+             (found-something
+              (error "Need package `%s-%s', but only %s is available"
+                     next-pkg (package-version-join next-version)
+                     found-something))
+             (t (error "Package `%s-%s' is unavailable"
+                       next-pkg (package-version-join next-version)))))
+          (setq packages
+                (package-compute-transaction (cons found packages)
+                                             (package-desc-reqs found)
+                                             (cons found seen))))))))
   packages)
 
-(defun package-read-from-string (str)
-  "Read a Lisp expression from STR.
-Signal an error if the entire string was not used."
-  (let* ((read-data (read-from-string str))
-	 (more-left
-	  (condition-case nil
-	      ;; The call to `ignore' suppresses a compiler warning.
-	      (progn (ignore (read-from-string
-			      (substring str (cdr read-data))))
-		     t)
-	    (end-of-file nil))))
-    (if more-left
-        (error "Can't read whole string")
-      (car read-data))))
-
-(defun package--read-archive-file (file)
-  "Re-read archive file FILE, if it exists.
-Will return the data from the file, or nil if the file does not exist.
-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 ((contents (read (current-buffer))))
-	  (if (> (car contents) package-archive-version)
-	      (error "Package archive version %d is higher than %d"
-		     (car contents) package-archive-version))
-	  (cdr contents))))))
+(defun package--find-non-dependencies ()
+  "Return a list of installed packages which are not dependencies.
+Finds all packages in `package-alist' which are not dependencies
+of any other packages.
+Used to populate `package-selected-packages'."
+  (let ((dep-list
+         (delete-dups
+          (apply #'append
+            (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p))))
+                    package-alist)))))
+    (cl-loop for p in package-alist
+             for name = (car p)
+             unless (memq name dep-list)
+             collect name)))
+
+(defun package--save-selected-packages (&optional value)
+  "Set and save `package-selected-packages' to VALUE."
+  (when value
+    (setq package-selected-packages value))
+  (if after-init-time
+      (let ((save-silently inhibit-message))
+        (customize-save-variable 'package-selected-packages package-selected-packages))
+    (add-hook 'after-init-hook #'package--save-selected-packages)))
+
+(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)
+    (package--save-selected-packages (package--find-non-dependencies)))
+  (memq pkg package-selected-packages))
+
+(defun package--get-deps (pkg &optional only)
+  (let* ((pkg-desc (cadr (assq pkg package-alist)))
+         (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+                               for name = (car p)
+                               when (assq name package-alist)
+                               collect name))
+         (indirect-deps (unless (eq only 'direct)
+                          (delete-dups
+                           (cl-loop for p in direct-deps
+                                    append (package--get-deps p))))))
+    (cl-case only
+      (direct   direct-deps)
+      (separate (list direct-deps indirect-deps))
+      (indirect indirect-deps)
+      (t        (delete-dups (append direct-deps indirect-deps))))))
+
+(defun package--removable-packages ()
+  "Return a list of names of packages no longer needed.
+These are packages which are neither contained in
+`package-selected-packages' nor a dependency of one that is."
+  (let ((needed (cl-loop for p in package-selected-packages
+                         if (assq p package-alist)
+                         ;; `p' and its dependencies are needed.
+                         append (cons p (package--get-deps p)))))
+    (cl-loop for p in (mapcar #'car package-alist)
+             unless (memq p needed)
+             collect p)))
+
+(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.  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))
+           (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.
+PACKAGE is included as the first element of the returned list.
+ONLY is an alist associating package names to package objects.
+Only these packages will be in the return value an their cdrs are
+destructively set to nil in ONLY."
+  (let ((out))
+    (dolist (dep (package-desc-reqs package))
+      (when-let ((cell (assq (car dep) only))
+                 (dep-package (cdr-safe cell)))
+        (setcdr cell nil)
+        (setq out (append (package--sort-deps-in-alist dep-package only)
+                          out))))
+    (cons package out)))
+
+(defun package--sort-by-dependence (package-list)
+  "Return PACKAGE-LIST sorted by dependence.
+That is, any element of the returned list is guaranteed to not
+directly depend on any elements that come before it.
+
+PACKAGE-LIST is a list of package-desc objects.
+Indirect dependencies are guaranteed to be returned in order only
+if all the in-between dependencies are also in PACKAGE-LIST."
+  (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list))
+        out-list)
+    (dolist (cell alist out-list)
+      ;; `package--sort-deps-in-alist' destructively changes alist, so
+      ;; some cells might already be empty.  We check this here.
+      (when-let ((pkg-desc (cdr cell)))
+        (setcdr cell nil)
+        (setq out-list
+              (append (package--sort-deps-in-alist pkg-desc alist)
+                      out-list))))))
 
-(defun package-read-all-archive-contents ()
-  "Re-read `archive-contents', if it exists.
-If successful, set `package-archive-contents'."
-  (setq package-archive-contents nil)
-  (dolist (archive package-archives)
-    (package-read-archive-contents (car archive))))
+
+;;; Installation Functions
+;; As opposed to the previous section (which listed some underlying
+;; functions necessary for installation), this one contains the actual
+;; functions that install packages.  The package itself can be
+;; installed in a variety of ways (archives, buffer, file), but
+;; requirements (dependencies) are always satisfied by looking in
+;; `package-archive-contents'.
+(defun package-archive-base (desc)
+  "Return the archive containing the package NAME."
+  (cdr (assoc (package-desc-archive desc) package-archives)))
 
-(defun package-read-archive-contents (archive)
-  "Re-read archive contents for ARCHIVE.
-If successful, set the variable `package-archive-contents'.
-If the archive version is too new, signal an error."
-  ;; Version 1 of 'archive-contents' is identical to our internal
-  ;; representation.
-  (let* ((contents-file (format "archives/%s/archive-contents" archive))
-	 (contents (package--read-archive-file contents-file)))
-    (when contents
-      (dolist (package contents)
-	(package--add-to-archive-contents package archive)))))
+(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 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.
+          (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 nil
+           ;; 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 t))
+                                 (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))))))))))
 
-;; Package descriptor objects used inside the "archive-contents" file.
-;; Changing this defstruct implies changing the format of the
-;; "archive-contents" files.
-(cl-defstruct (package--ac-desc
-               (:constructor package-make-ac-desc (version reqs summary kind))
-               (:copier nil)
-               (:type vector))
-  version reqs summary kind)
+(defun package-installed-p (package &optional min-version)
+  "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+If PACKAGE is a symbol, it is the package name and MIN-VERSION
+should be a version list.
 
-(defun package--add-to-archive-contents (package archive)
-  "Add the PACKAGE from the given ARCHIVE if necessary.
-PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
-Also, add the originating archive to the `package-desc' structure."
-  (let* ((name (car package))
-         (version (package--ac-desc-version (cdr package)))
-         (pkg-desc
-          (package-desc-create
-           :name name
-           :version version
-           :reqs (package--ac-desc-reqs (cdr package))
-           :summary (package--ac-desc-summary (cdr package))
-           :kind (package--ac-desc-kind (cdr package))
-           :archive archive))
-         (existing-packages (assq name package-archive-contents))
-         (pinned-to-archive (assoc name package-pinned-packages)))
-    (cond
-     ;; Skip entirely if pinned to another archive or already installed.
-     ((or (and pinned-to-archive
-               (not (equal (cdr pinned-to-archive) archive)))
-          (let ((bi (assq name package--builtin-versions)))
-            (and bi (version-list-= version (cdr bi))))
-          (let ((ins (cdr (assq name package-alist))))
-            (and ins (version-list-= version
-                                     (package-desc-version (car ins))))))
-      nil)
-     ((not existing-packages)
-      (push (list name pkg-desc) package-archive-contents))
-     (t
-      (while
-          (if (and (cdr existing-packages)
-                   (version-list-<
-                    version (package-desc-version (cadr existing-packages))))
-              (setq existing-packages (cdr existing-packages))
-            (push pkg-desc (cdr existing-packages))
-            nil))))))
+If PACKAGE is a package-desc object, MIN-VERSION is ignored."
+  (unless package--initialized (error "package.el is not yet initialized!"))
+  (if (package-desc-p package)
+      (let ((dir (package-desc-dir package)))
+        (and (stringp dir)
+             (file-exists-p dir)))
+    (or
+     (let ((pkg-descs (cdr (assq package package-alist))))
+       (and pkg-descs
+            (version-list-<= min-version
+                             (package-desc-version (car pkg-descs)))))
+     ;; Also check built-in packages.
+     (package-built-in-p package min-version))))
 
 (defun package-download-transaction (packages)
   "Download and install all the packages in PACKAGES.
@@ -936,11 +1843,67 @@ PACKAGES are satisfied, i.e. that PACKAGES is computed
 using `package-compute-transaction'."
   (mapc #'package-install-from-archive packages))
 
+(defun package--ensure-init-file ()
+  "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 (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
+                (with-current-buffer buffer
+                  (save-excursion
+                    (save-restriction
+                      (widen)
+                      (goto-char (point-min))
+                      (re-search-forward "(package-initialize\\_>" nil 'noerror))))
+              ;; Don't visit the file if we don't have to.
+              (with-temp-buffer
+                (insert-file-contents user-init-file)
+                (goto-char (point-min))
+                (re-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))
+              (while (and (looking-at-p "[[:blank:]]*\\(;\\|$\\)")
+                          (not (eobp)))
+                (forward-line 1))
+              (insert
+               "\n"
+               ";; 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)))))))))
+  (setq package--init-file-ensured t))
+
 ;;;###autoload
-(defun package-install (pkg)
+(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."
+PKG can be a package-desc or a symbol naming one of 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 PKG is a package-desc and it is already installed, don't try
+to install it but still mark it as selected."
   (interactive
    (progn
      ;; Initialize the package system to get the list of package
@@ -951,15 +1914,28 @@ in an archive in `package-archives'.  Interactively, prompt for its name."
        (package-refresh-contents))
      (list (intern (completing-read
                     "Install package: "
-                    (mapcar (lambda (elt) (symbol-name (car elt)))
-                            package-archive-contents)
-                    nil t)))))
-  (package-download-transaction
-   (if (package-desc-p pkg)
-       (package-compute-transaction (list pkg)
-                                    (package-desc-reqs pkg))
-     (package-compute-transaction ()
-                                  (list (list pkg))))))
+                    (delq nil
+                          (mapcar (lambda (elt)
+                                    (unless (package-installed-p (car elt))
+                                      (symbol-name (car elt))))
+                                  package-archive-contents))
+                    nil t))
+           nil)))
+  (add-hook 'post-command-hook #'package-menu--post-refresh)
+  (let ((name (if (package-desc-p pkg)
+                  (package-desc-name pkg)
+                pkg)))
+    (unless (or dont-select (package--user-selected-p name))
+      (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)
+      (message "`%s' is already installed" name))))
 
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
@@ -968,163 +1944,199 @@ Otherwise return nil."
   (when str
     (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
       (setq str (substring str (match-end 0))))
-    (condition-case nil
-	(if (version-to-list str)
-	    str)
-      (error nil))))
-
-(defun package-buffer-info ()
-  "Return a `package-desc' describing the package in the current buffer.
-
-If the buffer does not contain a conforming package, signal an
-error.  If there is a package, narrow the buffer to the file's
-boundaries."
-  (goto-char (point-min))
-  (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
-    (error "Packages lacks a file header"))
-  (let ((file-name (match-string-no-properties 1))
-	(desc      (match-string-no-properties 2))
-	(start     (line-beginning-position)))
-    (unless (search-forward (concat ";;; " file-name ".el ends here"))
-      (error "Package lacks a terminating comment"))
-    ;; Try to include a trailing newline.
-    (forward-line)
-    (narrow-to-region start (point))
-    (require 'lisp-mnt)
-    ;; Use some headers we've invented to drive the process.
-    (let* ((requires-str (lm-header "package-requires"))
-	   ;; Prefer Package-Version; if defined, the package author
-	   ;; probably wants us to use it.  Otherwise try Version.
-	   (pkg-version
-	    (or (package-strip-rcs-id (lm-header "package-version"))
-		(package-strip-rcs-id (lm-header "version")))))
-      (unless pkg-version
-	(error
-	 "Package lacks a \"Version\" or \"Package-Version\" header"))
-      (package-desc-from-define
-       file-name pkg-version desc
-       (if requires-str (package-read-from-string requires-str))
-       :kind 'single))))
-
-(declare-function tar-get-file-descriptor "tar-mode" (file))
-(declare-function tar--extract "tar-mode" (descriptor))
-
-(defun package-tar-file-info ()
-  "Find package information for a tar file.
-The return result is a `package-desc'."
-  (cl-assert (derived-mode-p 'tar-mode))
-  (let* ((dir-name (file-name-directory
-                    (tar-header-name (car tar-parse-info))))
-         (desc-file (package--description-file dir-name))
-         (tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
-    (unless tar-desc
-      (error "No package descriptor file found"))
-    (with-current-buffer (tar--extract tar-desc)
-      (goto-char (point-min))
-      (unwind-protect
-          (let* ((pkg-def-parsed (read (current-buffer)))
-                 (pkg-desc
-                  (if (not (eq (car pkg-def-parsed) 'define-package))
-                      (error "Can't find define-package in %s"
-                             (tar-header-name tar-desc))
-                    (apply #'package-desc-from-define
-                           (append (cdr pkg-def-parsed))))))
-            (setf (package-desc-kind pkg-desc) 'tar)
-            pkg-desc)
-        (kill-buffer (current-buffer))))))
+    (ignore-errors
+      (if (version-to-list str) str))))
 
+(declare-function lm-homepage "lisp-mnt" (&optional file))
 
 ;;;###autoload
 (defun package-install-from-buffer ()
   "Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file that follows the
-packaging guidelines; see info node `(elisp)Packaging'.
+The current buffer is assumed to be a single .el or .tar file or
+a directory.  These must follow the packaging guidelines (see
+info node `(elisp)Packaging').
+
+Specially, if current buffer is a directory, the -pkg.el
+description file is not mandatory, in which case the information
+is derived from the main .el file in the directory.
+
 Downloads and installs required packages as needed."
   (interactive)
-  (let ((pkg-desc (if (derived-mode-p 'tar-mode)
-                      (package-tar-file-info)
-                    (package-buffer-info))))
+  (let* ((pkg-desc
+          (cond
+            ((derived-mode-p 'dired-mode)
+             ;; This is the only way a package-desc object with a `dir'
+             ;; desc-kind can be created.  Such packages can't be
+             ;; uploaded or installed from archives, they can only be
+             ;; installed from local buffers or directories.
+             (package-dir-info))
+            ((derived-mode-p 'tar-mode)
+             (package-tar-file-info))
+            (t
+             (package-buffer-info))))
+         (name (package-desc-name pkg-desc)))
     ;; Download and install the dependencies.
     (let* ((requires (package-desc-reqs pkg-desc))
            (transaction (package-compute-transaction nil requires)))
       (package-download-transaction transaction))
     ;; Install the package itself.
     (package-unpack pkg-desc)
+    (unless (package--user-selected-p name)
+      (package--save-selected-packages
+       (cons name package-selected-packages)))
     pkg-desc))
 
 ;;;###autoload
 (defun package-install-file (file)
   "Install a package from a file.
-The file can either be a tar file or an Emacs Lisp file."
+The file can either be a tar file, an Emacs Lisp file, or a
+directory."
   (interactive "fPackage file name: ")
   (with-temp-buffer
-    (insert-file-contents-literally file)
-    (when (string-match "\\.tar\\'" file) (tar-mode))
+    (if (file-directory-p file)
+        (progn
+          (setq default-directory file)
+          (dired-mode))
+      (insert-file-contents-literally file)
+      (when (string-match "\\.tar\\'" file) (tar-mode)))
     (package-install-from-buffer)))
 
-(defun package-delete (pkg-desc)
-  (let ((dir (package-desc-dir pkg-desc)))
-    (if (not (string-prefix-p (file-name-as-directory
-                               (expand-file-name package-user-dir))
-                              (expand-file-name dir)))
-        ;; Don't delete "system" packages.
-	(error "Package `%s' is a system package, not deleting"
-               (package-desc-full-name pkg-desc))
-      (delete-directory dir t t)
-      ;; Update package-alist.
-      (let* ((name (package-desc-name pkg-desc)))
-        (delete pkg-desc (assq name package-alist)))
-      (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
-
-(defun package-archive-base (desc)
-  "Return the archive containing the package NAME."
-  (cdr (assoc (package-desc-archive desc) package-archives)))
+;;;###autoload
+(defun package-install-selected-packages ()
+  "Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them."
+  (interactive)
+  ;; We don't need to populate `package-selected-packages' before
+  ;; using here, because the outcome is the same either way (nothing
+  ;; gets installed).
+  (if (not package-selected-packages)
+      (message "`package-selected-packages' is empty, nothing to install")
+    (cl-loop for p in package-selected-packages
+             unless (package-installed-p p)
+             collect p into lst
+             finally
+             (if lst
+                 (when (y-or-n-p
+                        (format "%s packages will be installed:\n%s, proceed?"
+                          (length lst)
+                          (mapconcat #'symbol-name lst ", ")))
+                   (mapc #'package-install lst))
+               (message "All your packages are already installed")))))
 
-(defun package--download-one-archive (archive file)
-  "Retrieve an archive file FILE from ARCHIVE, and cache it.
-ARCHIVE should be a cons cell of the form (NAME . LOCATION),
-similar to an entry in `package-alist'.  Save the cached copy to
-\"archives/NAME/archive-contents\" in `package-user-dir'."
-  (let* ((dir (expand-file-name (format "archives/%s" (car archive))
-                                package-user-dir)))
-    (package--with-work-buffer (cdr archive) file
-      ;; Read the retrieved buffer to make sure it is valid (e.g. it
-      ;; may fetch a URL redirect page).
-      (when (listp (read buffer))
-	(make-directory dir t)
-	(setq buffer-file-name (expand-file-name file dir))
-	(let ((version-control 'never))
-	  (save-buffer))))))
+
+;;; Package Deletion
+(defun package--newest-p (pkg)
+  "Return t if PKG is the newest package with its name."
+  (equal (cadr (assq (package-desc-name pkg) package-alist))
+         pkg))
+
+(defun package-delete (pkg-desc &optional force nosave)
+  "Delete package PKG-DESC.
+
+Argument PKG-DESC is a full description of package as vector.
+Interactively, prompt the user for the package name and version.
+
+When package is used elsewhere as dependency of another package,
+refuse deleting it and return an error.
+If prefix argument FORCE is non-nil, package will be deleted even
+if it is used elsewhere.
+If NOSAVE is non-nil, the package is not removed from
+`package-selected-packages'."
+  (interactive
+   (progn
+     ;; Initialize the package system to get the list of package
+     ;; symbols for completion.
+     (unless package--initialized
+       (package-initialize t))
+     (let* ((package-table
+             (mapcar
+              (lambda (p) (cons (package-desc-full-name p) p))
+              (delq nil
+                    (mapcar (lambda (p) (unless (package-built-in-p p) p))
+                            (apply #'append (mapcar #'cdr package-alist))))))
+            (package-name (completing-read "Delete package: "
+                                           (mapcar #'car package-table)
+                                           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))
+        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
+    ;; `package-selected-packages' even if it can't be deleted.
+    (when (and (null nosave)
+               (package--user-selected-p name)
+               ;; Don't deselect if this is an older version of an
+               ;; upgraded package.
+               (package--newest-p pkg-desc))
+      (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)))
+           ;; Don't delete "system" packages.
+           (error "Package `%s' is a system package, not deleting"
+                  (package-desc-full-name pkg-desc)))
+          ((and (null force)
+                (setq pkg-used-elsewhere-by
+                      (package--used-elsewhere-p pkg-desc)))
+           ;; 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)
+                  (package-desc-name pkg-used-elsewhere-by)))
+          (t
+           (add-hook 'post-command-hook #'package-menu--post-refresh)
+           (delete-directory dir t t)
+           ;; Remove NAME-VERSION.signed file.
+           (let ((signed-file (concat dir ".signed")))
+             (if (file-exists-p signed-file)
+                 (delete-file signed-file)))
+           ;; Update package-alist.
+           (let ((pkgs (assq name package-alist)))
+             (delete pkg-desc pkgs)
+             (unless (cdr pkgs)
+               (setq package-alist (delq pkgs package-alist))))
+           (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
 
 ;;;###autoload
-(defun package-refresh-contents ()
-  "Download the ELPA archive description if needed.
-This informs Emacs about the latest versions of all packages, and
-makes them available for download."
-  (interactive)
-  ;; FIXME: Do it asynchronously.
-  (unless (file-exists-p package-user-dir)
-    (make-directory package-user-dir t))
-  (dolist (archive package-archives)
-    (condition-case-unless-debug nil
-	(package--download-one-archive archive "archive-contents")
-      (error (message "Failed to download `%s' archive."
-		      (car archive)))))
-  (package-read-all-archive-contents))
+(defun package-reinstall (pkg)
+  "Reinstall package PKG.
+PKG should be either a symbol, the package name, or a package-desc
+object."
+  (interactive (list (intern (completing-read
+                              "Reinstall package: "
+                              (mapcar #'symbol-name
+                                      (mapcar #'car package-alist))))))
+  (package-delete
+   (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist)))
+   'force 'nosave)
+  (package-install pkg 'dont-select))
 
 ;;;###autoload
-(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."
+(defun package-autoremove ()
+  "Remove packages that are no more needed.
+
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted."
   (interactive)
-  (setq package-alist nil)
-  (package-load-all-descriptors)
-  (package-read-all-archive-contents)
-  (unless no-activate
-    (dolist (elt package-alist)
-      (package-activate (car elt))))
-  (setq package--initialized t))
+  ;; 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
+            (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 "%s packages will be deleted:\n%s, proceed? "
+                   (length removable)
+                   (mapconcat #'symbol-name removable ", ")))
+            (mapc (lambda (p)
+                    (package-delete (cadr (assq p package-alist)) t))
+                  removable))
+        (message "Nothing to autoremove")))))
 
 
 ;;;; Package description buffer.
@@ -1133,7 +2145,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
 (defun describe-package (package)
   "Display the full documentation of PACKAGE (a symbol)."
   (interactive
-   (let* ((guess (function-called-at-point)))
+   (let* ((guess (or (function-called-at-point)
+                     (symbol-at-point))))
      (require 'finder-inf nil t)
      ;; Load the package list if necessary (but don't activate them).
      (unless package--initialized
@@ -1149,15 +2162,34 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
                                    (format "Describe package (default %s): "
                                            guess)
                                  "Describe package: ")
-                               packages nil t nil nil guess)))
+                               packages nil t nil nil (when guess
+                                                        (symbol-name guess)))))
          (list (intern val))))))
   (if (not (or (package-desc-p package) (and package (symbolp package))))
       (message "No package specified")
     (help-setup-xref (list #'describe-package package)
-		     (called-interactively-p 'interactive))
+                     (called-interactively-p 'interactive))
     (with-help-window (help-buffer)
       (with-current-buffer standard-output
-	(describe-package-1 package)))))
+        (describe-package-1 package)))))
+
+(defface package-help-section-name
+  '((t :inherit (bold font-lock-function-name-face)))
+  "Face used on section names in package description buffers."
+  :version "25.1")
+
+(defun package--print-help-section (name &rest strings)
+  "Print \"NAME: \", right aligned to the 13th column.
+If more STRINGS are provided, insert them followed by a newline.
+Otherwise no newline is inserted."
+  (declare (indent 1))
+  (insert (make-string (max 0 (- 11 (string-width name))) ?\s)
+          (propertize (concat name ": ") 'font-lock-face 'package-help-section-name))
+  (when strings
+    (apply #'insert strings)
+    (insert "\n")))
+
+(declare-function lm-commentary "lisp-mnt" (&optional file))
 
 (defun describe-package-1 (pkg)
   (require 'lisp-mnt)
@@ -1171,151 +2203,231 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
          (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)))
+         (homepage (cdr (assoc :url extras)))
+         (keywords (if desc (package-desc--keywords desc)))
          (built-in (eq pkg-dir 'builtin))
          (installable (and archive (not built-in)))
-         (status (if desc (package-desc-status desc) "orphan")))
+         (status (if desc (package-desc-status desc) "orphan"))
+         (incompatible-reason (package--incompatible-p desc))
+         (signed (if desc (package-desc-signed desc))))
+    (when (string= status "avail-obso")
+      (setq status "available obsolete"))
+    (when incompatible-reason
+      (setq status "incompatible"))
     (prin1 name)
     (princ " is ")
     (princ (if (memq (aref status 0) '(?a ?e ?i ?o ?u)) "an " "a "))
     (princ status)
     (princ " package.\n\n")
 
-    (insert "     " (propertize "Status" 'font-lock-face 'bold) ": ")
+    (package--print-help-section "Status")
     (cond (built-in
-	   (insert (propertize (capitalize status)
-                               'font-lock-face 'font-lock-builtin-face)
+           (insert (propertize (capitalize status)
+                               'font-lock-face 'package-status-builtin-face)
                    "."))
-	  (pkg-dir
-	   (insert (propertize (capitalize status) ;FIXME: Why comment-face?
-			       'font-lock-face 'font-lock-comment-face))
-	   (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)
+          (pkg-dir
+           (insert (propertize (if (member status '("unsigned" "dependency"))
+                                   "Installed"
+                                 (capitalize status))
+                               'font-lock-face 'package-status-builtin-face))
+           (insert (substitute-command-keys " in `"))
+           (let ((dir (abbreviate-file-name
+                       (file-name-as-directory
+                        (if (file-in-directory-p pkg-dir package-user-dir)
+                            (file-relative-name pkg-dir package-user-dir)
+                          pkg-dir)))))
+             (help-insert-xref-button dir 'help-package-def pkg-dir))
+           (if (and (package-built-in-p name)
                     (not (package-built-in-p name version)))
-	       (insert "',\n             shadowing a "
-		       (propertize "built-in package"
-				   'font-lock-face 'font-lock-builtin-face)
-		       ".")
-	     (insert "'.")))
-	  (installable
+               (insert (substitute-command-keys
+                        "',\n             shadowing a ")
+                       (propertize "built-in package"
+                                   'font-lock-face 'package-status-builtin-face))
+             (insert (substitute-command-keys "'")))
+           (if signed
+               (insert ".")
+             (insert " (unsigned)."))
+           (when (and (package-desc-p desc)
+                      (not required-by)
+                      (member status '("unsigned" "installed")))
+             (insert " ")
+             (package-make-button "Delete"
+                                  'action #'package-delete-button-action
+                                  'package-desc desc)))
+          (incompatible-reason
+           (insert (propertize "Incompatible" 'font-lock-face font-lock-warning-face)
+                   " because it depends on ")
+           (if (stringp incompatible-reason)
+               (insert "Emacs " incompatible-reason ".")
+             (insert "uninstallable packages.")))
+          (installable
            (insert (capitalize status))
-	   (insert " from " (format "%s" archive))
-	   (insert " -- ")
-	   (let ((button-text (if (display-graphic-p) "Install" "[Install]"))
-		 (button-face (if (display-graphic-p)
-				  '(:box (:line-width 2 :color "dark grey")
-					 :background "light grey"
-					 :foreground "black")
-				'link)))
-	     (insert-text-button button-text 'face button-face 'follow-link t
-				 'package-desc desc
-				 'action 'package-install-button-action)))
-	  (t (insert (capitalize status) ".")))
+           (insert " from " (format "%s" archive))
+           (insert " -- ")
+           (package-make-button
+            "Install"
+            'action 'package-install-button-action
+            'package-desc desc))
+          (t (insert (capitalize status) ".")))
     (insert "\n")
+    (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive.
+      (package--print-help-section "Archive"
+        (or archive "n/a") "\n"))
     (and version
-	 (insert "    "
-		 (propertize "Version" 'font-lock-face 'bold) ": "
-                 (package-version-join version) "\n"))
+         (package--print-help-section "Version"
+           (package-version-join version)))
+    (when desc
+      (package--print-help-section "Summary"
+        (package-desc-summary desc)))
 
     (setq reqs (if desc (package-desc-reqs desc)))
     (when reqs
-      (insert "   " (propertize "Requires" 'font-lock-face 'bold) ": ")
-      (let ((first t)
-	    name vers text)
-	(dolist (req reqs)
-	  (setq name (car req)
-		vers (cadr req)
-		text (format "%s-%s" (symbol-name name)
-			     (package-version-join vers)))
-	  (cond (first (setq first nil))
-		((>= (+ 2 (current-column) (length text))
-		     (window-width))
-		 (insert ",\n               "))
-		(t (insert ", ")))
-	  (help-insert-xref-button text 'help-package name))
-	(insert "\n")))
-    (insert "    " (propertize "Summary" 'font-lock-face 'bold)
-	    ": " (if desc (package-desc-summary desc)) "\n")
-
+      (package--print-help-section "Requires")
+      (let ((first t))
+        (dolist (req reqs)
+          (let* ((name (car req))
+                 (vers (cadr req))
+                 (text (format "%s-%s" (symbol-name name)
+                               (package-version-join vers)))
+                 (reason (if (and (listp incompatible-reason)
+                                  (assq name incompatible-reason))
+                             " (not available)" "")))
+            (cond (first (setq first nil))
+                  ((>= (+ 2 (current-column) (length text) (length reason))
+                       (window-width))
+                   (insert ",\n               "))
+                  (t (insert ", ")))
+            (help-insert-xref-button text 'help-package name)
+            (insert reason)))
+        (insert "\n")))
+    (when required-by
+      (package--print-help-section "Required by")
+      (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")))
+    (when homepage
+      (package--print-help-section "Homepage")
+      (help-insert-xref-button homepage 'help-url homepage)
+      (insert "\n"))
+    (when keywords
+      (package--print-help-section "Keywords")
+      (dolist (k keywords)
+        (package-make-button
+         k
+         'package-keyword k
+         'action 'package-keyword-button-action)
+        (insert " "))
+      (insert "\n"))
     (let* ((all-pkgs (append (cdr (assq name package-alist))
                              (cdr (assq name package-archive-contents))
                              (let ((bi (assq name package--builtins)))
                                (if bi (list (package--from-builtin bi))))))
            (other-pkgs (delete desc all-pkgs)))
       (when other-pkgs
-        (insert "    " (propertize "Other versions" 'font-lock-face 'bold) ": "
-                (mapconcat
-                 (lambda (opkg)
-                   (let* ((ov (package-desc-version opkg))
-                          (dir (package-desc-dir opkg))
-                          (from (or (package-desc-archive opkg)
-                                    (if (stringp dir) "installed" dir))))
-                     (if (not ov) (format "%s" from)
-                       (format "%s (%s)"
-                               (make-text-button (package-version-join ov) nil
-                                                 'face 'link
-                                                 'follow-link t
-                                                 'action
-                                                 (lambda (_button)
-                                                   (describe-package opkg)))
-                               from))))
-                 other-pkgs ", ")
-                ".\n")))
+        (package--print-help-section "Other versions"
+          (mapconcat (lambda (opkg)
+                       (let* ((ov (package-desc-version opkg))
+                              (dir (package-desc-dir opkg))
+                              (from (or (package-desc-archive opkg)
+                                        (if (stringp dir) "installed" dir))))
+                         (if (not ov) (format "%s" from)
+                           (format "%s (%s)"
+                                   (make-text-button (package-version-join ov) nil
+                                                     'font-lock-face 'link
+                                                     'follow-link t
+                                                     'action
+                                                     (lambda (_button)
+                                                       (describe-package opkg)))
+                                   from))))
+                     other-pkgs ", ")
+          ".")))
 
     (insert "\n")
 
     (if built-in
-	;; For built-in packages, insert the commentary.
-	(let ((fn (locate-file (format "%s.el" name) load-path
-			       load-file-rep-suffixes))
-	      (opoint (point)))
-	  (insert (or (lm-commentary fn) ""))
-	  (save-excursion
-	    (goto-char opoint)
-	    (when (re-search-forward "^;;; Commentary:\n" nil t)
-	      (replace-match ""))
-	    (while (re-search-forward "^\\(;+ ?\\)" nil t)
-	      (replace-match ""))))
+        ;; For built-in packages, insert the commentary.
+        (let ((fn (locate-file (format "%s.el" name) load-path
+                               load-file-rep-suffixes))
+              (opoint (point)))
+          (insert (or (lm-commentary fn) ""))
+          (save-excursion
+            (goto-char opoint)
+            (when (re-search-forward "^;;; Commentary:\n" nil t)
+              (replace-match ""))
+            (while (re-search-forward "^\\(;+ ?\\)" nil t)
+              (replace-match ""))))
       (let ((readme (expand-file-name (format "%s-readme.txt" name)
-				      package-user-dir))
-	    readme-string)
-	;; For elpa packages, try downloading the commentary.  If that
-	;; fails, try an existing readme file in `package-user-dir'.
-	(cond ((condition-case nil
-		   (package--with-work-buffer
-                       (package-archive-base desc)
-                       (format "%s-readme.txt" name)
-		     (setq buffer-file-name
-			   (expand-file-name readme package-user-dir))
-		     (let ((version-control 'never))
-		       (save-buffer))
-		     (setq readme-string (buffer-string))
-		     t)
-		 (error nil))
-	       (insert readme-string))
-	      ((file-readable-p readme)
-	       (insert-file-contents readme)
-	       (goto-char (point-max))))))))
+                                      package-user-dir))
+            readme-string)
+        ;; For elpa packages, try downloading the commentary.  If that
+        ;; fails, try an existing readme file in `package-user-dir'.
+        (cond ((condition-case nil
+                   (save-excursion
+                     (package--with-work-buffer
+                         (package-archive-base desc)
+                         (format "%s-readme.txt" name)
+                       (save-excursion
+                         (goto-char (point-max))
+                         (unless (bolp)
+                           (insert ?\n)))
+                       (write-region nil nil
+                                     (expand-file-name readme package-user-dir)
+                                     nil 'silent)
+                       (setq readme-string (buffer-string))
+                       t))
+                 (error nil))
+               (insert readme-string))
+              ((file-readable-p readme)
+               (insert-file-contents readme)
+               (goto-char (point-max))))))))
 
 (defun package-install-button-action (button)
   (let ((pkg-desc (button-get button 'package-desc)))
-    (when (y-or-n-p (format "Install package `%s'? "
-                            (package-desc-full-name pkg-desc)))
-      (package-install pkg-desc)
+    (when (y-or-n-p (format-message "Install package `%s'? "
+                                    (package-desc-full-name pkg-desc)))
+      (package-install pkg-desc nil)
+      (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-message "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))))
+
+(defun package-make-button (text &rest props)
+  (let ((button-text (if (display-graphic-p) text (concat "[" text "]")))
+        (button-face (if (display-graphic-p)
+                         '(:box (:line-width 2 :color "dark grey")
+                                :background "light grey"
+                                :foreground "black")
+                       'link)))
+    (apply 'insert-text-button button-text 'face button-face 'follow-link t
+           props)))
+
 
 ;;;; Package menu mode.
 
 (defvar package-menu-mode-map
-  (let ((map (make-sparse-keymap))
-	(menu-map (make-sparse-keymap "Package")))
+  (let ((map (make-sparse-keymap)))
     (set-keymap-parent map tabulated-list-mode-map)
     (define-key map "\C-m" 'package-menu-describe-package)
     (define-key map "u" 'package-menu-mark-unmark)
@@ -1324,73 +2436,69 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
     (define-key map "i" 'package-menu-mark-install)
     (define-key map "U" 'package-menu-mark-upgrades)
     (define-key map "r" 'package-menu-refresh)
+    (define-key map "f" 'package-menu-filter)
     (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
     (define-key map "x" 'package-menu-execute)
     (define-key map "h" 'package-menu-quick-help)
+    (define-key map "H" #'package-menu-hide-package)
     (define-key map "?" 'package-menu-describe-package)
-    (define-key map [menu-bar package-menu] (cons "Package" menu-map))
-    (define-key menu-map [mq]
-      '(menu-item "Quit" quit-window
-		  :help "Quit package selection"))
-    (define-key menu-map [s1] '("--"))
-    (define-key menu-map [mn]
-      '(menu-item "Next" next-line
-		  :help "Next Line"))
-    (define-key menu-map [mp]
-      '(menu-item "Previous" previous-line
-		  :help "Previous Line"))
-    (define-key menu-map [s2] '("--"))
-    (define-key menu-map [mu]
-      '(menu-item "Unmark" package-menu-mark-unmark
-		  :help "Clear any marks on a package and move to the next line"))
-    (define-key menu-map [munm]
-      '(menu-item "Unmark Backwards" package-menu-backup-unmark
-		  :help "Back up one line and clear any marks on that package"))
-    (define-key menu-map [md]
-      '(menu-item "Mark for Deletion" package-menu-mark-delete
-		  :help "Mark a package for deletion and move to the next line"))
-    (define-key menu-map [mi]
-      '(menu-item "Mark for Install" package-menu-mark-install
-		  :help "Mark a package for installation and move to the next line"))
-    (define-key menu-map [mupgrades]
-      '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
-		  :help "Mark packages that have a newer version for upgrading"))
-    (define-key menu-map [s3] '("--"))
-    (define-key menu-map [mg]
-      '(menu-item "Update Package List" revert-buffer
-		  :help "Update the list of packages"))
-    (define-key menu-map [mr]
-      '(menu-item "Refresh Package List" package-menu-refresh
-		  :help "Download the ELPA archive"))
-    (define-key menu-map [s4] '("--"))
-    (define-key menu-map [mt]
-      '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
-		  :help "Mark all obsolete packages for deletion"))
-    (define-key menu-map [mx]
-      '(menu-item "Execute Actions" package-menu-execute
-		  :help "Perform all the marked actions"))
-    (define-key menu-map [s5] '("--"))
-    (define-key menu-map [mh]
-      '(menu-item "Help" package-menu-quick-help
-		  :help "Show short key binding help for package-menu-mode"))
-    (define-key menu-map [mc]
-      '(menu-item "View Commentary" package-menu-view-commentary
-		  :help "Display information about this package"))
+    (define-key map "(" #'package-menu-toggle-hiding)
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
+(easy-menu-define package-menu-mode-menu package-menu-mode-map
+  "Menu for `package-menu-mode'."
+  `("Package"
+    ["Describe Package" package-menu-describe-package :help "Display information about this package"]
+    ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"]
+    "--"
+    ["Refresh Package List" package-menu-refresh
+     :help "Redownload the ELPA archive"
+     :active (not package--downloads-in-progress)]
+    ["Redisplay buffer" revert-buffer :help "Update the buffer with current list of packages"]
+    ["Execute Marked Actions" package-menu-execute :help "Perform all the marked actions"]
+
+    "--"
+    ["Mark All Available Upgrades" package-menu-mark-upgrades
+     :help "Mark packages that have a newer version for upgrading"
+     :active (not package--downloads-in-progress)]
+    ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"]
+    ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"]
+    ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"]
+    ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"]
+
+    "--"
+    ["Filter Package List" package-menu-filter :help "Filter package selection (q to go back)"]
+    ["Hide by Regexp" package-menu-hide-package :help "Permanently hide all packages matching a regexp"]
+    ["Display Older Versions" package-menu-toggle-hiding
+     :style toggle :selected (not package-menu--hide-packages)
+     :help "Display package even if a newer version is already installed"]
+
+    "--"
+    ["Quit" quit-window :help "Quit package selection"]
+    ["Customize" (customize-group 'package)]))
+
 (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>
 \\{package-menu-mode-map}"
-  (setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
-			       ("Version" 12 nil)
-			       ("Status"  10 package-menu--status-predicate)
-			       ("Description" 0 nil)])
+  (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)
+          ("Status"  10 package-menu--status-predicate)
+          ,@(if (cdr package-archives)
+                '(("Archive" 10 package-menu--archive-predicate)))
+          ("Description" 0 nil)])
   (setq tabulated-list-padding 2)
   (setq tabulated-list-sort-key (cons "Status" nil))
   (add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t)
@@ -1407,12 +2515,47 @@ package PKG-DESC, add one.  The alist is keyed with PKG-DESC."
 (defvar package-list-unversioned nil
   "If non-nil include packages that don't have a version in `list-package'.")
 
+(defvar package-list-unsigned nil
+  "If non-nil, mention in the list which packages were installed w/o signature.")
+
+(defvar package--emacs-version-list (version-to-list emacs-version)
+  "`emacs-version', as a list.")
+
+(defun package--incompatible-p (pkg &optional shallow)
+  "Return non-nil if PKG has no chance of being installable.
+PKG is a package-desc object.
+
+If SHALLOW is non-nil, this only checks if PKG depends on a
+higher `emacs-version' than the one being used.  Otherwise, also
+checks the viability of dependencies, according to
+`package--compatibility-table'.
+
+If PKG requires an incompatible Emacs version, the return value
+is this version (as a string).
+If PKG requires incompatible packages, the return value is a list
+of these dependencies, similar to the list returned by
+`package-desc-reqs'."
+  (let* ((reqs    (package-desc-reqs pkg))
+         (version (cadr (assq 'emacs reqs))))
+    (if (and version (version-list-< package--emacs-version-list version))
+        (package-version-join version)
+      (unless shallow
+        (let (out)
+          (dolist (dep (package-desc-reqs pkg) out)
+            (let ((dep-name (car dep)))
+              (unless (eq 'emacs dep-name)
+                (let ((cv (gethash dep-name package--compatibility-table)))
+                  (when (version-list-< (or cv '(0)) (or (cadr dep) '(0)))
+                    (push dep out)))))))))))
+
 (defun package-desc-status (pkg-desc)
   (let* ((name (package-desc-name pkg-desc))
          (dir (package-desc-dir pkg-desc))
          (lle (assq name package-load-list))
          (held (cadr lle))
-         (version (package-desc-version pkg-desc)))
+         (version (package-desc-version pkg-desc))
+         (signed (or (not package-list-unsigned)
+                     (package-desc-signed pkg-desc))))
     (cond
      ((eq dir 'builtin) "built-in")
      ((and lle (null held)) "disabled")
@@ -1422,34 +2565,166 @@ package PKG-DESC, add one.  The alist is keyed with PKG-DESC."
          ((version-list-= version hv) "held")
          ((version-list-< version hv) "obsolete")
          (t "disabled"))))
-     ((package-built-in-p name version) "obsolete")
      (dir                               ;One of the installed packages.
       (cond
-       ((not (file-exists-p (package-desc-dir pkg-desc))) "deleted")
-       ((eq pkg-desc (cadr (assq name package-alist))) "installed")
+       ((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)
+              "installed" "dependency")))
        (t "obsolete")))
+     ((package--incompatible-p pkg-desc) "incompat")
      (t
       (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-packages'.
+         ((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) "installed")))))))
+              "new" "available"))))))))
 
-(defun package-menu--refresh (&optional packages)
+(defvar package-menu--hide-packages t
+  "Whether available obsolete packages should be hidden.
+Can be toggled with \\<package-menu-mode-map> \\[package-menu-toggle-hiding].
+Installed obsolete packages are always displayed.")
+
+(defun package-menu-toggle-hiding ()
+  "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-packages
+        (not package-menu--hide-packages))
+  (message "%s packages" (if package-menu--hide-packages
+                             "Hiding obsolete or unwanted"
+                           "Displaying all"))
+  (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, all with the
+same name, sorted by decreasing `package-desc-priority-version'.
+Return a list of packages tied for the highest priority according
+to their archives."
+  (when pkg-list
+    ;; Variable toggled with `package-menu-toggle-hiding'.
+    (if (not package-menu--hide-packages)
+        pkg-list
+      (let ((installed (cadr (assq (package-desc-name (car pkg-list))
+                                   package-alist))))
+        (when installed
+          (setq pkg-list
+                (let ((ins-version (package-desc-version installed)))
+                  (cl-remove-if (lambda (p) (version-list-< (package-desc-version p)
+                                                       ins-version))
+                                pkg-list))))
+        (let ((filtered-by-priority
+               (cond
+                ((not package-menu-hide-low-priority)
+                 pkg-list)
+                ((eq package-menu-hide-low-priority 'archive)
+                 (let* ((max-priority most-negative-fixnum)
+                        (out))
+                   (while pkg-list
+                     (let ((p (pop pkg-list)))
+                       (let ((priority (package-desc-priority p)))
+                         (if (< priority max-priority)
+                             (setq pkg-list nil)
+                           (push p out)
+                           (setq max-priority priority)))))
+                   (nreverse out)))
+                (pkg-list
+                 (list (car pkg-list))))))
+          (if (not installed)
+              filtered-by-priority
+            (let ((ins-version (package-desc-version installed)))
+              (cl-remove-if (lambda (p) (version-list-= (package-desc-version p)
+                                                   ins-version))
+                            filtered-by-priority))))))))
+
+(defcustom package-hidden-regexps nil
+  "List of regexps matching the name of packages to hide.
+If the name of a package matches any of these regexps it is
+omitted from the package menu.  To toggle this, type \\[package-menu-toggle-hiding].
+
+Values can be interactively added to this list by typing
+\\[package-menu-hide-package] on a package"
+  :type '(repeat (regexp :tag "Hide packages with name matching")))
+
+(defun package-menu--refresh (&optional packages keywords)
   "Re-populate the `tabulated-list-entries'.
-PACKAGES should be nil or t, which means to display all known packages."
+PACKAGES should be nil or t, which means to display all known packages.
+KEYWORDS should be nil or a list of keywords."
   ;; Construct list of (PKG-DESC . STATUS).
   (unless packages (setq packages t))
-  (let (info-list name)
+  (let ((hidden-names (mapconcat #'identity package-hidden-regexps "\\|"))
+        info-list)
+    ;; Installed packages:
+    (dolist (elt package-alist)
+      (let ((name (car elt)))
+        (when (or (eq packages t) (memq name packages))
+          (dolist (pkg (cdr elt))
+            (when (package--has-keyword-p pkg keywords)
+              (push pkg info-list))))))
+
+    ;; Built-in packages:
+    (dolist (elt package--builtins)
+      (let ((pkg  (package--from-builtin elt))
+            (name (car elt)))
+        (when (not (eq name 'emacs)) ; Hide the `emacs' package.
+          (when (and (package--has-keyword-p pkg keywords)
+                     (or package-list-unversioned
+                         (package--bi-desc-version (cdr elt)))
+                     (or (eq packages t) (memq name packages)))
+            (push pkg info-list)))))
+
+    ;; Available and disabled packages:
+    (unless (equal package--old-archive-priorities package-archive-priorities)
+      (package-read-all-archive-contents))
+    (dolist (elt package-archive-contents)
+      (let ((name (car elt)))
+        ;; To be displayed it must be in PACKAGES;
+        (when (and (or (eq packages t) (memq name packages))
+                   ;; and we must either not be hiding anything,
+                   (or (not package-menu--hide-packages)
+                       (not package-hidden-regexps)
+                       ;; or just not hiding this specific package.
+                       (not (string-match hidden-names (symbol-name name)))))
+          ;; Hide available-obsolete or low-priority packages.
+          (dolist (pkg (package--remove-hidden (cdr elt)))
+            (when (package--has-keyword-p pkg keywords)
+              (push pkg info-list))))))
+
+    ;; Print the result.
+    (setq tabulated-list-entries
+          (mapcar #'package-menu--print-info-simple info-list))))
+
+(defun package-all-keywords ()
+  "Collect all package keywords"
+  (let ((key-list))
+    (package--mapc (lambda (desc)
+                     (setq key-list (append (package-desc--keywords desc)
+                                            key-list))))
+    key-list))
+
+(defun package--mapc (function &optional packages)
+  "Call FUNCTION for all known PACKAGES.
+PACKAGES can be nil or t, which means to display all known
+packages, or a list of packages.
+
+Built-in packages are converted with `package--from-builtin'."
+  (unless packages (setq packages t))
+  (let (name)
     ;; Installed packages:
     (dolist (elt package-alist)
       (setq name (car elt))
       (when (or (eq packages t) (memq name packages))
-        (dolist (pkg (cdr elt))
-          (package--push pkg (package-desc-status pkg) info-list))))
+        (mapc function (cdr elt))))
 
     ;; Built-in packages:
     (dolist (elt package--builtins)
@@ -1457,8 +2732,8 @@ PACKAGES should be nil or t, which means to display all known packages."
       (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
                  (or package-list-unversioned
                      (package--bi-desc-version (cdr elt)))
-		 (or (eq packages t) (memq name packages)))
-    	(package--push (package--from-builtin elt) "built-in" info-list)))
+                 (or (eq packages t) (memq name packages)))
+        (funcall function (package--from-builtin elt))))
 
     ;; Available and disabled packages:
     (dolist (elt package-archive-contents)
@@ -1468,46 +2743,157 @@ PACKAGES should be nil or t, which means to display all known packages."
           ;; Hide obsolete packages.
           (unless (package-installed-p (package-desc-name pkg)
                                        (package-desc-version pkg))
-            (package--push pkg (package-desc-status pkg) info-list)))))
-
-    ;; Print the result.
-    (setq tabulated-list-entries
-          (mapcar #'package-menu--print-info info-list))))
+        (funcall function pkg)))))))
+
+(defun package--has-keyword-p (desc &optional keywords)
+  "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)
+        (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))
 
-(defun package-menu--generate (remember-pos packages)
+(defun package-menu--generate (remember-pos packages &optional keywords)
   "Populate the Package Menu.
  If REMEMBER-POS is non-nil, keep point on the same entry.
 PACKAGES should be t, which means to display all known packages,
-or a list of package names (symbols) to display."
-  (package-menu--refresh packages)
+or a list of package names (symbols) to display.
+
+With KEYWORDS given, only packages with those keywords are
+shown."
+  (package-menu--refresh packages keywords)
+  (setf (car (aref tabulated-list-format 0))
+        (if keywords
+            (let ((filters (mapconcat 'identity keywords ",")))
+              (concat "Package[" filters "]"))
+          "Package"))
+  (if keywords
+      (define-key package-menu-mode-map "q" 'package-show-package-list)
+    (define-key package-menu-mode-map "q" 'quit-window))
+  (tabulated-list-init-header)
   (tabulated-list-print remember-pos))
 
 (defun package-menu--print-info (pkg)
   "Return a package entry suitable for `tabulated-list-entries'.
 PKG has the form (PKG-DESC . STATUS).
 Return (PKG-DESC [NAME VERSION STATUS DOC])."
-  (let* ((pkg-desc (car pkg))
-	 (status  (cdr pkg))
-	 (face (pcase status
-		(`"built-in"  'font-lock-builtin-face)
-		(`"available" 'default)
-		(`"new"       'bold)
-		(`"held"      'font-lock-constant-face)
-		(`"disabled"  'font-lock-warning-face)
-		(`"installed" 'font-lock-comment-face)
-		(_            'font-lock-warning-face)))) ; obsolete.
-    (list pkg-desc
-	  (vector (list (symbol-name (package-desc-name pkg-desc))
-			'face 'link
-			'follow-link t
-			'package-desc pkg-desc
-			'action 'package-menu-describe-package)
-		  (propertize (package-version-join
-                               (package-desc-version pkg-desc))
-			      'font-lock-face face)
-		  (propertize status 'font-lock-face face)
-		  (propertize (package-desc-summary pkg-desc)
-                              'font-lock-face face)))))
+  (package-menu--print-info-simple (car pkg)))
+(make-obsolete 'package-menu--print-info
+               'package-menu--print-info-simple "25.1")
+
+
+;;; Package menu faces
+(defface package-name
+  '((t :inherit link))
+  "Face used on package names in the package menu."
+  :version "25.1")
+
+(defface package-description
+  '((t :inherit default))
+  "Face used on package description summaries in the package menu."
+  :version "25.1")
+
+(defface package-status-built-in
+  '((t :inherit font-lock-builtin-face))
+  "Face used on the status and version of built-in packages."
+  :version "25.1")
+
+(defface package-status-external
+  '((t :inherit package-status-builtin-face))
+  "Face used on the status and version of external packages."
+  :version "25.1")
+
+(defface package-status-available
+  '((t :inherit default))
+  "Face used on the status and version of available packages."
+  :version "25.1")
+
+(defface package-status-new
+  '((t :inherit (bold package-status-available)))
+  "Face used on the status and version of new packages."
+  :version "25.1")
+
+(defface package-status-held
+  '((t :inherit font-lock-constant-face))
+  "Face used on the status and version of held packages."
+  :version "25.1")
+
+(defface package-status-disabled
+  '((t :inherit font-lock-warning-face))
+  "Face used on the status and version of disabled packages."
+  :version "25.1")
+
+(defface package-status-installed
+  '((t :inherit font-lock-comment-face))
+  "Face used on the status and version of installed packages."
+  :version "25.1")
+
+(defface package-status-dependency
+  '((t :inherit package-status-installed))
+  "Face used on the status and version of dependency packages."
+  :version "25.1")
+
+(defface package-status-unsigned
+  '((t :inherit font-lock-warning-face))
+  "Face used on the status and version of unsigned packages."
+  :version "25.1")
+
+(defface package-status-incompat
+  '((t :inherit font-lock-comment-face))
+  "Face used on the status and version of incompat packages."
+  :version "25.1")
+
+(defface package-status-avail-obso
+  '((t :inherit package-status-incompat))
+  "Face used on the status and version of avail-obso packages."
+  :version "25.1")
+
+
+;;; Package menu printing
+(defun package-menu--print-info-simple (pkg)
+  "Return a package entry suitable for `tabulated-list-entries'.
+PKG is a package-desc object.
+Return (PKG-DESC [NAME VERSION STATUS DOC])."
+  (let* ((status  (package-desc-status pkg))
+         (face (pcase status
+                 (`"built-in"  'package-status-built-in)
+                 (`"external"  'package-status-external)
+                 (`"available" 'package-status-available)
+                 (`"avail-obso" 'package-status-avail-obso)
+                 (`"new"       'package-status-new)
+                 (`"held"      'package-status-held)
+                 (`"disabled"  'package-status-disabled)
+                 (`"installed" 'package-status-installed)
+                 (`"dependency" 'package-status-dependency)
+                 (`"unsigned"  'package-status-unsigned)
+                 (`"incompat"  'package-status-incompat)
+                 (_            'font-lock-warning-face)))) ; obsolete.
+    (list pkg
+          `[(,(symbol-name (package-desc-name pkg))
+             face package-name
+             font-lock-face package-name
+             follow-link t
+             package-desc ,pkg
+             action package-menu-describe-package)
+            ,(propertize (package-version-join
+                          (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 (package-desc-summary pkg)
+                         'font-lock-face 'package-description)])))
+
+(defvar package-menu--old-archive-contents nil
+  "`package-archive-contents' before the latest refresh.")
 
 (defun package-menu-refresh ()
   "Download the Emacs Lisp package archive.
@@ -1515,32 +2901,57 @@ This fetches the contents of each archive specified in
 `package-archives', and then refreshes the package menu."
   (interactive)
   (unless (derived-mode-p 'package-menu-mode)
-    (error "The current buffer is not a Package Menu"))
-  (package-refresh-contents)
-  (package-menu--generate t t))
+    (user-error "The current buffer is not a Package Menu"))
+  (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-hide-package ()
+  "Hide a package under point.
+If optional arg BUTTON is non-nil, describe its associated package."
+  (interactive)
+  (declare (interactive-only "change `package-hidden-regexps' instead."))
+  (let* ((name (when (derived-mode-p 'package-menu-mode)
+                 (concat "\\`" (regexp-quote (symbol-name (package-desc-name
+                                                           (tabulated-list-get-id)))))))
+         (re (read-string "Hide packages matching regexp: " name)))
+    ;; Test if it is valid.
+    (string-match re "")
+    (push re package-hidden-regexps)
+    (customize-save-variable 'package-hidden-regexps package-hidden-regexps)
+    (package-menu--post-refresh)
+    (let ((hidden
+           (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e))))
+                             package-archive-contents)))
+      (message (substitute-command-keys
+                (concat "Hiding %s packages, type `\\[package-menu-toggle-hiding]'"
+                        " to toggle or `\\[customize-variable] RET package-hidden-regexps'"
+                        " to customize it"))
+        (length hidden)))))
 
 (defun package-menu-describe-package (&optional button)
   "Describe the current package.
 If optional arg BUTTON is non-nil, describe its associated package."
   (interactive)
   (let ((pkg-desc (if button (button-get button 'package-desc)
-		    (tabulated-list-get-id))))
+                    (tabulated-list-get-id))))
     (if pkg-desc
-	(describe-package pkg-desc)
-      (error "No package here"))))
+        (describe-package pkg-desc)
+      (user-error "No package here"))))
 
 ;; fixme numeric argument
 (defun package-menu-mark-delete (&optional _num)
   "Mark a package for deletion and move to the next line."
   (interactive "p")
-  (if (member (package-menu-get-status) '("installed" "obsolete"))
+  (if (member (package-menu-get-status)
+              '("installed" "dependency" "obsolete" "unsigned"))
       (tabulated-list-put-tag "D" t)
     (forward-line)))
 
 (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"))
+  (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency"))
       (tabulated-list-put-tag "I" t)
     (forward-line)))
 
@@ -1562,72 +2973,216 @@ If optional arg BUTTON is non-nil, describe its associated package."
     (goto-char (point-min))
     (while (not (eobp))
       (if (equal (package-menu-get-status) "obsolete")
-	  (tabulated-list-put-tag "D" t)
-	(forward-line 1)))))
+          (tabulated-list-put-tag "D" t)
+        (forward-line 1)))))
+
+(defvar package--quick-help-keys
+  '(("install," "delete," "unmark," ("execute" . 1))
+    ("next," "previous")
+    ("Hide-package," "(-toggle-hidden")
+    ("refresh-contents," "g-redisplay," "filter," "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)))
+          (add-text-properties place (1+ place)
+                               '(face (bold font-lock-warning-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")
 
 (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)
+        (aref (cadr entry) 2)
       "")))
 
+(defun package-archive-priority (archive)
+  "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+  (or (cdr (assoc archive package-archive-priorities))
+      0))
+
+(defun package-desc-priority-version (pkg-desc)
+  "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+  (cons (package-desc-priority pkg-desc)
+        (package-desc-version pkg-desc)))
+
 (defun package-menu--find-upgrades ()
   (let (installed available upgrades)
     ;; Build list of installed/available packages in this buffer.
     (dolist (entry tabulated-list-entries)
       ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
       (let ((pkg-desc (car entry))
-	    (status (aref (cadr entry) 2)))
-	(cond ((equal status "installed")
-	       (push pkg-desc installed))
-	      ((member status '("available" "new"))
-	       (push (cons (package-desc-name pkg-desc) pkg-desc)
-                     available)))))
+            (status (aref (cadr entry) 2)))
+        (cond ((member status '("installed" "dependency" "unsigned"))
+               (push pkg-desc installed))
+              ((member status '("available" "new"))
+               (setq available (package--append-to-alist pkg-desc available))))))
     ;; Loop through list of installed packages, finding upgrades.
     (dolist (pkg-desc installed)
-      (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
-	(and avail-pkg
-	     (version-list-< (package-desc-version pkg-desc)
-                             (package-desc-version (cdr avail-pkg)))
-	     (push avail-pkg upgrades))))
+      (let* ((name (package-desc-name pkg-desc))
+             (avail-pkg (cadr (assq name available))))
+        (and avail-pkg
+             (version-list-< (package-desc-priority-version pkg-desc)
+                             (package-desc-priority-version avail-pkg))
+             (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.")
+        (message "No packages to upgrade.")
       (widen)
       (save-excursion
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (let* ((pkg-desc (tabulated-list-get-id))
-		 (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
-	    (cond ((null upgrade)
-		   (forward-line 1))
-		  ((equal pkg-desc upgrade)
-		   (package-menu-mark-install))
-		  (t
-		   (package-menu-mark-delete))))))
+        (goto-char (point-min))
+        (while (not (eobp))
+          (let* ((pkg-desc (tabulated-list-get-id))
+                 (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
+            (cond ((null upgrade)
+                   (forward-line 1))
+                  ((equal pkg-desc upgrade)
+                   (package-menu-mark-install))
+                  (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.
+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-message "package `%s'"
+                      (package-desc-full-name (car packages))))))
+
+(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)))
+    `((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 ((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))))
+  (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
+          (let ((inhibit-message package-menu-async))
+            (package-delete elt nil 'nosave))
+        (error (message "Error trying to delete `%s': %S"
+                 (package-desc-full-name elt)
+                 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.
@@ -1641,84 +3196,140 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
     (save-excursion
       (goto-char (point-min))
       (while (not (eobp))
-	(setq cmd (char-after))
-	(unless (eq cmd ?\s)
-	  ;; This is the key PKG-DESC.
-	  (setq pkg-desc (tabulated-list-get-id))
-	  (cond ((eq cmd ?D)
-		 (push pkg-desc delete-list))
-		((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 'package-install 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 delete-list)
-	    (condition-case-unless-debug err
-		(package-delete elt)
-	      (error (message (cadr err)))))
-	(error "Aborted")))
-    (if (or delete-list install-list)
-	(package-menu--generate t t)
-      (message "No operations specified."))))
+        (setq cmd (char-after))
+        (unless (eq cmd ?\s)
+          ;; This is the key PKG-DESC.
+          (setq pkg-desc (tabulated-list-get-id))
+          (cond ((eq cmd ?D)
+                 (push pkg-desc delete-list))
+                ((eq cmd ?I)
+                 (push pkg-desc install-list))))
+        (forward-line)))
+    (unless (or delete-list install-list)
+      (user-error "No operations specified"))
+    (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)
+                  (substitute-command-keys
+                   "are no longer needed, type `\\[package-autoremove]' to remove them"))
+              (message (replace-regexp-in-string "__" "ed" message-template)
+                "finished"))))))))
 
 (defun package-menu--version-predicate (A B)
   (let ((vA (or (aref (cadr A) 1)  '(0)))
-	(vB (or (aref (cadr B) 1) '(0))))
+        (vB (or (aref (cadr B) 1) '(0))))
     (if (version-list-= vA vB)
-	(package-menu--name-predicate A B)
+        (package-menu--name-predicate A B)
       (version-list-< vA vB))))
 
 (defun package-menu--status-predicate (A B)
   (let ((sA (aref (cadr A) 2))
-	(sB (aref (cadr B) 2)))
+        (sB (aref (cadr B) 2)))
     (cond ((string= sA sB)
-	   (package-menu--name-predicate A B))
-	  ((string= sA "new") t)
-	  ((string= sB "new") nil)
-	  ((string= sA "available") t)
-	  ((string= sB "available") nil)
-	  ((string= sA "installed") t)
-	  ((string= sB "installed") nil)
-	  ((string= sA "held") t)
-	  ((string= sB "held") nil)
-	  ((string= sA "built-in") t)
-	  ((string= sB "built-in") nil)
-	  ((string= sA "obsolete") t)
-	  ((string= sB "obsolete") nil)
-	  (t (string< sA sB)))))
+           (package-menu--name-predicate A B))
+          ((string= sA "new") t)
+          ((string= sB "new") 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)
+          ((string= sB "dependency") nil)
+          ((string= sA "unsigned") t)
+          ((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)
+          ((string= sB "obsolete") nil)
+          ((string= sA "incompat") t)
+          ((string= sB "incompat") nil)
+          (t (string< sA sB)))))
 
 (defun package-menu--description-predicate (A B)
   (let ((dA (aref (cadr A) 3))
-	(dB (aref (cadr B) 3)))
+        (dB (aref (cadr B) 3)))
     (if (string= dA dB)
-	(package-menu--name-predicate A B)
+        (package-menu--name-predicate A B)
       (string< dA dB))))
 
 (defun package-menu--name-predicate (A B)
   (string< (symbol-name (package-desc-name (car A)))
-	   (symbol-name (package-desc-name (car B)))))
+           (symbol-name (package-desc-name (car B)))))
+
+(defun package-menu--archive-predicate (A B)
+  (string< (or (package-desc-archive (car A)) "")
+           (or (package-desc-archive (car B)) "")))
+
+(defun package-menu--populate-new-package-list ()
+  "Decide which packages are new in `package-archives-contents'.
+Store this list in `package-menu--new-package-list'."
+  ;; Find which packages are new.
+  (when package-menu--old-archive-contents
+    (dolist (elt package-archive-contents)
+      (unless (assq (car elt) package-menu--old-archive-contents)
+        (push (car elt) package-menu--new-package-list)))
+    (setq package-menu--old-archive-contents nil)))
+
+(defun package-menu--find-and-notify-upgrades ()
+  "Notify the user of upgradable packages."
+  (when-let ((upgrades (package-menu--find-upgrades)))
+    (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+      (length upgrades)
+      (if (= (length upgrades) 1) "" "s")
+      (substitute-command-keys "\\[package-menu-mark-upgrades]")
+      (if (= (length upgrades) 1) "it" "them"))))
+
+(defun package-menu--post-refresh ()
+  "If there's a *Packages* buffer, revert it and check for new packages and upgrades.
+Do nothing if there's no *Packages* buffer.
+
+This function is called after `package-refresh-contents' and it
+is added to `post-command-hook' by any function which alters the
+package database (`package-install' and `package-delete').  When
+run, it removes itself from `post-command-hook'."
+  (remove-hook 'post-command-hook #'package-menu--post-refresh)
+  (let ((buf (get-buffer "*Packages*")))
+    (when (buffer-live-p buf)
+      (with-current-buffer buf
+        (package-menu--populate-new-package-list)
+        (run-hooks 'tabulated-list-revert-hook)
+        (tabulated-list-print 'remember 'update)))))
+
+(defun package-menu--mark-or-notify-upgrades ()
+  "If there's a *Packages* buffer, check for upgrades and possibly mark them.
+Do nothing if there's no *Packages* buffer.  If there are
+upgrades, mark them if `package-menu--mark-upgrades-pending' is
+non-nil, otherwise just notify the user that there are upgrades.
+This function is called after `package-refresh-contents'."
+  (let ((buf (get-buffer "*Packages*")))
+    (when (buffer-live-p buf)
+      (with-current-buffer buf
+        (if package-menu--mark-upgrades-pending
+            (package-menu--mark-upgrades-1)
+          (package-menu--find-and-notify-upgrades))))))
 
 ;;;###autoload
 (defun list-packages (&optional no-fetch)
@@ -1731,52 +3342,66 @@ The list is displayed in a buffer named `*Packages*'."
   ;; Initialize the package system if necessary.
   (unless package--initialized
     (package-initialize t))
-  (let (old-archives new-packages)
-    (unless no-fetch
-      ;; Read the locally-cached archive-contents.
-      (package-read-all-archive-contents)
-      (setq old-archives package-archive-contents)
+  ;; Integrate the package-menu with updating the archives.
+  (add-hook 'package--post-download-archives-hook
+            #'package-menu--post-refresh)
+  (add-hook 'package--post-download-archives-hook
+            #'package-menu--mark-or-notify-upgrades 'append)
+
+  ;; Generate the Package Menu.
+  (let ((buf (get-buffer-create "*Packages*")))
+    (with-current-buffer buf
+      (package-menu-mode)
+
       ;; Fetch the remote list of packages.
-      (package-refresh-contents)
-      ;; Find which packages are new.
-      (dolist (elt package-archive-contents)
-	(unless (assq (car elt) old-archives)
-	  (push (car elt) new-packages))))
-
-    ;; Generate the Package Menu.
-    (let ((buf (get-buffer-create "*Packages*")))
-      (with-current-buffer buf
-	(package-menu-mode)
-	(set (make-local-variable 'package-menu--new-package-list)
-	     new-packages)
-	(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))
-
-    (let ((upgrades (package-menu--find-upgrades)))
-      (if upgrades
-	  (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
-		   (length upgrades)
-		   (if (= (length upgrades) 1) "" "s")
-		   (substitute-command-keys "\\[package-menu-mark-upgrades]")
-		   (if (= (length upgrades) 1) "it" "them"))))))
+      (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)))
 
 ;;;###autoload
 (defalias 'package-list-packages 'list-packages)
 
 ;; Used in finder.el
-(defun package-show-package-list (packages)
+(defun package-show-package-list (&optional packages keywords)
   "Display PACKAGES in a *Packages* buffer.
 This is similar to `list-packages', but it does not fetch the
 updated list of packages, and it only displays packages with
-names in PACKAGES (which should be a list of symbols)."
+names in PACKAGES (which should be a list of symbols).
+
+When KEYWORDS are given, only packages with those KEYWORDS are
+shown."
+  (interactive)
   (require 'finder-inf nil t)
-  (let ((buf (get-buffer-create "*Packages*")))
+  (let* ((buf (get-buffer-create "*Packages*"))
+         (win (get-buffer-window buf)))
     (with-current-buffer buf
       (package-menu-mode)
-      (package-menu--generate nil packages))
-    (switch-to-buffer buf)))
+      (package-menu--generate nil packages keywords))
+    (if win
+        (select-window win)
+      (switch-to-buffer buf))))
+
+;; package-menu--generate rebinds "q" on the fly, so we have to
+;; hard-code the binding in the doc-string here.
+(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-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.