X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/499a48f31a6b81c695b7270fc474299c029669c1..c08211aa9838ecdb251e5df62f9c6394676349ee:/dot-emacs.el diff --git a/dot-emacs.el b/dot-emacs.el index 704f37d..5b9408f 100644 --- a/dot-emacs.el +++ b/dot-emacs.el @@ -1,7 +1,5 @@ ;;; -*- mode: emacs-lisp; coding: utf-8 -*- ;;; -;;; $Id$ -;;; ;;; Functions and macros for .emacs ;;; ;;; (c) 2004 Mark Wooding @@ -87,6 +85,17 @@ This may be at the expense of cool features.") (concat "(" (buffer-string) ")"))))))) (cdr (assq sym mdw-config))) +;; --- Set up the load path convincingly --- + +(dolist (dir (append (and (boundp 'debian-emacs-flavor) + (list (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp"))))) + (dolist (sub (directory-files dir t)) + (when (and (file-accessible-directory-p sub) + (not (member sub load-path))) + (setq load-path (nconc load-path (list sub)))))) + ;; --- Is an Emacs library available? --- (defun library-exists-p (name) @@ -179,6 +188,115 @@ symbols `sunday', `monday', etc. (or a mixture). If the date stored in (nth 2 when)))))))) (eq w d))) +;; --- Fighting with Org-mode's evil key maps --- + +(defvar mdw-evil-keymap-keys + '(([S-up] . [?\C-c up]) + ([S-down] . [?\C-c down]) + ([S-left] . [?\C-c left]) + ([S-right] . [?\C-c right]) + (([M-up] [?\e up]) . [C-up]) + (([M-down] [?\e down]) . [C-down]) + (([M-left] [?\e left]) . [C-left]) + (([M-right] [?\e right]) . [C-right])) + "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'. +The value is an alist mapping evil keys (as a list, or singleton) +to good keys (in the same form).") + +(defun mdw-clobber-evil-keymap (keymap) + "Replace evil key bindings in the KEYMAP. +Evil key bindings are defined in `mdw-evil-keymap-keys'." + (dolist (entry mdw-evil-keymap-keys) + (let ((binding nil) + (keys (if (listp (car entry)) + (car entry) + (list (car entry)))) + (replacements (if (listp (cdr entry)) + (cdr entry) + (list (cdr entry))))) + (catch 'found + (dolist (key keys) + (setq binding (lookup-key keymap key)) + (when binding + (throw 'found nil)))) + (when binding + (dolist (key keys) + (define-key keymap key nil)) + (dolist (key replacements) + (define-key keymap key binding)))))) + +;;;----- Mail and news hacking ---------------------------------------------- + +(define-derived-mode mdwmail-mode mail-mode "[mdw] mail" + "Major mode for editing news and mail messages from external programs +Not much right now. Just support for doing MailCrypt stuff." + :syntax-table nil + :abbrev-table nil + (run-hooks 'mail-setup-hook)) + +(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation) + +(add-hook 'mdwail-mode-hook + (lambda () + (set-buffer-file-coding-system 'utf-8) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + (setq paragraph-start + (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" + paragraph-start)) + (setq paragraph-separate + (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" + paragraph-separate)))) + +;; --- How to encrypt in mdwmail --- + +(defun mdwmail-mc-encrypt (&optional recip scm start end from sign) + (or start + (setq start (save-excursion + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-min))))) + (or end + (setq end (point-max))) + (mc-encrypt-generic recip scm start end from sign)) + +;; --- How to sign in mdwmail --- + +(defun mdwmail-mc-sign (key scm start end uclr) + (or start + (setq start (save-excursion + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (point-min))))) + (or end + (setq end (point-max))) + (mc-sign-generic key scm start end uclr)) + +;; --- Some signature mangling --- + +(defun mdwmail-mangle-signature () + (save-excursion + (goto-char (point-min)) + (perform-replace "\n-- \n" "\n-- " nil nil nil))) +(add-hook 'mail-setup-hook 'mdwmail-mangle-signature) +(add-hook 'message-setup-hook 'mdwmail-mangle-signature) + +;; --- Insert my login name into message-ids, so I can score replies --- + +(defadvice message-unique-id (after mdw-user-name last activate compile) + "Ensure that the user's name appears at the end of the message-id string, +so that it can be used for convenient filtering." + (setq ad-return-value (concat ad-return-value "." (user-login-name)))) + +;; --- Tell my movemail hack where movemail is --- +;; +;; This is needed to shup up warnings about LD_PRELOAD. + +(let ((path exec-path)) + (while path + (let ((try (expand-file-name "movemail" (car path)))) + (if (file-executable-p try) + (setenv "REAL_MOVEMAIL" try)) + (setq path (cdr path))))) + ;;;----- Utility functions -------------------------------------------------- (or (fboundp 'line-number-at-pos) @@ -315,54 +433,6 @@ get itself into a twist." (defadvice write-file (after mdw-autorevert activate) (mdw-check-autorevert)) -(defun mdwmail-mode () - "Major mode for editing news and mail messages from external programs -Not much right now. Just support for doing MailCrypt stuff." - (interactive) - (kill-all-local-variables) - (use-local-map text-mode-map) - (setq local-abbrev-table text-mode-abbrev-table) - (setq major-mode 'mdwmail-mode) - (setq mode-name "[mdw] mail") - (set-buffer-file-coding-system 'utf-8) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" - paragraph-start)) - (setq paragraph-separate (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|" - paragraph-separate)) - (run-hooks 'text-mode-hook 'mdwmail-mode-hook 'mail-setup-hook)) - -;; --- How to encrypt in mdwmail --- - -(defun mdwmail-mc-encrypt (&optional recip scm start end from sign) - (or start - (setq start (save-excursion - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-min))))) - (or end - (setq end (point-max))) - (mc-encrypt-generic recip scm start end from sign)) - -;; --- How to sign in mdwmail --- - -(defun mdwmail-mc-sign (key scm start end uclr) - (or start - (setq start (save-excursion - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-min))))) - (or end - (setq end (point-max))) - (mc-sign-generic key scm start end uclr)) - -;; --- Some signature mangling --- - -(defun mdwmail-mangle-signature () - (save-excursion - (goto-char (point-min)) - (perform-replace "\n-- \n" "\n-- " nil nil nil))) -(add-hook 'mail-setup-hook 'mdwmail-mangle-signature) - ;;;----- Dired hacking ------------------------------------------------------ (defadvice dired-maybe-insert-subdir @@ -543,40 +613,6 @@ doesn't cope with anything approximating a complicated case." ;;;----- Other common declarations ------------------------------------------ -(defun mdw-set-frame-transparency (&optional n) - (interactive "P") - (let* ((alist (frame-parameters)) - (trans (assq 'transparency alist))) - (if trans - (rplacd trans (not (if n (zerop n) (cdr trans)))) - (setq trans (cons 'transparency (not (equal 0 n))))) - (modify-frame-parameters (selected-frame) (list trans)))) - -;; --- Mouse wheel support --- - -(defconst mdw-wheel-scroll-amount 15) -(defun mdw-wheel-up (click) - (interactive "@e") - (mdw-wheel-scroll click (function scroll-down))) -(defun mdw-wheel-down (click) - (interactive "@e") - (mdw-wheel-scroll click (function scroll-up))) - -(defun mdw-wheel-scroll (click func) - (let ((win (selected-window))) - (unwind-protect - (progn - (select-window (posn-window (event-start click))) - (let ((arg 2)) - (funcall func (/ (window-height) 2)))) - (select-window win)))) - -;; --- Going backwards --- - -(defun other-window-backwards (arg) - (interactive "p") - (other-window (- arg))) - ;; --- Common mode settings --- (defvar mdw-auto-indent t @@ -592,16 +628,21 @@ doesn't cope with anything approximating a complicated case." (t (local-set-key "\C-m" 'newline-and-indent)))) (local-set-key [C-return] 'newline) - (or (eq major-mode 'asm-mode) - (local-set-key [?\;] 'self-insert-command)) - (local-set-key [?\#] 'self-insert-command) - (local-set-key [?\"] 'self-insert-command) + (make-variable-buffer-local 'page-delimiter) + (setq page-delimiter "\f\\|^.*-\\{6\\}.*$") (setq comment-column 40) (auto-fill-mode 1) (setq fill-column 77) (setq show-trailing-whitespace t) + (and (fboundp 'gtags-mode) + (gtags-mode)) + (outline-minor-mode t) (mdw-set-font)) +(eval-after-load 'gtags + '(dolist (key '([mouse-2] [mouse-3])) + (define-key gtags-mode-map key nil))) + ;; --- Set up all sorts of faces --- (defvar mdw-set-font nil) @@ -611,6 +652,26 @@ doesn't cope with anything approximating a complicated case." (defvar mdw-number-face 'mdw-number-face "Face to use for numbers") (make-face 'mdw-number-face) +;; --- Backup file handling --- + +(defvar mdw-backup-disable-regexps nil + "*List of regular expressions: if a file name matches any of these then the +file is not backed up.") + +(defun mdw-backup-enable-predicate (name) + "[mdw]'s default backup predicate: allows a backup if the +standard predicate would allow it, and it doesn't match any of +the regular expressions in `mdw-backup-disable-regexps'." + (and (normal-backup-enable-predicate name) + (let ((answer t) (list mdw-backup-disable-regexps)) + (save-match-data + (while list + (if (string-match (car list) name) + (setq answer nil)) + (setq list (cdr list))) + answer)))) +(setq backup-enable-predicate 'mdw-backup-enable-predicate) + ;;;----- General fontification ---------------------------------------------- (defun mdw-set-fonts (frame faces) @@ -662,7 +723,7 @@ doesn't cope with anything approximating a complicated case." (comint-highlight-input) (font-lock-builtin-face :weight bold) (font-lock-type-face :weight bold) - (region :background "grey30") + (region :background ,(if window-system "grey30" "blue")) (isearch :background "palevioletred2") (mdw-punct-face :foreground ,(if window-system "burlywood2" "yellow")) (mdw-number-face :foreground "yellow") @@ -678,6 +739,30 @@ doesn't cope with anything approximating a complicated case." (font-lock-keyword-face :weight bold) (font-lock-constant-face :weight bold) (font-lock-reference-face :weight bold) + (message-cited-text + :foreground ,(if window-system "SeaGreen1" "green") + :slant italic) + (message-separator :background "red" :foreground "white" :weight bold) + (message-header-cc + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-newsgroups + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-subject + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-to + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-xheader + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-other + :foreground ,(if window-system "SeaGreen1" "green") + :weight bold) + (message-header-name + :foreground ,(if window-system "SeaGreen1" "green")) (woman-bold :weight bold) (woman-italic :slant italic) (diff-index :weight bold) @@ -716,10 +801,14 @@ doesn't cope with anything approximating a complicated case." ;; --- Make C indentation nice --- +(eval-after-load "cc-mode" + '(progn + (define-key c-mode-map "*" nil) + (define-key c-mode-map "/" nil))) + (defun mdw-c-style () (c-add-style "[mdw] C and C++ style" '((c-basic-offset . 2) - (c-tab-always-indent . nil) (comment-column . 40) (c-class-key . "class") (c-offsets-alist (substatement-open . 0) @@ -736,7 +825,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Fiddle with some syntax codes --- - (modify-syntax-entry ?_ "w") (modify-syntax-entry ?* ". 23") (modify-syntax-entry ?/ ". 124b") (modify-syntax-entry ?\n "> b") @@ -918,7 +1006,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Fiddle with some syntax codes --- - (modify-syntax-entry ?_ "w") (modify-syntax-entry ?* ". 23") (modify-syntax-entry ?/ ". 14") @@ -975,7 +1062,6 @@ doesn't cope with anything approximating a complicated case." (defun mdw-java-style () (c-add-style "[mdw] Java style" '((c-basic-offset . 2) - (c-tab-always-indent . nil) (c-offsets-alist (substatement-open . 0) (label . +) (case-label . +) @@ -991,7 +1077,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Other stuff --- (mdw-java-style) - (modify-syntax-entry ?_ "w") (setq c-hanging-comment-ender-p nil) (setq c-backslash-column 72) (setq comment-start "/* ") @@ -1050,7 +1135,6 @@ doesn't cope with anything approximating a complicated case." (defun mdw-csharp-style () (c-add-style "[mdw] C# style" '((c-basic-offset . 2) - (c-tab-always-indent . nil) (c-offsets-alist (substatement-open . 0) (label . 0) (case-label . +) @@ -1066,7 +1150,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Other stuff --- (mdw-csharp-style) - (modify-syntax-entry ?_ "w") (setq c-hanging-comment-ender-p nil) (setq c-backslash-column 72) (setq comment-start "/* ") @@ -1138,7 +1221,6 @@ doesn't cope with anything approximating a complicated case." (defun mdw-awk-style () (c-add-style "[mdw] Awk style" '((c-basic-offset . 2) - (c-tab-always-indent . nil) (c-offsets-alist (substatement-open . 0) (statement-cont . 0) (statement-case-intro . +))) @@ -1150,7 +1232,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Miscellaneous fiddling --- - (modify-syntax-entry ?_ "w") (mdw-awk-style) (setq c-backslash-column 72) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") @@ -1199,8 +1280,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Perl indentation style --- -(setq cperl-tab-always-indent nil) - (setq cperl-indent-level 2) (setq cperl-continued-statement-offset 2) (setq cperl-continued-brace-offset 0) @@ -1214,7 +1293,6 @@ doesn't cope with anything approximating a complicated case." ;; --- Miscellaneous fiddling --- - (modify-syntax-entry ?_ "w") (modify-syntax-entry ?$ "\\") (modify-syntax-entry ?$ "\\" font-lock-syntax-table) (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") @@ -1272,7 +1350,6 @@ strip numbers instead." ;; --- Miscellaneous fiddling --- - (modify-syntax-entry ?_ "w") (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)") ;; --- Now define fontification things --- @@ -1439,7 +1516,7 @@ strip numbers instead." (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent) (local-set-key [?*] 'mdw-rexx-electric-*) (mapcar #'(lambda (ch) (modify-syntax-entry ch "w")) - '(?. ?! ?? ?_ ?# ?@ ?$)) + '(?! ?? ?# ?@ ?$)) (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)") ;; --- Set up keywords and things for fontification --- @@ -1449,7 +1526,6 @@ strip numbers instead." (setq rexx-indent 2) (setq rexx-end-indent rexx-indent) - (setq rexx-tab-always-indent nil) (setq rexx-cont-indent rexx-indent) (make-local-variable 'font-lock-keywords) @@ -1502,7 +1578,6 @@ strip numbers instead." ;; --- Make underscore an honorary letter --- - (modify-syntax-entry ?_ "w") (modify-syntax-entry ?' "w") ;; --- Set fill prefix --- @@ -1558,7 +1633,6 @@ strip numbers instead." ;; --- Fiddle with syntax table to get comments right --- - (modify-syntax-entry ?_ "w") (modify-syntax-entry ?' "\"") (modify-syntax-entry ?- ". 123") (modify-syntax-entry ?{ ". 1b") @@ -1592,6 +1666,41 @@ strip numbers instead." (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" '(0 mdw-punct-face)))))) +;;;----- Erlang configuration ----------------------------------------------- + +(setq erlang-electric-commannds + '(erlang-electric-newline erlang-electric-semicolon)) + +(defun mdw-fontify-erlang () + + ;; --- Set fill prefix --- + + (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)") + + ;; --- Fiddle with fontification --- + + (make-local-variable 'font-lock-keywords) + (let ((erlang-keywords + (mdw-regexps "after" "and" "andalso" + "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor" + "case" "catch" "cond" + "div" "end" "fun" "if" "let" "not" + "of" "or" "orelse" + "query" "receive" "rem" "try" "when" "xor"))) + + (setq font-lock-keywords + (list + (list "%.*$" + '(0 font-lock-comment-face)) + (list (concat "\\<\\(" erlang-keywords "\\)\\>") + '(0 font-lock-keyword-face)) + (list (concat "^-\\sw+\\>") + '(0 font-lock-keyword-face)) + (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>" + '(0 mdw-number-face)) + (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" + '(0 mdw-punct-face)))))) + ;;;----- Texinfo configuration ---------------------------------------------- (defun mdw-fontify-texinfo () @@ -1636,6 +1745,7 @@ strip numbers instead." (defun mdw-fontify-tex () (setq ispell-parser 'tex) + (turn-on-reftex) ;; --- Don't make maths into a string --- @@ -1762,11 +1872,9 @@ strip numbers instead." ;;;----- Messages-file mode ------------------------------------------------- -(defun message-mode-guts () +(defun messages-mode-guts () (setq messages-mode-syntax-table (make-syntax-table)) (set-syntax-table messages-mode-syntax-table) - (modify-syntax-entry ?_ "w" messages-mode-syntax-table) - (modify-syntax-entry ?- "w" messages-mode-syntax-table) (modify-syntax-entry ?0 "w" messages-mode-syntax-table) (modify-syntax-entry ?1 "w" messages-mode-syntax-table) (modify-syntax-entry ?2 "w" messages-mode-syntax-table) @@ -1783,7 +1891,7 @@ strip numbers instead." (setq indent-line-function 'indent-relative) (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)") (make-local-variable 'font-lock-defaults) - (make-local-variable 'message-mode-keywords) + (make-local-variable 'messages-mode-keywords) (let ((keywords (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum" "export" "enum" "fixed-octetstring" "flags" @@ -1792,7 +1900,7 @@ strip numbers instead." "primitive-nullfree" "relaxed[ \t]+enum" "set" "table" "tagged-optional" "union" "variadic" "vector" "version" "version-tag"))) - (setq message-mode-keywords + (setq messages-mode-keywords (list (list (concat "\\<\\(" keywords "\\)\\>:") '(0 font-lock-keyword-face)) @@ -1803,7 +1911,7 @@ strip numbers instead." '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))) (setq font-lock-defaults - '(message-mode-keywords nil nil nil nil)) + '(messages-mode-keywords nil nil nil nil)) (run-hooks 'messages-file-hook)) (defun messages-mode () @@ -1811,7 +1919,7 @@ strip numbers instead." (fundamental-mode) (setq major-mode 'messages-mode) (setq mode-name "Messages") - (message-mode-guts) + (messages-mode-guts) (modify-syntax-entry ?# "<" messages-mode-syntax-table) (modify-syntax-entry ?\n ">" messages-mode-syntax-table) (setq comment-start "# ") @@ -1824,7 +1932,7 @@ strip numbers instead." (fundamental-mode) (setq major-mode 'cpp-messages-mode) (setq mode-name "CPP Messages") - (message-mode-guts) + (messages-mode-guts) (modify-syntax-entry ?* ". 23" messages-mode-syntax-table) (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table) (setq comment-start "/* ") @@ -1833,7 +1941,7 @@ strip numbers instead." (mdw-regexps "assert" "define" "elif" "else" "endif" "error" "ident" "if" "ifdef" "ifndef" "import" "include" "line" "pragma" "unassert" "undef" "warning"))) - (setq message-mode-keywords + (setq messages-mode-keywords (append (list (list (concat "^[ \t]*\\#[ \t]*" "\\(include\\|import\\)" "[ \t]*\\(<[^>]+\\(>\\|\\)\\)") @@ -1842,7 +1950,7 @@ strip numbers instead." preprocessor-keywords "\\)\\>\\|[0-9]+\\|$\\)\\)") '(1 font-lock-keyword-face))) - message-mode-keywords))) + messages-mode-keywords))) (turn-on-font-lock-if-enabled) (run-hooks 'cpp-messages-mode-hook)) @@ -1982,6 +2090,10 @@ strip numbers instead." (make-variable-buffer-local 'lisp-indent-function) (setq lisp-indent-function 'common-lisp-indent-function)) +(setq lisp-simple-loop-indentation 2 + lisp-loop-keyword-indentation 6 + lisp-loop-forms-indentation 6) + (defun mdw-fontify-lispy () ;; --- Set fill prefix --- @@ -2014,6 +2126,17 @@ strip numbers instead." "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3) (auto-fill-mode 1)) +;;;----- Outline mode ------------------------------------------------------- + +(defun mdw-outline-collapse-all () + "Completely collapse everything in the entire buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (< (point) (point-max)) + (hide-subtree) + (forward-line)))) + ;;;----- Shell mode --------------------------------------------------------- (defun mdw-sh-mode-setup ()