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