bug#64619: [PATCH] Add toggle-window-dedicated command

[Spencer Baugh <sbaugh@janestreet.com>]

[-- Attachment #1: Type: text/plain, Size: 504 bytes --]


OK, this patch adds support for making the buffer strongly dedicated
with a prefix argument, and also adds an indicator to the mode line of
whether the current window is dedicated (which seems useful even if we
don't apply the toggle part of this patch).

I wonder if we should support clicking on the mode line indicator to
turn off dedicated status?  The tricky thing is that the mode line
indicator disappears when the window isn't dedicated, so there's no way
to turn it back *on* using the mouse.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-toggle-window-dedicated-command-and-mode-line-wi.patch --]
[-- Type: text/x-patch, Size: 4209 bytes --]

From 6346388d0992ad78b42e79590db60f2f337b0b88 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@janestreet.com>
Date: Fri, 14 Jul 2023 11:38:24 -0400
Subject: [PATCH] Add toggle-window-dedicated command and
 mode-line-window-dedicated

It's sometimes useful to interactively make certain windows dedicated.
This allows a level of interactive control over which window
display-buffer uses.

Additionally, when a window is dedicated (even without this new
command) it can affect display-buffer behavior in ways which may be
unexpected for users.  Let's display the window dedicated status in
the mode-line to help indicate what's going on.

* lisp/window.el (toggle-window-dedicated): Add.
(window-prefix-map): Add C-x w d binding.
* lisp/bindings.el (mode-line-window-control): Add.
(mode-line-window-dedicated): Add.
(standard-mode-line-format): Insert mode-line-window-dedicated.
---
 lisp/bindings.el | 22 ++++++++++++++++++++++
 lisp/window.el   | 28 ++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+)

diff --git a/lisp/bindings.el b/lisp/bindings.el
index 0a0fef1b564..a570b5d6a7b 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -298,6 +298,27 @@ mode-line-frame-identification
 ;;;###autoload
 (put 'mode-line-frame-identification 'risky-local-variable t)
 
+(defun mode-line-window-control ()
+  "Compute mode line construct for window dedicated state.
+Value is used for `mode-line-window-dedicated', which see."
+  (cond
+   ((eq (window-dedicated-p) t)
+   '(:propertize
+     " D"
+     help-echo "Window is strongly dedicated to current buffer"
+     mouse-face 'mode-line-highlight))
+   ((window-dedicated-p)
+   '(:propertize
+     " d"
+     help-echo "Window is dedicated to current buffer"
+     mouse-face 'mode-line-highlight))
+   (t "")))
+
+(defvar mode-line-window-dedicated '(:eval (mode-line-window-control))
+  "Mode line construct to describe the current window.")
+;;;###autoload
+(put 'mode-line-window-dedicated 'risky-local-variable t)
+
 (defvar-local mode-line-process nil
   "Mode line construct for displaying info on process status.
 Normally nil in most modes, since there is no process to display.")
@@ -678,6 +699,7 @@ mode-line-end-spaces
 	            'mode-line-modified
 	            'mode-line-remote)
               'display '(min-width (5.0)))
+             'mode-line-window-dedicated
 	     'mode-line-frame-identification
 	     'mode-line-buffer-identification
 	     "   "
diff --git a/lisp/window.el b/lisp/window.el
index d91bbabc010..259c1e679ac 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -7463,6 +7463,33 @@ display-buffer-mark-dedicated
 The actual non-nil value of this variable will be copied to the
 `window-dedicated-p' flag.")
 
+(defun toggle-window-dedicated (&optional window flag interactive)
+  "Toggle whether WINDOW is dedicated.
+
+See `set-window-dedicated-p' for more details.  WINDOW defaults
+to the currently selected window.  FLAG defaults to
+`dedicated' (weak dedication) or `t' (strong dedication) with a
+prefix argument.  If INTERACTIVE is non-nil, will print a message
+about the dedication status of the window afterwards."
+  (interactive "i\nP\np")
+  (setq window (window-normalize-window window))
+  (setq flag (cond
+              ((consp flag) t)
+              ((null flag) 'dedicated)
+              (t flag)))
+  (if (window-dedicated-p window)
+      (set-window-dedicated-p window nil)
+    (set-window-dedicated-p window flag))
+  (when interactive
+    (message "Window is %s dedicated to buffer %s"
+             (let ((status (window-dedicated-p window)))
+               (cond
+                ((null status) "no longer")
+                ((eq status t) "now strongly")
+                (t "now")))
+             (current-buffer))
+    (force-mode-line-update)))
+
 (defconst display-buffer--action-function-custom-type
   '(choice :tag "Function"
 	   (const :tag "--" ignore) ; default for insertion
@@ -10746,6 +10773,7 @@ window-prefix-map
   "2" #'split-root-window-below
   "3" #'split-root-window-right
   "s" #'window-toggle-side-windows
+  "d" #'toggle-window-dedicated
   "^ f" #'tear-off-window
   "^ t" #'tab-window-detach
   "-" #'fit-window-to-buffer
-- 
2.39.3