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

[Philip Kaludercic]

Juri Linkov <juri@linkov.net> writes:

>> -  (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))
>> +  (windmove-install-defaults modifiers
>> +                             '((windmove-delete-left left)
>> +                               (windmove-delete-right right)
>> +                               (windmove-delete-up up)
>> +                               (windmove-delete-down down))))
>
> I haven't yet tested your patch, but after reading it seems 'prefix' is 
> unused now?

You are right, I didn't test that specific function
properly. windmove-install-defaults had to be extended by another
argument to fix this.

What I don't really like is that only
windmove-delete-default-keybindings can make use of prefixes, while all
commands only use modifiers. Could it make sense to deprecate these
functions in favour of either new functions or user-options?

-- 
        Philip K.

>From ecbed85db9622ef5b1680472273163cb7789ae3f Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 25 May 2021 11:47:51 +0200
Subject: [PATCH] Improve windmove-*-default-keybindings fuctions

* windmove.el (windmove-mode-map): Add special map for windmove
commands
(windmove-mode): Add minor mode for activating windmove-mode-map
(windmove-install-defaults): Add general function for manipulating
windmove-mode-map
(windmove-default-keybindings): Use windmove-install-defaults
(windmove-display-default-keybindings): Use windmove-install-defaults
(windmove-delete-default-keybindings): Use windmove-install-defaults
(windmove-swap-states-default-keybindings): Use
windmove-install-defaults
---
 lisp/windmove.el | 87 ++++++++++++++++++++++++++++++++++++------------
 1 file changed, 66 insertions(+), 21 deletions(-)

diff --git a/lisp/windmove.el b/lisp/windmove.el
index e4ea8e0f69..d7c1d25d82 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -426,19 +426,49 @@ 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-mode-map (make-sparse-keymap)
+  "Map used by `windmove-install-defaults'.")
+
+(define-minor-mode windmove-mode
+  "Global minor mode for default windmove commands."
+  :keymap windmove-mode-map
+  :init-value t
+  :global t)
+
+(defun windmove-install-defaults (prefix modifiers alist)
+  "Install keys as specified by ALIST.
+Every element of ALIST has the form (FN KEY), where KEY is
+appended to MODIFIERS, adding PREFIX to the beginning, before
+installing the key.  Previous bindings of FN are unbound."
+  (dolist (bind alist)
+    (when (or (memq (cadr bind) '(left right up down))
+              (not (null modifiers)))
+      (dolist (old (where-is-internal (car bind) windmove-mode-map))
+        (define-key windmove-mode-map old nil))
+      (let ((key (vconcat (if (eq prefix 'none) nil prefix)
+                          (list (append modifiers (cdr bind))))))
+        (let ((old-fn (lookup-key windmove-mode-map key)))
+          (when old-fn
+            (warn "Overriding %S with %S" old-fn (car bind))))
+        (define-key windmove-mode-map key (car bind))))))
+
 ;;;###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))
+  (windmove-install-defaults nil modifiers
+                             '((windmove-left left)
+                               (windmove-right right)
+                               (windmove-up up)
+                               (windmove-down down))))
 
 
 ;;; Directional window display and selection
@@ -546,17 +576,21 @@ 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))
+  (windmove-install-defaults nil modifiers
+                             '((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))))
 
 
 ;;; Directional window deletion
@@ -618,16 +652,22 @@ 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))
+  (windmove-install-defaults prefix modifiers
+                             '((windmove-delete-left left)
+                               (windmove-delete-right right)
+                               (windmove-delete-up up)
+                               (windmove-delete-down down))))
 
 
 ;;; Directional window swap states
@@ -673,14 +713,19 @@ 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))
+  (windmove-install-defaults nil modifiers
+                             '((windmove-swap-states-left left)
+                               (windmove-swap-states-right right)
+                               (windmove-swap-states-up up)
+                               (windmove-swap-states-down down))))
 
 
 (provide 'windmove)
-- 
2.30.2