From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 22 Jun 2024 10:42:30 +0000 (+0100)
Subject: el/dot-emacs.el: Split window management hacks into their own section.
X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/profile/commitdiff_plain/6b1134c9b02938692dc9ffa637905a3a5bcfd8db

el/dot-emacs.el: Split window management hacks into their own section.
---

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 0abad6b..ef46c62 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -122,17 +122,6 @@ (defun mdw-config (sym)
 		      (concat "(" (buffer-string) ")")))))))
   (cdr (assq sym mdw-config)))
 
-;; Width configuration.
-
-(defcustom mdw-column-width
-  (string-to-number (or (mdw-config 'emacs-width) "77"))
-  "Width of Emacs columns."
-  :type 'integer)
-(defcustom mdw-text-width mdw-column-width
-  "Expected width of text within columns."
-  :type 'integer
-  :safe 'integerp)
-
 ;; Local variables hacking.
 
 (defun run-local-vars-mode-hook ()
@@ -193,206 +182,6 @@ (defadvice backward-page (after mdw-fixup compile activate)
 (defadvice forward-page (after mdw-fixup compile activate)
   (mdw-fixup-page-position))
 
-;; Splitting windows.
-
-(unless (fboundp 'scroll-bar-columns)
-  (defun scroll-bar-columns (side)
-    (cond ((eq side 'left) 0)
-	  (window-system 3)
-	  (t 1))))
-(unless (fboundp 'fringe-columns)
-  (defun fringe-columns (side)
-    (cond ((not window-system) 0)
-	  ((eq side 'left) 1)
-	  (t 2))))
-
-(defun mdw-horizontal-window-overhead ()
-  "Computes the horizontal window overhead.
-This is the number of columns used by fringes, scroll bars and other such
-cruft."
-  (if (not window-system)
-      1
-    (let ((tot 0))
-      (dolist (what '(scroll-bar fringe))
-	(dolist (side '(left right))
-	  (cl-incf tot
-		   (funcall (intern (concat (symbol-name what) "-columns"))
-			    side))))
-      tot)))
-
-(defun mdw-split-window-horizontally (&optional width)
-  "Split a window horizontally.
-Without a numeric argument, split the window approximately in
-half.  With a numeric argument WIDTH, allocate WIDTH columns to
-the left-hand window (if positive) or -WIDTH columns to the
-right-hand window (if negative).  Space for scroll bars and
-fringes is not taken out of the allowance for WIDTH, unlike
-\\[split-window-horizontally]."
-  (interactive "P")
-  (split-window-horizontally
-   (cond ((null width) nil)
-	 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
-	 ((< width 0) width))))
-
-(defun mdw-preferred-column-width ()
-  "Return the preferred column width."
-  (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
-    (1+ mdw-column-width)))
-
-(defun mdw-divvy-window (&optional width)
-  "Split a wide window into appropriate widths."
-  (interactive "P")
-  (setq width (if width (prefix-numeric-value width)
-		(mdw-preferred-column-width)))
-  (let* ((win (selected-window))
-	 (sb-width (mdw-horizontal-window-overhead))
-	 (c (/ (+ (window-width) sb-width)
-	       (+ width sb-width))))
-    (while (> c 1)
-      (setq c (1- c))
-      (split-window-horizontally (+ width sb-width))
-      (other-window 1))
-    (select-window win)))
-
-(defun mdw-frame-width-quantized-p (frame-width column-width)
-  "Return whether the FRAME-WIDTH was chosen specifically for COLUMN-WIDTH."
-  (let ((sb-width (mdw-horizontal-window-overhead)))
-    (zerop (mod (+ frame-width sb-width)
-		(+ column-width sb-width)))))
-
-(defun mdw-frame-width-for-columns (columns width)
-  "Return the preferred width for a frame with so many COLUMNS of WIDTH."
-  (let ((sb-width (mdw-horizontal-window-overhead)))
-    (- (* columns (+ width sb-width))
-       sb-width)))
-
-(defun mdw-set-frame-width (columns &optional width)
-  "Set the current frame to be the correct width for COLUMNS columns.
-
-If WIDTH is non-nil, then it provides the width for the new columns.  (This
-can be set interactively with a prefix argument.)"
-  (interactive "nColumns: 
-P")
-  (setq width (if width (prefix-numeric-value width)
-		(mdw-preferred-column-width)))
-  (set-frame-width (selected-frame)
-		   (mdw-frame-width-for-columns columns width))
-  (mdw-divvy-window width))
-
-(defcustom mdw-frame-width-fudge
-  (cond ((<= emacs-major-version 20) 1)
-	((= emacs-major-version 26) 3)
-	(t 0))
-  "The number of extra columns to add to the desired frame width.
-
-This is sadly necessary because Emacs 26 is broken in this regard."
-  :type 'integer)
-
-(defcustom mdw-frame-colour-alist
-  '((black . ("#000000" . "#ffffff"))
-    (red . ("#2a0000" . "#ffffff"))
-    (green . ("#002a00" . "#ffffff"))
-    (blue . ("#00002a" . "#ffffff")))
-  "Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs."
-  :type '(alist :key-type symbol :value-type (cons color color)))
-
-(defun mdw-set-frame-colour (colour &optional frame)
-  (interactive "xColour name or (FOREGROUND . BACKGROUND) pair: 
-")
-  (when (and colour (symbolp colour))
-    (let ((entry (assq colour mdw-frame-colour-alist)))
-      (unless entry (error "Unknown colour `%s'" colour))
-      (setf colour (cdr entry))))
-  (set-frame-parameter frame 'background-color (car colour))
-  (set-frame-parameter frame 'foreground-color (cdr colour)))
-
-;; Window configuration switching.
-
-(defvar mdw-current-window-configuration nil
-  "The current window configuration register name, or `nil'.")
-
-(defun mdw-switch-window-configuration (register &optional no-save)
-  "Switch make REGISTER be the new current window configuration.
-If a current window configuration register is established, and
-NO-SAVE is nil, then save the current window configuration to
-that register first.
-
-Signal an error if the new register contains something other than
-a window configuration.  If the register is unset then save the
-current window configuration to it immediately.
-
-With one or three C-u, or an odd numeric prefix argument, set
-NO-SAVE, so the previous window configuration register is left
-unchanged.
-
-With two or three C-u, or a prefix argument which is an odd
-multiple of 2, just clear the record of the current window
-configuration register, so that the next switch doesn't save the
-prevailing configuration."
-  (interactive
-   (let ((arg current-prefix-arg))
-     (list (if (or (and (consp arg) (= (car arg) 16) (= (car arg) 64))
-		   (and (integerp arg) (not (zerop (logand arg 2)))))
-	       nil
-	     (register-read-with-preview "Switch to window configuration: "))
-	   (or (and (consp arg) (= (car arg) 4) (= (car arg) 64))
-	       (and (integerp arg) (not (zerop (logand arg 1))))))))
-
-  (let ((previous mdw-current-window-configuration)
-	(current-windows (list (current-window-configuration)
-			       (point-marker)))
-	(register-value (and register (get-register register))))
-    (when (and mdw-current-window-configuration (not no-save))
-      (set-register mdw-current-window-configuration current-windows))
-    (cond ((null register)
-	   (setq mdw-current-window-configuration nil)
-	   (if previous
-	       (message "Left window configuration `%c'." previous)
-	     (message "Nothing to do!")))
-	  ((not (or (null register-value)
-		    (and (consp register-value)
-			 (window-configuration-p (car register-value))
-			 (integer-or-marker-p (cadr register-value))
-			 (null (cl-caddr register-value)))))
-	   (error "Register `%c' is not a window configuration" register))
-	  (t
-	   (cond ((null register-value)
-		  (set-register register current-windows)
-		  (message "Started new window configuration `%c'."
-			   register))
-		 (t
-		  (set-window-configuration (car register-value))
-		  (goto-char (cadr register-value))
-		  (message "Switched to window configuration `%c'."
-			   register)))
-	   (setq mdw-current-window-configuration register)))))
-
-;; Don't raise windows unless I say so.
-
-(defcustom mdw-inhibit-raise-frame nil
-  "Whether `raise-frame' should do nothing when the frame is mapped."
-  :type 'boolean)
-
-(defadvice raise-frame
-    (around mdw-inhibit (&optional frame) activate compile)
-  "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
-frame is actually mapped on the screen."
-  (if mdw-inhibit-raise-frame
-      (make-frame-visible frame)
-    ad-do-it))
-
-(defmacro mdw-advise-to-inhibit-raise-frame (function)
-  "Advise the FUNCTION not to raise frames, even if it wants to."
-  `(defadvice ,function
-       (around mdw-inhibit-raise (&rest hunoz) activate compile)
-     "Don't raise the window unless you have to."
-     (let ((mdw-inhibit-raise-frame t))
-       ad-do-it)))
-
-(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
-(mdw-advise-to-inhibit-raise-frame appt-disp-window)
-(mdw-advise-to-inhibit-raise-frame mouse-select-window)
-
 ;; Bug fix for markdown-mode, which breaks point positioning during
 ;; `query-replace'.
 (defadvice markdown-check-change-for-wiki-link
@@ -679,7 +468,251 @@ (setq glasses-separator "-"
       glasses-separate-parentheses-p nil
       glasses-uncapitalize-p t)
 
-;; Some hacks to do with window placement.
+;; Rename buffers along with files.
+
+(defvar mdw-inhibit-rename-buffer nil
+  "If non-nil, `rename-file' won't rename the buffer visiting the file.")
+
+(defmacro mdw-advise-to-inhibit-rename-buffer (function)
+  "Advise FUNCTION to set `mdw-inhibit-rename-buffer' while it runs.
+
+This will prevent `rename-file' from renaming the buffer."
+  `(defadvice ,function (around mdw-inhibit-rename-buffer compile activate)
+     "Don't rename the buffer when renaming the underlying file."
+     (let ((mdw-inhibit-rename-buffer t))
+       ad-do-it)))
+(mdw-advise-to-inhibit-rename-buffer recode-file-name)
+(mdw-advise-to-inhibit-rename-buffer set-visited-file-name)
+(mdw-advise-to-inhibit-rename-buffer backup-buffer)
+
+(defadvice rename-file (after mdw-rename-buffers (from to &optional forcep)
+			compile activate)
+  "If a buffer is visiting the file, rename it to match the new name.
+
+Don't do this if `mdw-inhibit-rename-buffer' is non-nil."
+  (unless mdw-inhibit-rename-buffer
+    (let ((buffer (get-file-buffer from)))
+      (when buffer
+	(let ((to (if (not (string= (file-name-nondirectory to) "")) to
+		    (concat to (file-name-nondirectory from)))))
+	  (with-current-buffer buffer
+	    (set-visited-file-name to nil t)))))))
+
+;;;--------------------------------------------------------------------------
+;;; Window management.
+
+;; Width configuration.
+
+(defcustom mdw-column-width
+  (string-to-number (or (mdw-config 'emacs-width) "77"))
+  "Width of Emacs columns."
+  :type 'integer)
+(defcustom mdw-text-width mdw-column-width
+  "Expected width of text within columns."
+  :type 'integer
+  :safe 'integerp)
+
+;; Splitting windows.
+
+(unless (fboundp 'scroll-bar-columns)
+  (defun scroll-bar-columns (side)
+    (cond ((eq side 'left) 0)
+	  (window-system 3)
+	  (t 1))))
+(unless (fboundp 'fringe-columns)
+  (defun fringe-columns (side)
+    (cond ((not window-system) 0)
+	  ((eq side 'left) 1)
+	  (t 2))))
+
+(defun mdw-horizontal-window-overhead ()
+  "Computes the horizontal window overhead.
+This is the number of columns used by fringes, scroll bars and other such
+cruft."
+  (if (not window-system)
+      1
+    (let ((tot 0))
+      (dolist (what '(scroll-bar fringe))
+	(dolist (side '(left right))
+	  (cl-incf tot
+		   (funcall (intern (concat (symbol-name what) "-columns"))
+			    side))))
+      tot)))
+
+(defun mdw-split-window-horizontally (&optional width)
+  "Split a window horizontally.
+Without a numeric argument, split the window approximately in
+half.  With a numeric argument WIDTH, allocate WIDTH columns to
+the left-hand window (if positive) or -WIDTH columns to the
+right-hand window (if negative).  Space for scroll bars and
+fringes is not taken out of the allowance for WIDTH, unlike
+\\[split-window-horizontally]."
+  (interactive "P")
+  (split-window-horizontally
+   (cond ((null width) nil)
+	 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
+	 ((< width 0) width))))
+
+(defun mdw-preferred-column-width ()
+  "Return the preferred column width."
+  (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
+    (1+ mdw-column-width)))
+
+(defun mdw-divvy-window (&optional width)
+  "Split a wide window into appropriate widths."
+  (interactive "P")
+  (setq width (if width (prefix-numeric-value width)
+		(mdw-preferred-column-width)))
+  (let* ((win (selected-window))
+	 (sb-width (mdw-horizontal-window-overhead))
+	 (c (/ (+ (window-width) sb-width)
+	       (+ width sb-width))))
+    (while (> c 1)
+      (setq c (1- c))
+      (split-window-horizontally (+ width sb-width))
+      (other-window 1))
+    (select-window win)))
+
+(defun mdw-frame-width-quantized-p (frame-width column-width)
+  "Return whether the FRAME-WIDTH was chosen specifically for COLUMN-WIDTH."
+  (let ((sb-width (mdw-horizontal-window-overhead)))
+    (zerop (mod (+ frame-width sb-width)
+		(+ column-width sb-width)))))
+
+(defun mdw-frame-width-for-columns (columns width)
+  "Return the preferred width for a frame with so many COLUMNS of WIDTH."
+  (let ((sb-width (mdw-horizontal-window-overhead)))
+    (- (* columns (+ width sb-width))
+       sb-width)))
+
+(defun mdw-set-frame-width (columns &optional width)
+  "Set the current frame to be the correct width for COLUMNS columns.
+
+If WIDTH is non-nil, then it provides the width for the new columns.  (This
+can be set interactively with a prefix argument.)"
+  (interactive "nColumns: 
+P")
+  (setq width (if width (prefix-numeric-value width)
+		(mdw-preferred-column-width)))
+  (set-frame-width (selected-frame)
+		   (mdw-frame-width-for-columns columns width))
+  (mdw-divvy-window width))
+
+(defcustom mdw-frame-width-fudge
+  (cond ((<= emacs-major-version 20) 1)
+	((= emacs-major-version 26) 3)
+	(t 0))
+  "The number of extra columns to add to the desired frame width.
+
+This is sadly necessary because Emacs 26 is broken in this regard."
+  :type 'integer)
+
+(defcustom mdw-frame-colour-alist
+  '((black . ("#000000" . "#ffffff"))
+    (red . ("#2a0000" . "#ffffff"))
+    (green . ("#002a00" . "#ffffff"))
+    (blue . ("#00002a" . "#ffffff")))
+  "Alist mapping symbol names to (FOREGROUND . BACKGROUND) colour pairs."
+  :type '(alist :key-type symbol :value-type (cons color color)))
+
+(defun mdw-set-frame-colour (colour &optional frame)
+  (interactive "xColour name or (FOREGROUND . BACKGROUND) pair: 
+")
+  (when (and colour (symbolp colour))
+    (let ((entry (assq colour mdw-frame-colour-alist)))
+      (unless entry (error "Unknown colour `%s'" colour))
+      (setf colour (cdr entry))))
+  (set-frame-parameter frame 'background-color (car colour))
+  (set-frame-parameter frame 'foreground-color (cdr colour)))
+
+;; Window configuration switching.
+
+(defvar mdw-current-window-configuration nil
+  "The current window configuration register name, or `nil'.")
+
+(defun mdw-switch-window-configuration (register &optional no-save)
+  "Switch make REGISTER be the new current window configuration.
+If a current window configuration register is established, and
+NO-SAVE is nil, then save the current window configuration to
+that register first.
+
+Signal an error if the new register contains something other than
+a window configuration.  If the register is unset then save the
+current window configuration to it immediately.
+
+With one or three C-u, or an odd numeric prefix argument, set
+NO-SAVE, so the previous window configuration register is left
+unchanged.
+
+With two or three C-u, or a prefix argument which is an odd
+multiple of 2, just clear the record of the current window
+configuration register, so that the next switch doesn't save the
+prevailing configuration."
+  (interactive
+   (let ((arg current-prefix-arg))
+     (list (if (or (and (consp arg) (= (car arg) 16) (= (car arg) 64))
+		   (and (integerp arg) (not (zerop (logand arg 2)))))
+	       nil
+	     (register-read-with-preview "Switch to window configuration: "))
+	   (or (and (consp arg) (= (car arg) 4) (= (car arg) 64))
+	       (and (integerp arg) (not (zerop (logand arg 1))))))))
+
+  (let ((previous mdw-current-window-configuration)
+	(current-windows (list (current-window-configuration)
+			       (point-marker)))
+	(register-value (and register (get-register register))))
+    (when (and mdw-current-window-configuration (not no-save))
+      (set-register mdw-current-window-configuration current-windows))
+    (cond ((null register)
+	   (setq mdw-current-window-configuration nil)
+	   (if previous
+	       (message "Left window configuration `%c'." previous)
+	     (message "Nothing to do!")))
+	  ((not (or (null register-value)
+		    (and (consp register-value)
+			 (window-configuration-p (car register-value))
+			 (integer-or-marker-p (cadr register-value))
+			 (null (cl-caddr register-value)))))
+	   (error "Register `%c' is not a window configuration" register))
+	  (t
+	   (cond ((null register-value)
+		  (set-register register current-windows)
+		  (message "Started new window configuration `%c'."
+			   register))
+		 (t
+		  (set-window-configuration (car register-value))
+		  (goto-char (cadr register-value))
+		  (message "Switched to window configuration `%c'."
+			   register)))
+	   (setq mdw-current-window-configuration register)))))
+
+;; Don't raise windows unless I say so.
+
+(defcustom mdw-inhibit-raise-frame nil
+  "Whether `raise-frame' should do nothing when the frame is mapped."
+  :type 'boolean)
+
+(defadvice raise-frame
+    (around mdw-inhibit (&optional frame) activate compile)
+  "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
+frame is actually mapped on the screen."
+  (if mdw-inhibit-raise-frame
+      (make-frame-visible frame)
+    ad-do-it))
+
+(defmacro mdw-advise-to-inhibit-raise-frame (function)
+  "Advise the FUNCTION not to raise frames, even if it wants to."
+  `(defadvice ,function
+       (around mdw-inhibit-raise (&rest hunoz) activate compile)
+     "Don't raise the window unless you have to."
+     (let ((mdw-inhibit-raise-frame t))
+       ad-do-it)))
+
+(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
+(mdw-advise-to-inhibit-raise-frame appt-disp-window)
+(mdw-advise-to-inhibit-raise-frame mouse-select-window)
+
+;; Window selection for `display-buffer'.
 
 (defvar mdw-designated-window nil
   "The window chosen by `mdw-designate-window', or nil.")
@@ -881,36 +914,6 @@ (setq display-buffer-fallback-action
 	   display-buffer-pop-up-window
 	   mdw-display-buffer-in-tolerable-window)))
 
-;; Rename buffers along with files.
-
-(defvar mdw-inhibit-rename-buffer nil
-  "If non-nil, `rename-file' won't rename the buffer visiting the file.")
-
-(defmacro mdw-advise-to-inhibit-rename-buffer (function)
-  "Advise FUNCTION to set `mdw-inhibit-rename-buffer' while it runs.
-
-This will prevent `rename-file' from renaming the buffer."
-  `(defadvice ,function (around mdw-inhibit-rename-buffer compile activate)
-     "Don't rename the buffer when renaming the underlying file."
-     (let ((mdw-inhibit-rename-buffer t))
-       ad-do-it)))
-(mdw-advise-to-inhibit-rename-buffer recode-file-name)
-(mdw-advise-to-inhibit-rename-buffer set-visited-file-name)
-(mdw-advise-to-inhibit-rename-buffer backup-buffer)
-
-(defadvice rename-file (after mdw-rename-buffers (from to &optional forcep)
-			compile activate)
-  "If a buffer is visiting the file, rename it to match the new name.
-
-Don't do this if `mdw-inhibit-rename-buffer' is non-nil."
-  (unless mdw-inhibit-rename-buffer
-    (let ((buffer (get-file-buffer from)))
-      (when buffer
-	(let ((to (if (not (string= (file-name-nondirectory to) "")) to
-		    (concat to (file-name-nondirectory from)))))
-	  (with-current-buffer buffer
-	    (set-visited-file-name to nil t)))))))
-
 ;;;--------------------------------------------------------------------------
 ;;; Improved compilation machinery.