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