# HG changeset patch # User Chong Yidong # Date 1288754736 14400 # Node ID 27839df805b070edbdd460382fb7b7b796c2e524 # Parent 0b85687890f84e9bdec26848dcf1627e30679662 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. diff -r 0b85687890f8 -r 27839df805b0 lisp/ChangeLog --- a/lisp/ChangeLog Tue Nov 02 20:25:23 2010 -0700 +++ b/lisp/ChangeLog Tue Nov 02 23:25:36 2010 -0400 @@ -1,3 +1,27 @@ +2010-11-03 Chong Yidong + + * 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 * progmodes/perl-mode.el (perl-syntax-propertize-function): diff -r 0b85687890f8 -r 27839df805b0 lisp/emacs-lisp/package.el --- a/lisp/emacs-lisp/package.el Tue Nov 02 20:25:23 2010 -0700 +++ b/lisp/emacs-lisp/package.el Tue Nov 02 23:25:36 2010 -0400 @@ -329,7 +329,9 @@ (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 @@ ;; 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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ "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 @@ 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 @@ ;; 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 @@ (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 @@ (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 @@ "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 @@ 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))