Separate built-in packages from elpa packages, for efficiency.

* emacs-lisp/package.el: Don't put built-in packages in
package-alist, to avoid loading inefficiencies.
(package-built-in-p): Make VERSION optional, and treat it as a
minimum acceptable version.
(package-activate): Search separately for built-in packages.  Emit
a warning if a dependency fails.
(define-package): Handle most common case, where there is no
obsolete package, first.
(package-compute-transaction): Print required version in error.
(package--initialized): New variable.
(list-packages): Use it.
(package-initialize): Optional arg NO-ACTIVATE.  Don't put
built-in packages in packages-alist; keep it separate.  Set
package--initialized.
(describe-package): Avoid activating packages as a side-effect.
Search separately for built-in packages.
(describe-package-1): Handle the case where an elpa package is
simultaneously built-in and available/installed.
(package-installed-p, package--generate-package-list): Search
separately for built-in packages.
(package-load-descriptor): Doc fix.

2 files changed, 176 insertions, 131 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4cb8061e71e..7eef58d6401 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,27 @@
+2010-11-03  Chong Yidong  <cyd@stupidchicken.com>
+
+        * emacs-lisp/package.el: Don't put built-in packages in
+        package-alist, to avoid loading inefficiencies.
+        (package-built-in-p): Make VERSION optional, and treat it as a
+        minimum acceptable version.
+        (package-activate): Search separately for built-in packages.  Emit
+        a warning if a dependency fails.
+        (define-package): Handle most common case, where there is no
+        obsolete package, first.
+        (package-compute-transaction): Print required version in error.
+        (package--initialized): New variable.
+        (list-packages): Use it.
+        (package-initialize): Optional arg NO-ACTIVATE.  Don't put
+        built-in packages in packages-alist; keep it separate.  Set
+        package--initialized.
+        (describe-package): Avoid activating packages as a side-effect.
+        Search separately for built-in packages.
+        (describe-package-1): Handle the case where an elpa package is
+        simultaneously built-in and available/installed.
+        (package-installed-p, package--generate-package-list): Search
+        separately for built-in packages.
+        (package-load-descriptor): Doc fix.
+
 2010-11-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * progmodes/perl-mode.el (perl-syntax-propertize-function):
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index e260691da36..a08ea5d2a17 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -329,7 +329,9 @@ E.g., if given \"quux-23.0\", will return \"quux\""
       (match-string 1 dirname)))
 
 (defun package-load-descriptor (dir package)
-  "Load the description file in directory DIR for package PACKAGE."
+  "Load the description file in directory DIR for package PACKAGE.
+Here, PACKAGE is a string of the form NAME-VER, where NAME is the
+package name and VER is its version."
   (let* ((pkg-dir (expand-file-name package dir))
          (pkg-file (expand-file-name
                     (concat (package-strip-version package) "-pkg")
@@ -419,42 +421,46 @@ updates `package-alist' and `package-obsolete-alist'."
     ;; Don't return nil.
     t))
 
-(defun package--built-in (package version)
-  "Return true if the package is built-in to Emacs."
+(defun package-built-in-p (package &optional version)
+  "Return true if PACKAGE, of VERSION or newer, is built-in to Emacs."
+  (require 'finder-inf nil t) ; For `package--builtins'.
   (let ((elt (assq package package--builtins)))
-    (and elt (version-list-= (package-desc-vers (cdr elt)) version))))
+    (and elt (version-list-<= version (package-desc-vers (cdr elt))))))
 
-;; FIXME: return a reason instead?
+;; 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.
 (defun package-activate (package version)
-  "Activate a package, and recursively activate its dependencies.
+  "Activate package PACKAGE, of version VERSION or newer.
+If PACKAGE has any dependencies, recursively activate them.
 Return nil if the package could not be activated."
-  ;; Assume the user knows what he is doing -- go ahead and activate a
-  ;; newer version of a package if an older one has already been
-  ;; 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.  However, don't try to activate 'emacs', as that makes
-  ;; no sense.
-  (unless (eq package 'emacs)
-    (let* ((pkg-desc (assq package package-alist))
-           (this-version (package-desc-vers (cdr pkg-desc)))
-           (req-list (package-desc-reqs (cdr pkg-desc)))
-           ;; If the package was never activated, do it now.
-           (keep-going (or (not (memq package package-activated-list))
-                           (version-list-< version this-version))))
-      (while (and req-list keep-going)
-        (let* ((req (car req-list))
-               (req-name (car req))
-               (req-version (cadr req)))
-          (or (package-activate req-name req-version)
-              (setq keep-going nil)))
-        (setq req-list (cdr req-list)))
-      (if keep-going
-          (package-activate-1 package (cdr pkg-desc))
-        ;; We get here if a dependency failed to activate -- but we
-        ;; can also get here if the requested package was already
-        ;; activated.  Return non-nil in the latter case.
-        (and (memq package package-activated-list)
-             (version-list-<= version this-version))))))
+  (let ((pkg-vec (cdr (assq package package-alist)))
+        available-version found)
+    ;; Check if PACKAGE is available in `package-alist'.
+    (when pkg-vec
+      (setq available-version (package-desc-vers pkg-vec)
+            found (version-list-<= version available-version)))
+    (cond
+     ;; If no such package is found, maybe it's built-in.
+     ((null found)
+      (package-built-in-p package version))
+     ;; If the package is already activated, just return t.
+     ((memq package package-activated-list)
+      t)
+     ;; Otherwise, proceed with activation.
+     (t
+      (let ((fail (catch 'dep-failure
+                    ;; Activate its dependencies recursively.
+                    (dolist (req (package-desc-reqs pkg-vec))
+                      (unless (package-activate (car req) (cadr req))
+                        (throw 'dep-failure req))))))
+        (if fail
+            (warn "Unable to activate package `%s'.
+Required package `%s', version %s, is unavailable"
+                  package (car fail) (package-version-join (cadr fail)))
+          ;; If all goes well, activate the package itself.
+          (package-activate-1 package pkg-vec)))))))
 
 (defun package-mark-obsolete (package pkg-vec)
   "Put package on the obsolete list, if not already there."
@@ -470,48 +476,45 @@ Return nil if the package could not be activated."
                                       pkg-vec)))
             package-obsolete-alist))))
 
-(defun define-package (name-str version-string
+(defun define-package (name-string version-string
                                 &optional docstring requirements
                                 &rest extra-properties)
   "Define a new package.
-NAME is the name of the package, a string.
-VERSION-STRING is the version of the package, a dotted sequence
-of integers.
-DOCSTRING is the optional description.
-REQUIREMENTS is a list of requirements on other packages.
+NAME-STRING is the name of the package, as a string.
+VERSION-STRING is the version of the package, as a list of
+integers of the form produced by `version-to-list'.
+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 \"VERSION\").
 
 EXTRA-PROPERTIES is currently unused."
-  (let* ((name (intern name-str))
-         (pkg-desc (assq name package-alist))
-         (new-version (version-to-list version-string))
+  (let* ((name (intern name-string))
+         (version (version-to-list version-string))
          (new-pkg-desc
           (cons name
-                (vector new-version
+                (vector version
                         (mapcar
                          (lambda (elt)
                            (list (car elt)
                                  (version-to-list (car (cdr elt)))))
                          requirements)
-                        docstring))))
-    ;; Only redefine a package if the redefinition is newer.
-    (if (or (not pkg-desc)
-            (version-list-< (package-desc-vers (cdr pkg-desc))
-                            new-version))
-        (progn
-          (when pkg-desc
-            ;; Remove old package and declare it obsolete.
-            (setq package-alist (delq pkg-desc package-alist))
-            (package-mark-obsolete (car pkg-desc) (cdr pkg-desc)))
-          ;; Add package to the alist.
-          (push new-pkg-desc package-alist))
-      ;; You can have two packages with the same version, for instance
-      ;; one in the system package directory and one in your private
-      ;; directory.  We just let the first one win.
-      (unless (version-list-= new-version
-                              (package-desc-vers (cdr pkg-desc)))
-        ;; The package is born obsolete.
-        (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc))))))
+                        docstring)))
+         (old-pkg (assq name package-alist)))
+    (cond
+     ;; If there's no old package, just add this to `package-alist'.
+     ((null old-pkg)
+      (push new-pkg-desc package-alist))
+     ((version-list-< (package-desc-vers (cdr old-pkg)) version)
+      ;; Remove the old package and declare it obsolete.
+      (package-mark-obsolete name (cdr old-pkg))
+      (setq package-alist (cons new-pkg-desc
+                                (delq old-pkg package-alist))))
+     ;; You can have two packages with the same version, e.g. one in
+     ;; the system package directory and one in your private
+     ;; directory.  We just let the first one win.
+     ((not (version-list-= (package-desc-vers (cdr old-pkg)) version))
+      ;; The package is born obsolete.
+      (package-mark-obsolete name (cdr new-pkg-desc))))))
 
 ;; From Emacs 22.
 (defun package-autoload-ensure-default-file (file)
@@ -657,10 +660,14 @@ It will move point to somewhere in the headers."
       (kill-buffer tar-buffer))))
 
 (defun package-installed-p (package &optional min-version)
+  "Return true if PACKAGE, of VERSION or newer, is installed.
+Built-in packages also qualify."
   (let ((pkg-desc (assq package package-alist)))
-    (and pkg-desc
-         (version-list-<= min-version
-                          (package-desc-vers (cdr pkg-desc))))))
+    (if pkg-desc
+        (version-list-<= min-version
+                         (package-desc-vers (cdr pkg-desc)))
+      ;; Also check built-in packages.
+      (package-built-in-p package min-version))))
 
 (defun package-compute-transaction (package-list requirements)
   "Return a list of packages to be installed, including PACKAGE-LIST.
@@ -696,8 +703,9 @@ but version %s required"
                           (symbol-name next-pkg) hold
                           (package-version-join next-version)))))
           (unless pkg-desc
-            (error "Package '%s' is not available for installation"
-                   (symbol-name next-pkg)))
+            (error "Package '%s', version %s, unavailable for installation"
+                   (symbol-name next-pkg)
+                   (package-version-join next-version)))
           (unless (version-list-<= next-version
                                    (package-desc-vers (cdr pkg-desc)))
             (error
@@ -1014,24 +1022,21 @@ makes them available for download."
                       (car archive)))))
   (package-read-all-archive-contents))
 
