replace viper with bespoke modal

2 files changed, 214 insertions, 49 deletions

diff --git a/emacs/init.el b/emacs/init.el
index ffcbd00..27eef38 100644
--- a/emacs/init.el
+++ b/emacs/init.el
@@ -492,54 +492,6 @@ With ARG, don't save the current layout."
 (use-package battery ; battery in modeline etc
   )
 
-(progn ; viper, ancient vi emulation
-  (setq-default viper-want-ctl-h-help t
-                viper-inhibit-startup-message 't
-                viper-expert-level 5
-                viper-is-in-minibuffer nil
-                viper-vi-style-in-minibuffer nil
-                viper-enable-minibuffer-faces nil
-                viper-syntax-preference 'emacs
-                viper-ex-style-motion nil
-                viper-auto-indent t
-                viper-buffer-search-char ?g
-                viper-insert-state-mode-list nil
-                viper-vi-state-mode-list nil
-                viper-emacs-state-mode-list nil
-                viper-major-mode-modifier-list nil
-                viper-mode nil)
-  (require 'viper)
-  (require 'viper-ex)
-  (advice-add 'viper-this-major-mode-requires-vi-state :override
-              ;; when viper, always, otherwise never
-              (lambda (&rest r) viper-mode))
-  (advice-add 'viper-toggle-key-action :around
-              (lambda (func &optional arg)
-                (interactive "P")
-                (if arg
-                    (progn (toggle-viper-mode) (force-window-update))
-                  (and viper-mode (call-interactively func)))))
-  (define-key my/keys-mode-map (kbd "C-;") 'viper-ex)
-  (define-key my/keys-mode-map (kbd "C-z") 'viper-toggle-key-action)
-  (advice-add 'viper-ex :around 'my/display-lines-advice)
-  (define-key viper-vi-global-user-map (kbd "C-y") 'yank)
-  (define-key viper-vi-global-user-map (kbd "C-e") 'end-of-line)
-  (define-key viper-vi-global-user-map (kbd "C-f") 'forward-char)
-  (define-key viper-vi-global-user-map (kbd "C-b") 'backward-char)
-  (define-key viper-vi-global-user-map (kbd "C-u") 'universal-argument)
-  (define-key viper-insert-global-user-map (kbd "C-u") 'universal-argument)
-  (define-key viper-insert-global-user-map (kbd "C-d") 'delete-char)
-  ;; TODO this is still somehow broken, I get the completion and the newline
-  ;; (define-key viper-insert-global-user-map (kbd "RET")
-  ;;             #'(lambda ()
-  ;;                 (interactive)
-  ;;                 (if completion-in-region-mode
-  ;;                     (corfu-insert)
-  ;;                   (viper-autoindent))))
-                    )
-
-
-
 (progn ; indent code when pasting
   (require 'dash)
   (defvar yank-indent-modes '(prog-mode LaTeX-mode TeX-mode)
@@ -978,7 +930,7 @@ With ARG, don't save the current layout."
   :config
   (minions-mode 1)
   :custom
-  (minions-prominent-modes '(persp-mode auto-fill-mode eldoc-mode eglot-mode lsp-mode)))
+  (minions-prominent-modes '(my/temp-nonmodal-mode persp-mode auto-fill-mode eldoc-mode eglot-mode lsp-mode)))
 
 (use-package ispell ; spellchecker
   :demand t
@@ -992,6 +944,8 @@ With ARG, don't save the current layout."
   (advice-add 'ispell-mode :before 'debug)
   (setq-default text-mode-hook (cons 'ispell-minor-mode (remove 'ispell-mode text-mode-hook))))
 
+(load-file "/home/tmu/.emacs.d/site-lisp/my-modal.el")
+
 ;;; Optional files for occasional loading:
 
 ;; if you want exwm, include from ~/.emacs.d/site-lisp/my-exwm.el
diff --git a/emacs/site-lisp/my-modal.el b/emacs/site-lisp/my-modal.el
new file mode 100644
index 0000000..52cf8d3
--- /dev/null
+++ b/emacs/site-lisp/my-modal.el
@@ -0,0 +1,211 @@
+;;; bespoke vish modal -*- lexical-binding: t; -*-
+
+(require 's)
+
+
+(defun do-nothing () (interactive))
+
+(defun yank-looks-like-lines ()
+  (s-contains? "
+" (current-kill 0 t)))
+
+(defun paste-after-maybe-lines ()
+  (interactive)
+  (if (yank-looks-like-lines)
+      (progn
+        (move-end-of-line nil)
+        (newline)
+        (yank))
+    (forward-char-unless-eol)
+    (yank)))
+
+(defun paste-before-maybe-lines ()
+  (interactive)
+  (if (yank-looks-like-lines)
+      (progn
+        (move-beginning-of-line nil)
+        (yank))
+    (yank)))
+
+(defun forward-char-unless-eol (&optional arg)
+  (interactive "P")
+  (when (< (point) (point-at-eol)) (forward-char arg)))
+
+(defun mark-end-of-line (&optional arg)
+  (interactive "P")
+  (push-mark)
+  (move-end-of-line arg)
+  (exchange-point-and-mark))
+
+(defun mark-beginning-of-line (&optional arg)
+  (interactive "P")
+  (push-mark)
+  (move-beginning-of-line arg)
+  (exchange-point-and-mark))
+
+;; what I really want is a meta operator to invert the arg count,
+;; but between how ryo calls functions and expects symbols in binds,
+;; this is the best I can do.
+(defun mark-word-backward (&optional arg allow-extend)
+  (interactive "P\np")
+  (cond
+   ((null arg)
+    (setq arg -1))
+   ((numberp arg)
+    (setq arg (* -1 arg))))
+  (mark-word arg allow-extend))
+
+(defun mark-sexp-backward (&optional arg allow-extend)
+  (interactive "P\np")
+  (cond
+   ((null arg)
+    (setq arg -1))
+   ((numberp arg)
+    (setq arg (* -1 arg))))
+  (mark-sexp arg allow-extend))
+
+(defun mark-defun-backward (&optional arg interactive)
+  (interactive "p\nd")
+  (cond
+   ((null arg)
+    (setq arg -1))
+   ((numberp arg)
+    (setq arg (* -1 arg))))
+  (mark-defun arg interactive))
+
+(defun mark-paragraph-backward (&optional arg allow-extend)
+  (interactive "P\np")
+  (cond
+   ((null arg)
+    (setq arg -1))
+   ((numberp arg)
+    (setq arg (* -1 arg))))
+  (mark-paragraph arg allow-extend))
+
+(defconst my/ryo-digits '(("1" "C-1" :norepeat t)
+                          ("2" "C-2" :norepeat t)
+                          ("3" "C-3" :norepeat t)
+                          ("4" "C-4" :norepeat t)
+                          ("5" "C-5" :norepeat t)
+                          ("6" "C-6" :norepeat t)
+                          ("7" "C-7" :norepeat t)
+                          ("8" "C-8" :norepeat t)
+                          ("9" "C-9" :norepeat t)))
+
+(defconst my/ryo-moves '(("h" backward-char)
+                         ("j" next-line)
+                         ("k" previous-line)
+                         ("l" forward-char)
+
+                         ("e" forward-word)
+                         ("b" backward-word)
+                         ("E" forward-sexp)
+                         ("B" backward-sexp)
+
+                         ("0" "C-a")
+                         ("$" "C-e")
+
+                         ("[" beginning-of-defun)
+                         ("]" end-of-defun)
+                         ("{" backward-paragraph)
+                         ("}" forward-paragraph)
+                         ))
+
+(defconst my/ryo-marking-moves '(("h" backward-char :first (push-mark-command))
+                                 ("j" next-line :first (push-mark-command))
+                                 ("k" previous-line :first (push-mark-command))
+                                 ("l" forward-char :first (push-mark-command))
+
+                                 ("b" mark-word-backward)
+                                 ("e" mark-word)
+                                 ("B" mark-sexp-backward)
+                                 ("E" mark-sexp)
+
+                                 ("[" mark-defun-backward)
+                                 ("]" mark-defun)
+
+                                 ("0" mark-beginning-of-line)
+                                 ("$" mark-end-of-line)
+
+                                 ("{" mark-paragraph-backward)
+                                 ("}" mark-paragraph)
+                                 ))
+
+(defconst my/ryo-no-ops '(
+                          "<escape>"
+                          "`" "-" "+"
+                          "q" "w" "r" "t" "\\"
+                          "s" "f" ";" "'"
+                          "z" "n" "m" "," "."
+
+                          "~" "!" "@" "#" "%" "^" "&" "*" "(" ")" "_" "+"
+                          "Q" "W" "R" "T" "Y" "U" "|"
+                          "S" "D" "F" "H" "J" "K" "L" ":" "\""
+                          "Z" "X" "C" "V" "N" "M" "<" ">"
+                          ))
+
+
+
+(use-package ryo-modal
+  :demand t
+  :bind (:map my/keys-mode-map
+              ("C-c C-<space>" . ryo-modal-mode))
+  :config
+  (define-minor-mode my/temp-nonmodal-mode
+    "Minor mode for a temporary exit that should return to ryo-modal-mode."
+    :keymap (define-keymap
+              "<escape>"
+              'my/temp-nonmodal-mode)
+    :lighter " <NM>"
+    (ryo-modal-mode (if my/temp-nonmodal-mode -1 1)))
+
+  (let* ()
+    (eval
+     `(ryo-modal-keys
+       ,@my/ryo-moves
+       ,@my/ryo-digits
+       ,@(mapcar (lambda (key) (list key 'do-nothing)) my/ryo-no-ops)
+       ("g" (("g" beginning-of-buffer)))
+       ("G" end-of-buffer)
+
+       ("i" my/temp-nonmodal-mode)
+       ("I" back-to-indentation :then '(my/temp-nonmodal-mode))
+       ("a" forward-char-unless-eol :then '(my/temp-nonmodal-mode))
+       ("A" move-end-of-line :then '(my/temp-nonmodal-mode))
+       ("o" move-end-of-line :then '(newline-and-indent my/temp-nonmodal-mode))
+       ("O" move-beginning-of-line
+        :then '(open-line indent-according-to-mode my/temp-nonmodal-mode))
+
+       ("x" delete-char)
+       ("d" (("d" kill-whole-line)
+             ("m" kill-region)))
+       ("d" ,my/ryo-marking-moves :then '(kill-region))
+
+       ("c" (("c" kill-whole-line))
+        :then '(open-line my/temp-nonmodal-mode))
+       ("c" (("m" kill-region))
+        :then '(my/temp-nonmodal-mode))
+       ("C" kill-line :then '(my/temp-nonmodal-mode))
+       ("c" ,my/ryo-marking-moves :then '(kill-region my/temp-nonmodal-mode))
+
+       ("y" (("m" copy-region-as-kill)))
+       ("y" (("y" copy-region-as-kill))
+        :first '(push-mark move-beginning-of-line push-mark move-end-of-line forward-char)
+        :then '(pop-mark pop-to-mark-command))
+
+       ("P" paste-before-maybe-lines)
+       ("p" paste-after-maybe-lines)
+
+       ("/" isearch-forward-regexp)
+       ("?" isearch-backward-regexp)
+
+       ("u" undo)
+
+       ("SPC" set-mark-command)
+       ("v" set-mark-command)
+       )))
+  (setq ryo-modal-cursor-color "aquamarine")
+  (defun ryo-modal-unless-minibuffer ()
+    (unless (minibufferp)
+      (ryo-modal-mode 1)))
+  (add-hook 'after-change-major-mode-hook 'ryo-modal-unless-minibuffer))