+;; 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'.
~mdw / profile / commitdiff