+(defvar package--initialized nil)
+
 ;;;###autoload
-(defun package-initialize ()
+(defun package-initialize (&optional no-activate)
   "Load Emacs Lisp packages, and activate them.
-The variable `package-load-list' controls which packages to load."
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages."
   (interactive)
-  (require 'finder-inf nil t)
-  (setq package-alist package--builtins
-        package-activated-list (mapcar #'car package-alist)
-        package-obsolete-alist nil)
+  (setq package-obsolete-alist nil)
   (package-load-all-descriptors)
   (package-read-all-archive-contents)
-  ;; "Deactivate" obsoleted built-in packages
-  (dolist (elt package-obsolete-alist)
-    (setq package-activated-list
-          (delq (car elt) package-activated-list)))
-  ;; Try to activate all our packages.
-  (dolist (elt package-alist)
-    (package-activate (car elt) (package-desc-vers (cdr elt)))))
+  (unless no-activate
+    (dolist (elt package-alist)
+      (package-activate (car elt) (package-desc-vers (cdr elt)))))
+  (setq package--initialized t))
 
 
 ;;;; Package description buffer.
@@ -1042,11 +1047,13 @@ The variable `package-load-list' controls which packages to load."
   (interactive
    (let* ((guess (function-called-at-point))
           packages val)
-     ;; Initialize the package system if it's not.
-     (unless package-alist
-       (package-initialize))
+     (require 'finder-inf nil t)
+     ;; Load the package list if necessary (but don't activate them).
+     (unless package--initialized
+       (package-initialize t))
      (setq packages (append (mapcar 'car package-alist)
-                            (mapcar 'car package-archive-contents)))
+                            (mapcar 'car package-archive-contents)
+                            (mapcar 'car package--builtins)))
      (unless (memq guess packages)
        (setq guess nil))
      (setq packages (mapcar 'symbol-name packages))
@@ -1057,8 +1064,8 @@ The variable `package-load-list' controls which packages to load."
                               "Describe package: ")
                             packages nil t nil nil guess))
      (list (if (equal val "") guess (intern val)))))
-  (if (or (null package) (null (symbolp package)))
-      (message "You did not specify a package")
+  (if (or (null package) (not (symbolp package)))
+      (message "No package specified")
     (help-setup-xref (list #'describe-package package)
                      (called-interactively-p 'interactive))
     (with-help-window (help-buffer)
@@ -1072,22 +1079,27 @@ The variable `package-load-list' controls which packages to load."
         desc pkg-dir reqs version installable)
     (prin1 package)
     (princ " is ")
-    (if (setq desc (cdr (assq package package-alist)))
-        ;; This package is loaded (i.e. in `package-alist').
-        (progn
-          (setq version (package-version-join (package-desc-vers desc)))
-          (cond ((setq pkg-dir (package--dir package-name version))
-                 (insert "an installed package.\n\n"))
-                (built-in
-                 (princ "a built-in package.\n\n"))
-                (t ;; This normally does not happen.
-                 (insert "a deleted package.\n\n")
-                 (setq version nil))))
-      ;; This package is not installed.
-      (setq desc    (cdr (assq package package-archive-contents))
-            version (package-version-join (package-desc-vers desc))
+    (cond
+     ;; Loaded packages are in `package-alist'.
+     ((setq desc (cdr (assq package package-alist)))
+      (setq version (package-version-join (package-desc-vers desc)))
+      (if (setq pkg-dir (package--dir package-name version))
+          (insert "an installed package.\n\n")
+        ;; This normally does not happen.
+        (insert "a deleted package.\n\n")))
+     ;; Available packages are in `package-archive-contents'.
+     ((setq desc (cdr (assq package package-archive-contents)))
+      (setq version (package-version-join (package-desc-vers desc))
             installable t)
-      (insert "an uninstalled package.\n\n"))
+      (if built-in
+          (insert "a built-in package.\n\n")
+        (insert "an uninstalled package.\n\n")))
+     (built-in
+      (setq desc (cdr built-in)
+            version (package-version-join (package-desc-vers desc)))
+      (insert "a built-in package.\n\n"))
+     (t
+      (insert "an orphan package.\n\n")))
 
     (insert "     " (propertize "Status" 'font-lock-face 'bold) ": ")
     (cond (pkg-dir
@@ -1097,32 +1109,35 @@ The variable `package-load-list' controls which packages to load."
            ;; Todo: Add button for uninstalling.
            (help-insert-xref-button (file-name-as-directory pkg-dir)
                                     'help-package-def pkg-dir)
-           (insert "'."))
+           (if built-in
+               (insert "',\n             shadowing a "
+                       (propertize "built-in package"
+                                   'font-lock-face 'font-lock-builtin-face)
+                       ".")
+             (insert "'.")))
           (installable
-           (insert "Available -- ")
-           (let ((button-text (if (display-graphic-p)
-                                  "Install"
-                                "[Install]"))
+           (if built-in
+               (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)
+                       "  Alternate version available -- ")
+             (insert "Available -- "))
+           (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
+             (insert-text-button button-text 'face button-face 'follow-link t
                                  'package-symbol package
                                  'action 'package-install-button-action)))
           (built-in
-           (insert (propertize "Built-in"
-                               'font-lock-face 'font-lock-builtin-face) "."))
+           (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)))
           (t (insert "Deleted.")))
     (insert "\n")
-    (and version
-         (> (length version) 0)
+    (and version (> (length version) 0)
          (insert "    "
                  (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
-    (setq reqs (package-desc-reqs desc))
+
+    (setq reqs (if desc (package-desc-reqs desc)))
     (when reqs
       (insert "   " (propertize "Requires" 'font-lock-face 'bold) ": ")
       (let ((first t)
@@ -1140,9 +1155,9 @@ The variable `package-load-list' controls which packages to load."
           (help-insert-xref-button text 'help-package name))
         (insert "\n")))
     (insert "    " (propertize "Summary" 'font-lock-face 'bold)
-            ": " (package-desc-doc desc) "\n\n")
+            ": " (if desc (package-desc-doc desc)) "\n\n")
 
-    (if (assq package package--builtins)
+    (if built-in
         ;; For built-in packages, insert the commentary.
         (let ((fn (locate-file (concat package-name ".el") load-path
                                load-file-rep-suffixes))
@@ -1477,31 +1492,36 @@ A value of nil means to display all packages.")
 
 (defun package--generate-package-list ()
   "Populate the current Package Menu buffer."
-  (package-initialize)
   (let ((inhibit-read-only t)
         info-list name desc hold builtin)
     (erase-buffer)
     ;; List installed packages
     (dolist (elt package-alist)
       (setq name (car elt))
-      (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
-                 (or (null package-menu-package-list)
-                     (memq name package-menu-package-list)))
+      (when (or (null package-menu-package-list)
+                (memq name package-menu-package-list))
         (setq desc (cdr elt)
-              hold (cadr (assq name package-load-list))
-              builtin (cdr (assq name package--builtins)))
+              hold (cadr (assq name package-load-list)))
         (setq info-list
               (package-list-maybe-add
                name (package-desc-vers desc)
                ;; FIXME: it turns out to be tricky to see if this
                ;; package is presently activated.
-               (cond ((stringp hold) "held")
-                     ((and builtin
-                           (version-list-=
-                            (package-desc-vers builtin)
-                            (package-desc-vers desc)))
-                      "built-in")
-                     (t "installed"))
+               (if (stringp hold) "held" "installed")
+               (package-desc-doc desc)
+               info-list))))
+
+    ;; List built-in packages
+    (dolist (elt package--builtins)
+      (setq name (car elt))
+      (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+                 (or (null package-menu-package-list)
+                     (memq name package-menu-package-list)))
+        (setq desc (cdr elt))
+        (setq info-list
+              (package-list-maybe-add
+               name (package-desc-vers desc)
+               "built-in"
                (package-desc-doc desc)
                info-list))))
 
@@ -1607,6 +1627,7 @@ A value of nil means to display all packages.")
   "Generate and pop to the *Packages* buffer.
 Optional PACKAGES is a list of names of packages (symbols) to
 list; the default is to display everything in `package-alist'."
+  (require 'finder-inf nil t)
   (with-current-buffer (get-buffer-create "*Packages*")
     (package-menu-mode)
     (set (make-local-variable 'package-menu-package-list) packages)
@@ -1624,8 +1645,8 @@ Fetches the updated list of packages before displaying.
 The list is displayed in a buffer named `*Packages*'."
   (interactive)
   ;; Initialize the package system if necessary.
-  (unless package-alist
-    (package-initialize))
+  (unless package--initialized
+    (package-initialize t))
   (package-refresh-contents)
   (package--list-packages))