[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r100925: Add support for non-default
From: |
Chong Yidong |
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r100925: Add support for non-default package repositories. |
Date: |
Wed, 28 Jul 2010 14:54:42 -0400 |
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100925
author: Phil Hagelberg <address@hidden>
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Wed 2010-07-28 14:54:42 -0400
message:
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.
modified:
lisp/ChangeLog
lisp/emacs-lisp/package.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-07-28 17:34:51 +0000
+++ b/lisp/ChangeLog 2010-07-28 18:54:42 +0000
@@ -1,3 +1,33 @@
+2010-07-28 Chong Yidong <address@hidden>
+
+ * 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.
+
+2010-07-28 Phil Hagelberg <address@hidden>
+
+ Add support for non-default package repositories.
+ * 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.
+
2010-07-28 Jan Djärv <address@hidden>
* cus-start.el (tool-bar-style): Add text-image-horiz.
=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el 2010-06-20 04:55:14 +0000
+++ b/lisp/emacs-lisp/package.el 2010-07-28 18:54:42 +0000
@@ -43,9 +43,6 @@
;; currently register any of these, so this feature does not actually
;; work.)
-;; This code supports a single package repository, ELPA. All packages
-;; must be registered there.
-
;; A package is described by its name and version. The distribution
;; format is either a tar file or a single .el file.
@@ -55,11 +52,13 @@
;; which consists of a call to define-package. It may also contain a
;; "dir" file and the info files it references.
-;; A .el file will be named "NAME-VERSION.el" in ELPA, but will be
+;; A .el file is named "NAME-VERSION.el" in the remote archive, but is
;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
-;; The downloader will download all dependent packages. It will also
-;; byte-compile the package's lisp at install time.
+;; The downloader downloads all dependent packages. By default,
+;; packages come from the official GNU sources, but others may be
+;; added by customizing the `package-archives' alist. Packages get
+;; byte-compiled at install time.
;; At activation time we will set up the load-path and the info path,
;; and we will load the package's autoloads. If a package's
@@ -207,6 +206,7 @@
Hence, the package is \"held\" at that version.
If VERSION is nil, the package is not loaded (it is \"disabled\")."
:type '(repeat symbol)
+ :risky t
:group 'package
:version "24.1")
@@ -217,10 +217,16 @@
(declare-function lm-commentary "lisp-mnt" (&optional file))
(declare-function dired-delete-file "dired" (file &optional recursive trash))
-(defconst package-archive-base "http://elpa.gnu.org/packages/"
- "Base URL for the Emacs Lisp Package Archive (ELPA).
-Ordinarily you should not need to change this.
-Note that some code in package.el assumes that this is an http: URL.")
+(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
+ "An alist of archives from which to fetch.
+The default value points to the GNU Emacs package repository.
+Each element has the form (ID . URL), where ID is an identifier
+string for an archive and URL is a http: URL (a string)."
+ :type '(alist :key-type (string :tag "Archive name")
+ :value-type (string :tag "Archive URL"))
+ :risky t
+ :group 'package
+ :version "24.1")
(defconst package-archive-version 1
"Version number of the package archive understood by this file.
@@ -234,8 +240,10 @@
"Cache of the contents of the Emacs Lisp Package Archive.
This is an alist mapping package names (symbols) to package
descriptor vectors. These are like the vectors for `package-alist'
-but have an extra entry which is 'tar for tar packages and
-'single for single-file packages.")
+but have extra entries: one which is 'tar for tar packages and
+'single for single-file packages, and one which is the name of
+the archive from which it came.")
+(put 'package-archive-contents 'risky-local-variable t)
(defcustom package-user-dir (locate-user-emacs-file "elpa")
"Directory containing the user's Emacs Lisp packages.
@@ -243,6 +251,7 @@
Apart from this directory, Emacs also looks for system-wide
packages in `package-directory-list'."
:type 'directory
+ :risky t
:group 'package
:version "24.1")
@@ -259,6 +268,7 @@
These directories contain packages intended for system-wide; in
contrast, `package-user-dir' contains packages for personal use."
:type '(repeat directory)
+ :risky t
:group 'package
:version "24.1")
@@ -293,6 +303,7 @@
(bubbles . [(0 5) nil "Puzzle game for Emacs."])))))
"Alist of all built-in packages.
Maps the package name to a vector [VERSION REQS DOCSTRING].")
+(put 'package--builtins 'risky-local-variable t)
(defvar package-alist package--builtins
"Alist of all packages available for activation.
@@ -301,15 +312,18 @@
The value is generated by `package-load-descriptor', usually
called via `package-initialize'. For user customizations of
which packages to load/activate, see `package-load-list'.")
+(put 'package-archive-contents 'risky-local-variable t)
(defvar package-activated-list
(mapcar #'car package-alist)
"List of the names of currently activated packages.")
+(put 'package-activated-list 'risky-local-variable t)
(defvar package-obsolete-alist nil
"Representation of obsolete packages.
Like `package-alist', but maps package name to a second alist.
The inner alist is keyed by version.")
+(put 'package-obsolete-alist 'risky-local-variable t)
(defconst package-subdirectory-regexp
"^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$"
@@ -361,16 +375,14 @@
(match-string 1 dirname)))
(defun package-load-descriptor (dir package)
- "Load the description file for a package.
-DIR is the directory in which to find the package subdirectory,
-and PACKAGE is the name of the package subdirectory.
-Return nil if the package could not be found."
- (let ((pkg-dir (expand-file-name package dir)))
- (if (file-directory-p pkg-dir)
- (load (expand-file-name (concat (package-strip-version package)
- "-pkg")
- pkg-dir)
- nil t))))
+ "Load the description file in directory DIR for package PACKAGE."
+ (let* ((pkg-dir (expand-file-name package dir))
+ (pkg-file (expand-file-name
+ (concat (package-strip-version package) "-pkg")
+ pkg-dir)))
+ (when (and (file-directory-p pkg-dir)
+ (file-exists-p (concat pkg-file ".el")))
+ (load pkg-file nil t))))
(defun package-load-all-descriptors ()
"Load descriptors for installed Emacs Lisp packages.
@@ -613,20 +625,23 @@
(let ((load-path (cons pkg-dir load-path)))
(byte-recompile-directory pkg-dir 0 t)))))
+(defun package--write-file-no-coding (file-name excl)
+ (let ((buffer-file-coding-system 'no-conversion))
+ (write-region (point-min) (point-max) file-name nil nil nil excl)))
+
(defun package-unpack-single (file-name version desc requires)
"Install the contents of the current buffer as a package."
;; Special case "package".
(if (string= file-name "package")
- (write-region (point-min) (point-max)
- (expand-file-name (concat file-name ".el")
- package-user-dir)
- nil nil nil nil)
+ (package--write-file-no-coding
+ (expand-file-name (concat file-name ".el") package-user-dir)
+ nil)
(let* ((pkg-dir (expand-file-name (concat file-name "-" version)
package-user-dir))
(el-file (expand-file-name (concat file-name ".el") pkg-dir))
(pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
(make-directory pkg-dir t)
- (write-region (point-min) (point-max) el-file nil nil nil 'excl)
+ (package--write-file-no-coding el-file 'excl)
(let ((print-level nil)
(print-length nil))
(write-region
@@ -670,7 +685,7 @@
(defun package-download-single (name version desc requires)
"Download and install a single-file package."
(let ((buffer (url-retrieve-synchronously
- (concat package-archive-base
+ (concat (package-archive-id name)
(symbol-name name) "-" version ".el"))))
(with-current-buffer buffer
(package-handle-response)
@@ -683,7 +698,7 @@
(defun package-download-tar (name version)
"Download and install a tar package."
(let ((tar-buffer (url-retrieve-synchronously
- (concat package-archive-base
+ (concat (package-archive-id name)
(symbol-name name) "-" version ".tar"))))
(with-current-buffer tar-buffer
(package-handle-response)
@@ -692,12 +707,12 @@
(package-unpack name version)
(kill-buffer tar-buffer))))
-(defun package-installed-p (package version)
+(defun package-installed-p (package &optional min-version)
(let ((pkg-desc (assq package package-alist)))
(and pkg-desc
- (package-version-compare version
+ (package-version-compare min-version
(package-desc-vers (cdr pkg-desc))
- '>=))))
+ '<=))))
(defun package-compute-transaction (result requirements)
(dolist (elt requirements)
@@ -772,16 +787,13 @@
(car contents) package-archive-version))
(cdr contents))))))
-(defun package-read-archive-contents ()
+(defun package-read-all-archive-contents ()
"Re-read `archive-contents' and `builtin-packages', if they exist.
Set `package-archive-contents' and `package--builtins' if successful.
Throw an error if the archive version is too new."
- (let ((archive-contents (package--read-archive-file "archive-contents"))
- (builtins (package--read-archive-file "builtin-packages")))
- (if archive-contents
- ;; Version 1 of 'archive-contents' is identical to our
- ;; internal representation.
- (setq package-archive-contents archive-contents))
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive)))
+ (let ((builtins (package--read-archive-file "builtin-packages")))
(if builtins
;; Version 1 of 'builtin-packages' is a list where the car is
;; a split emacs version and the cdr is an alist suitable for
@@ -793,6 +805,33 @@
(if (package-version-compare our-version (car elt) '>=)
(setq result (append (cdr elt) result)))))))))
+(defun package-read-archive-contents (archive)
+ "Re-read `archive-contents' and `builtin-packages' for ARCHIVE.
+If successful, set `package-archive-contents' and `package--builtins'.
+If the archive version is too new, signal an error."
+ (let ((archive-contents (package--read-archive-file
+ (concat "archives/" archive
+ "/archive-contents"))))
+ (if archive-contents
+ ;; Version 1 of 'archive-contents' is identical to our
+ ;; internal representation.
+ ;; TODO: merge archive lists
+ (dolist (package archive-contents)
+ (package--add-to-archive-contents package archive)))))
+
+(defun package--add-to-archive-contents (package archive)
+ "Add the PACKAGE from the given ARCHIVE if necessary.
+Also, add the originating archive to the end of the package vector."
+ (let* ((name (car package))
+ (version (aref (cdr package) 0))
+ (entry (cons (car package)
+ (vconcat (cdr package) (vector archive))))
+ (existing-package (cdr (assq name package-archive-contents))))
+ (when (or (not existing-package)
+ (package-version-compare version
+ (aref existing-package 0) '>))
+ (add-to-list 'package-archive-contents entry))))
+
(defun package-download-transaction (transaction)
"Download and install all the packages in the given transaction."
(dolist (elt transaction)
@@ -817,26 +856,21 @@
(defun package-install (name)
"Install the package named NAME.
Interactively, prompt for the package name.
-The package is found on the archive site, see `package-archive-base'."
+The package is found on one of the archives in `package-archive-base'."
(interactive
- (list (progn
- ;; Make sure we're using the most recent download of the
- ;; archive. Maybe we should be updating the archive first?
- (package-read-archive-contents)
- (intern (completing-read "Install package: "
- (mapcar (lambda (elt)
- (cons (symbol-name (car elt))
- nil))
- package-archive-contents)
- nil t)))))
+ (list (intern (completing-read "Install package: "
+ (mapcar (lambda (elt)
+ (cons (symbol-name (car elt))
+ nil))
+ package-archive-contents)
+ nil t))))
(let ((pkg-desc (assq name package-archive-contents)))
(unless pkg-desc
- (error "Package '%s' not available for installation"
+ (error "Package '%s' is not available for installation"
(symbol-name name)))
- (let ((transaction
- (package-compute-transaction (list name)
- (package-desc-reqs (cdr pkg-desc)))))
- (package-download-transaction transaction)))
+ (package-download-transaction
+ (package-compute-transaction (list name)
+ (package-desc-reqs (cdr pkg-desc)))))
;; Try to activate it.
(package-initialize))
@@ -996,20 +1030,28 @@
;; FIXME: query user?
'always))
-(defun package--download-one-archive (file)
- "Download a single archive file and cache it locally."
- (let ((buffer (url-retrieve-synchronously
- (concat package-archive-base file))))
+(defun package-archive-id (name)
+ "Return the archive containing the package NAME."
+ (let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
+ (cdr (assoc (aref desc (- (length desc) 1)) package-archives))))
+
+(defun package--download-one-archive (archive file)
+ "Download an archive file FILE from ARCHIVE, and cache it locally."
+ (let* ((archive-name (car archive))
+ (archive-url (cdr archive))
+ (dir (expand-file-name "archives" package-user-dir))
+ (dir (expand-file-name archive-name dir))
+ (buffer (url-retrieve-synchronously (concat archive-url file))))
(with-current-buffer buffer
(package-handle-response)
(re-search-forward "^$" nil 'move)
(forward-char)
(delete-region (point-min) (point))
- (setq buffer-file-name (concat (file-name-as-directory package-user-dir)
- file))
+ (make-directory dir t)
+ (setq buffer-file-name (expand-file-name file dir))
(let ((version-control 'never))
- (save-buffer))
- (kill-buffer buffer))))
+ (save-buffer)))
+ (kill-buffer buffer)))
(defun package-refresh-contents ()
"Download the ELPA archive description if needed.
@@ -1019,9 +1061,9 @@
(interactive)
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
- (package--download-one-archive "archive-contents")
- (package--download-one-archive "builtin-packages")
- (package-read-archive-contents))
+ (dolist (archive package-archives)
+ (package--download-one-archive archive "archive-contents"))
+ (package-read-all-archive-contents))
;;;###autoload
(defun package-initialize ()
@@ -1030,7 +1072,7 @@
(interactive)
(setq package-obsolete-alist nil)
(package-load-all-descriptors)
- (package-read-archive-contents)
+ (package-read-all-archive-contents)
;; Try to activate all our packages.
(mapc (lambda (elt)
(package-activate (car elt) (package-desc-vers (cdr elt))))
@@ -1306,11 +1348,12 @@
For single-file packages, shows the commentary section from the header.
For larger packages, shows the README file."
(interactive)
- (let* (start-point ok
- (pkg-name (package-menu-get-package))
- (buffer (url-retrieve-synchronously (concat package-archive-base
- pkg-name
- "-readme.txt"))))
+ (let* ((pkg-name (package-menu-get-package))
+ (buffer (url-retrieve-synchronously
+ (concat (package-archive-id pkg-name)
+ pkg-name
+ "-readme.txt")))
+ start-point ok)
(with-current-buffer buffer
;; FIXME: it would be nice to work with any URL type.
(setq start-point url-http-end-of-headers)
@@ -1322,7 +1365,7 @@
(insert "Package information for " pkg-name "\n\n")
(if ok
(insert-buffer-substring buffer start-point)
- (insert "This package does not have a README file or commentary
comment.\n"))
+ (insert "This package lacks a README file or commentary.\n"))
(goto-char (point-min))
(view-mode)))
(display-buffer new-buffer t))))
@@ -1355,7 +1398,6 @@
Emacs."
(interactive)
(goto-char (point-min))
- (forward-line 2)
(while (not (eobp))
(let ((cmd (char-after))
(pkg-name (package-menu-get-package))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r100925: Add support for non-default package repositories.,
Chong Yidong <=