Re: Package.el merged

[Phil Hagelberg <phil@hagelb.org>]

[-- Attachment #1: Type: text/plain, Size: 1023 bytes --]

On Thu, Jun 17, 2010 at 9:20 PM, Phil Hagelberg <phil@hagelb.org> wrote:
> I think I may have miscommunicated at some point; it looks like the
> version in Emacs right now is based on the one at tromey.com rather
> than my version from git that has had several bugfixes applied to it.
> I can try to replay the bugfixes in my branch on top of the version in
> Emacs, but it will probably be easier to apply your changes on top of
> mine. Am I correct in assuming that most of the changes were around
> adding the package-hold-alist variable?
>
> I will try to perform the merge and submit a patch that brings it up to date.

I've attached a set of patches that add my multi-source feature (plus
a couple other bug fixes) in. I've used the ChangeLog format for
commit messages; I'm not sure of the preferred style for patch
submission. I've tested it with a few sample repositories; anyone
interested in running it through the paces can try it for themselves
with this code:

http://p.hagelb.org/package-test.el.html

-Phil

[-- Attachment #2: 0001-2010-07-12-Phil-Hagelberg-technomancy-gmail.com.patch --]
[-- Type: text/x-patch, Size: 11641 bytes --]

From 07366aa9fbc5bb4ef272b5ad843b8b8d1f70461b Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <technomancy@gmail.com>
Date: Mon, 12 Jul 2010 22:10:40 -0700
Subject: [PATCH 1/5] 2010-07-12  Phil Hagelberg  <technomancy@gmail.com>

	* emacs-lisp/package.el: Support multiple archive sources from
	which to fetch packages. Replace package-archive-base with
	package-archives alist.
---
 lisp/emacs-lisp/package.el |  136 ++++++++++++++++++++++++++++----------------
 1 files changed, 87 insertions(+), 49 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index c603544..0278149 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -217,15 +217,19 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
 (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 (names and URLs) from which to fetch.
+The default points to the GNU package repository.
+Note that some code in package.el assumes that this is an http: URL."
+  :type '(alist :key-type (string :tag "Archive name")
+                :value-type (string :tag "Archive URL"))
+  :group 'package)
 
 (defconst package-archive-version 1
   "Version number of the package archive understood by this file.
 Lower version numbers than this will probably be understood as well.")
 
+;; TODO: this doesn't match the version in the comments header
 (defconst package-el-version "1.0"
   "Version of package.el.")
 
@@ -234,8 +238,9 @@ Lower version numbers than this will probably be understood as well.")
   "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.")
 
 (defcustom package-user-dir (locate-user-emacs-file "elpa")
   "Directory containing the user's Emacs Lisp packages.
@@ -361,16 +366,14 @@ E.g., if given \"quux-23.0\", will return \"quux\""
       (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.
+  "Load the description file in directory DIR for a PACKAGE.
 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))))
