X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/539dce4c2422e7d4c720fad79f2a6ee2038257d1..14be6377828468938a6de60f6d5361474e8e42d1:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index 21933de..07b6d03 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -55,15 +55,14 @@ This may be at the expense of cool features.") ;;; Some general utilities. (eval-when-compile - (unless (fboundp 'make-regexp) - (load "make-regexp")) - (require 'cl)) + (unless (fboundp 'make-regexp) (load "make-regexp")) + (require 'cl-lib)) (defmacro mdw-regexps (&rest list) "Turn a LIST of strings into a single regular expression at compile-time." (declare (indent nil) (debug 0)) - `',(make-regexp list)) + `',(make-regexp (sort (cl-copy-list list) #'string<))) (defun mdw-wrong () "This is not the key sequence you're looking for." @@ -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. @@ -98,10 +105,10 @@ This may be at the expense of cool features.") "Read the configuration variable named SYM." (unless mdw-config (setq mdw-config - (flet ((replace (what with) - (goto-char (point-min)) - (while (re-search-forward what nil t) - (replace-match with t)))) + (cl-flet ((replace (what with) + (goto-char (point-min)) + (while (re-search-forward what nil t) + (replace-match with t)))) (with-temp-buffer (insert-file-contents "~/.mdw.conf") (replace "^[ \t]*\\(#.*\\)?\n" "") @@ -208,8 +215,9 @@ cruft." (let ((tot 0)) (dolist (what '(scroll-bar fringe)) (dolist (side '(left right)) - (incf tot (funcall (intern (concat (symbol-name what) "-columns")) - side)))) + (cl-incf tot + (funcall (intern (concat (symbol-name what) "-columns")) + side)))) tot))) (defun mdw-split-window-horizontally (&optional width) @@ -246,6 +254,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 +275,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 +306,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 (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 @@ -418,8 +497,8 @@ as output rather than a string." (if (eq (cdr ddate) 'st-tibs-day) (format "St Tib's Day %s" tail) (let ((season (cadr ddate)) - (daynum (caddr ddate)) - (dayname (cadddr ddate))) + (daynum (cl-caddr ddate)) + (dayname (cl-cadddr ddate))) (format "%s, the %d%s day of %s %s" dayname daynum @@ -555,6 +634,17 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." :key-type string :value-type string)))) +(setq org-emphasis-regexp-components + '("- \t('\"{}" ; prematch + "- \t.,:!?;'\")}\\[" ; postmatch + " \t\r\n" ; /forbidden/ as border + "." ; body regexp + 1)) ; maximum newlines + +(setq org-entities-user + ;; NAME LATEX MATHP HTML ASCII LATIN1 UTF8 + '(("relax" "" nil "" "" "" ""))) + (eval-after-load "org-latex" '(setq org-export-latex-classes (append mdw-org-latex-defs org-export-latex-classes))) @@ -578,7 +668,6 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." ("" "hyperref" nil) "\\tolerance=1000"))) - (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i" org-export-docbook-xsl-fo-proc-command "fop %i.safe %o" org-export-docbook-xslt-stylesheet @@ -592,6 +681,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: ") @@ -631,7 +766,70 @@ Pretend they don't exist. They might be on other display devices." (ad-set-arg 2 nil)) (setq even-window-sizes nil - even-window-heights nil) + even-window-heights nil + 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. @@ -711,14 +909,14 @@ to force interactive compilation." (interactive (let* ((prefix (prefix-numeric-value current-prefix-arg)) (command (eval compile-command)) - (dir (and (plusp (logand prefix #x54)) + (dir (and (cl-plusp (logand prefix #x54)) (read-directory-name "Compile in directory: ")))) (list (if (or compilation-read-command - (plusp (logand prefix #x42))) + (cl-plusp (logand prefix #x42))) (compilation-read-command command) command) dir - (plusp (logand prefix #x58))))) + (cl-plusp (logand prefix #x58))))) (let ((default-directory (or directory default-directory))) (compile command comint))) @@ -728,13 +926,13 @@ to force interactive compilation." (catch 'found (let* ((src-dir (file-name-as-directory (expand-file-name "."))) (dir src-dir)) - (loop + (cl-loop (when (file-exists-p (concat dir build-file)) (throw 'found dir)) (let ((sub (expand-file-name (file-relative-name src-dir dir) (concat dir "build/")))) (catch 'give-up - (loop + (cl-loop (when (file-exists-p (concat sub build-file)) (throw 'found sub)) (when (string= sub dir) (throw 'give-up nil)) @@ -876,12 +1074,12 @@ Use this to arrange for per-server settings." (defun mdw-nnimap-transform-headers () (goto-char (point-min)) (let (article lines size string) - (block nil + (cl-block nil (while (not (eobp)) (while (not (looking-at "\\* [0-9]+ FETCH")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) - (return))) + (cl-return))) (goto-char (match-end 0)) ;; Unfold quoted {number} strings. (while (re-search-forward @@ -947,8 +1145,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. @@ -1215,7 +1413,7 @@ CHECK is fboundp, and returning the correponding FUNC." "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s") ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml"))) (add-to-list 'w3m-search-engine-alist - (list (cadr item) (caddr item) nil)) + (list (cadr item) (cl-caddr item) nil)) (add-to-list 'w3m-uri-replace-alist (list (concat "\\`" (car item) ":") 'w3m-search-uri-replace @@ -1286,12 +1484,12 @@ This is mainly useful in `auto-fill-mode'." ((eq (car pat) 'if) (if (or (null (cdr pat)) (null (cddr pat)) - (null (cdddr pat)) - (cddddr pat)) + (null (cl-cdddr pat)) + (cl-cddddr pat)) (error "Invalid `if' pattern `%S'" pat)) (mdw-fill-prefix-match-p (if (eval (cadr pat)) - (caddr pat) - (cadddr pat)))) + (cl-caddr pat) + (cl-cadddr pat)))) ((eq (car pat) 'and) (let ((pats (cdr pat)) (ok t)) @@ -1411,7 +1609,7 @@ case." '(progn ;; Notice that the comment-delimiters should be in italics too. - (pushnew 'font-lock-comment-delimiter-face ps-italic-faces) + (cl-pushnew 'font-lock-comment-delimiter-face ps-italic-faces) ;; Select more suitable colours for the main kinds of tokens. The ;; colours set on the Emacs faces are chosen for use against a dark @@ -1581,11 +1779,11 @@ doesn't match any of the regular expressions in (let ((frame-display (frame-parameter frame 'display))) (when (and frame-display (eq window-system 'x) - (not (some (lambda (fr) - (and (not (eq fr frame)) - (string= (frame-parameter fr 'display) - frame-display))) - (frame-list)))) + (not (cl-some (lambda (fr) + (and (not (eq fr frame)) + (string= (frame-parameter fr 'display) + frame-display))) + (frame-list)))) (run-with-idle-timer 0 nil #'x-close-connection frame-display)))) (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights) @@ -1660,6 +1858,9 @@ doesn't match any of the regular expressions in (((min-colors 64)) :background "grey30") (((class color)) :background "blue") (t :inverse-video t)) +(mdw-define-face error + (((class color)) :background "red") + (t :inverse-video t)) (mdw-define-face match (((class color)) :background "blue") (t :inverse-video t)) @@ -1704,11 +1905,37 @@ 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 (t :foreground "yellow" :weight bold)) +(mdw-define-face flyspell-incorrect + (((type x)) :underline (:color "red" :style wave)) + (((class color)) :foreground "red" :underline t) + (t :underline t)) +(mdw-define-face flyspell-duplicate + (((type x)) :underline (:color "orange" :style wave)) + (((class color)) :foreground "orange" :underline t) + (t :underline t)) + (mdw-define-face comint-highlight-prompt (t :weight bold)) (mdw-define-face comint-highlight-input @@ -1754,18 +1981,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)) @@ -2098,11 +2325,11 @@ doesn't match any of the regular expressions in :global nil (let ((buffer (current-buffer))) (setq mdw-point-overlay-buffers - (mapcan (lambda (buf) - (if (and (buffer-live-p buf) - (not (eq buf buffer))) - (list buf))) - mdw-point-overlay-buffers)) + (cl-mapcan (lambda (buf) + (if (and (buffer-live-p buf) + (not (eq buf buffer))) + (list buf))) + mdw-point-overlay-buffers)) (if mdw-point-overlay-mode (setq mdw-point-overlay-buffers (cons buffer mdw-point-overlay-buffers)))) @@ -2134,6 +2361,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. @@ -2163,7 +2402,7 @@ indentation anyway." (should-indent-p t)) (while (and context (eq (caar context) 'arglist-cont-nonempty)) - (when (and (= (caddr (pop context)) pos) + (when (and (= (cl-caddr (pop context)) pos) context (memq (caar context) '(arglist-intro arglist-cont-nonempty))) @@ -2177,7 +2416,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= (substring key-name (- key-len 6)) "-alist"))) (push (cons key (mdw-merge-style-alists value (cdr (assoc key second)))) @@ -2257,11 +2499,12 @@ name, as a symbol." (append (mapcar (lambda (mode) (cons mode style)) modes) - (remove-if (lambda (assoc) - (memq (car assoc) modes)) - (if (listp c-default-style) - c-default-style - (list (cons 'other c-default-style)))))))) + (cl-remove-if (lambda (assoc) + (memq (car assoc) modes)) + (if (listp c-default-style) + c-default-style + (list (cons 'other + c-default-style)))))))) (setq c-default-style "mdw-c") (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c) @@ -2805,7 +3048,7 @@ name, as a symbol." (defun mdw-fontify-fsharp () (let ((punct "=<>+-*/|&%!@?")) - (do ((i 0 (1+ i))) + (cl-do ((i 0 (1+ i))) ((>= i (length punct))) (modify-syntax-entry (aref punct i) "."))) @@ -3059,7 +3302,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) @@ -3138,6 +3382,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 @@ -3218,7 +3463,7 @@ strip numbers instead." python-indent-offset 2 python-fill-docstring-style 'symmetric) -(defun mdw-fontify-pythonic (keywords) +(defun mdw-fontify-pythonic (keywords soft-keywords builtins) ;; Miscellaneous fiddling. (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") @@ -3233,6 +3478,12 @@ strip numbers instead." ;; Set up the keywords defined above. (list (concat "\\_<\\(" keywords "\\)\\_>") '(0 font-lock-keyword-face)) + (list (concat "\\(^\\|[^.]\\)\\_<\\(" soft-keywords "\\)\\_>") + '(2 font-lock-keyword-face)) + (list (concat "\\(^\\|[^.]\\)\\_<\\(" builtins "\\)\\_>") + '(2 font-lock-variable-name-face)) + (list (concat "\\_<\\(__\\(\\sw+\\|\\s_+\\)+__\\)\\_>") + '(0 font-lock-variable-name-face)) ;; At least numbers are simpler than C. (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|" @@ -3248,11 +3499,130 @@ strip numbers instead." (defun mdw-fontify-python () (mdw-fontify-pythonic - (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def" - "del" "elif" "else" "except" "exec" "finally" "for" - "from" "global" "if" "import" "in" "is" "lambda" - "not" "or" "pass" "print" "raise" "return" "try" - "while" "with" "yield"))) + (mdw-regexps "and" "as" "assert" "async" "await" + "break" + "class" "continue" + "def" "del" + "elif" "else" "except" ;"exec" + "finally" "for" "from" + "global" + "if" "import" "in" "is" + "lambda" + "nonlocal" + "not" + "or" + "pass" ;"print" + "raise" "return" + "try" ;"type" + "while" "with" + "yield") + + (mdw-regexps "case" + "match") + + (mdw-regexps "Ellipsis" + "False" + "None" "NotImplemented" + "True" + "__debug__" + + "BaseException" + "BaseExceptionGroup" + "Exception" + "StandardError" + "ArithmeticError" + "FloatingPointError" + "OverflowError" + "ZeroDivisionError" + "AssertionError" + "AttributeError" + "BufferError" + "EnvironmentError" + "IOError" + "OSError" + "BlockingIOError" + "ChildProcessError" + "ConnectionError" + "BrokenPipeError" + "ConnectionAbortedError" + "ConnectionRefusedError" + "ConnectionResetError" + "FileExistsError" + "FileNotFoundError" + "InterruptedError" + "IsADirectoryError" + "NotADirectoryError" + "PermissionError" + "TimeoutError" + "EOFError" + "ExceptionGroup" + "ImportError" + "ModuleNotFoundError" + "LookupError" + "IndexError" + "KeyError" + "MemoryError" + "NameError" + "UnboundLocalError" + "ReferenceError" + "RuntimeError" + "NotImplementedError" + "RecursionError" + "SyntaxError" + "IndentationError" + "TabError" + "SystemError" + "TypeError" + "ValueError" + "UnicodeError" + "UnicodeDecodeError" + "UnicodeEncodeError" + "UnicodeTranslateError" + "StopIteration" + "Warning" + "BytesWarning" + "DeprecationWarning" + "EncodingWarning" + "FutureWarning" + "ImportWarning" + "PendingDeprecationWarning" + "ResourceWarning" + "RuntimeWarning" + "SyntaxWarning" + "UnicodeWarning" + "UserWarning" + "GeneratorExit" + "KeyboardInterrupt" + "SystemExit" + + "abs" "absolute_import" "aiter" + "all" "anext" "any" "apply" "ascii" + "basestring" "bin" "bool" "breakpoint" + "buffer" "bytearray" "bytes" + "callable" "coerce" "chr" "classmethod" + "cmp" "compile" "complex" + "delattr" "dict" "dir" "divmod" + "enumerate" "eval" "exec" "execfile" + "file" "filter" "float" "format" "frozenset" + "getattr" "globals" + "hasattr" "hash" "help" "hex" + "id" "input" "int" "intern" + "isinstance" "issubclass" "iter" + "len" "list" "locals" "long" + "map" "max" "memoryview" "min" + "next" + "object" "oct" "open" "ord" + "pow" "print" "property" + "range" "raw_input" "reduce" "reload" + "repr" "reversed" "round" + "set" "setattr" "slice" "sorted" + "staticmethod" "str" "sum" "super" + "tuple" "type" + "unichr" "unicode" + "vars" + "xrange" + "zip" + "__import__"))) (defun mdw-fontify-pyrex () (mdw-fontify-pythonic @@ -3261,7 +3631,9 @@ strip numbers instead." "extern" "finally" "for" "from" "global" "if" "import" "in" "is" "lambda" "not" "or" "pass" "print" "property" "raise" "return" "struct" "try" "while" "with" - "yield"))) + "yield") + "" + "")) (define-derived-mode pyrex-mode python-mode "Pyrex" "Major mode for editing Pyrex source code") @@ -3729,11 +4101,11 @@ strip numbers instead." (let ((not-comment (let ((word "COMMENT")) - (do ((regexp (concat "[^" (substring word 0 1) "]+") - (concat regexp "\\|" - (substring word 0 i) - "[^" (substring word i (1+ i)) "]")) - (i 1 (1+ i))) + (cl-do ((regexp (concat "[^" (substring word 0 1) "]+") + (concat regexp "\\|" + (substring word 0 i) + "[^" (substring word i (1+ i)) "]")) + (i 1 (1+ i))) ((>= i (length word)) regexp))))) (setq font-lock-keywords (list (list (concat "\\" @@ -3899,6 +4271,8 @@ strip numbers instead." ;;; Haskell configuration. (setq-default haskell-indent-offset 2) +(setq haskell-doc-prettify-types nil + haskell-interactive-popup-errors nil) (defun mdw-fontify-haskell () @@ -3909,7 +4283,7 @@ strip numbers instead." ;; Make punctuation be punctuation (let ((punct "=<>+-*/|&%!@?$.^:#`")) - (do ((i 0 (1+ i))) + (cl-do ((i 0 (1+ i))) ((>= i (length punct))) (modify-syntax-entry (aref punct i) "."))) @@ -4229,7 +4603,7 @@ strip numbers instead." ;;;-------------------------------------------------------------------------- ;;; HTML, CSS, and other web foolishness. -(setq-default css-indent-offset 2) +(setq-default css-indent-offset 8) ;;;-------------------------------------------------------------------------- ;;; SGML hacking. @@ -4270,8 +4644,8 @@ that character only to be normal punctuation." (defun mdw-conf-quote-normal-acceptable-value-p (value) "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?" (or (booleanp value) - (every (lambda (v) (memq v '(?\" ?'))) - (if (listp value) value (list value))))) + (cl-every (lambda (v) (memq v '(?\" ?'))) + (if (listp value) value (list value))))) (defun mdw-fix-up-quote () "Apply the setting of `mdw-conf-quote-normal'." @@ -4705,11 +5079,11 @@ by `mdw-lisp-setf-value-indent' spaces." (while (< (point) start) (condition-case nil (forward-sexp 1) (scan-error (throw 'done nil))) - (incf count)) + (cl-incf count)) (1- count))))))) (and basic-indent offset (list (+ basic-indent - (if (oddp offset) 0 + (if (cl-oddp offset) 0 mdw-lisp-setf-value-indent)) basic-indent))))) (progn @@ -4738,12 +5112,12 @@ align the other subforms beneath it. Otherwise, indent them (save-excursion (goto-char (elt state 1)) (cl-incf loop-indentation - (cond ((eq (char-before) ?,) -1) - ((and (eq (char-before) ?@) - (progn (backward-char) - (eq (char-before) ?,))) - -2) - (t 0))))) + (cond ((eq (char-before) ?,) -1) + ((and (eq (char-before) ?@) + (progn (backward-char) + (eq (char-before) ?,))) + -2) + (t 0))))) ;; If the first loop item is on the same line as the `loop' itself then ;; use that as the baseline. Otherwise advance by the default indent. @@ -4792,11 +5166,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) @@ -4879,6 +5254,11 @@ align the other subforms beneath it. Otherwise, indent them (progn (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t)) +;; nroff/troff. + +(progn + (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t)) + ;;;-------------------------------------------------------------------------- ;;; Text mode. @@ -5084,6 +5464,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. @@ -5097,6 +5506,20 @@ there is sadness." "Don't make windows dedicated. Seriously." (set-window-dedicated-p (or window (selected-window)) nil)) +(defadvice gud-find-expr + (around mdw-inhibit-read-only (&rest args) compile activate) + "Inhibit errors caused by my setting of `comint-prompt-read-only'." + (let ((inhibit-read-only t)) ad-do-it)) + +;;;-------------------------------------------------------------------------- +;;; 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. @@ -5221,21 +5644,21 @@ there is sadness." (funcall func) (forward-line))) (let ((n (prefix-numeric-value arg))) - (cond ((minusp n) + (cond ((cl-minusp n) (unless (bolp) (beginning-of-line) (funcall func) - (incf n)) - (while (minusp n) + (cl-incf n)) + (while (cl-minusp n) (forward-line -1) (funcall func) - (incf n))) + (cl-incf n))) (t (beginning-of-line) - (while (plusp n) + (while (cl-plusp n) (funcall func) (forward-line) - (decf n))))))) + (cl-decf n))))))) (defun mdw-mpc-select-one () (when (and (get-char-property (point) 'mpc-file)