el/dot-emacs.el: Better highlighting of M-x occur matches.
[profile] / el / dot-emacs.el
1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
2 ;;;
3 ;;; Functions and macros for .emacs
4 ;;;
5 ;;; (c) 2004 Mark Wooding
6 ;;;
7
8 ;;;----- Licensing notice ---------------------------------------------------
9 ;;;
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
14 ;;;
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
19 ;;;
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software Foundation,
22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23
24 ;;;--------------------------------------------------------------------------
25 ;;; Check command-line.
26
27 (defvar mdw-fast-startup nil
28 "Whether .emacs should optimize for rapid startup.
29 This may be at the expense of cool features.")
30 (let ((probe nil) (next command-line-args))
31 (while next
32 (cond ((string= (car next) "--mdw-fast-startup")
33 (setq mdw-fast-startup t)
34 (if probe
35 (rplacd probe (cdr next))
36 (setq command-line-args (cdr next))))
37 (t
38 (setq probe next)))
39 (setq next (cdr next))))
40
41 ;;;--------------------------------------------------------------------------
42 ;;; Some general utilities.
43
44 (eval-when-compile
45 (unless (fboundp 'make-regexp)
46 (load "make-regexp"))
47 (require 'cl))
48
49 (defmacro mdw-regexps (&rest list)
50 "Turn a LIST of strings into a single regular expression at compile-time."
51 (declare (indent nil)
52 (debug 0))
53 `',(make-regexp list))
54
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 (declare (indent 0)
63 (debug t))
64 `(condition-case err
65 ,(if (cdr forms) (cons 'progn forms) (car forms))
66 (error (message "Error (trapped): %s in %s"
67 (error-message-string err)
68 ',forms))))
69
70 ;; Configuration reading.
71
72 (defvar mdw-config nil)
73 (defun mdw-config (sym)
74 "Read the configuration variable named SYM."
75 (unless mdw-config
76 (setq mdw-config
77 (flet ((replace (what with)
78 (goto-char (point-min))
79 (while (re-search-forward what nil t)
80 (replace-match with t))))
81 (with-temp-buffer
82 (insert-file-contents "~/.mdw.conf")
83 (replace "^[ \t]*\\(#.*\\|\\)\n" "")
84 (replace (concat "^[ \t]*"
85 "\\([-a-zA-Z0-9_.]*\\)"
86 "[ \t]*=[ \t]*"
87 "\\(.*[^ \t\n]\\|\\)"
88 "[ \t]**\\(\n\\|$\\)")
89 "(\\1 . \"\\2\")\n")
90 (car (read-from-string
91 (concat "(" (buffer-string) ")")))))))
92 (cdr (assq sym mdw-config)))
93
94 ;; Set up the load path convincingly.
95
96 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
97 (list (concat "/usr/share/"
98 (symbol-name debian-emacs-flavor)
99 "/site-lisp")))))
100 (dolist (sub (directory-files dir t))
101 (when (and (file-accessible-directory-p sub)
102 (not (member sub load-path)))
103 (setq load-path (nconc load-path (list sub))))))
104
105 ;; Is an Emacs library available?
106
107 (defun library-exists-p (name)
108 "Return non-nil if NAME is an available library.
109 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
110 load path. The non-nil value is the filename we found for the
111 library."
112 (let ((path load-path) elt (foundp nil))
113 (while (and path (not foundp))
114 (setq elt (car path))
115 (setq path (cdr path))
116 (setq foundp (or (let ((file (concat elt "/" name ".elc")))
117 (and (file-exists-p file) file))
118 (let ((file (concat elt "/" name ".el")))
119 (and (file-exists-p file) file)))))
120 foundp))
121
122 (defun maybe-autoload (symbol file &optional docstring interactivep type)
123 "Set an autoload if the file actually exists."
124 (and (library-exists-p file)
125 (autoload symbol file docstring interactivep type)))
126
127 (defun mdw-kick-menu-bar (&optional frame)
128 "Regenerate FRAME's menu bar so it doesn't have empty menus."
129 (interactive)
130 (unless frame (setq frame (selected-frame)))
131 (let ((old (frame-parameter frame 'menu-bar-lines)))
132 (set-frame-parameter frame 'menu-bar-lines 0)
133 (set-frame-parameter frame 'menu-bar-lines old)))
134
135 ;; Splitting windows.
136
137 (unless (fboundp 'scroll-bar-columns)
138 (defun scroll-bar-columns (side)
139 (cond ((eq side 'left) 0)
140 (window-system 3)
141 (t 1))))
142 (unless (fboundp 'fringe-columns)
143 (defun fringe-columns (side)
144 (cond ((not window-system) 0)
145 ((eq side 'left) 1)
146 (t 2))))
147
148 (defun mdw-horizontal-window-overhead ()
149 "Computes the horizontal window overhead.
150 This is the number of columns used by fringes, scroll bars and other such
151 cruft."
152 (if (not window-system)
153 1
154 (let ((tot 0))
155 (dolist (what '(scroll-bar fringe))
156 (dolist (side '(left right))
157 (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
158 side))))
159 tot)))
160
161 (defun mdw-split-window-horizontally (&optional width)
162 "Split a window horizontally.
163 Without a numeric argument, split the window approximately in
164 half. With a numeric argument WIDTH, allocate WIDTH columns to
165 the left-hand window (if positive) or -WIDTH columns to the
166 right-hand window (if negative). Space for scroll bars and
167 fringes is not taken out of the allowance for WIDTH, unlike
168 \\[split-window-horizontally]."
169 (interactive "P")
170 (split-window-horizontally
171 (cond ((null width) nil)
172 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
173 ((< width 0) width))))
174
175 (defun mdw-divvy-window (&optional width)
176 "Split a wide window into appropriate widths."
177 (interactive "P")
178 (setq width (cond (width (prefix-numeric-value width))
179 ((and window-system
180 (>= emacs-major-version 22))
181 77)
182 (t 78)))
183 (let* ((win (selected-window))
184 (sb-width (mdw-horizontal-window-overhead))
185 (c (/ (+ (window-width) sb-width)
186 (+ width sb-width))))
187 (while (> c 1)
188 (setq c (1- c))
189 (split-window-horizontally (+ width sb-width))
190 (other-window 1))
191 (select-window win)))
192
193 ;; Don't raise windows unless I say so.
194
195 (defvar mdw-inhibit-raise-frame nil
196 "*Whether `raise-frame' should do nothing when the frame is mapped.")
197
198 (defadvice raise-frame
199 (around mdw-inhibit (&optional frame) activate compile)
200 "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
201 frame is actually mapped on the screen."
202 (if mdw-inhibit-raise-frame
203 (make-frame-visible frame)
204 ad-do-it))
205
206 (defmacro mdw-advise-to-inhibit-raise-frame (function)
207 "Advise the FUNCTION not to raise frames, even if it wants to."
208 `(defadvice ,function
209 (around mdw-inhibit-raise (&rest hunoz) activate compile)
210 "Don't raise the window unless you have to."
211 (let ((mdw-inhibit-raise-frame t))
212 ad-do-it)))
213
214 (mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
215
216 ;; Transient mark mode hacks.
217
218 (defadvice exchange-point-and-mark
219 (around mdw-highlight (&optional arg) activate compile)
220 "Maybe don't actually exchange point and mark.
221 If `transient-mark-mode' is on and the mark is inactive, then
222 just activate it. A non-trivial prefix argument will force the
223 usual behaviour. A trivial prefix argument (i.e., just C-u) will
224 activate the mark and temporarily enable `transient-mark-mode' if
225 it's currently off."
226 (cond ((or mark-active
227 (and (not transient-mark-mode) (not arg))
228 (and arg (or (not (consp arg))
229 (not (= (car arg) 4)))))
230 ad-do-it)
231 (t
232 (or transient-mark-mode (setq transient-mark-mode 'only))
233 (set-mark (mark t)))))
234
235 ;; Functions for sexp diary entries.
236
237 (defun mdw-weekday (l)
238 "Return non-nil if `date' falls on one of the days of the week in L.
239 L is a list of day numbers (from 0 to 6 for Sunday through to
240 Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
241 the date stored in `date' falls on a listed day, then the
242 function returns non-nil."
243 (let ((d (calendar-day-of-week date)))
244 (or (memq d l)
245 (memq (nth d '(sunday monday tuesday wednesday
246 thursday friday saturday)) l))))
247
248 (defun mdw-todo (&optional when)
249 "Return non-nil today, or on WHEN, whichever is later."
250 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
251 (d (calendar-absolute-from-gregorian date)))
252 (if when
253 (setq w (max w (calendar-absolute-from-gregorian
254 (cond
255 ((not european-calendar-style)
256 when)
257 ((> (car when) 100)
258 (list (nth 1 when)
259 (nth 2 when)
260 (nth 0 when)))
261 (t
262 (list (nth 1 when)
263 (nth 0 when)
264 (nth 2 when))))))))
265 (eq w d)))
266
267 ;; Fighting with Org-mode's evil key maps.
268
269 (defvar mdw-evil-keymap-keys
270 '(([S-up] . [?\C-c up])
271 ([S-down] . [?\C-c down])
272 ([S-left] . [?\C-c left])
273 ([S-right] . [?\C-c right])
274 (([M-up] [?\e up]) . [C-up])
275 (([M-down] [?\e down]) . [C-down])
276 (([M-left] [?\e left]) . [C-left])
277 (([M-right] [?\e right]) . [C-right]))
278 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
279 The value is an alist mapping evil keys (as a list, or singleton)
280 to good keys (in the same form).")
281
282 (defun mdw-clobber-evil-keymap (keymap)
283 "Replace evil key bindings in the KEYMAP.
284 Evil key bindings are defined in `mdw-evil-keymap-keys'."
285 (dolist (entry mdw-evil-keymap-keys)
286 (let ((binding nil)
287 (keys (if (listp (car entry))
288 (car entry)
289 (list (car entry))))
290 (replacements (if (listp (cdr entry))
291 (cdr entry)
292 (list (cdr entry)))))
293 (catch 'found
294 (dolist (key keys)
295 (setq binding (lookup-key keymap key))
296 (when binding
297 (throw 'found nil))))
298 (when binding
299 (dolist (key keys)
300 (define-key keymap key nil))
301 (dolist (key replacements)
302 (define-key keymap key binding))))))
303
304 (eval-after-load "org-latex"
305 '(progn
306 (push '("strayman"
307 "\\documentclass{strayman}
308 \\usepackage[utf8]{inputenc}
309 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
310 \\usepackage[T1]{fontenc}
311 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
312 ("\\section{%s}" . "\\section*{%s}")
313 ("\\subsection{%s}" . "\\subsection*{%s}")
314 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
315 ("\\paragraph{%s}" . "\\paragraph*{%s}")
316 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
317 org-export-latex-classes)))
318
319 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
320 org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
321 org-export-docbook-xslt-stylesheet
322 "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
323
324 ;; Some hacks to do with window placement.
325
326 (defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
327 "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
328 (interactive "bBuffer: ")
329 (let ((home-frame (selected-frame))
330 (buffer (get-buffer buffer-or-name))
331 (safe-buffer (get-buffer "*scratch*")))
332 (mapc (lambda (frame)
333 (or (eq frame home-frame)
334 (mapc (lambda (window)
335 (and (eq (window-buffer window) buffer)
336 (set-window-buffer window safe-buffer)))
337 (window-list frame))))
338 (frame-list))))
339
340 (defvar mdw-inhibit-walk-windows nil
341 "If non-nil, then `walk-windows' does nothing.
342 This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
343 buffers in random frames.")
344
345 (defadvice walk-windows (around mdw-inhibit activate)
346 "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
347 (and (not mdw-inhibit-walk-windows)
348 ad-do-it))
349
350 (defadvice switch-to-buffer-other-frame
351 (around mdw-always-new-frame activate)
352 "Always make a new frame.
353 Even if an existing window in some random frame looks tempting."
354 (let ((mdw-inhibit-walk-windows t)) ad-do-it))
355
356 (defadvice display-buffer (before mdw-inhibit-other-frames activate)
357 "Don't try to do anything fancy with other frames.
358 Pretend they don't exist. They might be on other display devices."
359 (ad-set-arg 2 nil))
360
361 ;;;--------------------------------------------------------------------------
362 ;;; Mail and news hacking.
363
364 (define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
365 "Major mode for editing news and mail messages from external programs.
366 Not much right now. Just support for doing MailCrypt stuff."
367 :syntax-table nil
368 :abbrev-table nil
369 (run-hooks 'mail-setup-hook))
370
371 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
372
373 (add-hook 'mdwail-mode-hook
374 (lambda ()
375 (set-buffer-file-coding-system 'utf-8)
376 (make-local-variable 'paragraph-separate)
377 (make-local-variable 'paragraph-start)
378 (setq paragraph-start
379 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
380 paragraph-start))
381 (setq paragraph-separate
382 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
383 paragraph-separate))))
384
385 ;; How to encrypt in mdwmail.
386
387 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
388 (or start
389 (setq start (save-excursion
390 (goto-char (point-min))
391 (or (search-forward "\n\n" nil t) (point-min)))))
392 (or end
393 (setq end (point-max)))
394 (mc-encrypt-generic recip scm start end from sign))
395
396 ;; How to sign in mdwmail.
397
398 (defun mdwmail-mc-sign (key scm start end uclr)
399 (or start
400 (setq start (save-excursion
401 (goto-char (point-min))
402 (or (search-forward "\n\n" nil t) (point-min)))))
403 (or end
404 (setq end (point-max)))
405 (mc-sign-generic key scm start end uclr))
406
407 ;; Some signature mangling.
408
409 (defun mdwmail-mangle-signature ()
410 (save-excursion
411 (goto-char (point-min))
412 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
413 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
414 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
415
416 ;; Insert my login name into message-ids, so I can score replies.
417
418 (defadvice message-unique-id (after mdw-user-name last activate compile)
419 "Ensure that the user's name appears at the end of the message-id string,
420 so that it can be used for convenient filtering."
421 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
422
423 ;; Tell my movemail hack where movemail is.
424 ;;
425 ;; This is needed to shup up warnings about LD_PRELOAD.
426
427 (let ((path exec-path))
428 (while path
429 (let ((try (expand-file-name "movemail" (car path))))
430 (if (file-executable-p try)
431 (setenv "REAL_MOVEMAIL" try))
432 (setq path (cdr path)))))
433
434 (eval-after-load "erc"
435 '(load "~/.ercrc.el"))
436
437 ;;;--------------------------------------------------------------------------
438 ;;; Utility functions.
439
440 (or (fboundp 'line-number-at-pos)
441 (defun line-number-at-pos (&optional pos)
442 (let ((opoint (or pos (point))) start)
443 (save-excursion
444 (save-restriction
445 (goto-char (point-min))
446 (widen)
447 (forward-line 0)
448 (setq start (point))
449 (goto-char opoint)
450 (forward-line 0)
451 (1+ (count-lines 1 (point))))))))
452
453 (defun mdw-uniquify-alist (&rest alists)
454 "Return the concatenation of the ALISTS with duplicate elements removed.
455 The first association with a given key prevails; others are
456 ignored. The input lists are not modified, although they'll
457 probably become garbage."
458 (and alists
459 (let ((start-list (cons nil nil)))
460 (mdw-do-uniquify start-list
461 start-list
462 (car alists)
463 (cdr alists)))))
464
465 (defun mdw-do-uniquify (done end l rest)
466 "A helper function for mdw-uniquify-alist.
467 The DONE argument is a list whose first element is `nil'. It
468 contains the uniquified alist built so far. The leading `nil' is
469 stripped off at the end of the operation; it's only there so that
470 DONE always references a cons cell. END refers to the final cons
471 cell in the DONE list; it is modified in place each time to avoid
472 the overheads of `append'ing all the time. The L argument is the
473 alist we're currently processing; the remaining alists are given
474 in REST."
475
476 ;; There are several different cases to deal with here.
477 (cond
478
479 ;; Current list isn't empty. Add the first item to the DONE list if
480 ;; there's not an item with the same KEY already there.
481 (l (or (assoc (car (car l)) done)
482 (progn
483 (setcdr end (cons (car l) nil))
484 (setq end (cdr end))))
485 (mdw-do-uniquify done end (cdr l) rest))
486
487 ;; The list we were working on is empty. Shunt the next list into the
488 ;; current list position and go round again.
489 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
490
491 ;; Everything's done. Remove the leading `nil' from the DONE list and
492 ;; return it. Finished!
493 (t (cdr done))))
494
495 (defun date ()
496 "Insert the current date in a pleasing way."
497 (interactive)
498 (insert (save-excursion
499 (let ((buffer (get-buffer-create "*tmp*")))
500 (unwind-protect (progn (set-buffer buffer)
501 (erase-buffer)
502 (shell-command "date +%Y-%m-%d" t)
503 (goto-char (mark))
504 (delete-backward-char 1)
505 (buffer-string))
506 (kill-buffer buffer))))))
507
508 (defun uuencode (file &optional name)
509 "UUencodes a file, maybe calling it NAME, into the current buffer."
510 (interactive "fInput file name: ")
511
512 ;; If NAME isn't specified, then guess from the filename.
513 (if (not name)
514 (setq name
515 (substring file
516 (or (string-match "[^/]*$" file) 0))))
517 (print (format "uuencode `%s' `%s'" file name))
518
519 ;; Now actually do the thing.
520 (call-process "uuencode" file t nil name))
521
522 (defvar np-file "~/.np"
523 "*Where the `now-playing' file is.")
524
525 (defun np (&optional arg)
526 "Grabs a `now-playing' string."
527 (interactive)
528 (save-excursion
529 (or arg (progn
530 (goto-char (point-max))
531 (insert "\nNP: ")
532 (insert-file-contents np-file)))))
533
534 (defun mdw-version-< (ver-a ver-b)
535 "Answer whether VER-A is strictly earlier than VER-B.
536 VER-A and VER-B are version numbers, which are strings containing digit
537 sequences separated by `.'."
538 (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
539 (split-string ver-a "\\.")))
540 (lb (mapcar (lambda (x) (car (read-from-string x)))
541 (split-string ver-b "\\."))))
542 (catch 'done
543 (while t
544 (cond ((null la) (throw 'done lb))
545 ((null lb) (throw 'done nil))
546 ((< (car la) (car lb)) (throw 'done t))
547 ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
548
549 (defun mdw-check-autorevert ()
550 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
551 This takes into consideration whether it's been found using
552 tramp, which seems to get itself into a twist."
553 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
554 nil)
555 ((and (buffer-file-name)
556 (fboundp 'tramp-tramp-file-p)
557 (tramp-tramp-file-p (buffer-file-name)))
558 (unless global-auto-revert-ignore-buffer
559 (setq global-auto-revert-ignore-buffer 'tramp)))
560 ((eq global-auto-revert-ignore-buffer 'tramp)
561 (setq global-auto-revert-ignore-buffer nil))))
562
563 (defadvice find-file (after mdw-autorevert activate)
564 (mdw-check-autorevert))
565 (defadvice write-file (after mdw-autorevert activate)
566 (mdw-check-autorevert))
567
568 ;;;--------------------------------------------------------------------------
569 ;;; Dired hacking.
570
571 (defadvice dired-maybe-insert-subdir
572 (around mdw-marked-insertion first activate)
573 "The DIRNAME may be a list of directory names to insert.
574 Interactively, if files are marked, then insert all of them.
575 With a numeric prefix argument, select that many entries near
576 point; with a non-numeric prefix argument, prompt for listing
577 options."
578 (interactive
579 (list (dired-get-marked-files nil
580 (and (integerp current-prefix-arg)
581 current-prefix-arg)
582 #'file-directory-p)
583 (and current-prefix-arg
584 (not (integerp current-prefix-arg))
585 (read-string "Switches for listing: "
586 (or dired-subdir-switches
587 dired-actual-switches)))))
588 (let ((dirs (ad-get-arg 0)))
589 (dolist (dir (if (listp dirs) dirs (list dirs)))
590 (ad-set-arg 0 dir)
591 ad-do-it)))
592
593 ;;;--------------------------------------------------------------------------
594 ;;; URL viewing.
595
596 (defun mdw-w3m-browse-url (url &optional new-session-p)
597 "Invoke w3m on the URL in its current window, or at least a different one.
598 If NEW-SESSION-P, start a new session."
599 (interactive "sURL: \nP")
600 (save-excursion
601 (let ((window (selected-window)))
602 (unwind-protect
603 (progn
604 (select-window (or (and (not new-session-p)
605 (get-buffer-window "*w3m*"))
606 (progn
607 (if (one-window-p t) (split-window))
608 (get-lru-window))))
609 (w3m-browse-url url new-session-p))
610 (select-window window)))))
611
612 (defvar mdw-good-url-browsers
613 '(browse-url-mozilla
614 browse-url-generic
615 (w3m . mdw-w3m-browse-url)
616 browse-url-w3)
617 "List of good browsers for mdw-good-url-browsers.
618 Each item is a browser function name, or a cons (CHECK . FUNC).
619 A symbol FOO stands for (FOO . FOO).")
620
621 (defun mdw-good-url-browser ()
622 "Return a good URL browser.
623 Trundle the list of such things, finding the first item for which
624 CHECK is fboundp, and returning the correponding FUNC."
625 (let ((bs mdw-good-url-browsers) b check func answer)
626 (while (and bs (not answer))
627 (setq b (car bs)
628 bs (cdr bs))
629 (if (consp b)
630 (setq check (car b) func (cdr b))
631 (setq check b func b))
632 (if (fboundp check)
633 (setq answer func)))
634 answer))
635
636 (eval-after-load "w3m-search"
637 '(progn
638 (dolist
639 (item
640 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
641 ("gd" "Google Directory"
642 "http://www.google.com/search?cat=gwd/Top&q=%s")
643 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
644 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
645 ("gi" "Images" "http://images.google.com/images?q=%s")
646 ("rfc" "RFC"
647 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
648 ("wp" "Wikipedia"
649 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
650 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
651 ("nc-wiki" "nCipher wiki"
652 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
653 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
654 ("lp" "Launchpad bug by number"
655 "https://bugs.launchpad.net/bugs/%s")
656 ("lppkg" "Launchpad bugs by package"
657 "https://bugs.launchpad.net/%s")
658 ("msdn" "MSDN"
659 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
660 ("debbug" "Debian bug by number"
661 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
662 ("debbugpkg" "Debian bugs by package"
663 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
664 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
665 (add-to-list 'w3m-search-engine-alist
666 (list (cadr item) (caddr item) nil))
667 (add-to-list 'w3m-uri-replace-alist
668 (list (concat "\\`" (car item) ":")
669 'w3m-search-uri-replace
670 (cadr item))))))
671
672 ;;;--------------------------------------------------------------------------
673 ;;; Paragraph filling.
674
675 ;; Useful variables.
676
677 (defvar mdw-fill-prefix nil
678 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
679 If there's no fill prefix currently set (by the `fill-prefix'
680 variable) and there's a match from one of the regexps here, it
681 gets used to set the fill-prefix for the current operation.
682
683 The variable is a list of items of the form `REGEXP . PREFIX'; if
684 the REGEXP matches, the PREFIX is used to set the fill prefix.
685 It in turn is a list of things:
686
687 STRING -- insert a literal string
688 (match . N) -- insert the thing matched by bracketed subexpression N
689 (pad . N) -- a string of whitespace the same width as subexpression N
690 (expr . FORM) -- the result of evaluating FORM")
691
692 (make-variable-buffer-local 'mdw-fill-prefix)
693
694 (defvar mdw-hanging-indents
695 (concat "\\(\\("
696 "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
697 "[ \t]+"
698 "\\)?\\)")
699 "*Standard regexp matching parts of a hanging indent.
700 This is mainly useful in `auto-fill-mode'.")
701
702 ;; Setting things up.
703
704 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
705
706 ;; Utility functions.
707
708 (defun mdw-maybe-tabify (s)
709 "Tabify or untabify the string S, according to `indent-tabs-mode'."
710 (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
711 (with-temp-buffer
712 (save-match-data
713 (insert s "\n")
714 (let ((start (point-min)) (end (point-max)))
715 (funcall tabfun (point-min) (point-max))
716 (setq s (buffer-substring (point-min) (1- (point-max)))))))))
717
718 (defun mdw-examine-fill-prefixes (l)
719 "Given a list of dynamic fill prefixes, pick one which matches
720 context and return the static fill prefix to use. Point must be
721 at the start of a line, and match data must be saved."
722 (cond ((not l) nil)
723 ((looking-at (car (car l)))
724 (mdw-maybe-tabify (apply #'concat
725 (mapcar #'mdw-do-prefix-match
726 (cdr (car l))))))
727 (t (mdw-examine-fill-prefixes (cdr l)))))
728
729 (defun mdw-maybe-car (p)
730 "If P is a pair, return (car P), otherwise just return P."
731 (if (consp p) (car p) p))
732
733 (defun mdw-padding (s)
734 "Return a string the same width as S but made entirely from whitespace."
735 (let* ((l (length s)) (i 0) (n (make-string l ? )))
736 (while (< i l)
737 (if (= 9 (aref s i))
738 (aset n i 9))
739 (setq i (1+ i)))
740 n))
741
742 (defun mdw-do-prefix-match (m)
743 "Expand a dynamic prefix match element.
744 See `mdw-fill-prefix' for details."
745 (cond ((not (consp m)) (format "%s" m))
746 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
747 ((eq (car m) 'pad) (mdw-padding (match-string
748 (mdw-maybe-car (cdr m)))))
749 ((eq (car m) 'eval) (eval (cdr m)))
750 (t "")))
751
752 (defun mdw-choose-dynamic-fill-prefix ()
753 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
754 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
755 ((not mdw-fill-prefix) fill-prefix)
756 (t (save-excursion
757 (beginning-of-line)
758 (save-match-data
759 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
760
761 (defun do-auto-fill ()
762 "Handle auto-filling, working out a dynamic fill prefix in the
763 case where there isn't a sensible static one."
764 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
765 (mdw-do-auto-fill)))
766
767 (defun mdw-fill-paragraph ()
768 "Fill paragraph, getting a dynamic fill prefix."
769 (interactive)
770 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
771 (fill-paragraph nil)))
772
773 (defun mdw-standard-fill-prefix (rx &optional mat)
774 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
775 This is just a short-cut for setting the thing by hand, and by
776 design it doesn't cope with anything approximating a complicated
777 case."
778 (setq mdw-fill-prefix
779 `((,(concat rx mdw-hanging-indents)
780 (match . 1)
781 (pad . ,(or mat 2))))))
782
783 ;;;--------------------------------------------------------------------------
784 ;;; Other common declarations.
785
786 ;; Common mode settings.
787
788 (defvar mdw-auto-indent t
789 "Whether to indent automatically after a newline.")
790
791 (defun mdw-whitespace-mode (&optional arg)
792 "Turn on/off whitespace mode, but don't highlight trailing space."
793 (interactive "P")
794 (when (and (boundp 'whitespace-style)
795 (fboundp 'whitespace-mode))
796 (let ((whitespace-style (remove 'trailing whitespace-style)))
797 (whitespace-mode arg))
798 (setq show-trailing-whitespace whitespace-mode)))
799
800 (defun mdw-misc-mode-config ()
801 (and mdw-auto-indent
802 (cond ((eq major-mode 'lisp-mode)
803 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
804 ((or (eq major-mode 'slime-repl-mode)
805 (eq major-mode 'asm-mode))
806 nil)
807 (t
808 (local-set-key "\C-m" 'newline-and-indent))))
809 (local-set-key [C-return] 'newline)
810 (make-local-variable 'page-delimiter)
811 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
812 (setq comment-column 40)
813 (auto-fill-mode 1)
814 (setq fill-column 77)
815 (setq show-trailing-whitespace t)
816 (mdw-whitespace-mode 1)
817 (and (fboundp 'gtags-mode)
818 (gtags-mode))
819 (if (fboundp 'hs-minor-mode)
820 (trap (hs-minor-mode t))
821 (outline-minor-mode t))
822 (reveal-mode t)
823 (trap (turn-on-font-lock)))
824
825 (defun mdw-post-config-mode-hack ()
826 (mdw-whitespace-mode 1))
827
828 (eval-after-load 'gtags
829 '(progn
830 (dolist (key '([mouse-2] [mouse-3]))
831 (define-key gtags-mode-map key nil))
832 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
833 (define-key gtags-select-mode-map [C-S-mouse-2]
834 'gtags-select-tag-by-event)
835 (dolist (map (list gtags-mode-map gtags-select-mode-map))
836 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
837
838 ;; Backup file handling.
839
840 (defvar mdw-backup-disable-regexps nil
841 "*List of regular expressions: if a file name matches any of
842 these then the file is not backed up.")
843
844 (defun mdw-backup-enable-predicate (name)
845 "[mdw]'s default backup predicate.
846 Allows a backup if the standard predicate would allow it, and it
847 doesn't match any of the regular expressions in
848 `mdw-backup-disable-regexps'."
849 (and (normal-backup-enable-predicate name)
850 (let ((answer t) (list mdw-backup-disable-regexps))
851 (save-match-data
852 (while list
853 (if (string-match (car list) name)
854 (setq answer nil))
855 (setq list (cdr list)))
856 answer))))
857 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
858
859 ;; Frame cleanup.
860
861 (defun mdw-last-one-out-turn-off-the-lights (frame)
862 "Disconnect from an X display if this was the last frame on that display."
863 (let ((frame-display (frame-parameter frame 'display)))
864 (when (and frame-display
865 (eq window-system 'x)
866 (not (some (lambda (fr)
867 (and (not (eq fr frame))
868 (string= (frame-parameter fr 'display)
869 frame-display)))
870 (frame-list))))
871 (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
872 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
873
874 ;;;--------------------------------------------------------------------------
875 ;;; General fontification.
876
877 (defmacro mdw-define-face (name &rest body)
878 "Define a face, and make sure it's actually set as the definition."
879 (declare (indent 1)
880 (debug 0))
881 `(progn
882 (make-face ',name)
883 (defvar ,name ',name)
884 (put ',name 'face-defface-spec ',body)
885 (face-spec-set ',name ',body nil)))
886
887 (mdw-define-face default
888 (((type w32)) :family "courier new" :height 85)
889 (((type x)) :family "6x13" :foundry "trad" :height 130)
890 (((type color)) :foreground "white" :background "black")
891 (t nil))
892 (mdw-define-face fixed-pitch
893 (((type w32)) :family "courier new" :height 85)
894 (((type x)) :family "6x13" :foundry "trad" :height 130)
895 (t :foreground "white" :background "black"))
896 (if (>= emacs-major-version 23)
897 (mdw-define-face variable-pitch
898 (((type x)) :family "sans" :height 100))
899 (mdw-define-face variable-pitch
900 (((type x)) :family "helvetica" :height 90)))
901 (mdw-define-face region
902 (((type tty) (class color)) :background "blue")
903 (((type tty) (class mono)) :inverse-video t)
904 (t :background "grey30"))
905 (mdw-define-face match
906 (((type tty) (class color)) :background "blue")
907 (((type tty) (class mono)) :inverse-video t)
908 (t :background "blue"))
909 (mdw-define-face mc/cursor-face
910 (((type tty) (class mono)) :inverse-video t)
911 (t :background "red"))
912 (mdw-define-face minibuffer-prompt
913 (t :weight bold))
914 (mdw-define-face mode-line
915 (((class color)) :foreground "blue" :background "yellow"
916 :box (:line-width 1 :style released-button))
917 (t :inverse-video t))
918 (mdw-define-face mode-line-inactive
919 (((class color)) :foreground "yellow" :background "blue"
920 :box (:line-width 1 :style released-button))
921 (t :inverse-video t))
922 (mdw-define-face nobreak-space
923 (((type tty)))
924 (t :inherit escape-glyph :underline t))
925 (mdw-define-face scroll-bar
926 (t :foreground "black" :background "lightgrey"))
927 (mdw-define-face fringe
928 (t :foreground "yellow"))
929 (mdw-define-face show-paren-match
930 (((class color)) :background "darkgreen")
931 (t :underline t))
932 (mdw-define-face show-paren-mismatch
933 (((class color)) :background "red")
934 (t :inverse-video t))
935 (mdw-define-face highlight
936 (((type x) (class color)) :background "DarkSeaGreen4")
937 (((type tty) (class color)) :background "cyan")
938 (t :inverse-video t))
939
940 (mdw-define-face holiday-face
941 (t :background "red"))
942 (mdw-define-face calendar-today-face
943 (t :foreground "yellow" :weight bold))
944
945 (mdw-define-face comint-highlight-prompt
946 (t :weight bold))
947 (mdw-define-face comint-highlight-input
948 (t nil))
949
950 (mdw-define-face dired-directory
951 (t :foreground "cyan" :weight bold))
952 (mdw-define-face dired-symlink
953 (t :foreground "cyan"))
954 (mdw-define-face dired-perm-write
955 (t nil))
956
957 (mdw-define-face trailing-whitespace
958 (((class color)) :background "red")
959 (t :inverse-video t))
960 (mdw-define-face mdw-punct-face
961 (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
962 (mdw-define-face mdw-number-face
963 (t :foreground "yellow"))
964 (mdw-define-face mdw-trivial-face)
965 (mdw-define-face font-lock-function-name-face
966 (t :slant italic))
967 (mdw-define-face font-lock-keyword-face
968 (t :weight bold))
969 (mdw-define-face font-lock-constant-face
970 (t :slant italic))
971 (mdw-define-face font-lock-builtin-face
972 (t :weight bold))
973 (mdw-define-face font-lock-type-face
974 (t :weight bold :slant italic))
975 (mdw-define-face font-lock-reference-face
976 (t :weight bold))
977 (mdw-define-face font-lock-variable-name-face
978 (t :slant italic))
979 (mdw-define-face font-lock-comment-delimiter-face
980 (((class mono)) :weight bold)
981 (((type tty) (class color)) :foreground "green")
982 (t :slant italic :foreground "SeaGreen1"))
983 (mdw-define-face font-lock-comment-face
984 (((class mono)) :weight bold)
985 (((type tty) (class color)) :foreground "green")
986 (t :slant italic :foreground "SeaGreen1"))
987 (mdw-define-face font-lock-string-face
988 (((class mono)) :weight bold)
989 (((class color)) :foreground "SkyBlue1"))
990
991 (mdw-define-face message-separator
992 (t :background "red" :foreground "white" :weight bold))
993 (mdw-define-face message-cited-text
994 (default :slant italic)
995 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
996 (mdw-define-face message-header-cc
997 (default :weight bold)
998 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
999 (mdw-define-face message-header-newsgroups
1000 (default :weight bold)
1001 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1002 (mdw-define-face message-header-subject
1003 (default :weight bold)
1004 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1005 (mdw-define-face message-header-to
1006 (default :weight bold)
1007 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1008 (mdw-define-face message-header-xheader
1009 (default :weight bold)
1010 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1011 (mdw-define-face message-header-other
1012 (default :weight bold)
1013 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1014 (mdw-define-face message-header-name
1015 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1016 (mdw-define-face which-func
1017 (t nil))
1018
1019 (mdw-define-face diff-header
1020 (t nil))
1021 (mdw-define-face diff-index
1022 (t :weight bold))
1023 (mdw-define-face diff-file-header
1024 (t :weight bold))
1025 (mdw-define-face diff-hunk-header
1026 (t :foreground "SkyBlue1"))
1027 (mdw-define-face diff-function
1028 (t :foreground "SkyBlue1" :weight bold))
1029 (mdw-define-face diff-header
1030 (t :background "grey10"))
1031 (mdw-define-face diff-added
1032 (t :foreground "green"))
1033 (mdw-define-face diff-removed
1034 (t :foreground "red"))
1035 (mdw-define-face diff-context
1036 (t nil))
1037 (mdw-define-face diff-refine-change
1038 (((class color) (type x)) :background "RoyalBlue4")
1039 (t :underline t))
1040
1041 (mdw-define-face dylan-header-background
1042 (((class color) (type x)) :background "NavyBlue")
1043 (t :background "blue"))
1044
1045 (mdw-define-face magit-diff-add
1046 (t :foreground "green"))
1047 (mdw-define-face magit-diff-del
1048 (t :foreground "red"))
1049 (mdw-define-face magit-diff-file-header
1050 (t :weight bold))
1051 (mdw-define-face magit-diff-hunk-header
1052 (t :foreground "SkyBlue1"))
1053 (mdw-define-face magit-item-highlight
1054 (((type tty)) :background "blue")
1055 (t :background "DarkSeaGreen4"))
1056 (mdw-define-face magit-log-head-label-remote
1057 (((type tty)) :background "cyan" :foreground "green")
1058 (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1059 (mdw-define-face magit-log-head-label-local
1060 (((type tty)) :background "cyan" :foreground "yellow")
1061 (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1062 (mdw-define-face magit-log-head-label-tags
1063 (((type tty)) :background "red" :foreground "yellow")
1064 (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1065 (mdw-define-face magit-log-graph
1066 (((type tty)) :foreground "magenta")
1067 (t :foreground "grey80"))
1068
1069 (mdw-define-face erc-input-face
1070 (t :foreground "red"))
1071
1072 (mdw-define-face woman-bold
1073 (t :weight bold))
1074 (mdw-define-face woman-italic
1075 (t :slant italic))
1076
1077 (eval-after-load "rst"
1078 '(progn
1079 (mdw-define-face rst-level-1-face
1080 (t :foreground "SkyBlue1" :weight bold))
1081 (mdw-define-face rst-level-2-face
1082 (t :foreground "SeaGreen1" :weight bold))
1083 (mdw-define-face rst-level-3-face
1084 (t :weight bold))
1085 (mdw-define-face rst-level-4-face
1086 (t :slant italic))
1087 (mdw-define-face rst-level-5-face
1088 (t :underline t))
1089 (mdw-define-face rst-level-6-face
1090 ())))
1091
1092 (mdw-define-face p4-depot-added-face
1093 (t :foreground "green"))
1094 (mdw-define-face p4-depot-branch-op-face
1095 (t :foreground "yellow"))
1096 (mdw-define-face p4-depot-deleted-face
1097 (t :foreground "red"))
1098 (mdw-define-face p4-depot-unmapped-face
1099 (t :foreground "SkyBlue1"))
1100 (mdw-define-face p4-diff-change-face
1101 (t :foreground "yellow"))
1102 (mdw-define-face p4-diff-del-face
1103 (t :foreground "red"))
1104 (mdw-define-face p4-diff-file-face
1105 (t :foreground "SkyBlue1"))
1106 (mdw-define-face p4-diff-head-face
1107 (t :background "grey10"))
1108 (mdw-define-face p4-diff-ins-face
1109 (t :foreground "green"))
1110
1111 (mdw-define-face w3m-anchor-face
1112 (t :foreground "SkyBlue1" :underline t))
1113 (mdw-define-face w3m-arrived-anchor-face
1114 (t :foreground "SkyBlue1" :underline t))
1115
1116 (mdw-define-face whizzy-slice-face
1117 (t :background "grey10"))
1118 (mdw-define-face whizzy-error-face
1119 (t :background "darkred"))
1120
1121 ;; Ellipses used to indicate hidden text (and similar).
1122 (mdw-define-face mdw-ellipsis-face
1123 (((type tty)) :foreground "blue") (t :foreground "grey60"))
1124 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1125 (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1126 (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1127 (bar (make-glyph-code ?| mdw-ellipsis-face)))
1128 (set-display-table-slot standard-display-table 0 dollar)
1129 (set-display-table-slot standard-display-table 1 backslash)
1130 (set-display-table-slot standard-display-table 4
1131 (vector dot dot dot))
1132 (set-display-table-slot standard-display-table 5 bar))
1133
1134 ;;;--------------------------------------------------------------------------
1135 ;;; C programming configuration.
1136
1137 ;; Linux kernel hacking.
1138
1139 (defvar linux-c-mode-hook)
1140
1141 (defun linux-c-mode ()
1142 (interactive)
1143 (c-mode)
1144 (setq major-mode 'linux-c-mode)
1145 (setq mode-name "Linux C")
1146 (run-hooks 'linux-c-mode-hook))
1147
1148 ;; Make C indentation nice.
1149
1150 (defun mdw-c-lineup-arglist (langelem)
1151 "Hack for DWIMmery in c-lineup-arglist."
1152 (if (save-excursion
1153 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1154 0
1155 (c-lineup-arglist langelem)))
1156
1157 (defun mdw-c-indent-extern-mumble (langelem)
1158 "Indent `extern \"...\" {' lines."
1159 (save-excursion
1160 (back-to-indentation)
1161 (if (looking-at
1162 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1163 c-basic-offset
1164 nil)))
1165
1166 (defun mdw-c-style ()
1167 (c-add-style "[mdw] C and C++ style"
1168 '((c-basic-offset . 2)
1169 (comment-column . 40)
1170 (c-class-key . "class")
1171 (c-backslash-column . 72)
1172 (c-offsets-alist
1173 (substatement-open . (add 0 c-indent-one-line-block))
1174 (defun-open . (add 0 c-indent-one-line-block))
1175 (arglist-cont-nonempty . mdw-c-lineup-arglist)
1176 (topmost-intro . mdw-c-indent-extern-mumble)
1177 (cpp-define-intro . 0)
1178 (knr-argdecl . 0)
1179 (inextern-lang . [0])
1180 (label . 0)
1181 (case-label . +)
1182 (access-label . -)
1183 (inclass . +)
1184 (inline-open . ++)
1185 (statement-cont . +)
1186 (statement-case-intro . +)))
1187 t))
1188
1189 (defvar mdw-c-comment-fill-prefix
1190 `((,(concat "\\([ \t]*/?\\)"
1191 "\\(\*\\|//]\\)"
1192 "\\([ \t]*\\)"
1193 "\\([A-Za-z]+:[ \t]*\\)?"
1194 mdw-hanging-indents)
1195 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1196 "Fill prefix matching C comments (both kinds).")
1197
1198 (defun mdw-fontify-c-and-c++ ()
1199
1200 ;; Fiddle with some syntax codes.
1201 (modify-syntax-entry ?* ". 23")
1202 (modify-syntax-entry ?/ ". 124b")
1203 (modify-syntax-entry ?\n "> b")
1204
1205 ;; Other stuff.
1206 (mdw-c-style)
1207 (setq c-hanging-comment-ender-p nil)
1208 (setq c-backslash-column 72)
1209 (setq c-label-minimum-indentation 0)
1210 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1211
1212 ;; Now define things to be fontified.
1213 (make-local-variable 'font-lock-keywords)
1214 (let ((c-keywords
1215 (mdw-regexps "and" ;C++
1216 "and_eq" ;C++
1217 "asm" ;K&R, GCC
1218 "auto" ;K&R, C89
1219 "bitand" ;C++
1220 "bitor" ;C++
1221 "bool" ;C++, C9X macro
1222 "break" ;K&R, C89
1223 "case" ;K&R, C89
1224 "catch" ;C++
1225 "char" ;K&R, C89
1226 "class" ;C++
1227 "complex" ;C9X macro, C++ template type
1228 "compl" ;C++
1229 "const" ;C89
1230 "const_cast" ;C++
1231 "continue" ;K&R, C89
1232 "defined" ;C89 preprocessor
1233 "default" ;K&R, C89
1234 "delete" ;C++
1235 "do" ;K&R, C89
1236 "double" ;K&R, C89
1237 "dynamic_cast" ;C++
1238 "else" ;K&R, C89
1239 ;; "entry" ;K&R -- never used
1240 "enum" ;C89
1241 "explicit" ;C++
1242 "export" ;C++
1243 "extern" ;K&R, C89
1244 "float" ;K&R, C89
1245 "for" ;K&R, C89
1246 ;; "fortran" ;K&R
1247 "friend" ;C++
1248 "goto" ;K&R, C89
1249 "if" ;K&R, C89
1250 "imaginary" ;C9X macro
1251 "inline" ;C++, C9X, GCC
1252 "int" ;K&R, C89
1253 "long" ;K&R, C89
1254 "mutable" ;C++
1255 "namespace" ;C++
1256 "new" ;C++
1257 "operator" ;C++
1258 "or" ;C++
1259 "or_eq" ;C++
1260 "private" ;C++
1261 "protected" ;C++
1262 "public" ;C++
1263 "register" ;K&R, C89
1264 "reinterpret_cast" ;C++
1265 "restrict" ;C9X
1266 "return" ;K&R, C89
1267 "short" ;K&R, C89
1268 "signed" ;C89
1269 "sizeof" ;K&R, C89
1270 "static" ;K&R, C89
1271 "static_cast" ;C++
1272 "struct" ;K&R, C89
1273 "switch" ;K&R, C89
1274 "template" ;C++
1275 "throw" ;C++
1276 "try" ;C++
1277 "this" ;C++
1278 "typedef" ;C89
1279 "typeid" ;C++
1280 "typeof" ;GCC
1281 "typename" ;C++
1282 "union" ;K&R, C89
1283 "unsigned" ;K&R, C89
1284 "using" ;C++
1285 "virtual" ;C++
1286 "void" ;C89
1287 "volatile" ;C89
1288 "wchar_t" ;C++, C89 library type
1289 "while" ;K&R, C89
1290 "xor" ;C++
1291 "xor_eq" ;C++
1292 "_Bool" ;C9X
1293 "_Complex" ;C9X
1294 "_Imaginary" ;C9X
1295 "_Pragma" ;C9X preprocessor
1296 "__alignof__" ;GCC
1297 "__asm__" ;GCC
1298 "__attribute__" ;GCC
1299 "__complex__" ;GCC
1300 "__const__" ;GCC
1301 "__extension__" ;GCC
1302 "__imag__" ;GCC
1303 "__inline__" ;GCC
1304 "__label__" ;GCC
1305 "__real__" ;GCC
1306 "__signed__" ;GCC
1307 "__typeof__" ;GCC
1308 "__volatile__" ;GCC
1309 ))
1310 (c-constants
1311 (mdw-regexps "false" ;C++, C9X macro
1312 "this" ;C++
1313 "true" ;C++, C9X macro
1314 ))
1315 (preprocessor-keywords
1316 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1317 "ident" "if" "ifdef" "ifndef" "import" "include"
1318 "line" "pragma" "unassert" "undef" "warning"))
1319 (objc-keywords
1320 (mdw-regexps "class" "defs" "encode" "end" "implementation"
1321 "interface" "private" "protected" "protocol" "public"
1322 "selector")))
1323
1324 (setq font-lock-keywords
1325 (list
1326
1327 ;; Fontify include files as strings.
1328 (list (concat "^[ \t]*\\#[ \t]*"
1329 "\\(include\\|import\\)"
1330 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1331 '(2 font-lock-string-face))
1332
1333 ;; Preprocessor directives are `references'?.
1334 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1335 preprocessor-keywords
1336 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1337 '(1 font-lock-keyword-face))
1338
1339 ;; Handle the keywords defined above.
1340 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1341 '(0 font-lock-keyword-face))
1342
1343 (list (concat "\\<\\(" c-keywords "\\)\\>")
1344 '(0 font-lock-keyword-face))
1345
1346 (list (concat "\\<\\(" c-constants "\\)\\>")
1347 '(0 font-lock-variable-name-face))
1348
1349 ;; Handle numbers too.
1350 ;;
1351 ;; This looks strange, I know. It corresponds to the
1352 ;; preprocessor's idea of what a number looks like, rather than
1353 ;; anything sensible.
1354 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1355 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1356 '(0 mdw-number-face))
1357
1358 ;; And anything else is punctuation.
1359 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1360 '(0 mdw-punct-face))))
1361
1362 (mdw-post-config-mode-hack)))
1363
1364 ;;;--------------------------------------------------------------------------
1365 ;;; AP calc mode.
1366
1367 (defun apcalc-mode ()
1368 (interactive)
1369 (c-mode)
1370 (setq major-mode 'apcalc-mode)
1371 (setq mode-name "AP Calc")
1372 (run-hooks 'apcalc-mode-hook))
1373
1374 (defun mdw-fontify-apcalc ()
1375
1376 ;; Fiddle with some syntax codes.
1377 (modify-syntax-entry ?* ". 23")
1378 (modify-syntax-entry ?/ ". 14")
1379
1380 ;; Other stuff.
1381 (mdw-c-style)
1382 (setq c-hanging-comment-ender-p nil)
1383 (setq c-backslash-column 72)
1384 (setq comment-start "/* ")
1385 (setq comment-end " */")
1386 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1387
1388 ;; Now define things to be fontified.
1389 (make-local-variable 'font-lock-keywords)
1390 (let ((c-keywords
1391 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1392 "do" "else" "exit" "for" "global" "goto" "help" "if"
1393 "local" "mat" "obj" "print" "quit" "read" "return"
1394 "show" "static" "switch" "while" "write")))
1395
1396 (setq font-lock-keywords
1397 (list
1398
1399 ;; Handle the keywords defined above.
1400 (list (concat "\\<\\(" c-keywords "\\)\\>")
1401 '(0 font-lock-keyword-face))
1402
1403 ;; Handle numbers too.
1404 ;;
1405 ;; This looks strange, I know. It corresponds to the
1406 ;; preprocessor's idea of what a number looks like, rather than
1407 ;; anything sensible.
1408 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1409 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1410 '(0 mdw-number-face))
1411
1412 ;; And anything else is punctuation.
1413 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1414 '(0 mdw-punct-face)))))
1415
1416 (mdw-post-config-mode-hack))
1417
1418 ;;;--------------------------------------------------------------------------
1419 ;;; Java programming configuration.
1420
1421 ;; Make indentation nice.
1422
1423 (defun mdw-java-style ()
1424 (c-add-style "[mdw] Java style"
1425 '((c-basic-offset . 2)
1426 (c-offsets-alist (substatement-open . 0)
1427 (label . +)
1428 (case-label . +)
1429 (access-label . 0)
1430 (inclass . +)
1431 (statement-case-intro . +)))
1432 t))
1433
1434 ;; Declare Java fontification style.
1435
1436 (defun mdw-fontify-java ()
1437
1438 ;; Other stuff.
1439 (mdw-java-style)
1440 (setq c-hanging-comment-ender-p nil)
1441 (setq c-backslash-column 72)
1442 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1443
1444 ;; Now define things to be fontified.
1445 (make-local-variable 'font-lock-keywords)
1446 (let ((java-keywords
1447 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1448 "char" "class" "const" "continue" "default" "do"
1449 "double" "else" "extends" "final" "finally" "float"
1450 "for" "goto" "if" "implements" "import" "instanceof"
1451 "int" "interface" "long" "native" "new" "package"
1452 "private" "protected" "public" "return" "short"
1453 "static" "switch" "synchronized" "throw" "throws"
1454 "transient" "try" "void" "volatile" "while"))
1455
1456 (java-constants
1457 (mdw-regexps "false" "null" "super" "this" "true")))
1458
1459 (setq font-lock-keywords
1460 (list
1461
1462 ;; Handle the keywords defined above.
1463 (list (concat "\\<\\(" java-keywords "\\)\\>")
1464 '(0 font-lock-keyword-face))
1465
1466 ;; Handle the magic constants defined above.
1467 (list (concat "\\<\\(" java-constants "\\)\\>")
1468 '(0 font-lock-variable-name-face))
1469
1470 ;; Handle numbers too.
1471 ;;
1472 ;; The following isn't quite right, but it's close enough.
1473 (list (concat "\\<\\("
1474 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1475 "[0-9]+\\(\\.[0-9]*\\|\\)"
1476 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1477 "[lLfFdD]?")
1478 '(0 mdw-number-face))
1479
1480 ;; And anything else is punctuation.
1481 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1482 '(0 mdw-punct-face)))))
1483
1484 (mdw-post-config-mode-hack))
1485
1486 ;;;--------------------------------------------------------------------------
1487 ;;; Javascript programming configuration.
1488
1489 (defun mdw-javascript-style ()
1490 (setq js-indent-level 2)
1491 (setq js-expr-indent-offset 0))
1492
1493 (defun mdw-fontify-javascript ()
1494
1495 ;; Other stuff.
1496 (mdw-javascript-style)
1497 (setq js-auto-indent-flag t)
1498
1499 ;; Now define things to be fontified.
1500 (make-local-variable 'font-lock-keywords)
1501 (let ((javascript-keywords
1502 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1503 "char" "class" "const" "continue" "debugger" "default"
1504 "delete" "do" "double" "else" "enum" "export" "extends"
1505 "final" "finally" "float" "for" "function" "goto" "if"
1506 "implements" "import" "in" "instanceof" "int"
1507 "interface" "let" "long" "native" "new" "package"
1508 "private" "protected" "public" "return" "short"
1509 "static" "super" "switch" "synchronized" "throw"
1510 "throws" "transient" "try" "typeof" "var" "void"
1511 "volatile" "while" "with" "yield"
1512
1513 "boolean" "byte" "char" "double" "float" "int" "long"
1514 "short" "void"))
1515 (javascript-constants
1516 (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1517 "arguments" "this")))
1518
1519 (setq font-lock-keywords
1520 (list
1521
1522 ;; Handle the keywords defined above.
1523 (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1524 '(0 font-lock-keyword-face))
1525
1526 ;; Handle the predefined constants defined above.
1527 (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1528 '(0 font-lock-variable-name-face))
1529
1530 ;; Handle numbers too.
1531 ;;
1532 ;; The following isn't quite right, but it's close enough.
1533 (list (concat "\\_<\\("
1534 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1535 "[0-9]+\\(\\.[0-9]*\\|\\)"
1536 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1537 "[lLfFdD]?")
1538 '(0 mdw-number-face))
1539
1540 ;; And anything else is punctuation.
1541 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1542 '(0 mdw-punct-face)))))
1543
1544 (mdw-post-config-mode-hack))
1545
1546 ;;;--------------------------------------------------------------------------
1547 ;;; Scala programming configuration.
1548
1549 (defun mdw-fontify-scala ()
1550
1551 ;; Comment filling.
1552 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1553
1554 ;; Define things to be fontified.
1555 (make-local-variable 'font-lock-keywords)
1556 (let ((scala-keywords
1557 (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1558 "extends" "final" "finally" "for" "forSome" "if"
1559 "implicit" "import" "lazy" "match" "new" "object"
1560 "override" "package" "private" "protected" "return"
1561 "sealed" "throw" "trait" "try" "type" "val"
1562 "var" "while" "with" "yield"))
1563 (scala-constants
1564 (mdw-regexps "false" "null" "super" "this" "true"))
1565 (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1566
1567 (setq font-lock-keywords
1568 (list
1569
1570 ;; Magical identifiers between backticks.
1571 (list (concat "`\\([^`]+\\)`")
1572 '(1 font-lock-variable-name-face))
1573
1574 ;; Handle the keywords defined above.
1575 (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1576 '(0 font-lock-keyword-face))
1577
1578 ;; Handle the constants defined above.
1579 (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1580 '(0 font-lock-variable-name-face))
1581
1582 ;; Magical identifiers between backticks.
1583 (list (concat "`\\([^`]+\\)`")
1584 '(1 font-lock-variable-name-face))
1585
1586 ;; Handle numbers too.
1587 ;;
1588 ;; As usual, not quite right.
1589 (list (concat "\\_<\\("
1590 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1591 "[0-9]+\\(\\.[0-9]*\\|\\)"
1592 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1593 "[lLfFdD]?")
1594 '(0 mdw-number-face))
1595
1596 ;; Identifiers with trailing operators.
1597 (list (concat "_\\(" punctuation "\\)+")
1598 '(0 mdw-trivial-face))
1599
1600 ;; And everything else is punctuation.
1601 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1602 '(0 mdw-punct-face)))
1603
1604 font-lock-syntactic-keywords
1605 (list
1606
1607 ;; Single quotes around characters. But not when used to quote
1608 ;; symbol names. Ugh.
1609 (list (concat "\\('\\)"
1610 "\\(" "."
1611 "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1612 "u+" "[0-9a-fA-F]\\{4\\}"
1613 "\\|" "\\\\" "[0-7]\\{1,3\\}"
1614 "\\|" "\\\\" "." "\\)"
1615 "\\('\\)")
1616 '(1 "\"")
1617 '(4 "\"")))))
1618
1619 (mdw-post-config-mode-hack))
1620
1621 ;;;--------------------------------------------------------------------------
1622 ;;; C# programming configuration.
1623
1624 ;; Make indentation nice.
1625
1626 (defun mdw-csharp-style ()
1627 (c-add-style "[mdw] C# style"
1628 '((c-basic-offset . 2)
1629 (c-offsets-alist (substatement-open . 0)
1630 (label . 0)
1631 (case-label . +)
1632 (access-label . 0)
1633 (inclass . +)
1634 (statement-case-intro . +)))
1635 t))
1636
1637 ;; Declare C# fontification style.
1638
1639 (defun mdw-fontify-csharp ()
1640
1641 ;; Other stuff.
1642 (mdw-csharp-style)
1643 (setq c-hanging-comment-ender-p nil)
1644 (setq c-backslash-column 72)
1645 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1646
1647 ;; Now define things to be fontified.
1648 (make-local-variable 'font-lock-keywords)
1649 (let ((csharp-keywords
1650 (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1651 "char" "checked" "class" "const" "continue" "decimal"
1652 "default" "delegate" "do" "double" "else" "enum"
1653 "event" "explicit" "extern" "finally" "fixed" "float"
1654 "for" "foreach" "goto" "if" "implicit" "in" "int"
1655 "interface" "internal" "is" "lock" "long" "namespace"
1656 "new" "object" "operator" "out" "override" "params"
1657 "private" "protected" "public" "readonly" "ref"
1658 "return" "sbyte" "sealed" "short" "sizeof"
1659 "stackalloc" "static" "string" "struct" "switch"
1660 "throw" "try" "typeof" "uint" "ulong" "unchecked"
1661 "unsafe" "ushort" "using" "virtual" "void" "volatile"
1662 "while" "yield"))
1663
1664 (csharp-constants
1665 (mdw-regexps "base" "false" "null" "this" "true")))
1666
1667 (setq font-lock-keywords
1668 (list
1669
1670 ;; Handle the keywords defined above.
1671 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1672 '(0 font-lock-keyword-face))
1673
1674 ;; Handle the magic constants defined above.
1675 (list (concat "\\<\\(" csharp-constants "\\)\\>")
1676 '(0 font-lock-variable-name-face))
1677
1678 ;; Handle numbers too.
1679 ;;
1680 ;; The following isn't quite right, but it's close enough.
1681 (list (concat "\\<\\("
1682 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1683 "[0-9]+\\(\\.[0-9]*\\|\\)"
1684 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1685 "[lLfFdD]?")
1686 '(0 mdw-number-face))
1687
1688 ;; And anything else is punctuation.
1689 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1690 '(0 mdw-punct-face)))))
1691
1692 (mdw-post-config-mode-hack))
1693
1694 (define-derived-mode csharp-mode java-mode "C#"
1695 "Major mode for editing C# code.")
1696
1697 ;;;--------------------------------------------------------------------------
1698 ;;; F# programming configuration.
1699
1700 (setq fsharp-indent-offset 2)
1701
1702 (defun mdw-fontify-fsharp ()
1703
1704 (let ((punct "=<>+-*/|&%!@?"))
1705 (do ((i 0 (1+ i)))
1706 ((>= i (length punct)))
1707 (modify-syntax-entry (aref punct i) ".")))
1708
1709 (modify-syntax-entry ?_ "_")
1710 (modify-syntax-entry ?( "(")
1711 (modify-syntax-entry ?) ")")
1712
1713 (setq indent-tabs-mode nil)
1714
1715 (let ((fsharp-keywords
1716 (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1717 "begin" "break"
1718 "checked" "class" "component" "const" "constraint"
1719 "constructor" "continue"
1720 "default" "delegate" "do" "done" "downcast" "downto"
1721 "eager" "elif" "else" "end" "exception" "extern"
1722 "finally" "fixed" "for" "fori" "fun" "function"
1723 "functor"
1724 "global"
1725 "if" "in" "include" "inherit" "inline" "interface"
1726 "internal"
1727 "lazy" "let"
1728 "match" "measure" "member" "method" "mixin" "module"
1729 "mutable"
1730 "namespace" "new"
1731 "object" "of" "open" "or" "override"
1732 "parallel" "params" "private" "process" "protected"
1733 "public" "pure"
1734 "rec" "recursive" "return"
1735 "sealed" "sig" "static" "struct"
1736 "tailcall" "then" "to" "trait" "try" "type"
1737 "upcast" "use"
1738 "val" "virtual" "void" "volatile"
1739 "when" "while" "with"
1740 "yield"))
1741
1742 (fsharp-builtins
1743 (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1744 "base" "false" "null" "true"))
1745
1746 (bang-keywords
1747 (mdw-regexps "do" "let" "return" "use" "yield"))
1748
1749 (preprocessor-keywords
1750 (mdw-regexps "if" "indent" "else" "endif")))
1751
1752 (setq font-lock-keywords
1753 (list (list (concat "\\(^\\|[^\"]\\)"
1754 "\\(" "(\\*"
1755 "[^*]*\\*+"
1756 "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1757 ")"
1758 "\\|"
1759 "//.*"
1760 "\\)")
1761 '(2 font-lock-comment-face))
1762
1763 (list (concat "'" "\\("
1764 "\\\\"
1765 "\\(" "[ntbr'\\]"
1766 "\\|" "[0-9][0-9][0-9]"
1767 "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1768 "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1769 "\\)"
1770 "\\|"
1771 "." "\\)" "'"
1772 "\\|"
1773 "\"" "[^\"\\]*"
1774 "\\(" "\\\\" "\\(.\\|\n\\)"
1775 "[^\"\\]*" "\\)*"
1776 "\\(\"\\|\\'\\)")
1777 '(0 font-lock-string-face))
1778
1779 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1780 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1781 "\\|"
1782 "\\_<\\(" fsharp-keywords "\\)\\_>")
1783 '(0 font-lock-keyword-face))
1784 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1785 '(0 font-lock-variable-name-face))
1786
1787 (list (concat "\\_<"
1788 "\\(" "0[bB][01]+" "\\|"
1789 "0[oO][0-7]+" "\\|"
1790 "0[xX][0-9a-fA-F]+" "\\)"
1791 "\\(" "lf\\|LF" "\\|"
1792 "[uU]?[ysnlL]?" "\\)"
1793 "\\|"
1794 "\\_<"
1795 "[0-9]+" "\\("
1796 "[mMQRZING]"
1797 "\\|"
1798 "\\(\\.[0-9]*\\)?"
1799 "\\([eE][-+]?[0-9]+\\)?"
1800 "[fFmM]?"
1801 "\\|"
1802 "[uU]?[ysnlL]?"
1803 "\\)")
1804 '(0 mdw-number-face))
1805
1806 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1807 '(0 mdw-punct-face)))))
1808
1809 (mdw-post-config-mode-hack))
1810
1811 (defun mdw-fontify-inferior-fsharp ()
1812 (mdw-fontify-fsharp)
1813 (setq font-lock-keywords
1814 (append (list (list "^[#-]" '(0 font-lock-comment-face))
1815 (list "^>" '(0 font-lock-keyword-face)))
1816 font-lock-keywords)))
1817
1818 ;;;--------------------------------------------------------------------------
1819 ;;; Go programming configuration.
1820
1821 (defun mdw-fontify-go ()
1822
1823 (make-local-variable 'font-lock-keywords)
1824 (let ((go-keywords
1825 (mdw-regexps "break" "case" "chan" "const" "continue"
1826 "default" "defer" "else" "fallthrough" "for"
1827 "func" "go" "goto" "if" "import"
1828 "interface" "map" "package" "range" "return"
1829 "select" "struct" "switch" "type" "var"))
1830 (go-intrinsics
1831 (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1832 "float32" "float64" "int" "uint8" "int16" "int32"
1833 "int64" "rune" "string" "uint" "uint8" "uint16"
1834 "uint32" "uint64" "uintptr" "void"
1835 "false" "iota" "nil" "true"
1836 "init" "main"
1837 "append" "cap" "copy" "delete" "imag" "len" "make"
1838 "new" "panic" "real" "recover")))
1839
1840 (setq font-lock-keywords
1841 (list
1842
1843 ;; Handle the keywords defined above.
1844 (list (concat "\\<\\(" go-keywords "\\)\\>")
1845 '(0 font-lock-keyword-face))
1846 (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1847 '(0 font-lock-variable-name-face))
1848
1849 ;; Strings and characters.
1850 (list (concat "'"
1851 "\\(" "[^\\']" "\\|"
1852 "\\\\"
1853 "\\(" "[abfnrtv\\'\"]" "\\|"
1854 "[0-7]\\{3\\}" "\\|"
1855 "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1856 "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1857 "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1858 "'"
1859 "\\|"
1860 "\""
1861 "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1862 "\\(\"\\|$\\)"
1863 "\\|"
1864 "`" "[^`]+" "`")
1865 '(0 font-lock-string-face))
1866
1867 ;; Handle numbers too.
1868 ;;
1869 ;; The following isn't quite right, but it's close enough.
1870 (list (concat "\\<\\("
1871 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1872 "[0-9]+\\(\\.[0-9]*\\|\\)"
1873 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1874 '(0 mdw-number-face))
1875
1876 ;; And anything else is punctuation.
1877 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1878 '(0 mdw-punct-face)))))
1879
1880 (mdw-post-config-mode-hack))
1881
1882 ;;;--------------------------------------------------------------------------
1883 ;;; Awk programming configuration.
1884
1885 ;; Make Awk indentation nice.
1886
1887 (defun mdw-awk-style ()
1888 (c-add-style "[mdw] Awk style"
1889 '((c-basic-offset . 2)
1890 (c-offsets-alist (substatement-open . 0)
1891 (statement-cont . 0)
1892 (statement-case-intro . +)))
1893 t))
1894
1895 ;; Declare Awk fontification style.
1896
1897 (defun mdw-fontify-awk ()
1898
1899 ;; Miscellaneous fiddling.
1900 (mdw-awk-style)
1901 (setq c-backslash-column 72)
1902 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1903
1904 ;; Now define things to be fontified.
1905 (make-local-variable 'font-lock-keywords)
1906 (let ((c-keywords
1907 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1908 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1909 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1910 "RSTART" "RLENGTH" "RT" "SUBSEP"
1911 "atan2" "break" "close" "continue" "cos" "delete"
1912 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1913 "function" "gensub" "getline" "gsub" "if" "in"
1914 "index" "int" "length" "log" "match" "next" "rand"
1915 "return" "print" "printf" "sin" "split" "sprintf"
1916 "sqrt" "srand" "strftime" "sub" "substr" "system"
1917 "systime" "tolower" "toupper" "while")))
1918
1919 (setq font-lock-keywords
1920 (list
1921
1922 ;; Handle the keywords defined above.
1923 (list (concat "\\<\\(" c-keywords "\\)\\>")
1924 '(0 font-lock-keyword-face))
1925
1926 ;; Handle numbers too.
1927 ;;
1928 ;; The following isn't quite right, but it's close enough.
1929 (list (concat "\\<\\("
1930 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1931 "[0-9]+\\(\\.[0-9]*\\|\\)"
1932 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1933 "[uUlL]*")
1934 '(0 mdw-number-face))
1935
1936 ;; And anything else is punctuation.
1937 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1938 '(0 mdw-punct-face)))))
1939
1940 (mdw-post-config-mode-hack))
1941
1942 ;;;--------------------------------------------------------------------------
1943 ;;; Perl programming style.
1944
1945 ;; Perl indentation style.
1946
1947 (fset 'perl-mode 'cperl-mode)
1948 (setq cperl-indent-level 2)
1949 (setq cperl-continued-statement-offset 2)
1950 (setq cperl-continued-brace-offset 0)
1951 (setq cperl-brace-offset -2)
1952 (setq cperl-brace-imaginary-offset 0)
1953 (setq cperl-label-offset 0)
1954
1955 ;; Define perl fontification style.
1956
1957 (defun mdw-fontify-perl ()
1958
1959 ;; Miscellaneous fiddling.
1960 (modify-syntax-entry ?$ "\\")
1961 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1962 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1963
1964 ;; Now define fontification things.
1965 (make-local-variable 'font-lock-keywords)
1966 (let ((perl-keywords
1967 (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
1968 "for" "foreach" "ge" "given" "gt" "goto" "if"
1969 "last" "le" "lt" "local" "my" "ne" "next" "or"
1970 "our" "package" "redo" "require" "return" "sub"
1971 "undef" "unless" "until" "use" "when" "while")))
1972
1973 (setq font-lock-keywords
1974 (list
1975
1976 ;; Set up the keywords defined above.
1977 (list (concat "\\<\\(" perl-keywords "\\)\\>")
1978 '(0 font-lock-keyword-face))
1979
1980 ;; At least numbers are simpler than C.
1981 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1982 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1983 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1984 '(0 mdw-number-face))
1985
1986 ;; And anything else is punctuation.
1987 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1988 '(0 mdw-punct-face)))))
1989
1990 (mdw-post-config-mode-hack))
1991
1992 (defun perl-number-tests (&optional arg)
1993 "Assign consecutive numbers to lines containing `#t'. With ARG,
1994 strip numbers instead."
1995 (interactive "P")
1996 (save-excursion
1997 (goto-char (point-min))
1998 (let ((i 0) (fmt (if arg "" " %4d")))
1999 (while (search-forward "#t" nil t)
2000 (delete-region (point) (line-end-position))
2001 (setq i (1+ i))
2002 (insert (format fmt i)))
2003 (goto-char (point-min))
2004 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2005 (replace-match (format "\\1%d" i))))))
2006
2007 ;;;--------------------------------------------------------------------------
2008 ;;; Python programming style.
2009
2010 (defun mdw-fontify-pythonic (keywords)
2011
2012 ;; Miscellaneous fiddling.
2013 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2014 (setq indent-tabs-mode nil)
2015
2016 ;; Now define fontification things.
2017 (make-local-variable 'font-lock-keywords)
2018 (setq font-lock-keywords
2019 (list
2020
2021 ;; Set up the keywords defined above.
2022 (list (concat "\\_<\\(" keywords "\\)\\_>")
2023 '(0 font-lock-keyword-face))
2024
2025 ;; At least numbers are simpler than C.
2026 (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2027 "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2028 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2029 '(0 mdw-number-face))
2030
2031 ;; And anything else is punctuation.
2032 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2033 '(0 mdw-punct-face))))
2034
2035 (mdw-post-config-mode-hack))
2036
2037 ;; Define Python fontification styles.
2038
2039 (defun mdw-fontify-python ()
2040 (mdw-fontify-pythonic
2041 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2042 "del" "elif" "else" "except" "exec" "finally" "for"
2043 "from" "global" "if" "import" "in" "is" "lambda"
2044 "not" "or" "pass" "print" "raise" "return" "try"
2045 "while" "with" "yield")))
2046
2047 (defun mdw-fontify-pyrex ()
2048 (mdw-fontify-pythonic
2049 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2050 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2051 "extern" "finally" "for" "from" "global" "if"
2052 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2053 "raise" "return" "struct" "try" "while" "with"
2054 "yield")))
2055
2056 ;;;--------------------------------------------------------------------------
2057 ;;; Icon programming style.
2058
2059 ;; Icon indentation style.
2060
2061 (setq icon-brace-offset 0
2062 icon-continued-brace-offset 0
2063 icon-continued-statement-offset 2
2064 icon-indent-level 2)
2065
2066 ;; Define Icon fontification style.
2067
2068 (defun mdw-fontify-icon ()
2069
2070 ;; Miscellaneous fiddling.
2071 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2072
2073 ;; Now define fontification things.
2074 (make-local-variable 'font-lock-keywords)
2075 (let ((icon-keywords
2076 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2077 "end" "every" "fail" "global" "if" "initial"
2078 "invocable" "link" "local" "next" "not" "of"
2079 "procedure" "record" "repeat" "return" "static"
2080 "suspend" "then" "to" "until" "while"))
2081 (preprocessor-keywords
2082 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2083 "include" "line" "undef")))
2084 (setq font-lock-keywords
2085 (list
2086
2087 ;; Set up the keywords defined above.
2088 (list (concat "\\<\\(" icon-keywords "\\)\\>")
2089 '(0 font-lock-keyword-face))
2090
2091 ;; The things that Icon calls keywords.
2092 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2093
2094 ;; At least numbers are simpler than C.
2095 (list (concat "\\<[0-9]+"
2096 "\\([rR][0-9a-zA-Z]+\\|"
2097 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2098 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2099 '(0 mdw-number-face))
2100
2101 ;; Preprocessor.
2102 (list (concat "^[ \t]*$[ \t]*\\<\\("
2103 preprocessor-keywords
2104 "\\)\\>")
2105 '(0 font-lock-keyword-face))
2106
2107 ;; And anything else is punctuation.
2108 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2109 '(0 mdw-punct-face)))))
2110
2111 (mdw-post-config-mode-hack))
2112
2113 ;;;--------------------------------------------------------------------------
2114 ;;; ARM assembler programming configuration.
2115
2116 ;; There doesn't appear to be an Emacs mode for this yet.
2117 ;;
2118 ;; Better do something about that, I suppose.
2119
2120 (defvar arm-assembler-mode-map nil)
2121 (defvar arm-assembler-abbrev-table nil)
2122 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
2123
2124 (or arm-assembler-mode-map
2125 (progn
2126 (setq arm-assembler-mode-map (make-sparse-keymap))
2127 (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
2128 (define-key arm-assembler-mode-map [C-return] 'newline)
2129 (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
2130
2131 (defun arm-assembler-mode ()
2132 "Major mode for ARM assembler programs"
2133 (interactive)
2134
2135 ;; Do standard major mode things.
2136 (kill-all-local-variables)
2137 (use-local-map arm-assembler-mode-map)
2138 (setq local-abbrev-table arm-assembler-abbrev-table)
2139 (setq major-mode 'arm-assembler-mode)
2140 (setq mode-name "ARM assembler")
2141
2142 ;; Set up syntax table.
2143 (set-syntax-table arm-assembler-mode-syntax-table)
2144 (modify-syntax-entry ?; ; Nasty hack
2145 "<" arm-assembler-mode-syntax-table)
2146 (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
2147 (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
2148 (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
2149
2150 (make-local-variable 'comment-start)
2151 (setq comment-start ";")
2152 (make-local-variable 'comment-end)
2153 (setq comment-end "")
2154 (make-local-variable 'comment-column)
2155 (setq comment-column 48)
2156 (make-local-variable 'comment-start-skip)
2157 (setq comment-start-skip ";+[ \t]*")
2158
2159 ;; Play with indentation.
2160 (make-local-variable 'indent-line-function)
2161 (setq indent-line-function 'indent-relative-maybe)
2162
2163 ;; Set fill prefix.
2164 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2165
2166 ;; Fiddle with fontification.
2167 (make-local-variable 'font-lock-keywords)
2168 (setq font-lock-keywords
2169 (list
2170
2171 ;; Handle numbers too.
2172 ;;
2173 ;; The following isn't quite right, but it's close enough.
2174 (list (concat "\\("
2175 "&[0-9a-fA-F]+\\|"
2176 "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
2177 "\\)")
2178 '(0 mdw-number-face))
2179
2180 ;; Do something about operators.
2181 (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
2182 '(1 font-lock-keyword-face)
2183 '(2 font-lock-string-face))
2184 (list ":[a-zA-Z]+:"
2185 '(0 font-lock-keyword-face))
2186
2187 ;; Do menemonics and directives.
2188 (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
2189 '(1 font-lock-keyword-face))
2190
2191 ;; And anything else is punctuation.
2192 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2193 '(0 mdw-punct-face))))
2194
2195 (mdw-post-config-mode-hack)
2196 (run-hooks 'arm-assembler-mode-hook))
2197
2198 ;;;--------------------------------------------------------------------------
2199 ;;; Assembler mode.
2200
2201 (defun mdw-fontify-asm ()
2202 (modify-syntax-entry ?' "\"")
2203 (modify-syntax-entry ?. "w")
2204 (setf fill-prefix nil)
2205 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2206
2207 ;;;--------------------------------------------------------------------------
2208 ;;; TCL configuration.
2209
2210 (defun mdw-fontify-tcl ()
2211 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2212 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2213 (make-local-variable 'font-lock-keywords)
2214 (setq font-lock-keywords
2215 (list
2216 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2217 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2218 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2219 '(0 mdw-number-face))
2220 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2221 '(0 mdw-punct-face))))
2222 (mdw-post-config-mode-hack))
2223
2224 ;;;--------------------------------------------------------------------------
2225 ;;; Dylan programming configuration.
2226
2227 (defun mdw-fontify-dylan ()
2228
2229 (make-local-variable 'font-lock-keywords)
2230
2231 ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
2232 ;; hook, which undoes all of our configuration.
2233 (setq major-mode 'dylan-mode)
2234 (font-lock-set-defaults)
2235
2236 (let* ((word "[-_a-zA-Z!*@<>$%]+")
2237 (dylan-keywords (mdw-regexps
2238
2239 "C-address" "C-callable-wrapper" "C-function"
2240 "C-mapped-subtype" "C-pointer-type" "C-struct"
2241 "C-subtype" "C-union" "C-variable"
2242
2243 "above" "abstract" "afterwards" "all"
2244 "begin" "below" "block" "by"
2245 "case" "class" "cleanup" "constant" "create"
2246 "define" "domain"
2247 "else" "elseif" "end" "exception" "export"
2248 "finally" "for" "from" "function"
2249 "generic"
2250 "handler"
2251 "if" "in" "instance" "interface" "iterate"
2252 "keyed-by"
2253 "let" "library" "local"
2254 "macro" "method" "module"
2255 "otherwise"
2256 "profiling"
2257 "select" "slot" "subclass"
2258 "table" "then" "to"
2259 "unless" "until" "use"
2260 "variable" "virtual"
2261 "when" "while"))
2262 (sharp-keywords (mdw-regexps
2263 "all-keys" "key" "next" "rest" "include"
2264 "t" "f")))
2265 (setq font-lock-keywords
2266 (list (list (concat "\\<\\(" dylan-keywords
2267 "\\|" "with\\(out\\)?-" word
2268 "\\)\\>")
2269 '(0 font-lock-keyword-face))
2270 (list (concat "\\<" word ":" "\\|"
2271 "#\\(" sharp-keywords "\\)\\>")
2272 '(0 font-lock-variable-name-face))
2273 (list (concat "\\("
2274 "\\([-+]\\|\\<\\)[0-9]+" "\\("
2275 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2276 "\\|" "/[0-9]+"
2277 "\\)"
2278 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2279 "\\|" "#b[01]+"
2280 "\\|" "#o[0-7]+"
2281 "\\|" "#x[0-9a-zA-Z]+"
2282 "\\)\\>")
2283 '(0 mdw-number-face))
2284 (list (concat "\\("
2285 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2286 "\\_<[-+*/=<>:&|]+\\_>"
2287 "\\)")
2288 '(0 mdw-punct-face)))))
2289
2290 (mdw-post-config-mode-hack))
2291
2292 ;;;--------------------------------------------------------------------------
2293 ;;; Algol 68 configuration.
2294
2295 (setq a68-indent-step 2)
2296
2297 (defun mdw-fontify-algol-68 ()
2298
2299 ;; Fix up the syntax table.
2300 (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2301 (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2302 (modify-syntax-entry ch "." a68-mode-syntax-table))
2303
2304 (make-local-variable 'font-lock-keywords)
2305
2306 (let ((not-comment
2307 (let ((word "COMMENT"))
2308 (do ((regexp (concat "[^" (substring word 0 1) "]+")
2309 (concat regexp "\\|"
2310 (substring word 0 i)
2311 "[^" (substring word i (1+ i)) "]"))
2312 (i 1 (1+ i)))
2313 ((>= i (length word)) regexp)))))
2314 (setq font-lock-keywords
2315 (list (list (concat "\\<COMMENT\\>"
2316 "\\(" not-comment "\\)\\{0,5\\}"
2317 "\\(\\'\\|\\<COMMENT\\>\\)")
2318 '(0 font-lock-comment-face))
2319 (list (concat "\\<CO\\>"
2320 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2321 "\\($\\|\\<CO\\>\\)")
2322 '(0 font-lock-comment-face))
2323 (list "\\<[A-Z_]+\\>"
2324 '(0 font-lock-keyword-face))
2325 (list (concat "\\<"
2326 "[0-9]+"
2327 "\\(\\.[0-9]+\\)?"
2328 "\\([eE][-+]?[0-9]+\\)?"
2329 "\\>")
2330 '(0 mdw-number-face))
2331 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2332 '(0 mdw-punct-face)))))
2333
2334 (mdw-post-config-mode-hack))
2335
2336 ;;;--------------------------------------------------------------------------
2337 ;;; REXX configuration.
2338
2339 (defun mdw-rexx-electric-* ()
2340 (interactive)
2341 (insert ?*)
2342 (rexx-indent-line))
2343
2344 (defun mdw-rexx-indent-newline-indent ()
2345 (interactive)
2346 (rexx-indent-line)
2347 (if abbrev-mode (expand-abbrev))
2348 (newline-and-indent))
2349
2350 (defun mdw-fontify-rexx ()
2351
2352 ;; Various bits of fiddling.
2353 (setq mdw-auto-indent nil)
2354 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2355 (local-set-key [?*] 'mdw-rexx-electric-*)
2356 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2357 '(?! ?? ?# ?@ ?$))
2358 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2359
2360 ;; Set up keywords and things for fontification.
2361 (make-local-variable 'font-lock-keywords-case-fold-search)
2362 (setq font-lock-keywords-case-fold-search t)
2363
2364 (setq rexx-indent 2)
2365 (setq rexx-end-indent rexx-indent)
2366 (setq rexx-cont-indent rexx-indent)
2367
2368 (make-local-variable 'font-lock-keywords)
2369 (let ((rexx-keywords
2370 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2371 "else" "end" "engineering" "exit" "expose" "for"
2372 "forever" "form" "fuzz" "if" "interpret" "iterate"
2373 "leave" "linein" "name" "nop" "numeric" "off" "on"
2374 "options" "otherwise" "parse" "procedure" "pull"
2375 "push" "queue" "return" "say" "select" "signal"
2376 "scientific" "source" "then" "trace" "to" "until"
2377 "upper" "value" "var" "version" "when" "while"
2378 "with"
2379
2380 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2381 "center" "center" "charin" "charout" "chars"
2382 "compare" "condition" "copies" "c2d" "c2x"
2383 "datatype" "date" "delstr" "delword" "d2c" "d2x"
2384 "errortext" "format" "fuzz" "insert" "lastpos"
2385 "left" "length" "lineout" "lines" "max" "min"
2386 "overlay" "pos" "queued" "random" "reverse" "right"
2387 "sign" "sourceline" "space" "stream" "strip"
2388 "substr" "subword" "symbol" "time" "translate"
2389 "trunc" "value" "verify" "word" "wordindex"
2390 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2391 "x2d")))
2392
2393 (setq font-lock-keywords
2394 (list
2395
2396 ;; Set up the keywords defined above.
2397 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2398 '(0 font-lock-keyword-face))
2399
2400 ;; Fontify all symbols the same way.
2401 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2402 "[A-Za-z0-9.!?_#@$]+\\)")
2403 '(0 font-lock-variable-name-face))
2404
2405 ;; And everything else is punctuation.
2406 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2407 '(0 mdw-punct-face)))))
2408
2409 (mdw-post-config-mode-hack))
2410
2411 ;;;--------------------------------------------------------------------------
2412 ;;; Standard ML programming style.
2413
2414 (defun mdw-fontify-sml ()
2415
2416 ;; Make underscore an honorary letter.
2417 (modify-syntax-entry ?' "w")
2418
2419 ;; Set fill prefix.
2420 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2421
2422 ;; Now define fontification things.
2423 (make-local-variable 'font-lock-keywords)
2424 (let ((sml-keywords
2425 (mdw-regexps "abstype" "and" "andalso" "as"
2426 "case"
2427 "datatype" "do"
2428 "else" "end" "eqtype" "exception"
2429 "fn" "fun" "functor"
2430 "handle"
2431 "if" "in" "include" "infix" "infixr"
2432 "let" "local"
2433 "nonfix"
2434 "of" "op" "open" "orelse"
2435 "raise" "rec"
2436 "sharing" "sig" "signature" "struct" "structure"
2437 "then" "type"
2438 "val"
2439 "where" "while" "with" "withtype")))
2440
2441 (setq font-lock-keywords
2442 (list
2443
2444 ;; Set up the keywords defined above.
2445 (list (concat "\\<\\(" sml-keywords "\\)\\>")
2446 '(0 font-lock-keyword-face))
2447
2448 ;; At least numbers are simpler than C.
2449 (list (concat "\\<\\(\\~\\|\\)"
2450 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2451 "[wW][0-9]+\\)\\|"
2452 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2453 "\\([eE]\\(\\~\\|\\)"
2454 "[0-9]+\\|\\)\\)\\)")
2455 '(0 mdw-number-face))
2456
2457 ;; And anything else is punctuation.
2458 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2459 '(0 mdw-punct-face)))))
2460
2461 (mdw-post-config-mode-hack))
2462
2463 ;;;--------------------------------------------------------------------------
2464 ;;; Haskell configuration.
2465
2466 (defun mdw-fontify-haskell ()
2467
2468 ;; Fiddle with syntax table to get comments right.
2469 (modify-syntax-entry ?' "_")
2470 (modify-syntax-entry ?- ". 12")
2471 (modify-syntax-entry ?\n ">")
2472
2473 ;; Make punctuation be punctuation
2474 (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2475 (do ((i 0 (1+ i)))
2476 ((>= i (length punct)))
2477 (modify-syntax-entry (aref punct i) ".")))
2478
2479 ;; Set fill prefix.
2480 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2481
2482 ;; Fiddle with fontification.
2483 (make-local-variable 'font-lock-keywords)
2484 (let ((haskell-keywords
2485 (mdw-regexps "as"
2486 "case" "ccall" "class"
2487 "data" "default" "deriving" "do"
2488 "else" "exists"
2489 "forall" "foreign"
2490 "hiding"
2491 "if" "import" "in" "infix" "infixl" "infixr" "instance"
2492 "let"
2493 "mdo" "module"
2494 "newtype"
2495 "of"
2496 "proc"
2497 "qualified"
2498 "rec"
2499 "safe" "stdcall"
2500 "then" "type"
2501 "unsafe"
2502 "where"))
2503 (control-sequences
2504 (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2505 "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2506 "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2507 "SP" "STX" "SUB" "SYN" "US" "VT")))
2508
2509 (setq font-lock-keywords
2510 (list
2511 (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2512 "\\(-+}\\|-*\\'\\)"
2513 "\\|"
2514 "--.*$")
2515 '(0 font-lock-comment-face))
2516 (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2517 '(0 font-lock-keyword-face))
2518 (list (concat "'\\("
2519 "[^\\]"
2520 "\\|"
2521 "\\\\"
2522 "\\(" "[abfnrtv\\\"']" "\\|"
2523 "^" "\\(" control-sequences "\\|"
2524 "[]A-Z@[\\^_]" "\\)" "\\|"
2525 "\\|"
2526 "[0-9]+" "\\|"
2527 "[oO][0-7]+" "\\|"
2528 "[xX][0-9A-Fa-f]+"
2529 "\\)"
2530 "\\)'")
2531 '(0 font-lock-string-face))
2532 (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2533 '(0 font-lock-variable-name-face))
2534 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2535 "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2536 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2537 '(0 mdw-number-face))
2538 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2539 '(0 mdw-punct-face)))))
2540
2541 (mdw-post-config-mode-hack))
2542
2543 ;;;--------------------------------------------------------------------------
2544 ;;; Erlang configuration.
2545
2546 (setq erlang-electric-commands nil)
2547
2548 (defun mdw-fontify-erlang ()
2549
2550 ;; Set fill prefix.
2551 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2552
2553 ;; Fiddle with fontification.
2554 (make-local-variable 'font-lock-keywords)
2555 (let ((erlang-keywords
2556 (mdw-regexps "after" "and" "andalso"
2557 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2558 "case" "catch" "cond"
2559 "div" "end" "fun" "if" "let" "not"
2560 "of" "or" "orelse"
2561 "query" "receive" "rem" "try" "when" "xor")))
2562
2563 (setq font-lock-keywords
2564 (list
2565 (list "%.*$"
2566 '(0 font-lock-comment-face))
2567 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2568 '(0 font-lock-keyword-face))
2569 (list (concat "^-\\sw+\\>")
2570 '(0 font-lock-keyword-face))
2571 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2572 '(0 mdw-number-face))
2573 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2574 '(0 mdw-punct-face)))))
2575
2576 (mdw-post-config-mode-hack))
2577
2578 ;;;--------------------------------------------------------------------------
2579 ;;; Texinfo configuration.
2580
2581 (defun mdw-fontify-texinfo ()
2582
2583 ;; Set fill prefix.
2584 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2585
2586 ;; Real fontification things.
2587 (make-local-variable 'font-lock-keywords)
2588 (setq font-lock-keywords
2589 (list
2590
2591 ;; Environment names are keywords.
2592 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
2593 '(2 font-lock-keyword-face))
2594
2595 ;; Unmark escaped magic characters.
2596 (list "\\(@\\)\\([@{}]\\)"
2597 '(1 font-lock-keyword-face)
2598 '(2 font-lock-variable-name-face))
2599
2600 ;; Make sure we get comments properly.
2601 (list "@c\\(\\|omment\\)\\( .*\\)?$"
2602 '(0 font-lock-comment-face))
2603
2604 ;; Command names are keywords.
2605 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2606 '(0 font-lock-keyword-face))
2607
2608 ;; Fontify TeX special characters as punctuation.
2609 (list "[{}]+"
2610 '(0 mdw-punct-face))))
2611
2612 (mdw-post-config-mode-hack))
2613
2614 ;;;--------------------------------------------------------------------------
2615 ;;; TeX and LaTeX configuration.
2616
2617 (defun mdw-fontify-tex ()
2618 (setq ispell-parser 'tex)
2619 (turn-on-reftex)
2620
2621 ;; Don't make maths into a string.
2622 (modify-syntax-entry ?$ ".")
2623 (modify-syntax-entry ?$ "." font-lock-syntax-table)
2624 (local-set-key [?$] 'self-insert-command)
2625
2626 ;; Set fill prefix.
2627 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2628
2629 ;; Real fontification things.
2630 (make-local-variable 'font-lock-keywords)
2631 (setq font-lock-keywords
2632 (list
2633
2634 ;; Environment names are keywords.
2635 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2636 "{\\([^}\n]*\\)}")
2637 '(2 font-lock-keyword-face))
2638
2639 ;; Suspended environment names are keywords too.
2640 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2641 "{\\([^}\n]*\\)}")
2642 '(3 font-lock-keyword-face))
2643
2644 ;; Command names are keywords.
2645 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2646 '(0 font-lock-keyword-face))
2647
2648 ;; Handle @/.../ for italics.
2649 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2650 ;; '(1 font-lock-keyword-face)
2651 ;; '(3 font-lock-keyword-face))
2652
2653 ;; Handle @*...* for boldness.
2654 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2655 ;; '(1 font-lock-keyword-face)
2656 ;; '(3 font-lock-keyword-face))
2657
2658 ;; Handle @`...' for literal syntax things.
2659 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2660 ;; '(1 font-lock-keyword-face)
2661 ;; '(3 font-lock-keyword-face))
2662
2663 ;; Handle @<...> for nonterminals.
2664 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2665 ;; '(1 font-lock-keyword-face)
2666 ;; '(3 font-lock-keyword-face))
2667
2668 ;; Handle other @-commands.
2669 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2670 ;; '(0 font-lock-keyword-face))
2671
2672 ;; Make sure we get comments properly.
2673 (list "%.*"
2674 '(0 font-lock-comment-face))
2675
2676 ;; Fontify TeX special characters as punctuation.
2677 (list "[$^_{}#&]"
2678 '(0 mdw-punct-face))))
2679
2680 (mdw-post-config-mode-hack))
2681
2682 ;;;--------------------------------------------------------------------------
2683 ;;; SGML hacking.
2684
2685 (defun mdw-sgml-mode ()
2686 (interactive)
2687 (sgml-mode)
2688 (mdw-standard-fill-prefix "")
2689 (make-local-variable 'sgml-delimiters)
2690 (setq sgml-delimiters
2691 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2692 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2693 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2694 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2695 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2696 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2697 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2698 "NULL" ""))
2699 (setq major-mode 'mdw-sgml-mode)
2700 (setq mode-name "[mdw] SGML")
2701 (run-hooks 'mdw-sgml-mode-hook))
2702
2703 ;;;--------------------------------------------------------------------------
2704 ;;; Configuration files.
2705
2706 (defvar mdw-conf-quote-normal nil
2707 "*Control syntax category of quote characters `\"' and `''.
2708 If this is `t', consider quote characters to be normal
2709 punctuation, as for `conf-quote-normal'. If this is `nil' then
2710 leave quote characters as quotes. If this is a list, then
2711 consider the quote characters in the list to be normal
2712 punctuation. If this is a single quote character, then consider
2713 that character only to be normal punctuation.")
2714 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2715 "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2716 (or (booleanp value)
2717 (every (lambda (v) (memq v '(?\" ?')))
2718 (if (listp value) value (list value)))))
2719 (put 'mdw-conf-quote-normal 'safe-local-variable '
2720 mdw-conf-quote-normal-acceptable-value-p)
2721
2722 (defun mdw-fix-up-quote ()
2723 "Apply the setting of `mdw-conf-quote-normal'."
2724 (let ((flag mdw-conf-quote-normal))
2725 (cond ((eq flag t)
2726 (conf-quote-normal t))
2727 ((not flag)
2728 nil)
2729 (t
2730 (let ((table (copy-syntax-table (syntax-table))))
2731 (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2732 (if (listp flag) flag (list flag)))
2733 (set-syntax-table table)
2734 (and font-lock-mode (font-lock-fontify-buffer)))))))
2735 (defun mdw-fix-up-quote-hack ()
2736 "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2737 Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2738 so we wouldn't see a local-variable setting of
2739 `mdw-conf-quote-normal' in `conf-mode-hook'. Instead, wire
2740 ourselves onto `hack-local-variables-hook' here, and check the
2741 setting once it's actually been made."
2742 (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2743 (add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2744
2745 ;;;--------------------------------------------------------------------------
2746 ;;; Shell scripts.
2747
2748 (defun mdw-setup-sh-script-mode ()
2749
2750 ;; Fetch the shell interpreter's name.
2751 (let ((shell-name sh-shell-file))
2752
2753 ;; Try reading the hash-bang line.
2754 (save-excursion
2755 (goto-char (point-min))
2756 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2757 (setq shell-name (match-string 1))))
2758
2759 ;; Now try to set the shell.
2760 ;;
2761 ;; Don't let `sh-set-shell' bugger up my script.
2762 (let ((executable-set-magic #'(lambda (s &rest r) s)))
2763 (sh-set-shell shell-name)))
2764
2765 ;; Now enable my keys and the fontification.
2766 (mdw-misc-mode-config)
2767
2768 ;; Set the indentation level correctly.
2769 (setq sh-indentation 2)
2770 (setq sh-basic-offset 2))
2771
2772 (setq sh-shell-file "/bin/sh")
2773
2774 ;; Awful hacking to override the shell detection for particular scripts.
2775 (defmacro define-custom-shell-mode (name shell)
2776 `(defun ,name ()
2777 (interactive)
2778 (set (make-local-variable 'sh-shell-file) ,shell)
2779 (sh-mode)))
2780 (define-custom-shell-mode bash-mode "/bin/bash")
2781 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2782 (put 'sh-shell-file 'permanent-local t)
2783
2784 ;; Hack the rc syntax table. Backquotes aren't paired in rc.
2785 (eval-after-load "sh-script"
2786 '(or (assq 'rc sh-mode-syntax-table-input)
2787 (let ((frag '(nil
2788 ?# "<"
2789 ?\n ">#"
2790 ?\" "\"\""
2791 ?\' "\"\'"
2792 ?$ "'"
2793 ?\` "."
2794 ?! "_"
2795 ?% "_"
2796 ?. "_"
2797 ?^ "_"
2798 ?~ "_"
2799 ?, "_"
2800 ?= "."
2801 ?< "."
2802 ?> "."))
2803 (assoc (assq 'rc sh-mode-syntax-table-input)))
2804 (if assoc
2805 (rplacd assoc frag)
2806 (setq sh-mode-syntax-table-input
2807 (cons (cons 'rc frag)
2808 sh-mode-syntax-table-input))))))
2809
2810 ;;;--------------------------------------------------------------------------
2811 ;;; Emacs shell mode.
2812
2813 (defun mdw-eshell-prompt ()
2814 (let ((left "[") (right "]"))
2815 (when (= (user-uid) 0)
2816 (setq left "«" right "»"))
2817 (concat left
2818 (save-match-data
2819 (replace-regexp-in-string "\\..*$" "" (system-name)))
2820 " "
2821 (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2822 (home (expand-file-name "~")) (nhome (length home)))
2823 (if (and (>= npwd nhome)
2824 (or (= nhome npwd)
2825 (= (elt pwd nhome) ?/))
2826 (string= (substring pwd 0 nhome) home))
2827 (concat "~" (substring pwd (length home)))
2828 pwd))
2829 right)))
2830 (setq eshell-prompt-function 'mdw-eshell-prompt)
2831 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2832
2833 (defun eshell/e (file) (find-file file) nil)
2834 (defun eshell/ee (file) (find-file-other-window file) nil)
2835 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2836
2837 (mdw-define-face eshell-prompt (t :weight bold))
2838 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2839 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2840 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2841 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2842 (mdw-define-face eshell-ls-executable (t :weight bold))
2843 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2844 (mdw-define-face eshell-ls-readonly (t nil))
2845 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2846
2847 ;;;--------------------------------------------------------------------------
2848 ;;; Messages-file mode.
2849
2850 (defun messages-mode-guts ()
2851 (setq messages-mode-syntax-table (make-syntax-table))
2852 (set-syntax-table messages-mode-syntax-table)
2853 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2854 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2855 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2856 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2857 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2858 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2859 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2860 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2861 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2862 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2863 (make-local-variable 'comment-start)
2864 (make-local-variable 'comment-end)
2865 (make-local-variable 'indent-line-function)
2866 (setq indent-line-function 'indent-relative)
2867 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2868 (make-local-variable 'font-lock-defaults)
2869 (make-local-variable 'messages-mode-keywords)
2870 (let ((keywords
2871 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2872 "export" "enum" "fixed-octetstring" "flags"
2873 "harmless" "map" "nested" "optional"
2874 "optional-tagged" "package" "primitive"
2875 "primitive-nullfree" "relaxed[ \t]+enum"
2876 "set" "table" "tagged-optional" "union"
2877 "variadic" "vector" "version" "version-tag")))
2878 (setq messages-mode-keywords
2879 (list
2880 (list (concat "\\<\\(" keywords "\\)\\>:")
2881 '(0 font-lock-keyword-face))
2882 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2883 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2884 (0 font-lock-variable-name-face))
2885 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2886 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2887 (0 mdw-punct-face)))))
2888 (setq font-lock-defaults
2889 '(messages-mode-keywords nil nil nil nil))
2890 (run-hooks 'messages-file-hook))
2891
2892 (defun messages-mode ()
2893 (interactive)
2894 (fundamental-mode)
2895 (setq major-mode 'messages-mode)
2896 (setq mode-name "Messages")
2897 (messages-mode-guts)
2898 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2899 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2900 (setq comment-start "# ")
2901 (setq comment-end "")
2902 (run-hooks 'messages-mode-hook))
2903
2904 (defun cpp-messages-mode ()
2905 (interactive)
2906 (fundamental-mode)
2907 (setq major-mode 'cpp-messages-mode)
2908 (setq mode-name "CPP Messages")
2909 (messages-mode-guts)
2910 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2911 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2912 (setq comment-start "/* ")
2913 (setq comment-end " */")
2914 (let ((preprocessor-keywords
2915 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2916 "ident" "if" "ifdef" "ifndef" "import" "include"
2917 "line" "pragma" "unassert" "undef" "warning")))
2918 (setq messages-mode-keywords
2919 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2920 "\\(include\\|import\\)"
2921 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2922 '(2 font-lock-string-face))
2923 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2924 preprocessor-keywords
2925 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2926 '(1 font-lock-keyword-face)))
2927 messages-mode-keywords)))
2928 (run-hooks 'cpp-messages-mode-hook))
2929
2930 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2931 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2932 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2933
2934 ;;;--------------------------------------------------------------------------
2935 ;;; Messages-file mode.
2936
2937 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2938 "Face to use for subsittution directives.")
2939 (make-face 'mallow-driver-substitution-face)
2940 (defvar mallow-driver-text-face 'mallow-driver-text-face
2941 "Face to use for body text.")
2942 (make-face 'mallow-driver-text-face)
2943
2944 (defun mallow-driver-mode ()
2945 (interactive)
2946 (fundamental-mode)
2947 (setq major-mode 'mallow-driver-mode)
2948 (setq mode-name "Mallow driver")
2949 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2950 (set-syntax-table mallow-driver-mode-syntax-table)
2951 (make-local-variable 'comment-start)
2952 (make-local-variable 'comment-end)
2953 (make-local-variable 'indent-line-function)
2954 (setq indent-line-function 'indent-relative)
2955 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2956 (make-local-variable 'font-lock-defaults)
2957 (make-local-variable 'mallow-driver-mode-keywords)
2958 (let ((keywords
2959 (mdw-regexps "each" "divert" "file" "if"
2960 "perl" "set" "string" "type" "write")))
2961 (setq mallow-driver-mode-keywords
2962 (list
2963 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2964 '(0 font-lock-keyword-face))
2965 (list "^%\\s *\\(#.*\\|\\)$"
2966 '(0 font-lock-comment-face))
2967 (list "^%"
2968 '(0 font-lock-keyword-face))
2969 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2970 (list "\\${[^}]*}"
2971 '(0 mallow-driver-substitution-face t)))))
2972 (setq font-lock-defaults
2973 '(mallow-driver-mode-keywords nil nil nil nil))
2974 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2975 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2976 (setq comment-start "%# ")
2977 (setq comment-end "")
2978 (run-hooks 'mallow-driver-mode-hook))
2979
2980 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2981
2982 ;;;--------------------------------------------------------------------------
2983 ;;; NFast debugs.
2984
2985 (defun nfast-debug-mode ()
2986 (interactive)
2987 (fundamental-mode)
2988 (setq major-mode 'nfast-debug-mode)
2989 (setq mode-name "NFast debug")
2990 (setq messages-mode-syntax-table (make-syntax-table))
2991 (set-syntax-table messages-mode-syntax-table)
2992 (make-local-variable 'font-lock-defaults)
2993 (make-local-variable 'nfast-debug-mode-keywords)
2994 (setq truncate-lines t)
2995 (setq nfast-debug-mode-keywords
2996 (list
2997 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2998 (0 font-lock-keyword-face))
2999 (list (concat "^[ \t]+\\(\\("
3000 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3001 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3002 "[ \t]+\\)*"
3003 "[0-9a-fA-F]+\\)[ \t]*$")
3004 '(0 mdw-number-face))
3005 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3006 (1 font-lock-keyword-face))
3007 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3008 (1 font-lock-warning-face))
3009 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3010 (1 nil))
3011 (list (concat "^[ \t]+\\.cmd=[ \t]+"
3012 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3013 '(1 font-lock-keyword-face))
3014 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3015 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3016 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3017 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3018 (setq font-lock-defaults
3019 '(nfast-debug-mode-keywords nil nil nil nil))
3020 (run-hooks 'nfast-debug-mode-hook))
3021
3022 ;;;--------------------------------------------------------------------------
3023 ;;; Other languages.
3024
3025 ;; Smalltalk.
3026
3027 (defun mdw-setup-smalltalk ()
3028 (and mdw-auto-indent
3029 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3030 (make-local-variable 'mdw-auto-indent)
3031 (setq mdw-auto-indent nil)
3032 (local-set-key "\C-i" 'smalltalk-reindent))
3033
3034 (defun mdw-fontify-smalltalk ()
3035 (make-local-variable 'font-lock-keywords)
3036 (setq font-lock-keywords
3037 (list
3038 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3039 '(0 font-lock-keyword-face))
3040 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3041 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3042 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3043 '(0 mdw-number-face))
3044 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3045 '(0 mdw-punct-face))))
3046 (mdw-post-config-mode-hack))
3047
3048 ;; Lispy languages.
3049
3050 ;; Unpleasant bodge.
3051 (unless (boundp 'slime-repl-mode-map)
3052 (setq slime-repl-mode-map (make-sparse-keymap)))
3053
3054 (defun mdw-indent-newline-and-indent ()
3055 (interactive)
3056 (indent-for-tab-command)
3057 (newline-and-indent))
3058
3059 (eval-after-load "cl-indent"
3060 '(progn
3061 (mapc #'(lambda (pair)
3062 (put (car pair)
3063 'common-lisp-indent-function
3064 (cdr pair)))
3065 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3066 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3067
3068 (defun mdw-common-lisp-indent ()
3069 (make-local-variable 'lisp-indent-function)
3070 (setq lisp-indent-function 'common-lisp-indent-function))
3071
3072 (setq lisp-simple-loop-indentation 2
3073 lisp-loop-keyword-indentation 6
3074 lisp-loop-forms-indentation 6)
3075
3076 (defun mdw-fontify-lispy ()
3077
3078 ;; Set fill prefix.
3079 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3080
3081 ;; Not much fontification needed.
3082 (make-local-variable 'font-lock-keywords)
3083 (setq font-lock-keywords
3084 (list (list (concat "\\("
3085 "\\_<[-+]?"
3086 "\\(" "[0-9]+/[0-9]+"
3087 "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3088 "\\.[0-9]+" "\\)"
3089 "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3090 "\\)"
3091 "\\|"
3092 "#"
3093 "\\(" "x" "[-+]?"
3094 "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3095 "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3096 "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3097 "\\|" "[0-9]+" "r" "[-+]?"
3098 "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3099 "\\)"
3100 "\\)\\_>")
3101 '(0 mdw-number-face))
3102 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3103 '(0 mdw-punct-face))))
3104
3105 (mdw-post-config-mode-hack))
3106
3107 (defun comint-send-and-indent ()
3108 (interactive)
3109 (comint-send-input)
3110 (and mdw-auto-indent
3111 (indent-for-tab-command)))
3112
3113 (defun mdw-setup-m4 ()
3114
3115 ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
3116 ;; annoying: fix it.
3117 (modify-syntax-entry ?{ "(")
3118 (modify-syntax-entry ?} ")")
3119
3120 ;; Fill prefix.
3121 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3122
3123 ;;;--------------------------------------------------------------------------
3124 ;;; Text mode.
3125
3126 (defun mdw-text-mode ()
3127 (setq fill-column 72)
3128 (flyspell-mode t)
3129 (mdw-standard-fill-prefix
3130 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3131 (auto-fill-mode 1))
3132
3133 ;;;--------------------------------------------------------------------------
3134 ;;; Outline and hide/show modes.
3135
3136 (defun mdw-outline-collapse-all ()
3137 "Completely collapse everything in the entire buffer."
3138 (interactive)
3139 (save-excursion
3140 (goto-char (point-min))
3141 (while (< (point) (point-max))
3142 (hide-subtree)
3143 (forward-line))))
3144
3145 (setq hs-hide-comments-when-hiding-all nil)
3146
3147 (defadvice hs-hide-all (after hide-first-comment activate)
3148 (save-excursion (hs-hide-initial-comment-block)))
3149
3150 ;;;--------------------------------------------------------------------------
3151 ;;; Shell mode.
3152
3153 (defun mdw-sh-mode-setup ()
3154 (local-set-key [?\C-a] 'comint-bol)
3155 (add-hook 'comint-output-filter-functions
3156 'comint-watch-for-password-prompt))
3157
3158 (defun mdw-term-mode-setup ()
3159 (setq term-prompt-regexp shell-prompt-pattern)
3160 (make-local-variable 'mouse-yank-at-point)
3161 (make-local-variable 'transient-mark-mode)
3162 (setq mouse-yank-at-point t)
3163 (auto-fill-mode -1)
3164 (setq tab-width 8))
3165
3166 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3167 (defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
3168 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3169 (defun term-send-meta-meta-something ()
3170 (interactive)
3171 (term-send-raw-string "\e\e")
3172 (term-send-raw))
3173 (eval-after-load 'term
3174 '(progn
3175 (define-key term-raw-map [?\e ?\e] nil)
3176 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3177 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3178 (define-key term-raw-map [M-right] 'term-send-meta-right)
3179 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3180 (define-key term-raw-map [M-left] 'term-send-meta-left)
3181 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3182
3183 (defadvice term-exec (before program-args-list compile activate)
3184 "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3185 This allows you to pass a list of arguments through `ansi-term'."
3186 (let ((program (ad-get-arg 2)))
3187 (if (listp program)
3188 (progn
3189 (ad-set-arg 2 (car program))
3190 (ad-set-arg 4 (cdr program))))))
3191
3192 (defun ssh (host)
3193 "Open a terminal containing an ssh session to the HOST."
3194 (interactive "sHost: ")
3195 (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3196
3197 ;;;--------------------------------------------------------------------------
3198 ;;; Inferior Emacs Lisp.
3199
3200 (setq comint-prompt-read-only t)
3201
3202 (eval-after-load "comint"
3203 '(progn
3204 (define-key comint-mode-map "\C-w" 'comint-kill-region)
3205 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3206
3207 (eval-after-load "ielm"
3208 '(progn
3209 (define-key ielm-map "\C-w" 'comint-kill-region)
3210 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3211
3212 ;;;----- That's all, folks --------------------------------------------------
3213
3214 (provide 'dot-emacs)