emacs fix modal colors and add special state

1 files changed, 45 insertions, 17 deletions

diff --git a/config/emacs/site-lisp/my-modal.el b/config/emacs/site-lisp/my-modal.el
index c885544..0759fe5 100644
--- a/config/emacs/site-lisp/my-modal.el
+++ b/config/emacs/site-lisp/my-modal.el
@@ -3,8 +3,6 @@
 (require 's)
 (require 'dash)
 
-(toggle-debug-on-error)
-
 (defun mm/do-nothing () (interactive))
 
 (defmacro mm/compose-command (first cmd then)
@@ -98,7 +96,7 @@ trigger EFFECT or consult UNTIL."
 (defvar-local mm/state 'nil)
 (defvar mm/all-states '())
 ;; pairs of (state-mode-symbol . cursor color)
-(defvar mm/state-color-alist '())
+(defvar mm/state-color-alist (list (cons nil (face-background 'cursor))))
 
 (defmacro mm/transition-state (to)
   `(lambda ()
@@ -107,7 +105,8 @@ trigger EFFECT or consult UNTIL."
      (funcall ,to 1)))
 
 (defmacro mm/define-state (name lighter color keymap enable disable)
-  `(progn
+  `(let ((lighter ,lighter))
+     (add-face-text-property 0 (length lighter) '(:foreground ,color) t lighter)
      (define-minor-mode ,name
        "TODO This is a modal state."
        :init-value nil
@@ -125,9 +124,7 @@ trigger EFFECT or consult UNTIL."
          )
        )
      (add-to-list 'mm/all-states ',name)
-     (add-to-list 'mm/state-color-alist (cons ',name ,color))
-     )
-  )
+     (add-to-list 'mm/state-color-alist (cons ',name ,color))))
 
 ;; TODO consider an entry action that indents the line? maybe controlled by a variable?
 (mm/define-state mm/base-state-mode
@@ -181,6 +178,17 @@ trigger EFFECT or consult UNTIL."
                  nil
                  nil)
 
+(mm/define-state mm/special-state-mode
+                 " <S>"
+                 "light sea green"
+                 `(,@mm/moves
+                   ,@mm/digits
+                   (,(kbd "SPC") . set-mark-command)
+                   ;; TODO introude mm/last-state and add yank here
+                   )
+                 nil
+                 nil)
+
 (mm/define-state mm/delete-state-mode
                  " <D>"
                  "red"
@@ -314,37 +322,57 @@ trigger EFFECT or consult UNTIL."
 
 (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))))
 
+(defvar mm/special-modes '())
+
+(defun mm/pick-starting-state (&optional buffer)
+  (unless buffer (setq buffer (current-buffer)))
+  (with-current-buffer buffer
+    (let ((pick (if (or buffer-read-only
+                        (memq major-mode mm/special-modes))
+                    'mm/special-state-mode
+                  'mm/normal-state-mode)))
+      pick)))
+
+(defun mm/enable-starting-state (&optional buffer)
+  (unless (minibufferp)
+    (unless buffer (setq buffer (current-buffer)))
+    (with-current-buffer buffer
+      (funcall (mm/pick-starting-state buffer) 1))))
+
+(defun mm/enable-starting-state-unless-set  (&optional buffer)
+  (unless buffer (setq buffer (current-buffer)))
+  (unless (or (minibufferp) (string-match-p "^ " (buffer-name buffer)))
+    (with-current-buffer buffer
+      (unless mm/state
+        (funcall (mm/pick-starting-state buffer) 1)))))
+
 (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)
+        (add-hook 'after-change-major-mode-hook 'mm/enable-starting-state-unless-set)
         (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)))
+            (mm/transition-state (mm/pick-starting-state))
+          (mm/enable-starting-state)))
     (progn
-      (remove-hook 'after-change-major-mode-hook 'mm/enable-normal-state)
+      (remove-hook 'after-change-major-mode-hook 'mm/enable-starting-state-unless-set)
       (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))))
+      (setq mm/state nil)
+      (set-face-background 'cursor (alist-get nil mm/state-color-alist)))))
 
 ;; And we're off!
 (mm/global-modal-mode 1)