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