Package: emacs;
Reported by: Jorgen Schaefer <forcer <at> forcix.cx>
Date: Sun, 7 Dec 2014 13:24:01 UTC
Severity: wishlist
Tags: patch
Fixed in version 25.1
Done: Glenn Morris <rgm <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Jorgen Schaefer <forcer <at> forcix.cx> To: 19296 <at> debbugs.gnu.org Cc: Jorgen Schaefer <forcer <at> forcix.cx> Subject: bug#19296: [PATCH] Package archives now have priorities. Date: Sun, 7 Dec 2014 22:28:38 +0100
When installing packages by name, only packages from archives with
the highest priority are considered, before versions are compared.
This solves the "MELPA problem", where MELPA assigns date-based
version numbers to packages which override all other archives.
Giving MELPA a lower priority means packages are installed from
MELPA only when the package is not available from other archives.
This can be overridden manually by the user.
---
lisp/emacs-lisp/package.el | 107 ++++++++++++++++++++++++++++++----------
test/automated/package-test.el | 17 +++++++
2 files changed, 98 insertions(+), 26 deletions(-)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4e5c397..844e5ea 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -228,6 +228,33 @@ a package can run arbitrary code."
:group 'package
:version "24.1")
+(defcustom package-archive-default-priority 500
+ "The default priority for archives.
+
+This is used if the archive is not found in
+`package-archive-priorities'."
+ :type 'integer
+ :risky t
+ :group 'package
+ :version "25.1")
+
+(defcustom package-archive-priorities nil
+ "An alist of priorities for packages.
+
+Each element has the form (ARCHIVE-ID . PRIORITY).
+
+When installing packages, the package with the highest version
+number from the archive with the highest priority is
+selected. When higher versions are available from archives with
+lower priorities, the user has to select those manually.
+
+Archives not in this list have the priority given in
+`package-archive-default-priority'."
+ :type 'integer
+ :risky t
+ :group 'package
+ :version "25.1")
+
(defcustom package-pinned-packages nil
"An alist of packages that are pinned to specific archives.
This can be useful if you have multiple package archives enabled,
@@ -1063,23 +1090,32 @@ Also, add the originating archive to the `package-desc' structure."
;; Older archive-contents files have only 4
;; elements here.
(package--ac-desc-extras (cdr package)))))
- (existing-packages (assq name package-archive-contents))
(pinned-to-archive (assoc name package-pinned-packages)))
- (cond
- ;; Skip entirely if pinned to another archive.
- ((and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive)))
- nil)
- ((not existing-packages)
- (push (list name pkg-desc) package-archive-contents))
- (t
- (while
- (if (and (cdr existing-packages)
- (version-list-<
- version (package-desc-version (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))))))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--add-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--add-to-alist (pkg-desc alist)
+ "Add PKG-DESC to ALIST.
+
+Packages are grouped by name. The package descriptions are sorted
+by version number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
@@ -1268,6 +1304,25 @@ The file can either be a tar file or an Emacs Lisp file."
"Return the archive containing the package NAME."
(cdr (assoc (package-desc-archive desc) package-archives)))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities' and
+`package-archive-default-priority'."
+ (or (cdr (assoc archive package-archive-priorities))
+ package-archive-default-priority))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-archive-priority
+ (package-desc-archive pkg-desc))
+ (package-desc-version pkg-desc)))
+
(defun package--download-one-archive (archive file)
"Retrieve an archive file FILE from ARCHIVE, and cache it.
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
@@ -1940,18 +1995,18 @@ If optional arg BUTTON is non-nil, describe its associated package."
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "unsigned"))
- (push pkg-desc installed))
- ((member status '("available" "new"))
- (push (cons (package-desc-name pkg-desc) pkg-desc)
- available)))))
+ (cond ((member status '("installed" "unsigned"))
+ (push pkg-desc installed))
+ ((member status '("available" "new"))
+ (setq available (package--add-to-alist pkg-desc available))))))
;; Loop through list of installed packages, finding upgrades.
(dolist (pkg-desc installed)
- (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
- (and avail-pkg
- (version-list-< (package-desc-version pkg-desc)
- (package-desc-version (cdr avail-pkg)))
- (push avail-pkg upgrades))))
+ (let* ((name (package-desc-name pkg-desc))
+ (avail-pkg (cadr (assq name available))))
+ (and avail-pkg
+ (version-list-< (package-desc-priority-version pkg-desc)
+ (package-desc-priority-version avail-pkg))
+ (push (cons name avail-pkg) upgrades))))
upgrades))
(defun package-menu-mark-upgrades ()
diff --git a/test/automated/package-test.el b/test/automated/package-test.el
index 6e7994a..2a337fb 100644
--- a/test/automated/package-test.el
+++ b/test/automated/package-test.el
@@ -230,6 +230,23 @@ Must called from within a `tar-mode' buffer."
(package-refresh-contents)
(package-install 'simple-single)))
+(ert-deftest package-test-install-prioritized ()
+ "Install a lower version from a higher-prioritized archive."
+ (with-package-test ()
+ (let* ((newer-version (expand-file-name "data/package/newer-versions"
+ package-test-file-dir))
+ (package-archives `(("older" . ,package-test-data-dir)
+ ("newer" . ,newer-version)))
+ (package-archive-priorities '(("newer" . 100))))
+
+ (package-initialize)
+ (package-refresh-contents)
+ (package-install 'simple-single)
+
+ (let ((installed (cdr (assq 'simple-single package-alist))))
+ (should (version-list-= '(1 3)
+ (package-desc-version installed)))))))
+
(ert-deftest package-test-install-multifile ()
"Check properties of the installed multi-file package."
(with-package-test (:basedir "data/package" :install '(multi-file))
--
1.7.10.4
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.