TakeV
/
spacemacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: add overriding rules for :toggle 

:toggle is ignored if not used in the owner of a package, it can
be overridden by new owners or by the dotfile.
This commit is contained in:
syl20bnr 2016-03-19 18:24:59 -04:00
parent bc31eb4878
commit c3bb8a609e
2 changed files with 108 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
core/core-configuration-layer.el
View File

@ -369,17 +369,18 @@ layer directory."
"Make `cfgl-layer' objects from the passed layer SYMBOLS."
(delq nil (mapcar 'configuration-layer/make-layer symbols)))
(defun configuration-layer/make-package (pkg &optional obj)
(defun configuration-layer/make-package (pkg &optional obj togglep)
"Return a `cfgl-package' object based on PKG.
If OBJ is non nil then copy PKG properties into OBJ, otherwise create
a new object.
Properties that can be copied are `:location', `:step' and `:excluded'."
Properties that can be copied are `:location', `:step' and `:excluded'.
If TOGGLEP is non nil then `:toggle' parameter is ignored."
(let* ((name-sym (if (listp pkg) (car pkg) pkg))
(name-str (symbol-name name-sym))
(location (when (listp pkg) (plist-get (cdr pkg) :location)))
(step (when (listp pkg) (plist-get (cdr pkg) :step)))
(excluded (when (listp pkg) (plist-get (cdr pkg) :excluded)))
(toggle (when (listp pkg) (plist-get (cdr pkg) :toggle)))
(toggle (when (and togglep (listp pkg)) (plist-get (cdr pkg) :toggle)))
(protected (when (listp pkg) (plist-get (cdr pkg) :protected)))
(copyp (not (null obj)))
(obj (if obj obj (cfgl-package name-str :name name-sym))))
@ -602,14 +603,15 @@ Properties that can be copied are `:location', `:step' and `:excluded'."
name pkg-name)))
(post-init-func (intern (format "%S/post-init-%S"
name pkg-name)))
(ownerp (fboundp init-func))
(obj (object-assoc pkg-name :name result)))
(cl-pushnew pkg-name (oref layer :packages))
(if obj
(setq obj (configuration-layer/make-package pkg obj))
(setq obj (configuration-layer/make-package pkg))
(setq obj (configuration-layer/make-package pkg obj ownerp))
(setq obj (configuration-layer/make-package pkg nil ownerp))
(push obj result))
(oset obj :lazy-install lazy-install)
(when (fboundp init-func)
(when ownerp
;; last owner wins over the previous one,
;; still warn about mutliple owners
(when (oref obj :owner)
@ -617,8 +619,14 @@ Properties that can be copied are `:location', `:step' and `:excluded'."
(format (concat "More than one init function found for "
"package %S. Previous owner was %S, "
"replacing it with layer %S.")
pkg (oref obj :owner) name)))
pkg-name (oref obj :owner) name)))
(oset obj :owner name))
(when (and (not ownerp)
(listp pkg)
(spacemacs/mplist-get pkg :toggle))
(spacemacs-buffer/warning
(format (concat "Ignoring :toggle for package %s because "
"layer %S does not own it.") pkg-name name)))
(when (fboundp pre-init-func)
(push name (oref obj :pre-layers)))
(when (fboundp post-init-func)
@ -629,8 +637,8 @@ Properties that can be copied are `:location', `:step' and `:excluded'."
(let* ((pkg-name (if (listp pkg) (car pkg) pkg))
(obj (object-assoc pkg-name :name result)))
(if obj
(setq obj (configuration-layer/make-package pkg obj))
(setq obj (configuration-layer/make-package pkg))
(setq obj (configuration-layer/make-package pkg obj t))
(setq obj (configuration-layer/make-package pkg nil t))
(push obj result)
(oset obj :owner 'dotfile))))
(dolist (xpkg dotspacemacs-excluded-packages)

91
tests/core/core-configuration-layer-utest.el
View File

@ -33,6 +33,8 @@
;; class cfgl-package
;; ---------------------------------------------------------------------------
;; method: cfgl-package-enabledp
(ert-deftest test-cfgl-package-enabledp--default-toggle-eval-non-nil ()
(let ((pkg (cfgl-package "testpkg" :name 'testpkg)))
(should (cfgl-package-enabledp pkg))))
@ -537,6 +539,95 @@
(should (equal (list (cfgl-package "pkg1" :name 'pkg1 :owner 'layer18 :excluded t))
(configuration-layer/get-packages layers))))))
(ert-deftest test-get-packages--owner-layer-can-define-toggle ()
(let* ((layer19 (cfgl-layer "layer19" :name 'layer19 :dir "/path"))
(layers (list layer19))
(layer19-packages '((pkg1 :toggle (foo-toggle))))
(mocker-mock-default-record-cls 'mocker-stub-record))
(defun layer19/init-pkg1 nil)
(mocker-let
((file-exists-p (f) ((:output t :occur 1)))
(configuration-layer/layer-usedp (l) ((:output t :occur 1))))
(should (equal (list (cfgl-package "pkg1"
:name 'pkg1
:owner 'layer19
:toggle '(foo-toggle)))
(configuration-layer/get-packages layers))))))
(ert-deftest test-get-packages--not-owner-layer-cannot-define-toggle ()
(let* ((layer20 (cfgl-layer "layer20" :name 'layer20 :dir "/path"))
(layer21 (cfgl-layer "layer21" :name 'layer21 :dir "/path"))
(layers (list layer20 layer21))
(layer20-packages '((pkg1)))
(layer21-packages '((pkg1 :toggle (foo-toggle))))
(mocker-mock-default-record-cls 'mocker-stub-record))
(defun layer20/init-pkg1 nil)
(defun layer21/post-init-pkg1 nil)
(mocker-let
((file-exists-p (f) ((:output t :occur 2)))
(spacemacs-buffer/warning (msg &rest args) ((:output nil :occur 1)))
(configuration-layer/layer-usedp (l) ((:output t :occur 2))))
(should (equal (list (cfgl-package "pkg1"
:name 'pkg1
:owner 'layer20
:post-layers '(layer21)
:toggle t))
(configuration-layer/get-packages layers))))))
(ert-deftest test-get-packages--new-owner-layer-can-override-toggle ()
(let* ((layer22 (cfgl-layer "layer22" :name 'layer22 :dir "/path"))
(layer23 (cfgl-layer "layer23" :name 'layer23 :dir "/path"))
(layers (list layer22 layer23))
(layer22-packages '((pkg1 :toggle (foo-toggle))))
(layer23-packages '((pkg1 :toggle (bar-toggle))))
(mocker-mock-default-record-cls 'mocker-stub-record))
(defun layer22/init-pkg1 nil)
(defun layer23/init-pkg1 nil)
(mocker-let
((file-exists-p (f) ((:output t :occur 2)))
(spacemacs-buffer/warning (msg &rest args) ((:output nil :occur 1)))
(configuration-layer/layer-usedp (l) ((:output t :occur 2))))
(should (equal (list (cfgl-package "pkg1"
:name 'pkg1
:owner 'layer23
:toggle '(bar-toggle)))
(configuration-layer/get-packages layers))))))
(ert-deftest test-get-packages--dotfile-additional-pkg-can-override-toggle ()
(let* ((layer22 (cfgl-layer "layer22" :name 'layer22 :dir "/path"))
(layer23 (cfgl-layer "layer23" :name 'layer23 :dir "/path"))
(layers (list layer22 layer23))
(layer22-packages '((pkg1 :toggle (foo-toggle))))
(layer23-packages '((pkg1 :toggle (bar-toggle))))
(mocker-mock-default-record-cls 'mocker-stub-record))
(defun layer22/init-pkg1 nil)
(defun layer23/init-pkg1 nil)
(mocker-let
((file-exists-p (f) ((:output t :occur 2)))
(spacemacs-buffer/warning (msg &rest args) ((:output nil :occur 1)))
(configuration-layer/layer-usedp (l) ((:output t :occur 2))))
(should (equal (list (cfgl-package "pkg1"
:name 'pkg1
:owner 'layer23
:toggle '(bar-toggle)))
(configuration-layer/get-packages layers))))))
(ert-deftest test-get-packages--dotfile-additional-pkg-can-override-toggle ()
(let* ((layer24 (cfgl-layer "layer24" :name 'layer24 :dir "/path"))
(layers (list layer24))
(layer24-packages '((pkg1 :toggle (foo-toggle))))
(dotspacemacs-additional-packages '((pkg1 :toggle (bar-toggle))))
(mocker-mock-default-record-cls 'mocker-stub-record))
(defun layer24/init-pkg1 nil)
(mocker-let
((file-exists-p (f) ((:output t :occur 1)))
(configuration-layer/layer-usedp (l) ((:output t :occur 1))))
(should (equal (list (cfgl-package "pkg1"
:name 'pkg1
:owner 'layer24
:toggle '(bar-toggle)))
(configuration-layer/get-packages layers t))))))
;; ---------------------------------------------------------------------------
;; configuration-layer//configure-package
;; ---------------------------------------------------------------------------