X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/b524cfb560bd79551c34352732d31814c3a9e791..f50c1bed963ac02b75f39124dda23c69441c0bff:/dot-emacs.el

diff --git a/dot-emacs.el b/dot-emacs.el
index 82d0214..0d27f52 100644
--- a/dot-emacs.el
+++ b/dot-emacs.el
@@ -85,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)
@@ -177,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)
@@ -313,57 +433,6 @@ get itself into a twist."
 (defadvice write-file (after mdw-autorevert activate)
   (mdw-check-autorevert))
 
-(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)
-
 ;;;----- Dired hacking ------------------------------------------------------
 
 (defadvice dired-maybe-insert-subdir
@@ -565,9 +634,15 @@ doesn't cope with anything approximating a complicated case."
   (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)
@@ -664,8 +739,42 @@ the regular expressions in `mdw-backup-disable-regexps'."
     (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)
+    (p4-depot-added-face :foreground "green")
+    (p4-depot-branch-op-face :foreground "yellow")
+    (p4-depot-deleted-face :foreground "red")
+    (p4-depot-unmapped-face
+       :foreground ,(if window-system "SkyBlue1" "cyan"))
+    (p4-diff-change-face :foreground "yellow")
+    (p4-diff-del-face :foreground "red")
+    (p4-diff-file-face :foreground "SkyBlue1")
+    (p4-diff-head-face :background "grey10")
+    (p4-diff-ins-face :foreground "green")
     (diff-index :weight bold)
     (diff-file-header :weight bold)
     (diff-hunk-header :foreground "SkyBlue1")
@@ -702,19 +811,47 @@ the regular expressions in `mdw-backup-disable-regexps'."
 
 ;; --- 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-lineup-arglist (langelem)
+  "Hack for DWIMmery in c-lineup-arglist."
+  (if (save-excursion
+	(c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
+      0
+    (c-lineup-arglist langelem)))
+
+(defun mdw-c-indent-extern-mumble (langelem)
+  "Indent `extern \"...\" {' lines."
+  (save-excursion
+    (back-to-indentation)
+    (if (looking-at
+	 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
+	c-basic-offset
+      nil)))
+
 (defun mdw-c-style ()
   (c-add-style "[mdw] C and C++ style"
 	       '((c-basic-offset . 2)
 		 (comment-column . 40)
 		 (c-class-key . "class")
-		 (c-offsets-alist (substatement-open . 0)
-				  (label . 0)
-				  (case-label . +)
-				  (access-label . -)
-				  (inclass . +)
-				  (inline-open . ++)
-				  (statement-cont . 0)
-				  (statement-case-intro . +)))
+		 (c-backslash-column . 72)
+		 (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)
+		  (topmost-intro . mdw-c-indent-extern-mumble)
+		  (cpp-define-intro . 0)
+		  (inextern-lang . [0])
+		  (label . 0)
+		  (case-label . +)
+		  (access-label . -)
+		  (inclass . +)
+		  (inline-open . ++)
+		  (statement-cont . 0)
+		  (statement-case-intro . +)))
 	       t))
 
 (defun mdw-fontify-c-and-c++ ()
@@ -1562,6 +1699,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 ()
@@ -1606,6 +1778,7 @@ strip numbers instead."
 
 (defun mdw-fontify-tex ()
   (setq ispell-parser 'tex)
+  (turn-on-reftex)
 
   ;; --- Don't make maths into a string ---
 
@@ -1732,7 +1905,7 @@ 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 ?0 "w" messages-mode-syntax-table)
@@ -1751,7 +1924,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"
@@ -1760,7 +1933,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))
@@ -1771,7 +1944,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 ()
@@ -1779,7 +1952,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 "# ")
@@ -1792,7 +1965,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 "/* ")
@@ -1801,7 +1974,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]*\\(<[^>]+\\(>\\|\\)\\)")
@@ -1810,7 +1983,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))
 
@@ -1932,6 +2105,10 @@ strip numbers instead."
 
 ;; --- Lispy languages ---
 
+;; Unpleasant bodge.
+(unless (boundp 'slime-repl-mode-map)
+  (setq slime-repl-mode-map (make-sparse-keymap)))
+
 (defun mdw-indent-newline-and-indent ()
   (interactive)
   (indent-for-tab-command)
@@ -1950,6 +2127,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 ---
@@ -2001,14 +2182,30 @@ strip numbers instead."
 	    'comint-watch-for-password-prompt))
 
 (defun mdw-term-mode-setup ()
-  (setq term-prompt-regexp "^[^]#$%>»}\n]*[]#$%>»}] *")
+  (setq term-prompt-regexp shell-prompt-pattern)
   (make-local-variable 'mouse-yank-at-point)
   (make-local-variable 'transient-mark-mode)
   (setq mouse-yank-at-point t)
-  (setq transient-mark-mode nil)
   (auto-fill-mode -1)
   (setq tab-width 8))
 
+(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
+(defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
+(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
+(defun term-send-meta-meta-something ()
+  (interactive)
+  (term-send-raw-string "\e\e")
+  (term-send-raw))
+(eval-after-load 'term
+  '(progn
+     (define-key term-raw-map [?\e ?\e] nil)
+     (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
+     (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
+     (define-key term-raw-map [M-right] 'term-send-meta-right)
+     (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
+     (define-key term-raw-map [M-left] 'term-send-meta-left)
+     (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
+
 ;;;----- That's all, folks --------------------------------------------------
 
 (provide 'dot-emacs)