procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Chong Yidong 2010-11-02 23:25:36 -04:00
parent 73ab9865e6
commit 4b99edf23f
2 changed files with 176 additions and 131 deletions
Download patch file Download diff file Expand all files Collapse all files

283
lisp/emacs-lisp/package.el
View file

@ -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))