emacs: repeat keys and modal fixes

1 files changed, 40 insertions, 10 deletions

diff --git a/config/emacs/site-lisp/my-modal.el b/config/emacs/site-lisp/my-modal.el
index b026fe9..c885544 100644
--- a/config/emacs/site-lisp/my-modal.el
+++ b/config/emacs/site-lisp/my-modal.el
@@ -3,6 +3,8 @@
 (require 's)
 (require 'dash)
 
+(toggle-debug-on-error)
+
 (defun mm/do-nothing () (interactive))
 
 (defmacro mm/compose-command (first cmd then)
@@ -93,8 +95,10 @@ trigger EFFECT or consult UNTIL."
                       "Z" "X" "C" "V" "N" "M" "<" ">"
                       ))
 
-(defvar-local mm/state 'mm/normal-state-mode)
-(defvar mm/all-states '() )
+(defvar-local mm/state 'nil)
+(defvar mm/all-states '())
+;; pairs of (state-mode-symbol . cursor color)
+(defvar mm/state-color-alist '())
 
 (defmacro mm/transition-state (to)
   `(lambda ()
@@ -121,6 +125,7 @@ trigger EFFECT or consult UNTIL."
          )
        )
      (add-to-list 'mm/all-states ',name)
+     (add-to-list 'mm/state-color-alist (cons ',name ,color))
      )
   )
 
@@ -171,7 +176,8 @@ trigger EFFECT or consult UNTIL."
                                                 (open-line 1)
                                                 (funcall indent-line-function))
                                                (mm/transition-state 'mm/base-state-mode)
-                                               nil)))
+                                               nil))
+                   ("x" . delete-char))
                  nil
                  nil)
 
@@ -182,7 +188,10 @@ trigger EFFECT or consult UNTIL."
                    ,@mm/digits
                    ,@(mapcar (lambda (key) (cons key 'keyboard-quit))
                              mm/no-ops)
-                   ("m" . mm/do-nothing)
+                   ("m" . ,(mm/compose-command
+                            ((pop-mark))
+                            'mm/do-nothing
+                            nil))
                    ("d" . ,(mm/compose-command ((pop-mark)
                                                 (move-beginning-of-line nil)
                                                 (push-mark)
@@ -227,7 +236,10 @@ trigger EFFECT or consult UNTIL."
                    ,@mm/digits
                    ,@(mapcar (lambda (key) (cons key 'keyboard-quit))
                              mm/no-ops)
-                   ("m" . mm/do-nothing)
+                   ("m" . ,(mm/compose-command
+                            ((pop-mark))
+                            'mm/do-nothing
+                            nil))
                    ("c" . ,(mm/compose-command ((pop-mark)
                                                 (move-beginning-of-line nil)
                                                 (push-mark)
@@ -300,21 +312,39 @@ trigger EFFECT or consult UNTIL."
                       (copy-region-as-kill nil nil t))
                     )))
 
-(setq minions-prominent-modes (append mm/all-states minions-prominent-modes))
+(mapc (lambda (mode) (add-to-list 'minions-prominent-modes mode)) mm/all-states)
 
 (defun mm/enable-normal-state ()
   (interactive)
   (unless (minibufferp)
     (mm/normal-state-mode 1)))
 
+(defun mm/ensure-color (frame)
+  (interactive)
+  (let ((color (alist-get mm/state mm/state-color-alist)))
+    (when color
+      (set-face-background 'cursor color))))
+
 (define-minor-mode mm/global-modal-mode
   "Makes buffers start in normal state."
   :global t
   :interactive t
   (if mm/global-modal-mode
-      (progn (add-hook 'after-change-major-mode-hook 'mm/enable-normal-state)
-             (mm/enable-normal-state))
-    (remove-hook 'after-change-major-mode-hook 'mm/enable-normal-state)))
+      (progn
+        (add-hook 'after-change-major-mode-hook 'mm/enable-normal-state)
+        (add-hook 'window-selection-change-functions 'mm/ensure-color)
+        (add-hook 'window-buffer-change-functions 'mm/ensure-color)
+        (if mm/state
+            (mm/transition-state 'mm/normal-state-mode)
+          (mm/enable-normal-state)))
+    (progn
+      (remove-hook 'after-change-major-mode-hook 'mm/enable-normal-state)
+      (remove-hook 'window-selection-change-functions 'mm/ensure-color)
+      (remove-hook 'window-buffer-change-functions 'mm/ensure-color)
+      (setq this-command 'keyboard-quit)
+      (mm/transition-state 'mm/normal-state-mode)
+      (mm/normal-state-mode -1)
+      (setq mm/state nil))))
 
 ;; And we're off!
-;; (mm/global-modal-mode 1)
+(mm/global-modal-mode 1)