From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jorgen Schaefer Newsgroups: gmane.emacs.bugs Subject: bug#19296: [PATCH] Package archives now have priorities. Date: Sun, 7 Dec 2014 22:28:38 +0100 Message-ID: <20141207214345.A8216200D2E@loki.jorgenschaefer.de> References: <20141207132244.A14A7200D1E@loki.jorgenschaefer.de> NNTP-Posting-Host: plane.gmane.org X-Trace: ger.gmane.org 1417988666 29656 80.91.229.3 (7 Dec 2014 21:44:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 7 Dec 2014 21:44:26 +0000 (UTC) Cc: Jorgen Schaefer To: 19296@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sun Dec 07 22:44:20 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Xxjcq-0008Kh-1H for geb-bug-gnu-emacs@m.gmane.org; Sun, 07 Dec 2014 22:44:20 +0100 Original-Received: from localhost ([::1]:59273 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xxjcp-0000rs-ML for geb-bug-gnu-emacs@m.gmane.org; Sun, 07 Dec 2014 16:44:19 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:41718) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xxjcg-0000mv-GU for bug-gnu-emacs@gnu.org; Sun, 07 Dec 2014 16:44:17 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XxjcY-0004qk-M3 for bug-gnu-emacs@gnu.org; Sun, 07 Dec 2014 16:44:10 -0500 Original-Received: from debbugs.gnu.org ([140.186.70.43]:59408) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XxjcY-0004qE-Hq for bug-gnu-emacs@gnu.org; Sun, 07 Dec 2014 16:44:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1XxjcX-0000Qi-UF for bug-gnu-emacs@gnu.org; Sun, 07 Dec 2014 16:44:02 -0500 X-Loop: help-debbugs@gnu.org In-Reply-To: <20141207132244.A14A7200D1E@loki.jorgenschaefer.de> Resent-From: Jorgen Schaefer Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 07 Dec 2014 21:44:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 19296 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 19296-submit@debbugs.gnu.org id=B19296.14179886311617 (code B ref 19296); Sun, 07 Dec 2014 21:44:01 +0000 Original-Received: (at 19296) by debbugs.gnu.org; 7 Dec 2014 21:43:51 +0000 Original-Received: from localhost ([127.0.0.1]:56621 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XxjcM-0000Q1-RW for submit@debbugs.gnu.org; Sun, 07 Dec 2014 16:43:51 -0500 Original-Received: from loki.jorgenschaefer.de ([87.230.15.51]:34953) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1XxjcJ-0000Pm-1u for 19296@debbugs.gnu.org; Sun, 07 Dec 2014 16:43:48 -0500 Original-Received: by loki.jorgenschaefer.de (Postfix, from userid 1000) id A8216200D2E; Sun, 7 Dec 2014 22:43:45 +0100 (CET) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:96967 Archived-At: 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