emacs-lisp/package.el: Reorganize package.el

Reorganize package.el and divide it with page-breaks and comments

2 files changed, 791 insertions, 710 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 649e8849732..da5893f495b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2015-03-30  Artur Malabarba  <bruce.connor.am@gmail.com>
+
+        * emacs-lisp/package.el: Reorganize package.el and divide it with
+        page-breaks and comments.
+
 2015-03-30  Alan Mackenzie  <acm@muc.de>
 
         Correct calculation of CC Mode's font-lock region.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 0275da39229..526c0b41a77 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -173,6 +173,8 @@
   :group 'applications
   :version "24.1")
 
+
+;;; Customization options
 ;;;###autoload
 (defcustom package-enable-at-startup t
   "Whether to activate installed packages when Emacs starts.
@@ -204,12 +206,6 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
   :group 'package
   :version "24.1")
 
-(defvar Info-directory-list)
-(declare-function info-initialize "info" ())
-(declare-function url-http-file-exists-p "url-http" (url))
-(declare-function lm-header "lisp-mnt" (header))
-(declare-function lm-commentary "lisp-mnt" (&optional file))
-
 (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.
@@ -270,17 +266,6 @@ the package will be unavailable."
   :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.
@@ -348,6 +333,14 @@ a sane initial value."
   :group 'package
   :type '(repeat symbol))
 
+
+;;; `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
@@ -419,7 +412,43 @@ Slots:
   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)
@@ -446,6 +475,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
@@ -467,53 +503,33 @@ called via `package-initialize'.  To change which packages are
 loaded and/or activated, customize `package-load-list'.")
 (put 'package-alist '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.")
-
 (defvar package-activated-list nil
   ;; FIXME: This should implicitly include all builtin packages.
   "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 -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)))))
+;;;; 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."
@@ -524,8 +540,9 @@ This is, approximately, the inverse of `version-to-list'.
       (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))
@@ -547,6 +564,24 @@ updates `package-alist'."
           (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'.
@@ -562,6 +597,23 @@ 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-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))))))
+
+(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
@@ -606,6 +658,7 @@ correspond to previously loaded files (those returned by
     t))
 
 (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
@@ -640,33 +693,14 @@ DIR, sorted by most recently loaded last."
               ;; Sort the files by ascending HISTORY-POSITION.
               (lambda (x y) (< (cdr x) (cdr y))))))))
 
-(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--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.
+;;;; `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
@@ -698,76 +732,14 @@ Required package `%s-%s' is unavailable"
           ;; If all goes well, activate the package itself.
           (package-activate-1 pkg-vec force)))))))
 
-(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 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))
-         (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))
+
+;;; 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)
@@ -792,34 +764,6 @@ untar into a directory named DIR; otherwise, signal an error."
             (error "Package does not untar cleanly into directory %s/" dir)))))
   (tar-untar-buffer))
 
-(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))))
-
 (defun package--alist-to-plist-args (alist)
   (mapcar 'macroexp-quote
           (apply #'nconc
@@ -866,6 +810,70 @@ 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"
+             "(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 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))
+         (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)
@@ -876,33 +884,153 @@ untar into a directory named DIR; otherwise, signal an error."
   ;; FIXME: Create foo.info and dir file from foo.texi?
   )
 
+;;;; Compilation
 (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))
 
+;;;; 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" ())
+
+(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))))
+
+(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 nil 'silent)))
 
-(defmacro package--with-work-buffer (location file &rest body)
-  "Run BODY in a buffer containing the contents of FILE at LOCATION.
-LOCATION is the base location of a package archive, and should be
-one of the URLs (or file names) specified in `package-archives'.
-FILE is the name of a file relative to that base location.
-
-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))
-  `(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))
+(declare-function url-http-file-exists-p "url-http" (url))
 
 (defun package--archive-file-exists-p (location file)
   (let ((http (string-match "\\`https?:" location)))
@@ -935,6 +1063,25 @@ buffer is killed afterwards.  Return the last value in BODY."
           (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.
+LOCATION is the base location of a package archive, and should be
+one of the URLs (or file names) specified in `package-archives'.
+FILE is the name of a file relative to that base location.
+
+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))
+  `(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))
+
 (defun package--check-signature (location file)
   "Check signature of the current buffer.
 GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
@@ -967,65 +1114,256 @@ GnuPG keyring is located under \"gnupg\" in `package-user-dir'."
         (error "Failed to verify signature %s" sig-file))
       good-signatures)))
 
-(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)))
-         (sig-file (concat file ".sig"))
-         good-signatures pkg-descs)
-    (package--with-work-buffer location file
+
+;;; 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'."
+  ;; 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
+        (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-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-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))))
+
+;;;; 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)
+
+;;;###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."
+  (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)
+  ;; 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.
+(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))
+        (sig-file (concat file ".sig"))
+        good-signatures)
+    (package--with-work-buffer (cdr archive) file
+      ;; Check signature of archive-contents, if desired.
       (if (and package-check-signature
-               (not (member (package-desc-archive pkg-desc)
-                            package-unsigned-archives)))
-          (if (package--archive-file-exists-p location sig-file)
-              (setq good-signatures (package--check-signature location file))
+               (not (member archive package-unsigned-archives)))
+          (if (package--archive-file-exists-p (cdr archive) sig-file)
+              (setq good-signatures (package--check-signature (cdr archive)
+                                                              file))
             (unless (eq package-check-signature 'allow-unsigned)
-              (error "Unsigned package: `%s'"
-                     (package-desc-name pkg-desc)))))
-      (package-unpack pkg-desc))
-    ;; Here the package has been installed successfully, mark it as
-    ;; signed if appropriate.
+              (error "Unsigned archive `%s'"
+                (car archive)))))
+      ;; Read the retrieved buffer to make sure it is valid (e.g. it
+      ;; may fetch a URL redirect page).
+      (when (listp (read (current-buffer)))
+        (make-directory dir t)
+        (write-region nil nil (expand-file-name file dir) nil 'silent)))
     (when good-signatures
-      ;; Write out good signatures into NAME-VERSION.signed file.
+      ;; Write out good signatures into archive-contents.signed file.
       (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
                     nil
-                    (expand-file-name
-                     (concat (package-desc-full-name pkg-desc)
-                             ".signed")
-                     package-user-dir)
-                    nil 'silent)
-      ;; Update the old pkg-desc which will be shown on the description buffer.
-      (setf (package-desc-signed pkg-desc) t)
-      ;; Update the new (activated) pkg-desc as well.
-      (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
-      (if pkg-descs
-          (setf (package-desc-signed (car pkg-descs)) t)))))
+                    (expand-file-name (concat file ".signed") dir)
+                    nil 'silent))))
 
-(defvar package--initialized nil)
+(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))
 
-(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.
+;;;###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))))
 
-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))))
+;;;###autoload
+(defun package-refresh-contents ()
+  "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."
+  (interactive)
+  ;; FIXME: Do it asynchronously.
+  (unless (file-exists-p package-user-dir)
+    (make-directory package-user-dir t))
+  (let ((default-keyring (expand-file-name "package-keyring.gpg"
+                                           data-directory)))
+    (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))))))
+  (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)
+  (package--build-compatibility-table)
+  (message "Package refresh done"))
 
+
+;;; 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'.
@@ -1109,109 +1447,20 @@ but version %s required"
                                              (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-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))))
-
-(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)))))
-
-;; 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--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--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--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--user-selected-p (pkg)
   "Return non-nil if PKG is a package was installed by the user.
@@ -1224,6 +1473,153 @@ if it is still empty."
      (setq package-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)
+  "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.
+
+When not specified, PKG-LIST defaults to `package-alist'
+with PKG-DESC entry removed."
+  (unless (string= (package-desc-status pkg-desc) "obsolete")
+    (let ((pkg (package-desc-name pkg-desc)))
+      (cl-loop with alist = (or pkg-list
+                                (remove (assq pkg package-alist)
+                                        package-alist))
+               for p in alist thereis
+               (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
+                    (car p))))))
+
+(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))))))
+
+
+;;; 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-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)))
+         (sig-file (concat file ".sig"))
+         good-signatures pkg-descs)
+    (package--with-work-buffer location file
+      (if (and package-check-signature
+               (not (member (package-desc-archive pkg-desc)
+                            package-unsigned-archives)))
+          (if (package--archive-file-exists-p location sig-file)
+              (setq good-signatures (package--check-signature location file))
+            (unless (eq package-check-signature 'allow-unsigned)
+              (error "Unsigned package: `%s'"
+                     (package-desc-name pkg-desc)))))
+      (package-unpack pkg-desc))
+    ;; Here the package has been installed successfully, mark it as
+    ;; signed if appropriate.
+    (when good-signatures
+      ;; Write out good signatures into NAME-VERSION.signed file.
+      (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
+                    nil
+                    (expand-file-name
+                     (concat (package-desc-full-name pkg-desc)
+                             ".signed")
+                     package-user-dir)
+                    nil 'silent)
+      ;; Update the old pkg-desc which will be shown on the description buffer.
+      (setf (package-desc-signed pkg-desc) t)
+      ;; Update the new (activated) pkg-desc as well.
+      (setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
+      (if pkg-descs
+          (setf (package-desc-signed (car pkg-descs)) t)))))
+
+(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.
+
+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.
 PACKAGES should be a list of package-desc.
@@ -1276,20 +1672,6 @@ to install it but still mark it as selected."
      (package-compute-transaction ()
                                   (list (list pkg))))))
 
-;;;###autoload
-(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))
-
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
 If the result looks like a dotted numeric version, return it.
