X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/da4332a99aa48af7d4992f87ea93b277e58ce9d8..4b7a0fa89382f7d07d5b886712c4fb2eba8911b7:/el/dot-emacs.el diff --git a/el/dot-emacs.el b/el/dot-emacs.el index d2b9dcc..5d47344 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -100,11 +100,11 @@ This may be at the expense of cool features.") (replace-match with t)))) (with-temp-buffer (insert-file-contents "~/.mdw.conf") - (replace "^[ \t]*\\(#.*\\|\\)\n" "") + (replace "^[ \t]*\\(#.*\\)?\n" "") (replace (concat "^[ \t]*" "\\([-a-zA-Z0-9_.]*\\)" "[ \t]*=[ \t]*" - "\\(.*[^ \t\n]\\|\\)" + "\\(.*[^ \t\n]\\)?" "[ \t]**\\(\n\\|$\\)") "(\\1 . \"\\2\")\n") (car (read-from-string @@ -169,6 +169,17 @@ library." (set-frame-parameter frame 'menu-bar-lines 0) (set-frame-parameter frame 'menu-bar-lines old))) +;; Page motion. + +(defun mdw-fixup-page-position () + (unless (eq (char-before (point)) ? ) + (forward-line 0))) + +(defadvice backward-page (after mdw-fixup compile activate) + (mdw-fixup-page-position)) +(defadvice forward-page (after mdw-fixup compile activate) + (mdw-fixup-page-position)) + ;; Splitting windows. (unless (fboundp 'scroll-bar-columns) @@ -240,6 +251,14 @@ P") sb-width)) (mdw-divvy-window width))) +(defvar 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.") + ;; Don't raise windows unless I say so. (defvar mdw-inhibit-raise-frame nil @@ -347,9 +366,9 @@ as output rather than a string." (months ["Chaos" "Discord" "Confusion" "Bureaucracy" "Aftermath"]) (day-count [0 31 59 90 120 151 181 212 243 273 304 334]) - (year (- (extract-calendar-year date) 1900)) - (month (1- (extract-calendar-month date))) - (day (1- (extract-calendar-day date))) + (year (- (calendar-extract-year date) 1900)) + (month (1- (calendar-extract-month date))) + (day (1- (calendar-extract-day date))) (julian (+ (aref day-count month) day)) (dyear (+ year 3066))) (if (and (= month 1) (= day 28)) @@ -569,6 +588,34 @@ Even if an existing window in some random frame looks tempting." Pretend they don't exist. They might be on other display devices." (ad-set-arg 2 nil)) +;; 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 + (with-current-buffer buffer + (set-visited-file-name to nil t)))))) + ;;;-------------------------------------------------------------------------- ;;; Improved compilation machinery. @@ -800,7 +847,7 @@ Use this to arrange for per-server settings.") (delete-region (+ (match-beginning 0) 2) (point)) (setq string (buffer-substring (point) (+ (point) size))) (delete-region (point) (+ (point) size)) - (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string))) + (insert (format "%S" (subst-char-in-string ?\n ?\s string))) ;; [mdw] missing from upstream (backward-char 1)) (beginning-of-line) @@ -846,6 +893,18 @@ Use this to arrange for per-server settings.") '(defalias 'nnimap-transform-headers (symbol-function 'mdw-nnimap-transform-headers))) +(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)))) + ad-do-it)) + +;; Preferred programs. + +(setq mailcap-user-mime-data + '(((type . "application/pdf") (viewer . "mupdf %s")))) + ;;;-------------------------------------------------------------------------- ;;; Utility functions. @@ -1260,7 +1319,14 @@ case." (set (make-local-variable 'mdw-do-misc-mode-hacking) t) (local-set-key [C-return] 'newline) (make-local-variable 'page-delimiter) - (setq page-delimiter "\f\\|^.*-\\{6\\}.*$") + (setq page-delimiter (concat "^" "\f" + "\\|" "^" + ".\\{0,4\\}" + "-\\{5\\}" + "\\(" " " ".*" " " "\\)?" + "-+" + ".\\{0,2\\}" + "$")) (setq comment-column 40) (auto-fill-mode 1) (setq fill-column mdw-text-width) @@ -1404,11 +1470,8 @@ doesn't match any of the regular expressions in (((type w32)) :family "courier new" :height 85 :weight bold) (((type x)) :family "6x13" :foundry "trad" :height 130 :weight bold) (t :foreground "white" :background "black" :weight bold)) -(if (mdw-emacs-version-p 23) - (mdw-define-face variable-pitch - (((type x)) :family "sans" :height 100)) - (mdw-define-face variable-pitch - (((type x)) :family "helvetica" :height 90))) +(mdw-define-face variable-pitch + (((type x)) :family "helvetica" :height 120)) (mdw-define-face region (((min-colors 64)) :background "grey30") (((class color)) :background "blue") @@ -1856,6 +1919,21 @@ doesn't match any of the regular expressions in mdw-point-overlay-mode (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t)))) +(defvar mdw-terminal-title-alist nil) +(defun mdw-update-terminal-title () + (when (let ((term (frame-parameter nil 'tty-type))) + (and term (string-match "^xterm" term))) + (let* ((tty (frame-parameter nil 'tty)) + (old (assoc tty mdw-terminal-title-alist)) + (new (format-mode-line frame-title-format))) + (unless (and old (equal (cdr old) new)) + (if old (rplacd old new) + (setq mdw-terminal-title-alist + (cons (cons tty new) mdw-terminal-title-alist))) + (send-string-to-terminal (concat "\e]2;" new "\e\\")))))) + +(add-hook 'post-command-hook 'mdw-update-terminal-title) + ;;;-------------------------------------------------------------------------- ;;; C programming configuration. @@ -1896,50 +1974,47 @@ indentation anyway." (defvar mdw-define-c-styles-hook nil "Hook run when `cc-mode' starts up to define styles.") -(defmacro mdw-define-c-style (name &rest assocs) - "Define a C style, called NAME (a symbol), setting ASSOCs. +(defun mdw-merge-style-alists (first second) + (let ((output nil)) + (dolist (item first) + (let ((key (car item)) (value (cdr item))) + (if (string-suffix-p "-alist" (symbol-name key)) + (push (cons key + (mdw-merge-style-alists value + (cdr (assoc key second)))) + output) + (push item output)))) + (dolist (item second) + (unless (assoc (car item) first) + (push item output))) + (nreverse output))) + +(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 `mdw-define-c-styles-hook'. If CC Mode is already loaded, then the style is set." (declare (indent defun)) (let* ((name-string (symbol-name name)) + (var (intern (concat "mdw-c-style/" name-string))) (func (intern (concat "mdw-define-c-style/" name-string)))) `(progn - (defun ,func () (c-add-style ,name-string ',assocs)) + (setq ,var + ,(if (null parent) + `',assocs + (let ((parent-list (intern (concat "mdw-c-style/" + (symbol-name parent))))) + `(mdw-merge-style-alists ',assocs ,parent-list)))) + (defun ,func () (c-add-style ,name-string ,var)) (and (featurep 'cc-mode) (,func)) - (add-hook 'mdw-define-c-styles-hook ',func)))) + (add-hook 'mdw-define-c-styles-hook ',func) + ',name))) (eval-after-load "cc-mode" '(run-hooks 'mdw-define-c-styles-hook)) -(mdw-define-c-style mdw-trustonic-c - (c-basic-offset . 4) - (comment-column . 0) - (c-indent-comment-alist (anchored-comment . (column . 0)) - (end-block . (space . 1)) - (cpp-end-block . (space . 1)) - (other . (space . 1))) - (c-class-key . "class") - (c-backslash-column . 0) - (c-auto-align-backslashes . nil) - (c-label-minimum-indentation . 0) - (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-indent-arglist-nested) - (topmost-intro . mdw-c-indent-extern-mumble) - (cpp-define-intro . 0) - (knr-argdecl . 0) - (inextern-lang . [0]) - (label . 0) - (case-label . +) - (access-label . -2) - (inclass . +) - (inline-open . ++) - (statement-cont . +) - (statement-case-intro . +))) - -(mdw-define-c-style mdw-c +(mdw-define-c-style mdw-c () (c-basic-offset . 2) (comment-column . 40) (c-class-key . "class") @@ -1960,6 +2035,18 @@ set." (statement-cont . +) (statement-case-intro . +))) +(mdw-define-c-style mdw-trustonic-basic-c (mdw-c) + (c-basic-offset . 4) + (comment-column . 0) + (c-indent-comment-alist (anchored-comment . (column . 0)) + (end-block . (space . 1)) + (cpp-end-block . (space . 1)) + (other . (space . 1))) + (c-offsets-alist (access-label . -2))) + +(mdw-define-c-style mdw-trustonic-c (mdw-trustonic-basic-c) + (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested))) + (defun mdw-set-default-c-style (modes style) "Update the default CC Mode style for MODES to be STYLE. @@ -2137,7 +2224,7 @@ name, as a symbol." ;; Fontify include files as strings. (list (concat "^[ \t]*\\#[ \t]*" "\\(include\\|import\\)" - "[ \t]*\\(<[^>]+\\(>\\|\\)\\)") + "[ \t]*\\(<[^>]+>?\\)") '(2 font-lock-string-face)) ;; Preprocessor directives are `references'?. @@ -2231,7 +2318,7 @@ name, as a symbol." ;; Make indentation nice. -(mdw-define-c-style mdw-java +(mdw-define-c-style mdw-java () (c-basic-offset . 2) (c-backslash-column . 72) (c-offsets-alist (substatement-open . 0) @@ -2293,8 +2380,8 @@ name, as a symbol." ;; The following isn't quite right, but it's close enough. (list (concat "\\<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)" "[lLfFdD]?") '(0 mdw-number-face)) @@ -2352,8 +2439,8 @@ name, as a symbol." ;; The following isn't quite right, but it's close enough. (list (concat "\\_<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)" "[lLfFdD]?") '(0 mdw-number-face)) @@ -2410,8 +2497,8 @@ name, as a symbol." ;; As usual, not quite right. (list (concat "\\_<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)" "[lLfFdD]?") '(0 mdw-number-face)) @@ -2443,7 +2530,7 @@ name, as a symbol." ;; Make indentation nice. -(mdw-define-c-style mdw-csharp +(mdw-define-c-style mdw-csharp () (c-basic-offset . 2) (c-backslash-column . 72) (c-offsets-alist (substatement-open . 0) @@ -2497,8 +2584,8 @@ name, as a symbol." ;; The following isn't quite right, but it's close enough. (list (concat "\\<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)" "[lLfFdD]?") '(0 mdw-number-face)) @@ -2689,8 +2776,8 @@ name, as a symbol." ;; The following isn't quite right, but it's close enough. (list (concat "\\<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)") + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)") '(0 mdw-number-face)) ;; And anything else is punctuation. @@ -2788,7 +2875,7 @@ name, as a symbol." ;; Make Awk indentation nice. -(mdw-define-c-style mdw-awk +(mdw-define-c-style mdw-awk () (c-basic-offset . 2) (c-offsets-alist (substatement-open . 0) (c-backslash-column . 72) @@ -2830,8 +2917,8 @@ name, as a symbol." ;; The following isn't quite right, but it's close enough. (list (concat "\\<\\(" "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|" - "[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)" + "[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?\\)" "[uUlL]*") '(0 mdw-number-face)) @@ -2897,8 +2984,8 @@ name, as a symbol." ;; At least numbers are simpler than C. (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|" - "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)") + "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?" + "\\([eE][-+]?[0-9_]+\\)?") '(0 mdw-number-face)) ;; And anything else is punctuation. @@ -2949,8 +3036,8 @@ strip numbers instead." ;; At least numbers are simpler than C. (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|" - "\\_<[0-9][0-9]*\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|[lL]\\|\\)") + "\\_<[0-9][0-9]*\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\|[lL]\\)?") '(0 mdw-number-face)) ;; And anything else is punctuation. @@ -3135,8 +3222,8 @@ strip numbers instead." (setq font-lock-keywords (list (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|" - "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)") + "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?" + "\\([eE][-+]?[0-9_]+\\)?") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face))))) @@ -3381,12 +3468,12 @@ strip numbers instead." '(0 font-lock-keyword-face)) ;; At least numbers are simpler than C. - (list (concat "\\<\\(\\~\\|\\)" - "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|" + (list (concat "\\<\\~?" + "\\(0\\([wW]?[xX][0-9a-fA-F]+\\|" "[wW][0-9]+\\)\\|" - "\\([0-9]+\\(\\.[0-9]+\\|\\)" - "\\([eE]\\(\\~\\|\\)" - "[0-9]+\\|\\)\\)\\)") + "\\([0-9]+\\(\\.[0-9]+\\)?" + "\\([eE]\\~?" + "[0-9]+\\)?\\)\\)") '(0 mdw-number-face)) ;; And anything else is punctuation. @@ -3471,8 +3558,8 @@ strip numbers instead." (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>" '(0 font-lock-variable-name-face)) (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|" - "\\_<[0-9]+\\(\\.[0-9]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)") + "\\_<[0-9]+\\(\\.[0-9]*\\)?" + "\\([eE][-+]?[0-9]+\\)?") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face)))))) @@ -3509,7 +3596,7 @@ strip numbers instead." '(0 font-lock-keyword-face)) (list (concat "^-\\sw+\\>") '(0 font-lock-keyword-face)) - (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>" + (list "\\<[0-9]+\\(#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)?\\>" '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face)))))) @@ -3541,7 +3628,7 @@ strip numbers instead." '(2 font-lock-variable-name-face)) ;; Make sure we get comments properly. - (list "@c\\(\\|omment\\)\\( .*\\)?$" + (list "@c\\(omment\\)?\\( .*\\)?$" '(0 font-lock-comment-face)) ;; Command names are keywords. @@ -3979,7 +4066,7 @@ that character only to be normal punctuation.") (setq messages-mode-keywords (append (list (list (concat "^[ \t]*\\#[ \t]*" "\\(include\\|import\\)" - "[ \t]*\\(<[^>]+\\(>\\|\\)\\)") + "[ \t]*\\(<[^>]+\\(>\\)?\\)") '(2 font-lock-string-face)) (list (concat "^\\([ \t]*#[ \t]*\\(\\(" preprocessor-keywords @@ -4025,7 +4112,7 @@ that character only to be normal punctuation.") (list (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$") '(0 font-lock-keyword-face)) - (list "^%\\s *\\(#.*\\|\\)$" + (list "^%\\s *\\(#.*\\)?$" '(0 font-lock-comment-face)) (list "^%" '(0 font-lock-keyword-face)) @@ -4209,8 +4296,8 @@ that character only to be normal punctuation.") (list "\\<[A-Z][a-zA-Z0-9]*\\>" '(0 font-lock-keyword-face)) (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|" - "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)" - "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)") + "[0-9][0-9_]*\\(\\.[0-9_]*\\)?" + "\\([eE][-+]?[0-9_]+\\)?") '(0 mdw-number-face)) (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face))))) @@ -4441,6 +4528,41 @@ there is sadness." (set-window-dedicated-p (or window (selected-window)) nil)) ;;;-------------------------------------------------------------------------- +;;; Man pages. + +;; Turn off `noip' when running `man': it interferes with `man-db''s own +;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly +;; better. +(defadvice Man-getpage-in-background + (around mdw-inhibit-noip (topic) compile activate) + "Inhibit the `noip' preload hack when invoking `man'." + (let* ((old-preload (getenv "LD_PRELOAD")) + (preloads (save-match-data (split-string old-preload ":"))) + (any nil) + (filtered nil)) + (save-match-data + (while preloads + (let ((item (pop preloads))) + (if (string-match "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item) + (setq any t) + (push item filtered))))) + (if any + (unwind-protect + (progn + (setenv "LD_PRELOAD" + (and filtered + (with-output-to-string + (setq filtered (nreverse filtered)) + (let ((first t)) + (while filtered + (if first (setq first nil) + (write-char ?:)) + (write-string (pop filtered))))))) + ad-do-it) + (setenv "LD_PRELOAD" old-preload)) + ad-do-it))) + +;;;-------------------------------------------------------------------------- ;;; MPC configuration. (eval-when-compile (trap (require 'mpc)))