diff --git a/core/core-configuration-layer.el b/core/core-configuration-layer.el index 2054c46e6..397b9ba4d 100644 --- a/core/core-configuration-layer.el +++ b/core/core-configuration-layer.el @@ -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 diff --git a/tests/core/core-configuration-layer-utest.el b/tests/core/core-configuration-layer-utest.el index 474ff9e9d..18b562aa8 100644 --- a/tests/core/core-configuration-layer-utest.el +++ b/tests/core/core-configuration-layer-utest.el @@ -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\\'\\)")))))