Mercurial > emacs
comparison lisp/emacs-lisp/package.el @ 109567:0fc9f7a0d319
Add support for non-default package repositories.
* lisp/emacs-lisp/package.el (package-archive-base): Var deleted.
(package-archives): New variable.
(package-archive-contents): Doc fix.
(package-load-descriptor): Do nothing if descriptor file is
missing.
(package--write-file-no-coding): New function.
(package-unpack-single): Use it.
(package-archive-id): New function.
(package-download-single, package-download-tar)
(package-menu-view-commentary): Use it.
(package-installed-p): Make second argument optional.
(package-read-all-archive-contents): New function.
(package-initialize): Use it.
(package-read-archive-contents): Add ARCHIVE argument.
(package--add-to-archive-contents): New function.
(package-install): Don't call package-read-archive-contents.
(package--download-one-archive): Store archive file in a
subdirectory of package-user-dir.
(package-menu-execute): Remove spurious line movement.
* lisp/emacs-lisp/package.el (package-load-list, package-archives)
(package-archive-contents, package-user-dir)
(package-directory-list, package--builtins, package-alist)
(package-activated-list, package-obsolete-alist): Mark as risky.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Wed, 28 Jul 2010 14:54:42 -0400 |
parents | 858e3e43cfd5 |
children | 3021343b766a |
comparison
equal
deleted
inserted
replaced
109566:d03bc4a3fced | 109567:0fc9f7a0d319 |
---|---|
41 ;; it possible to upgrade Emacs and automatically disable packages | 41 ;; it possible to upgrade Emacs and automatically disable packages |
42 ;; which have moved from external to core. (Note though that we don't | 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 | 43 ;; currently register any of these, so this feature does not actually |
44 ;; work.) | 44 ;; work.) |
45 | 45 |
46 ;; This code supports a single package repository, ELPA. All packages | |
47 ;; must be registered there. | |
48 | |
49 ;; A package is described by its name and version. The distribution | 46 ;; A package is described by its name and version. The distribution |
50 ;; format is either a tar file or a single .el file. | 47 ;; format is either a tar file or a single .el file. |
51 | 48 |
52 ;; A tar file should be named "NAME-VERSION.tar". The tar file must | 49 ;; A tar file should be named "NAME-VERSION.tar". The tar file must |
53 ;; unpack into a directory named after the package and version: | 50 ;; unpack into a directory named after the package and version: |
54 ;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" | 51 ;; "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 | 52 ;; which consists of a call to define-package. It may also contain a |
56 ;; "dir" file and the info files it references. | 53 ;; "dir" file and the info files it references. |
57 | 54 |
58 ;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be | 55 ;; A .el file is named "NAME-VERSION.el" in the remote archive, but is |
59 ;; installed as simply "NAME.el" in a directory named "NAME-VERSION". | 56 ;; installed as simply "NAME.el" in a directory named "NAME-VERSION". |
60 | 57 |
61 ;; The downloader will download all dependent packages. It will also | 58 ;; The downloader downloads all dependent packages. By default, |
62 ;; byte-compile the package's lisp at install time. | 59 ;; packages come from the official GNU sources, but others may be |
60 ;; added by customizing the `package-archives' alist. Packages get | |
61 ;; byte-compiled at install time. | |
63 | 62 |
64 ;; At activation time we will set up the load-path and the info path, | 63 ;; 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 | 64 ;; and we will load the package's autoloads. If a package's |
66 ;; dependencies are not available, we will not activate that package. | 65 ;; dependencies are not available, we will not activate that package. |
67 | 66 |
205 If VERSION is a string, only that version is ever loaded. | 204 If VERSION is a string, only that version is ever loaded. |
206 Any other version, even if newer, is silently ignored. | 205 Any other version, even if newer, is silently ignored. |
207 Hence, the package is \"held\" at that version. | 206 Hence, the package is \"held\" at that version. |
208 If VERSION is nil, the package is not loaded (it is \"disabled\")." | 207 If VERSION is nil, the package is not loaded (it is \"disabled\")." |
209 :type '(repeat symbol) | 208 :type '(repeat symbol) |
209 :risky t | |
210 :group 'package | 210 :group 'package |
211 :version "24.1") | 211 :version "24.1") |
212 | 212 |
213 (defvar Info-directory-list) | 213 (defvar Info-directory-list) |
214 (declare-function info-initialize "info" ()) | 214 (declare-function info-initialize "info" ()) |
215 (declare-function url-http-parse-response "url-http" ()) | 215 (declare-function url-http-parse-response "url-http" ()) |
216 (declare-function lm-header "lisp-mnt" (header)) | 216 (declare-function lm-header "lisp-mnt" (header)) |
217 (declare-function lm-commentary "lisp-mnt" (&optional file)) | 217 (declare-function lm-commentary "lisp-mnt" (&optional file)) |
218 (declare-function dired-delete-file "dired" (file &optional recursive trash)) | 218 (declare-function dired-delete-file "dired" (file &optional recursive trash)) |
219 | 219 |
220 (defconst package-archive-base "http://elpa.gnu.org/packages/" | 220 (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) |
221 "Base URL for the Emacs Lisp Package Archive (ELPA). | 221 "An alist of archives from which to fetch. |
222 Ordinarily you should not need to change this. | 222 The default value points to the GNU Emacs package repository. |
223 Note that some code in package.el assumes that this is an http: URL.") | 223 Each element has the form (ID . URL), where ID is an identifier |
224 string for an archive and URL is a http: URL (a string)." | |
225 :type '(alist :key-type (string :tag "Archive name") | |
226 :value-type (string :tag "Archive URL")) | |
227 :risky t | |
228 :group 'package | |
229 :version "24.1") | |
224 | 230 |
225 (defconst package-archive-version 1 | 231 (defconst package-archive-version 1 |
226 "Version number of the package archive understood by this file. | 232 "Version number of the package archive understood by this file. |
227 Lower version numbers than this will probably be understood as well.") | 233 Lower version numbers than this will probably be understood as well.") |
228 | 234 |
232 ;; We don't prime the cache since it tends to get out of date. | 238 ;; We don't prime the cache since it tends to get out of date. |
233 (defvar package-archive-contents nil | 239 (defvar package-archive-contents nil |
234 "Cache of the contents of the Emacs Lisp Package Archive. | 240 "Cache of the contents of the Emacs Lisp Package Archive. |
235 This is an alist mapping package names (symbols) to package | 241 This is an alist mapping package names (symbols) to package |
236 descriptor vectors. These are like the vectors for `package-alist' | 242 descriptor vectors. These are like the vectors for `package-alist' |
237 but have an extra entry which is 'tar for tar packages and | 243 but have extra entries: one which is 'tar for tar packages and |
238 'single for single-file packages.") | 244 'single for single-file packages, and one which is the name of |
245 the archive from which it came.") | |
246 (put 'package-archive-contents 'risky-local-variable t) | |
239 | 247 |
240 (defcustom package-user-dir (locate-user-emacs-file "elpa") | 248 (defcustom package-user-dir (locate-user-emacs-file "elpa") |
241 "Directory containing the user's Emacs Lisp packages. | 249 "Directory containing the user's Emacs Lisp packages. |
242 The directory name should be absolute. | 250 The directory name should be absolute. |
243 Apart from this directory, Emacs also looks for system-wide | 251 Apart from this directory, Emacs also looks for system-wide |
244 packages in `package-directory-list'." | 252 packages in `package-directory-list'." |
245 :type 'directory | 253 :type 'directory |
254 :risky t | |
246 :group 'package | 255 :group 'package |
247 :version "24.1") | 256 :version "24.1") |
248 | 257 |
249 (defcustom package-directory-list | 258 (defcustom package-directory-list |
250 ;; Defaults are subdirs named "elpa" in the site-lisp dirs. | 259 ;; Defaults are subdirs named "elpa" in the site-lisp dirs. |
257 Each directory name should be absolute. | 266 Each directory name should be absolute. |
258 | 267 |
259 These directories contain packages intended for system-wide; in | 268 These directories contain packages intended for system-wide; in |
260 contrast, `package-user-dir' contains packages for personal use." | 269 contrast, `package-user-dir' contains packages for personal use." |
261 :type '(repeat directory) | 270 :type '(repeat directory) |
271 :risky t | |
262 :group 'package | 272 :group 'package |
263 :version "24.1") | 273 :version "24.1") |
264 | 274 |
265 (defun package-version-split (string) | 275 (defun package-version-split (string) |
266 "Split a package string into a version list." | 276 "Split a package string into a version list." |
291 ;; We pick the merge date as the version. | 301 ;; We pick the merge date as the version. |
292 (nxml . [(20071123) nil "Major mode for editing XML documents."]) | 302 (nxml . [(20071123) nil "Major mode for editing XML documents."]) |
293 (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) | 303 (bubbles . [(0 5) nil "Puzzle game for Emacs."]))))) |
294 "Alist of all built-in packages. | 304 "Alist of all built-in packages. |
295 Maps the package name to a vector [VERSION REQS DOCSTRING].") | 305 Maps the package name to a vector [VERSION REQS DOCSTRING].") |
306 (put 'package--builtins 'risky-local-variable t) | |
296 | 307 |
297 (defvar package-alist package--builtins | 308 (defvar package-alist package--builtins |
298 "Alist of all packages available for activation. | 309 "Alist of all packages available for activation. |
299 This maps the package name to a vector [VERSION REQS DOCSTRING]. | 310 This maps the package name to a vector [VERSION REQS DOCSTRING]. |
300 | 311 |
301 The value is generated by `package-load-descriptor', usually | 312 The value is generated by `package-load-descriptor', usually |
302 called via `package-initialize'. For user customizations of | 313 called via `package-initialize'. For user customizations of |
303 which packages to load/activate, see `package-load-list'.") | 314 which packages to load/activate, see `package-load-list'.") |
315 (put 'package-archive-contents 'risky-local-variable t) | |
304 | 316 |
305 (defvar package-activated-list | 317 (defvar package-activated-list |
306 (mapcar #'car package-alist) | 318 (mapcar #'car package-alist) |
307 "List of the names of currently activated packages.") | 319 "List of the names of currently activated packages.") |
320 (put 'package-activated-list 'risky-local-variable t) | |
308 | 321 |
309 (defvar package-obsolete-alist nil | 322 (defvar package-obsolete-alist nil |
310 "Representation of obsolete packages. | 323 "Representation of obsolete packages. |
311 Like `package-alist', but maps package name to a second alist. | 324 Like `package-alist', but maps package name to a second alist. |
312 The inner alist is keyed by version.") | 325 The inner alist is keyed by version.") |
326 (put 'package-obsolete-alist 'risky-local-variable t) | |
313 | 327 |
314 (defconst package-subdirectory-regexp | 328 (defconst package-subdirectory-regexp |
315 "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" | 329 "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$" |
316 "Regular expression matching the name of a package subdirectory. | 330 "Regular expression matching the name of a package subdirectory. |
317 The first subexpression is the package name. | 331 The first subexpression is the package name. |
359 E.g., if given \"quux-23.0\", will return \"quux\"" | 373 E.g., if given \"quux-23.0\", will return \"quux\"" |
360 (if (string-match package-subdirectory-regexp dirname) | 374 (if (string-match package-subdirectory-regexp dirname) |
361 (match-string 1 dirname))) | 375 (match-string 1 dirname))) |
362 | 376 |
363 (defun package-load-descriptor (dir package) | 377 (defun package-load-descriptor (dir package) |
364 "Load the description file for a package. | 378 "Load the description file in directory DIR for package PACKAGE." |
365 DIR is the directory in which to find the package subdirectory, | 379 (let* ((pkg-dir (expand-file-name package dir)) |
366 and PACKAGE is the name of the package subdirectory. | 380 (pkg-file (expand-file-name |
367 Return nil if the package could not be found." | 381 (concat (package-strip-version package) "-pkg") |
368 (let ((pkg-dir (expand-file-name package dir))) | 382 pkg-dir))) |
369 (if (file-directory-p pkg-dir) | 383 (when (and (file-directory-p pkg-dir) |
370 (load (expand-file-name (concat (package-strip-version package) | 384 (file-exists-p (concat pkg-file ".el"))) |
371 "-pkg") | 385 (load pkg-file nil t)))) |
372 pkg-dir) | |
373 nil t)))) | |
374 | 386 |
375 (defun package-load-all-descriptors () | 387 (defun package-load-all-descriptors () |
376 "Load descriptors for installed Emacs Lisp packages. | 388 "Load descriptors for installed Emacs Lisp packages. |
377 This looks for package subdirectories in `package-user-dir' and | 389 This looks for package subdirectories in `package-user-dir' and |
378 `package-directory-list'. The variable `package-load-list' | 390 `package-directory-list'. The variable `package-load-list' |
611 (package-untar-buffer) | 623 (package-untar-buffer) |
612 (package-generate-autoloads (symbol-name name) pkg-dir) | 624 (package-generate-autoloads (symbol-name name) pkg-dir) |
613 (let ((load-path (cons pkg-dir load-path))) | 625 (let ((load-path (cons pkg-dir load-path))) |
614 (byte-recompile-directory pkg-dir 0 t))))) | 626 (byte-recompile-directory pkg-dir 0 t))))) |
615 | 627 |
628 (defun package--write-file-no-coding (file-name excl) | |
629 (let ((buffer-file-coding-system 'no-conversion)) | |
630 (write-region (point-min) (point-max) file-name nil nil nil excl))) | |
631 | |
616 (defun package-unpack-single (file-name version desc requires) | 632 (defun package-unpack-single (file-name version desc requires) |
617 "Install the contents of the current buffer as a package." | 633 "Install the contents of the current buffer as a package." |
618 ;; Special case "package". | 634 ;; Special case "package". |
619 (if (string= file-name "package") | 635 (if (string= file-name "package") |
620 (write-region (point-min) (point-max) | 636 (package--write-file-no-coding |
621 (expand-file-name (concat file-name ".el") | 637 (expand-file-name (concat file-name ".el") package-user-dir) |
622 package-user-dir) | 638 nil) |
623 nil nil nil nil) | |
624 (let* ((pkg-dir (expand-file-name (concat file-name "-" version) | 639 (let* ((pkg-dir (expand-file-name (concat file-name "-" version) |
625 package-user-dir)) | 640 package-user-dir)) |
626 (el-file (expand-file-name (concat file-name ".el") pkg-dir)) | 641 (el-file (expand-file-name (concat file-name ".el") pkg-dir)) |
627 (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) | 642 (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) |
628 (make-directory pkg-dir t) | 643 (make-directory pkg-dir t) |
629 (write-region (point-min) (point-max) el-file nil nil nil 'excl) | 644 (package--write-file-no-coding el-file 'excl) |
630 (let ((print-level nil) | 645 (let ((print-level nil) |
631 (print-length nil)) | 646 (print-length nil)) |
632 (write-region | 647 (write-region |
633 (concat | 648 (concat |
634 (prin1-to-string | 649 (prin1-to-string |
668 (point))))))) | 683 (point))))))) |
669 | 684 |
670 (defun package-download-single (name version desc requires) | 685 (defun package-download-single (name version desc requires) |
671 "Download and install a single-file package." | 686 "Download and install a single-file package." |
672 (let ((buffer (url-retrieve-synchronously | 687 (let ((buffer (url-retrieve-synchronously |
673 (concat package-archive-base | 688 (concat (package-archive-id name) |
674 (symbol-name name) "-" version ".el")))) | 689 (symbol-name name) "-" version ".el")))) |
675 (with-current-buffer buffer | 690 (with-current-buffer buffer |
676 (package-handle-response) | 691 (package-handle-response) |
677 (re-search-forward "^$" nil 'move) | 692 (re-search-forward "^$" nil 'move) |
678 (forward-char) | 693 (forward-char) |
681 (kill-buffer buffer)))) | 696 (kill-buffer buffer)))) |
682 | 697 |
683 (defun package-download-tar (name version) | 698 (defun package-download-tar (name version) |
684 "Download and install a tar package." | 699 "Download and install a tar package." |
685 (let ((tar-buffer (url-retrieve-synchronously | 700 (let ((tar-buffer (url-retrieve-synchronously |
686 (concat package-archive-base | 701 (concat (package-archive-id name) |
687 (symbol-name name) "-" version ".tar")))) | 702 (symbol-name name) "-" version ".tar")))) |
688 (with-current-buffer tar-buffer | 703 (with-current-buffer tar-buffer |
689 (package-handle-response) | 704 (package-handle-response) |
690 (re-search-forward "^$" nil 'move) | 705 (re-search-forward "^$" nil 'move) |
691 (forward-char) | 706 (forward-char) |
692 (package-unpack name version) | 707 (package-unpack name version) |
693 (kill-buffer tar-buffer)))) | 708 (kill-buffer tar-buffer)))) |
694 | 709 |
695 (defun package-installed-p (package version) | 710 (defun package-installed-p (package &optional min-version) |
696 (let ((pkg-desc (assq package package-alist))) | 711 (let ((pkg-desc (assq package package-alist))) |
697 (and pkg-desc | 712 (and pkg-desc |
698 (package-version-compare version | 713 (package-version-compare min-version |
699 (package-desc-vers (cdr pkg-desc)) | 714 (package-desc-vers (cdr pkg-desc)) |
700 '>=)))) | 715 '<=)))) |
701 | 716 |
702 (defun package-compute-transaction (result requirements) | 717 (defun package-compute-transaction (result requirements) |
703 (dolist (elt requirements) | 718 (dolist (elt requirements) |
704 (let* ((next-pkg (car elt)) | 719 (let* ((next-pkg (car elt)) |
705 (next-version (cadr elt))) | 720 (next-version (cadr elt))) |
770 (if (> (car contents) package-archive-version) | 785 (if (> (car contents) package-archive-version) |
771 (error "Package archive version %d is greater than %d - upgrade package.el" | 786 (error "Package archive version %d is greater than %d - upgrade package.el" |
772 (car contents) package-archive-version)) | 787 (car contents) package-archive-version)) |
773 (cdr contents)))))) | 788 (cdr contents)))))) |
774 | 789 |
775 (defun package-read-archive-contents () | 790 (defun package-read-all-archive-contents () |
776 "Re-read `archive-contents' and `builtin-packages', if they exist. | 791 "Re-read `archive-contents' and `builtin-packages', if they exist. |
777 Set `package-archive-contents' and `package--builtins' if successful. | 792 Set `package-archive-contents' and `package--builtins' if successful. |
778 Throw an error if the archive version is too new." | 793 Throw an error if the archive version is too new." |
779 (let ((archive-contents (package--read-archive-file "archive-contents")) | 794 (dolist (archive package-archives) |
780 (builtins (package--read-archive-file "builtin-packages"))) | 795 (package-read-archive-contents (car archive))) |
781 (if archive-contents | 796 (let ((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)) | |
785 (if builtins | 797 (if builtins |
786 ;; Version 1 of 'builtin-packages' is a list where the car is | 798 ;; 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 | 799 ;; a split emacs version and the cdr is an alist suitable for |
788 ;; package--builtins. | 800 ;; package--builtins. |
789 (let ((our-version (package-version-split emacs-version)) | 801 (let ((our-version (package-version-split emacs-version)) |
790 (result package--builtins-base)) | 802 (result package--builtins-base)) |
791 (setq package--builtins | 803 (setq package--builtins |
792 (dolist (elt builtins result) | 804 (dolist (elt builtins result) |
793 (if (package-version-compare our-version (car elt) '>=) | 805 (if (package-version-compare our-version (car elt) '>=) |
794 (setq result (append (cdr elt) result))))))))) | 806 (setq result (append (cdr elt) result))))))))) |
807 | |
808 (defun package-read-archive-contents (archive) | |
809 "Re-read `archive-contents' and `builtin-packages' for ARCHIVE. | |
810 If successful, set `package-archive-contents' and `package--builtins'. | |
811 If the archive version is too new, signal an error." | |
812 (let ((archive-contents (package--read-archive-file | |
813 (concat "archives/" archive | |
814 "/archive-contents")))) | |
815 (if archive-contents | |
816 ;; Version 1 of 'archive-contents' is identical to our | |
817 ;; internal representation. | |
818 ;; TODO: merge archive lists | |
819 (dolist (package archive-contents) | |
820 (package--add-to-archive-contents package archive))))) | |
821 | |
822 (defun package--add-to-archive-contents (package archive) | |
823 "Add the PACKAGE from the given ARCHIVE if necessary. | |
824 Also, add the originating archive to the end of the package vector." | |
825 (let* ((name (car package)) | |
826 (version (aref (cdr package) 0)) | |
827 (entry (cons (car package) | |
828 (vconcat (cdr package) (vector archive)))) | |
829 (existing-package (cdr (assq name package-archive-contents)))) | |
830 (when (or (not existing-package) | |
831 (package-version-compare version | |
832 (aref existing-package 0) '>)) | |
833 (add-to-list 'package-archive-contents entry)))) | |
795 | 834 |
796 (defun package-download-transaction (transaction) | 835 (defun package-download-transaction (transaction) |
797 "Download and install all the packages in the given transaction." | 836 "Download and install all the packages in the given transaction." |
798 (dolist (elt transaction) | 837 (dolist (elt transaction) |
799 (let* ((desc (cdr (assq elt package-archive-contents))) | 838 (let* ((desc (cdr (assq elt package-archive-contents))) |
815 | 854 |
816 ;;;###autoload | 855 ;;;###autoload |
817 (defun package-install (name) | 856 (defun package-install (name) |
818 "Install the package named NAME. | 857 "Install the package named NAME. |
819 Interactively, prompt for the package name. | 858 Interactively, prompt for the package name. |
820 The package is found on the archive site, see `package-archive-base'." | 859 The package is found on one of the archives in `package-archive-base'." |
821 (interactive | 860 (interactive |
822 (list (progn | 861 (list (intern (completing-read "Install package: " |
823 ;; Make sure we're using the most recent download of the | 862 (mapcar (lambda (elt) |
824 ;; archive. Maybe we should be updating the archive first? | 863 (cons (symbol-name (car elt)) |
825 (package-read-archive-contents) | 864 nil)) |
826 (intern (completing-read "Install package: " | 865 package-archive-contents) |
827 (mapcar (lambda (elt) | 866 nil t)))) |
828 (cons (symbol-name (car elt)) | |
829 nil)) | |
830 package-archive-contents) | |
831 nil t))))) | |
832 (let ((pkg-desc (assq name package-archive-contents))) | 867 (let ((pkg-desc (assq name package-archive-contents))) |
833 (unless pkg-desc | 868 (unless pkg-desc |
834 (error "Package '%s' not available for installation" | 869 (error "Package '%s' is not available for installation" |
835 (symbol-name name))) | 870 (symbol-name name))) |
836 (let ((transaction | 871 (package-download-transaction |
837 (package-compute-transaction (list name) | 872 (package-compute-transaction (list name) |
838 (package-desc-reqs (cdr pkg-desc))))) | 873 (package-desc-reqs (cdr pkg-desc))))) |
839 (package-download-transaction transaction))) | |
840 ;; Try to activate it. | 874 ;; Try to activate it. |
841 (package-initialize)) | 875 (package-initialize)) |
842 | 876 |
843 (defun package-strip-rcs-id (v-str) | 877 (defun package-strip-rcs-id (v-str) |
844 "Strip RCS version ID from the version string. | 878 "Strip RCS version ID from the version string. |
994 (dired-delete-file (expand-file-name (concat name "-" version) | 1028 (dired-delete-file (expand-file-name (concat name "-" version) |
995 package-user-dir) | 1029 package-user-dir) |
996 ;; FIXME: query user? | 1030 ;; FIXME: query user? |
997 'always)) | 1031 'always)) |
998 | 1032 |
999 (defun package--download-one-archive (file) | 1033 (defun package-archive-id (name) |
1000 "Download a single archive file and cache it locally." | 1034 "Return the archive containing the package NAME." |
1001 (let ((buffer (url-retrieve-synchronously | 1035 (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) |
1002 (concat package-archive-base file)))) | 1036 (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) |
1037 | |
1038 (defun package--download-one-archive (archive file) | |
1039 "Download an archive file FILE from ARCHIVE, and cache it locally." | |
1040 (let* ((archive-name (car archive)) | |
1041 (archive-url (cdr archive)) | |
1042 (dir (expand-file-name "archives" package-user-dir)) | |
1043 (dir (expand-file-name archive-name dir)) | |
1044 (buffer (url-retrieve-synchronously (concat archive-url file)))) | |
1003 (with-current-buffer buffer | 1045 (with-current-buffer buffer |
1004 (package-handle-response) | 1046 (package-handle-response) |
1005 (re-search-forward "^$" nil 'move) | 1047 (re-search-forward "^$" nil 'move) |
1006 (forward-char) | 1048 (forward-char) |
1007 (delete-region (point-min) (point)) | 1049 (delete-region (point-min) (point)) |
1008 (setq buffer-file-name (concat (file-name-as-directory package-user-dir) | 1050 (make-directory dir t) |
1009 file)) | 1051 (setq buffer-file-name (expand-file-name file dir)) |
1010 (let ((version-control 'never)) | 1052 (let ((version-control 'never)) |
1011 (save-buffer)) | 1053 (save-buffer))) |
1012 (kill-buffer buffer)))) | 1054 (kill-buffer buffer))) |
1013 | 1055 |
1014 (defun package-refresh-contents () | 1056 (defun package-refresh-contents () |
1015 "Download the ELPA archive description if needed. | 1057 "Download the ELPA archive description if needed. |
1016 Invoking this will ensure that Emacs knows about the latest versions | 1058 Invoking this will ensure that Emacs knows about the latest versions |
1017 of all packages. This will let Emacs make them available for | 1059 of all packages. This will let Emacs make them available for |
1018 download." | 1060 download." |
1019 (interactive) | 1061 (interactive) |
1020 (unless (file-exists-p package-user-dir) | 1062 (unless (file-exists-p package-user-dir) |
1021 (make-directory package-user-dir t)) | 1063 (make-directory package-user-dir t)) |
1022 (package--download-one-archive "archive-contents") | 1064 (dolist (archive package-archives) |
1023 (package--download-one-archive "builtin-packages") | 1065 (package--download-one-archive archive "archive-contents")) |
1024 (package-read-archive-contents)) | 1066 (package-read-all-archive-contents)) |
1025 | 1067 |
1026 ;;;###autoload | 1068 ;;;###autoload |
1027 (defun package-initialize () | 1069 (defun package-initialize () |
1028 "Load Emacs Lisp packages, and activate them. | 1070 "Load Emacs Lisp packages, and activate them. |
1029 The variable `package-load-list' controls which packages to load." | 1071 The variable `package-load-list' controls which packages to load." |
1030 (interactive) | 1072 (interactive) |
1031 (setq package-obsolete-alist nil) | 1073 (setq package-obsolete-alist nil) |
1032 (package-load-all-descriptors) | 1074 (package-load-all-descriptors) |
1033 (package-read-archive-contents) | 1075 (package-read-all-archive-contents) |
1034 ;; Try to activate all our packages. | 1076 ;; Try to activate all our packages. |
1035 (mapc (lambda (elt) | 1077 (mapc (lambda (elt) |
1036 (package-activate (car elt) (package-desc-vers (cdr elt)))) | 1078 (package-activate (car elt) (package-desc-vers (cdr elt)))) |
1037 package-alist)) | 1079 package-alist)) |
1038 | 1080 |
1304 (defun package-menu-view-commentary () | 1346 (defun package-menu-view-commentary () |
1305 "Display information about this package. | 1347 "Display information about this package. |
1306 For single-file packages, shows the commentary section from the header. | 1348 For single-file packages, shows the commentary section from the header. |
1307 For larger packages, shows the README file." | 1349 For larger packages, shows the README file." |
1308 (interactive) | 1350 (interactive) |
1309 (let* (start-point ok | 1351 (let* ((pkg-name (package-menu-get-package)) |
1310 (pkg-name (package-menu-get-package)) | 1352 (buffer (url-retrieve-synchronously |
1311 (buffer (url-retrieve-synchronously (concat package-archive-base | 1353 (concat (package-archive-id pkg-name) |
1312 pkg-name | 1354 pkg-name |
1313 "-readme.txt")))) | 1355 "-readme.txt"))) |
1356 start-point ok) | |
1314 (with-current-buffer buffer | 1357 (with-current-buffer buffer |
1315 ;; FIXME: it would be nice to work with any URL type. | 1358 ;; FIXME: it would be nice to work with any URL type. |
1316 (setq start-point url-http-end-of-headers) | 1359 (setq start-point url-http-end-of-headers) |
1317 (setq ok (eq (url-http-parse-response) 200))) | 1360 (setq ok (eq (url-http-parse-response) 200))) |
1318 (let ((new-buffer (get-buffer-create "*Package Info*"))) | 1361 (let ((new-buffer (get-buffer-create "*Package Info*"))) |
1320 (let ((buffer-read-only nil)) | 1363 (let ((buffer-read-only nil)) |
1321 (erase-buffer) | 1364 (erase-buffer) |
1322 (insert "Package information for " pkg-name "\n\n") | 1365 (insert "Package information for " pkg-name "\n\n") |
1323 (if ok | 1366 (if ok |
1324 (insert-buffer-substring buffer start-point) | 1367 (insert-buffer-substring buffer start-point) |
1325 (insert "This package does not have a README file or commentary comment.\n")) | 1368 (insert "This package lacks a README file or commentary.\n")) |
1326 (goto-char (point-min)) | 1369 (goto-char (point-min)) |
1327 (view-mode))) | 1370 (view-mode))) |
1328 (display-buffer new-buffer t)))) | 1371 (display-buffer new-buffer t)))) |
1329 | 1372 |
1330 ;; Return the name of the package on the current line. | 1373 ;; Return the name of the package on the current line. |
1353 installed. Packages marked for deletion will be removed. | 1396 installed. Packages marked for deletion will be removed. |
1354 Note that after installing packages you will want to restart | 1397 Note that after installing packages you will want to restart |
1355 Emacs." | 1398 Emacs." |
1356 (interactive) | 1399 (interactive) |
1357 (goto-char (point-min)) | 1400 (goto-char (point-min)) |
1358 (forward-line 2) | |
1359 (while (not (eobp)) | 1401 (while (not (eobp)) |
1360 (let ((cmd (char-after)) | 1402 (let ((cmd (char-after)) |
1361 (pkg-name (package-menu-get-package)) | 1403 (pkg-name (package-menu-get-package)) |
1362 (pkg-vers (package-menu-get-version)) | 1404 (pkg-vers (package-menu-get-version)) |
1363 (pkg-status (package-menu-get-status))) | 1405 (pkg-status (package-menu-get-status))) |