logo-320.png

Take Control of Meta

Do you use key chords to copy and paste text? Do you use the arrow keys to move the cursor? Although useful, key chords and special purpose keys are often painfully inaccessible. I have been an Emacs user for the past twenty years and for better or worse, I am quite accustomed to the key bindings. Is there a way to stop key chording without getting into endless mode specific configuration?

Hello Modal Mode

Modal Mode is easy to learn and seldom require fixes to coexist with other modes. While it is not an emulation of the visual editor of Unix, the feel is similar. The command state keymap layout is influenced by it's counterpart in Xah Lee's excellent Fly Keys.

Goals

  • No key chords or inaccessible keys

    The introduction of two input states, command state and insert state à la vi, enables bindings of frequently used commands to accessible keys.

  • No configuration domino effect

    To achieve it, Dynamic Commands and Dynamic Keymaps are used. This sets Modal Mode apart from similar software packages, in my opinion.

Dynamic Commands

A good thing about Emacs is that there is a lot of convention to rely on. For example "C-M-i" is usually bound to some completion command (like ispell-complete-word or complete-symbol), "C-k" is usually bound to some kill command (like kill-line or paredit-kill) and "C-c C-c" usually bound to some eval or compile command (like geiser-eval-definition or slime-compile-defun).

Dynamic Commands may look a lot like normal key translations. In essence, a Dynamic Command finds the effective command for some keys and binds this-command to it, then applies call-interactively to it. A Dynamic Command preserves the correct behaviour when a command relies on this-command and last-command to recognize repetition, for example. In contrast, as key translations operates by means of keyboard macros, they break such commands.

Dynamic Keymaps with Event Queues

A Dynamic Keymap allows the user to collect conventional key chord sequences by single key presses only, like "SPC c c" to call the command bound to the key chord sequence "C-c C-c", or "SPC c d SPC h" for "C-c C-d h".

An important feature of Dynamic Keymaps is the support for event queues. One could execute a Dynamic Keymap with an event queue holding "C-x C-" and just press "s" to call save-buffer, for example. As a matter of fact, a Dynamic Command is just a Dynamic Keymap with a complete key chord sequence in the event queue.

Keymaps

Below is an illustration of the command state keymap layout that I use. The orange boxes highlights the home position, and the green boxes highlights three supplementary positions. The left hand mainly operates editing and window commands, while the right hand operates navigational and selection commands.

The left index finger switches to insert state and the space bar initiates a Leader sequence. I do actually use one key chord regularly: "S-SPC" is bound to the Dynamic Command "C-M-i", for completion commands. Ultimately, it all comes down to personal preference, and for this reason I do not see the benefit of jotting all the details down.

command-keymap-1080.png

Figure 2: The command state keymap layout.

State Indicators

Three indicators are used to highlight the current state.

  • A tree letter code as mode line front space
  • The mode line color
  • The cursor color

Finally, it's time to enjoy some soothing pastel colors!

command.png insert.png leader.png dynamic-keymap.png describer.png

Program Source Code

Direct link: floatp-modal-mode.el

;;; floatp-modal-mode.el --- Floatp Modal Mode -*- lexical-binding: t; coding: utf-8-unix; tab-width: 8; -*-

;; Author: Gunnar Lingegård
;; Version: 1.1.3
;; Package-Version: 20220112.0
;; Keywords: keyboard input ergonomy convenience
;; URL: http://www.floatp.net
;; Package-Requires: ((emacs "25.1"))

;; MIT License
;;
;; Copyright (c) 2020-2022 Gunnar Lingegård
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in all
;; copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

;;; Commentary:

;;; Code:

