bug#41438: [PATCH] Allow windmove keys to be bound without prefix or modifiers

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> "Philip K." <philipk@posteo.net> writes:
>
>> These are the only edge-cases I found, but I didn't fix them yet, as I'm
>> not sure what would be preferred. So the patches should not be applies yet.
>
> Have you done any further work on this?

I have been thinking about this a bit more, and tried a different
approach. The implementation is not prefect, but basically I am playing
with emulation-mode-map-alists to bind the keys, instead of using the
global map.

The should solve the two issues I brought up, because I do not have to
worry about restoring the previous keys, and some edge-cases are
avoided, where e.g. doc-view would override up and down breaking the
expected behaviour when setting the prefix to 'none.

The code should probably be refactored, moving more of the common
functionality into it's own function, but I am primarily wondering if
using emulation-mode-map-alists the way I am proposing it here is ok. Or
should I prefer minor-mode-map-alist?

-- 
        Philip K.

>From eba161853d50c2a6ce27af5907efdae4f6ab81eb Mon Sep 17 00:00:00 2001
From: Philip K <philipk@posteo.net>
Date: Sat, 22 May 2021 22:03:22 +0200
Subject: [PATCH] Allow windmove keys to be bound without prefix or modifiers

---
 lisp/windmove.el | 91 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 70 insertions(+), 21 deletions(-)

diff --git a/lisp/windmove.el b/lisp/windmove.el
index e4ea8e0f69..acd9cb41fc 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -426,19 +426,35 @@ windmove-down
 ;; I don't think these bindings will work on non-X terminals; you
 ;; probably want to use different bindings in that case.
 
