From b83521edbb2fbb1b60346b528cdb82d882ad47ad Mon Sep 17 00:00:00 2001 From: jaremko Date: Fri, 29 Nov 2019 11:55:03 +0200 Subject: [PATCH] Add spacebind macro and tests for it --- core/core-spacebind.el | 275 ++++++++++++++ core/core-spacemacs.el | 1 + .../spacemacs-bootstrap/funcs.el | 18 + .../spacemacs-bootstrap/packages.el | 3 +- tests/core/Makefile | 1 + tests/core/core-spacebind-utest.el | 339 ++++++++++++++++++ .../+distribution/spacemacs-base/Makefile | 3 +- .../spacemacs-base/spacebind-utest.el | 113 ++++++ 8 files changed, 751 insertions(+), 2 deletions(-) create mode 100644 core/core-spacebind.el create mode 100644 tests/core/core-spacebind-utest.el create mode 100644 tests/layers/+distribution/spacemacs-base/spacebind-utest.el diff --git a/core/core-spacebind.el b/core/core-spacebind.el new file mode 100644 index 000000000..400982076 --- /dev/null +++ b/core/core-spacebind.el @@ -0,0 +1,275 @@ +;;; core-spacebind.el --- Spacemacs Core File +;; +;; Copyright (c) 2012-2020 Sylvain Benner & Contributors +;; +;; Author: Eugene "JAremko" Yaremenko +;; URL: https://github.com/syl20bnr/spacemacs +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 + +(require 'core-keybindings) + +;; TODO: Make this configurable. +(define-inline spacemacs/major-mode-prefix () + "Get current prefix for major modes." + "m") + +(define-inline spacemacs/leader-key () + "Returns `dotspacemacs-leader-key'" + dotspacemacs-leader-key) + +(defun spacebind//strip-docstring (binding-form) + "Remove second element of BINDING-FORM if it is a string." + (if (stringp (cadr binding-form)) + (cons (car binding-form) (cddr binding-form)) + binding-form)) + +(defun spacebind//nosp (str) + "Remove all white-spaces from STR." + (replace-regexp-in-string " +" "" str)) + +(defun spacemacs/add-key-based-replacements-for-minor-mode + (mode key-sequence replacement &rest more) + "Proxy for `which-key-add-key-based-replacements' +MODE currently ignored. +FIXME: We should disable replacements when the mode is disabled. +The function `which-key-add-major-mode-key-based-replacements' might give +a clue how to do this. +Also there is discussion about the feature: +https://github.com/justbur/emacs-which-key/issues/212" + (apply #'which-key-add-key-based-replacements key-sequence replacement more)) + +(cl-defstruct spacemacs--spacebind-state + "State object for `spacebind' macro implementation. +CTYPE - current binding type. +RSEXP - accumulator with the macro output. +This structure has one interpreter method for each supported CTYPE. +CTYPE is a type of a currently processed binding." + ctype rsexp) + +(cl-defgeneric spacemacs//spacebind-dispatch (state binding) + (:documentation "Based on BINDING type modify STATE using BINDING value.")) + +(cl-defmethod spacemacs//spacebind-dispatch ((state spacemacs--spacebind-state) + (keyword-or-symbol symbol)) + "If KEYWORD is a keyword, set STATE slot ctype(current type) to its value. +If KEYWORD is a non-keyword symbol (without \":\" prefix in the name), wrap +its value into a list and re-apply the function to it." + (if (not (keywordp keyword-or-symbol)) + (spacemacs//spacebind-dispatch state (list keyword-or-symbol)) + (setf (spacemacs--spacebind-state-ctype state) keyword-or-symbol) + state)) + +(cl-defmethod spacemacs//spacebind-dispatch ((state spacemacs--spacebind-state) + (sexp list)) + "Apply STATE method from ctype slot to SEXP and append output to rsexp slot." + (cl-callf append (spacemacs--spacebind-state-rsexp state) + (funcall (spacemacs--spacebind-state-ctype state) state sexp)) + state) + +(cl-defmethod spacemacs//spacebind-dispatch ((state spacemacs--spacebind-state) + (_ string)) + "Append STR to the RSEXP of STATE. Can be used as a doc-string." + state) + +(defun spacemacs//spacebind-form-visitor (form path k-fn p-fn) + "Applies K-FN to FORM if it is a key binding form. Otherwise applies P-FN. +PATH passed to the applied function. +NOTE: This function strips all newline characters, replaces successive spaces +with a singular in string elements of FORM and trims tails of function labels +delimited by \"|\" character." + (when-let ((fm (and (stringp (car-safe form)) + (seq-take form 3)))) + (list + (cl-destructuring-bind + (key-or-prefix + leader-label-or-fn-symbol + leader-label-or-next-form) + (mapcar (lambda (el) + (if (stringp el) + (replace-regexp-in-string "[\n[:space:]]+" " " el) + el)) + fm) + (let ((full-key-or-prefix (concat path " " key-or-prefix))) + (if (symbolp leader-label-or-fn-symbol) + (funcall k-fn + full-key-or-prefix + leader-label-or-fn-symbol + (replace-regexp-in-string + "[[:punct:][:space:]]*|.*" + "" + leader-label-or-next-form)) + (funcall p-fn + full-key-or-prefix + leader-label-or-fn-symbol))))))) + +(defun spacemacs//spacebind-form-walker-rec (path k-fn p-fn form) + "Recursive body of `spacemacs//spacebind-form-walker'." + (append + (spacemacs//spacebind-form-visitor form path k-fn p-fn) + (let* ((is-prefix-form (stringp (cadr form))) + (cur-path (if is-prefix-form + (concat path (car form)) + path)) + ;; Strip key and label from prefix forms. + (bindings (if is-prefix-form + (cddr form) + form))) + ;; Is it a list of bind forms? + (when (consp (car-safe bindings)) + (seq-mapcat + (apply-partially + 'spacemacs//spacebind-form-walker-rec + cur-path + k-fn + p-fn) + bindings))))) + +(defun spacemacs//spacebind-form-walker (b-forms k-fn p-fn) + "Part of `spacemacs--spacebind-state' interpreters implementation. +B-FORMS is a root node of a binding tree without mode (car of the root form). +K-FN called for each key binding node with 3 arguments: full_key_sequence, +function_symbol and label_for_leader_menu. +P-FN called for each prefix binding node with 2 arguments: +full_key_prefix_sequence and label_for_leader_menu. +Both K-FN and P-FN should return binding evaluation forms. +The forms will be concatenated and substituted by `spacebind' macro." + (spacemacs//spacebind-form-walker-rec "" k-fn p-fn b-forms)) + +;; Key bindings - keywords handlers + +(cl-defmethod :print-debug ((_ spacemacs--spacebind-state) form) + "`message' logging interpreter for debugging." + (let* ((form (spacebind//strip-docstring form)) + (mode (pop form))) + (spacemacs//spacebind-form-walker + form + (lambda (key-seq fn-symbol label) + `(message "Key binding visitor args: key-seq: %S fn-symbol: %S label: %S" + ,key-seq ,fn-symbol ,label)) + (lambda (key-prefix label) + `(message "Prefix binding visitor args: key-prefix: %S label: %S" + ,key-prefix ,label))))) + +(cl-defmethod :global ((_ spacemacs--spacebind-state) form) + "Interpreter for global binding forms." + (spacemacs//spacebind-form-walker + ;; Strip optional doc-string. + (if (char-or-string-p (car form)) + (cdr form) + form) + (lambda (key-seq fn-symbol label) + `(progn + (which-key-add-key-based-replacements + (concat (spacemacs/leader-key) " " ,key-seq) + ,label) + (spacemacs/set-leader-keys ,(spacebind//nosp key-seq) ',fn-symbol))) + (lambda (key-prefix label) + `(spacemacs/declare-prefix ,(spacebind//nosp key-prefix) ,label)))) + +(cl-defmethod :major ((_ spacemacs--spacebind-state) form) + "Interpreter for major mode binding forms." + (let* ((form (spacebind//strip-docstring form)) + (mode (pop form))) + (spacemacs//spacebind-form-walker + form + (lambda (key-seq fn-symbol label) + `(progn + (which-key-add-major-mode-key-based-replacements + ',mode + (string-join + (list (spacemacs/leader-key) + (spacemacs/major-mode-prefix) + ,key-seq) + " ") + ,label) + (spacemacs/set-leader-keys-for-major-mode + ',mode + (concat (spacemacs/major-mode-prefix) ,(spacebind//nosp key-seq)) + ',fn-symbol))) + (lambda (key-prefix label) + `(spacemacs/declare-prefix-for-mode + ',mode + (concat (spacemacs/major-mode-prefix) ,(spacebind//nosp key-prefix)) + ,label))))) + +(cl-defmethod :minor ((_ spacemacs--spacebind-state) form) + "Interpreter for minor mode binding forms." + (let* ((form (spacebind//strip-docstring form)) + (mode (pop form))) + (spacemacs//spacebind-form-walker + form + (lambda (key-seq fn-symbol label) + `(progn + (spacemacs/add-key-based-replacements-for-minor-mode + ',mode + (concat (spacemacs/leader-key) " " ,key-seq) + ,label) + (spacemacs/set-leader-keys-for-minor-mode + ',mode + ,(spacebind//nosp key-seq) + ',fn-symbol))) + (lambda (key-prefix label) + `(spacemacs/declare-prefix-for-mode + ',mode + ,(spacebind//nosp key-prefix) + ,label))))) + +(defmacro spacebind (&rest bindings) + "Bind keys and their prefixes declared via BINDINGS tree like structure. +BINDINGS format: + + + + ... + + + ... + ... + +DELIMITER_KEYWORD - specifies a type of following (or forms). +Currently supported types: :major, :minor and :global. + +:major and :minor bindings have this shape: +( + + + + ...) + +:global forms have a similar shape: +( + + + ...) + + is a string that will be used to generate a key-bindings +section in the corresponding README.org files. + + is a recursive form that can be: + A prefix form: + ( ) + Or a key-binding form: + ( ) + + is what will be displayed in the menu and used for the documentation +generation. + + and are singular keys represented as strings. + + is the function that will be bound to the . + +See core-spacebind-utest.el for examples. + +NOTE: This macro also has `use-package' integration via `:spacebind' key + +\(fn < ...>...)" + (spacemacs--spacebind-state-rsexp + (seq-reduce 'spacemacs//spacebind-dispatch + bindings + (make-spacemacs--spacebind-state + :rsexp `(progn))))) + +(provide 'core-spacebind) diff --git a/core/core-spacemacs.el b/core/core-spacemacs.el index 1f4682729..703a3625c 100644 --- a/core/core-spacemacs.el +++ b/core/core-spacemacs.el @@ -32,6 +32,7 @@ (require 'core-micro-state) (require 'core-transient-state) (require 'core-use-package-ext) +(require 'core-spacebind) (defgroup spacemacs nil "Spacemacs customizations." diff --git a/layers/+distributions/spacemacs-bootstrap/funcs.el b/layers/+distributions/spacemacs-bootstrap/funcs.el index 576290067..ae3f38ddd 100644 --- a/layers/+distributions/spacemacs-bootstrap/funcs.el +++ b/layers/+distributions/spacemacs-bootstrap/funcs.el @@ -212,3 +212,21 @@ the scroll transient state.") (if spacemacs--scroll-ts-full-hint-toggle spacemacs--scroll-ts-full-hint (concat "[" (propertize "?" 'face 'hydra-face-red) "] toggle help")))) + + + +(defun use-package-normalize/:spacebind (name-symbol keyword args) + (use-package-only-one (symbol-name keyword) args + (lambda (label arg) + (if (and (listp arg) (keywordp (car arg))) + arg + (use-package-error + ":spacebind wants an arg list compatible with `spacebind' macro"))))) + +(defun use-package-handler/:spacebind (name-symbol keyword args rest state) + (let ((body (use-package-process-keywords name-symbol rest state))) + (if (null args) + body + (use-package-concat + body + `((spacebind ,@args)))))) diff --git a/layers/+distributions/spacemacs-bootstrap/packages.el b/layers/+distributions/spacemacs-bootstrap/packages.el index 284a89e0c..3b7ece386 100644 --- a/layers/+distributions/spacemacs-bootstrap/packages.el +++ b/layers/+distributions/spacemacs-bootstrap/packages.el @@ -310,7 +310,8 @@ (setq use-package-verbose init-file-debug ;; inject use-package hooks for easy customization of stock package ;; configuration - use-package-inject-hooks t)) + use-package-inject-hooks t) + (add-to-list 'use-package-keywords :spacebind t)) (defun spacemacs-bootstrap/init-which-key () (require 'which-key) diff --git a/tests/core/Makefile b/tests/core/Makefile index c47786744..839eca0b5 100644 --- a/tests/core/Makefile +++ b/tests/core/Makefile @@ -14,6 +14,7 @@ TEST_DIR := $(shell dirname $(realpath $(lastword $(MAKEFILE_LIST)))) LOAD_FILES = core/core-versions.el core/core-load-paths.el UNIT_TEST_FILES = \ core-configuration-layer-utest.el \ + core-spacebind-utest.el \ core-funcs-utest.el FUNC_TEST_FILES = \ core-spacemacs-ftest.el \ diff --git a/tests/core/core-spacebind-utest.el b/tests/core/core-spacebind-utest.el new file mode 100644 index 000000000..59acaa0df --- /dev/null +++ b/tests/core/core-spacebind-utest.el @@ -0,0 +1,339 @@ +;;; core-spacebind-utest.el --- Spacemacs Unit Test File +;; +;; Copyright (c) 2012-2020 Sylvain Benner & Contributors +;; +;; Author: Eugene "JAremko" Yaremenko +;; URL: https://github.com/syl20bnr/spacemacs +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 +(require 'core-spacebind) +(require 'cl-lib) + +(defconst test-spacebind-moked-fns-sig + '((spacemacs/add-key-based-replacements-for-minor-mode + (MODE KEY-SEQUENCE REPLACEMENT &rest MORE)) + (spacemacs/declare-prefix + (PREFIX NAME &optional LONG-NAME)) + (spacemacs/declare-prefix-for-mode + (MODE PREFIX NAME &optional LONG-NAME)) + (spacemacs/set-leader-keys + (KEY DEF &rest BINDINGS)) + (spacemacs/set-leader-keys-for-major-mode + (MODE KEY DEF &rest BINDINGS)) + (spacemacs/set-leader-keys-for-minor-mode + (MODE KEY DEF &rest BINDINGS)) + (which-key-add-key-based-replacements + (KEY-SEQUENCE REPLACEMENT &rest MORE)) + (which-key-add-major-mode-key-based-replacements + (MODE KEY-SEQUENCE REPLACEMENT &rest MORE))) + "Signature of the functions that we will mock for the `spacebind' tests.") + +;;;; Helpers: +(defmacro test-spacebind/subst-eval (rep-fun &rest body) + "Substitute calls to binding functions with calls to REP-FUN. +REP-FUN applied to the form: (fn-sym (args)). +Binding functions are listed in `test-spacebind-moked-fns-sig'. " + `(cl-labels + ((spacemacs/leader-key () "SPC") + (spacemacs/major-mode-prefix () "m") + ,@(mapcar + (lambda (seg) + (let* ((f-s (car seg)) + (args (cadr seg)) + (pl-args (cl-set-difference args '(&rest &optional)))) + `(,f-s ,args (funcall ,rep-fun ',f-s (list ,@pl-args))))) + test-spacebind-moked-fns-sig)) + ,@body)) + +(defmacro test-spacebind/log-calls (&rest body) + "Evaluate BODY while mocking and logging calls to the binding functions. +The log is returned. +Binding functions are listed in `test-spacebind-moked-fns-sig'." + `(let ((acc nil)) + (test-spacebind/subst-eval + (lambda (fn args) (push (list* fn args) acc)) + ,@body) + acc)) + +;; Example: +(thread-last (spacebind + :major + (major-foo-mode + ("a" "section a" + ("a" foo-fn "execute foo-fn")))) + (test-spacebind/log-calls) + (format "%S") + (insert) + ;; Prevents execution + (declare)) + +;;;; Tests: +(ert-deftest test-spacebind-major-mode-always-generates-right-calls () + (should + (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + :major + (python-mode + "with a description" + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file"))))) + + '((spacemacs/set-leader-keys-for-major-mode + python-mode "mcc" spacemacs/python-execute-file nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m c c" "execute file" nil) + (spacemacs/declare-prefix-for-mode + python-mode "mc" "compile/execute" nil)) + :test 'equal)))) + +(ert-deftest test-spacebind-minor-mode-always-generates-right-calls () + (should + (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + :minor + (foo-mode + "With a description" + ("a" "section under a key" + ("b" baz-fn "call baz-fn"))))) + + '((spacemacs/set-leader-keys-for-minor-mode + foo-mode "ab" baz-fn nil) + (spacemacs/add-key-based-replacements-for-minor-mode + foo-mode "SPC a b" "call baz-fn" nil) + (spacemacs/declare-prefix-for-mode + foo-mode "a" "section under a key" nil)) + :test 'equal)))) + +(ert-deftest test-spacebind-global-always-generates-right-calls () + (should + (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + "With a description" + :global + (("a" "section under a key" + ("b" bar-fn "call bar-fn"))))) + '((spacemacs/set-leader-keys "ab" bar-fn nil) + (which-key-add-key-based-replacements "SPC a b" "call bar-fn" nil) + (spacemacs/declare-prefix "a" "section under a key" nil)) + :test 'equal)))) + +(ert-deftest test-spacebind-doc-string-always-ignored () + (should (equal (test-spacebind/log-calls + (spacebind + :major + (python-mode + "With a doc-string" + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file"))))) + (test-spacebind/log-calls + (spacebind + :major + (python-mode + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file"))))))) + (should (equal (test-spacebind/log-calls + (spacebind + :minor + (foo-mode + "With a doc-string" + ("a" "section under a key" + ("b" baz-fn "call baz-fn"))))) + (test-spacebind/log-calls + (spacebind + :minor + (foo-mode + "With a description" + ("a" "section under a key" + ("b" baz-fn "call baz-fn"))))))) + (should (equal (test-spacebind/log-calls + (spacebind + "With a doc-string" + :global + (("a" "section under a key" + ("b" bar-fn "call bar-fn"))))) + (test-spacebind/log-calls + (spacebind + :global + (("a" "section under a key" + ("b" bar-fn "call bar-fn")))))))) + +(ert-deftest test-spacebind-multy-section-always-work () + (should (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + :major + (major-foo-mode + ("a" "section a" + ("a" foo-fn "execute foo-fn"))) + :minor + (minor-foo-mode + ("b" "section b" + ("b" bar-fn "execute bar-fn"))) + :major + (major-bar-mode + ("c" "section c" + ("c" baz-fn "execute baz-fn"))) + :minor + (minor-bar-mode + ("d" "section d" + ("d" qux-fn "execute qux-fn"))) + :global + (("e" "section e" + ("e" quux-fn "execute quux-fn"))) + :global + (("f" "section f" + ("f" quuz-fn "execute quuz-fn"))))) + + '((spacemacs/set-leader-keys "ff" quuz-fn nil) + (which-key-add-key-based-replacements + "SPC f f" "execute quuz-fn" nil) + (spacemacs/declare-prefix + "f" "section f" nil) + (spacemacs/set-leader-keys + "ee" quux-fn nil) + (which-key-add-key-based-replacements + "SPC e e" "execute quux-fn" nil) + (spacemacs/declare-prefix + "e" "section e" nil) + (spacemacs/set-leader-keys-for-minor-mode + minor-bar-mode "dd" qux-fn nil) + (spacemacs/add-key-based-replacements-for-minor-mode + minor-bar-mode "SPC d d" "execute qux-fn" nil) + (spacemacs/declare-prefix-for-mode + minor-bar-mode "d" "section d" nil) + (spacemacs/set-leader-keys-for-major-mode + major-bar-mode "mcc" baz-fn nil) + (which-key-add-major-mode-key-based-replacements + major-bar-mode "SPC m c c" "execute baz-fn" nil) + (spacemacs/declare-prefix-for-mode + major-bar-mode "mc" "section c" nil) + (spacemacs/set-leader-keys-for-minor-mode + minor-foo-mode "bb" bar-fn nil) + (spacemacs/add-key-based-replacements-for-minor-mode + minor-foo-mode "SPC b b" "execute bar-fn" nil) + (spacemacs/declare-prefix-for-mode + minor-foo-mode "b" "section b" nil) + (spacemacs/set-leader-keys-for-major-mode + major-foo-mode "maa" foo-fn nil) + (which-key-add-major-mode-key-based-replacements + major-foo-mode "SPC m a a" "execute foo-fn" nil) + (spacemacs/declare-prefix-for-mode + major-foo-mode "ma" "section a" nil)) + :test 'equal)))) + +(ert-deftest test-spacebind-complex-always-generates-right-calls () + (should + (eq + '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + :major + (python-mode + "Docstring for documentation" + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file") + ("C" spacemacs/python-execute-file-focus "execute file and focus")) + ("d" "debug" + ("b" spacemacs/python-toggle-breakpoint "toggle breakpoint")) + ("r" "refactor" + ("i" spacemacs/python-remove-unused-imports "remove unused import")) + ("s" "REPL" + ("s" spacemacs/python-shell-send-buffer-switch + "send buffer to REPL and focus") + ("S" python-shell-send-buffer + "send buffer to REPL") + ("d" spacemacs/python-shell-send-defun-switch + "send function around point to REPL and focus") + ("D" python-shell-send-defun + "send function around point to REPL") + ("r" spacemacs/python-shell-send-region-switch + "send region to REPL and focus") + ("R" python-shell-send-region "send region to REPL"))) + :minor + (some-minor-mode + ("a" "section under a key" + ("b" "sub section under b key" + ("c" "sub sub section under c key" + ("b" baz-fn "call baz-fn"))))) + :global + (("a" "section under a key" + ("b" bar-fn "call bar-fn"))))) + + '((spacemacs/set-leader-keys + "ab" bar-fn nil) + (which-key-add-key-based-replacements + "SPC a b" "call bar-fn" nil) + (spacemacs/declare-prefix + "a" "section under a key" nil) + (spacemacs/set-leader-keys-for-minor-mode + some-minor-mode "abcb" baz-fn nil) + (spacemacs/add-key-based-replacements-for-minor-mode + some-minor-mode "SPC abc b" "call baz-fn" nil) + (spacemacs/declare-prefix-for-mode + some-minor-mode "abc" "sub sub section under c key" nil) + (spacemacs/declare-prefix-for-mode + some-minor-mode "ab" "sub section under b key" nil) + (spacemacs/declare-prefix-for-mode + some-minor-mode "a" "section under a key" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "msR" python-shell-send-region nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m s R" "send region to REPL" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "msr" spacemacs/python-shell-send-region-switch nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m s r" "send region to REPL and focus" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "msD" python-shell-send-defun nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m s D" "send function around point to REPL" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "msd" spacemacs/python-shell-send-defun-switch nil) + (which-key-add-major-mode-key-based-replacements + python-mode + "SPC m s d" + "send function around point to REPL and focus" + nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "msS" python-shell-send-buffer nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m s S" "send buffer to REPL" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "mss" spacemacs/python-shell-send-buffer-switch nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m s s" "send buffer to REPL and focus" nil) + (spacemacs/declare-prefix-for-mode + python-mode "ms" "REPL" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "mri" spacemacs/python-remove-unused-imports nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m r i" "remove unused import" nil) + (spacemacs/declare-prefix-for-mode + python-mode "mr" "refactor" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "mdb" spacemacs/python-toggle-breakpoint nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m d b" "toggle breakpoint" nil) + (spacemacs/declare-prefix-for-mode + python-mode "md" "debug" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "mcC" spacemacs/python-execute-file-focus nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m c C" "execute file and focus" nil) + (spacemacs/set-leader-keys-for-major-mode + python-mode "mcc" spacemacs/python-execute-file nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m c c" "execute file" nil) + (spacemacs/declare-prefix-for-mode + python-mode "mc" "compile/execute" nil)) + :test 'equal)))) diff --git a/tests/layers/+distribution/spacemacs-base/Makefile b/tests/layers/+distribution/spacemacs-base/Makefile index 78d731aeb..bf0640700 100644 --- a/tests/layers/+distribution/spacemacs-base/Makefile +++ b/tests/layers/+distribution/spacemacs-base/Makefile @@ -14,7 +14,8 @@ TEST_DIR := $(shell dirname $(realpath $(lastword $(MAKEFILE_LIST)))) LOAD_FILES = init.el UNIT_TEST_FILES = \ evil-evilified-state-utest.el \ - line-numbers-utest.el + line-numbers-utest.el \ + spacebind-utest.el FUNC_TEST_FILES = \ evil-evilified-state-ftest.el diff --git a/tests/layers/+distribution/spacemacs-base/spacebind-utest.el b/tests/layers/+distribution/spacemacs-base/spacebind-utest.el new file mode 100644 index 000000000..3daf876aa --- /dev/null +++ b/tests/layers/+distribution/spacemacs-base/spacebind-utest.el @@ -0,0 +1,113 @@ +;;; spacebind-utest.el --- Spacemacs Unit Test File +;; +;; Copyright (c) 2012-2020 Sylvain Benner & Contributors +;; +;; Author: Eugene "JAremko" Yaremenko +;; URL: https://github.com/syl20bnr/spacemacs +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 +(require 'core-spacebind) +(require 'cl-lib) + +(defconst test-spacebind-moked-fns-sig + '((spacemacs/add-key-based-replacements-for-minor-mode + (MODE KEY-SEQUENCE REPLACEMENT &rest MORE)) + (spacemacs/declare-prefix + (PREFIX NAME &optional LONG-NAME)) + (spacemacs/declare-prefix-for-mode + (MODE PREFIX NAME &optional LONG-NAME)) + (spacemacs/set-leader-keys + (KEY DEF &rest BINDINGS)) + (spacemacs/set-leader-keys-for-major-mode + (MODE KEY DEF &rest BINDINGS)) + (spacemacs/set-leader-keys-for-minor-mode + (MODE KEY DEF &rest BINDINGS)) + (which-key-add-key-based-replacements + (KEY-SEQUENCE REPLACEMENT &rest MORE)) + (which-key-add-major-mode-key-based-replacements + (MODE KEY-SEQUENCE REPLACEMENT &rest MORE))) + "Signature of the functions that we will mock for the `spacebind' tests.") + +;;;; Helpers: +(defmacro test-spacebind/subst-eval (rep-fun &rest body) + "Substitute calls to binding functions with calls to REP-FUN. +REP-FUN applied to the form: (fn-sym (args)). +Binding functions are listed in `test-spacebind-moked-fns-sig'. " + `(cl-labels + ((spacemacs/leader-key () "SPC") + (spacemacs/major-mode-prefix () "m") + ,@(mapcar + (lambda (seg) + (let* ((f-s (car seg)) + (args (cadr seg)) + (pl-args (cl-set-difference args '(&rest &optional)))) + `(,f-s ,args (funcall ,rep-fun ',f-s (list ,@pl-args))))) + test-spacebind-moked-fns-sig)) + ,@body)) + +(defmacro test-spacebind/log-calls (&rest body) + "Evaluate BODY while mocking and logging calls to the binding functions. +The log is returned. +Binding functions are listed in `test-spacebind-moked-fns-sig'." + `(let ((acc nil)) + (test-spacebind/subst-eval + (lambda (fn args) (push (cons fn args) acc)) + ,@body) + acc)) + +;; Example: +(thread-last (spacebind + :major + (major-foo-mode + ("a" "section a" + ("a" foo-fn "execute foo-fn")))) + (test-spacebind/log-calls) + (format "%S") + (insert) + ;; Prevents execution + (declare)) + +;;;; Tests: + +(ert-deftest test-spacebind-sanity-check () + (should + (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (spacebind + :major + (python-mode + "with a description" + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file"))))) + + '((spacemacs/set-leader-keys-for-major-mode + python-mode "mcc" spacemacs/python-execute-file nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m c c" "execute file" nil) + (spacemacs/declare-prefix-for-mode + python-mode "mc" "compile/execute" nil)) + :test 'equal)))) + +(ert-deftest test-spacebind-use-package-integration-works () + (should + (eq '() + (cl-set-exclusive-or + (test-spacebind/log-calls + (use-package use-package + :spacebind + (:major + (python-mode + "with a description" + ("c" "compile/execute" + ("c" spacemacs/python-execute-file "execute file")))))) + + '((spacemacs/set-leader-keys-for-major-mode + python-mode "mcc" spacemacs/python-execute-file nil) + (which-key-add-major-mode-key-based-replacements + python-mode "SPC m c c" "execute file" nil) + (spacemacs/declare-prefix-for-mode + python-mode "mc" "compile/execute" nil)) + :test 'equal))))