1 ;;; package.el --- Simple package system for Emacs
3 ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Tom Tromey <tromey@redhat.com>
6 ;; Created: 10 Mar 2007
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 3, or (at your option)
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
29 ;; 2 Apr 2007 - now using ChangeLog file
30 ;; 15 Mar 2007 - updated documentation
31 ;; 14 Mar 2007 - Changed how obsolete packages are handled
32 ;; 13 Mar 2007 - Wrote package-install-from-buffer
33 ;; 12 Mar 2007 - Wrote package-menu mode
37 ;; The idea behind package.el is to be able to download packages and
38 ;; install them. Packages are versioned and have versioned
39 ;; dependencies. Furthermore, this supports built-in packages which
40 ;; may or may not be newer than user-specified packages. This makes
41 ;; it possible to upgrade Emacs and automatically disable packages
42 ;; which have moved from external to core. (Note though that we don't
43 ;; currently register any of these, so this feature does not actually
46 ;; This code supports a single package repository, ELPA. All packages
47 ;; must be registered there.
49 ;; A package is described by its name and version. The distribution
50 ;; format is either a tar file or a single .el file.
52 ;; A tar file should be named "NAME-VERSION.tar". The tar file must
53 ;; unpack into a directory named after the package and version:
54 ;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el"
55 ;; which consists of a call to define-package. It may also contain a
56 ;; "dir" file and the info files it references.
58 ;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be
59 ;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
61 ;; The downloader will download all dependent packages. It will also
62 ;; byte-compile the package's lisp at install time.
64 ;; At activation time we will set up the load-path and the info path,
65 ;; and we will load the package's autoloads. If a package's
66 ;; dependencies are not available, we will not activate that package.
68 ;; Conceptually a package has multiple state transitions:
70 ;; * Download. Fetching the package from ELPA.
71 ;; * Install. Untar the package, or write the .el file, into
72 ;; ~/.emacs.d/elpa/ directory.
73 ;; * Byte compile. Currently this phase is done during install,
74 ;; but we may change this.
75 ;; * Activate. Evaluate the autoloads for the package to make it
76 ;; available to the user.
77 ;; * Load. Actually load the package and run some code from it.
79 ;; Other external functions you may want to use:
81 ;; M-x package-list-packages
82 ;; Enters a mode similar to buffer-menu which lets you manage
83 ;; packages. You can choose packages for install (mark with "i",
84 ;; then "x" to execute) or deletion (not implemented yet), and you
85 ;; can see what packages are available. This will automatically
86 ;; fetch the latest list of packages from ELPA.
88 ;; M-x package-list-packages-no-fetch
89 ;; Like package-list-packages, but does not automatically fetch the
90 ;; new list of packages.
92 ;; M-x package-install-from-buffer
93 ;; Install a package consisting of a single .el file that appears
94 ;; in the current buffer. This only works for packages which
95 ;; define a Version header properly; package.el also supports the
96 ;; extension headers Package-Version (in case Version is an RCS id
97 ;; or similar), and Package-Requires (if the package requires other
100 ;; M-x package-install-file
101 ;; Install a package from the indicated file. The package can be
102 ;; either a tar file or a .el file. A tar file must contain an
103 ;; appropriately-named "-pkg.el" file; a .el file must be properly
104 ;; formatted as with package-install-from-buffer.
107 ;;; (sorted by sort-lines):
109 ;; Jim Blandy <jimb@red-bean.com>
110 ;; Karl Fogel <kfogel@red-bean.com>
111 ;; Kevin Ryde <user42@zip.com.au>
113 ;; Michael Olson <mwolson@member.fsf.org>
114 ;; Sebastian Tennant <sebyte@smolny.plus.com>
115 ;; Stefan Monnier <monnier@iro.umontreal.ca>
116 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
117 ;; Phil Hagelberg <phil@hagelb.org>
121 ;; - putting info dirs at the start of the info path means
122 ;; users see a weird ordering of categories. OTOH we want to
123 ;; override later entries. maybe emacs needs to enforce
124 ;; the standard layout?
125 ;; - put bytecode in a separate directory tree
126 ;; - perhaps give users a way to recompile their bytecode
127 ;; or do it automatically when emacs changes
128 ;; - give users a way to know whether a package is installed ok
129 ;; - give users a way to view a package's documentation when it
130 ;; only appears in the .el
131 ;; - use/extend checkdoc so people can tell if their package will work
132 ;; - "installed" instead of a blank in the status column
133 ;; - tramp needs its files to be compiled in a certain order.
134 ;; how to handle this? fix tramp?
135 ;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22?
136 ;; - maybe we need separate .elc directories for various emacs versions
137 ;; and also emacs-vs-xemacs. That way conditional compilation can
138 ;; work. But would this break anything?
139 ;; - should store the package's keywords in archive-contents, then
140 ;; let the users filter the package-menu by keyword. See
141 ;; finder-by-keyword. (We could also let people view the
142 ;; Commentary, but it isn't clear how useful this is.)
143 ;; - William Xu suggests being able to open a package file without
145 ;; - Interface with desktop.el so that restarting after an install
147 ;; - Implement M-x package-upgrade, to upgrade any/all existing packages
148 ;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
149 ;; ... except maybe lisp?
150 ;; - It may be nice to have a macro that expands to the package's
151 ;; private data dir, aka ".../etc". Or, maybe data-directory
152 ;; needs to be a list (though this would be less nice)
153 ;; a few packages want this, eg sokoban
154 ;; - package menu needs:
155 ;; ability to know which packages are built-in & thus not deletable
156 ;; it can sometimes print odd results, like 0.3 available but 0.4 active
158 ;; - Allow multiple versions on the server...?
160 ;; - Don't install a package which will invalidate dependencies overall
161 ;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
162 ;; [ currently thinking, why bother.. KISS ]
163 ;; - Allow optional package dependencies
164 ;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
165 ;; and just don't compile to add to load path ...?
166 ;; - Have a list of archive URLs? [ maybe there's no point ]
167 ;; - David Kastrup pointed out on the xemacs list that for GPL it
168 ;; is friendlier to ship the source tree. We could "support" that
169 ;; by just having a "src" subdir in the package. This isn't ideal
170 ;; but it probably is not worth trying to support random source
171 ;; tree layouts, build schemes, etc.
172 ;; - Our treatment of the info path is somewhat bogus
173 ;; - perhaps have an "unstable" tree in ELPA as well as a stable one
177 (defgroup package nil
178 "Manager for Emacs Lisp packages."
183 (defcustom package-enable-at-startup t
184 "Whether to activate installed packages when Emacs starts.
185 If non-nil, packages are activated after reading the init file
186 and before `after-init-hook'. Activation is not done if
187 `user-init-file' is nil (e.g. Emacs was started with \"-q\").
189 Even if the value is nil, you can type \\[package-initialize] to
190 activate the package system at any time."
195 (defcustom package-load-list '(all)
196 "List of packages for `package-initialize' to load.
197 Each element in this list should be a list (NAME VERSION), or the
198 symbol `all'. The symbol `all' says to load the latest installed
199 versions of all packages not specified by other elements.
201 For an element (NAME VERSION), NAME is a package name (a symbol).
202 VERSION should be t, a string, or nil.
203 If VERSION is t, all versions are loaded, though obsolete ones
204 will be put in `package-obsolete-alist' and not activated.
205 If VERSION is a string, only that version is ever loaded.
206 Any other version, even if newer, is silently ignored.
207 Hence, the package is \"held\" at that version.
208 If VERSION is nil, the package is not loaded (it is \"disabled\")."
209 :type '(repeat symbol)
213 (defvar Info-directory-list)
214 (defvar gnus-article-buffer)
215 (declare-function info-initialize "info" ())
216 (declare-function url-http-parse-response "url-http" ())
217 (declare-function lm-header "lisp-mnt" (header))
218 (declare-function lm-commentary "lisp-mnt" (&optional file))
219 (declare-function dired-delete-file "dired" (file &optional recursive trash))
221 (defconst package-archive-base "http://elpa.gnu.org/packages/"
222 "Base URL for the Emacs Lisp Package Archive (ELPA).
223 Ordinarily you should not need to change this.
224 Note that some code in package.el assumes that this is an http: URL.")
226 (defconst package-archive-version 1
227 "Version number of the package archive understood by this file.
228 Lower version numbers than this will probably be understood as well.")
230 (defconst package-el-version "1.0"
231 "Version of package.el.")
233 ;; We don't prime the cache since it tends to get out of date.
234 (defvar package-archive-contents nil
235 "Cache of the contents of the Emacs Lisp Package Archive.
236 This is an alist mapping package names (symbols) to package
237 descriptor vectors. These are like the vectors for `package-alist'
238 but have an extra entry which is 'tar for tar packages and
239 'single for single-file packages.")
241 (defcustom package-user-dir (locate-user-emacs-file "elpa")
242 "Directory containing the user's Emacs Lisp packages.
243 The directory name should be absolute.
244 Apart from this directory, Emacs also looks for system-wide
245 packages in `package-directory-list'."
250 (defcustom package-directory-list
251 ;; Defaults are subdirs named "elpa" in the site-lisp dirs.
253 (dolist (f load-path)
254 (if (equal (file-name-nondirectory f) "site-lisp")
255 (push (expand-file-name "elpa" f) result)))
257 "List of additional directories containing Emacs Lisp packages.
258 Each directory name should be absolute.
260 These directories contain packages intended for system-wide; in
261 contrast, `package-user-dir' contains packages for personal use."
262 :type '(repeat directory)
266 (defun package-version-split (string)
267 "Split a package string into a version list."
268 (mapcar 'string-to-int (split-string string "[.]")))
270 (defconst package--builtins-base
271 ;; We use package-version split here to make sure to pick up the
273 `((emacs . [,(package-version-split emacs-version) nil
275 (package . [,(package-version-split package-el-version)
276 nil "Simple package system for GNU Emacs"]))
277 "Packages which are always built-in.")
279 (defvar package--builtins
282 package--builtins-base
283 (if (>= emacs-major-version 22)
284 ;; FIXME: emacs 22 includes tramp, rcirc, maybe
286 '((erc . [(5 2) nil "An Emacs Internet Relay Chat client"])
287 ;; The external URL is version 1.15, so make sure the
288 ;; built-in one looks newer.
289 (url . [(1 16) nil "URL handling libary"])))
290 (if (>= emacs-major-version 23)
291 '(;; Strangely, nxml-version is missing in Emacs 23.
292 ;; We pick the merge date as the version.
293 (nxml . [(20071123) nil "Major mode for editing XML documents."])
294 (bubbles . [(0 5) nil "Puzzle game for Emacs."])))))
295 "Alist of all built-in packages.
296 Maps the package name to a vector [VERSION REQS DOCSTRING].")
298 (defvar package-alist package--builtins
299 "Alist of all packages available for activation.
300 This maps the package name to a vector [VERSION REQS DOCSTRING].
302 The value is generated by `package-load-descriptor', usually
303 called via `package-initialize'. For user customizations of
304 which packages to load/activate, see `package-load-list'.")
306 (defvar package-activated-list
307 (mapcar #'car package-alist)
308 "List of the names of currently activated packages.")
310 (defvar package-obsolete-alist nil
311 "Representation of obsolete packages.
312 Like `package-alist', but maps package name to a second alist.
313 The inner alist is keyed by version.")
315 (defconst package-subdirectory-regexp
316 "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$"
317 "Regular expression matching the name of a package subdirectory.
318 The first subexpression is the package name.
319 The second subexpression is the version string.")
321 (defun package-version-join (l)
322 "Turn a list of version numbers into a version string."
323 (mapconcat 'int-to-string l "."))
325 (defun package--version-first-nonzero (l)
326 (while (and l (= (car l) 0))
330 (defun package-version-compare (v1 v2 fun)
331 "Compare two version lists according to FUN.
332 FUN can be <, <=, =, >, >=, or /=."
333 (while (and v1 v2 (= (car v1) (car v2)))
338 ;; Both not null; we know the cars are not =.
339 (funcall fun (car v1) (car v2))
340 ;; V1 not null, V2 null.
341 (funcall fun (package--version-first-nonzero v1) 0))
343 ;; V1 null, V2 not null.
344 (funcall fun 0 (package--version-first-nonzero v2))
348 (defun package--test-version-compare ()
349 "Test suite for `package-version-compare'."
350 (unless (and (package-version-compare '(0) '(0) '=)
351 (not (package-version-compare '(1) '(0) '=))
352 (package-version-compare '(1 0 1) '(1) '>=)
353 (package-version-compare '(1 0 1) '(1) '>)
354 (not (package-version-compare '(0 9 1) '(1 0 2) '>=)))
358 (defun package-strip-version (dirname)
359 "Strip the version from a combined package name and version.
360 E.g., if given \"quux-23.0\", will return \"quux\""
361 (if (string-match package-subdirectory-regexp dirname)
362 (match-string 1 dirname)))
364 (defun package-load-descriptor (dir package)
365 "Load the description file for a package.
366 DIR is the directory in which to find the package subdirectory,
367 and PACKAGE is the name of the package subdirectory.
368 Return nil if the package could not be found."
369 (let ((pkg-dir (expand-file-name package dir)))
370 (if (file-directory-p pkg-dir)
371 (load (expand-file-name (concat (package-strip-version package)
376 (defun package-load-all-descriptors ()
377 "Load descriptors for installed Emacs Lisp packages.
378 This looks for package subdirectories in `package-user-dir' and
379 `package-directory-list'. The variable `package-load-list'
380 controls which package subdirectories may be loaded.
382 In each valid package subdirectory, this function loads the
383 description file containing a call to `define-package', which
384 updates `package-alist' and `package-obsolete-alist'."
385 (let ((all (memq 'all package-load-list))
387 (dolist (dir (cons package-user-dir package-directory-list))
388 (when (file-directory-p dir)
389 (dolist (subdir (directory-files dir))
390 (when (and (file-directory-p (expand-file-name subdir dir))
391 (string-match package-subdirectory-regexp subdir))
392 (setq name (intern (match-string 1 subdir))
393 version (match-string 2 subdir)
394 force (assq name package-load-list))
397 all) ; not in package-load-list
398 ((null (setq force (cadr force)))
402 ((stringp force) ; held
403 (package-version-compare (package-version-split version)
404 (package-version-split force)
407 (error "Invalid element in `package-load-list'")))
408 (package-load-descriptor dir subdir))))))))
410 (defsubst package-desc-vers (desc)
411 "Extract version from a package description vector."
414 (defsubst package-desc-reqs (desc)
415 "Extract requirements from a package description vector."
418 (defsubst package-desc-doc (desc)
419 "Extract doc string from a package description vector."
422 (defsubst package-desc-kind (desc)
423 "Extract the kind of download from an archive package description vector."
426 (defun package-activate-1 (package pkg-vec)
427 (let* ((pkg-name (symbol-name package))
428 (pkg-ver-str (package-version-join (package-desc-vers pkg-vec)))
429 (dir-list (cons package-user-dir package-directory-list))
432 (let ((subdir (expand-file-name (concat pkg-name "-" pkg-ver-str)
434 (if (file-directory-p subdir)
436 (setq pkg-dir subdir)
438 (setq dir-list (cdr dir-list)))))
440 (error "Internal error: could not find directory for %s-%s"
441 pkg-name pkg-ver-str))
442 (if (file-exists-p (expand-file-name "dir" pkg-dir))
444 ;; FIXME: not the friendliest, but simple.
447 (setq Info-directory-list (cons pkg-dir Info-directory-list))))
448 (setq load-path (cons pkg-dir load-path))
449 ;; Load the autoloads and activate the package.
450 (load (expand-file-name (concat (symbol-name package) "-autoloads")
453 (setq package-activated-list (cons package package-activated-list))
457 (defun package--built-in (package version)
458 "Return true if the package is built-in to Emacs."
459 (let ((elt (assq package package--builtins)))
461 (package-version-compare (package-desc-vers (cdr elt)) version '=))))
463 ;; FIXME: return a reason instead?
464 (defun package-activate (package version)
465 "Activate a package, and recursively activate its dependencies.
466 Return nil if the package could not be activated."
467 ;; Assume the user knows what he is doing -- go ahead and activate a
468 ;; newer version of a package if an older one has already been
469 ;; activated. This is not ideal; we'd at least need to check to see
470 ;; if the package has actually been loaded, and not merely
471 ;; activated. However, don't try to activate 'emacs', as that makes
473 (unless (eq package 'emacs)
474 (let* ((pkg-desc (assq package package-alist))
475 (this-version (package-desc-vers (cdr pkg-desc)))
476 (req-list (package-desc-reqs (cdr pkg-desc)))
477 ;; If the package was never activated, we want to do it
479 (keep-going (or (not (memq package package-activated-list))
480 (package-version-compare this-version version '>))))
481 (while (and req-list keep-going)
482 (let* ((req (car req-list))
484 (req-version (cadr req)))
485 (or (package-activate req-name req-version)
486 (setq keep-going nil)))
487 (setq req-list (cdr req-list)))
489 (package-activate-1 package (cdr pkg-desc))
490 ;; We get here if a dependency failed to activate -- but we
491 ;; can also get here if the requested package was already
492 ;; activated. Return non-nil in the latter case.
493 (and (memq package package-activated-list)
494 (package-version-compare this-version version '>=))))))
496 (defun package-mark-obsolete (package pkg-vec)
497 "Put package on the obsolete list, if not already there."
498 (let ((elt (assq package package-obsolete-alist)))
500 ;; If this obsolete version does not exist in the list, update
502 (unless (assoc (package-desc-vers pkg-vec) (cdr elt))
503 (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
505 ;; Make a new association.
506 (setq package-obsolete-alist
507 (cons (cons package (list (cons (package-desc-vers pkg-vec)
509 package-obsolete-alist)))))
511 ;; (define-package "emacs" "21.4.1" "GNU Emacs core package.")
512 ;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0")))
513 (defun define-package (name-str version-string
514 &optional docstring requirements)
515 "Define a new package.
516 NAME is the name of the package, a string.
517 VERSION-STRING is the version of the package, a dotted sequence
519 DOCSTRING is the optional description.
520 REQUIREMENTS is a list of requirements on other packages.
521 Each requirement is of the form (OTHER-PACKAGE \"VERSION\")."
522 (let* ((name (intern name-str))
523 (pkg-desc (assq name package-alist))
524 (new-version (package-version-split version-string))
531 (package-version-split (car (cdr elt)))))
534 ;; Only redefine a package if the redefinition is newer.
535 (if (or (not pkg-desc)
536 (package-version-compare new-version
537 (package-desc-vers (cdr pkg-desc))
541 ;; Remove old package and declare it obsolete.
542 (setq package-alist (delq pkg-desc package-alist))
543 (package-mark-obsolete (car pkg-desc) (cdr pkg-desc)))
544 ;; Add package to the alist.
545 (setq package-alist (cons new-pkg-desc package-alist)))
546 ;; You can have two packages with the same version, for instance
547 ;; one in the system package directory and one in your private
548 ;; directory. We just let the first one win.
549 (unless (package-version-compare new-version
550 (package-desc-vers (cdr pkg-desc))
552 ;; The package is born obsolete.
553 (package-mark-obsolete (car new-pkg-desc) (cdr new-pkg-desc))))))
556 (defun package-autoload-ensure-default-file (file)
557 "Make sure that the autoload file FILE exists and if not create it."
558 (unless (file-exists-p file)
560 (concat ";;; " (file-name-nondirectory file)
561 " --- automatically extracted autoloads\n"
564 "
\f\n;; Local Variables:\n"
565 ";; version-control: never\n"
566 ";; no-byte-compile: t\n"
567 ";; no-update-autoloads: t\n"
569 ";;; " (file-name-nondirectory file)
574 (defun package-generate-autoloads (name pkg-dir)
575 (let* ((auto-name (concat name "-autoloads.el"))
576 (ignore-name (concat name "-pkg.el"))
577 (generated-autoload-file (expand-file-name auto-name pkg-dir))
578 (version-control 'never))
580 (unless (fboundp 'autoload-ensure-default-file)
581 (package-autoload-ensure-default-file generated-autoload-file))
582 (update-directory-autoloads pkg-dir)))
584 (defun package-untar-buffer ()
585 "Untar the current buffer.
586 This uses `tar-untar-buffer' if it is available.
587 Otherwise it uses an external `tar' program.
588 `default-directory' should be set by the caller."
590 (if (fboundp 'tar-untar-buffer)
592 ;; tar-mode messes with narrowing, so we just let it have the
593 ;; whole buffer to play with.
594 (delete-region (point-min) (point))
597 ;; FIXME: check the result.
598 (call-process-region (point) (point-max) "tar" nil '(nil nil) nil
601 (defun package-unpack (name version)
602 (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version)
605 (make-directory package-user-dir t)
606 (if (file-directory-p pkg-dir)
607 (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're
609 (directory-files pkg-dir t "^[^.]")))
610 (let* ((default-directory (file-name-as-directory package-user-dir)))
611 (package-untar-buffer)
612 (package-generate-autoloads (symbol-name name) pkg-dir)
613 (let ((load-path (cons pkg-dir load-path)))
614 (byte-recompile-directory pkg-dir 0 t)))))
616 (defun package-unpack-single (file-name version desc requires)
617 "Install the contents of the current buffer as a package."
618 ;; Special case "package".
619 (if (string= file-name "package")
620 (write-region (point-min) (point-max)
621 (expand-file-name (concat file-name ".el")
624 (let* ((pkg-dir (expand-file-name (concat file-name "-" version)
626 (el-file (expand-file-name (concat file-name ".el") pkg-dir))
627 (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
628 (make-directory pkg-dir t)
629 (write-region (point-min) (point-max) el-file nil nil nil 'excl)
630 (let ((print-level nil)
635 (list 'define-package
640 ;; Turn version lists into string form.
644 (package-version-join (car (cdr elt)))))
650 (package-generate-autoloads file-name pkg-dir)
651 (let ((load-path (cons pkg-dir load-path)))
652 (byte-recompile-directory pkg-dir 0 t)))))
654 (defun package-handle-response ()
655 "Handle the response from the server.
656 Parse the HTTP response and throw if an error occurred.
657 The url package seems to require extra processing for this.
658 This should be called in a `save-excursion', in the download buffer.
659 It will move point to somewhere in the headers."
660 ;; We assume HTTP here.
662 (let ((response (url-http-parse-response)))
663 (when (or (< response 200) (>= response 300))
664 (display-buffer (current-buffer))
665 (error "Error during download request:%s"
666 (buffer-substring-no-properties (point) (progn
670 (defun package-download-single (name version desc requires)
671 "Download and install a single-file package."
672 (let ((buffer (url-retrieve-synchronously
673 (concat package-archive-base
674 (symbol-name name) "-" version ".el"))))
675 (with-current-buffer buffer
676 (package-handle-response)
677 (re-search-forward "^$" nil 'move)
679 (delete-region (point-min) (point))
680 (package-unpack-single (symbol-name name) version desc requires)
681 (kill-buffer buffer))))
683 (defun package-download-tar (name version)
684 "Download and install a tar package."
685 (let ((tar-buffer (url-retrieve-synchronously
686 (concat package-archive-base
687 (symbol-name name) "-" version ".tar"))))
688 (with-current-buffer tar-buffer
689 (package-handle-response)
690 (re-search-forward "^$" nil 'move)
692 (package-unpack name version)
693 (kill-buffer tar-buffer))))
695 (defun package-installed-p (package version)
696 (let ((pkg-desc (assq package package-alist)))
698 (package-version-compare version
699 (package-desc-vers (cdr pkg-desc))
702 (defun package-compute-transaction (result requirements)
703 (dolist (elt requirements)
704 (let* ((next-pkg (car elt))
705 (next-version (cadr elt)))
706 (unless (package-installed-p next-pkg next-version)
707 ;; A package is required, but not installed. It might also be
708 ;; blocked via `package-load-list'.
709 (let ((pkg-desc (assq next-pkg package-archive-contents))
711 (when (setq hold (assq next-pkg package-load-list))
712 (setq hold (cadr hold))
714 (error "Required package '%s' is disabled"
715 (symbol-name next-pkg)))
716 ((null (stringp hold))
717 (error "Invalid element in `package-load-list'"))
718 ((package-version-compare next-version
719 (package-version-split hold)
721 (error "Package '%s' held at version %s, \
722 but version %s required"
723 (symbol-name next-pkg) hold
724 (package-version-join next-version)))))
726 (error "Package '%s' is not available for installation"
727 (symbol-name next-pkg)))
728 (unless (package-version-compare (package-desc-vers (cdr pkg-desc))
732 "Need package '%s' with version %s, but only %s is available"
733 (symbol-name next-pkg) (package-version-join next-version)
734 (package-version-join (package-desc-vers (cdr pkg-desc)))))
735 ;; Only add to the transaction if we don't already have it.
736 (unless (memq next-pkg result)
737 (setq result (cons next-pkg result)))
739 (package-compute-transaction result
741 (cdr pkg-desc))))))))
744 (defun package-read-from-string (str)
745 "Read a Lisp expression from STR.
746 Signal an error if the entire string was not used."
747 (let* ((read-data (read-from-string str))
750 ;; The call to `ignore' suppresses a compiler warning.
751 (progn (ignore (read-from-string
752 (substring str (cdr read-data))))
756 (error "Can't read whole string")
759 (defun package--read-archive-file (file)
760 "Re-read archive file FILE, if it exists.
761 Will return the data from the file, or nil if the file does not exist.
762 Will throw an error if the archive version is too new."
763 (let ((filename (expand-file-name file package-user-dir)))
764 (if (file-exists-p filename)
766 (insert-file-contents-literally filename)
767 (let ((contents (package-read-from-string
768 (buffer-substring-no-properties (point-min)
770 (if (> (car contents) package-archive-version)
771 (error "Package archive version %d is greater than %d - upgrade package.el"
772 (car contents) package-archive-version))
775 (defun package-read-archive-contents ()
776 "Re-read `archive-contents' and `builtin-packages', if they exist.
777 Set `package-archive-contents' and `package--builtins' if successful.
778 Throw an error if the archive version is too new."
779 (let ((archive-contents (package--read-archive-file "archive-contents"))
780 (builtins (package--read-archive-file "builtin-packages")))
782 ;; Version 1 of 'archive-contents' is identical to our
783 ;; internal representation.
784 (setq package-archive-contents archive-contents))
786 ;; Version 1 of 'builtin-packages' is a list where the car is
787 ;; a split emacs version and the cdr is an alist suitable for
788 ;; package--builtins.
789 (let ((our-version (package-version-split emacs-version))
790 (result package--builtins-base))
791 (setq package--builtins
792 (dolist (elt builtins result)
793 (if (package-version-compare our-version (car elt) '>=)
794 (setq result (append (cdr elt) result)))))))))
796 (defun package-download-transaction (transaction)
797 "Download and install all the packages in the given transaction."
798 (dolist (elt transaction)
799 (let* ((desc (cdr (assq elt package-archive-contents)))
800 ;; As an exception, if package is "held" in
801 ;; `package-load-list', download the held version.
802 (hold (cadr (assq elt package-load-list)))
803 (v-string (or (and (stringp hold) hold)
804 (package-version-join (package-desc-vers desc))))
805 (kind (package-desc-kind desc)))
808 (package-download-tar elt v-string))
810 (package-download-single elt v-string
811 (package-desc-doc desc)
812 (package-desc-reqs desc)))
814 (error "Unknown package kind: %s" (symbol-name kind)))))))
817 (defun package-install (name)
818 "Install the package named NAME.
819 Interactively, prompt for the package name.
820 The package is found on the archive site, see `package-archive-base'."
823 ;; Make sure we're using the most recent download of the
824 ;; archive. Maybe we should be updating the archive first?
825 (package-read-archive-contents)
826 (intern (completing-read "Install package: "
827 (mapcar (lambda (elt)
828 (cons (symbol-name (car elt))
830 package-archive-contents)
832 (let ((pkg-desc (assq name package-archive-contents)))
834 (error "Package '%s' not available for installation"
837 (package-compute-transaction (list name)
838 (package-desc-reqs (cdr pkg-desc)))))
839 (package-download-transaction transaction)))
840 ;; Try to activate it.
841 (package-initialize))
843 (defun package-strip-rcs-id (v-str)
844 "Strip RCS version ID from the version string.
845 If the result looks like a dotted numeric version, return it.
846 Otherwise return nil."
848 (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str)
849 (match-string 1 v-str)
850 (if (string-match "^[0-9.]*$" v-str)
853 (defun package-buffer-info ()
854 "Return a vector of information about the package in the current buffer.
855 The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
856 FILENAME is the file name, a string. It does not have the \".el\" extension.
857 REQUIRES is a requires list, or nil.
858 DESCRIPTION is the package description (a string).
859 VERSION is the version, a string.
860 COMMENTARY is the commentary section, a string, or nil if none.
861 Throws an exception if the buffer does not contain a conforming package.
862 If there is a package, narrows the buffer to the file's boundaries.
863 May narrow buffer or move point even on failure."
864 (goto-char (point-min))
865 (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
866 (let ((file-name (match-string 1))
867 (desc (match-string 2))
868 (start (progn (beginning-of-line) (point))))
869 (if (search-forward (concat ";;; " file-name ".el ends here"))
871 ;; Try to include a trailing newline.
873 (narrow-to-region start (point))
875 ;; Use some headers we've invented to drive the process.
876 (let* ((requires-str (lm-header "package-requires"))
877 (requires (if requires-str
878 (package-read-from-string requires-str)))
879 ;; Prefer Package-Version, because if it is
880 ;; defined the package author probably wants us
881 ;; to use it. Otherwise try Version.
883 (or (package-strip-rcs-id (lm-header "package-version"))
884 (package-strip-rcs-id (lm-header "version"))))
885 (commentary (lm-commentary)))
888 "Package does not define a usable \"Version\" or \"Package-Version\" header"))
889 ;; Turn string version numbers into list form.
894 (package-version-split (car (cdr elt)))))
896 (set-text-properties 0 (length file-name) nil file-name)
897 (set-text-properties 0 (length pkg-version) nil pkg-version)
898 (set-text-properties 0 (length desc) nil desc)
899 (vector file-name requires desc pkg-version commentary)))
900 (error "Package missing a terminating comment")))
901 (error "No starting comment for package")))
903 (defun package-tar-file-info (file)
904 "Find package information for a tar file.
905 FILE is the name of the tar file to examine.
906 The return result is a vector like `package-buffer-info'."
907 (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file)
908 (error "`%s' doesn't have a package-ish name" file))
909 (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file)))
910 (pkg-version (match-string-no-properties 2 file))
911 ;; Extract the package descriptor.
912 (pkg-def-contents (shell-command-to-string
914 (concat "tar -xOf " file " "
915 pkg-name "-" pkg-version "/"
916 pkg-name "-pkg.el")))
917 (pkg-def-parsed (package-read-from-string pkg-def-contents)))
918 (unless (eq (car pkg-def-parsed) 'define-package)
919 (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name))
920 (let ((name-str (nth 1 pkg-def-parsed))
921 (version-string (nth 2 pkg-def-parsed))
922 (docstring (nth 3 pkg-def-parsed))
923 (requires (nth 4 pkg-def-parsed))
925 (readme (shell-command-to-string
927 (concat "tar -xOf " file " "
928 pkg-name "-" pkg-version "/README"))))
929 (unless (equal pkg-version version-string)
930 (error "Inconsistent versions!"))
931 (unless (equal pkg-name name-str)
932 (error "Inconsistent names!"))
934 (if (string-match ": Not found in archive" readme)
936 ;; Turn string version numbers into list form.
937 (if (eq (car requires) 'quote)
938 (setq requires (car (cdr requires))))
943 (package-version-split (car (cdr elt)))))
945 (vector pkg-name requires docstring version-string readme))))
947 (defun package-install-buffer-internal (pkg-info type)
950 (let* ((file-name (aref pkg-info 0))
951 (requires (aref pkg-info 1))
952 (desc (if (string= (aref pkg-info 2) "")
953 "No description available."
955 (pkg-version (aref pkg-info 3)))
956 ;; Download and install the dependencies.
957 (let ((transaction (package-compute-transaction nil requires)))
958 (package-download-transaction transaction))
959 ;; Install the package itself.
962 (package-unpack-single file-name pkg-version desc requires))
964 (package-unpack (intern file-name) pkg-version))
966 (error "Unknown type: %s" (symbol-name type))))
967 ;; Try to activate it.
968 (package-initialize)))))
971 (defun package-install-from-buffer ()
972 "Install a package from the current buffer.
973 The package is assumed to be a single .el file which
974 follows the elisp comment guidelines; see
975 info node `(elisp)Library Headers'."
977 (package-install-buffer-internal (package-buffer-info) 'single))
980 (defun package-install-file (file)
981 "Install a package from a file.
982 The file can either be a tar file or an Emacs Lisp file."
983 (interactive "fPackage file name: ")
985 (insert-file-contents-literally file)
987 ((string-match "\\.el$" file) (package-install-from-buffer))
988 ((string-match "\\.tar$" file)
989 (package-install-buffer-internal (package-tar-file-info file) 'tar))
990 (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
992 (defun package-delete (name version)
993 (require 'dired) ; for dired-delete-file
994 (dired-delete-file (expand-file-name (concat name "-" version)
996 ;; FIXME: query user?
999 (defun package--download-one-archive (file)
1000 "Download a single archive file and cache it locally."
1001 (let ((buffer (url-retrieve-synchronously
1002 (concat package-archive-base file))))
1003 (with-current-buffer buffer
1004 (package-handle-response)
1005 (re-search-forward "^$" nil 'move)
1007 (delete-region (point-min) (point))
1008 (setq buffer-file-name (concat (file-name-as-directory package-user-dir)
1010 (let ((version-control 'never))
1012 (kill-buffer buffer))))
1014 (defun package-refresh-contents ()
1015 "Download the ELPA archive description if needed.
1016 Invoking this will ensure that Emacs knows about the latest versions
1017 of all packages. This will let Emacs make them available for
1020 (unless (file-exists-p package-user-dir)
1021 (make-directory package-user-dir t))
1022 (package--download-one-archive "archive-contents")
1023 (package--download-one-archive "builtin-packages")
1024 (package-read-archive-contents))
1027 (defun package-initialize ()
1028 "Load Emacs Lisp packages, and activate them.
1029 The variable `package-load-list' controls which packages to load."
1031 (setq package-obsolete-alist nil)
1032 (package-load-all-descriptors)
1033 (package-read-archive-contents)
1034 ;; Try to activate all our packages.
1036 (package-activate (car elt) (package-desc-vers (cdr elt))))
1041 ;;;; Package menu mode.
1043 (defvar package-menu-mode-map nil
1044 "Local keymap for `package-menu-mode' buffers.")
1046 (unless package-menu-mode-map
1047 (setq package-menu-mode-map (make-keymap))
1048 (suppress-keymap package-menu-mode-map)
1049 (define-key package-menu-mode-map "q" 'quit-window)
1050 (define-key package-menu-mode-map "n" 'next-line)
1051 (define-key package-menu-mode-map "p" 'previous-line)
1052 (define-key package-menu-mode-map "u" 'package-menu-mark-unmark)
1053 (define-key package-menu-mode-map "\177" 'package-menu-backup-unmark)
1054 (define-key package-menu-mode-map "d" 'package-menu-mark-delete)
1055 (define-key package-menu-mode-map "i" 'package-menu-mark-install)
1056 (define-key package-menu-mode-map "g" 'package-menu-revert)
1057 (define-key package-menu-mode-map "r" 'package-menu-refresh)
1058 (define-key package-menu-mode-map "~"
1059 'package-menu-mark-obsolete-for-deletion)
1060 (define-key package-menu-mode-map "x" 'package-menu-execute)
1061 (define-key package-menu-mode-map "h" 'package-menu-quick-help)
1062 (define-key package-menu-mode-map "?" 'package-menu-view-commentary))
1064 (defvar package-menu-sort-button-map
1065 (let ((map (make-sparse-keymap)))
1066 (define-key map [header-line mouse-1] 'package-menu-sort-by-column)
1067 (define-key map [follow-link] 'mouse-face)
1069 "Local keymap for package menu sort buttons.")
1071 (put 'package-menu-mode 'mode-class 'special)
1073 (defun package-menu-mode ()
1074 "Major mode for browsing a list of packages.
1075 Letters do not insert themselves; instead, they are commands.
1076 \\<package-menu-mode-map>
1077 \\{package-menu-mode-map}"
1078 (kill-all-local-variables)
1079 (use-local-map package-menu-mode-map)
1080 (setq major-mode 'package-menu-mode)
1081 (setq mode-name "Package Menu")
1082 (setq truncate-lines t)
1083 (setq buffer-read-only t)
1084 ;; Support Emacs 21.
1085 (if (fboundp 'run-mode-hooks)
1086 (run-mode-hooks 'package-menu-mode-hook)
1087 (run-hooks 'package-menu-mode-hook)))
1089 (defun package-menu-refresh ()
1090 "Download the ELPA archive.
1091 This fetches the file describing the current contents of
1092 the Emacs Lisp Package Archive, and then refreshes the
1093 package menu. This lets you see what new packages are
1094 available for download."
1096 (package-refresh-contents)
1097 (package-list-packages-internal))
1099 (defun package-menu-revert ()
1100 "Update the list of packages."
1102 (package-list-packages-internal))
1104 (defun package-menu-mark-internal (what)
1106 (let ((buffer-read-only nil))
1112 ;; fixme numeric argument
1113 (defun package-menu-mark-delete (num)
1114 "Mark a package for deletion and move to the next line."
1116 (package-menu-mark-internal "D"))
1118 (defun package-menu-mark-install (num)
1119 "Mark a package for installation and move to the next line."
1121 (package-menu-mark-internal "I"))
1123 (defun package-menu-mark-unmark (num)
1124 "Clear any marks on a package and move to the next line."
1126 (package-menu-mark-internal " "))
1128 (defun package-menu-backup-unmark ()
1129 "Back up one line and clear any marks on that package."
1132 (package-menu-mark-internal " ")
1135 (defun package-menu-mark-obsolete-for-deletion ()
1136 "Mark all obsolete packages for deletion."
1139 (goto-char (point-min))
1142 (if (looking-at ".*\\s obsolete\\s ")
1143 (package-menu-mark-internal "D")
1144 (forward-line 1)))))
1146 (defun package-menu-quick-help ()
1147 "Show short key binding help for package-menu-mode."
1149 (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
1151 (defun package-menu-view-commentary ()
1152 "Display information about this package.
1153 For single-file packages, shows the commentary section from the header.
1154 For larger packages, shows the README file."
1156 (let* (start-point ok
1157 (pkg-name (package-menu-get-package))
1158 (buffer (url-retrieve-synchronously (concat package-archive-base
1161 (with-current-buffer buffer
1162 ;; FIXME: it would be nice to work with any URL type.
1163 (setq start-point url-http-end-of-headers)
1164 (setq ok (eq (url-http-parse-response) 200)))
1165 (let ((new-buffer (get-buffer-create "*Package Info*")))
1166 (with-current-buffer new-buffer
1167 (let ((buffer-read-only nil))
1169 (insert "Package information for " pkg-name "\n\n")
1171 (insert-buffer-substring buffer start-point)
1172 (insert "This package does not have a README file or commentary comment.\n"))
1173 (goto-char (point-min))
1175 (display-buffer new-buffer t))))
1177 ;; Return the name of the package on the current line.
1178 (defun package-menu-get-package ()
1181 (if (looking-at ". \\([^ \t]*\\)")
1184 ;; Return the version of the package on the current line.
1185 (defun package-menu-get-version ()
1188 (if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)")
1191 (defun package-menu-get-status ()
1193 (if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)")
1197 (defun package-menu-execute ()
1198 "Perform all the marked actions.
1199 Packages marked for installation will be downloaded and
1200 installed. Packages marked for deletion will be removed.
1201 Note that after installing packages you will want to restart
1204 (goto-char (point-min))
1207 (let ((cmd (char-after))
1208 (pkg-name (package-menu-get-package))
1209 (pkg-vers (package-menu-get-version))
1210 (pkg-status (package-menu-get-status)))
1213 (when (and (string= pkg-status "installed")
1214 (string= pkg-name "package"))
1215 ;; FIXME: actually, we could be tricky and remove all info.
1216 ;; But that is drastic and the user can do that instead.
1217 (error "Can't delete most recent version of `package'"))
1218 ;; Ask for confirmation here? Maybe if package status is ""?
1219 ;; Or if any lisp from package is actually loaded?
1220 (message "Deleting %s-%s..." pkg-name pkg-vers)
1221 (package-delete pkg-name pkg-vers)
1222 (message "Deleting %s-%s... done" pkg-name pkg-vers))
1224 (package-install (intern pkg-name)))))
1226 (package-menu-revert))
1228 (defun package-print-package (package version key desc)
1230 (cond ((eq package 'emacs) 'font-lock-builtin-face)
1231 ((string= key "available") 'default)
1232 ((string= key "held") 'font-lock-constant-face)
1233 ((string= key "disabled") 'font-lock-warning-face)
1234 ((string= key "installed") 'font-lock-comment-face)
1235 (t ; obsolete, but also the default.
1236 'font-lock-warning-face))))
1237 (insert (propertize " " 'font-lock-face face))
1238 (insert (propertize (symbol-name package) 'font-lock-face face))
1240 (insert (propertize (package-version-join version) 'font-lock-face face))
1242 (insert (propertize key 'font-lock-face face))
1243 ;; FIXME: this 'when' is bogus...
1246 (insert (propertize desc 'font-lock-face face)))
1249 (defun package-list-maybe-add (package version status description result)
1250 (unless (assoc (cons package version) result)
1251 (setq result (cons (list (cons package version) status description)
1255 ;; This decides how we should sort; nil means by package name.
1256 (defvar package-menu-sort-key nil)
1258 (defun package-list-packages-internal ()
1259 (package-initialize) ; FIXME: do this here?
1260 (with-current-buffer (get-buffer-create "*Packages*")
1261 (setq buffer-read-only nil)
1265 ;; List installed packages
1266 (dolist (elt package-alist)
1267 (setq name (car elt)
1269 hold (assq name package-load-list))
1271 (package-list-maybe-add name (package-desc-vers desc)
1272 ;; FIXME: it turns out to be
1273 ;; tricky to see if this package
1274 ;; is presently activated.
1275 (if (stringp (cadr hold))
1278 (package-desc-doc desc)
1280 ;; List available packages
1281 (dolist (elt package-archive-contents)
1282 (setq name (car elt)
1284 hold (assq name package-load-list))
1285 (unless (and hold (stringp (cadr hold))
1286 (package-installed-p
1287 name (package-version-split (cadr hold))))
1289 (package-list-maybe-add name
1290 (package-desc-vers desc)
1291 (if (and hold (null (cadr hold)))
1294 (package-desc-doc (cdr elt))
1296 ;; List obsolete packages
1298 (mapc (lambda (inner-elt)
1300 (package-list-maybe-add (car elt)
1308 package-obsolete-alist)
1309 (let ((selector (cond
1310 ((string= package-menu-sort-key "Version")
1311 ;; FIXME this doesn't work.
1312 #'(lambda (e) (cdr (car e))))
1313 ((string= package-menu-sort-key "Status")
1314 #'(lambda (e) (car (cdr e))))
1315 ((string= package-menu-sort-key "Description")
1316 #'(lambda (e) (car (cdr (cdr e)))))
1317 (t ; "Package" is default.
1318 #'(lambda (e) (symbol-name (car (car e))))))))
1321 (lambda (left right)
1322 (let ((vleft (funcall selector left))
1323 (vright (funcall selector right)))
1324 (string< vleft vright))))))
1326 (package-print-package (car (car elt))
1329 (car (cdr (cdr elt)))))
1331 (goto-char (point-min))
1334 (defun package-menu-sort-by-column (&optional e)
1335 "Sort the package menu by the last column clicked on."
1336 (interactive (list last-input-event))
1337 (if e (mouse-select-window e))
1338 (let* ((pos (event-start e))
1339 (obj (posn-object pos))
1341 (get-text-property (cdr obj) 'column-name (car obj))
1342 (get-text-property (posn-point pos) 'column-name))))
1343 (setq package-menu-sort-key col))
1344 (package-list-packages-internal))
1346 (defun package--list-packages ()
1347 "Display a list of packages.
1348 Helper function that does all the work for the user-facing functions."
1349 (with-current-buffer (package-list-packages-internal)
1351 ;; Set up the header line.
1352 (setq header-line-format
1355 (let ((column (car pair))
1358 ;; Insert a space that aligns the button properly.
1359 (propertize " " 'display (list 'space :align-to column)
1361 ;; Set up the column button.
1362 (if (string= name "Version")
1366 'help-echo "mouse-1: sort by column"
1367 'mouse-face 'highlight
1368 'keymap package-menu-sort-button-map)))))
1369 ;; We take a trick from buff-menu and have a dummy leading
1370 ;; space to align the header line with the beginning of the
1371 ;; text. This doesn't really work properly on Emacs 21,
1372 ;; but it is close enough.
1377 (41 . "Description"))
1380 ;; It's okay to use pop-to-buffer here. The package menu buffer
1381 ;; has keybindings, and the user just typed 'M-x
1382 ;; package-list-packages', suggesting that they might want to use
1384 (pop-to-buffer (current-buffer))))
1387 (defun package-list-packages ()
1388 "Display a list of packages.
1389 Fetches the updated list of packages before displaying.
1390 The list is displayed in a buffer named `*Packages*'."
1392 (package-refresh-contents)
1393 (package--list-packages))
1395 (defun package-list-packages-no-fetch ()
1396 "Display a list of packages.
1397 Does not fetch the updated list of packages before displaying.
1398 The list is displayed in a buffer named `*Packages*'."
1400 (package--list-packages))
1402 ;; Make it appear on the menu.
1403 (define-key-after menu-bar-options-menu [package]
1404 '(menu-item "Manage Packages" package-list-packages
1405 :help "Install or uninstall additional Emacs packages"))
1409 ;;; package.el ends here