(require 'cl-lib)
(require 'seq)

(defgroup floatp-modal-mode nil
  "A global minor mode to enable modal interaction with Emacs."
  :group 'convenience)

(defcustom mm:mode-line-lighter " M"
  "Mode line lighter."
  :type 'string
  :group 'floatp-modal-mode)

(defcustom mm:mode-line-command-color "#b0ffb0"
  "Mode line background color to be used for the active buffer,
when in COMMAND state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:cursor-command-color "#00b000"
  "Cursor color to be used when in COMMAND state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:mode-line-insert-color "#ffb0b0"
  "Mode line background color to be used for the active buffer,
when in INSERT state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:cursor-insert-color "#ff0000"
  "Cursor color to be used when in INSERT state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:mode-line-leader-color "#c0f0f0"
  "Mode line background color to be used for the active buffer,
when in LEADER state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:cursor-leader-color "#2040ff"
  "Cursor color to be used when in LEADER state."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:mode-line-describer-color "#fff0a0"
  "Mode line background color to be used for the active buffer,
while collecting a dynamic command for the describer."
  :type 'color
  :group 'floatp-modal-mode)

(defcustom mm:cursor-describer-color "#f8e020"
  "Cursor color to be used while collecting a dynamic command for
the describer."
  :type 'color
  :group 'floatp-modal-mode)

(defvar mm:mode-hook nil
  "A normal hook, run when `floatp-modal-mode' is enabled.")
(defvar mm:mode-exit-hook nil
  "A normal hook, run when `floatp-modal-mode' is disabled.'")

(defvar mm:insert-map (make-sparse-keymap))
(defvar mm:command-map (make-sparse-keymap))
(defvar mm:leader-map (make-sparse-keymap))

(defvar mm::command-map-deactivator nil
  "Refer to `mm:ensure-command-state' and `mm:ensure-insert-state'.")

(defvar mm::leader-terminator nil
  "Refer to `mm:leader-initiate'.")

(defvar mm::describer-terminator nil
  "Refer to `mm:describer-initiate'")

(defvar mm::default-mode-line-front-space nil)
(defvar mm::default-mode-line-color nil)
(defvar mm::default-cursor-color nil)

(defun mm:update-state-indicators ()
  "Update faces according to the inferred state.  The default
values are determined at mode initialization."
  (cl-destructuring-bind (front-space mode-line-color cursor-color)
      (if floatp-modal-mode
          (if mm::command-map-deactivator
              (if mm::leader-terminator
                  '("LDR " mm:mode-line-leader-color mm:cursor-leader-color)
                '("CMD " mm:mode-line-command-color mm:cursor-command-color))
            '("INS " mm:mode-line-insert-color mm:cursor-insert-color))
        '(nil mm::default-mode-line-color mm::default-cursor-color))
    ;; Set mode line front space
    (setq mode-line-front-space
          (or front-space mm::default-mode-line-front-space))
    ;; The describer overrides the normal colors
    (when (and floatp-modal-mode mm::describer-terminator)
      (setq mode-line-color 'mm:mode-line-describer-color
            cursor-color 'mm:cursor-describer-color))
    ;; Set mode line background color
    (set-face-attribute 'mode-line nil
                        :background (or (symbol-value mode-line-color)
                                        mm::default-mode-line-color))
    ;; Set cursor color
    (set-face-attribute 'cursor nil
                        :background (or (symbol-value cursor-color)
                                        mm::default-cursor-color)))
  (force-mode-line-update))

(defun mm:ensure-command-state ()
  (interactive)
  (unless (and mm::command-map-deactivator
               overriding-terminal-local-map)
    (setq mm::command-map-deactivator
          (set-transient-map mm:command-map
                             (lambda () t)
                             (lambda () (setq mm::command-map-deactivator nil))))
    (mm:update-state-indicators)))

(defun mm:ensure-insert-state ()
  (interactive)
  (when mm::command-map-deactivator
    (funcall mm::command-map-deactivator)
    (mm:update-state-indicators)))

(defun mm:ensure-insert-state-after (f)
  (lambda ()
    (interactive)
    (funcall f)
    (mm:ensure-insert-state)))

(defun mm::describer-terminate ()
  "Refer to `mm:describer-initiate'."
  (when mm::describer-terminator
    (funcall mm::describer-terminator)))

(defvar mm::describer-requested-p nil
  "Refer to `mm:describer-initiate'.  This variable is
dynamically bound to `T' by functions made by
`mm:make-dynamic-command', and is used to determine whether or
not to terminate a describer.")

(defun mm:describer-initiate ()
  "Initiate the collection of a dynamic command, with the intent
to describe the effective command (bound in underlying keymaps).
Set `mm::describer-terminator' to be called by functions made by
`mm:make-dynamic-command', and from `post-command-loop' via
`mm::describer-terminate'."
  (interactive)
  (unless mm::describer-terminator
    (message "(Describer) Describe the next dynamic command, rather than calling it.")
    (setq mm::describer-terminator
          (let (not-first-p)
            ;; The first invocation of the returned function is from
            ;; `post-command-hook' as an effect of calling
            ;; `mm:describer-initiate' ...
            (lambda ()
              (let (result)
                (unless (or (not not-first-p)
                            (eql this-command 'mm:leader-initiate))
                  (setq mm::describer-terminator nil
                        result (when mm::describer-requested-p t)))
                (setq not-first-p t)
                (mm:update-state-indicators)
                result))))))

(defun mm::dynamic-keymap-events-description (events)
  "Describe a sequence, `events', stored in the internal format
of `mm::execute-dynamic-keymap'."
  (key-description (seq-concatenate 'vector (reverse events))))

(defun mm::dynamic-keymap-format-sequence (modifier events)
  "Format a sequence `events', stored in the internal format of
`mm::execute-dynamic-keymap'.  A hint on how to complete the
sequence is appended."
  (let (strings)
    (when events
      (push (mm::dynamic-keymap-events-description events) strings)
      (push " " strings))
    (when modifier
      (let* ((str (single-key-description (event-convert-list (list modifier ??))))
             (len (length str)))
        (cl-assert (string= (substring str (- len 2) len) "-?"))
        (push (substring str 0 (1- len)) strings)))
    (push "..." strings)
    (apply 'concat (nreverse strings))))

(defvar mm::dynamic-keymap-recurse-p nil
  "A predicate to test whether `mm::execute-dynamic-keymap' is
allowed to recurse to complete a sequence.")

(defvar mm::dynamic-keymap-modifier nil
  "A modifier to be used by `mm::execute-dynamic-keymap' to
  complete a sequence.")
(defvar mm::dynamic-keymap-modifier-event-p nil
  "A predicate used by `mm::execute-dynamic-keymap' to test
  whether an event should toggle usage of the modifier on/off.")
(defvar mm::dynamic-keymap-modifier-default-active nil
  "When non-`NIL', usage of the modifier is enabled by default.
  Refer to `mm::execute-dynamic-keymap'.")

(defun mm::execute-dynamic-keymap (modifier-active event-queue events)
  "Refer to `mm:make-dynamic-keymap'."
  (let ((event (if event-queue
                   (pop event-queue)
                 (let* ((modifier (when modifier-active mm::dynamic-keymap-modifier))
                        (event (read-event (format "(Dynamic Keymap) Complete sequence: %s"
                                                   (mm::dynamic-keymap-format-sequence modifier events)))))
                   (event-convert-list (list modifier event))))))
    (if (funcall mm::dynamic-keymap-modifier-event-p (event-basic-type event))
        (mm::execute-dynamic-keymap (not modifier-active) event-queue events)
      (let ((events (cons event events))
            (object (if overriding-local-map
                        (lookup-key overriding-local-map (vector event))
                      (key-binding (vector event)))))
        (cond
         ((keymapp object)
          (if (funcall mm::dynamic-keymap-recurse-p)
              (let ((overriding-local-map object))
                (mm::execute-dynamic-keymap mm::dynamic-keymap-modifier-default-active
                                            event-queue
                                            events))
            (message "(Dynamic Keymap) Abort.  Sequence requires recursion to complete: %s"
                     (mm::dynamic-keymap-events-description events))
            nil))
         ((null object)
          (message "(Dynamic Keymap) Unbound sequence: %s"
                   (mm::dynamic-keymap-events-description events))
          nil)
         (t object))))))

(defun mm::make-dynamic-keymap-modifier-event-p (keys)
  "Refer to `mm::dynamic-keymap-modifier-event-p'."
  (let ((key-sequence (listify-key-sequence (kbd keys))))
    (cl-assert (= (length key-sequence) 1))
    (let ((modifier-event (car key-sequence)))
      (lambda (event) (eql event modifier-event)))))

(defun mm:make-dynamic-keymap (keys &optional modifier-active modifier modifier-keys no-recursion-p)
  "Make a Dynamic Keymap.  Be aware that commands which depends
on `this-command-keys' or `this-command-keys-vector' will be
broken when called from a command made by this function."
  (let ((event-queue (when keys (listify-key-sequence (kbd keys))))
        (modifier (or modifier 'ctrl))
        (modifier-event-p (mm::make-dynamic-keymap-modifier-event-p (or modifier-keys "SPC")))
        (recurse-p (lambda () (not no-recursion-p))))
    (lambda ()
      (interactive)
      (let* ((describe-p (let ((mm::describer-requested-p t))
                           (mm::describer-terminate)))
             (mm::dynamic-keymap-recurse-p recurse-p)
             (mm::dynamic-keymap-modifier modifier)
             (mm::dynamic-keymap-modifier-event-p modifier-event-p)
             (mm::dynamic-keymap-modifier-default-active modifier-active)
             (overriding-terminal-local-map nil)
             (overriding-local-map nil)
             (f (mm::execute-dynamic-keymap modifier-active event-queue nil)))
        (when f
          (if describe-p
              (describe-function f)
            (setq this-command f)
            (call-interactively f)))))))

(defun mm:make-dynamic-command (keys)
  "Make a Dynamic Command."
  (mm:make-dynamic-keymap keys nil nil nil t))

(defun mm::leader-terminate ()
  "Refer to `mm:leader-initiate'."
  (when (functionp mm::leader-terminator)
    (funcall mm::leader-terminator)))

(defun mm:leader-initiate ()
  "Initiate the collection of a leader sequence by calling this
function, instead of simply binding a key to `mm:leader-map'.

So, when leaving the transient map (via the `on-exit' function),
set `mm:leader-terminator' to be called by `mm::leader-terminate'
from `post-command-hook'.  That function then serves as a
termination point for the sequence collection and command
execution."
  (interactive)
  (setq mm::leader-terminator t)
  (mm:update-state-indicators)
  (message "(Leader) Complete sequence ...")
  (set-transient-map mm:leader-map nil
                     (lambda ()
                       (setq mm::leader-terminator
                             (lambda ()
                               (setq mm::leader-terminator nil)
                               (mm:update-state-indicators))))))

(defvar mm:state-transition-hook-pairs
  '((minibuffer-setup-hook . minibuffer-exit-hook)
    (isearch-mode-hook . isearch-mode-end-hook))
  "Hook pairs for exceptional modes, for which insert state is a
better default than command state.  This variable is used when
enabling or disabling `floatp-modal-mode'.

car: Name of hook to run `mm:ensure-insert-state'
cdr: Name of hook to run `mm:ensure-command-state'")

(cl-labels ((alter (f)
                   (dolist (pair mm:state-transition-hook-pairs)
                     (cl-destructuring-bind (insert-state-hook . command-state-hook)
                         pair
                       (apply f (list insert-state-hook 'mm:ensure-insert-state))
                       (apply f (list command-state-hook 'mm:ensure-command-state))))))
  (defun mm::add-state-transition-hooks ()
    "Refer to `mm:state-transition-hook-pairs'."
    (alter 'add-hook))
  (defun mm::remove-state-transition-hooks ()
    "Refer to `mm:state-transition-hook-pairs'."
    (alter 'remove-hook)))

;;;###autoload
(define-minor-mode floatp-modal-mode
  "A global minor mode to enable modal interaction with Emacs."
  :group 'floatp-modal-mode
  :global t
  :lighter mm:mode-line-lighter
  :keymap mm:insert-map
  (if floatp-modal-mode
      (progn
        (run-hooks 'mm:mode-hook)
        (mm::add-state-transition-hooks)
        (add-hook 'post-command-hook 'mm::describer-terminate)
        (add-hook 'post-command-hook 'mm::leader-terminate)
        (advice-add 'keyboard-quit :before 'mm:ensure-command-state)
        (setq mm::default-mode-line-front-space mode-line-front-space
              mm::default-mode-line-color (face-attribute 'mode-line :background)
              mm::default-cursor-color (face-attribute 'cursor :background))
        (mm:ensure-command-state))
    (mm:ensure-insert-state)
    (setq mm::default-mode-line-front-space nil
          mm::default-mode-line-color nil
          mm::default-cursor-color nil)
    (advice-remove 'keyboard-quit 'mm:ensure-command-state)
    (remove-hook 'post-command-hook 'mm::leader-terminate)
    (remove-hook 'post-command-hook 'mm::describer-terminate)
    (mm::remove-state-transition-hooks)
    (run-hooks 'mm:mode-exit-hook)))

;;
;; Some random commands
;;

(defun mm:beginning-of-line-or-backward-paragraph ()
  "Complemented by `mm:end-of-line-or-forward-paragraph'."
  (interactive)
  (if (= (point) (line-beginning-position))
      (progn
        (backward-char)
        (backward-paragraph)
        (skip-chars-forward "^[:graph:]"))
    (let ((indentation-position (save-excursion (back-to-indentation) (point))))
      (if (< indentation-position (point))
          (goto-char indentation-position)
        (beginning-of-line)))))

(defun mm:end-of-line-or-forward-paragraph ()
  "Complemented by `mm:beginning-of-line-or-backward-paragraph'."
  (interactive)
  (if (and (eql this-command last-command)
           (or (= (point) (line-beginning-position))
               (= (point) (line-end-position))))
      (progn
        (forward-paragraph)
        (skip-chars-forward "^[:graph:]"))
    (let ((indentation-position (save-excursion (back-to-indentation) (point))))
      (if (< (point) indentation-position)
          (goto-char indentation-position)
        (end-of-line)))))

(defun mm:select-word ()
  (interactive)
  (unless (region-active-p)
    (forward-char)
    (backward-word)
    (set-mark (point)))
  (forward-word))

(defun mm:select-line ()
  (interactive)
  (unless (region-active-p)
    (beginning-of-line)
    (set-mark (point)))
  (forward-line 1))

(defun mm:select-paragraph ()
  (interactive)
  (unless (region-active-p)
    (backward-paragraph)
    (skip-chars-forward "^[:graph:]")
    (set-mark (point)))
  (forward-paragraph 1))

(defun mm:count-lines (start end)
  (save-excursion
    (count-lines
     (progn
       (goto-char start)
       (line-beginning-position))
     (progn
       (goto-char end)
       (line-beginning-position)))))

(defun mm:rotate (list &optional x)
  (let* ((l (length list))
         (x (if x (mod x l) 1)))
    (append (cl-subseq list x l)
            (cl-subseq list 0 x))))

(defconst mm::+new-line+ "
" "Refer to `mm:normalize-space'.")

(defvar mm::normalize-space--stops nil
  "Refer to `mm:normalize-space'.")

(defun mm:normalize-space (&optional backwards-p)
  (interactive "P")
  (let (;; Find beginning of whitespace region.
        (b (save-excursion
             (unless (looking-back "[[:graph:]]" 1)
               (if (re-search-backward "[[:graph:]]" nil t)
                   (forward-char)
                 (goto-char (point-min))))
             (point)))
        ;; Find end of whitespace region.
        (e (save-excursion
             (unless (looking-at "[[:graph:]]")
               (if (re-search-forward "[[:graph:]]" nil t)
                   (backward-char)
                 (goto-char (point-max))))
             (point))))
    ;; Update `mm::normalize-space--stops'.
    (let* ((str (buffer-substring-no-properties b e))
           (new-line-count (mm:count-lines b e))
           (empty-p (or (= b e) (string= str mm::+new-line+)))
           (indent (let ((str (buffer-substring-no-properties
                               (max (save-excursion (goto-char e) (line-beginning-position)) b)
                               e)))
                     (unless (or (= (length str) 0) (= new-line-count 0)) str))))
      (setq mm::normalize-space--stops
            (if (eql this-command last-command)
                (mm:rotate mm::normalize-space--stops (if backwards-p -1 1))
              (mapcar (let ((l (list
                                (lambda () nil) ; 0) no spaces
                                (lambda ()  ; 1) one or two spaces
                                  (insert (if (cl-find (char-before) '(?. ?? ?!)) "  " " ")) nil)
                                (lambda ()  ; 2) one new line
                                  (insert mm::+new-line+) t)
                                (lambda ()  ; 3) two new lines
                                  (insert (concat mm::+new-line+ mm::+new-line+)) t)
                                (lambda ()  ; 4) one new line plus indentation
                                  (insert (concat mm::+new-line+ indent)) t)
                                (lambda ()  ; 5) two new lines plus indentation
                                  (insert (concat mm::+new-line+ mm::+new-line+ indent)) t))))
                        (lambda (i) (nth i l)))
                      (mm:rotate (if indent '(0 1 2 3 4 5) '(0 1 2 3))
                                 (if backwards-p
                                     (cond
                                      ((< 1 new-line-count) -2)
                                      ((< 0 new-line-count) -3)
                                      (t (if empty-p -1 -0)))
                                   (cond
                                    ((< 1 new-line-count) 0)
                                    ((< 0 new-line-count) (if indent -1 3))
                                    (t (if empty-p 1 2)))))))))
    ;; Delete current whitespaces.
    (delete-region b e)
    (goto-char b)
    ;; Insert new whitespaces.
    (when (save-excursion (funcall (car mm::normalize-space--stops)))
      (forward-line))))

(defun mm:normalize-space-backwards ()
  (interactive)
  (setq this-command 'mm:normalize-space)
  (funcall-interactively 'mm:normalize-space t))

(let ((C-k (mm:make-dynamic-command "C-k"))
      (C-w (mm:make-dynamic-command "C-w")))
  (defun mm:kill-line-or-region ()
    (interactive)
    (funcall (if (region-active-p) C-w C-k))))

(let ((M-w (mm:make-dynamic-command "M-w")))
  (defun mm:kill-ring-save ()
    (interactive)
    (if (not (region-active-p))
        (message "No active region to save.")
      (funcall M-w)
      (when (fboundp 'floatp-flash-region)
        (floatp-flash-region (point) (mark))))))

(defun mm:delete-region-command ()
  (interactive)
  (when (region-active-p)
    (delete-region (point) (mark))))

(defun mm:yank-or-yank-pop ()
  (interactive)
  (if (eql real-last-command this-command)
      (yank-pop 1)
    (yank)))

(defun mm:other-window-or-buffer ()
  (interactive)
  (if (one-window-p)
      (switch-to-buffer (other-buffer))
    (other-window 1)))

(defun mm:spell-check ()
  (interactive)
  (if (region-active-p)
      (save-excursion
        (unless (< (point) (mark))
          (exchange-point-and-mark))
        (ispell-region (point) (mark)))
    (ispell-word)))

;;
;; Key bindings
;;

(defun mm:make-insert-map (&optional keys-translator)
  ";; (set-keymap-parent mm:insert-map map)"
  (cl-flet ((kbd (keys) (if keys-translator (funcall keys-translator (kbd keys)) (kbd keys))))
    (let ((map (make-sparse-keymap)))
      (define-key map (kbd "<escape>") 'mm:ensure-command-state)
      (define-key map (kbd "<menu>") 'mm:ensure-command-state)
      (define-key map (kbd "<print>") 'mm:ensure-command-state)
      (define-key map (kbd "S-SPC") (mm:ensure-insert-state-after (mm:make-dynamic-command "C-M-i")))
      map)))

(defun mm:make-leader-map (&optional keys-translator)
  ";; (set-keymap-parent mm:leader-map map)"
  (cl-flet ((kbd (keys) (if keys-translator (funcall keys-translator (kbd keys)) (kbd keys))))
    (let ((map (make-sparse-keymap)))
      (define-key map (kbd "<escape>") (lambda () (interactive) (message "(Leader) Abort.")))
      (define-key map (kbd "SPC") (mm:make-dynamic-keymap "C-SPC" nil nil "C-SPC" t))
      ;; Prefix Keys: mode-specific-map
      (define-key map (kbd "c") (mm:make-dynamic-keymap "C-c" t))
      (define-key map (kbd "t") (mm:make-dynamic-keymap "C-c"))
      ;; Prefix Keys: ctl-x-map
      (define-key map (kbd "h") (mm:make-dynamic-keymap "C-x" t))
      (define-key map (kbd "m") (mm:make-dynamic-keymap "C-x"))
      ;; Prefix Keys: help-map
      (define-key map (kbd "d") (mm:make-dynamic-keymap "C-h"))
      (define-key map (kbd "n") 'mm:describer-initiate)
      ;;
      (define-key map (kbd ",") 'beginning-of-buffer)
      (define-key map (kbd ".") 'end-of-buffer)
      (define-key map (kbd "a") (mm:make-dynamic-command "M-:"))
      (define-key map (kbd "u") 'universal-argument)
      (define-key map (kbd "k") 'mm:delete-region-command)
      (define-key map (kbd "s") 'mm:spell-check)
      (define-key map (kbd "S") 'ispell-change-dictionary)
      map)))

(defun mm:make-command-map (&optional keys-translator)
  ";; (set-keymap-parent mm:command-map map)"
  (cl-flet ((kbd (keys) (if keys-translator (funcall keys-translator (kbd keys)) (kbd keys))))
    (let ((map (make-sparse-keymap)))
      (define-key map (kbd "<escape>") (mm:make-dynamic-command "C-g"))
      (define-key map (kbd "SPC") 'mm:leader-initiate)
      ;;
      (define-key map (kbd "(") (mm:ensure-insert-state-after (mm:make-dynamic-command "(")))
      (define-key map (kbd ")") (mm:ensure-insert-state-after (mm:make-dynamic-command ")")))
      ;;
      ;; Alpha-numeric, left hand
      ;;
      (define-key map (kbd "1") 'split-window-right)
      (define-key map (kbd "2") 'split-window-below)
      (define-key map (kbd "3") 'delete-other-windows)
      (define-key map (kbd "4") 'switch-to-buffer)
      (define-key map (kbd "5") 'kill-buffer)
      ;;
      (define-key map (kbd "'") 'mm:normalize-space-backwards)
      (define-key map (kbd ",") 'mm:normalize-space)
      (define-key map (kbd ".") (mm:make-dynamic-command "M-DEL"))
      (define-key map (kbd "p") 'mm:yank-or-yank-pop)
      (define-key map (kbd "y") (mm:make-dynamic-command "M-d"))
      ;;
      (define-key map (kbd "a") 'execute-extended-command)
      (define-key map (kbd "o") (mm:make-dynamic-command "RET"))
      (define-key map (kbd "e") (mm:make-dynamic-command "DEL"))
      (define-key map (kbd "u") 'mm:ensure-insert-state)
      (define-key map (kbd "i") (mm:make-dynamic-command "C-d"))
      ;;
      (define-key map (kbd ";") (mm:make-dynamic-command "M-;"))
      (define-key map (kbd "q") (mm:make-dynamic-command "M-q"))
      (define-key map (kbd "j") 'mm:kill-ring-save)
      (define-key map (kbd "k") 'mm:kill-line-or-region)
      (define-key map (kbd "x") (mm:make-dynamic-keymap nil t))
      ;;
      ;; Alpha-numeric, right hand
      ;;
      (define-key map (kbd "6") (lambda () (interactive)))
      (define-key map (kbd "7") 'mm:select-word)
      (define-key map (kbd "8") 'mm:select-line)
      (define-key map (kbd "9") 'mm:select-paragraph)
      (define-key map (kbd "0") (lambda () (interactive)))
      ;;
      (define-key map (kbd "f") (lambda () (interactive)))
      (define-key map (kbd "g") (mm:make-dynamic-command "M-b"))
      (define-key map (kbd "c") (mm:make-dynamic-command "<up>"))
      (define-key map (kbd "r") (mm:make-dynamic-command "M-f"))
      (define-key map (kbd "l") (mm:make-dynamic-command "<prior>"))
      ;;
      (define-key map (kbd "d") (mm:make-dynamic-command "C-l"))
      (define-key map (kbd "h") (mm:make-dynamic-command "<left>"))
      (define-key map (kbd "t") (mm:make-dynamic-command "<down>"))
      (define-key map (kbd "n") (mm:make-dynamic-command "<right>"))
      (define-key map (kbd "s") (mm:make-dynamic-command "<next>"))
      ;;
      (define-key map (kbd "b") (mm:make-dynamic-command "C-/"))
      (define-key map (kbd "m") 'mm:beginning-of-line-or-backward-paragraph)
      (define-key map (kbd "w") 'mm:other-window-or-buffer)
      (define-key map (kbd "v") 'mm:end-of-line-or-forward-paragraph)
      (define-key map (kbd "z") (lambda () (interactive)))
      map)))

(defun mm:make-qwerty-us-keys-alist ()
  "Associations between Dvorak and US QWERTY, for making keymaps."
  (mapcan (lambda (cons)
            (list (cons (kbd (car cons)) (kbd (cadr cons)))
                  (cons (kbd (upcase (car cons))) (kbd (upcase (cadr cons))))))
          '(("'" "q") ("," "w") ("." "e") ("p" "r") ("y" "t") ("f" "y") ("g" "u") ("c" "i") ("r" "o") ("l" "p")
            ("a" "a") ("o" "s") ("e" "d") ("u" "f") ("i" "g") ("d" "h") ("h" "j") ("t" "k") ("n" "l") ("s" ";")
            (";" "z") ("q" "x") ("j" "c") ("k" "v") ("x" "b") ("b" "n") ("m" "m") ("w" ",") ("v" ".") ("z" "/"))))

(defun mm:make-qwerty-se-keys-alist ()
  "Associations between Dvorak and Swedish QWERTY, for making keymaps."
  (mapcan (lambda (cons)
            (list (cons (kbd (car cons)) (kbd (cadr cons)))
                  (cons (kbd (upcase (car cons))) (kbd (upcase (cadr cons))))))
          '(("'" "q") ("," "w") ("." "e") ("p" "r") ("y" "t") ("f" "y") ("g" "u") ("c" "i") ("r" "o") ("l" "p")
            ("a" "a") ("o" "s") ("e" "d") ("u" "f") ("i" "g") ("d" "h") ("h" "j") ("t" "k") ("n" "l") ("s" "ö")
            (";" "z") ("q" "x") ("j" "c") ("k" "v") ("x" "b") ("b" "n") ("m" "m") ("w" ",") ("v" ".") ("z" "-"))))

(defun mm:set-keymaps (&optional keys-alist)
  "A convenience function for setting (the parents of) insert-,
leader- and command-map.  The layout is Dvorak by default, but
any other layout could be used by passing `KEYS-ALIST', with
associations from Dvorak to a layout of your choice.

For example, for use with Swedish QWERTY layout:

;; (mm:set-keymaps (mm:make-qwerty-se-keys-alist))"
  (let ((keys-translator (when keys-alist
                           (lambda (keys)
                             (or (cdr (cl-assoc keys keys-alist :test #'equal))
                                 keys)))))
    (set-keymap-parent mm:insert-map (mm:make-insert-map keys-translator))
    (set-keymap-parent mm:leader-map (mm:make-leader-map keys-translator))
    (set-keymap-parent mm:command-map (mm:make-command-map keys-translator))))

(mm:set-keymaps)

(provide 'floatp-modal-mode)

;;; floatp-modal-mode.el ends here

Date: 2021-10-19

Author: Gunnar Lingegård

Validate