diff --git a/core/core-configuration-layer.el b/core/core-configuration-layer.el index b100553d0..81c17533d 100644 --- a/core/core-configuration-layer.el +++ b/core/core-configuration-layer.el @@ -2192,6 +2192,40 @@ Original code from dochang at https://github.com/dochang/elpa-clone" (prin1 archive-contents (current-buffer)) (save-buffer))))) +(defun configuration-layer//package-install-org (func &rest args) + "Advice around `package-install' to patch package name and dependencies at +install time in order to replace all `org' package installation by +`org-plus-contrib'. We avoid installing unecessarily both `org' and +`org-plus-contrib' at the same time (i.e. we always install `org-plus-contrib')" + (let* ((pkg (car args)) + (patched + (cond + ;; patch symbol name + ((and (symbolp pkg) (eq 'org pkg)) + (setcar args 'org-plus-contrib) + t) + ;; patch name in package-desc object + ((and (package-desc-p pkg) + (eq 'org (package-desc-name pkg))) + (setf (package-desc-name pkg) 'org-plus-contrib) + t) + ;; patch dependencies in package-desc object + ((and (package-desc-p pkg) + (assq 'org (package-desc-reqs pkg))) + (setf (car (assq 'org (package-desc-reqs pkg))) 'org-plus-contrib) + t)))) + (let ((name (if (package-desc-p pkg) + (package-desc-name pkg) + pkg))) + ;; check manually if `org-plus-contrib' is already installed since + ;; package.el may install `org-plus-contrib' more than once. + ;; Maybe we could hook somewhere else (at transaction computation time?) + (if (or patched (eq 'org-plus-contrib name)) + (unless (package-installed-p name) + (apply func args)) + (apply func args))))) +(advice-add 'package-install :around #'configuration-layer//package-install-org) + (defun configuration-layer//increment-error-count () "Increment the error counter." (if configuration-layer-error-count diff --git a/tests/core/core-configuration-layer-utest.el b/tests/core/core-configuration-layer-utest.el index 8101d791d..b87c0e83b 100644 --- a/tests/core/core-configuration-layer-utest.el +++ b/tests/core/core-configuration-layer-utest.el @@ -2319,3 +2319,123 @@ (cadr (assq 'recipe stats)) (cadr (assq 'local stats)) (cadr (assq 'built-in stats))))))) + +;; --------------------------------------------------------------------------- +;; configuration-layer//package-install-org +;; --------------------------------------------------------------------------- + +(defun --test-package-install-org--symbol-name (pkg-name) + (mocker-let + ((package-installed-p (org-plus-contrib) + ((:record-cls 'mocker-stub-record + :output nil :occur 1))) + (identity (x) ((:input '(org-plus-contrib) :output nil :occur 1)))) + (configuration-layer//package-install-org 'identity pkg-name))) + +(defun --package-install-org--symbol-name-already-installed (pkg-name) + (mocker-let + ((package-installed-p (org-plus-contrib) + ((:record-cls 'mocker-stub-record + :output t :occur 1)))) + (configuration-layer//package-install-org 'identity pkg-name))) + +(defun --test-package-install-org--package-desc-name (pkg-desc) + (mocker-let + ((package-installed-p (org-plus-contrib) + ((:record-cls 'mocker-stub-record + :output nil :occur 1))) + (identity (x) ((:input `(,pkg-desc) :output nil :occur 1)))) + (configuration-layer//package-install-org 'identity pkg-desc))) + +(defun --package-install-org--package-desc-name-already-installed (pkg-desc) + (mocker-let + ((package-installed-p (org-plus-contrib) + ((:record-cls 'mocker-stub-record + :output t :occur 1)))) + (configuration-layer//package-install-org 'identity pkg-desc))) + +(defun --test-package-install-org--package-desc-reqs (pkg-desc) + (mocker-let + ((package-installed-p (x) ((:record-cls 'mocker-stub-record + :output nil :occur 1)))) + (configuration-layer//package-install-org 'identity pkg-desc))) + +(ert-deftest test-package-install-org--symbol-name-org () + (--test-package-install-org--symbol-name 'org)) + +(ert-deftest test-package-install-org--symbol-name-org-plus-contrib () + (--test-package-install-org--symbol-name 'org-plus-contrib)) + +(ert-deftest test-package-install-org--symbol-name-org-already-installed () + (should (null (--package-install-org--symbol-name-already-installed 'org)))) + +(ert-deftest + test-package-install-org--symbol-name-org-plus-contrib-already-installed () + (should (null (--package-install-org--symbol-name-already-installed + 'org-plus-contrib)))) + +(ert-deftest test-package-install-org--no-effect-on-symbol-name-other-packages () + (let ((pkg (configuration-layer//package-install-org 'identity 'foo))) + (should (eq 'foo pkg )))) + +(ert-deftest test-package-install-org--package-desc-name-org () + (let ((pkg (package-desc-create :name 'org + :version '(7) + :summary "Dummy Org package desc" + :reqs nil))) + (--test-package-install-org--package-desc-name pkg))) + +(ert-deftest test-package-install-org--package-desc-name-org-already-installed () + (let ((pkg (package-desc-create :name 'org + :version '(7) + :summary "Dummy Org package desc" + :reqs nil))) + (--package-install-org--package-desc-name-already-installed pkg))) + +(ert-deftest test-package-install-org--package-desc-name-org-plus-contrib () + (let ((pkg (package-desc-create :name 'org-plus-contrib + :version '(7) + :summary "Dummy org-plus-contrib package desc" + :reqs nil))) + (--test-package-install-org--package-desc-name pkg))) + +(ert-deftest + test-package-install-org--package-desc-name-org-plus-contrib-already-installed () + (let ((pkg (package-desc-create :name 'org-plus-contrib + :version '(7) + :summary "Dummy org-plus-contrib package desc" + :reqs nil))) + (--package-install-org--package-desc-name-already-installed pkg))) + +(ert-deftest test-package-install-org--package-desc-reqs-org () + (let ((pkg (package-desc-create :name 'dummy + :version '(7) + :summary "Dummy package desc" + :reqs '((org 7))))) + (mocker-let + ((package-installed-p (x) ((:record-cls 'mocker-stub-record + :output nil :occur 1)))) + (let ((patched-pkg (configuration-layer//package-install-org + 'identity pkg))) + (should (equal + (package-desc-create :name 'dummy + :version '(7) + :summary "Dummy package desc" + :reqs '((org-plus-contrib 7))) + patched-pkg)))))) + +(ert-deftest test-package-install-org--package-desc-reqs-org-contrib-plus () + (let ((pkg (package-desc-create :name 'dummy + :version '(7) + :summary "Dummy package desc" + :reqs '((org-plus-contrib 7))))) + (let ((patched-pkg (configuration-layer//package-install-org 'identity pkg))) + (should (equal pkg patched-pkg))))) + +(ert-deftest test-package-install-org--no-effect-on-package-desc-other-packages () + (let ((pkg (package-desc-create :name 'dummy + :version '(7) + :summary "Dummy package desc" + :reqs '((foo 7))))) + (let ((patched-pkg (configuration-layer//package-install-org 'identity pkg))) + (should (equal pkg patched-pkg)))))