@@ -1304,120 +1686,6 @@ Otherwise return nil."
 
 (declare-function lm-homepage "lisp-mnt" (&optional file))
 
-(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))))
-
-(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))))
-
-(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))))
-
-(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))))
-
-
 ;;;###autoload
 (defun package-install-from-buffer ()
   "Install a package from the current buffer.
@@ -1469,22 +1737,6 @@ The file can either be a tar file or an Emacs Lisp file."
       (when (string-match "\\.tar\\'" file) (tar-mode)))
     (package-install-from-buffer)))
 
-(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))))))
-
 ;;;###autoload
 (defun package-install-user-selected-packages ()
   "Ensure packages in `package-selected-packages' are installed.
@@ -1507,22 +1759,8 @@ If some packages are not installed propose to install them."
                    (mapc #'package-install lst))
                (message "All your packages are already installed")))))
 
-(defun package--used-elsewhere-p (pkg-desc &optional pkg-list)
-  "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.
-
-When not specified, PKG-LIST defaults to `package-alist'
-with PKG-DESC entry removed."
-  (unless (string= (package-desc-status pkg-desc) "obsolete")
-    (let ((pkg (package-desc-name pkg-desc)))
-      (cl-loop with alist = (or pkg-list
-                                (remove (assq pkg package-alist)
-                                        package-alist))
-               for p in alist thereis
-               (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
-                    (car p))))))
-
+
+;;; 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))
@@ -1577,17 +1815,19 @@ If NOSAVE is non-nil, the package is not removed from
                (setq package-alist (delq pkgs package-alist))))
            (message "Package `%s' deleted." (package-desc-full-name pkg-desc))))))
 
-(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)))
+;;;###autoload
+(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-autoremove ()
@@ -1614,157 +1854,6 @@ will be deleted."
                   removable))
         (message "Nothing to autoremove")))))
 
-(defun package-archive-base (desc)
-  "Return the archive containing the package NAME."
-  (cdr (assoc (package-desc-archive desc) package-archives)))
-
-(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-archive-priority
-         (package-desc-archive pkg-desc))
-        (package-desc-version pkg-desc)))
-
-(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))
-        (sig-file (concat file ".sig"))
-        good-signatures)
-    (package--with-work-buffer (cdr archive) file
-      ;; Check signature of archive-contents, if desired.
-      (if (and package-check-signature
-               (not (member archive package-unsigned-archives)))
-          (if (package--archive-file-exists-p (cdr archive) sig-file)
-              (setq good-signatures (package--check-signature (cdr archive)
-                                                              file))
-            (unless (eq package-check-signature 'allow-unsigned)
-              (error "Unsigned archive `%s'"
-                     (car archive)))))
-      ;; Read the retrieved buffer to make sure it is valid (e.g. it
-      ;; may fetch a URL redirect page).
-      (when (listp (read (current-buffer)))
-        (make-directory dir t)
-        (write-region nil nil (expand-file-name file dir) nil 'silent)))
-    (when good-signatures
-      ;; Write out good signatures into archive-contents.signed file.
-      (write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
-                    nil
-                    (expand-file-name (concat file ".signed") dir)
-                    nil 'silent))))
-
-(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))))
-
-(defun package--build-compatibility-table ()
-  "Build `package--compatibility-table' with `package--mapc'."
-  ;; Build compat table.
-  (setq package--compatibility-table (make-hash-table :test 'eq))
-  (package--mapc #'package--add-to-compatibility-table))
-
-;;;###autoload
-(defun package-refresh-contents ()
-  "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."
-  (interactive)
-  ;; FIXME: Do it asynchronously.
-  (unless (file-exists-p package-user-dir)
-    (make-directory package-user-dir t))
-  (let ((default-keyring (expand-file-name "package-keyring.gpg"
-                                           data-directory)))
-    (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))))))
-  (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)
-  (package--build-compatibility-table)
-  (message "Package refresh done"))
-
-(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)))
-
-;;;###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."
-  (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)
-  ;; This uses `package--mapc' so it must be called after
-  ;; `package--initialized' is t.
-  (package--build-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 description buffer.
 
@@ -1798,6 +1887,8 @@ the table."
       (with-current-buffer standard-output
         (describe-package-1 package)))))
 
+(declare-function lm-commentary "lisp-mnt" (&optional file))
+
 (defun describe-package-1 (pkg)
   (require 'lisp-mnt)
   (let* ((desc (or
@@ -2392,6 +2483,25 @@ If optional arg BUTTON is non-nil, describe its associated package."
         (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-archive-priority
+         (package-desc-archive 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.
@@ -2441,40 +2551,6 @@ call will upgrade the package."
                (length upgrades)
                (if (= (length upgrades) 1) "" "s")))))
 
-(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-menu-execute (&optional noquery)
   "Perform marked Package Menu actions.
 Packages marked for installation are downloaded and installed;