el/dot-emacs.el: Org-mode hacking to use Strayman class.
[profile] / el / dot-emacs.el
1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
2 ;;;
3 ;;; Functions and macros for .emacs
4 ;;;
5 ;;; (c) 2004 Mark Wooding
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
14 ;;;
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
19 ;;;
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software Foundation,
22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23
24 ;;;--------------------------------------------------------------------------
25 ;;; Check command-line.
26
27 (defvar mdw-fast-startup nil
28 "Whether .emacs should optimize for rapid startup.
29 This may be at the expense of cool features.")
30 (let ((probe nil) (next command-line-args))
31 (while next
32 (cond ((string= (car next) "--mdw-fast-startup")
33 (setq mdw-fast-startup t)
34 (if probe
35 (rplacd probe (cdr next))
36 (setq command-line-args (cdr next))))
37 (t
38 (setq probe next)))
39 (setq next (cdr next))))
40
41 ;;;--------------------------------------------------------------------------
42 ;;; Some general utilities.
43
44 (eval-when-compile
45 (unless (fboundp 'make-regexp)
46 (load "make-regexp"))
47 (require 'cl))
48
49 (defmacro mdw-regexps (&rest list)
50 "Turn a LIST of strings into a single regular expression at compile-time."
51 `',(make-regexp list))
52
53 ;; Some error trapping.
54 ;;
55 ;; If individual bits of this file go tits-up, we don't particularly want
56 ;; the whole lot to stop right there and then, because it's bloody annoying.
57
58 (defmacro trap (&rest forms)
59 "Execute FORMS without allowing errors to propagate outside."
60 `(condition-case err
61 ,(if (cdr forms) (cons 'progn forms) (car forms))
62 (error (message "Error (trapped): %s in %s"
63 (error-message-string err)
64 ',forms))))
65
66 ;; Configuration reading.
67
68 (defvar mdw-config nil)
69 (defun mdw-config (sym)
70 "Read the configuration variable named SYM."
71 (unless mdw-config
72 (setq mdw-config
73 (flet ((replace (what with)
74 (goto-char (point-min))
75 (while (re-search-forward what nil t)
76 (replace-match with t))))
77 (with-temp-buffer
78 (insert-file-contents "~/.mdw.conf")
79 (replace "^[ \t]*\\(#.*\\|\\)\n" "")
80 (replace (concat "^[ \t]*"
81 "\\([-a-zA-Z0-9_.]*\\)"
82 "[ \t]*=[ \t]*"
83 "\\(.*[^ \t\n]\\|\\)"
84 "[ \t]**\\(\n\\|$\\)")
85 "(\\1 . \"\\2\")\n")
86 (car (read-from-string
87 (concat "(" (buffer-string) ")")))))))
88 (cdr (assq sym mdw-config)))
89
90 ;; Set up the load path convincingly.
91
92 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
93 (list (concat "/usr/share/"
94 (symbol-name debian-emacs-flavor)
95 "/site-lisp")))))
96 (dolist (sub (directory-files dir t))
97 (when (and (file-accessible-directory-p sub)
98 (not (member sub load-path)))
99 (setq load-path (nconc load-path (list sub))))))
100
101 ;; Is an Emacs library available?
102
103 (defun library-exists-p (name)
104 "Return non-nil if NAME is an available library.
105 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
106 load path. The non-nil value is the filename we found for the
107 library."
108 (let ((path load-path) elt (foundp nil))
109 (while (and path (not foundp))
110 (setq elt (car path))
111 (setq path (cdr path))
112 (setq foundp (or (let ((file (concat elt "/" name ".elc")))
113 (and (file-exists-p file) file))
114 (let ((file (concat elt "/" name ".el")))
115 (and (file-exists-p file) file)))))
116 foundp))
117
118 (defun maybe-autoload (symbol file &optional docstring interactivep type)
119 "Set an autoload if the file actually exists."
120 (and (library-exists-p file)
121 (autoload symbol file docstring interactivep type)))
122
123 ;; Splitting windows.
124
125 (unless (fboundp 'scroll-bar-columns)
126 (defun scroll-bar-columns (side)
127 (cond ((eq side 'left) 0)
128 (window-system 3)
129 (t 1))))
130 (unless (fboundp 'fringe-columns)
131 (defun fringe-columns (side)
132 (cond ((not window-system) 0)
133 ((eq side 'left) 1)
134 (t 2))))
135
136 (defun mdw-divvy-window (&optional width)
137 "Split a wide window into appropriate widths."
138 (interactive "P")
139 (setq width (cond (width (prefix-numeric-value width))
140 ((and window-system
141 (>= emacs-major-version 22))
142 77)
143 (t 78)))
144 (let* ((win (selected-window))
145 (sb-width (if (not window-system)
146 1
147 (let ((tot 0))
148 (dolist (what '(scroll-bar fringe))
149 (dolist (side '(left right))
150 (incf tot
151 (funcall (intern (concat (symbol-name what)
152 "-columns"))
153 side))))
154 tot)))
155 (c (/ (+ (window-width) sb-width)
156 (+ width sb-width))))
157 (while (> c 1)
158 (setq c (1- c))
159 (split-window-horizontally (+ width sb-width))
160 (other-window 1))
161 (select-window win)))
162
163 ;; Functions for sexp diary entries.
164
165 (defun mdw-weekday (l)
166 "Return non-nil if `date' falls on one of the days of the week in L.
167 L is a list of day numbers (from 0 to 6 for Sunday through to
168 Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
169 the date stored in `date' falls on a listed day, then the
170 function returns non-nil."
171 (let ((d (calendar-day-of-week date)))
172 (or (memq d l)
173 (memq (nth d '(sunday monday tuesday wednesday
174 thursday friday saturday)) l))))
175
176 (defun mdw-todo (&optional when)
177 "Return non-nil today, or on WHEN, whichever is later."
178 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
179 (d (calendar-absolute-from-gregorian date)))
180 (if when
181 (setq w (max w (calendar-absolute-from-gregorian
182 (cond
183 ((not european-calendar-style)
184 when)
185 ((> (car when) 100)
186 (list (nth 1 when)
187 (nth 2 when)
188 (nth 0 when)))
189 (t
190 (list (nth 1 when)
191 (nth 0 when)
192 (nth 2 when))))))))
193 (eq w d)))
194
195 ;; Fighting with Org-mode's evil key maps.
196
197 (defvar mdw-evil-keymap-keys
198 '(([S-up] . [?\C-c up])
199 ([S-down] . [?\C-c down])
200 ([S-left] . [?\C-c left])
201 ([S-right] . [?\C-c right])
202 (([M-up] [?\e up]) . [C-up])
203 (([M-down] [?\e down]) . [C-down])
204 (([M-left] [?\e left]) . [C-left])
205 (([M-right] [?\e right]) . [C-right]))
206 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
207 The value is an alist mapping evil keys (as a list, or singleton)
208 to good keys (in the same form).")
209
210 (defun mdw-clobber-evil-keymap (keymap)
211 "Replace evil key bindings in the KEYMAP.
212 Evil key bindings are defined in `mdw-evil-keymap-keys'."
213 (dolist (entry mdw-evil-keymap-keys)
214 (let ((binding nil)
215 (keys (if (listp (car entry))
216 (car entry)
217 (list (car entry))))
218 (replacements (if (listp (cdr entry))
219 (cdr entry)
220 (list (cdr entry)))))
221 (catch 'found
222 (dolist (key keys)
223 (setq binding (lookup-key keymap key))
224 (when binding
225 (throw 'found nil))))
226 (when binding
227 (dolist (key keys)
228 (define-key keymap key nil))
229 (dolist (key replacements)
230 (define-key keymap key binding))))))
231
232 (eval-after-load "org"
233 '(progn
234 (push '("strayman"
235 "\\documentclass{strayman}
236 \\usepackage[utf8]{inputenc}
237 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
238 \\usepackage[T1]{fontenc}
239 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
240 ("\\section{%s}" . "\\section*{%s}")
241 ("\\subsection{%s}" . "\\subsection*{%s}")
242 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
243 ("\\paragraph{%s}" . "\\paragraph*{%s}")
244 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
245 org-export-latex-classes)))
246
247 ;;;--------------------------------------------------------------------------
248 ;;; Mail and news hacking.
249
250 (define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
251 "Major mode for editing news and mail messages from external programs.
252 Not much right now. Just support for doing MailCrypt stuff."
253 :syntax-table nil
254 :abbrev-table nil
255 (run-hooks 'mail-setup-hook))
256
257 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
258
259 (add-hook 'mdwail-mode-hook
260 (lambda ()
261 (set-buffer-file-coding-system 'utf-8)
262 (make-local-variable 'paragraph-separate)
263 (make-local-variable 'paragraph-start)
264 (setq paragraph-start
265 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
266 paragraph-start))
267 (setq paragraph-separate
268 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
269 paragraph-separate))))
270
271 ;; How to encrypt in mdwmail.
272
273 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
274 (or start
275 (setq start (save-excursion
276 (goto-char (point-min))
277 (or (search-forward "\n\n" nil t) (point-min)))))
278 (or end
279 (setq end (point-max)))
280 (mc-encrypt-generic recip scm start end from sign))
281
282 ;; How to sign in mdwmail.
283
284 (defun mdwmail-mc-sign (key scm start end uclr)
285 (or start
286 (setq start (save-excursion
287 (goto-char (point-min))
288 (or (search-forward "\n\n" nil t) (point-min)))))
289 (or end
290 (setq end (point-max)))
291 (mc-sign-generic key scm start end uclr))
292
293 ;; Some signature mangling.
294
295 (defun mdwmail-mangle-signature ()
296 (save-excursion
297 (goto-char (point-min))
298 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
299 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
300 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
301
302 ;; Insert my login name into message-ids, so I can score replies.
303
304 (defadvice message-unique-id (after mdw-user-name last activate compile)
305 "Ensure that the user's name appears at the end of the message-id string,
306 so that it can be used for convenient filtering."
307 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
308
309 ;; Tell my movemail hack where movemail is.
310 ;;
311 ;; This is needed to shup up warnings about LD_PRELOAD.
312
313 (let ((path exec-path))
314 (while path
315 (let ((try (expand-file-name "movemail" (car path))))
316 (if (file-executable-p try)
317 (setenv "REAL_MOVEMAIL" try))
318 (setq path (cdr path)))))
319
320 ;;;--------------------------------------------------------------------------
321 ;;; Utility functions.
322
323 (or (fboundp 'line-number-at-pos)
324 (defun line-number-at-pos (&optional pos)
325 (let ((opoint (or pos (point))) start)
326 (save-excursion
327 (save-restriction
328 (goto-char (point-min))
329 (widen)
330 (forward-line 0)
331 (setq start (point))
332 (goto-char opoint)
333 (forward-line 0)
334 (1+ (count-lines 1 (point))))))))
335
336 (defun mdw-uniquify-alist (&rest alists)
337 "Return the concatenation of the ALISTS with duplicate elements removed.
338 The first association with a given key prevails; others are
339 ignored. The input lists are not modified, although they'll
340 probably become garbage."
341 (and alists
342 (let ((start-list (cons nil nil)))
343 (mdw-do-uniquify start-list
344 start-list
345 (car alists)
346 (cdr alists)))))
347
348
349 (defun mdw-do-uniquify (done end l rest)
350 "A helper function for mdw-uniquify-alist.
351 The DONE argument is a list whose first element is `nil'. It
352 contains the uniquified alist built so far. The leading `nil' is
353 stripped off at the end of the operation; it's only there so that
354 DONE always references a cons cell. END refers to the final cons
355 cell in the DONE list; it is modified in place each time to avoid
356 the overheads of `append'ing all the time. The L argument is the
357 alist we're currently processing; the remaining alists are given
358 in REST."
359
360 ;; There are several different cases to deal with here.
361 (cond
362
363 ;; Current list isn't empty. Add the first item to the DONE list if
364 ;; there's not an item with the same KEY already there.
365 (l (or (assoc (car (car l)) done)
366 (progn
367 (setcdr end (cons (car l) nil))
368 (setq end (cdr end))))
369 (mdw-do-uniquify done end (cdr l) rest))
370
371 ;; The list we were working on is empty. Shunt the next list into the
372 ;; current list position and go round again.
373 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
374
375 ;; Everything's done. Remove the leading `nil' from the DONE list and
376 ;; return it. Finished!
377 (t (cdr done))))
378
379 (defun date ()
380 "Insert the current date in a pleasing way."
381 (interactive)
382 (insert (save-excursion
383 (let ((buffer (get-buffer-create "*tmp*")))
384 (unwind-protect (progn (set-buffer buffer)
385 (erase-buffer)
386 (shell-command "date +%Y-%m-%d" t)
387 (goto-char (mark))
388 (delete-backward-char 1)
389 (buffer-string))
390 (kill-buffer buffer))))))
391
392 (defun uuencode (file &optional name)
393 "UUencodes a file, maybe calling it NAME, into the current buffer."
394 (interactive "fInput file name: ")
395
396 ;; If NAME isn't specified, then guess from the filename.
397 (if (not name)
398 (setq name
399 (substring file
400 (or (string-match "[^/]*$" file) 0))))
401 (print (format "uuencode `%s' `%s'" file name))
402
403 ;; Now actually do the thing.
404 (call-process "uuencode" file t nil name))
405
406 (defvar np-file "~/.np"
407 "*Where the `now-playing' file is.")
408
409 (defun np (&optional arg)
410 "Grabs a `now-playing' string."
411 (interactive)
412 (save-excursion
413 (or arg (progn
414 (goto-char (point-max))
415 (insert "\nNP: ")
416 (insert-file-contents np-file)))))
417
418 (defun mdw-check-autorevert ()
419 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
420 This takes into consideration whether it's been found using
421 tramp, which seems to get itself into a twist."
422 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
423 nil)
424 ((and (buffer-file-name)
425 (fboundp 'tramp-tramp-file-p)
426 (tramp-tramp-file-p (buffer-file-name)))
427 (unless global-auto-revert-ignore-buffer
428 (setq global-auto-revert-ignore-buffer 'tramp)))
429 ((eq global-auto-revert-ignore-buffer 'tramp)
430 (setq global-auto-revert-ignore-buffer nil))))
431
432 (defadvice find-file (after mdw-autorevert activate)
433 (mdw-check-autorevert))
434 (defadvice write-file (after mdw-autorevert activate)
435 (mdw-check-autorevert))
436
437 ;;;--------------------------------------------------------------------------
438 ;;; Dired hacking.
439
440 (defadvice dired-maybe-insert-subdir
441 (around mdw-marked-insertion first activate)
442 "The DIRNAME may be a list of directory names to insert.
443 Interactively, if files are marked, then insert all of them.
444 With a numeric prefix argument, select that many entries near
445 point; with a non-numeric prefix argument, prompt for listing
446 options."
447 (interactive
448 (list (dired-get-marked-files nil
449 (and (integerp current-prefix-arg)
450 current-prefix-arg)
451 #'file-directory-p)
452 (and current-prefix-arg
453 (not (integerp current-prefix-arg))
454 (read-string "Switches for listing: "
455 (or dired-subdir-switches
456 dired-actual-switches)))))
457 (let ((dirs (ad-get-arg 0)))
458 (dolist (dir (if (listp dirs) dirs (list dirs)))
459 (ad-set-arg 0 dir)
460 ad-do-it)))
461
462 ;;;--------------------------------------------------------------------------
463 ;;; URL viewing.
464
465 (defun mdw-w3m-browse-url (url &optional new-session-p)
466 "Invoke w3m on the URL in its current window, or at least a different one.
467 If NEW-SESSION-P, start a new session."
468 (interactive "sURL: \nP")
469 (save-excursion
470 (let ((window (selected-window)))
471 (unwind-protect
472 (progn
473 (select-window (or (and (not new-session-p)
474 (get-buffer-window "*w3m*"))
475 (progn
476 (if (one-window-p t) (split-window))
477 (get-lru-window))))
478 (w3m-browse-url url new-session-p))
479 (select-window window)))))
480
481 (defvar mdw-good-url-browsers
482 '((w3m . mdw-w3m-browse-url)
483 browse-url-w3
484 browse-url-mozilla)
485 "List of good browsers for mdw-good-url-browsers.
486 Each item is a browser function name, or a cons (CHECK . FUNC).
487 A symbol FOO stands for (FOO . FOO).")
488
489 (defun mdw-good-url-browser ()
490 "Return a good URL browser.
491 Trundle the list of such things, finding the first item for which
492 CHECK is fboundp, and returning the correponding FUNC."
493 (let ((bs mdw-good-url-browsers) b check func answer)
494 (while (and bs (not answer))
495 (setq b (car bs)
496 bs (cdr bs))
497 (if (consp b)
498 (setq check (car b) func (cdr b))
499 (setq check b func b))
500 (if (fboundp check)
501 (setq answer func)))
502 answer))
503
504 ;;;--------------------------------------------------------------------------
505 ;;; Paragraph filling.
506
507 ;; Useful variables.
508
509 (defvar mdw-fill-prefix nil
510 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
511 If there's no fill prefix currently set (by the `fill-prefix'
512 variable) and there's a match from one of the regexps here, it
513 gets used to set the fill-prefix for the current operation.
514
515 The variable is a list of items of the form `REGEXP . PREFIX'; if
516 the REGEXP matches, the PREFIX is used to set the fill prefix.
517 It in turn is a list of things:
518
519 STRING -- insert a literal string
520 (match . N) -- insert the thing matched by bracketed subexpression N
521 (pad . N) -- a string of whitespace the same width as subexpression N
522 (expr . FORM) -- the result of evaluating FORM")
523
524 (make-variable-buffer-local 'mdw-fill-prefix)
525
526 (defvar mdw-hanging-indents
527 (concat "\\(\\("
528 "\\([*o]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
529 "[ \t]+"
530 "\\)?\\)")
531 "*Standard regexp matching parts of a hanging indent.
532 This is mainly useful in `auto-fill-mode'.")
533
534 ;; Setting things up.
535
536 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
537
538 ;; Utility functions.
539
540 (defun mdw-tabify (s)
541 "Tabify the string S. This is a horrid hack."
542 (save-excursion
543 (save-match-data
544 (let (start end)
545 (beginning-of-line)
546 (setq start (point-marker))
547 (insert s "\n")
548 (setq end (point-marker))
549 (tabify start end)
550 (setq s (buffer-substring start (1- end)))
551 (delete-region start end)
552 (set-marker start nil)
553 (set-marker end nil)
554 s))))
555
556 (defun mdw-examine-fill-prefixes (l)
557 "Given a list of dynamic fill prefixes, pick one which matches
558 context and return the static fill prefix to use. Point must be
559 at the start of a line, and match data must be saved."
560 (cond ((not l) nil)
561 ((looking-at (car (car l)))
562 (mdw-tabify (apply (function concat)
563 (mapcar (function mdw-do-prefix-match)
564 (cdr (car l))))))
565 (t (mdw-examine-fill-prefixes (cdr l)))))
566
567 (defun mdw-maybe-car (p)
568 "If P is a pair, return (car P), otherwise just return P."
569 (if (consp p) (car p) p))
570
571 (defun mdw-padding (s)
572 "Return a string the same width as S but made entirely from whitespace."
573 (let* ((l (length s)) (i 0) (n (make-string l ? )))
574 (while (< i l)
575 (if (= 9 (aref s i))
576 (aset n i 9))
577 (setq i (1+ i)))
578 n))
579
580 (defun mdw-do-prefix-match (m)
581 "Expand a dynamic prefix match element.
582 See `mdw-fill-prefix' for details."
583 (cond ((not (consp m)) (format "%s" m))
584 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
585 ((eq (car m) 'pad) (mdw-padding (match-string
586 (mdw-maybe-car (cdr m)))))
587 ((eq (car m) 'eval) (eval (cdr m)))
588 (t "")))
589
590 (defun mdw-choose-dynamic-fill-prefix ()
591 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
592 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
593 ((not mdw-fill-prefix) fill-prefix)
594 (t (save-excursion
595 (beginning-of-line)
596 (save-match-data
597 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
598
599 (defun do-auto-fill ()
600 "Handle auto-filling, working out a dynamic fill prefix in the
601 case where there isn't a sensible static one."
602 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
603 (mdw-do-auto-fill)))
604
605 (defun mdw-fill-paragraph ()
606 "Fill paragraph, getting a dynamic fill prefix."
607 (interactive)
608 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
609 (fill-paragraph nil)))
610
611 (defun mdw-standard-fill-prefix (rx &optional mat)
612 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
613 This is just a short-cut for setting the thing by hand, and by
614 design it doesn't cope with anything approximating a complicated
615 case."
616 (setq mdw-fill-prefix
617 `((,(concat rx mdw-hanging-indents)
618 (match . 1)
619 (pad . ,(or mat 2))))))
620
621 ;;;--------------------------------------------------------------------------
622 ;;; Other common declarations.
623
624 ;; Common mode settings.
625
626 (defvar mdw-auto-indent t
627 "Whether to indent automatically after a newline.")
628
629 (defun mdw-misc-mode-config ()
630 (and mdw-auto-indent
631 (cond ((eq major-mode 'lisp-mode)
632 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
633 ((or (eq major-mode 'slime-repl-mode)
634 (eq major-mode 'asm-mode))
635 nil)
636 (t
637 (local-set-key "\C-m" 'newline-and-indent))))
638 (local-set-key [C-return] 'newline)
639 (make-variable-buffer-local 'page-delimiter)
640 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
641 (setq comment-column 40)
642 (auto-fill-mode 1)
643 (setq fill-column 77)
644 (setq show-trailing-whitespace t)
645 (and (fboundp 'gtags-mode)
646 (gtags-mode))
647 (outline-minor-mode t)
648 (mdw-set-font))
649
650 (eval-after-load 'gtags
651 '(dolist (key '([mouse-2] [mouse-3]))
652 (define-key gtags-mode-map key nil)))
653
654 ;; Set up all sorts of faces.
655
656 (defvar mdw-set-font nil)
657
658 (defvar mdw-punct-face 'mdw-punct-face "Face to use for punctuation")
659 (make-face 'mdw-punct-face)
660 (defvar mdw-number-face 'mdw-number-face "Face to use for numbers")
661 (make-face 'mdw-number-face)
662
663 ;; Backup file handling.
664
665 (defvar mdw-backup-disable-regexps nil
666 "*List of regular expressions: if a file name matches any of
667 these then the file is not backed up.")
668
669 (defun mdw-backup-enable-predicate (name)
670 "[mdw]'s default backup predicate.
671 Allows a backup if the standard predicate would allow it, and it
672 doesn't match any of the regular expressions in
673 `mdw-backup-disable-regexps'."
674 (and (normal-backup-enable-predicate name)
675 (let ((answer t) (list mdw-backup-disable-regexps))
676 (save-match-data
677 (while list
678 (if (string-match (car list) name)
679 (setq answer nil))
680 (setq list (cdr list)))
681 answer))))
682 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
683
684 ;;;--------------------------------------------------------------------------
685 ;;; General fontification.
686
687 (defun mdw-set-fonts (frame faces)
688 (while faces
689 (let ((face (caar faces)))
690 (or (facep face) (make-face face))
691 (set-face-attribute face frame
692 :family 'unspecified
693 :width 'unspecified
694 :height 'unspecified
695 :weight 'unspecified
696 :slant 'unspecified
697 :foreground 'unspecified
698 :background 'unspecified
699 :underline 'unspecified
700 :overline 'unspecified
701 :strike-through 'unspecified
702 :box 'unspecified
703 :inverse-video 'unspecified
704 :stipple 'unspecified
705 ;:font 'unspecified
706 :inherit 'unspecified)
707 (apply 'set-face-attribute face frame (cdar faces))
708 (setq faces (cdr faces)))))
709
710 (defun mdw-do-set-font (&optional frame)
711 (interactive)
712 (mdw-set-fonts (and (boundp 'frame) frame) `(
713 (default :foreground "white" :background "black"
714 ,@(cond ((eq window-system 'w32)
715 '(:family "courier new" :height 85))
716 ((eq window-system 'x)
717 '(:family "misc-fixed" :height 130 :width semi-condensed))))
718 (fixed-pitch)
719 (minibuffer-prompt)
720 (mode-line :foreground "blue" :background "yellow"
721 :box (:line-width 1 :style released-button))
722 (mode-line-inactive :foreground "yellow" :background "blue"
723 :box (:line-width 1 :style released-button))
724 (scroll-bar :foreground "black" :background "lightgrey")
725 (fringe :foreground "yellow" :background "black")
726 (show-paren-match-face :background "darkgreen")
727 (show-paren-mismatch-face :background "red")
728 (font-lock-warning-face :background "red" :weight bold)
729 (highlight :background "DarkSeaGreen4")
730 (holiday-face :background "red")
731 (calendar-today-face :foreground "yellow" :weight bold)
732 (comint-highlight-prompt :weight bold)
733 (comint-highlight-input)
734 (font-lock-builtin-face :weight bold)
735 (font-lock-type-face :weight bold)
736 (region :background ,(if window-system "grey30" "blue"))
737 (isearch :background "palevioletred2")
738 (mdw-punct-face :foreground ,(if window-system "burlywood2" "yellow"))
739 (mdw-number-face :foreground "yellow")
740 (font-lock-function-name-face :weight bold)
741 (font-lock-variable-name-face :slant italic)
742 (font-lock-comment-delimiter-face
743 :foreground ,(if window-system "SeaGreen1" "green")
744 :slant italic)
745 (font-lock-comment-face
746 :foreground ,(if window-system "SeaGreen1" "green")
747 :slant italic)
748 (font-lock-string-face :foreground ,(if window-system "SkyBlue1" "cyan"))
749 (font-lock-keyword-face :weight bold)
750 (font-lock-constant-face :weight bold)
751 (font-lock-reference-face :weight bold)
752 (message-cited-text
753 :foreground ,(if window-system "SeaGreen1" "green")
754 :slant italic)
755 (message-separator :background "red" :foreground "white" :weight bold)
756 (message-header-cc
757 :foreground ,(if window-system "SeaGreen1" "green")
758 :weight bold)
759 (message-header-newsgroups
760 :foreground ,(if window-system "SeaGreen1" "green")
761 :weight bold)
762 (message-header-subject
763 :foreground ,(if window-system "SeaGreen1" "green")
764 :weight bold)
765 (message-header-to
766 :foreground ,(if window-system "SeaGreen1" "green")
767 :weight bold)
768 (message-header-xheader
769 :foreground ,(if window-system "SeaGreen1" "green")
770 :weight bold)
771 (message-header-other
772 :foreground ,(if window-system "SeaGreen1" "green")
773 :weight bold)
774 (message-header-name
775 :foreground ,(if window-system "SeaGreen1" "green"))
776 (woman-bold :weight bold)
777 (woman-italic :slant italic)
778 (p4-depot-added-face :foreground "green")
779 (p4-depot-branch-op-face :foreground "yellow")
780 (p4-depot-deleted-face :foreground "red")
781 (p4-depot-unmapped-face
782 :foreground ,(if window-system "SkyBlue1" "cyan"))
783 (p4-diff-change-face :foreground "yellow")
784 (p4-diff-del-face :foreground "red")
785 (p4-diff-file-face :foreground "SkyBlue1")
786 (p4-diff-head-face :background "grey10")
787 (p4-diff-ins-face :foreground "green")
788 (diff-index :weight bold)
789 (diff-file-header :weight bold)
790 (diff-hunk-header :foreground "SkyBlue1")
791 (diff-function :foreground "SkyBlue1" :weight bold)
792 (diff-header :background "grey10")
793 (diff-added :foreground "green")
794 (diff-removed :foreground "red")
795 (diff-context)
796 (whizzy-slice-face :background "grey10")
797 (whizzy-error-face :background "darkred")
798 (trailing-whitespace :background "red")
799 )))
800
801 (defun mdw-set-font ()
802 (trap
803 (turn-on-font-lock)
804 (if (not mdw-set-font)
805 (progn
806 (setq mdw-set-font t)
807 (mdw-do-set-font nil)))))
808
809 ;;;--------------------------------------------------------------------------
810 ;;; C programming configuration.
811
812 ;; Linux kernel hacking.
813
814 (defvar linux-c-mode-hook)
815
816 (defun linux-c-mode ()
817 (interactive)
818 (c-mode)
819 (setq major-mode 'linux-c-mode)
820 (setq mode-name "Linux C")
821 (run-hooks 'linux-c-mode-hook))
822
823 ;; Make C indentation nice.
824
825 (eval-after-load "cc-mode"
826 '(progn
827 (define-key c-mode-map "*" nil)
828 (define-key c-mode-map "/" nil)))
829
830 (defun mdw-c-lineup-arglist (langelem)
831 "Hack for DWIMmery in c-lineup-arglist."
832 (if (save-excursion
833 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
834 0
835 (c-lineup-arglist langelem)))
836
837 (defun mdw-c-indent-extern-mumble (langelem)
838 "Indent `extern \"...\" {' lines."
839 (save-excursion
840 (back-to-indentation)
841 (if (looking-at
842 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
843 c-basic-offset
844 nil)))
845
846 (defun mdw-c-style ()
847 (c-add-style "[mdw] C and C++ style"
848 '((c-basic-offset . 2)
849 (comment-column . 40)
850 (c-class-key . "class")
851 (c-backslash-column . 72)
852 (c-offsets-alist
853 (substatement-open . (add 0 c-indent-one-line-block))
854 (defun-open . (add 0 c-indent-one-line-block))
855 (arglist-cont-nonempty . mdw-c-lineup-arglist)
856 (topmost-intro . mdw-c-indent-extern-mumble)
857 (cpp-define-intro . 0)
858 (inextern-lang . [0])
859 (label . 0)
860 (case-label . +)
861 (access-label . -)
862 (inclass . +)
863 (inline-open . ++)
864 (statement-cont . 0)
865 (statement-case-intro . +)))
866 t))
867
868 (defun mdw-fontify-c-and-c++ ()
869
870 ;; Fiddle with some syntax codes.
871 (modify-syntax-entry ?* ". 23")
872 (modify-syntax-entry ?/ ". 124b")
873 (modify-syntax-entry ?\n "> b")
874
875 ;; Other stuff.
876 (mdw-c-style)
877 (setq c-hanging-comment-ender-p nil)
878 (setq c-backslash-column 72)
879 (setq c-label-minimum-indentation 0)
880 (setq mdw-fill-prefix
881 `((,(concat "\\([ \t]*/?\\)"
882 "\\([\*/][ \t]*\\)"
883 "\\([A-Za-z]+:[ \t]*\\)?"
884 mdw-hanging-indents)
885 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
886
887 ;; Now define things to be fontified.
888 (make-local-variable 'font-lock-keywords)
889 (let ((c-keywords
890 (mdw-regexps "and" ;C++
891 "and_eq" ;C++
892 "asm" ;K&R, GCC
893 "auto" ;K&R, C89
894 "bitand" ;C++
895 "bitor" ;C++
896 "bool" ;C++, C9X macro
897 "break" ;K&R, C89
898 "case" ;K&R, C89
899 "catch" ;C++
900 "char" ;K&R, C89
901 "class" ;C++
902 "complex" ;C9X macro, C++ template type
903 "compl" ;C++
904 "const" ;C89
905 "const_cast" ;C++
906 "continue" ;K&R, C89
907 "defined" ;C89 preprocessor
908 "default" ;K&R, C89
909 "delete" ;C++
910 "do" ;K&R, C89
911 "double" ;K&R, C89
912 "dynamic_cast" ;C++
913 "else" ;K&R, C89
914 ;; "entry" ;K&R -- never used
915 "enum" ;C89
916 "explicit" ;C++
917 "export" ;C++
918 "extern" ;K&R, C89
919 "false" ;C++, C9X macro
920 "float" ;K&R, C89
921 "for" ;K&R, C89
922 ;; "fortran" ;K&R
923 "friend" ;C++
924 "goto" ;K&R, C89
925 "if" ;K&R, C89
926 "imaginary" ;C9X macro
927 "inline" ;C++, C9X, GCC
928 "int" ;K&R, C89
929 "long" ;K&R, C89
930 "mutable" ;C++
931 "namespace" ;C++
932 "new" ;C++
933 "operator" ;C++
934 "or" ;C++
935 "or_eq" ;C++
936 "private" ;C++
937 "protected" ;C++
938 "public" ;C++
939 "register" ;K&R, C89
940 "reinterpret_cast" ;C++
941 "restrict" ;C9X
942 "return" ;K&R, C89
943 "short" ;K&R, C89
944 "signed" ;C89
945 "sizeof" ;K&R, C89
946 "static" ;K&R, C89
947 "static_cast" ;C++
948 "struct" ;K&R, C89
949 "switch" ;K&R, C89
950 "template" ;C++
951 "this" ;C++
952 "throw" ;C++
953 "true" ;C++, C9X macro
954 "try" ;C++
955 "this" ;C++
956 "typedef" ;C89
957 "typeid" ;C++
958 "typeof" ;GCC
959 "typename" ;C++
960 "union" ;K&R, C89
961 "unsigned" ;K&R, C89
962 "using" ;C++
963 "virtual" ;C++
964 "void" ;C89
965 "volatile" ;C89
966 "wchar_t" ;C++, C89 library type
967 "while" ;K&R, C89
968 "xor" ;C++
969 "xor_eq" ;C++
970 "_Bool" ;C9X
971 "_Complex" ;C9X
972 "_Imaginary" ;C9X
973 "_Pragma" ;C9X preprocessor
974 "__alignof__" ;GCC
975 "__asm__" ;GCC
976 "__attribute__" ;GCC
977 "__complex__" ;GCC
978 "__const__" ;GCC
979 "__extension__" ;GCC
980 "__imag__" ;GCC
981 "__inline__" ;GCC
982 "__label__" ;GCC
983 "__real__" ;GCC
984 "__signed__" ;GCC
985 "__typeof__" ;GCC
986 "__volatile__" ;GCC
987 ))
988 (preprocessor-keywords
989 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
990 "ident" "if" "ifdef" "ifndef" "import" "include"
991 "line" "pragma" "unassert" "undef" "warning"))
992 (objc-keywords
993 (mdw-regexps "class" "defs" "encode" "end" "implementation"
994 "interface" "private" "protected" "protocol" "public"
995 "selector")))
996
997 (setq font-lock-keywords
998 (list
999
1000 ;; Fontify include files as strings.
1001 (list (concat "^[ \t]*\\#[ \t]*"
1002 "\\(include\\|import\\)"
1003 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1004 '(2 font-lock-string-face))
1005
1006 ;; Preprocessor directives are `references'?.
1007 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1008 preprocessor-keywords
1009 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1010 '(1 font-lock-keyword-face))
1011
1012 ;; Handle the keywords defined above.
1013 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1014 '(0 font-lock-keyword-face))
1015
1016 (list (concat "\\<\\(" c-keywords "\\)\\>")
1017 '(0 font-lock-keyword-face))
1018
1019 ;; Handle numbers too.
1020 ;;
1021 ;; This looks strange, I know. It corresponds to the
1022 ;; preprocessor's idea of what a number looks like, rather than
1023 ;; anything sensible.
1024 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1025 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1026 '(0 mdw-number-face))
1027
1028 ;; And anything else is punctuation.
1029 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1030 '(0 mdw-punct-face))))))
1031
1032 ;;;--------------------------------------------------------------------------
1033 ;;; AP calc mode.
1034
1035 (defun apcalc-mode ()
1036 (interactive)
1037 (c-mode)
1038 (setq major-mode 'apcalc-mode)
1039 (setq mode-name "AP Calc")
1040 (run-hooks 'apcalc-mode-hook))
1041
1042 (defun mdw-fontify-apcalc ()
1043
1044 ;; Fiddle with some syntax codes.
1045 (modify-syntax-entry ?* ". 23")
1046 (modify-syntax-entry ?/ ". 14")
1047
1048 ;; Other stuff.
1049 (mdw-c-style)
1050 (setq c-hanging-comment-ender-p nil)
1051 (setq c-backslash-column 72)
1052 (setq comment-start "/* ")
1053 (setq comment-end " */")
1054 (setq mdw-fill-prefix
1055 `((,(concat "\\([ \t]*/?\\)"
1056 "\\([\*/][ \t]*\\)"
1057 "\\([A-Za-z]+:[ \t]*\\)?"
1058 mdw-hanging-indents)
1059 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1060
1061 ;; Now define things to be fontified.
1062 (make-local-variable 'font-lock-keywords)
1063 (let ((c-keywords
1064 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1065 "do" "else" "exit" "for" "global" "goto" "help" "if"
1066 "local" "mat" "obj" "print" "quit" "read" "return"
1067 "show" "static" "switch" "while" "write")))
1068
1069 (setq font-lock-keywords
1070 (list
1071
1072 ;; Handle the keywords defined above.
1073 (list (concat "\\<\\(" c-keywords "\\)\\>")
1074 '(0 font-lock-keyword-face))
1075
1076 ;; Handle numbers too.
1077 ;;
1078 ;; This looks strange, I know. It corresponds to the
1079 ;; preprocessor's idea of what a number looks like, rather than
1080 ;; anything sensible.
1081 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1082 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1083 '(0 mdw-number-face))
1084
1085 ;; And anything else is punctuation.
1086 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1087 '(0 mdw-punct-face))))))
1088
1089 ;;;--------------------------------------------------------------------------
1090 ;;; Java programming configuration.
1091
1092 ;; Make indentation nice.
1093
1094 (defun mdw-java-style ()
1095 (c-add-style "[mdw] Java style"
1096 '((c-basic-offset . 2)
1097 (c-offsets-alist (substatement-open . 0)
1098 (label . +)
1099 (case-label . +)
1100 (access-label . 0)
1101 (inclass . +)
1102 (statement-case-intro . +)))
1103 t))
1104
1105 ;; Declare Java fontification style.
1106
1107 (defun mdw-fontify-java ()
1108
1109 ;; Other stuff.
1110 (mdw-java-style)
1111 (setq c-hanging-comment-ender-p nil)
1112 (setq c-backslash-column 72)
1113 (setq comment-start "/* ")
1114 (setq comment-end " */")
1115 (setq mdw-fill-prefix
1116 `((,(concat "\\([ \t]*/?\\)"
1117 "\\([\*/][ \t]*\\)"
1118 "\\([A-Za-z]+:[ \t]*\\)?"
1119 mdw-hanging-indents)
1120 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1121
1122 ;; Now define things to be fontified.
1123 (make-local-variable 'font-lock-keywords)
1124 (let ((java-keywords
1125 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1126 "char" "class" "const" "continue" "default" "do"
1127 "double" "else" "extends" "final" "finally" "float"
1128 "for" "goto" "if" "implements" "import" "instanceof"
1129 "int" "interface" "long" "native" "new" "package"
1130 "private" "protected" "public" "return" "short"
1131 "static" "super" "switch" "synchronized" "this"
1132 "throw" "throws" "transient" "try" "void" "volatile"
1133 "while"
1134
1135 "false" "null" "true")))
1136
1137 (setq font-lock-keywords
1138 (list
1139
1140 ;; Handle the keywords defined above.
1141 (list (concat "\\<\\(" java-keywords "\\)\\>")
1142 '(0 font-lock-keyword-face))
1143
1144 ;; Handle numbers too.
1145 ;;
1146 ;; The following isn't quite right, but it's close enough.
1147 (list (concat "\\<\\("
1148 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1149 "[0-9]+\\(\\.[0-9]*\\|\\)"
1150 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1151 "[lLfFdD]?")
1152 '(0 mdw-number-face))
1153
1154 ;; And anything else is punctuation.
1155 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1156 '(0 mdw-punct-face))))))
1157
1158 ;;;--------------------------------------------------------------------------
1159 ;;; C# programming configuration.
1160
1161 ;; Make indentation nice.
1162
1163 (defun mdw-csharp-style ()
1164 (c-add-style "[mdw] C# style"
1165 '((c-basic-offset . 2)
1166 (c-offsets-alist (substatement-open . 0)
1167 (label . 0)
1168 (case-label . +)
1169 (access-label . 0)
1170 (inclass . +)
1171 (statement-case-intro . +)))
1172 t))
1173
1174 ;; Declare C# fontification style.
1175
1176 (defun mdw-fontify-csharp ()
1177
1178 ;; Other stuff.
1179 (mdw-csharp-style)
1180 (setq c-hanging-comment-ender-p nil)
1181 (setq c-backslash-column 72)
1182 (setq comment-start "/* ")
1183 (setq comment-end " */")
1184 (setq mdw-fill-prefix
1185 `((,(concat "\\([ \t]*/?\\)"
1186 "\\([\*/][ \t]*\\)"
1187 "\\([A-Za-z]+:[ \t]*\\)?"
1188 mdw-hanging-indents)
1189 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1190
1191 ;; Now define things to be fontified.
1192 (make-local-variable 'font-lock-keywords)
1193 (let ((csharp-keywords
1194 (mdw-regexps "abstract" "as" "base" "bool" "break"
1195 "byte" "case" "catch" "char" "checked"
1196 "class" "const" "continue" "decimal" "default"
1197 "delegate" "do" "double" "else" "enum"
1198 "event" "explicit" "extern" "false" "finally"
1199 "fixed" "float" "for" "foreach" "goto"
1200 "if" "implicit" "in" "int" "interface"
1201 "internal" "is" "lock" "long" "namespace"
1202 "new" "null" "object" "operator" "out"
1203 "override" "params" "private" "protected" "public"
1204 "readonly" "ref" "return" "sbyte" "sealed"
1205 "short" "sizeof" "stackalloc" "static" "string"
1206 "struct" "switch" "this" "throw" "true"
1207 "try" "typeof" "uint" "ulong" "unchecked"
1208 "unsafe" "ushort" "using" "virtual" "void"
1209 "volatile" "while" "yield")))
1210
1211 (setq font-lock-keywords
1212 (list
1213
1214 ;; Handle the keywords defined above.
1215 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1216 '(0 font-lock-keyword-face))
1217
1218 ;; Handle numbers too.
1219 ;;
1220 ;; The following isn't quite right, but it's close enough.
1221 (list (concat "\\<\\("
1222 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1223 "[0-9]+\\(\\.[0-9]*\\|\\)"
1224 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1225 "[lLfFdD]?")
1226 '(0 mdw-number-face))
1227
1228 ;; And anything else is punctuation.
1229 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1230 '(0 mdw-punct-face))))))
1231
1232 (defun csharp-mode ()
1233 (interactive)
1234 (java-mode)
1235 (setq major-mode 'csharp-mode)
1236 (setq mode-name "C#")
1237 (mdw-fontify-csharp)
1238 (run-hooks 'csharp-mode-hook))
1239
1240 ;;;--------------------------------------------------------------------------
1241 ;;; Awk programming configuration.
1242
1243 ;; Make Awk indentation nice.
1244
1245 (defun mdw-awk-style ()
1246 (c-add-style "[mdw] Awk style"
1247 '((c-basic-offset . 2)
1248 (c-offsets-alist (substatement-open . 0)
1249 (statement-cont . 0)
1250 (statement-case-intro . +)))
1251 t))
1252
1253 ;; Declare Awk fontification style.
1254
1255 (defun mdw-fontify-awk ()
1256
1257 ;; Miscellaneous fiddling.
1258 (mdw-awk-style)
1259 (setq c-backslash-column 72)
1260 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1261
1262 ;; Now define things to be fontified.
1263 (make-local-variable 'font-lock-keywords)
1264 (let ((c-keywords
1265 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1266 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1267 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1268 "RSTART" "RLENGTH" "RT" "SUBSEP"
1269 "atan2" "break" "close" "continue" "cos" "delete"
1270 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1271 "function" "gensub" "getline" "gsub" "if" "in"
1272 "index" "int" "length" "log" "match" "next" "rand"
1273 "return" "print" "printf" "sin" "split" "sprintf"
1274 "sqrt" "srand" "strftime" "sub" "substr" "system"
1275 "systime" "tolower" "toupper" "while")))
1276
1277 (setq font-lock-keywords
1278 (list
1279
1280 ;; Handle the keywords defined above.
1281 (list (concat "\\<\\(" c-keywords "\\)\\>")
1282 '(0 font-lock-keyword-face))
1283
1284 ;; Handle numbers too.
1285 ;;
1286 ;; The following isn't quite right, but it's close enough.
1287 (list (concat "\\<\\("
1288 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1289 "[0-9]+\\(\\.[0-9]*\\|\\)"
1290 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1291 "[uUlL]*")
1292 '(0 mdw-number-face))
1293
1294 ;; And anything else is punctuation.
1295 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1296 '(0 mdw-punct-face))))))
1297
1298 ;;;--------------------------------------------------------------------------
1299 ;;; Perl programming style.
1300
1301 ;; Perl indentation style.
1302
1303 (setq cperl-indent-level 2)
1304 (setq cperl-continued-statement-offset 2)
1305 (setq cperl-continued-brace-offset 0)
1306 (setq cperl-brace-offset -2)
1307 (setq cperl-brace-imaginary-offset 0)
1308 (setq cperl-label-offset 0)
1309
1310 ;; Define perl fontification style.
1311
1312 (defun mdw-fontify-perl ()
1313
1314 ;; Miscellaneous fiddling.
1315 (modify-syntax-entry ?$ "\\")
1316 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1317 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1318
1319 ;; Now define fontification things.
1320 (make-local-variable 'font-lock-keywords)
1321 (let ((perl-keywords
1322 (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1323 "for" "foreach" "ge" "gt" "goto" "if"
1324 "last" "le" "lt" "local" "my" "ne" "next" "or"
1325 "package" "redo" "require" "return" "sub"
1326 "undef" "unless" "until" "use" "while")))
1327
1328 (setq font-lock-keywords
1329 (list
1330
1331 ;; Set up the keywords defined above.
1332 (list (concat "\\<\\(" perl-keywords "\\)\\>")
1333 '(0 font-lock-keyword-face))
1334
1335 ;; At least numbers are simpler than C.
1336 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1337 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1338 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1339 '(0 mdw-number-face))
1340
1341 ;; And anything else is punctuation.
1342 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1343 '(0 mdw-punct-face))))))
1344
1345 (defun perl-number-tests (&optional arg)
1346 "Assign consecutive numbers to lines containing `#t'. With ARG,
1347 strip numbers instead."
1348 (interactive "P")
1349 (save-excursion
1350 (goto-char (point-min))
1351 (let ((i 0) (fmt (if arg "" " %4d")))
1352 (while (search-forward "#t" nil t)
1353 (delete-region (point) (line-end-position))
1354 (setq i (1+ i))
1355 (insert (format fmt i)))
1356 (goto-char (point-min))
1357 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1358 (replace-match (format "\\1%d" i))))))
1359
1360 ;;;--------------------------------------------------------------------------
1361 ;;; Python programming style.
1362
1363 ;; Define Python fontification style.
1364
1365 (defun mdw-fontify-python ()
1366
1367 ;; Miscellaneous fiddling.
1368 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1369
1370 ;; Now define fontification things.
1371 (make-local-variable 'font-lock-keywords)
1372 (let ((python-keywords
1373 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1374 "del" "elif" "else" "except" "exec" "finally" "for"
1375 "from" "global" "if" "import" "in" "is" "lambda"
1376 "not" "or" "pass" "print" "raise" "return" "try"
1377 "while" "with" "yield")))
1378 (setq font-lock-keywords
1379 (list
1380
1381 ;; Set up the keywords defined above.
1382 (list (concat "\\<\\(" python-keywords "\\)\\>")
1383 '(0 font-lock-keyword-face))
1384
1385 ;; At least numbers are simpler than C.
1386 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1387 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1388 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1389 '(0 mdw-number-face))
1390
1391 ;; And anything else is punctuation.
1392 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1393 '(0 mdw-punct-face))))))
1394
1395 ;;;--------------------------------------------------------------------------
1396 ;;; Icon programming style.
1397
1398 ;; Icon indentation style.
1399
1400 (setq icon-brace-offset 0
1401 icon-continued-brace-offset 0
1402 icon-continued-statement-offset 2
1403 icon-indent-level 2)
1404
1405 ;; Define Icon fontification style.
1406
1407 (defun mdw-fontify-icon ()
1408
1409 ;; Miscellaneous fiddling.
1410 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1411
1412 ;; Now define fontification things.
1413 (make-local-variable 'font-lock-keywords)
1414 (let ((icon-keywords
1415 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1416 "end" "every" "fail" "global" "if" "initial"
1417 "invocable" "link" "local" "next" "not" "of"
1418 "procedure" "record" "repeat" "return" "static"
1419 "suspend" "then" "to" "until" "while"))
1420 (preprocessor-keywords
1421 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1422 "include" "line" "undef")))
1423 (setq font-lock-keywords
1424 (list
1425
1426 ;; Set up the keywords defined above.
1427 (list (concat "\\<\\(" icon-keywords "\\)\\>")
1428 '(0 font-lock-keyword-face))
1429
1430 ;; The things that Icon calls keywords.
1431 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1432
1433 ;; At least numbers are simpler than C.
1434 (list (concat "\\<[0-9]+"
1435 "\\([rR][0-9a-zA-Z]+\\|"
1436 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1437 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1438 '(0 mdw-number-face))
1439
1440 ;; Preprocessor.
1441 (list (concat "^[ \t]*$[ \t]*\\<\\("
1442 preprocessor-keywords
1443 "\\)\\>")
1444 '(0 font-lock-keyword-face))
1445
1446 ;; And anything else is punctuation.
1447 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1448 '(0 mdw-punct-face))))))
1449
1450 ;;;--------------------------------------------------------------------------
1451 ;;; ARM assembler programming configuration.
1452
1453 ;; There doesn't appear to be an Emacs mode for this yet.
1454 ;;
1455 ;; Better do something about that, I suppose.
1456
1457 (defvar arm-assembler-mode-map nil)
1458 (defvar arm-assembler-abbrev-table nil)
1459 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1460
1461 (or arm-assembler-mode-map
1462 (progn
1463 (setq arm-assembler-mode-map (make-sparse-keymap))
1464 (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1465 (define-key arm-assembler-mode-map [C-return] 'newline)
1466 (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1467
1468 (defun arm-assembler-mode ()
1469 "Major mode for ARM assembler programs"
1470 (interactive)
1471
1472 ;; Do standard major mode things.
1473 (kill-all-local-variables)
1474 (use-local-map arm-assembler-mode-map)
1475 (setq local-abbrev-table arm-assembler-abbrev-table)
1476 (setq major-mode 'arm-assembler-mode)
1477 (setq mode-name "ARM assembler")
1478
1479 ;; Set up syntax table.
1480 (set-syntax-table arm-assembler-mode-syntax-table)
1481 (modify-syntax-entry ?; ; Nasty hack
1482 "<" arm-assembler-mode-syntax-table)
1483 (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1484 (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1485
1486 (make-local-variable 'comment-start)
1487 (setq comment-start ";")
1488 (make-local-variable 'comment-end)
1489 (setq comment-end "")
1490 (make-local-variable 'comment-column)
1491 (setq comment-column 48)
1492 (make-local-variable 'comment-start-skip)
1493 (setq comment-start-skip ";+[ \t]*")
1494
1495 ;; Play with indentation.
1496 (make-local-variable 'indent-line-function)
1497 (setq indent-line-function 'indent-relative-maybe)
1498
1499 ;; Set fill prefix.
1500 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1501
1502 ;; Fiddle with fontification.
1503 (make-local-variable 'font-lock-keywords)
1504 (setq font-lock-keywords
1505 (list
1506
1507 ;; Handle numbers too.
1508 ;;
1509 ;; The following isn't quite right, but it's close enough.
1510 (list (concat "\\("
1511 "&[0-9a-fA-F]+\\|"
1512 "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1513 "\\)")
1514 '(0 mdw-number-face))
1515
1516 ;; Do something about operators.
1517 (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1518 '(1 font-lock-keyword-face)
1519 '(2 font-lock-string-face))
1520 (list ":[a-zA-Z]+:"
1521 '(0 font-lock-keyword-face))
1522
1523 ;; Do menemonics and directives.
1524 (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1525 '(1 font-lock-keyword-face))
1526
1527 ;; And anything else is punctuation.
1528 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1529 '(0 mdw-punct-face))))
1530
1531 (run-hooks 'arm-assembler-mode-hook))
1532
1533 ;;;--------------------------------------------------------------------------
1534 ;;; Assembler mode.
1535
1536 (defun mdw-fontify-asm ()
1537 (modify-syntax-entry ?' "\"")
1538 (modify-syntax-entry ?. "w")
1539 (setf fill-prefix nil)
1540 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1541
1542 ;;;--------------------------------------------------------------------------
1543 ;;; TCL configuration.
1544
1545 (defun mdw-fontify-tcl ()
1546 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1547 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1548 (make-local-variable 'font-lock-keywords)
1549 (setq font-lock-keywords
1550 (list
1551 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1552 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1553 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1554 '(0 mdw-number-face))
1555 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1556 '(0 mdw-punct-face)))))
1557
1558 ;;;--------------------------------------------------------------------------
1559 ;;; REXX configuration.
1560
1561 (defun mdw-rexx-electric-* ()
1562 (interactive)
1563 (insert ?*)
1564 (rexx-indent-line))
1565
1566 (defun mdw-rexx-indent-newline-indent ()
1567 (interactive)
1568 (rexx-indent-line)
1569 (if abbrev-mode (expand-abbrev))
1570 (newline-and-indent))
1571
1572 (defun mdw-fontify-rexx ()
1573
1574 ;; Various bits of fiddling.
1575 (setq mdw-auto-indent nil)
1576 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1577 (local-set-key [?*] 'mdw-rexx-electric-*)
1578 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1579 '(?! ?? ?# ?@ ?$))
1580 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1581
1582 ;; Set up keywords and things for fontification.
1583 (make-local-variable 'font-lock-keywords-case-fold-search)
1584 (setq font-lock-keywords-case-fold-search t)
1585
1586 (setq rexx-indent 2)
1587 (setq rexx-end-indent rexx-indent)
1588 (setq rexx-cont-indent rexx-indent)
1589
1590 (make-local-variable 'font-lock-keywords)
1591 (let ((rexx-keywords
1592 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1593 "else" "end" "engineering" "exit" "expose" "for"
1594 "forever" "form" "fuzz" "if" "interpret" "iterate"
1595 "leave" "linein" "name" "nop" "numeric" "off" "on"
1596 "options" "otherwise" "parse" "procedure" "pull"
1597 "push" "queue" "return" "say" "select" "signal"
1598 "scientific" "source" "then" "trace" "to" "until"
1599 "upper" "value" "var" "version" "when" "while"
1600 "with"
1601
1602 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1603 "center" "center" "charin" "charout" "chars"
1604 "compare" "condition" "copies" "c2d" "c2x"
1605 "datatype" "date" "delstr" "delword" "d2c" "d2x"
1606 "errortext" "format" "fuzz" "insert" "lastpos"
1607 "left" "length" "lineout" "lines" "max" "min"
1608 "overlay" "pos" "queued" "random" "reverse" "right"
1609 "sign" "sourceline" "space" "stream" "strip"
1610 "substr" "subword" "symbol" "time" "translate"
1611 "trunc" "value" "verify" "word" "wordindex"
1612 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1613 "x2d")))
1614
1615 (setq font-lock-keywords
1616 (list
1617
1618 ;; Set up the keywords defined above.
1619 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1620 '(0 font-lock-keyword-face))
1621
1622 ;; Fontify all symbols the same way.
1623 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1624 "[A-Za-z0-9.!?_#@$]+\\)")
1625 '(0 font-lock-variable-name-face))
1626
1627 ;; And everything else is punctuation.
1628 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1629 '(0 mdw-punct-face))))))
1630
1631 ;;;--------------------------------------------------------------------------
1632 ;;; Standard ML programming style.
1633
1634 (defun mdw-fontify-sml ()
1635
1636 ;; Make underscore an honorary letter.
1637 (modify-syntax-entry ?' "w")
1638
1639 ;; Set fill prefix.
1640 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1641
1642 ;; Now define fontification things.
1643 (make-local-variable 'font-lock-keywords)
1644 (let ((sml-keywords
1645 (mdw-regexps "abstype" "and" "andalso" "as"
1646 "case"
1647 "datatype" "do"
1648 "else" "end" "eqtype" "exception"
1649 "fn" "fun" "functor"
1650 "handle"
1651 "if" "in" "include" "infix" "infixr"
1652 "let" "local"
1653 "nonfix"
1654 "of" "op" "open" "orelse"
1655 "raise" "rec"
1656 "sharing" "sig" "signature" "struct" "structure"
1657 "then" "type"
1658 "val"
1659 "where" "while" "with" "withtype")))
1660
1661 (setq font-lock-keywords
1662 (list
1663
1664 ;; Set up the keywords defined above.
1665 (list (concat "\\<\\(" sml-keywords "\\)\\>")
1666 '(0 font-lock-keyword-face))
1667
1668 ;; At least numbers are simpler than C.
1669 (list (concat "\\<\\(\\~\\|\\)"
1670 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1671 "[wW][0-9]+\\)\\|"
1672 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1673 "\\([eE]\\(\\~\\|\\)"
1674 "[0-9]+\\|\\)\\)\\)")
1675 '(0 mdw-number-face))
1676
1677 ;; And anything else is punctuation.
1678 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1679 '(0 mdw-punct-face))))))
1680
1681 ;;;--------------------------------------------------------------------------
1682 ;;; Haskell configuration.
1683
1684 (defun mdw-fontify-haskell ()
1685
1686 ;; Fiddle with syntax table to get comments right.
1687 (modify-syntax-entry ?' "\"")
1688 (modify-syntax-entry ?- ". 123")
1689 (modify-syntax-entry ?{ ". 1b")
1690 (modify-syntax-entry ?} ". 4b")
1691 (modify-syntax-entry ?\n ">")
1692
1693 ;; Set fill prefix.
1694 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1695
1696 ;; Fiddle with fontification.
1697 (make-local-variable 'font-lock-keywords)
1698 (let ((haskell-keywords
1699 (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1700 "deriving" "do" "else" "foreign" "hiding" "if"
1701 "import" "in" "infix" "infixl" "infixr" "instance"
1702 "let" "module" "newtype" "of" "qualified" "safe"
1703 "stdcall" "then" "type" "unsafe" "where")))
1704
1705 (setq font-lock-keywords
1706 (list
1707 (list "--.*$"
1708 '(0 font-lock-comment-face))
1709 (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1710 '(0 font-lock-keyword-face))
1711 (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1712 "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1713 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1714 '(0 mdw-number-face))
1715 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1716 '(0 mdw-punct-face))))))
1717
1718 ;;;--------------------------------------------------------------------------
1719 ;;; Erlang configuration.
1720
1721 (setq erlang-electric-commannds
1722 '(erlang-electric-newline erlang-electric-semicolon))
1723
1724 (defun mdw-fontify-erlang ()
1725
1726 ;; Set fill prefix.
1727 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1728
1729 ;; Fiddle with fontification.
1730 (make-local-variable 'font-lock-keywords)
1731 (let ((erlang-keywords
1732 (mdw-regexps "after" "and" "andalso"
1733 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1734 "case" "catch" "cond"
1735 "div" "end" "fun" "if" "let" "not"
1736 "of" "or" "orelse"
1737 "query" "receive" "rem" "try" "when" "xor")))
1738
1739 (setq font-lock-keywords
1740 (list
1741 (list "%.*$"
1742 '(0 font-lock-comment-face))
1743 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1744 '(0 font-lock-keyword-face))
1745 (list (concat "^-\\sw+\\>")
1746 '(0 font-lock-keyword-face))
1747 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1748 '(0 mdw-number-face))
1749 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1750 '(0 mdw-punct-face))))))
1751
1752 ;;;--------------------------------------------------------------------------
1753 ;;; Texinfo configuration.
1754
1755 (defun mdw-fontify-texinfo ()
1756
1757 ;; Set fill prefix.
1758 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1759
1760 ;; Real fontification things.
1761 (make-local-variable 'font-lock-keywords)
1762 (setq font-lock-keywords
1763 (list
1764
1765 ;; Environment names are keywords.
1766 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
1767 '(2 font-lock-keyword-face))
1768
1769 ;; Unmark escaped magic characters.
1770 (list "\\(@\\)\\([@{}]\\)"
1771 '(1 font-lock-keyword-face)
1772 '(2 font-lock-variable-name-face))
1773
1774 ;; Make sure we get comments properly.
1775 (list "@c\\(\\|omment\\)\\( .*\\)?$"
1776 '(0 font-lock-comment-face))
1777
1778 ;; Command names are keywords.
1779 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1780 '(0 font-lock-keyword-face))
1781
1782 ;; Fontify TeX special characters as punctuation.
1783 (list "[{}]+"
1784 '(0 mdw-punct-face)))))
1785
1786 ;;;--------------------------------------------------------------------------
1787 ;;; TeX and LaTeX configuration.
1788
1789 (defun mdw-fontify-tex ()
1790 (setq ispell-parser 'tex)
1791 (turn-on-reftex)
1792
1793 ;; Don't make maths into a string.
1794 (modify-syntax-entry ?$ ".")
1795 (modify-syntax-entry ?$ "." font-lock-syntax-table)
1796 (local-set-key [?$] 'self-insert-command)
1797
1798 ;; Set fill prefix.
1799 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1800
1801 ;; Real fontification things.
1802 (make-local-variable 'font-lock-keywords)
1803 (setq font-lock-keywords
1804 (list
1805
1806 ;; Environment names are keywords.
1807 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1808 "{\\([^}\n]*\\)}")
1809 '(2 font-lock-keyword-face))
1810
1811 ;; Suspended environment names are keywords too.
1812 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1813 "{\\([^}\n]*\\)}")
1814 '(3 font-lock-keyword-face))
1815
1816 ;; Command names are keywords.
1817 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1818 '(0 font-lock-keyword-face))
1819
1820 ;; Handle @/.../ for italics.
1821 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1822 ;; '(1 font-lock-keyword-face)
1823 ;; '(3 font-lock-keyword-face))
1824
1825 ;; Handle @*...* for boldness.
1826 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1827 ;; '(1 font-lock-keyword-face)
1828 ;; '(3 font-lock-keyword-face))
1829
1830 ;; Handle @`...' for literal syntax things.
1831 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1832 ;; '(1 font-lock-keyword-face)
1833 ;; '(3 font-lock-keyword-face))
1834
1835 ;; Handle @<...> for nonterminals.
1836 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1837 ;; '(1 font-lock-keyword-face)
1838 ;; '(3 font-lock-keyword-face))
1839
1840 ;; Handle other @-commands.
1841 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1842 ;; '(0 font-lock-keyword-face))
1843
1844 ;; Make sure we get comments properly.
1845 (list "%.*"
1846 '(0 font-lock-comment-face))
1847
1848 ;; Fontify TeX special characters as punctuation.
1849 (list "[$^_{}#&]"
1850 '(0 mdw-punct-face)))))
1851
1852 ;;;--------------------------------------------------------------------------
1853 ;;; SGML hacking.
1854
1855 (defun mdw-sgml-mode ()
1856 (interactive)
1857 (sgml-mode)
1858 (mdw-standard-fill-prefix "")
1859 (make-variable-buffer-local 'sgml-delimiters)
1860 (setq sgml-delimiters
1861 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1862 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1863 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1864 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1865 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1866 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1867 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1868 "NULL" ""))
1869 (setq major-mode 'mdw-sgml-mode)
1870 (setq mode-name "[mdw] SGML")
1871 (run-hooks 'mdw-sgml-mode-hook))
1872
1873 ;;;--------------------------------------------------------------------------
1874 ;;; Shell scripts.
1875
1876 (defun mdw-setup-sh-script-mode ()
1877
1878 ;; Fetch the shell interpreter's name.
1879 (let ((shell-name sh-shell-file))
1880
1881 ;; Try reading the hash-bang line.
1882 (save-excursion
1883 (goto-char (point-min))
1884 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1885 (setq shell-name (match-string 1))))
1886
1887 ;; Now try to set the shell.
1888 ;;
1889 ;; Don't let `sh-set-shell' bugger up my script.
1890 (let ((executable-set-magic #'(lambda (s &rest r) s)))
1891 (sh-set-shell shell-name)))
1892
1893 ;; Now enable my keys and the fontification.
1894 (mdw-misc-mode-config)
1895
1896 ;; Set the indentation level correctly.
1897 (setq sh-indentation 2)
1898 (setq sh-basic-offset 2))
1899
1900 ;;;--------------------------------------------------------------------------
1901 ;;; Messages-file mode.
1902
1903 (defun messages-mode-guts ()
1904 (setq messages-mode-syntax-table (make-syntax-table))
1905 (set-syntax-table messages-mode-syntax-table)
1906 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1907 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1908 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1909 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1910 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1911 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1912 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1913 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1914 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1915 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1916 (make-local-variable 'comment-start)
1917 (make-local-variable 'comment-end)
1918 (make-local-variable 'indent-line-function)
1919 (setq indent-line-function 'indent-relative)
1920 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1921 (make-local-variable 'font-lock-defaults)
1922 (make-local-variable 'messages-mode-keywords)
1923 (let ((keywords
1924 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1925 "export" "enum" "fixed-octetstring" "flags"
1926 "harmless" "map" "nested" "optional"
1927 "optional-tagged" "package" "primitive"
1928 "primitive-nullfree" "relaxed[ \t]+enum"
1929 "set" "table" "tagged-optional" "union"
1930 "variadic" "vector" "version" "version-tag")))
1931 (setq messages-mode-keywords
1932 (list
1933 (list (concat "\\<\\(" keywords "\\)\\>:")
1934 '(0 font-lock-keyword-face))
1935 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1936 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1937 (0 font-lock-variable-name-face))
1938 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1939 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1940 (0 mdw-punct-face)))))
1941 (setq font-lock-defaults
1942 '(messages-mode-keywords nil nil nil nil))
1943 (run-hooks 'messages-file-hook))
1944
1945 (defun messages-mode ()
1946 (interactive)
1947 (fundamental-mode)
1948 (setq major-mode 'messages-mode)
1949 (setq mode-name "Messages")
1950 (messages-mode-guts)
1951 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1952 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1953 (setq comment-start "# ")
1954 (setq comment-end "")
1955 (turn-on-font-lock-if-enabled)
1956 (run-hooks 'messages-mode-hook))
1957
1958 (defun cpp-messages-mode ()
1959 (interactive)
1960 (fundamental-mode)
1961 (setq major-mode 'cpp-messages-mode)
1962 (setq mode-name "CPP Messages")
1963 (messages-mode-guts)
1964 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1965 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1966 (setq comment-start "/* ")
1967 (setq comment-end " */")
1968 (let ((preprocessor-keywords
1969 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1970 "ident" "if" "ifdef" "ifndef" "import" "include"
1971 "line" "pragma" "unassert" "undef" "warning")))
1972 (setq messages-mode-keywords
1973 (append (list (list (concat "^[ \t]*\\#[ \t]*"
1974 "\\(include\\|import\\)"
1975 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1976 '(2 font-lock-string-face))
1977 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1978 preprocessor-keywords
1979 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1980 '(1 font-lock-keyword-face)))
1981 messages-mode-keywords)))
1982 (turn-on-font-lock-if-enabled)
1983 (run-hooks 'cpp-messages-mode-hook))
1984
1985 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
1986 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
1987 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
1988
1989 ;;;--------------------------------------------------------------------------
1990 ;;; Messages-file mode.
1991
1992 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
1993 "Face to use for subsittution directives.")
1994 (make-face 'mallow-driver-substitution-face)
1995 (defvar mallow-driver-text-face 'mallow-driver-text-face
1996 "Face to use for body text.")
1997 (make-face 'mallow-driver-text-face)
1998
1999 (defun mallow-driver-mode ()
2000 (interactive)
2001 (fundamental-mode)
2002 (setq major-mode 'mallow-driver-mode)
2003 (setq mode-name "Mallow driver")
2004 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2005 (set-syntax-table mallow-driver-mode-syntax-table)
2006 (make-local-variable 'comment-start)
2007 (make-local-variable 'comment-end)
2008 (make-local-variable 'indent-line-function)
2009 (setq indent-line-function 'indent-relative)
2010 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2011 (make-local-variable 'font-lock-defaults)
2012 (make-local-variable 'mallow-driver-mode-keywords)
2013 (let ((keywords
2014 (mdw-regexps "each" "divert" "file" "if"
2015 "perl" "set" "string" "type" "write")))
2016 (setq mallow-driver-mode-keywords
2017 (list
2018 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2019 '(0 font-lock-keyword-face))
2020 (list "^%\\s *\\(#.*\\|\\)$"
2021 '(0 font-lock-comment-face))
2022 (list "^%"
2023 '(0 font-lock-keyword-face))
2024 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2025 (list "\\${[^}]*}"
2026 '(0 mallow-driver-substitution-face t)))))
2027 (setq font-lock-defaults
2028 '(mallow-driver-mode-keywords nil nil nil nil))
2029 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2030 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2031 (setq comment-start "%# ")
2032 (setq comment-end "")
2033 (turn-on-font-lock-if-enabled)
2034 (run-hooks 'mallow-driver-mode-hook))
2035
2036 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2037
2038 ;;;--------------------------------------------------------------------------
2039 ;;; NFast debugs.
2040
2041 (defun nfast-debug-mode ()
2042 (interactive)
2043 (fundamental-mode)
2044 (setq major-mode 'nfast-debug-mode)
2045 (setq mode-name "NFast debug")
2046 (setq messages-mode-syntax-table (make-syntax-table))
2047 (set-syntax-table messages-mode-syntax-table)
2048 (make-local-variable 'font-lock-defaults)
2049 (make-local-variable 'nfast-debug-mode-keywords)
2050 (setq truncate-lines t)
2051 (setq nfast-debug-mode-keywords
2052 (list
2053 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2054 (0 font-lock-keyword-face))
2055 (list (concat "^[ \t]+\\(\\("
2056 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2057 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2058 "[ \t]+\\)*"
2059 "[0-9a-fA-F]+\\)[ \t]*$")
2060 '(0 mdw-number-face))
2061 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2062 (1 font-lock-keyword-face))
2063 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2064 (1 font-lock-warning-face))
2065 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2066 (1 nil))
2067 (list (concat "^[ \t]+\\.cmd=[ \t]+"
2068 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2069 '(1 font-lock-keyword-face))
2070 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2071 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2072 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2073 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2074 (setq font-lock-defaults
2075 '(nfast-debug-mode-keywords nil nil nil nil))
2076 (turn-on-font-lock-if-enabled)
2077 (run-hooks 'nfast-debug-mode-hook))
2078
2079 ;;;--------------------------------------------------------------------------
2080 ;;; Other languages.
2081
2082 ;; Smalltalk.
2083
2084 (defun mdw-setup-smalltalk ()
2085 (and mdw-auto-indent
2086 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2087 (make-variable-buffer-local 'mdw-auto-indent)
2088 (setq mdw-auto-indent nil)
2089 (local-set-key "\C-i" 'smalltalk-reindent))
2090
2091 (defun mdw-fontify-smalltalk ()
2092 (make-local-variable 'font-lock-keywords)
2093 (setq font-lock-keywords
2094 (list
2095 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2096 '(0 font-lock-keyword-face))
2097 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2098 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2099 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2100 '(0 mdw-number-face))
2101 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2102 '(0 mdw-punct-face)))))
2103
2104 ;; Lispy languages.
2105
2106 ;; Unpleasant bodge.
2107 (unless (boundp 'slime-repl-mode-map)
2108 (setq slime-repl-mode-map (make-sparse-keymap)))
2109
2110 (defun mdw-indent-newline-and-indent ()
2111 (interactive)
2112 (indent-for-tab-command)
2113 (newline-and-indent))
2114
2115 (eval-after-load "cl-indent"
2116 '(progn
2117 (mapc #'(lambda (pair)
2118 (put (car pair)
2119 'common-lisp-indent-function
2120 (cdr pair)))
2121 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2122 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2123
2124 (defun mdw-common-lisp-indent ()
2125 (make-variable-buffer-local 'lisp-indent-function)
2126 (setq lisp-indent-function 'common-lisp-indent-function))
2127
2128 (setq lisp-simple-loop-indentation 2
2129 lisp-loop-keyword-indentation 6
2130 lisp-loop-forms-indentation 6)
2131
2132 (defun mdw-fontify-lispy ()
2133
2134 ;; Set fill prefix.
2135 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2136
2137 ;; Not much fontification needed.
2138 (make-local-variable 'font-lock-keywords)
2139 (setq font-lock-keywords
2140 (list
2141 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2142 '(0 mdw-punct-face)))))
2143
2144 (defun comint-send-and-indent ()
2145 (interactive)
2146 (comint-send-input)
2147 (and mdw-auto-indent
2148 (indent-for-tab-command)))
2149
2150 (defun mdw-setup-m4 ()
2151 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2152
2153 ;;;--------------------------------------------------------------------------
2154 ;;; Text mode.
2155
2156 (defun mdw-text-mode ()
2157 (setq fill-column 72)
2158 (flyspell-mode t)
2159 (mdw-standard-fill-prefix
2160 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2161 (auto-fill-mode 1))
2162
2163 ;;;--------------------------------------------------------------------------
2164 ;;; Outline mode.
2165
2166 (defun mdw-outline-collapse-all ()
2167 "Completely collapse everything in the entire buffer."
2168 (interactive)
2169 (save-excursion
2170 (goto-char (point-min))
2171 (while (< (point) (point-max))
2172 (hide-subtree)
2173 (forward-line))))
2174
2175 ;;;--------------------------------------------------------------------------
2176 ;;; Shell mode.
2177
2178 (defun mdw-sh-mode-setup ()
2179 (local-set-key [?\C-a] 'comint-bol)
2180 (add-hook 'comint-output-filter-functions
2181 'comint-watch-for-password-prompt))
2182
2183 (defun mdw-term-mode-setup ()
2184 (setq term-prompt-regexp shell-prompt-pattern)
2185 (make-local-variable 'mouse-yank-at-point)
2186 (make-local-variable 'transient-mark-mode)
2187 (setq mouse-yank-at-point t)
2188 (auto-fill-mode -1)
2189 (setq tab-width 8))
2190
2191 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2192 (defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
2193 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2194 (defun term-send-meta-meta-something ()
2195 (interactive)
2196 (term-send-raw-string "\e\e")
2197 (term-send-raw))
2198 (eval-after-load 'term
2199 '(progn
2200 (define-key term-raw-map [?\e ?\e] nil)
2201 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2202 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2203 (define-key term-raw-map [M-right] 'term-send-meta-right)
2204 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2205 (define-key term-raw-map [M-left] 'term-send-meta-left)
2206 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2207
2208 ;;;----- That's all, folks --------------------------------------------------
2209
2210 (provide 'dot-emacs)