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