+(defvar windmove-map (make-sparse-keymap)
+  "Keymap to bind windmove keys to.")
+
+(add-to-list 'emulation-mode-map-alists
+             (list (cons t windmove-map)))
+
 ;;;###autoload
 (defun windmove-default-keybindings (&optional modifiers)
   "Set up keybindings for `windmove'.
 Keybindings are of the form MODIFIERS-{left,right,up,down},
 where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
 Default value of MODIFIERS is `shift'."
   (interactive)
   (unless modifiers (setq modifiers 'shift))
+  (when (eq modifiers 'none) (setq modifiers nil))
   (unless (listp modifiers) (setq modifiers (list modifiers)))
-  (global-set-key (vector (append modifiers '(left)))  'windmove-left)
-  (global-set-key (vector (append modifiers '(right))) 'windmove-right)
-  (global-set-key (vector (append modifiers '(up)))    'windmove-up)
-  (global-set-key (vector (append modifiers '(down)))  'windmove-down))
+  (dolist (bind '((windmove-left left)
+                  (windmove-right right)
+                  (windmove-up up)
+                  (windmove-down down)))
+    (when (or (memq (cadr bind) '(left right up down))
+              (not (null modifiers)))
+      (dolist (old (where-is-internal (car bind) windmove-map))
+        (define-key windmove-map old nil))
+      (define-key windmove-map
+        (vector (append modifiers (cdr bind)))
+        (car bind)))))
 
 
 ;;; Directional window display and selection
@@ -546,17 +562,27 @@ windmove-display-default-keybindings
 Keys are bound to commands that display the next buffer in the specified
 direction.  Keybindings are of the form MODIFIERS-{left,right,up,down},
 where MODIFIERS is either a list of modifiers or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to
+the arrow keys.
 Default value of MODIFIERS is `shift-meta'."
   (interactive)
   (unless modifiers (setq modifiers '(shift meta)))
+  (when (eq modifiers 'none) (setq modifiers nil))
   (unless (listp modifiers) (setq modifiers (list modifiers)))
-  (global-set-key (vector (append modifiers '(left)))  'windmove-display-left)
-  (global-set-key (vector (append modifiers '(right))) 'windmove-display-right)
-  (global-set-key (vector (append modifiers '(up)))    'windmove-display-up)
-  (global-set-key (vector (append modifiers '(down)))  'windmove-display-down)
-  (global-set-key (vector (append modifiers '(?0)))    
'windmove-display-same-window)
-  (global-set-key (vector (append modifiers '(?f)))    
'windmove-display-new-frame)
-  (global-set-key (vector (append modifiers '(?t)))    
'windmove-display-new-tab))
+  (dolist (bind '((windmove-display-left left)
+                  (windmove-display-right right)
+                  (windmove-display-up up)
+                  (windmove-display-down down)
+                  (windmove-display-same-window ?0)
+                  (windmove-display-new-frame ?f)
+                  (windmove-display-new-tab ?t)))
+    (when (or (memq (cadr bind) '(left right up down))
+              (not (null modifiers)))
+      (dolist (old (where-is-internal (car bind) windmove-map))
+        (define-key windmove-map old nil))
+      (define-key windmove-map
+        (vector (append modifiers (cdr bind)))
+        (car bind)))))
 
 
 ;;; Directional window deletion
@@ -618,16 +644,28 @@ windmove-delete-default-keybindings
 Keys are bound to commands that delete windows in the specified
 direction.  Keybindings are of the form PREFIX MODIFIERS-{left,right,up,down},
 where PREFIX is a prefix key and MODIFIERS is either a list of modifiers or
-a single modifier.  Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
+a single modifier.
+If PREFIX is `none', no prefix is used. If MODIFIERS is `none', the keybindings
+are directly bound to the arrow keys.
+Default value of PREFIX is `C-x' and MODIFIERS is `shift'."
   (interactive)
   (unless prefix (setq prefix '(?\C-x)))
+  (when (eq prefix 'none) (setq prefix nil))
   (unless (listp prefix) (setq prefix (list prefix)))
   (unless modifiers (setq modifiers '(shift)))
+  (when (eq modifiers 'none) (setq modifiers nil))
   (unless (listp modifiers) (setq modifiers (list modifiers)))
-  (global-set-key (vector prefix (append modifiers '(left)))  
'windmove-delete-left)
-  (global-set-key (vector prefix (append modifiers '(right))) 
'windmove-delete-right)
-  (global-set-key (vector prefix (append modifiers '(up)))    
'windmove-delete-up)
-  (global-set-key (vector prefix (append modifiers '(down)))  
'windmove-delete-down))
+  (dolist (bind '((windmove-delete-left left)
+                  (windmove-delete-right right)
+                  (windmove-delete-up up)
+                  (windmove-delete-down down)))
+    (when (or (memq (cadr bind) '(left right up down))
+              (not (null modifiers)))
+      (dolist (old (where-is-internal (car bind) windmove-map))
+        (define-key windmove-map old nil))
+      (define-key windmove-map
+        (vector (append modifiers (cdr bind)))
+        (car bind)))))
 
 
 ;;; Directional window swap states
@@ -673,14 +711,25 @@ windmove-swap-states-default-keybindings
 Keys are bound to commands that swap the states of the selected window
 with the window in the specified direction.  Keybindings are of the form
 MODIFIERS-{left,right,up,down}, where MODIFIERS is either a list of modifiers
-or a single modifier.  Default value of MODIFIERS is `shift-super'."
+or a single modifier.
+If MODIFIERS is `none', the keybindings will be directly bound to the
+arrow keys.
+Default value of MODIFIERS is `shift-super'."
   (interactive)
   (unless modifiers (setq modifiers '(shift super)))
+  (when (eq modifiers 'none) (setq modifiers nil))
   (unless (listp modifiers) (setq modifiers (list modifiers)))
-  (global-set-key (vector (append modifiers '(left)))  
'windmove-swap-states-left)
-  (global-set-key (vector (append modifiers '(right))) 
'windmove-swap-states-right)
-  (global-set-key (vector (append modifiers '(up)))    
'windmove-swap-states-up)
-  (global-set-key (vector (append modifiers '(down)))  
'windmove-swap-states-down))
+  (dolist (bind '((windmove-swap-states-left left)
+                  (windmove-swap-states-right right)
+                  (windmove-swap-states-up up)
+                  (windmove-swap-states-down down)))
+    (when (or (memq (cadr bind) '(left right up down))
+              (not (null modifiers)))
+      (dolist (old (where-is-internal (car bind) windmove-map))
+        (define-key windmove-map old nil))
+      (define-key windmove-map
+        (vector (append modifiers (cdr bind)))
+        (car bind)))))
 
 
 (provide 'windmove)
-- 
2.30.2