From 8c60f0d71295f8de44b012777cf9fde82bfef504 Mon Sep 17 00:00:00 2001 From: syl20bnr Date: Sat, 27 Jun 2015 23:49:18 -0400 Subject: [PATCH] WIP automated evilification of maps --- core/core-evilify-keymap.el | 69 +++++++++++++++++++++-- core/tests/core-evilify-keymap-utest.el | 74 +++++++++++++++++++++++-- 2 files changed, 133 insertions(+), 10 deletions(-) diff --git a/core/core-evilify-keymap.el b/core/core-evilify-keymap.el index 1f65c3bd4..f1914995a 100644 --- a/core/core-evilify-keymap.el +++ b/core/core-evilify-keymap.el @@ -35,8 +35,8 @@ (symbol-value map))) ;; (let* ((ekeys (mapcar 'car (cdr evil-evilified-state-map)))) ;; (mapc (lambda (entry) - ;; (apply (spacemacs//evilify-entry-func entry ekeys) '(entry map))) - ;; (cdr (symbol-value map)))) + ;; (apply (spacemacs//evilify-entry-func entry ekeys) (list entry map))) + ;; (cdr map))) ;; keep a list of all evilified modes (when mode (add-to-list 'evil-evilified-state--modes mode) @@ -44,13 +44,14 @@ (delq mode evil-emacs-state-modes) (add-to-list 'evil-evilified-state-modes mode)))) -(defun spacemacs//evilify-entry-func (entry evilified-events) +(defun spacemacs//evilify-entry-func (entry &optional evilified-events) "Return a function symbol responsible to process the keymap ENTRY." (let ((func (cond ((char-table-p entry) 'spacemacs//evilify-char-table) ((and (listp entry) (numberp (car entry))) - (when (member (car entry) evilified-events) + (when (or (null evilified-events) + (member (car entry) evilified-events)) (cond ((characterp (car entry)) (cond @@ -62,8 +63,66 @@ 'spacemacs//evilify-shift-ascii-event))))))) (if func func 'ignore))) +(defmacro spacemacs||evilify-event (event value map &rest body) + "Evilify an event according to passed BODY." + (declare (indent defun)) + `(let* ((new-event (spacemacs//evilify-next-event ,map ,event)) + (new-entry (assoc new-event (cdr ,map)))) + (if (null new-event) + (message "Warning: Could not rebind event \"%s\" (map %S)" + (char-to-string ,event) ,map) + (when new-entry + ;; new-event is already bound in MAP so we process it before + ;; for instance if MAP has already 'k' and 'K', then we move 'K' + ;; first to 'C-k' and then we are able to move 'k' to 'K'. + (apply (spacemacs//evilify-entry-func entry) (list new-entry map))) + ,@body))) + (defun spacemacs//evilify-ascii-event-command-binding (entry map) - "Evilify an ascii event with a command binding.") + "Evilify an ascii event with a command binding." + (let* ((event (car entry)) + (value (cdr entry))) + ;; (message "event: %s" event) + (spacemacs||evilify-event event value map + ;; remap + (define-key map `[remap ,value] (spacemacs//evilify-make-wrapper map event value)) + ;; move original event to new-event + (define-key map (char-to-string new-event) + `(lambda () + (interactive) + (call-interactively ',value))) + ;; delete old event + (setf (cdr map) (delq (assoc event (cdr map)) (cdr map))) + ;; (message "body-remap-map: %s" map) + ))) + + ;; (let ((new-event (spacemacs//evilify-next-event (symbol-value map) event)) + ;; (wrapper (spacemacs//evilify-make-wrapper map event value))) + ;; (if (null new-event) + ;; (message "Warning: Could not rebind event \"%s\" (map %S)" + ;; (char-to-string event) map) + ;; (when (assoc new-event (cdr (symbol-value map))) + ;; ;; new-event is already bound in MAP so we process it before + ;; ;; for instance if MAP has 'k' and 'K', then we move 'K' first + ;; ;; to 'C-k' and we will be able to move 'k' on 'K'. + ;; (message "new event: %s" new-event) + ;; (spacemacs//evilify-remap-binding + ;; map new-event (lookup-key (symbol-value map) + ;; (kbd (char-to-string new-event))))) + ;; ;; remap event + ;; (if (keymapp value) + ;; (progn + ;; (eval `(define-key ,map ,(char-to-string event) ',wrapper))) + ;; (eval `(define-key ,map [remap ,value] ',wrapper))) + ;; ;; move original command or keymap on a new event + ;; (if new-event + ;; (if (keymapp value) + ;; (eval `(define-key ,map ,(char-to-string new-event) ',value)) + ;; (eval `(define-key ,map ,(char-to-string new-event) + ;; (lambda () + ;; (interactive) + ;; (call-interactively ',value)))))))) + ;; ) (defun spacemacs//evilify-remap-binding (map event value) "Remap VALUE binding in MAP." diff --git a/core/tests/core-evilify-keymap-utest.el b/core/tests/core-evilify-keymap-utest.el index d68ff785c..6fd240489 100644 --- a/core/tests/core-evilify-keymap-utest.el +++ b/core/tests/core-evilify-keymap-utest.el @@ -31,6 +31,12 @@ (should (eq 'spacemacs//evilify-ascii-event-command-binding (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?s)))))) +(ert-deftest test-evilify-keymap-entry-func--command-s-nil-evilified-keys () + (let ((map (make-sparse-keymap))) + (define-key map "s" 'func) + (should (eq 'spacemacs//evilify-ascii-event-command-binding + (spacemacs//evilify-entry-func (nth 0 (cdr map)) nil))))) + (ert-deftest test-evilify-keymap-entry-func--command-S () (let ((map (make-sparse-keymap))) (define-key map "S" 'func) @@ -60,6 +66,13 @@ (should (eq 'spacemacs//evilify-ascii-event-keymap-binding (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?s)))))) +(ert-deftest test-evilify-keymap-entry-func--keymap-s-nil-evilified-keys () + (let ((map (make-sparse-keymap)) + (submap (make-sparse-keymap))) + (define-key map "s" submap) + (should (eq 'spacemacs//evilify-ascii-event-keymap-binding + (spacemacs//evilify-entry-func (nth 0 (cdr map)) nil))))) + (ert-deftest test-evilify-keymap-entry-func--keymap-S () (let ((map (make-sparse-keymap)) (submap (make-sparse-keymap))) @@ -99,6 +112,13 @@ (should (eq 'ignore (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?S)))))) +(ert-deftest test-evilify-keymap-entry-func--ignore-lambda-s-nil-evilified-keys () + (let ((map (make-sparse-keymap)) + (submap (make-sparse-keymap))) + (define-key map "s" (lambda () (interactive) 'dummy)) + (should (eq 'ignore + (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?a)))))) + (ert-deftest test-evilify-keymap-entry-func--ignore-lambda-C-s () (let ((map (make-sparse-keymap)) (submap (make-sparse-keymap)) @@ -124,33 +144,77 @@ (should (eq 'ignore (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?s)))))) -;; not evilified +;; ignore if not in passed evilified keys (ert-deftest test-evilify-keymap-entry-func--ignore-command-s-not-evilified () (let ((map (make-sparse-keymap))) (define-key map "s" 'func) (should (eq 'ignore - (spacemacs//evilify-entry-func (nth 0 (cdr map)) nil))))) + (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?a)))))) (ert-deftest test-evilify-keymap-entry-func--ignore-keymap-s-not-evilified () (let ((map (make-sparse-keymap)) (submap (make-sparse-keymap))) (define-key map "s" submap) (should (eq 'ignore - (spacemacs//evilify-entry-func (nth 0 (cdr map)) nil))))) + (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?a)))))) (ert-deftest test-evilify-keymap-entry-func--ignore-lambda-s-not-evilified () (let ((map (make-sparse-keymap)) (submap (make-sparse-keymap))) (define-key map "s" (lambda () (interactive) 'dummy)) (should (eq 'ignore - (spacemacs//evilify-entry-func (nth 0 (cdr map)) nil))))) - + (spacemacs//evilify-entry-func (nth 0 (cdr map)) '(?a)))))) ;; --------------------------------------------------------------------------- ;; spacemacs//evilify-ascii-event-command-binding ;; --------------------------------------------------------------------------- +(ert-deftest test-evilify-ascii-event-command-binding--s () + (let ((evil-evilified-state-map (let ((map (make-sparse-keymap))) + (define-key map "s" 'evil-func) + map)) + (map (make-sparse-keymap))) + (define-key map "s" 'func) + (spacemacs//evilify-ascii-event-command-binding (nth 0 (cdr map)) map) + (should (equal '(keymap + (83 . (lambda () (interactive) + (call-interactively (quote func)))) + (remap . (keymap (func . spacemacs/evilified-func)))) + map)))) + +;; (ert-deftest test-evilify-ascii-event-command-binding--s-and-S () +;; (let ((evil-evilified-state-map (let ((map (make-sparse-keymap))) +;; (define-key map "s" 'evil-func) +;; map)) +;; (map (make-sparse-keymap))) +;; (define-key map "s" 'func1) +;; (define-key map "S" 'func2) +;; (spacemacs//evilify-ascii-event-command-binding (nth 1 (cdr map)) map) +;; (should (equal '(keymap +;; (83 . (lambda () (interactive) +;; (call-interactively (quote func)))) +;; (remap . (keymap (func . spacemacs/evilified-func)))) +;; map)))) + +;; --------------------------------------------------------------------------- +;; spacemacs/evilify-map +;; --------------------------------------------------------------------------- + +;; (setq evil-evilified-state-map (let ((map (make-sparse-keymap))) +;; (define-key map "s" 'evil-func) +;; map)) + +;; (ert-deftest test-evilify-map--called-twice-with-command-s () +;; (let ((map (make-sparse-keymap))) +;; (define-key map "s" 'func) +;; (spacemacs/evilify-map map) +;; (spacemacs/evilify-map map) +;; (should (equal '(keymap +;; (83 . (lambda () (interactive) +;; (call-interactively (quote func)))) +;; (remap . (keymap (func . spacemacs/evilified-func)))) +;; map)))) ;; TO UPDATE