(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 ()
(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
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.")
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.
~mdw / profile / commitdiff