X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/6c0b60796d4e0c7ada1c0673e90e74e0a8462c77..34b3e368ae2864613990ff5a1a8bbf6bab92415f:/el/dot-emacs.el

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 67a5d1e..393e136 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -55,8 +55,7 @@ This may be at the expense of cool features.")
 ;;; Some general utilities.
 
 (eval-when-compile
-  (unless (fboundp 'make-regexp)
-    (load "make-regexp"))
+  (unless (fboundp 'make-regexp) (load "make-regexp"))
   (require 'cl))
 
 (defmacro mdw-regexps (&rest list)
@@ -76,20 +75,28 @@ This may be at the expense of cool features.")
       (and (= emacs-major-version major)
 	   (>= emacs-minor-version (or minor 0)))))
 
+(defun mdw-submode-p (mode parent)
+  "Return non-nil if MODE is indirectly derived from PARENT."
+  (let ((answer nil))
+    (while (cond ((eq mode parent) (setq answer t) nil)
+		 (t (setq mode (get mode 'derived-mode-parent)))))
+    answer))
+
 ;; Some error trapping.
 ;;
 ;; If individual bits of this file go tits-up, we don't particularly want
 ;; the whole lot to stop right there and then, because it's bloody annoying.
 
-(defmacro trap (&rest forms)
-  "Execute FORMS without allowing errors to propagate outside."
-  (declare (indent 0)
-	   (debug t))
-  `(condition-case err
-       ,(if (cdr forms) (cons 'progn forms) (car forms))
-     (error (message "Error (trapped): %s in %s"
-		     (error-message-string err)
-		     ',forms))))
+(eval-and-compile
+  (defmacro trap (&rest forms)
+    "Execute FORMS without allowing errors to propagate outside."
+    (declare (indent 0)
+	     (debug t))
+    `(condition-case err
+	 ,(if (cdr forms) (cons 'progn forms) (car forms))
+       (error (message "Error (trapped): %s in %s"
+		       (error-message-string err)
+		       ',forms)))))
 
 ;; Configuration reading.
 
@@ -246,6 +253,18 @@ fringes is not taken out of the allowance for WIDTH, unlike
       (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.
 
@@ -255,11 +274,9 @@ can be set interactively with a prefix argument.)"
 P")
   (setq width (if width (prefix-numeric-value width)
 		(mdw-preferred-column-width)))
-  (let ((sb-width (mdw-horizontal-window-overhead)))
-    (set-frame-width (selected-frame)
-		     (- (* columns (+ width sb-width))
-			sb-width))
-    (mdw-divvy-window 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)
@@ -288,6 +305,67 @@ This is sadly necessary because Emacs 26 is broken in this regard."
   (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 (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
@@ -592,6 +670,52 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'."
 
 ;; Some hacks to do with window placement.
 
+(defvar mdw-designated-window nil
+  "The window chosen by `mdw-designate-window', or nil.")
+
+(defun mdw-designated-window-display-buffer-function (buffer not-this-window)
+  "Display buffer function to use the designated window."
+  (unless mdw-designated-window (error "No designated window!"))
+  (prog1 mdw-designated-window
+    (with-selected-window mdw-designated-window (switch-to-buffer buffer))
+    (setq mdw-designated-window nil
+	  display-buffer-function nil)))
+
+(defun mdw-display-buffer-in-designated-window (buffer alist)
+  "Display function to use the designated window."
+  (prog1 mdw-designated-window
+    (when mdw-designated-window
+      (with-selected-window mdw-designated-window
+	(switch-to-buffer buffer nil t)))
+    (setq mdw-designated-window nil)))
+
+(defun mdw-designate-window (cancel)
+  "Use the selected window for the next pop-up buffer.
+With a prefix argument, clear the designated window."
+  (interactive "P")
+  (let ((window (selected-window)))
+    (cond (cancel
+	   (setq mdw-designated-window nil)
+	   (unless (mdw-emacs-version-p 24)
+	     (setq display-buffer-function nil))
+	   (message "Window designation cleared."))
+	  ((window-dedicated-p window)
+	   (error "Window is dedicated to its buffer."))
+	  (t
+	   (setq mdw-designated-window window)
+	   (unless (mdw-emacs-version-p 24)
+	     (setq display-buffer-function
+		     #'mdw-designated-window-display-buffer-function))
+	   (message "Window designated.")))))
+
+(when (mdw-emacs-version-p 24)
+  (setq display-buffer-base-action
+	  (let* ((action display-buffer-base-action)
+		 (funcs (car action))
+		 (alist (cdr action)))
+	    (cons (cons 'mdw-display-buffer-in-designated-window funcs)
+		  alist))))
+
 (defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
   "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
   (interactive "bBuffer: ")
@@ -633,6 +757,70 @@ Pretend they don't exist.  They might be on other display devices."
 (setq even-window-sizes nil
       even-window-heights nil)
 
+(setq display-buffer-reuse-frames nil)
+
+(defun mdw-last-window-in-frame-p (window)
+  "Return whether WINDOW is the last in its frame."
+  (catch 'done
+    (while window
+      (let ((next (window-next-sibling window)))
+	(while (and next (window-minibuffer-p next))
+	  (setq next (window-next-sibling next)))
+	(if next (throw 'done nil)))
+      (setq window (window-parent window)))
+    t))
+
+(defun mdw-display-buffer-in-tolerable-window (buffer alist)
+  "Try finding a tolerable window in which to display BUFFER.
+Begone, foul DWIMmerlaik!
+
+This is all totally subject to arbitrary change in the future, but the
+emphasis is on predictability rather than crazy DWIMmery."
+  (let* ((selected (selected-window)) chosen
+	 (full-height-p (window-full-height-p selected))
+	 (full-width-p (window-full-width-p selected)))
+    (cond
+
+     ((and full-height-p full-width-p)
+      ;; We're basically the only window in the frame.  If we want to get
+      ;; anywhere, we'll have to split the window.
+
+      (let ((width (window-width selected))
+	    (preferred-width (mdw-preferred-column-width)))
+	(if (and (>= width (mdw-frame-width-for-columns 2 preferred-width))
+		 (mdw-frame-width-quantized-p width preferred-width))
+	    (setq chosen (split-window-right preferred-width))
+	  (setq chosen (split-window-below)))
+	(display-buffer-record-window 'window chosen buffer)))
+
+     ((mdw-last-window-in-frame-p selected)
+      ;; This is the last window in the frame.  I don't think I want to
+      ;; clobber the first window, so rebound and clobber the previous one
+      ;; instead.  (This obviously has the same effect if there are only two
+      ;; windows, but seems more useful if there are three.)
+
+      (setq chosen (previous-window selected 'never nil))
+      (display-buffer-record-window 'reuse chosen buffer))
+
+     (t
+      ;; There's another window in front of us.  Let's use that one.
+      (setq chosen (next-window selected 'never nil)))
+      (display-buffer-record-window 'reuse chosen buffer))
+
+    (if (eq chosen selected)
+	(error "Failed to select a different window!"))
+
+    (when chosen
+      (with-selected-window chosen (switch-to-buffer buffer)))
+    chosen))
+
+;; Hack the display actions so that they do something sensible.
+(setq display-buffer-fallback-action
+	'((display-buffer--maybe-same-window
+	   display-buffer-reuse-window
+	   display-buffer-pop-up-window
+	   mdw-display-buffer-in-tolerable-window)))
+
 ;; Rename buffers along with files.
 
 (defvar mdw-inhibit-rename-buffer nil
@@ -947,8 +1135,8 @@ Use this to arrange for per-server settings."
 (defadvice gnus-other-frame (around mdw-hack-frame-width compile activate)
   "Always arrange for mail/news frames to be 80 columns wide."
   (let ((default-frame-alist (cons `(width . ,(+ 80 mdw-frame-width-fudge))
-				   (cl-delete 'width default-frame-alist
-					      :key #'car))))
+				   (delete* 'width default-frame-alist
+					    :key #'car))))
     ad-do-it))
 
 ;; Preferred programs.
@@ -1096,21 +1284,6 @@ tramp, which seems to get itself into a twist."
   (let ((auto-revert-check-vc-info t))
     (auto-revert-buffers)))
 
-(defun comint-send-and-indent ()
-  (interactive)
-  (comint-send-input)
-  (and mdw-auto-indent
-       (indent-for-tab-command)))
-
-(defadvice comint-line-beginning-position
-    (around mdw-calculate-it-properly () activate compile)
-  "Calculate the actual line start for multi-line input."
-  (if (or comint-use-prompt-regexp
-	  (eq (field-at-pos (point)) 'output))
-      ad-do-it
-    (setq ad-return-value
-	    (constrain-to-field (line-beginning-position) (point)))))
-
 ;;;--------------------------------------------------------------------------
 ;;; Dired hacking.
 
@@ -1448,8 +1621,8 @@ case."
 			(line-height . 10.55)
 			(space-width . 5.1)
 			(avg-char-width . 5.1)))
-		     (cl-remove 'CourierCondensed ps-font-info-database
-				:key #'car)))))
+		     (remove* 'CourierCondensed ps-font-info-database
+			      :key #'car)))))
 
 ;; Arrange to strip overlays from the buffer before we print .  This will
 ;; prevent `flyspell' from interfering with the printout.  (It would be less
@@ -1719,6 +1892,23 @@ doesn't match any of the regular expressions in
   (t :inverse-video t))
 (mdw-define-face viper-search (t :inherit isearch))
 
+(mdw-define-face compilation-error
+  (((class color)) :foreground "red" :weight bold)
+  (t :weight bold))
+(mdw-define-face compilation-warning
+  (((class color)) :foreground "orange" :weight bold)
+  (t :weight bold))
+(mdw-define-face compilation-info
+  (((class color)) :foreground "green" :weight bold)
+  (t :weight bold))
+(mdw-define-face compilation-line-number
+  (t :weight bold))
+(mdw-define-face compilation-column-number
+  (((min-colors 64)) :foreground "lightgrey"))
+(setq compilation-message-face 'mdw-virgin-face)
+(setq compilation-enter-directory-face 'font-lock-comment-face)
+(setq compilation-leave-directory-face 'font-lock-comment-face)
+
 (mdw-define-face holiday-face
   (t :background "red"))
 (mdw-define-face calendar-today-face
@@ -1769,18 +1959,18 @@ doesn't match any of the regular expressions in
   (t :weight bold))
 (mdw-define-face font-lock-variable-name-face
   (t :slant italic))
-(mdw-define-face font-lock-comment-delimiter-face
-  (((min-colors 64)) :slant italic :foreground "SeaGreen1")
-  (((class color)) :foreground "green")
-  (t :weight bold))
 (mdw-define-face font-lock-comment-face
   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
   (((class color)) :foreground "green")
   (t :weight bold))
+(mdw-define-face font-lock-comment-delimiter-face
+  (t :inherit font-lock-comment-face))
 (mdw-define-face font-lock-string-face
   (((min-colors 64)) :foreground "SkyBlue1")
   (((class color)) :foreground "cyan")
   (t :weight bold))
+(mdw-define-face font-lock-doc-face
+  (t :inherit font-lock-string-face))
 
 (mdw-define-face message-separator
   (t :background "red" :foreground "white" :weight bold))
@@ -2149,6 +2339,18 @@ doesn't match any of the regular expressions in
 (add-hook 'post-command-hook 'mdw-update-terminal-title)
 
 ;;;--------------------------------------------------------------------------
+;;; Ediff hacking.
+
+(defvar mdw-ediff-previous-windows)
+(defun mdw-ediff-setup ()
+  (setq mdw-ediff-previous-windows (current-window-configuration)))
+(defun mdw-ediff-suspend-or-quit ()
+  (set-window-configuration mdw-ediff-previous-windows))
+(add-hook 'ediff-before-setup-hook 'mdw-ediff-setup)
+(add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t)
+(add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t)
+
+;;;--------------------------------------------------------------------------
 ;;; C programming configuration.
 
 ;; Make C indentation nice.
@@ -2192,7 +2394,10 @@ indentation anyway."
   (let ((output nil))
     (dolist (item first)
       (let ((key (car item)) (value (cdr item)))
-	(if (string-suffix-p "-alist" (symbol-name key))
+	(if (let* ((key-name (symbol-name key))
+		   (key-len (length key-name)))
+	      (and (>= key-len 6)
+		   (string= (subseq key-name (- key-len 6)) "-alist")))
 	    (push (cons key
 			(mdw-merge-style-alists value
 						(cdr (assoc key second))))
@@ -2203,7 +2408,7 @@ indentation anyway."
 	(push item output)))
     (nreverse output)))
 
-(cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
+(defmacro* mdw-define-c-style (name (&optional parent) &rest assocs)
   "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
 A function, named `mdw-define-c-style/NAME', is defined to actually install
 the style using `c-add-style', and added to the hook
@@ -3074,7 +3279,8 @@ name, as a symbol."
 
 	     ;; And anything else is punctuation.
 	     (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
-		   '(0 mdw-punct-face)))))
+		   '(0 mdw-punct-face)))
+	    font-lock-syntactic-face-function . nil))
 
   ;; Hack key bindings.
   (local-set-key [?{] 'mdw-self-insert-and-indent)
@@ -3153,6 +3359,7 @@ name, as a symbol."
 
 (setq-default cperl-indent-level 2
 	      cperl-continued-statement-offset 2
+	      cperl-indent-region-fix-constructs nil
 	      cperl-continued-brace-offset 0
 	      cperl-brace-offset -2
 	      cperl-brace-imaginary-offset 0
@@ -4244,7 +4451,7 @@ strip numbers instead."
 ;;;--------------------------------------------------------------------------
 ;;; HTML, CSS, and other web foolishness.
 
-(setq-default css-indent-offset 2)
+(setq-default css-indent-offset 8)
 
 ;;;--------------------------------------------------------------------------
 ;;; SGML hacking.
@@ -4752,7 +4959,7 @@ align the other subforms beneath it.  Otherwise, indent them
 	       (eq lisp-indent-backquote-substitution-mode 'corrected))
       (save-excursion
 	(goto-char (elt state 1))
-	(cl-incf loop-indentation
+	(incf loop-indentation
 		 (cond ((eq (char-before) ?,) -1)
 		       ((and (eq (char-before) ?@)
 			     (progn (backward-char)
@@ -4807,11 +5014,12 @@ align the other subforms beneath it.  Otherwise, indent them
   (if mdw-friendly-name (setq ad-return-value mdw-friendly-name)
     ad-do-it))
 
-(trap
- (if (not mdw-fast-startup)
-     (progn
-       (require 'slime-autoloads)
-       (slime-setup '(slime-autodoc slime-c-p-c)))))
+(eval-and-compile
+  (trap
+    (if (not mdw-fast-startup)
+	(progn
+	  (require 'slime-autoloads)
+	  (slime-setup '(slime-autodoc slime-c-p-c))))))
 
 (let ((stuff '((cmucl ("cmucl"))
 	       (sbcl ("sbcl") :coding-system utf-8-unix)
@@ -4943,6 +5151,21 @@ align the other subforms beneath it.  Otherwise, indent them
   (auto-fill-mode -1)
   (setq tab-width 8))
 
+(defun comint-send-and-indent ()
+  (interactive)
+  (comint-send-input)
+  (and mdw-auto-indent
+       (indent-for-tab-command)))
+
+(defadvice comint-line-beginning-position
+    (around mdw-calculate-it-properly () activate compile)
+  "Calculate the actual line start for multi-line input."
+  (if (or comint-use-prompt-regexp
+	  (eq (field-at-pos (point)) 'output))
+      ad-do-it
+    (setq ad-return-value
+	    (constrain-to-field (line-beginning-position) (point)))))
+
 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
@@ -5084,6 +5307,35 @@ there is sadness."
       (smerge-mode 1))))
 (add-hook 'find-file-hook 'mdw-try-smerge t)
 
+(defcustom mdw-magit-new-window-modes
+  '(magit-diff-mode
+    magit-log-mode
+    magit-process-mode
+    magit-revision-mode
+    magit-stash-mode
+    magit-status-mode)
+  "Magit modes which should cause a new window to be used."
+  :type '(repeat symbol))
+
+(defun mdw-display-magit-buffer (buffer)
+  "Like `magit-display-buffer-traditional'.
+But uses `mdw-magit-new-window-modes' for its list of modes
+rather than baking the list into the function."
+  (display-buffer buffer
+		  (let ((mode (with-current-buffer buffer major-mode)))
+		    (if (and (not mdw-designated-window)
+			     (derived-mode-p 'magit-mode)
+			     (mdw-submode-p mode 'magit-mode)
+			     (not (memq mode mdw-magit-new-window-modes)))
+			'(display-buffer-same-window . nil)
+		      nil))))
+(setq magit-display-buffer-function 'mdw-display-magit-buffer)
+
+(defun mdw-display-magit-file-buffer (buffer)
+  "Show a file buffer from a diff."
+  (select-window (display-buffer buffer)))
+(setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer)
+
 ;;;--------------------------------------------------------------------------
 ;;; GUD, and especially GDB.
 
@@ -5098,6 +5350,15 @@ there is sadness."
   (set-window-dedicated-p (or window (selected-window)) nil))
 
 ;;;--------------------------------------------------------------------------
+;;; SQL stuff.
+
+(setq sql-postgres-options '("-n" "-P" "pager=off")
+      sql-postgres-login-params
+	'((user :default "mdw")
+	  (database :default "mdw")
+	  (server :default "db.distorted.org.uk")))
+
+;;;--------------------------------------------------------------------------
 ;;; Man pages.
 
 ;; Turn off `noip' when running `man': it interferes with `man-db''s own