+  (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.
@@ -670,7 +673,7 @@ It will move point to somewhere in the headers."
 (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-for name)
 			 (symbol-name name) "-" version ".el"))))
     (with-current-buffer buffer
       (package-handle-response)
@@ -683,7 +686,7 @@ It will move point to somewhere in the headers."
 (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-for name)
 			     (symbol-name name) "-" version ".tar"))))
     (with-current-buffer tar-buffer
       (package-handle-response)
@@ -772,16 +775,13 @@ Will throw an error if the archive version is too new."
 		       (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 +793,36 @@ Throw an error if the archive version is too new."
 		  (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 they exist.
+
+Will set `package-archive-contents' and `package--builtins' if
+successful. Will throw an error if the archive version is too
+new."
+  (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 needed.
+
+Adds the archive from which it came to the end of the package vector."
+  (let* ((package-name (car package))
+         (package-version (aref (cdr package) 0))
+         (package-with-archive (cons (car package)
+                                     (vconcat (cdr package) (vector archive))))
+         (existing-package (cdr (assq package-name package-archive-contents))))
+    (when (or (not existing-package)
+              (package-version-compare package-version
+                                       (aref existing-package 0) '>))
+      (add-to-list 'package-archive-contents package-with-archive))))
+
 (defun package-download-transaction (transaction)
   "Download and install all the packages in the given transaction."
   (dolist (elt transaction)
@@ -817,25 +847,22 @@ Throw an error if the archive version is too new."
 (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 the archive sites, see `package-archives'."
   (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)))))
+           (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"
-	     (symbol-name name)))
+             (symbol-name name)))
     (let ((transaction
-	   (package-compute-transaction (list name)
-					(package-desc-reqs (cdr pkg-desc)))))
+           (package-compute-transaction (list name)
+                                        (package-desc-reqs (cdr pkg-desc)))))
       (package-download-transaction transaction)))
   ;; Try to activate it.
   (package-initialize))
@@ -996,19 +1023,30 @@ The file can either be a tar file or an Emacs Lisp file."
 		     ;; 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))))
-    (with-current-buffer buffer
+(defun package-archive-for (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 a single archive file and cache it locally.
+
+Downloads the archive index from ARCHIVE and stores it in FILE."
+  (let* ((archive-name (car archive))
+         (archive-url (cdr archive))
+         (buffer (url-retrieve-synchronously (concat archive-url file))))
+    (save-excursion
+      (set-buffer buffer)
       (package-handle-response)
       (re-search-forward "^$" nil 'move)
       (forward-char)
       (delete-region (point-min) (point))
+      (make-directory (concat (file-name-as-directory package-user-dir)
+                              "archives/" archive-name) t)
       (setq buffer-file-name (concat (file-name-as-directory package-user-dir)
-				     file))
+                                     "archives/" archive-name "/" file))
       (let ((version-control 'never))
-	(save-buffer))
+        (save-buffer))
       (kill-buffer buffer))))
 
 (defun package-refresh-contents ()
@@ -1019,9 +1057,9 @@ download."
   (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 +1068,7 @@ The variable `package-load-list' controls which packages to load."
   (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))))
@@ -1308,7 +1346,7 @@ 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
+	 (buffer (url-retrieve-synchronously (concat (package-archive-for pkg-name)
 						     pkg-name
 						     "-readme.txt"))))
     (with-current-buffer buffer
-- 
1.7.0.4


[-- Attachment #3: 0002-2010-07-12-Phil-Hagelberg-technomancy-gmail.com.patch --]
[-- Type: text/x-patch, Size: 857 bytes --]

From 57ea8c3a3f8b7270a4ecbe813b4778f1f21f0a51 Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <technomancy@gmail.com>
Date: Mon, 12 Jul 2010 22:11:06 -0700
Subject: [PATCH 2/5] 2010-07-12  Phil Hagelberg  <technomancy@gmail.com>

	* emacs-lisp/package.el: Fix a bug preventing the first two
    packages in the list from being installed.
---
 lisp/emacs-lisp/package.el |    1 -
 1 files changed, 0 insertions(+), 1 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 0278149..4dbae56 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1393,7 +1393,6 @@ Note that after installing packages you will want to restart
 Emacs."
   (interactive)
   (goto-char (point-min))
-  (forward-line 2)
   (while (not (eobp))
     (let ((cmd (char-after))
 	  (pkg-name (package-menu-get-package))
-- 
1.7.0.4


[-- Attachment #4: 0003-2010-07-12-Phil-Hagelberg-technomancy-gmail.com.patch --]
[-- Type: text/x-patch, Size: 1341 bytes --]

From 08640f9eed6d9d155ecf42d021bc99d4f57d7449 Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <technomancy@gmail.com>
Date: Mon, 12 Jul 2010 22:13:48 -0700
Subject: [PATCH 3/5] 2010-07-12  Phil Hagelberg  <technomancy@gmail.com>

	* emacs-lisp/package.el: Fix bug in package-installed-p which
    would prevent packages from installing if an older version of
    their dependencies was already present.
---
 lisp/emacs-lisp/package.el |    8 ++++----
 1 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4dbae56..df3295e 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -695,12 +695,12 @@ It will move point to somewhere in the headers."
       (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-desc-vers (cdr pkg-desc))
-				  '>=))))
+         (package-version-compare min-version
+                                  (package-desc-vers (cdr pkg-desc))
+                                  '<=))))
 
 (defun package-compute-transaction (result requirements)
   (dolist (elt requirements)
-- 
1.7.0.4


[-- Attachment #5: 0004-2010-07-12-Shawn-Hoover-shawn.hoover-gmail.com.patch --]
[-- Type: text/x-patch, Size: 1959 bytes --]

From 75c9de51ab431185e6cb8c50cc6b9517e65b1367 Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <technomancy@gmail.com>
Date: Mon, 12 Jul 2010 22:25:23 -0700
Subject: [PATCH 4/5] 2010-07-12  Shawn Hoover  <shawn.hoover@gmail.com>

	* emacs-lisp/package.el: Set buffer-file-coding-system to
    'no-conversion when unpacking. This fixes problems on Windows.
---
 lisp/emacs-lisp/package.el |   13 ++++++++-----
 1 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index df3295e..63dab02 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -616,20 +616,23 @@ Otherwise it uses an external `tar' program.
       (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
-- 
1.7.0.4


[-- Attachment #6: 0005-2010-07-13-Phil-Hagelberg-technomancy-gmail.com.patch --]
[-- Type: text/x-patch, Size: 4100 bytes --]

From 13b0cac8e027fcaad0ce1823f20afd4b692161fa Mon Sep 17 00:00:00 2001
From: Phil Hagelberg <technomancy@gmail.com>
Date: Tue, 13 Jul 2010 21:36:26 -0700
Subject: [PATCH 5/5] 2010-07-13  Phil Hagelberg  <technomancy@gmail.com>

	* emacs-lisp/package.el: Remove references to ELPA, since we are
    no longer pointing at Tromey's archive. Update header comments
---
 lisp/emacs-lisp/package.el |   24 ++++++++++++------------
 1 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 63dab02..0f43fa6 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -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 will be named "NAME-VERSION.el" remotely but will be
 ;; 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 will download all dependent packages.  By default
+;; packages will 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
@@ -67,9 +66,9 @@
 
 ;; Conceptually a package has multiple state transitions:
 ;;
-;; * Download.  Fetching the package from ELPA.
+;; * Download.  Fetching the package from a remote archive source.
 ;; * Install.  Untar the package, or write the .el file, into
-;;   ~/.emacs.d/elpa/ directory.
+;;   the package-user-dir.
 ;; * Byte compile.  Currently this phase is done during install,
 ;;   but we may change this.
 ;; * Activate.  Evaluate the autoloads for the package to make it
@@ -83,7 +82,8 @@
 ;;    packages.  You can choose packages for install (mark with "i",
 ;;    then "x" to execute) or deletion (not implemented yet), and you
 ;;    can see what packages are available.  This will automatically
-;;    fetch the latest list of packages from ELPA.
+;;    fetch the latest list of packages from the sources specified in
+;;    the package-archives alist.
 ;;
 ;; M-x package-list-packages-no-fetch
 ;;    Like package-list-packages, but does not automatically fetch the
@@ -1053,7 +1053,7 @@ Downloads the archive index from ARCHIVE and stores it in FILE."
       (kill-buffer buffer))))
 
 (defun package-refresh-contents ()
-  "Download the ELPA archive description if needed.
+  "Download the archive descriptions if needed.
 Invoking this will ensure that Emacs knows about the latest versions
 of all packages.  This will let Emacs make them available for
 download."
@@ -1229,7 +1229,7 @@ The variable `package-load-list' controls which packages to load."
 		  :help "Update the list of packages"))
     (define-key menu-map [mr]
       '(menu-item "Refresh package list" package-menu-refresh
-		  :help "Download the ELPA archive"))
+		  :help "Download the archive listings"))
     (define-key menu-map [s4] '("--"))
     (define-key menu-map [mt]
       '(menu-item "Mark obsolete packages" package-menu-mark-obsolete-for-deletion
@@ -1273,7 +1273,7 @@ Letters do not insert themselves; instead, they are commands.
     (run-hooks 'package-menu-mode-hook)))
 
 (defun package-menu-refresh ()
-  "Download the ELPA archive.
+  "Download the archive listings.
 This fetches the file describing the current contents of
 the Emacs Lisp Package Archive, and then refreshes the
 package menu.  This lets you see what new packages are
-- 
1.7.0.4