chiark / gitweb /
dot/gnus-local.el.distorted: Additional split rules for silly typos.
[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;;; Where is point?
876
877(defvar mdw-point-overlay
878 (let ((ov (make-overlay 0 0))
879 (s "."))
880 (overlay-put ov 'priority 2)
881 (put-text-property 0 1 'display '(left-fringe vertical-bar) s)
882 (overlay-put ov 'before-string s)
883 (delete-overlay ov)
884 ov)
885 "An overlay used for showing where point is in the selected window.")
886
887(defun mdw-remove-point-overlay ()
888 "Remove the current-point overlay."
889 (delete-overlay mdw-point-overlay))
890
891(defun mdw-update-point-overlay ()
892 "Mark the current point position with an overlay."
893 (if (not mdw-point-overlay-mode)
894 (mdw-remove-point-overlay)
895 (overlay-put mdw-point-overlay 'window (selected-window))
896 (if (bolp)
897 (move-overlay mdw-point-overlay
898 (point) (1+ (point)) (current-buffer))
899 (move-overlay mdw-point-overlay
900 (1- (point)) (point) (current-buffer)))))
901
902(defvar mdw-point-overlay-buffers nil
903 "List of buffers using `mdw-point-overlay-mode'.")
904
905(define-minor-mode mdw-point-overlay-mode
906 "Indicate current line with an overlay."
907 :global nil
908 (let ((buffer (current-buffer)))
909 (setq mdw-point-overlay-buffers
910 (mapcan (lambda (buf)
911 (if (and (buffer-live-p buf)
912 (not (eq buf buffer)))
913 (list buf)))
914 mdw-point-overlay-buffers))
915 (if mdw-point-overlay-mode
916 (setq mdw-point-overlay-buffers
917 (cons buffer mdw-point-overlay-buffers))))
918 (cond (mdw-point-overlay-buffers
919 (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
920 (add-hook 'post-command-hook 'mdw-update-point-overlay))
921 (t
922 (mdw-remove-point-overlay)
923 (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
924 (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
925
926(define-globalized-minor-mode mdw-global-point-overlay-mode
927 mdw-point-overlay-mode
928 (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
929
930;;;--------------------------------------------------------------------------
931;;; Fullscreen-ness.
932
933(defvar mdw-full-screen-parameters
934 '((menu-bar-lines . 0)
935 ;(vertical-scroll-bars . nil)
936 )
937 "Frame parameters to set when making a frame fullscreen.")
938
939(defvar mdw-full-screen-save
940 '(width height)
941 "Extra frame parameters to save when setting fullscreen.")
942
943(defun mdw-toggle-full-screen (&optional frame)
944 "Show the FRAME fullscreen."
945 (interactive)
946 (when window-system
947 (cond ((frame-parameter frame 'fullscreen)
948 (set-frame-parameter frame 'fullscreen nil)
949 (modify-frame-parameters
950 nil
951 (or (frame-parameter frame 'mdw-full-screen-saved)
952 (mapcar (lambda (assoc)
953 (assq (car assoc) default-frame-alist))
954 mdw-full-screen-parameters))))
955 (t
956 (let ((saved (mapcar (lambda (param)
957 (cons param (frame-parameter frame param)))
958 (append (mapcar #'car
959 mdw-full-screen-parameters)
960 mdw-full-screen-save))))
961 (set-frame-parameter frame 'mdw-full-screen-saved saved))
962 (modify-frame-parameters frame mdw-full-screen-parameters)
963 (set-frame-parameter frame 'fullscreen 'fullboth)))))
964
965;;;--------------------------------------------------------------------------
966;;; General fontification.
967
968(defmacro mdw-define-face (name &rest body)
969 "Define a face, and make sure it's actually set as the definition."
970 (declare (indent 1)
971 (debug 0))
972 `(progn
973 (make-face ',name)
974 (defvar ,name ',name)
975 (put ',name 'face-defface-spec ',body)
976 (face-spec-set ',name ',body nil)))
977
978(mdw-define-face default
979 (((type w32)) :family "courier new" :height 85)
980 (((type x)) :family "6x13" :foundry "trad" :height 130)
981 (((type color)) :foreground "white" :background "black")
982 (t nil))
983(mdw-define-face fixed-pitch
984 (((type w32)) :family "courier new" :height 85)
985 (((type x)) :family "6x13" :foundry "trad" :height 130)
986 (t :foreground "white" :background "black"))
987(if (>= emacs-major-version 23)
988 (mdw-define-face variable-pitch
989 (((type x)) :family "sans" :height 100))
990 (mdw-define-face variable-pitch
991 (((type x)) :family "helvetica" :height 90)))
992(mdw-define-face region
993 (((type tty) (class color)) :background "blue")
994 (((type tty) (class mono)) :inverse-video t)
995 (t :background "grey30"))
996(mdw-define-face match
997 (((type tty) (class color)) :background "blue")
998 (((type tty) (class mono)) :inverse-video t)
999 (t :background "blue"))
1000(mdw-define-face mc/cursor-face
1001 (((type tty) (class mono)) :inverse-video t)
1002 (t :background "red"))
1003(mdw-define-face minibuffer-prompt
1004 (t :weight bold))
1005(mdw-define-face mode-line
1006 (((class color)) :foreground "blue" :background "yellow"
1007 :box (:line-width 1 :style released-button))
1008 (t :inverse-video t))
1009(mdw-define-face mode-line-inactive
1010 (((class color)) :foreground "yellow" :background "blue"
1011 :box (:line-width 1 :style released-button))
1012 (t :inverse-video t))
1013(mdw-define-face nobreak-space
1014 (((type tty)))
1015 (t :inherit escape-glyph :underline t))
1016(mdw-define-face scroll-bar
1017 (t :foreground "black" :background "lightgrey"))
1018(mdw-define-face fringe
1019 (t :foreground "yellow"))
1020(mdw-define-face show-paren-match
1021 (((class color)) :background "darkgreen")
1022 (t :underline t))
1023(mdw-define-face show-paren-mismatch
1024 (((class color)) :background "red")
1025 (t :inverse-video t))
1026(mdw-define-face highlight
1027 (((type x) (class color)) :background "DarkSeaGreen4")
1028 (((type tty) (class color)) :background "cyan")
1029 (t :inverse-video t))
1030
1031(mdw-define-face holiday-face
1032 (t :background "red"))
1033(mdw-define-face calendar-today-face
1034 (t :foreground "yellow" :weight bold))
1035
1036(mdw-define-face comint-highlight-prompt
1037 (t :weight bold))
1038(mdw-define-face comint-highlight-input
1039 (t nil))
1040
1041(mdw-define-face dired-directory
1042 (t :foreground "cyan" :weight bold))
1043(mdw-define-face dired-symlink
1044 (t :foreground "cyan"))
1045(mdw-define-face dired-perm-write
1046 (t nil))
1047
1048(mdw-define-face trailing-whitespace
1049 (((class color)) :background "red")
1050 (t :inverse-video t))
1051(mdw-define-face mdw-punct-face
1052 (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
1053(mdw-define-face mdw-number-face
1054 (t :foreground "yellow"))
1055(mdw-define-face mdw-trivial-face)
1056(mdw-define-face font-lock-function-name-face
1057 (t :slant italic))
1058(mdw-define-face font-lock-keyword-face
1059 (t :weight bold))
1060(mdw-define-face font-lock-constant-face
1061 (t :slant italic))
1062(mdw-define-face font-lock-builtin-face
1063 (t :weight bold))
1064(mdw-define-face font-lock-type-face
1065 (t :weight bold :slant italic))
1066(mdw-define-face font-lock-reference-face
1067 (t :weight bold))
1068(mdw-define-face font-lock-variable-name-face
1069 (t :slant italic))
1070(mdw-define-face font-lock-comment-delimiter-face
1071 (((class mono)) :weight bold)
1072 (((type tty) (class color)) :foreground "green")
1073 (t :slant italic :foreground "SeaGreen1"))
1074(mdw-define-face font-lock-comment-face
1075 (((class mono)) :weight bold)
1076 (((type tty) (class color)) :foreground "green")
1077 (t :slant italic :foreground "SeaGreen1"))
1078(mdw-define-face font-lock-string-face
1079 (((class mono)) :weight bold)
1080 (((class color)) :foreground "SkyBlue1"))
1081
1082(mdw-define-face message-separator
1083 (t :background "red" :foreground "white" :weight bold))
1084(mdw-define-face message-cited-text
1085 (default :slant italic)
1086 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1087(mdw-define-face message-header-cc
1088 (default :weight bold)
1089 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1090(mdw-define-face message-header-newsgroups
1091 (default :weight bold)
1092 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1093(mdw-define-face message-header-subject
1094 (default :weight bold)
1095 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1096(mdw-define-face message-header-to
1097 (default :weight bold)
1098 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1099(mdw-define-face message-header-xheader
1100 (default :weight bold)
1101 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1102(mdw-define-face message-header-other
1103 (default :weight bold)
1104 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1105(mdw-define-face message-header-name
1106 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1107(mdw-define-face which-func
1108 (t nil))
1109
1110(mdw-define-face diff-header
1111 (t nil))
1112(mdw-define-face diff-index
1113 (t :weight bold))
1114(mdw-define-face diff-file-header
1115 (t :weight bold))
1116(mdw-define-face diff-hunk-header
1117 (t :foreground "SkyBlue1"))
1118(mdw-define-face diff-function
1119 (t :foreground "SkyBlue1" :weight bold))
1120(mdw-define-face diff-header
1121 (t :background "grey10"))
1122(mdw-define-face diff-added
1123 (t :foreground "green"))
1124(mdw-define-face diff-removed
1125 (t :foreground "red"))
1126(mdw-define-face diff-context
1127 (t nil))
1128(mdw-define-face diff-refine-change
1129 (((class color) (type x)) :background "RoyalBlue4")
1130 (t :underline t))
1131
1132(mdw-define-face dylan-header-background
1133 (((class color) (type x)) :background "NavyBlue")
1134 (t :background "blue"))
1135
1136(mdw-define-face magit-diff-add
1137 (t :foreground "green"))
1138(mdw-define-face magit-diff-del
1139 (t :foreground "red"))
1140(mdw-define-face magit-diff-file-header
1141 (t :weight bold))
1142(mdw-define-face magit-diff-hunk-header
1143 (t :foreground "SkyBlue1"))
1144(mdw-define-face magit-item-highlight
1145 (((type tty)) :background "blue")
1146 (t :background "DarkSeaGreen4"))
1147(mdw-define-face magit-log-head-label-remote
1148 (((type tty)) :background "cyan" :foreground "green")
1149 (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1150(mdw-define-face magit-log-head-label-local
1151 (((type tty)) :background "cyan" :foreground "yellow")
1152 (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1153(mdw-define-face magit-log-head-label-tags
1154 (((type tty)) :background "red" :foreground "yellow")
1155 (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1156(mdw-define-face magit-log-graph
1157 (((type tty)) :foreground "magenta")
1158 (t :foreground "grey80"))
1159
1160(mdw-define-face erc-input-face
1161 (t :foreground "red"))
1162
1163(mdw-define-face woman-bold
1164 (t :weight bold))
1165(mdw-define-face woman-italic
1166 (t :slant italic))
1167
1168(eval-after-load "rst"
1169 '(progn
1170 (mdw-define-face rst-level-1-face
1171 (t :foreground "SkyBlue1" :weight bold))
1172 (mdw-define-face rst-level-2-face
1173 (t :foreground "SeaGreen1" :weight bold))
1174 (mdw-define-face rst-level-3-face
1175 (t :weight bold))
1176 (mdw-define-face rst-level-4-face
1177 (t :slant italic))
1178 (mdw-define-face rst-level-5-face
1179 (t :underline t))
1180 (mdw-define-face rst-level-6-face
1181 ())))
1182
1183(mdw-define-face p4-depot-added-face
1184 (t :foreground "green"))
1185(mdw-define-face p4-depot-branch-op-face
1186 (t :foreground "yellow"))
1187(mdw-define-face p4-depot-deleted-face
1188 (t :foreground "red"))
1189(mdw-define-face p4-depot-unmapped-face
1190 (t :foreground "SkyBlue1"))
1191(mdw-define-face p4-diff-change-face
1192 (t :foreground "yellow"))
1193(mdw-define-face p4-diff-del-face
1194 (t :foreground "red"))
1195(mdw-define-face p4-diff-file-face
1196 (t :foreground "SkyBlue1"))
1197(mdw-define-face p4-diff-head-face
1198 (t :background "grey10"))
1199(mdw-define-face p4-diff-ins-face
1200 (t :foreground "green"))
1201
1202(mdw-define-face w3m-anchor-face
1203 (t :foreground "SkyBlue1" :underline t))
1204(mdw-define-face w3m-arrived-anchor-face
1205 (t :foreground "SkyBlue1" :underline t))
1206
1207(mdw-define-face whizzy-slice-face
1208 (t :background "grey10"))
1209(mdw-define-face whizzy-error-face
1210 (t :background "darkred"))
1211
1212;; Ellipses used to indicate hidden text (and similar).
1213(mdw-define-face mdw-ellipsis-face
1214 (((type tty)) :foreground "blue") (t :foreground "grey60"))
1215(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1216 (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1217 (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1218 (bar (make-glyph-code ?| mdw-ellipsis-face)))
1219 (set-display-table-slot standard-display-table 0 dollar)
1220 (set-display-table-slot standard-display-table 1 backslash)
1221 (set-display-table-slot standard-display-table 4
1222 (vector dot dot dot))
1223 (set-display-table-slot standard-display-table 5 bar))
1224
1225;;;--------------------------------------------------------------------------
1226;;; C programming configuration.
1227
1228;; Linux kernel hacking.
1229
1230(defvar linux-c-mode-hook)
1231
1232(defun linux-c-mode ()
1233 (interactive)
1234 (c-mode)
1235 (setq major-mode 'linux-c-mode)
1236 (setq mode-name "Linux C")
1237 (run-hooks 'linux-c-mode-hook))
1238
1239;; Make C indentation nice.
1240
1241(defun mdw-c-lineup-arglist (langelem)
1242 "Hack for DWIMmery in c-lineup-arglist."
1243 (if (save-excursion
1244 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1245 0
1246 (c-lineup-arglist langelem)))
1247
1248(defun mdw-c-indent-extern-mumble (langelem)
1249 "Indent `extern \"...\" {' lines."
1250 (save-excursion
1251 (back-to-indentation)
1252 (if (looking-at
1253 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1254 c-basic-offset
1255 nil)))
1256
1257(defun mdw-c-style ()
1258 (c-add-style "[mdw] C and C++ style"
1259 '((c-basic-offset . 2)
1260 (comment-column . 40)
1261 (c-class-key . "class")
1262 (c-backslash-column . 72)
1263 (c-offsets-alist
1264 (substatement-open . (add 0 c-indent-one-line-block))
1265 (defun-open . (add 0 c-indent-one-line-block))
1266 (arglist-cont-nonempty . mdw-c-lineup-arglist)
1267 (topmost-intro . mdw-c-indent-extern-mumble)
1268 (cpp-define-intro . 0)
1269 (knr-argdecl . 0)
1270 (inextern-lang . [0])
1271 (label . 0)
1272 (case-label . +)
1273 (access-label . -)
1274 (inclass . +)
1275 (inline-open . ++)
1276 (statement-cont . +)
1277 (statement-case-intro . +)))
1278 t))
1279
1280(defvar mdw-c-comment-fill-prefix
1281 `((,(concat "\\([ \t]*/?\\)"
1282 "\\(\*\\|//]\\)"
1283 "\\([ \t]*\\)"
1284 "\\([A-Za-z]+:[ \t]*\\)?"
1285 mdw-hanging-indents)
1286 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1287 "Fill prefix matching C comments (both kinds).")
1288
1289(defun mdw-fontify-c-and-c++ ()
1290
1291 ;; Fiddle with some syntax codes.
1292 (modify-syntax-entry ?* ". 23")
1293 (modify-syntax-entry ?/ ". 124b")
1294 (modify-syntax-entry ?\n "> b")
1295
1296 ;; Other stuff.
1297 (mdw-c-style)
1298 (setq c-hanging-comment-ender-p nil)
1299 (setq c-backslash-column 72)
1300 (setq c-label-minimum-indentation 0)
1301 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1302
1303 ;; Now define things to be fontified.
1304 (make-local-variable 'font-lock-keywords)
1305 (let ((c-keywords
1306 (mdw-regexps "and" ;C++
1307 "and_eq" ;C++
1308 "asm" ;K&R, GCC
1309 "auto" ;K&R, C89
1310 "bitand" ;C++
1311 "bitor" ;C++
1312 "bool" ;C++, C9X macro
1313 "break" ;K&R, C89
1314 "case" ;K&R, C89
1315 "catch" ;C++
1316 "char" ;K&R, C89
1317 "class" ;C++
1318 "complex" ;C9X macro, C++ template type
1319 "compl" ;C++
1320 "const" ;C89
1321 "const_cast" ;C++
1322 "continue" ;K&R, C89
1323 "defined" ;C89 preprocessor
1324 "default" ;K&R, C89
1325 "delete" ;C++
1326 "do" ;K&R, C89
1327 "double" ;K&R, C89
1328 "dynamic_cast" ;C++
1329 "else" ;K&R, C89
1330 ;; "entry" ;K&R -- never used
1331 "enum" ;C89
1332 "explicit" ;C++
1333 "export" ;C++
1334 "extern" ;K&R, C89
1335 "float" ;K&R, C89
1336 "for" ;K&R, C89
1337 ;; "fortran" ;K&R
1338 "friend" ;C++
1339 "goto" ;K&R, C89
1340 "if" ;K&R, C89
1341 "imaginary" ;C9X macro
1342 "inline" ;C++, C9X, GCC
1343 "int" ;K&R, C89
1344 "long" ;K&R, C89
1345 "mutable" ;C++
1346 "namespace" ;C++
1347 "new" ;C++
1348 "operator" ;C++
1349 "or" ;C++
1350 "or_eq" ;C++
1351 "private" ;C++
1352 "protected" ;C++
1353 "public" ;C++
1354 "register" ;K&R, C89
1355 "reinterpret_cast" ;C++
1356 "restrict" ;C9X
1357 "return" ;K&R, C89
1358 "short" ;K&R, C89
1359 "signed" ;C89
1360 "sizeof" ;K&R, C89
1361 "static" ;K&R, C89
1362 "static_cast" ;C++
1363 "struct" ;K&R, C89
1364 "switch" ;K&R, C89
1365 "template" ;C++
1366 "throw" ;C++
1367 "try" ;C++
1368 "this" ;C++
1369 "typedef" ;C89
1370 "typeid" ;C++
1371 "typeof" ;GCC
1372 "typename" ;C++
1373 "union" ;K&R, C89
1374 "unsigned" ;K&R, C89
1375 "using" ;C++
1376 "virtual" ;C++
1377 "void" ;C89
1378 "volatile" ;C89
1379 "wchar_t" ;C++, C89 library type
1380 "while" ;K&R, C89
1381 "xor" ;C++
1382 "xor_eq" ;C++
1383 "_Bool" ;C9X
1384 "_Complex" ;C9X
1385 "_Imaginary" ;C9X
1386 "_Pragma" ;C9X preprocessor
1387 "__alignof__" ;GCC
1388 "__asm__" ;GCC
1389 "__attribute__" ;GCC
1390 "__complex__" ;GCC
1391 "__const__" ;GCC
1392 "__extension__" ;GCC
1393 "__imag__" ;GCC
1394 "__inline__" ;GCC
1395 "__label__" ;GCC
1396 "__real__" ;GCC
1397 "__signed__" ;GCC
1398 "__typeof__" ;GCC
1399 "__volatile__" ;GCC
1400 ))
1401 (c-constants
1402 (mdw-regexps "false" ;C++, C9X macro
1403 "this" ;C++
1404 "true" ;C++, C9X macro
1405 ))
1406 (preprocessor-keywords
1407 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1408 "ident" "if" "ifdef" "ifndef" "import" "include"
1409 "line" "pragma" "unassert" "undef" "warning"))
1410 (objc-keywords
1411 (mdw-regexps "class" "defs" "encode" "end" "implementation"
1412 "interface" "private" "protected" "protocol" "public"
1413 "selector")))
1414
1415 (setq font-lock-keywords
1416 (list
1417
1418 ;; Fontify include files as strings.
1419 (list (concat "^[ \t]*\\#[ \t]*"
1420 "\\(include\\|import\\)"
1421 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1422 '(2 font-lock-string-face))
1423
1424 ;; Preprocessor directives are `references'?.
1425 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1426 preprocessor-keywords
1427 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1428 '(1 font-lock-keyword-face))
1429
1430 ;; Handle the keywords defined above.
1431 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1432 '(0 font-lock-keyword-face))
1433
1434 (list (concat "\\<\\(" c-keywords "\\)\\>")
1435 '(0 font-lock-keyword-face))
1436
1437 (list (concat "\\<\\(" c-constants "\\)\\>")
1438 '(0 font-lock-variable-name-face))
1439
1440 ;; Handle numbers too.
1441 ;;
1442 ;; This looks strange, I know. It corresponds to the
1443 ;; preprocessor's idea of what a number looks like, rather than
1444 ;; anything sensible.
1445 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1446 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1447 '(0 mdw-number-face))
1448
1449 ;; And anything else is punctuation.
1450 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1451 '(0 mdw-punct-face))))
1452
1453 (mdw-post-config-mode-hack)))
1454
1455;;;--------------------------------------------------------------------------
1456;;; AP calc mode.
1457
1458(defun apcalc-mode ()
1459 (interactive)
1460 (c-mode)
1461 (setq major-mode 'apcalc-mode)
1462 (setq mode-name "AP Calc")
1463 (run-hooks 'apcalc-mode-hook))
1464
1465(defun mdw-fontify-apcalc ()
1466
1467 ;; Fiddle with some syntax codes.
1468 (modify-syntax-entry ?* ". 23")
1469 (modify-syntax-entry ?/ ". 14")
1470
1471 ;; Other stuff.
1472 (mdw-c-style)
1473 (setq c-hanging-comment-ender-p nil)
1474 (setq c-backslash-column 72)
1475 (setq comment-start "/* ")
1476 (setq comment-end " */")
1477 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1478
1479 ;; Now define things to be fontified.
1480 (make-local-variable 'font-lock-keywords)
1481 (let ((c-keywords
1482 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1483 "do" "else" "exit" "for" "global" "goto" "help" "if"
1484 "local" "mat" "obj" "print" "quit" "read" "return"
1485 "show" "static" "switch" "while" "write")))
1486
1487 (setq font-lock-keywords
1488 (list
1489
1490 ;; Handle the keywords defined above.
1491 (list (concat "\\<\\(" c-keywords "\\)\\>")
1492 '(0 font-lock-keyword-face))
1493
1494 ;; Handle numbers too.
1495 ;;
1496 ;; This looks strange, I know. It corresponds to the
1497 ;; preprocessor's idea of what a number looks like, rather than
1498 ;; anything sensible.
1499 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1500 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1501 '(0 mdw-number-face))
1502
1503 ;; And anything else is punctuation.
1504 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1505 '(0 mdw-punct-face)))))
1506
1507 (mdw-post-config-mode-hack))
1508
1509;;;--------------------------------------------------------------------------
1510;;; Java programming configuration.
1511
1512;; Make indentation nice.
1513
1514(defun mdw-java-style ()
1515 (c-add-style "[mdw] Java style"
1516 '((c-basic-offset . 2)
1517 (c-offsets-alist (substatement-open . 0)
1518 (label . +)
1519 (case-label . +)
1520 (access-label . 0)
1521 (inclass . +)
1522 (statement-case-intro . +)))
1523 t))
1524
1525;; Declare Java fontification style.
1526
1527(defun mdw-fontify-java ()
1528
1529 ;; Other stuff.
1530 (mdw-java-style)
1531 (setq c-hanging-comment-ender-p nil)
1532 (setq c-backslash-column 72)
1533 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1534
1535 ;; Now define things to be fontified.
1536 (make-local-variable 'font-lock-keywords)
1537 (let ((java-keywords
1538 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1539 "char" "class" "const" "continue" "default" "do"
1540 "double" "else" "extends" "final" "finally" "float"
1541 "for" "goto" "if" "implements" "import" "instanceof"
1542 "int" "interface" "long" "native" "new" "package"
1543 "private" "protected" "public" "return" "short"
1544 "static" "switch" "synchronized" "throw" "throws"
1545 "transient" "try" "void" "volatile" "while"))
1546
1547 (java-constants
1548 (mdw-regexps "false" "null" "super" "this" "true")))
1549
1550 (setq font-lock-keywords
1551 (list
1552
1553 ;; Handle the keywords defined above.
1554 (list (concat "\\<\\(" java-keywords "\\)\\>")
1555 '(0 font-lock-keyword-face))
1556
1557 ;; Handle the magic constants defined above.
1558 (list (concat "\\<\\(" java-constants "\\)\\>")
1559 '(0 font-lock-variable-name-face))
1560
1561 ;; Handle numbers too.
1562 ;;
1563 ;; The following isn't quite right, but it's close enough.
1564 (list (concat "\\<\\("
1565 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1566 "[0-9]+\\(\\.[0-9]*\\|\\)"
1567 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1568 "[lLfFdD]?")
1569 '(0 mdw-number-face))
1570
1571 ;; And anything else is punctuation.
1572 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1573 '(0 mdw-punct-face)))))
1574
1575 (mdw-post-config-mode-hack))
1576
1577;;;--------------------------------------------------------------------------
1578;;; Javascript programming configuration.
1579
1580(defun mdw-javascript-style ()
1581 (setq js-indent-level 2)
1582 (setq js-expr-indent-offset 0))
1583
1584(defun mdw-fontify-javascript ()
1585
1586 ;; Other stuff.
1587 (mdw-javascript-style)
1588 (setq js-auto-indent-flag t)
1589
1590 ;; Now define things to be fontified.
1591 (make-local-variable 'font-lock-keywords)
1592 (let ((javascript-keywords
1593 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1594 "char" "class" "const" "continue" "debugger" "default"
1595 "delete" "do" "double" "else" "enum" "export" "extends"
1596 "final" "finally" "float" "for" "function" "goto" "if"
1597 "implements" "import" "in" "instanceof" "int"
1598 "interface" "let" "long" "native" "new" "package"
1599 "private" "protected" "public" "return" "short"
1600 "static" "super" "switch" "synchronized" "throw"
1601 "throws" "transient" "try" "typeof" "var" "void"
1602 "volatile" "while" "with" "yield"
1603
1604 "boolean" "byte" "char" "double" "float" "int" "long"
1605 "short" "void"))
1606 (javascript-constants
1607 (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1608 "arguments" "this")))
1609
1610 (setq font-lock-keywords
1611 (list
1612
1613 ;; Handle the keywords defined above.
1614 (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1615 '(0 font-lock-keyword-face))
1616
1617 ;; Handle the predefined constants defined above.
1618 (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1619 '(0 font-lock-variable-name-face))
1620
1621 ;; Handle numbers too.
1622 ;;
1623 ;; The following isn't quite right, but it's close enough.
1624 (list (concat "\\_<\\("
1625 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1626 "[0-9]+\\(\\.[0-9]*\\|\\)"
1627 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1628 "[lLfFdD]?")
1629 '(0 mdw-number-face))
1630
1631 ;; And anything else is punctuation.
1632 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1633 '(0 mdw-punct-face)))))
1634
1635 (mdw-post-config-mode-hack))
1636
1637;;;--------------------------------------------------------------------------
1638;;; Scala programming configuration.
1639
1640(defun mdw-fontify-scala ()
1641
1642 ;; Comment filling.
1643 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1644
1645 ;; Define things to be fontified.
1646 (make-local-variable 'font-lock-keywords)
1647 (let ((scala-keywords
1648 (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1649 "extends" "final" "finally" "for" "forSome" "if"
1650 "implicit" "import" "lazy" "match" "new" "object"
1651 "override" "package" "private" "protected" "return"
1652 "sealed" "throw" "trait" "try" "type" "val"
1653 "var" "while" "with" "yield"))
1654 (scala-constants
1655 (mdw-regexps "false" "null" "super" "this" "true"))
1656 (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1657
1658 (setq font-lock-keywords
1659 (list
1660
1661 ;; Magical identifiers between backticks.
1662 (list (concat "`\\([^`]+\\)`")
1663 '(1 font-lock-variable-name-face))
1664
1665 ;; Handle the keywords defined above.
1666 (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1667 '(0 font-lock-keyword-face))
1668
1669 ;; Handle the constants defined above.
1670 (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1671 '(0 font-lock-variable-name-face))
1672
1673 ;; Magical identifiers between backticks.
1674 (list (concat "`\\([^`]+\\)`")
1675 '(1 font-lock-variable-name-face))
1676
1677 ;; Handle numbers too.
1678 ;;
1679 ;; As usual, not quite right.
1680 (list (concat "\\_<\\("
1681 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1682 "[0-9]+\\(\\.[0-9]*\\|\\)"
1683 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1684 "[lLfFdD]?")
1685 '(0 mdw-number-face))
1686
1687 ;; Identifiers with trailing operators.
1688 (list (concat "_\\(" punctuation "\\)+")
1689 '(0 mdw-trivial-face))
1690
1691 ;; And everything else is punctuation.
1692 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1693 '(0 mdw-punct-face)))
1694
1695 font-lock-syntactic-keywords
1696 (list
1697
1698 ;; Single quotes around characters. But not when used to quote
1699 ;; symbol names. Ugh.
1700 (list (concat "\\('\\)"
1701 "\\(" "."
1702 "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1703 "u+" "[0-9a-fA-F]\\{4\\}"
1704 "\\|" "\\\\" "[0-7]\\{1,3\\}"
1705 "\\|" "\\\\" "." "\\)"
1706 "\\('\\)")
1707 '(1 "\"")
1708 '(4 "\"")))))
1709
1710 (mdw-post-config-mode-hack))
1711
1712;;;--------------------------------------------------------------------------
1713;;; C# programming configuration.
1714
1715;; Make indentation nice.
1716
1717(defun mdw-csharp-style ()
1718 (c-add-style "[mdw] C# style"
1719 '((c-basic-offset . 2)
1720 (c-offsets-alist (substatement-open . 0)
1721 (label . 0)
1722 (case-label . +)
1723 (access-label . 0)
1724 (inclass . +)
1725 (statement-case-intro . +)))
1726 t))
1727
1728;; Declare C# fontification style.
1729
1730(defun mdw-fontify-csharp ()
1731
1732 ;; Other stuff.
1733 (mdw-csharp-style)
1734 (setq c-hanging-comment-ender-p nil)
1735 (setq c-backslash-column 72)
1736 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1737
1738 ;; Now define things to be fontified.
1739 (make-local-variable 'font-lock-keywords)
1740 (let ((csharp-keywords
1741 (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1742 "char" "checked" "class" "const" "continue" "decimal"
1743 "default" "delegate" "do" "double" "else" "enum"
1744 "event" "explicit" "extern" "finally" "fixed" "float"
1745 "for" "foreach" "goto" "if" "implicit" "in" "int"
1746 "interface" "internal" "is" "lock" "long" "namespace"
1747 "new" "object" "operator" "out" "override" "params"
1748 "private" "protected" "public" "readonly" "ref"
1749 "return" "sbyte" "sealed" "short" "sizeof"
1750 "stackalloc" "static" "string" "struct" "switch"
1751 "throw" "try" "typeof" "uint" "ulong" "unchecked"
1752 "unsafe" "ushort" "using" "virtual" "void" "volatile"
1753 "while" "yield"))
1754
1755 (csharp-constants
1756 (mdw-regexps "base" "false" "null" "this" "true")))
1757
1758 (setq font-lock-keywords
1759 (list
1760
1761 ;; Handle the keywords defined above.
1762 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1763 '(0 font-lock-keyword-face))
1764
1765 ;; Handle the magic constants defined above.
1766 (list (concat "\\<\\(" csharp-constants "\\)\\>")
1767 '(0 font-lock-variable-name-face))
1768
1769 ;; Handle numbers too.
1770 ;;
1771 ;; The following isn't quite right, but it's close enough.
1772 (list (concat "\\<\\("
1773 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1774 "[0-9]+\\(\\.[0-9]*\\|\\)"
1775 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1776 "[lLfFdD]?")
1777 '(0 mdw-number-face))
1778
1779 ;; And anything else is punctuation.
1780 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1781 '(0 mdw-punct-face)))))
1782
1783 (mdw-post-config-mode-hack))
1784
1785(define-derived-mode csharp-mode java-mode "C#"
1786 "Major mode for editing C# code.")
1787
1788;;;--------------------------------------------------------------------------
1789;;; F# programming configuration.
1790
1791(setq fsharp-indent-offset 2)
1792
1793(defun mdw-fontify-fsharp ()
1794
1795 (let ((punct "=<>+-*/|&%!@?"))
1796 (do ((i 0 (1+ i)))
1797 ((>= i (length punct)))
1798 (modify-syntax-entry (aref punct i) ".")))
1799
1800 (modify-syntax-entry ?_ "_")
1801 (modify-syntax-entry ?( "(")
1802 (modify-syntax-entry ?) ")")
1803
1804 (setq indent-tabs-mode nil)
1805
1806 (let ((fsharp-keywords
1807 (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1808 "begin" "break"
1809 "checked" "class" "component" "const" "constraint"
1810 "constructor" "continue"
1811 "default" "delegate" "do" "done" "downcast" "downto"
1812 "eager" "elif" "else" "end" "exception" "extern"
1813 "finally" "fixed" "for" "fori" "fun" "function"
1814 "functor"
1815 "global"
1816 "if" "in" "include" "inherit" "inline" "interface"
1817 "internal"
1818 "lazy" "let"
1819 "match" "measure" "member" "method" "mixin" "module"
1820 "mutable"
1821 "namespace" "new"
1822 "object" "of" "open" "or" "override"
1823 "parallel" "params" "private" "process" "protected"
1824 "public" "pure"
1825 "rec" "recursive" "return"
1826 "sealed" "sig" "static" "struct"
1827 "tailcall" "then" "to" "trait" "try" "type"
1828 "upcast" "use"
1829 "val" "virtual" "void" "volatile"
1830 "when" "while" "with"
1831 "yield"))
1832
1833 (fsharp-builtins
1834 (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1835 "base" "false" "null" "true"))
1836
1837 (bang-keywords
1838 (mdw-regexps "do" "let" "return" "use" "yield"))
1839
1840 (preprocessor-keywords
1841 (mdw-regexps "if" "indent" "else" "endif")))
1842
1843 (setq font-lock-keywords
1844 (list (list (concat "\\(^\\|[^\"]\\)"
1845 "\\(" "(\\*"
1846 "[^*]*\\*+"
1847 "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1848 ")"
1849 "\\|"
1850 "//.*"
1851 "\\)")
1852 '(2 font-lock-comment-face))
1853
1854 (list (concat "'" "\\("
1855 "\\\\"
1856 "\\(" "[ntbr'\\]"
1857 "\\|" "[0-9][0-9][0-9]"
1858 "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1859 "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1860 "\\)"
1861 "\\|"
1862 "." "\\)" "'"
1863 "\\|"
1864 "\"" "[^\"\\]*"
1865 "\\(" "\\\\" "\\(.\\|\n\\)"
1866 "[^\"\\]*" "\\)*"
1867 "\\(\"\\|\\'\\)")
1868 '(0 font-lock-string-face))
1869
1870 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1871 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1872 "\\|"
1873 "\\_<\\(" fsharp-keywords "\\)\\_>")
1874 '(0 font-lock-keyword-face))
1875 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1876 '(0 font-lock-variable-name-face))
1877
1878 (list (concat "\\_<"
1879 "\\(" "0[bB][01]+" "\\|"
1880 "0[oO][0-7]+" "\\|"
1881 "0[xX][0-9a-fA-F]+" "\\)"
1882 "\\(" "lf\\|LF" "\\|"
1883 "[uU]?[ysnlL]?" "\\)"
1884 "\\|"
1885 "\\_<"
1886 "[0-9]+" "\\("
1887 "[mMQRZING]"
1888 "\\|"
1889 "\\(\\.[0-9]*\\)?"
1890 "\\([eE][-+]?[0-9]+\\)?"
1891 "[fFmM]?"
1892 "\\|"
1893 "[uU]?[ysnlL]?"
1894 "\\)")
1895 '(0 mdw-number-face))
1896
1897 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1898 '(0 mdw-punct-face)))))
1899
1900 (mdw-post-config-mode-hack))
1901
1902(defun mdw-fontify-inferior-fsharp ()
1903 (mdw-fontify-fsharp)
1904 (setq font-lock-keywords
1905 (append (list (list "^[#-]" '(0 font-lock-comment-face))
1906 (list "^>" '(0 font-lock-keyword-face)))
1907 font-lock-keywords)))
1908
1909;;;--------------------------------------------------------------------------
1910;;; Go programming configuration.
1911
1912(defun mdw-fontify-go ()
1913
1914 (make-local-variable 'font-lock-keywords)
1915 (let ((go-keywords
1916 (mdw-regexps "break" "case" "chan" "const" "continue"
1917 "default" "defer" "else" "fallthrough" "for"
1918 "func" "go" "goto" "if" "import"
1919 "interface" "map" "package" "range" "return"
1920 "select" "struct" "switch" "type" "var"))
1921 (go-intrinsics
1922 (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1923 "float32" "float64" "int" "uint8" "int16" "int32"
1924 "int64" "rune" "string" "uint" "uint8" "uint16"
1925 "uint32" "uint64" "uintptr" "void"
1926 "false" "iota" "nil" "true"
1927 "init" "main"
1928 "append" "cap" "copy" "delete" "imag" "len" "make"
1929 "new" "panic" "real" "recover")))
1930
1931 (setq font-lock-keywords
1932 (list
1933
1934 ;; Handle the keywords defined above.
1935 (list (concat "\\<\\(" go-keywords "\\)\\>")
1936 '(0 font-lock-keyword-face))
1937 (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1938 '(0 font-lock-variable-name-face))
1939
1940 ;; Strings and characters.
1941 (list (concat "'"
1942 "\\(" "[^\\']" "\\|"
1943 "\\\\"
1944 "\\(" "[abfnrtv\\'\"]" "\\|"
1945 "[0-7]\\{3\\}" "\\|"
1946 "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1947 "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1948 "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1949 "'"
1950 "\\|"
1951 "\""
1952 "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1953 "\\(\"\\|$\\)"
1954 "\\|"
1955 "`" "[^`]+" "`")
1956 '(0 font-lock-string-face))
1957
1958 ;; Handle numbers too.
1959 ;;
1960 ;; The following isn't quite right, but it's close enough.
1961 (list (concat "\\<\\("
1962 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1963 "[0-9]+\\(\\.[0-9]*\\|\\)"
1964 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1965 '(0 mdw-number-face))
1966
1967 ;; And anything else is punctuation.
1968 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1969 '(0 mdw-punct-face)))))
1970
1971 (mdw-post-config-mode-hack))
1972
1973;;;--------------------------------------------------------------------------
1974;;; Awk programming configuration.
1975
1976;; Make Awk indentation nice.
1977
1978(defun mdw-awk-style ()
1979 (c-add-style "[mdw] Awk style"
1980 '((c-basic-offset . 2)
1981 (c-offsets-alist (substatement-open . 0)
1982 (statement-cont . 0)
1983 (statement-case-intro . +)))
1984 t))
1985
1986;; Declare Awk fontification style.
1987
1988(defun mdw-fontify-awk ()
1989
1990 ;; Miscellaneous fiddling.
1991 (mdw-awk-style)
1992 (setq c-backslash-column 72)
1993 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1994
1995 ;; Now define things to be fontified.
1996 (make-local-variable 'font-lock-keywords)
1997 (let ((c-keywords
1998 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1999 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2000 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2001 "RSTART" "RLENGTH" "RT" "SUBSEP"
2002 "atan2" "break" "close" "continue" "cos" "delete"
2003 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2004 "function" "gensub" "getline" "gsub" "if" "in"
2005 "index" "int" "length" "log" "match" "next" "rand"
2006 "return" "print" "printf" "sin" "split" "sprintf"
2007 "sqrt" "srand" "strftime" "sub" "substr" "system"
2008 "systime" "tolower" "toupper" "while")))
2009
2010 (setq font-lock-keywords
2011 (list
2012
2013 ;; Handle the keywords defined above.
2014 (list (concat "\\<\\(" c-keywords "\\)\\>")
2015 '(0 font-lock-keyword-face))
2016
2017 ;; Handle numbers too.
2018 ;;
2019 ;; The following isn't quite right, but it's close enough.
2020 (list (concat "\\<\\("
2021 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2022 "[0-9]+\\(\\.[0-9]*\\|\\)"
2023 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2024 "[uUlL]*")
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;;;--------------------------------------------------------------------------
2034;;; Perl programming style.
2035
2036;; Perl indentation style.
2037
2038(setq cperl-indent-level 2)
2039(setq cperl-continued-statement-offset 2)
2040(setq cperl-continued-brace-offset 0)
2041(setq cperl-brace-offset -2)
2042(setq cperl-brace-imaginary-offset 0)
2043(setq cperl-label-offset 0)
2044
2045;; Define perl fontification style.
2046
2047(defun mdw-fontify-perl ()
2048
2049 ;; Miscellaneous fiddling.
2050 (modify-syntax-entry ?$ "\\")
2051 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2052 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2053
2054 ;; Now define fontification things.
2055 (make-local-variable 'font-lock-keywords)
2056 (let ((perl-keywords
2057 (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
2058 "for" "foreach" "ge" "given" "gt" "goto" "if"
2059 "last" "le" "lt" "local" "my" "ne" "next" "or"
2060 "our" "package" "redo" "require" "return" "sub"
2061 "undef" "unless" "until" "use" "when" "while")))
2062
2063 (setq font-lock-keywords
2064 (list
2065
2066 ;; Set up the keywords defined above.
2067 (list (concat "\\<\\(" perl-keywords "\\)\\>")
2068 '(0 font-lock-keyword-face))
2069
2070 ;; At least numbers are simpler than C.
2071 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2072 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2073 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2074 '(0 mdw-number-face))
2075
2076 ;; And anything else is punctuation.
2077 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2078 '(0 mdw-punct-face)))))
2079
2080 (mdw-post-config-mode-hack))
2081
2082(defun perl-number-tests (&optional arg)
2083 "Assign consecutive numbers to lines containing `#t'. With ARG,
2084strip numbers instead."
2085 (interactive "P")
2086 (save-excursion
2087 (goto-char (point-min))
2088 (let ((i 0) (fmt (if arg "" " %4d")))
2089 (while (search-forward "#t" nil t)
2090 (delete-region (point) (line-end-position))
2091 (setq i (1+ i))
2092 (insert (format fmt i)))
2093 (goto-char (point-min))
2094 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2095 (replace-match (format "\\1%d" i))))))
2096
2097;;;--------------------------------------------------------------------------
2098;;; Python programming style.
2099
2100(defun mdw-fontify-pythonic (keywords)
2101
2102 ;; Miscellaneous fiddling.
2103 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2104 (setq indent-tabs-mode nil)
2105
2106 ;; Now define fontification things.
2107 (make-local-variable 'font-lock-keywords)
2108 (setq font-lock-keywords
2109 (list
2110
2111 ;; Set up the keywords defined above.
2112 (list (concat "\\_<\\(" keywords "\\)\\_>")
2113 '(0 font-lock-keyword-face))
2114
2115 ;; At least numbers are simpler than C.
2116 (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2117 "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2118 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2119 '(0 mdw-number-face))
2120
2121 ;; And anything else is punctuation.
2122 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2123 '(0 mdw-punct-face))))
2124
2125 (mdw-post-config-mode-hack))
2126
2127;; Define Python fontification styles.
2128
2129(defun mdw-fontify-python ()
2130 (mdw-fontify-pythonic
2131 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2132 "del" "elif" "else" "except" "exec" "finally" "for"
2133 "from" "global" "if" "import" "in" "is" "lambda"
2134 "not" "or" "pass" "print" "raise" "return" "try"
2135 "while" "with" "yield")))
2136
2137(defun mdw-fontify-pyrex ()
2138 (mdw-fontify-pythonic
2139 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2140 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2141 "extern" "finally" "for" "from" "global" "if"
2142 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2143 "raise" "return" "struct" "try" "while" "with"
2144 "yield")))
2145
2146;;;--------------------------------------------------------------------------
2147;;; Icon programming style.
2148
2149;; Icon indentation style.
2150
2151(setq icon-brace-offset 0
2152 icon-continued-brace-offset 0
2153 icon-continued-statement-offset 2
2154 icon-indent-level 2)
2155
2156;; Define Icon fontification style.
2157
2158(defun mdw-fontify-icon ()
2159
2160 ;; Miscellaneous fiddling.
2161 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2162
2163 ;; Now define fontification things.
2164 (make-local-variable 'font-lock-keywords)
2165 (let ((icon-keywords
2166 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2167 "end" "every" "fail" "global" "if" "initial"
2168 "invocable" "link" "local" "next" "not" "of"
2169 "procedure" "record" "repeat" "return" "static"
2170 "suspend" "then" "to" "until" "while"))
2171 (preprocessor-keywords
2172 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2173 "include" "line" "undef")))
2174 (setq font-lock-keywords
2175 (list
2176
2177 ;; Set up the keywords defined above.
2178 (list (concat "\\<\\(" icon-keywords "\\)\\>")
2179 '(0 font-lock-keyword-face))
2180
2181 ;; The things that Icon calls keywords.
2182 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2183
2184 ;; At least numbers are simpler than C.
2185 (list (concat "\\<[0-9]+"
2186 "\\([rR][0-9a-zA-Z]+\\|"
2187 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2188 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2189 '(0 mdw-number-face))
2190
2191 ;; Preprocessor.
2192 (list (concat "^[ \t]*$[ \t]*\\<\\("
2193 preprocessor-keywords
2194 "\\)\\>")
2195 '(0 font-lock-keyword-face))
2196
2197 ;; And anything else is punctuation.
2198 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2199 '(0 mdw-punct-face)))))
2200
2201 (mdw-post-config-mode-hack))
2202
2203;;;--------------------------------------------------------------------------
2204;;; Assembler mode.
2205
2206(defun mdw-fontify-asm ()
2207 (modify-syntax-entry ?' "\"")
2208 (modify-syntax-entry ?. "w")
2209 (modify-syntax-entry ?; "."
2210 )
2211 (modify-syntax-entry asm-comment-char "<b")
2212 (modify-syntax-entry ?\n ">")
2213 (setf fill-prefix nil)
2214 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2215
2216(define-derived-mode x86-asm-mode asm-mode "x86 assembler"
2217 "Assembler mode variant which uses `#' as the comment character."
2218 (set (make-variable-buffer-local 'asm-comment-char) ?#))
2219
2220(define-derived-mode arm-asm-mode asm-mode "ARM assembler"
2221 "Assembler mode variant which uses `@' as the comment character."
2222 (set (make-variable-buffer-local 'asm-comment-char) ?@))
2223
2224;;;--------------------------------------------------------------------------
2225;;; TCL configuration.
2226
2227(defun mdw-fontify-tcl ()
2228 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2229 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2230 (make-local-variable 'font-lock-keywords)
2231 (setq font-lock-keywords
2232 (list
2233 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2234 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2235 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2236 '(0 mdw-number-face))
2237 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2238 '(0 mdw-punct-face))))
2239 (mdw-post-config-mode-hack))
2240
2241;;;--------------------------------------------------------------------------
2242;;; Dylan programming configuration.
2243
2244(defun mdw-fontify-dylan ()
2245
2246 (make-local-variable 'font-lock-keywords)
2247
2248 ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
2249 ;; hook, which undoes all of our configuration.
2250 (setq major-mode 'dylan-mode)
2251 (font-lock-set-defaults)
2252
2253 (let* ((word "[-_a-zA-Z!*@<>$%]+")
2254 (dylan-keywords (mdw-regexps
2255
2256 "C-address" "C-callable-wrapper" "C-function"
2257 "C-mapped-subtype" "C-pointer-type" "C-struct"
2258 "C-subtype" "C-union" "C-variable"
2259
2260 "above" "abstract" "afterwards" "all"
2261 "begin" "below" "block" "by"
2262 "case" "class" "cleanup" "constant" "create"
2263 "define" "domain"
2264 "else" "elseif" "end" "exception" "export"
2265 "finally" "for" "from" "function"
2266 "generic"
2267 "handler"
2268 "if" "in" "instance" "interface" "iterate"
2269 "keyed-by"
2270 "let" "library" "local"
2271 "macro" "method" "module"
2272 "otherwise"
2273 "profiling"
2274 "select" "slot" "subclass"
2275 "table" "then" "to"
2276 "unless" "until" "use"
2277 "variable" "virtual"
2278 "when" "while"))
2279 (sharp-keywords (mdw-regexps
2280 "all-keys" "key" "next" "rest" "include"
2281 "t" "f")))
2282 (setq font-lock-keywords
2283 (list (list (concat "\\<\\(" dylan-keywords
2284 "\\|" "with\\(out\\)?-" word
2285 "\\)\\>")
2286 '(0 font-lock-keyword-face))
2287 (list (concat "\\<" word ":" "\\|"
2288 "#\\(" sharp-keywords "\\)\\>")
2289 '(0 font-lock-variable-name-face))
2290 (list (concat "\\("
2291 "\\([-+]\\|\\<\\)[0-9]+" "\\("
2292 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2293 "\\|" "/[0-9]+"
2294 "\\)"
2295 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2296 "\\|" "#b[01]+"
2297 "\\|" "#o[0-7]+"
2298 "\\|" "#x[0-9a-zA-Z]+"
2299 "\\)\\>")
2300 '(0 mdw-number-face))
2301 (list (concat "\\("
2302 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2303 "\\_<[-+*/=<>:&|]+\\_>"
2304 "\\)")
2305 '(0 mdw-punct-face)))))
2306
2307 (mdw-post-config-mode-hack))
2308
2309;;;--------------------------------------------------------------------------
2310;;; Algol 68 configuration.
2311
2312(setq a68-indent-step 2)
2313
2314(defun mdw-fontify-algol-68 ()
2315
2316 ;; Fix up the syntax table.
2317 (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2318 (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2319 (modify-syntax-entry ch "." a68-mode-syntax-table))
2320
2321 (make-local-variable 'font-lock-keywords)
2322
2323 (let ((not-comment
2324 (let ((word "COMMENT"))
2325 (do ((regexp (concat "[^" (substring word 0 1) "]+")
2326 (concat regexp "\\|"
2327 (substring word 0 i)
2328 "[^" (substring word i (1+ i)) "]"))
2329 (i 1 (1+ i)))
2330 ((>= i (length word)) regexp)))))
2331 (setq font-lock-keywords
2332 (list (list (concat "\\<COMMENT\\>"
2333 "\\(" not-comment "\\)\\{0,5\\}"
2334 "\\(\\'\\|\\<COMMENT\\>\\)")
2335 '(0 font-lock-comment-face))
2336 (list (concat "\\<CO\\>"
2337 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2338 "\\($\\|\\<CO\\>\\)")
2339 '(0 font-lock-comment-face))
2340 (list "\\<[A-Z_]+\\>"
2341 '(0 font-lock-keyword-face))
2342 (list (concat "\\<"
2343 "[0-9]+"
2344 "\\(\\.[0-9]+\\)?"
2345 "\\([eE][-+]?[0-9]+\\)?"
2346 "\\>")
2347 '(0 mdw-number-face))
2348 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2349 '(0 mdw-punct-face)))))
2350
2351 (mdw-post-config-mode-hack))
2352
2353;;;--------------------------------------------------------------------------
2354;;; REXX configuration.
2355
2356(defun mdw-rexx-electric-* ()
2357 (interactive)
2358 (insert ?*)
2359 (rexx-indent-line))
2360
2361(defun mdw-rexx-indent-newline-indent ()
2362 (interactive)
2363 (rexx-indent-line)
2364 (if abbrev-mode (expand-abbrev))
2365 (newline-and-indent))
2366
2367(defun mdw-fontify-rexx ()
2368
2369 ;; Various bits of fiddling.
2370 (setq mdw-auto-indent nil)
2371 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2372 (local-set-key [?*] 'mdw-rexx-electric-*)
2373 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2374 '(?! ?? ?# ?@ ?$))
2375 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2376
2377 ;; Set up keywords and things for fontification.
2378 (make-local-variable 'font-lock-keywords-case-fold-search)
2379 (setq font-lock-keywords-case-fold-search t)
2380
2381 (setq rexx-indent 2)
2382 (setq rexx-end-indent rexx-indent)
2383 (setq rexx-cont-indent rexx-indent)
2384
2385 (make-local-variable 'font-lock-keywords)
2386 (let ((rexx-keywords
2387 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2388 "else" "end" "engineering" "exit" "expose" "for"
2389 "forever" "form" "fuzz" "if" "interpret" "iterate"
2390 "leave" "linein" "name" "nop" "numeric" "off" "on"
2391 "options" "otherwise" "parse" "procedure" "pull"
2392 "push" "queue" "return" "say" "select" "signal"
2393 "scientific" "source" "then" "trace" "to" "until"
2394 "upper" "value" "var" "version" "when" "while"
2395 "with"
2396
2397 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2398 "center" "center" "charin" "charout" "chars"
2399 "compare" "condition" "copies" "c2d" "c2x"
2400 "datatype" "date" "delstr" "delword" "d2c" "d2x"
2401 "errortext" "format" "fuzz" "insert" "lastpos"
2402 "left" "length" "lineout" "lines" "max" "min"
2403 "overlay" "pos" "queued" "random" "reverse" "right"
2404 "sign" "sourceline" "space" "stream" "strip"
2405 "substr" "subword" "symbol" "time" "translate"
2406 "trunc" "value" "verify" "word" "wordindex"
2407 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2408 "x2d")))
2409
2410 (setq font-lock-keywords
2411 (list
2412
2413 ;; Set up the keywords defined above.
2414 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2415 '(0 font-lock-keyword-face))
2416
2417 ;; Fontify all symbols the same way.
2418 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2419 "[A-Za-z0-9.!?_#@$]+\\)")
2420 '(0 font-lock-variable-name-face))
2421
2422 ;; And everything else is punctuation.
2423 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2424 '(0 mdw-punct-face)))))
2425
2426 (mdw-post-config-mode-hack))
2427
2428;;;--------------------------------------------------------------------------
2429;;; Standard ML programming style.
2430
2431(defun mdw-fontify-sml ()
2432
2433 ;; Make underscore an honorary letter.
2434 (modify-syntax-entry ?' "w")
2435
2436 ;; Set fill prefix.
2437 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2438
2439 ;; Now define fontification things.
2440 (make-local-variable 'font-lock-keywords)
2441 (let ((sml-keywords
2442 (mdw-regexps "abstype" "and" "andalso" "as"
2443 "case"
2444 "datatype" "do"
2445 "else" "end" "eqtype" "exception"
2446 "fn" "fun" "functor"
2447 "handle"
2448 "if" "in" "include" "infix" "infixr"
2449 "let" "local"
2450 "nonfix"
2451 "of" "op" "open" "orelse"
2452 "raise" "rec"
2453 "sharing" "sig" "signature" "struct" "structure"
2454 "then" "type"
2455 "val"
2456 "where" "while" "with" "withtype")))
2457
2458 (setq font-lock-keywords
2459 (list
2460
2461 ;; Set up the keywords defined above.
2462 (list (concat "\\<\\(" sml-keywords "\\)\\>")
2463 '(0 font-lock-keyword-face))
2464
2465 ;; At least numbers are simpler than C.
2466 (list (concat "\\<\\(\\~\\|\\)"
2467 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2468 "[wW][0-9]+\\)\\|"
2469 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2470 "\\([eE]\\(\\~\\|\\)"
2471 "[0-9]+\\|\\)\\)\\)")
2472 '(0 mdw-number-face))
2473
2474 ;; And anything else is punctuation.
2475 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2476 '(0 mdw-punct-face)))))
2477
2478 (mdw-post-config-mode-hack))
2479
2480;;;--------------------------------------------------------------------------
2481;;; Haskell configuration.
2482
2483(defun mdw-fontify-haskell ()
2484
2485 ;; Fiddle with syntax table to get comments right.
2486 (modify-syntax-entry ?' "_")
2487 (modify-syntax-entry ?- ". 12")
2488 (modify-syntax-entry ?\n ">")
2489
2490 ;; Make punctuation be punctuation
2491 (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2492 (do ((i 0 (1+ i)))
2493 ((>= i (length punct)))
2494 (modify-syntax-entry (aref punct i) ".")))
2495
2496 ;; Set fill prefix.
2497 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2498
2499 ;; Fiddle with fontification.
2500 (make-local-variable 'font-lock-keywords)
2501 (let ((haskell-keywords
2502 (mdw-regexps "as"
2503 "case" "ccall" "class"
2504 "data" "default" "deriving" "do"
2505 "else" "exists"
2506 "forall" "foreign"
2507 "hiding"
2508 "if" "import" "in" "infix" "infixl" "infixr" "instance"
2509 "let"
2510 "mdo" "module"
2511 "newtype"
2512 "of"
2513 "proc"
2514 "qualified"
2515 "rec"
2516 "safe" "stdcall"
2517 "then" "type"
2518 "unsafe"
2519 "where"))
2520 (control-sequences
2521 (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2522 "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2523 "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2524 "SP" "STX" "SUB" "SYN" "US" "VT")))
2525
2526 (setq font-lock-keywords
2527 (list
2528 (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2529 "\\(-+}\\|-*\\'\\)"
2530 "\\|"
2531 "--.*$")
2532 '(0 font-lock-comment-face))
2533 (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2534 '(0 font-lock-keyword-face))
2535 (list (concat "'\\("
2536 "[^\\]"
2537 "\\|"
2538 "\\\\"
2539 "\\(" "[abfnrtv\\\"']" "\\|"
2540 "^" "\\(" control-sequences "\\|"
2541 "[]A-Z@[\\^_]" "\\)" "\\|"
2542 "\\|"
2543 "[0-9]+" "\\|"
2544 "[oO][0-7]+" "\\|"
2545 "[xX][0-9A-Fa-f]+"
2546 "\\)"
2547 "\\)'")
2548 '(0 font-lock-string-face))
2549 (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2550 '(0 font-lock-variable-name-face))
2551 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2552 "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2553 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2554 '(0 mdw-number-face))
2555 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2556 '(0 mdw-punct-face)))))
2557
2558 (mdw-post-config-mode-hack))
2559
2560;;;--------------------------------------------------------------------------
2561;;; Erlang configuration.
2562
2563(setq erlang-electric-commands nil)
2564
2565(defun mdw-fontify-erlang ()
2566
2567 ;; Set fill prefix.
2568 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2569
2570 ;; Fiddle with fontification.
2571 (make-local-variable 'font-lock-keywords)
2572 (let ((erlang-keywords
2573 (mdw-regexps "after" "and" "andalso"
2574 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2575 "case" "catch" "cond"
2576 "div" "end" "fun" "if" "let" "not"
2577 "of" "or" "orelse"
2578 "query" "receive" "rem" "try" "when" "xor")))
2579
2580 (setq font-lock-keywords
2581 (list
2582 (list "%.*$"
2583 '(0 font-lock-comment-face))
2584 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2585 '(0 font-lock-keyword-face))
2586 (list (concat "^-\\sw+\\>")
2587 '(0 font-lock-keyword-face))
2588 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2589 '(0 mdw-number-face))
2590 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2591 '(0 mdw-punct-face)))))
2592
2593 (mdw-post-config-mode-hack))
2594
2595;;;--------------------------------------------------------------------------
2596;;; Texinfo configuration.
2597
2598(defun mdw-fontify-texinfo ()
2599
2600 ;; Set fill prefix.
2601 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2602
2603 ;; Real fontification things.
2604 (make-local-variable 'font-lock-keywords)
2605 (setq font-lock-keywords
2606 (list
2607
2608 ;; Environment names are keywords.
2609 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
2610 '(2 font-lock-keyword-face))
2611
2612 ;; Unmark escaped magic characters.
2613 (list "\\(@\\)\\([@{}]\\)"
2614 '(1 font-lock-keyword-face)
2615 '(2 font-lock-variable-name-face))
2616
2617 ;; Make sure we get comments properly.
2618 (list "@c\\(\\|omment\\)\\( .*\\)?$"
2619 '(0 font-lock-comment-face))
2620
2621 ;; Command names are keywords.
2622 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2623 '(0 font-lock-keyword-face))
2624
2625 ;; Fontify TeX special characters as punctuation.
2626 (list "[{}]+"
2627 '(0 mdw-punct-face))))
2628
2629 (mdw-post-config-mode-hack))
2630
2631;;;--------------------------------------------------------------------------
2632;;; TeX and LaTeX configuration.
2633
2634(defun mdw-fontify-tex ()
2635 (setq ispell-parser 'tex)
2636 (turn-on-reftex)
2637
2638 ;; Don't make maths into a string.
2639 (modify-syntax-entry ?$ ".")
2640 (modify-syntax-entry ?$ "." font-lock-syntax-table)
2641 (local-set-key [?$] 'self-insert-command)
2642
2643 ;; Set fill prefix.
2644 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2645
2646 ;; Real fontification things.
2647 (make-local-variable 'font-lock-keywords)
2648 (setq font-lock-keywords
2649 (list
2650
2651 ;; Environment names are keywords.
2652 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2653 "{\\([^}\n]*\\)}")
2654 '(2 font-lock-keyword-face))
2655
2656 ;; Suspended environment names are keywords too.
2657 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2658 "{\\([^}\n]*\\)}")
2659 '(3 font-lock-keyword-face))
2660
2661 ;; Command names are keywords.
2662 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2663 '(0 font-lock-keyword-face))
2664
2665 ;; Handle @/.../ for italics.
2666 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2667 ;; '(1 font-lock-keyword-face)
2668 ;; '(3 font-lock-keyword-face))
2669
2670 ;; Handle @*...* for boldness.
2671 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2672 ;; '(1 font-lock-keyword-face)
2673 ;; '(3 font-lock-keyword-face))
2674
2675 ;; Handle @`...' for literal syntax things.
2676 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2677 ;; '(1 font-lock-keyword-face)
2678 ;; '(3 font-lock-keyword-face))
2679
2680 ;; Handle @<...> for nonterminals.
2681 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2682 ;; '(1 font-lock-keyword-face)
2683 ;; '(3 font-lock-keyword-face))
2684
2685 ;; Handle other @-commands.
2686 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2687 ;; '(0 font-lock-keyword-face))
2688
2689 ;; Make sure we get comments properly.
2690 (list "%.*"
2691 '(0 font-lock-comment-face))
2692
2693 ;; Fontify TeX special characters as punctuation.
2694 (list "[$^_{}#&]"
2695 '(0 mdw-punct-face))))
2696
2697 (mdw-post-config-mode-hack))
2698
2699;;;--------------------------------------------------------------------------
2700;;; SGML hacking.
2701
2702(defun mdw-sgml-mode ()
2703 (interactive)
2704 (sgml-mode)
2705 (mdw-standard-fill-prefix "")
2706 (make-local-variable 'sgml-delimiters)
2707 (setq sgml-delimiters
2708 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2709 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2710 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2711 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2712 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2713 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2714 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2715 "NULL" ""))
2716 (setq major-mode 'mdw-sgml-mode)
2717 (setq mode-name "[mdw] SGML")
2718 (run-hooks 'mdw-sgml-mode-hook))
2719
2720;;;--------------------------------------------------------------------------
2721;;; Configuration files.
2722
2723(defvar mdw-conf-quote-normal nil
2724 "*Control syntax category of quote characters `\"' and `''.
2725If this is `t', consider quote characters to be normal
2726punctuation, as for `conf-quote-normal'. If this is `nil' then
2727leave quote characters as quotes. If this is a list, then
2728consider the quote characters in the list to be normal
2729punctuation. If this is a single quote character, then consider
2730that character only to be normal punctuation.")
2731(defun mdw-conf-quote-normal-acceptable-value-p (value)
2732 "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2733 (or (booleanp value)
2734 (every (lambda (v) (memq v '(?\" ?')))
2735 (if (listp value) value (list value)))))
2736(put 'mdw-conf-quote-normal 'safe-local-variable '
2737 mdw-conf-quote-normal-acceptable-value-p)
2738
2739(defun mdw-fix-up-quote ()
2740 "Apply the setting of `mdw-conf-quote-normal'."
2741 (let ((flag mdw-conf-quote-normal))
2742 (cond ((eq flag t)
2743 (conf-quote-normal t))
2744 ((not flag)
2745 nil)
2746 (t
2747 (let ((table (copy-syntax-table (syntax-table))))
2748 (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2749 (if (listp flag) flag (list flag)))
2750 (set-syntax-table table)
2751 (and font-lock-mode (font-lock-fontify-buffer)))))))
2752(defun mdw-fix-up-quote-hack ()
2753 "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2754Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2755so we wouldn't see a local-variable setting of
2756`mdw-conf-quote-normal' in `conf-mode-hook'. Instead, wire
2757ourselves onto `hack-local-variables-hook' here, and check the
2758setting once it's actually been made."
2759 (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2760(add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2761
2762;;;--------------------------------------------------------------------------
2763;;; Shell scripts.
2764
2765(defun mdw-setup-sh-script-mode ()
2766
2767 ;; Fetch the shell interpreter's name.
2768 (let ((shell-name sh-shell-file))
2769
2770 ;; Try reading the hash-bang line.
2771 (save-excursion
2772 (goto-char (point-min))
2773 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2774 (setq shell-name (match-string 1))))
2775
2776 ;; Now try to set the shell.
2777 ;;
2778 ;; Don't let `sh-set-shell' bugger up my script.
2779 (let ((executable-set-magic #'(lambda (s &rest r) s)))
2780 (sh-set-shell shell-name)))
2781
2782 ;; Now enable my keys and the fontification.
2783 (mdw-misc-mode-config)
2784
2785 ;; Set the indentation level correctly.
2786 (setq sh-indentation 2)
2787 (setq sh-basic-offset 2))
2788
2789(setq sh-shell-file "/bin/sh")
2790
2791;; Awful hacking to override the shell detection for particular scripts.
2792(defmacro define-custom-shell-mode (name shell)
2793 `(defun ,name ()
2794 (interactive)
2795 (set (make-local-variable 'sh-shell-file) ,shell)
2796 (sh-mode)))
2797(define-custom-shell-mode bash-mode "/bin/bash")
2798(define-custom-shell-mode rc-mode "/usr/bin/rc")
2799(put 'sh-shell-file 'permanent-local t)
2800
2801;; Hack the rc syntax table. Backquotes aren't paired in rc.
2802(eval-after-load "sh-script"
2803 '(or (assq 'rc sh-mode-syntax-table-input)
2804 (let ((frag '(nil
2805 ?# "<"
2806 ?\n ">#"
2807 ?\" "\"\""
2808 ?\' "\"\'"
2809 ?$ "'"
2810 ?\` "."
2811 ?! "_"
2812 ?% "_"
2813 ?. "_"
2814 ?^ "_"
2815 ?~ "_"
2816 ?, "_"
2817 ?= "."
2818 ?< "."
2819 ?> "."))
2820 (assoc (assq 'rc sh-mode-syntax-table-input)))
2821 (if assoc
2822 (rplacd assoc frag)
2823 (setq sh-mode-syntax-table-input
2824 (cons (cons 'rc frag)
2825 sh-mode-syntax-table-input))))))
2826
2827;;;--------------------------------------------------------------------------
2828;;; Emacs shell mode.
2829
2830(defun mdw-eshell-prompt ()
2831 (let ((left "[") (right "]"))
2832 (when (= (user-uid) 0)
2833 (setq left "«" right "»"))
2834 (concat left
2835 (save-match-data
2836 (replace-regexp-in-string "\\..*$" "" (system-name)))
2837 " "
2838 (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2839 (home (expand-file-name "~")) (nhome (length home)))
2840 (if (and (>= npwd nhome)
2841 (or (= nhome npwd)
2842 (= (elt pwd nhome) ?/))
2843 (string= (substring pwd 0 nhome) home))
2844 (concat "~" (substring pwd (length home)))
2845 pwd))
2846 right)))
2847(setq eshell-prompt-function 'mdw-eshell-prompt)
2848(setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2849
2850(defun eshell/e (file) (find-file file) nil)
2851(defun eshell/ee (file) (find-file-other-window file) nil)
2852(defun eshell/w3m (url) (w3m-goto-url url) nil)
2853
2854(mdw-define-face eshell-prompt (t :weight bold))
2855(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2856(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2857(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2858(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2859(mdw-define-face eshell-ls-executable (t :weight bold))
2860(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2861(mdw-define-face eshell-ls-readonly (t nil))
2862(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2863
2864;;;--------------------------------------------------------------------------
2865;;; Messages-file mode.
2866
2867(defun messages-mode-guts ()
2868 (setq messages-mode-syntax-table (make-syntax-table))
2869 (set-syntax-table messages-mode-syntax-table)
2870 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2871 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2872 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2873 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2874 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2875 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2876 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2877 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2878 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2879 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2880 (make-local-variable 'comment-start)
2881 (make-local-variable 'comment-end)
2882 (make-local-variable 'indent-line-function)
2883 (setq indent-line-function 'indent-relative)
2884 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2885 (make-local-variable 'font-lock-defaults)
2886 (make-local-variable 'messages-mode-keywords)
2887 (let ((keywords
2888 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2889 "export" "enum" "fixed-octetstring" "flags"
2890 "harmless" "map" "nested" "optional"
2891 "optional-tagged" "package" "primitive"
2892 "primitive-nullfree" "relaxed[ \t]+enum"
2893 "set" "table" "tagged-optional" "union"
2894 "variadic" "vector" "version" "version-tag")))
2895 (setq messages-mode-keywords
2896 (list
2897 (list (concat "\\<\\(" keywords "\\)\\>:")
2898 '(0 font-lock-keyword-face))
2899 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2900 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2901 (0 font-lock-variable-name-face))
2902 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2903 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2904 (0 mdw-punct-face)))))
2905 (setq font-lock-defaults
2906 '(messages-mode-keywords nil nil nil nil))
2907 (run-hooks 'messages-file-hook))
2908
2909(defun messages-mode ()
2910 (interactive)
2911 (fundamental-mode)
2912 (setq major-mode 'messages-mode)
2913 (setq mode-name "Messages")
2914 (messages-mode-guts)
2915 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2916 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2917 (setq comment-start "# ")
2918 (setq comment-end "")
2919 (run-hooks 'messages-mode-hook))
2920
2921(defun cpp-messages-mode ()
2922 (interactive)
2923 (fundamental-mode)
2924 (setq major-mode 'cpp-messages-mode)
2925 (setq mode-name "CPP Messages")
2926 (messages-mode-guts)
2927 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2928 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2929 (setq comment-start "/* ")
2930 (setq comment-end " */")
2931 (let ((preprocessor-keywords
2932 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2933 "ident" "if" "ifdef" "ifndef" "import" "include"
2934 "line" "pragma" "unassert" "undef" "warning")))
2935 (setq messages-mode-keywords
2936 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2937 "\\(include\\|import\\)"
2938 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2939 '(2 font-lock-string-face))
2940 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2941 preprocessor-keywords
2942 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2943 '(1 font-lock-keyword-face)))
2944 messages-mode-keywords)))
2945 (run-hooks 'cpp-messages-mode-hook))
2946
2947(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2948(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2949; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2950
2951;;;--------------------------------------------------------------------------
2952;;; Messages-file mode.
2953
2954(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2955 "Face to use for subsittution directives.")
2956(make-face 'mallow-driver-substitution-face)
2957(defvar mallow-driver-text-face 'mallow-driver-text-face
2958 "Face to use for body text.")
2959(make-face 'mallow-driver-text-face)
2960
2961(defun mallow-driver-mode ()
2962 (interactive)
2963 (fundamental-mode)
2964 (setq major-mode 'mallow-driver-mode)
2965 (setq mode-name "Mallow driver")
2966 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2967 (set-syntax-table mallow-driver-mode-syntax-table)
2968 (make-local-variable 'comment-start)
2969 (make-local-variable 'comment-end)
2970 (make-local-variable 'indent-line-function)
2971 (setq indent-line-function 'indent-relative)
2972 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2973 (make-local-variable 'font-lock-defaults)
2974 (make-local-variable 'mallow-driver-mode-keywords)
2975 (let ((keywords
2976 (mdw-regexps "each" "divert" "file" "if"
2977 "perl" "set" "string" "type" "write")))
2978 (setq mallow-driver-mode-keywords
2979 (list
2980 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2981 '(0 font-lock-keyword-face))
2982 (list "^%\\s *\\(#.*\\|\\)$"
2983 '(0 font-lock-comment-face))
2984 (list "^%"
2985 '(0 font-lock-keyword-face))
2986 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2987 (list "\\${[^}]*}"
2988 '(0 mallow-driver-substitution-face t)))))
2989 (setq font-lock-defaults
2990 '(mallow-driver-mode-keywords nil nil nil nil))
2991 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2992 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2993 (setq comment-start "%# ")
2994 (setq comment-end "")
2995 (run-hooks 'mallow-driver-mode-hook))
2996
2997(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2998
2999;;;--------------------------------------------------------------------------
3000;;; NFast debugs.
3001
3002(defun nfast-debug-mode ()
3003 (interactive)
3004 (fundamental-mode)
3005 (setq major-mode 'nfast-debug-mode)
3006 (setq mode-name "NFast debug")
3007 (setq messages-mode-syntax-table (make-syntax-table))
3008 (set-syntax-table messages-mode-syntax-table)
3009 (make-local-variable 'font-lock-defaults)
3010 (make-local-variable 'nfast-debug-mode-keywords)
3011 (setq truncate-lines t)
3012 (setq nfast-debug-mode-keywords
3013 (list
3014 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3015 (0 font-lock-keyword-face))
3016 (list (concat "^[ \t]+\\(\\("
3017 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3018 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3019 "[ \t]+\\)*"
3020 "[0-9a-fA-F]+\\)[ \t]*$")
3021 '(0 mdw-number-face))
3022 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3023 (1 font-lock-keyword-face))
3024 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3025 (1 font-lock-warning-face))
3026 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3027 (1 nil))
3028 (list (concat "^[ \t]+\\.cmd=[ \t]+"
3029 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3030 '(1 font-lock-keyword-face))
3031 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3032 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3033 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3034 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3035 (setq font-lock-defaults
3036 '(nfast-debug-mode-keywords nil nil nil nil))
3037 (run-hooks 'nfast-debug-mode-hook))
3038
3039;;;--------------------------------------------------------------------------
3040;;; Other languages.
3041
3042;; Smalltalk.
3043
3044(defun mdw-setup-smalltalk ()
3045 (and mdw-auto-indent
3046 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3047 (make-local-variable 'mdw-auto-indent)
3048 (setq mdw-auto-indent nil)
3049 (local-set-key "\C-i" 'smalltalk-reindent))
3050
3051(defun mdw-fontify-smalltalk ()
3052 (make-local-variable 'font-lock-keywords)
3053 (setq font-lock-keywords
3054 (list
3055 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3056 '(0 font-lock-keyword-face))
3057 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3058 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3059 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3060 '(0 mdw-number-face))
3061 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3062 '(0 mdw-punct-face))))
3063 (mdw-post-config-mode-hack))
3064
3065;; Lispy languages.
3066
3067;; Unpleasant bodge.
3068(unless (boundp 'slime-repl-mode-map)
3069 (setq slime-repl-mode-map (make-sparse-keymap)))
3070
3071(defun mdw-indent-newline-and-indent ()
3072 (interactive)
3073 (indent-for-tab-command)
3074 (newline-and-indent))
3075
3076(eval-after-load "cl-indent"
3077 '(progn
3078 (mapc #'(lambda (pair)
3079 (put (car pair)
3080 'common-lisp-indent-function
3081 (cdr pair)))
3082 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3083 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3084
3085(defun mdw-common-lisp-indent ()
3086 (make-local-variable 'lisp-indent-function)
3087 (setq lisp-indent-function 'common-lisp-indent-function))
3088
3089(setq lisp-simple-loop-indentation 2
3090 lisp-loop-keyword-indentation 6
3091 lisp-loop-forms-indentation 6)
3092
3093(defun mdw-fontify-lispy ()
3094
3095 ;; Set fill prefix.
3096 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3097
3098 ;; Not much fontification needed.
3099 (make-local-variable 'font-lock-keywords)
3100 (setq font-lock-keywords
3101 (list (list (concat "\\("
3102 "\\_<[-+]?"
3103 "\\(" "[0-9]+/[0-9]+"
3104 "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3105 "\\.[0-9]+" "\\)"
3106 "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3107 "\\)"
3108 "\\|"
3109 "#"
3110 "\\(" "x" "[-+]?"
3111 "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3112 "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3113 "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3114 "\\|" "[0-9]+" "r" "[-+]?"
3115 "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3116 "\\)"
3117 "\\)\\_>")
3118 '(0 mdw-number-face))
3119 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3120 '(0 mdw-punct-face))))
3121
3122 (mdw-post-config-mode-hack))
3123
3124(defun comint-send-and-indent ()
3125 (interactive)
3126 (comint-send-input)
3127 (and mdw-auto-indent
3128 (indent-for-tab-command)))
3129
3130(defun mdw-setup-m4 ()
3131
3132 ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
3133 ;; annoying: fix it.
3134 (modify-syntax-entry ?{ "(")
3135 (modify-syntax-entry ?} ")")
3136
3137 ;; Fill prefix.
3138 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3139
3140;;;--------------------------------------------------------------------------
3141;;; Text mode.
3142
3143(defun mdw-text-mode ()
3144 (setq fill-column 72)
3145 (flyspell-mode t)
3146 (mdw-standard-fill-prefix
3147 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3148 (auto-fill-mode 1))
3149
3150;;;--------------------------------------------------------------------------
3151;;; Outline and hide/show modes.
3152
3153(defun mdw-outline-collapse-all ()
3154 "Completely collapse everything in the entire buffer."
3155 (interactive)
3156 (save-excursion
3157 (goto-char (point-min))
3158 (while (< (point) (point-max))
3159 (hide-subtree)
3160 (forward-line))))
3161
3162(setq hs-hide-comments-when-hiding-all nil)
3163
3164(defadvice hs-hide-all (after hide-first-comment activate)
3165 (save-excursion (hs-hide-initial-comment-block)))
3166
3167;;;--------------------------------------------------------------------------
3168;;; Shell mode.
3169
3170(defun mdw-sh-mode-setup ()
3171 (local-set-key [?\C-a] 'comint-bol)
3172 (add-hook 'comint-output-filter-functions
3173 'comint-watch-for-password-prompt))
3174
3175(defun mdw-term-mode-setup ()
3176 (setq term-prompt-regexp shell-prompt-pattern)
3177 (make-local-variable 'mouse-yank-at-point)
3178 (make-local-variable 'transient-mark-mode)
3179 (setq mouse-yank-at-point t)
3180 (auto-fill-mode -1)
3181 (setq tab-width 8))
3182
3183(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3184(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
3185(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3186(defun term-send-meta-meta-something ()
3187 (interactive)
3188 (term-send-raw-string "\e\e")
3189 (term-send-raw))
3190(eval-after-load 'term
3191 '(progn
3192 (define-key term-raw-map [?\e ?\e] nil)
3193 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3194 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3195 (define-key term-raw-map [M-right] 'term-send-meta-right)
3196 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3197 (define-key term-raw-map [M-left] 'term-send-meta-left)
3198 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3199
3200(defadvice term-exec (before program-args-list compile activate)
3201 "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3202This allows you to pass a list of arguments through `ansi-term'."
3203 (let ((program (ad-get-arg 2)))
3204 (if (listp program)
3205 (progn
3206 (ad-set-arg 2 (car program))
3207 (ad-set-arg 4 (cdr program))))))
3208
3209(defun ssh (host)
3210 "Open a terminal containing an ssh session to the HOST."
3211 (interactive "sHost: ")
3212 (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3213
3214(defvar git-grep-command
3215 "env PAGER=cat git grep --no-color -nH -e "
3216 "*The default command for \\[git-grep].")
3217
3218(defvar git-grep-history nil)
3219
3220(defun git-grep (command-args)
3221 "Run `git grep' with user-specified args and collect output in a buffer."
3222 (interactive
3223 (list (read-shell-command "Run git grep (like this): "
3224 git-grep-command 'git-grep-history)))
3225 (grep command-args))
3226
3227;;;--------------------------------------------------------------------------
3228;;; Inferior Emacs Lisp.
3229
3230(setq comint-prompt-read-only t)
3231
3232(eval-after-load "comint"
3233 '(progn
3234 (define-key comint-mode-map "\C-w" 'comint-kill-region)
3235 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3236
3237(eval-after-load "ielm"
3238 '(progn
3239 (define-key ielm-map "\C-w" 'comint-kill-region)
3240 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3241
3242;;;----- That's all, folks --------------------------------------------------
3243
3244(provide 'dot-emacs)