* lisp/windmove.el: Directional window deletion (bug#32790)

* lisp/windmove.el (windmove-delete-in-direction)
(windmove-delete-left, windmove-delete-up)
(windmove-delete-right, windmove-delete-down)
(windmove-delete-default-keybindings): New functions.

2 files changed, 77 insertions, 2 deletions

diff --git a/etc/NEWS b/etc/NEWS
index eb3f314ccf4..1ddc565b8ba 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -304,6 +304,9 @@ back, customize 'follow-hide-ghost-cursors' to nil.
 
 ** Windmove
 
+*** 'windmove-create-window' when non-nil makes a new window on moving off
+the edge of the frame.
+
 *** Windmove supports directional window display and selection.
 The new command 'windmove-display-default-keybindings' binds default
 keys with provided modifiers (by default, Shift-Meta) to the commands
@@ -316,8 +319,13 @@ creating the window if necessary.  A special key can be customized to
 display the buffer in the same window, for example, 'S-M-0 C-h e'
 displays the *Messages* buffer in the same window.
 
-*** 'windmove-create-window' when non-nil makes a new window on moving off
-the edge of the frame.
+*** Windmove also supports directional window deletion.
+The new command 'windmove-delete-default-keybindings' binds default
+keys with provided prefix (by default, C-x) and modifiers (by default,
+Shift) to the commands that delete the window in the specified
+direction.  For example, 'C-x S-down' deletes the window below.
+With a prefix arg 'C-u', deletes the selected window and selects
+the window that was in the specified direction.
 
 ** Octave mode
 The mode is automatically enabled in files that start with the
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 898f87e2dbf..6d61806a831 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -678,6 +678,73 @@ Default value of MODIFIERS is `shift-meta'."
   (global-set-key (vector (append modifiers '(down)))  'windmove-display-down)
   (global-set-key (vector (append modifiers '(?0)))    'windmove-display-same-window))
 
+;;; Directional window deletion
+
+(defun windmove-delete-in-direction (dir &optional arg)
+  "Delete the window at direction DIR.
+If prefix ARG is `C-u', delete the selected window and
+select the window at direction DIR.
+When `windmove-wrap-around' is non-nil, takes the window
+from the opposite side of the frame."
+  (let ((other-window (window-in-direction dir nil nil arg
+                                           windmove-wrap-around t)))
+    (cond ((null other-window)
+           (user-error "No window %s from selected window" dir))
+          (t
+           (if (not (consp arg))
+               (delete-window other-window)
+             (delete-window (selected-window))
+             (select-window other-window))))))
+
+;;;###autoload
+(defun windmove-delete-left (&optional arg)
+  "Delete the window to the left of the current one.
+If prefix ARG is `C-u', delete the selected window and
+select the window that was to the left of the current one."
+  (interactive "P")
+  (windmove-delete-in-direction 'left arg))
+
+;;;###autoload
+(defun windmove-delete-up (&optional arg)
+  "Delete the window above the current one.
+If prefix ARG is `C-u', delete the selected window and
+select the window that was above the current one."
+  (interactive "P")
+  (windmove-delete-in-direction 'up arg))
+
+;;;###autoload
+(defun windmove-delete-right (&optional arg)
+  "Delete the window to the right of the current one.
+If prefix ARG is `C-u', delete the selected window and
+select the window that was to the right of the current one."
+  (interactive "P")
+  (windmove-delete-in-direction 'right arg))
+
+;;;###autoload
+(defun windmove-delete-down (&optional arg)
+  "Delete the window below the current one.
+If prefix ARG is `C-u', delete the selected window and
+select the window that was below the current one."
+  (interactive "P")
+  (windmove-delete-in-direction 'down arg))
+
+;;;###autoload
+(defun windmove-delete-default-keybindings (&optional prefix modifiers)
+  "Set up keybindings for directional window deletion.
+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'."
+  (interactive)
+  (unless prefix (setq prefix '(?\C-x)))
+  (unless (listp prefix) (setq prefix (list prefix)))
+  (unless modifiers (setq modifiers '(shift)))
+  (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))
+
 (provide 'windmove)
 
 ;;; windmove.el ends here