Commit b689b906 authored by Jorgen Schaefer's avatar Jorgen Schaefer

Package archives now have priorities.

* lisp/package.el: Provide repository priorities.
(package-archive-priorities): New variable.
(package--add-to-alist): New function.
(package--add-to-archive-contents): Use it.
(package-menu--find-upgrades): Use it as well. Small clean up to
make the use of the package name here explicit.
(package-archive-priority): New function.
(package-desc-priority-version): New function.

Fixes: debbugs:19296
parent 5d244fec
2015-01-16 Jorgen Schaefer <contact@jorgenschaefer.de>
* lisp/package.el: Provide repository priorities.
(package-archive-priorities): New variable.
(package--add-to-alist): New function.
(package--add-to-archive-contents): Use it.
(package-menu--find-upgrades): Use it as well. Small clean up to
make the use of the package name here explicit.
(package-archive-priority): New function.
(package-desc-priority-version): New function.
2015-01-16 Daniel Colascione <dancol@dancol.org>
* cus-start.el (all): Make `ring-bell-function' customizable.
......
......@@ -228,6 +228,22 @@ a package can run arbitrary code."
:group 'package
:version "24.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 0."
: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,
......@@ -1114,23 +1130,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.
......@@ -1319,6 +1344,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'. If not given there, the priority
defaults to 0."
(or (cdr (assoc archive package-archive-priorities))
0))
(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),
......@@ -1991,18 +2035,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 ()
......
......@@ -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))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment