X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/0bb9be93c106e149d21d72d20de02da8b978bf9e..5223adaa187d2231f03f59a44473b93192bc6968:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index ed894dd..f0d41c3 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -56,13 +56,13 @@ This may be at the expense of cool features.") (eval-when-compile (unless (fboundp 'make-regexp) (load "make-regexp")) - (require 'cl)) + (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." @@ -105,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" "") @@ -215,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) @@ -253,6 +254,12 @@ 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))) @@ -346,7 +353,7 @@ prevailing configuration." (and (consp register-value) (window-configuration-p (car register-value)) (integer-or-marker-p (cadr register-value)) - (null (caddr register-value))))) + (null (cl-caddr register-value))))) (error "Register `%c' is not a window configuration" register)) (t (cond ((null register-value) @@ -490,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 @@ -627,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))) @@ -650,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 @@ -689,10 +706,13 @@ 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.")) + (cond (mdw-designated-window + (setq mdw-designated-window nil) + (unless (mdw-emacs-version-p 24) + (setq display-buffer-function nil)) + (message "Window designation cleared.")) + (t + (message "No designated window active.")))) ((window-dedicated-p window) (error "Window is dedicated to its buffer.")) (t @@ -749,7 +769,117 @@ 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) + +(defvar mdw-fallback-window-alist nil + "Alist mapping frames to fallback windows.") + +(defun mdw-cleanup-fallback-window-alist () + "Remove entries for dead frames and windows from the fallback alist." + (let ((prev nil) + (cursor mdw-fallback-window-alist)) + (while cursor + (let* ((assoc (car cursor)) + (tail (cdr cursor))) + (cond ((and (frame-live-p (car assoc)) + (window-live-p (cdr assoc))) + (setq prev cursor)) + ((null prev) + (setq mdw-fallback-window-alist tail)) + (t + (setcdr prev tail))) + (setq cursor tail))))) + +(defun mdw-set-fallback-window (cancel) + "Prefer the selected window for pop-up buffers in this frame. +With a prefix argument, clear the fallback window." + (interactive "P") + (let* ((frame (selected-frame)) (window (selected-window)) + (assoc (assq (selected-frame) mdw-fallback-window-alist))) + (cond (cancel + (cond (assoc + (setcdr assoc nil) + (message "Fallback window cleared.")) + (t + (message "No fallback window active in this frame.")))) + ((window-dedicated-p window) + (error "Window is dedicated to its buffer.")) + (t + (if assoc (setcdr assoc window) + (push (cons frame window) mdw-fallback-window-alist)) + (message "Fallback window set."))) + (mdw-cleanup-fallback-window-alist))) + +(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 + (fallback (assq (selected-frame) mdw-fallback-window-alist)) + (full-height-p (window-full-height-p selected)) + (full-width-p (window-full-width-p selected))) + (cond + + ((and fallback (window-live-p (cdr fallback))) + ;; There's a fallback window set for this frame. Use it. + + (setq chosen (cdr fallback) + selected nil) + (display-buffer-record-window 'window chosen buffer)) + + ((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. @@ -829,14 +959,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))) @@ -846,13 +976,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)) @@ -994,12 +1124,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 @@ -1279,7 +1409,8 @@ If NEW-SESSION-P, start a new session." '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session)) (defcustom mdw-good-url-browsers - '(browse-url-mozilla + '(browse-url-firefox + browse-url-mozilla browse-url-generic (w3m . mdw-w3m-browse-url) browse-url-w3) @@ -1333,7 +1464,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 @@ -1404,12 +1535,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)) @@ -1529,7 +1660,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 @@ -1551,8 +1682,8 @@ case." (line-height . 10.55) (space-width . 5.1) (avg-char-width . 5.1))) - (remove* 'CourierCondensed ps-font-info-database - :key #'car))))) + (cl-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 @@ -1699,11 +1830,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) @@ -1778,6 +1909,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)) @@ -1844,6 +1978,15 @@ doesn't match any of the regular expressions in (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 @@ -2073,6 +2216,10 @@ doesn't match any of the regular expressions in (mdw-define-face magit-hash (((min-colors 64)) :foreground "grey40") (((class color)) :foreground "blue")) +(mdw-define-face magit-popup-argument + (((min-colors 64)) :foreground "SeaGreen1") + (((class color)) :foreground "green") + (t :weight bold)) (mdw-define-face magit-diff-hunk-heading (((min-colors 64)) :foreground "grey70" :background "grey25") (((class color)) :foreground "yellow")) @@ -2108,8 +2255,16 @@ doesn't match any of the regular expressions in (((min-colors 64)) :background "NavyBlue") (((class color)) :background "blue")) +(mdw-define-face erc-my-nick-face + (t :foreground "yellow" :weight bold)) +(mdw-define-face erc-current-nick-face + (t :foreground "yellow" :weight bold)) (mdw-define-face erc-input-face - (t :foreground "red")) + (t :foreground "yellow")) +(mdw-define-face erc-action-face + ()) +(mdw-define-face erc-button + (t :foreground "cyan" :underline t :weight semi-bold)) (mdw-define-face woman-bold (t :weight bold)) @@ -2233,11 +2388,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)))) @@ -2310,7 +2465,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))) @@ -2326,8 +2481,8 @@ indentation anyway." (let ((key (car item)) (value (cdr item))) (if (let* ((key-name (symbol-name key)) (key-len (length key-name))) - (and (>= key-len 5) - (string= (subseq key-name (- key-len 5)) "-alist"))) + (and (>= key-len 6) + (string= (substring key-name (- key-len 6)) "-alist"))) (push (cons key (mdw-merge-style-alists value (cdr (assoc key second)))) @@ -2338,7 +2493,7 @@ indentation anyway." (push item output))) (nreverse output))) -(defmacro* mdw-define-c-style (name (&optional parent) &rest assocs) +(cl-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 @@ -2369,6 +2524,10 @@ set." (c-class-key . "class") (c-backslash-column . 72) (c-label-minimum-indentation . 0) + (c-indent-comments-syntactically-p t) + (c-indent-comment-alist (end-block . (column . nil)) + (cpp-end-block . (column . nil)) + (other . (column . nil))) (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block)) (defun-open . (add 0 c-indent-one-line-block)) (arglist-cont-nonempty . mdw-c-lineup-arglist) @@ -2407,11 +2566,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) @@ -2955,7 +3115,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) "."))) @@ -3210,7 +3370,7 @@ name, as a symbol." ;; And anything else is punctuation. (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face))) - font-lock-syntactic-face-function . nil)) + font-lock-syntactic-face-function nil)) ;; Hack key bindings. (local-set-key [?{] 'mdw-self-insert-and-indent) @@ -3304,6 +3464,7 @@ name, as a symbol." (modify-syntax-entry ?$ "\\" font-lock-syntax-table) (modify-syntax-entry ?: "." font-lock-syntax-table) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") + (setq auto-fill-function #'do-auto-fill) ;; Now define fontification things. (make-local-variable 'font-lock-keywords) @@ -3370,7 +3531,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]*\\)") @@ -3385,6 +3546,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]+\\)\\|" @@ -3400,11 +3567,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 @@ -3413,7 +3699,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") @@ -3881,11 +4169,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 "\\" @@ -4051,6 +4339,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 () @@ -4061,7 +4351,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) "."))) @@ -4422,8 +4712,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'." @@ -4857,11 +5147,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 @@ -4889,13 +5179,13 @@ align the other subforms beneath it. Otherwise, indent them (eq lisp-indent-backquote-substitution-mode 'corrected)) (save-excursion (goto-char (elt state 1)) - (incf loop-indentation - (cond ((eq (char-before) ?,) -1) - ((and (eq (char-before) ?@) - (progn (backward-char) - (eq (char-before) ?,))) - -2) - (t 0))))) + (cl-incf loop-indentation + (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. @@ -5032,6 +5322,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. @@ -5279,6 +5574,11 @@ rather than baking the list into the function." "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. @@ -5412,21 +5712,21 @@ rather than baking the list into the function." (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)