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