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

core: new interactive function to insert lazy installation config

Browse source 
New function configuration-layer/insert-lazy-install-configuration
This function asks for a layer and then insert the lazy configuration
for all the packages owned by this layer.
This commit is contained in:
syl20bnr 2016-03-05 23:21:55 -05:00
parent 1bc773cc5f
commit f6657a5382
2 changed files with 156 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
core/core-configuration-layer.el
View file

@ -15,6 +15,7 @@
(require 'cl-lib)
(require 'eieio)
(require 'subr-x)
(require 'package)
(require 'warnings)
(require 'help-mode)
@ -66,7 +67,7 @@
(packages :initarg :packages
:initform nil
:type list
:documentation "List of package names declared in this layer.")
:documentation "List of package symbols declared in this layer.")
(variables :initarg :variables
:initform nil
:type list
@ -82,6 +83,20 @@
:documentation "A list of layer where this layer is disabled."))
"A configuration layer.")
(defmethod cfgl-layer-owned-packages ((layer cfgl-layer))
"Return the list of owned packages by LAYER.
LAYER has to be installed for this method to work properly."
(delq nil (mapcar
(lambda (x)
(let ((pkg (object-assoc x :name configuration-layer--packages)))
(when (and pkg (eq (oref layer :name) (oref pkg :owner)))
x)))
(oref layer :packages))))
(defmethod cfgl-layer-owned-packages ((layer nil))
"Accept nil as argument and return nil."
nil)
(defclass cfgl-package ()
((name :initarg :name
:type symbol
@ -1528,6 +1543,55 @@ to select one."
(spacemacs-buffer/append "\n"))
(spacemacs-buffer/message "No orphan package to delete."))))
(defun configuration-layer//gather-auto-mode-extensions (mode)
"Return a regular expression matching all the extensions associate to MODE."
(let (gather-extensions)
(dolist (x auto-mode-alist)
(let ((ext (car x))
(auto-mode (cdr x)))
(when (and (stringp ext)
(symbolp auto-mode)
(eq auto-mode mode))
(push (car x) gather-extensions))))
(when gather-extensions
(concat "\\("
(string-join gather-extensions "\\|")
"\\)"))))
(defun configuration-layer//lazy-install-extensions-for-layer (layer-symbol)
"Return an alist of owned modes and extensions for the passed layer."
(let* ((layer (object-assoc layer-symbol :name configuration-layer--layers))
(packages (cfgl-layer-owned-packages layer))
result)
(dolist (pkg-sym packages)
(dolist (mode (list pkg-sym (intern (format "%S-mode" pkg-sym))))
(let ((ext (configuration-layer//gather-auto-mode-extensions mode)))
(when ext (push (cons mode ext) result)))))
result))
(defun configuration-layer//insert-lazy-install-form (mode ext)
"Insert a configuration form for lazy installation of MODE."
(let ((str (concat "(configuration-layer/lazy-install '"
(symbol-name mode)
" :extensions '("
(let ((print-quoted t)) (prin1-to-string ext))
"))\n")))
(insert str)))
(defun configuration-layer/insert-lazy-install-configuration ()
"Prompt for a layer and insert the forms to configure lazy installation."
(interactive)
(let ((layer-sym
(completing-read
"Choose a used layer"
(sort (object-assoc-list :name configuration-layer--layers)
(lambda (x y)
(string< (oref (cdr x) :name) (oref (cdr y) :name)))))))
(let ((mode-exts (configuration-layer//lazy-install-extensions-for-layer
(intern layer-sym))))
(dolist (x mode-exts)
(configuration-layer//insert-lazy-install-form (car x) (cdr x))))))
(defun configuration-layer//increment-error-count ()
"Increment the error counter."
(if configuration-layer-error-count

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

@ -11,6 +11,24 @@
(require 'mocker)
(require 'core-configuration-layer)
;; ---------------------------------------------------------------------------
;; class cfgl-layer
;; ---------------------------------------------------------------------------
(ert-deftest test-cfgl-layer-owned-packages--owns-packages ()
(let ((layer1 (cfgl-layer "layer1"
:name 'layer1
:packages '(pkg1 pkg2 pkg3 pkg4)))
(configuration-layer--packages
(list (cfgl-package "pkg1" :name 'pkg1 :owner 'layer2)
(cfgl-package "pkg2" :name 'pkg2 :owner 'layer1)
(cfgl-package "pkg3" :name 'pkg3 :owner 'layer1)
(cfgl-package "pkg4" :name 'pkg4 :owner 'layer2))))
(should (equal '(pkg2 pkg3) (cfgl-layer-owned-packages layer1)))))
(ert-deftest test-cfgl-layer-owned-packages--nil-layer-returns-nil ()
(should (null (cfgl-layer-owned-packages nil))))
;; ---------------------------------------------------------------------------
;; class cfgl-package
;; ---------------------------------------------------------------------------
@ -1044,3 +1062,76 @@
((file-directory-p (f)
((:record-cls 'mocker-stub-record :output t :occur 1))))
(should (eq 'cat (configuration-layer//get-category-from-path input))))))
;; ---------------------------------------------------------------------------
;; configuration-layer//gather-auto-mode-extensions
;; ---------------------------------------------------------------------------
(ert-deftest test-gather-auto-mode-extensions--one-entry-in-auto-mode-alist ()
(let ((auto-mode-alist '(("\\.spacemacs\\'" . mode))))
(should (equal
"\\(\\.spacemacs\\'\\)"
(configuration-layer//gather-auto-mode-extensions 'mode)))))
(ert-deftest test-gather-auto-mode-extensions--several-entries-in-auto-mode-alist ()
(let ((auto-mode-alist '(("\\.spacemacs\\'" . mode)
("\\.dotspacemacs\\'" . mode)
("\\.spacelayer\\'" . mode))))
(should (equal
"\\(\\.spacelayer\\'\\|\\.dotspacemacs\\'\\|\\.spacemacs\\'\\)"
(configuration-layer//gather-auto-mode-extensions 'mode)))))
(ert-deftest test-gather-auto-mode-extensions--ext-entry-is-not-symbol ()
(let ((auto-mode-alist '(((nil t) . mode))))
(should (null (configuration-layer//gather-auto-mode-extensions 'mode)))))
(ert-deftest test-gather-auto-mode-extensions--mode-entry-is-not-symbol ()
(let ((auto-mode-alist '(("ext" . (lambda nil nil)))))
(should (null (configuration-layer//gather-auto-mode-extensions 'mode)))))
(ert-deftest test-gather-auto-mode-extensions--regexp-correctness ()
"Correctness is a big word here :-)"
(let ((regexp (configuration-layer//gather-auto-mode-extensions
'emacs-lisp-mode)))
(should (string-match-p regexp "/_emacs"))
(should (string-match-p regexp "/.toto_gnus"))
(should (string-match-p regexp "/.toto_viper"))
(should (string-match-p regexp "/toto/emacs.el"))
(should (string-match-p regexp "/toto/project.ede"))
(should (not (string-match-p regexp "/toto/emacs.dummy")))))
;; ---------------------------------------------------------------------------
;; configuration-layer//lazy-install-extensions-for-layer
;; ---------------------------------------------------------------------------
(ert-deftest test-lazy-install-extensions-for-layer--owned-packages ()
(let ((configuration-layer--layers
(list (cfgl-layer "layer" :name 'layer :packages '(pkg1 pkg2))))
(configuration-layer--packages
(list (cfgl-package "pkg1" :name 'pkg1 :owner 'layer)
(cfgl-package "pkg2" :name 'pkg2 :owner 'layer)))
(auto-mode-alist '(("\\.pkg1\\'" . pkg1)
("\\.pkg2\\'" . pkg2))))
(should (equal '((pkg2 . "\\(\\.pkg2\\'\\)")
(pkg1 . "\\(\\.pkg1\\'\\)"))
(configuration-layer//lazy-install-extensions-for-layer 'layer)))))
(ert-deftest test-lazy-install-extensions-for-layer--not-owned-package ()
(let ((configuration-layer--layers
(list (cfgl-layer "layer" :name 'layer :packages '(pkg1))))
(configuration-layer--packages
(list (cfgl-package "pkg1" :name 'pkg1 :owner 'other)))
(auto-mode-alist '(("\\.pkg1\\'" . pkg1))))
(should (null (configuration-layer//lazy-install-extensions-for-layer 'layer)))))
;; ---------------------------------------------------------------------------
;; configuration-layer//insert-lazy-install-form
;; ---------------------------------------------------------------------------
(ert-deftest test-insert-lazy-install-form ()
(cl-letf (((symbol-function 'insert) 'identity))
(should
(equal
(concat "(configuration-layer/lazy-install 'mode "
":extensions '(\"\\\\(\\\\.ext\\\\'\\\\)\"))\n")
(configuration-layer//insert-lazy-install-form 'mode "\\(\\.ext\\'\\)")))))