chiark / gitweb /
dot/bash_profile: Don't start new gnome-keyring-daemon processes.
[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;; Splitting windows.
128
129(unless (fboundp 'scroll-bar-columns)
130 (defun scroll-bar-columns (side)
131 (cond ((eq side 'left) 0)
132 (window-system 3)
133 (t 1))))
134(unless (fboundp 'fringe-columns)
135 (defun fringe-columns (side)
136 (cond ((not window-system) 0)
137 ((eq side 'left) 1)
138 (t 2))))
139
140(defun mdw-divvy-window (&optional width)
141 "Split a wide window into appropriate widths."
142 (interactive "P")
143 (setq width (cond (width (prefix-numeric-value width))
144 ((and window-system
145 (>= emacs-major-version 22))
146 77)
147 (t 78)))
148 (let* ((win (selected-window))
149 (sb-width (if (not window-system)
150 1
151 (let ((tot 0))
152 (dolist (what '(scroll-bar fringe))
153 (dolist (side '(left right))
154 (incf tot
155 (funcall (intern (concat (symbol-name what)
156 "-columns"))
157 side))))
158 tot)))
159 (c (/ (+ (window-width) sb-width)
160 (+ width sb-width))))
161 (while (> c 1)
162 (setq c (1- c))
163 (split-window-horizontally (+ width sb-width))
164 (other-window 1))
165 (select-window win)))
166
167;; Transient mark mode hacks.
168
169(defadvice exchange-point-and-mark
170 (around mdw-highlight (&optional arg) activate compile)
171 "Maybe don't actually exchange point and mark.
172If `transient-mark-mode' is on and the mark is inactive, then
173just activate it. A non-trivial prefix argument will force the
174usual behaviour. A trivial prefix argument (i.e., just C-u) will
175activate the mark and temporarily enable `transient-mark-mode' if
176it's currently off."
177 (cond ((or mark-active
178 (and (not transient-mark-mode) (not arg))
179 (and arg (or (not (consp arg))
180 (not (= (car arg) 4)))))
181 ad-do-it)
182 (t
183 (or transient-mark-mode (setq transient-mark-mode 'only))
184 (set-mark (mark t)))))
185
186;; Functions for sexp diary entries.
187
188(defun mdw-weekday (l)
189 "Return non-nil if `date' falls on one of the days of the week in L.
190L is a list of day numbers (from 0 to 6 for Sunday through to
191Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
192the date stored in `date' falls on a listed day, then the
193function returns non-nil."
194 (let ((d (calendar-day-of-week date)))
195 (or (memq d l)
196 (memq (nth d '(sunday monday tuesday wednesday
197 thursday friday saturday)) l))))
198
199(defun mdw-todo (&optional when)
200 "Return non-nil today, or on WHEN, whichever is later."
201 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
202 (d (calendar-absolute-from-gregorian date)))
203 (if when
204 (setq w (max w (calendar-absolute-from-gregorian
205 (cond
206 ((not european-calendar-style)
207 when)
208 ((> (car when) 100)
209 (list (nth 1 when)
210 (nth 2 when)
211 (nth 0 when)))
212 (t
213 (list (nth 1 when)
214 (nth 0 when)
215 (nth 2 when))))))))
216 (eq w d)))
217
218;; Fighting with Org-mode's evil key maps.
219
220(defvar mdw-evil-keymap-keys
221 '(([S-up] . [?\C-c up])
222 ([S-down] . [?\C-c down])
223 ([S-left] . [?\C-c left])
224 ([S-right] . [?\C-c right])
225 (([M-up] [?\e up]) . [C-up])
226 (([M-down] [?\e down]) . [C-down])
227 (([M-left] [?\e left]) . [C-left])
228 (([M-right] [?\e right]) . [C-right]))
229 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
230The value is an alist mapping evil keys (as a list, or singleton)
231to good keys (in the same form).")
232
233(defun mdw-clobber-evil-keymap (keymap)
234 "Replace evil key bindings in the KEYMAP.
235Evil key bindings are defined in `mdw-evil-keymap-keys'."
236 (dolist (entry mdw-evil-keymap-keys)
237 (let ((binding nil)
238 (keys (if (listp (car entry))
239 (car entry)
240 (list (car entry))))
241 (replacements (if (listp (cdr entry))
242 (cdr entry)
243 (list (cdr entry)))))
244 (catch 'found
245 (dolist (key keys)
246 (setq binding (lookup-key keymap key))
247 (when binding
248 (throw 'found nil))))
249 (when binding
250 (dolist (key keys)
251 (define-key keymap key nil))
252 (dolist (key replacements)
253 (define-key keymap key binding))))))
254
255(eval-after-load "org-latex"
256 '(progn
257 (push '("strayman"
258 "\\documentclass{strayman}
259\\usepackage[utf8]{inputenc}
260\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
261\\usepackage[T1]{fontenc}
262\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
263 ("\\section{%s}" . "\\section*{%s}")
264 ("\\subsection{%s}" . "\\subsection*{%s}")
265 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
266 ("\\paragraph{%s}" . "\\paragraph*{%s}")
267 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
268 org-export-latex-classes)))
269
270;;;--------------------------------------------------------------------------
271;;; Mail and news hacking.
272
273(define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
274 "Major mode for editing news and mail messages from external programs.
275Not much right now. Just support for doing MailCrypt stuff."
276 :syntax-table nil
277 :abbrev-table nil
278 (run-hooks 'mail-setup-hook))
279
280(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
281
282(add-hook 'mdwail-mode-hook
283 (lambda ()
284 (set-buffer-file-coding-system 'utf-8)
285 (make-local-variable 'paragraph-separate)
286 (make-local-variable 'paragraph-start)
287 (setq paragraph-start
288 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
289 paragraph-start))
290 (setq paragraph-separate
291 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
292 paragraph-separate))))
293
294;; How to encrypt in mdwmail.
295
296(defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
297 (or start
298 (setq start (save-excursion
299 (goto-char (point-min))
300 (or (search-forward "\n\n" nil t) (point-min)))))
301 (or end
302 (setq end (point-max)))
303 (mc-encrypt-generic recip scm start end from sign))
304
305;; How to sign in mdwmail.
306
307(defun mdwmail-mc-sign (key scm start end uclr)
308 (or start
309 (setq start (save-excursion
310 (goto-char (point-min))
311 (or (search-forward "\n\n" nil t) (point-min)))))
312 (or end
313 (setq end (point-max)))
314 (mc-sign-generic key scm start end uclr))
315
316;; Some signature mangling.
317
318(defun mdwmail-mangle-signature ()
319 (save-excursion
320 (goto-char (point-min))
321 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
322(add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
323(add-hook 'message-setup-hook 'mdwmail-mangle-signature)
324
325;; Insert my login name into message-ids, so I can score replies.
326
327(defadvice message-unique-id (after mdw-user-name last activate compile)
328 "Ensure that the user's name appears at the end of the message-id string,
329so that it can be used for convenient filtering."
330 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
331
332;; Tell my movemail hack where movemail is.
333;;
334;; This is needed to shup up warnings about LD_PRELOAD.
335
336(let ((path exec-path))
337 (while path
338 (let ((try (expand-file-name "movemail" (car path))))
339 (if (file-executable-p try)
340 (setenv "REAL_MOVEMAIL" try))
341 (setq path (cdr path)))))
342
343;;;--------------------------------------------------------------------------
344;;; Utility functions.
345
346(or (fboundp 'line-number-at-pos)
347 (defun line-number-at-pos (&optional pos)
348 (let ((opoint (or pos (point))) start)
349 (save-excursion
350 (save-restriction
351 (goto-char (point-min))
352 (widen)
353 (forward-line 0)
354 (setq start (point))
355 (goto-char opoint)
356 (forward-line 0)
357 (1+ (count-lines 1 (point))))))))
358
359(defun mdw-uniquify-alist (&rest alists)
360 "Return the concatenation of the ALISTS with duplicate elements removed.
361The first association with a given key prevails; others are
362ignored. The input lists are not modified, although they'll
363probably become garbage."
364 (and alists
365 (let ((start-list (cons nil nil)))
366 (mdw-do-uniquify start-list
367 start-list
368 (car alists)
369 (cdr alists)))))
370
371(defun mdw-do-uniquify (done end l rest)
372 "A helper function for mdw-uniquify-alist.
373The DONE argument is a list whose first element is `nil'. It
374contains the uniquified alist built so far. The leading `nil' is
375stripped off at the end of the operation; it's only there so that
376DONE always references a cons cell. END refers to the final cons
377cell in the DONE list; it is modified in place each time to avoid
378the overheads of `append'ing all the time. The L argument is the
379alist we're currently processing; the remaining alists are given
380in REST."
381
382 ;; There are several different cases to deal with here.
383 (cond
384
385 ;; Current list isn't empty. Add the first item to the DONE list if
386 ;; there's not an item with the same KEY already there.
387 (l (or (assoc (car (car l)) done)
388 (progn
389 (setcdr end (cons (car l) nil))
390 (setq end (cdr end))))
391 (mdw-do-uniquify done end (cdr l) rest))
392
393 ;; The list we were working on is empty. Shunt the next list into the
394 ;; current list position and go round again.
395 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
396
397 ;; Everything's done. Remove the leading `nil' from the DONE list and
398 ;; return it. Finished!
399 (t (cdr done))))
400
401(defun date ()
402 "Insert the current date in a pleasing way."
403 (interactive)
404 (insert (save-excursion
405 (let ((buffer (get-buffer-create "*tmp*")))
406 (unwind-protect (progn (set-buffer buffer)
407 (erase-buffer)
408 (shell-command "date +%Y-%m-%d" t)
409 (goto-char (mark))
410 (delete-backward-char 1)
411 (buffer-string))
412 (kill-buffer buffer))))))
413
414(defun uuencode (file &optional name)
415 "UUencodes a file, maybe calling it NAME, into the current buffer."
416 (interactive "fInput file name: ")
417
418 ;; If NAME isn't specified, then guess from the filename.
419 (if (not name)
420 (setq name
421 (substring file
422 (or (string-match "[^/]*$" file) 0))))
423 (print (format "uuencode `%s' `%s'" file name))
424
425 ;; Now actually do the thing.
426 (call-process "uuencode" file t nil name))
427
428(defvar np-file "~/.np"
429 "*Where the `now-playing' file is.")
430
431(defun np (&optional arg)
432 "Grabs a `now-playing' string."
433 (interactive)
434 (save-excursion
435 (or arg (progn
436 (goto-char (point-max))
437 (insert "\nNP: ")
438 (insert-file-contents np-file)))))
439
440(defun mdw-version-< (ver-a ver-b)
441 "Answer whether VER-A is strictly earlier than VER-B.
442VER-A and VER-B are version numbers, which are strings containing digit
443sequences separated by `.'."
444 (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
445 (split-string ver-a "\\.")))
446 (lb (mapcar (lambda (x) (car (read-from-string x)))
447 (split-string ver-b "\\."))))
448 (catch 'done
449 (while t
450 (cond ((null la) (throw 'done lb))
451 ((null lb) (throw 'done nil))
452 ((< (car la) (car lb)) (throw 'done t))
453 ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
454
455(defun mdw-check-autorevert ()
456 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
457This takes into consideration whether it's been found using
458tramp, which seems to get itself into a twist."
459 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
460 nil)
461 ((and (buffer-file-name)
462 (fboundp 'tramp-tramp-file-p)
463 (tramp-tramp-file-p (buffer-file-name)))
464 (unless global-auto-revert-ignore-buffer
465 (setq global-auto-revert-ignore-buffer 'tramp)))
466 ((eq global-auto-revert-ignore-buffer 'tramp)
467 (setq global-auto-revert-ignore-buffer nil))))
468
469(defadvice find-file (after mdw-autorevert activate)
470 (mdw-check-autorevert))
471(defadvice write-file (after mdw-autorevert activate)
472 (mdw-check-autorevert))
473
474;;;--------------------------------------------------------------------------
475;;; Dired hacking.
476
477(defadvice dired-maybe-insert-subdir
478 (around mdw-marked-insertion first activate)
479 "The DIRNAME may be a list of directory names to insert.
480Interactively, if files are marked, then insert all of them.
481With a numeric prefix argument, select that many entries near
482point; with a non-numeric prefix argument, prompt for listing
483options."
484 (interactive
485 (list (dired-get-marked-files nil
486 (and (integerp current-prefix-arg)
487 current-prefix-arg)
488 #'file-directory-p)
489 (and current-prefix-arg
490 (not (integerp current-prefix-arg))
491 (read-string "Switches for listing: "
492 (or dired-subdir-switches
493 dired-actual-switches)))))
494 (let ((dirs (ad-get-arg 0)))
495 (dolist (dir (if (listp dirs) dirs (list dirs)))
496 (ad-set-arg 0 dir)
497 ad-do-it)))
498
499;;;--------------------------------------------------------------------------
500;;; URL viewing.
501
502(defun mdw-w3m-browse-url (url &optional new-session-p)
503 "Invoke w3m on the URL in its current window, or at least a different one.
504If NEW-SESSION-P, start a new session."
505 (interactive "sURL: \nP")
506 (save-excursion
507 (let ((window (selected-window)))
508 (unwind-protect
509 (progn
510 (select-window (or (and (not new-session-p)
511 (get-buffer-window "*w3m*"))
512 (progn
513 (if (one-window-p t) (split-window))
514 (get-lru-window))))
515 (w3m-browse-url url new-session-p))
516 (select-window window)))))
517
518(defvar mdw-good-url-browsers
519 '(browse-url-generic
520 (w3m . mdw-w3m-browse-url)
521 browse-url-w3
522 browse-url-mozilla)
523 "List of good browsers for mdw-good-url-browsers.
524Each item is a browser function name, or a cons (CHECK . FUNC).
525A symbol FOO stands for (FOO . FOO).")
526
527(defun mdw-good-url-browser ()
528 "Return a good URL browser.
529Trundle the list of such things, finding the first item for which
530CHECK is fboundp, and returning the correponding FUNC."
531 (let ((bs mdw-good-url-browsers) b check func answer)
532 (while (and bs (not answer))
533 (setq b (car bs)
534 bs (cdr bs))
535 (if (consp b)
536 (setq check (car b) func (cdr b))
537 (setq check b func b))
538 (if (fboundp check)
539 (setq answer func)))
540 answer))
541
542(eval-after-load "w3m-search"
543 '(progn
544 (dolist
545 (item
546 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
547 ("gd" "Google Directory"
548 "http://www.google.com/search?cat=gwd/Top&q=%s")
549 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
550 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
551 ("gi" "Images" "http://images.google.com/images?q=%s")
552 ("rfc" "RFC"
553 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
554 ("wp" "Wikipedia"
555 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
556 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
557 ("nc-wiki" "nCipher wiki"
558 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
559 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
560 ("lp" "Launchpad bug by number"
561 "https://bugs.launchpad.net/bugs/%s")
562 ("lppkg" "Launchpad bugs by package"
563 "https://bugs.launchpad.net/%s")
564 ("msdn" "MSDN"
565 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
566 ("debbug" "Debian bug by number"
567 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
568 ("debbugpkg" "Debian bugs by package"
569 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
570 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
571 (add-to-list 'w3m-search-engine-alist
572 (list (cadr item) (caddr item) nil))
573 (add-to-list 'w3m-uri-replace-alist
574 (list (concat "\\`" (car item) ":")
575 'w3m-search-uri-replace
576 (cadr item))))))
577
578;;;--------------------------------------------------------------------------
579;;; Paragraph filling.
580
581;; Useful variables.
582
583(defvar mdw-fill-prefix nil
584 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
585If there's no fill prefix currently set (by the `fill-prefix'
586variable) and there's a match from one of the regexps here, it
587gets used to set the fill-prefix for the current operation.
588
589The variable is a list of items of the form `REGEXP . PREFIX'; if
590the REGEXP matches, the PREFIX is used to set the fill prefix.
591It in turn is a list of things:
592
593 STRING -- insert a literal string
594 (match . N) -- insert the thing matched by bracketed subexpression N
595 (pad . N) -- a string of whitespace the same width as subexpression N
596 (expr . FORM) -- the result of evaluating FORM")
597
598(make-variable-buffer-local 'mdw-fill-prefix)
599
600(defvar mdw-hanging-indents
601 (concat "\\(\\("
602 "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
603 "[ \t]+"
604 "\\)?\\)")
605 "*Standard regexp matching parts of a hanging indent.
606This is mainly useful in `auto-fill-mode'.")
607
608;; Setting things up.
609
610(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
611
612;; Utility functions.
613
614(defun mdw-tabify (s)
615 "Tabify the string S. This is a horrid hack."
616 (save-excursion
617 (save-match-data
618 (let (start end)
619 (beginning-of-line)
620 (setq start (point-marker))
621 (insert s "\n")
622 (setq end (point-marker))
623 (tabify start end)
624 (setq s (buffer-substring start (1- end)))
625 (delete-region start end)
626 (set-marker start nil)
627 (set-marker end nil)
628 s))))
629
630(defun mdw-examine-fill-prefixes (l)
631 "Given a list of dynamic fill prefixes, pick one which matches
632context and return the static fill prefix to use. Point must be
633at the start of a line, and match data must be saved."
634 (cond ((not l) nil)
635 ((looking-at (car (car l)))
636 (mdw-tabify (apply (function concat)
637 (mapcar (function mdw-do-prefix-match)
638 (cdr (car l))))))
639 (t (mdw-examine-fill-prefixes (cdr l)))))
640
641(defun mdw-maybe-car (p)
642 "If P is a pair, return (car P), otherwise just return P."
643 (if (consp p) (car p) p))
644
645(defun mdw-padding (s)
646 "Return a string the same width as S but made entirely from whitespace."
647 (let* ((l (length s)) (i 0) (n (make-string l ? )))
648 (while (< i l)
649 (if (= 9 (aref s i))
650 (aset n i 9))
651 (setq i (1+ i)))
652 n))
653
654(defun mdw-do-prefix-match (m)
655 "Expand a dynamic prefix match element.
656See `mdw-fill-prefix' for details."
657 (cond ((not (consp m)) (format "%s" m))
658 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
659 ((eq (car m) 'pad) (mdw-padding (match-string
660 (mdw-maybe-car (cdr m)))))
661 ((eq (car m) 'eval) (eval (cdr m)))
662 (t "")))
663
664(defun mdw-choose-dynamic-fill-prefix ()
665 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
666 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
667 ((not mdw-fill-prefix) fill-prefix)
668 (t (save-excursion
669 (beginning-of-line)
670 (save-match-data
671 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
672
673(defun do-auto-fill ()
674 "Handle auto-filling, working out a dynamic fill prefix in the
675case where there isn't a sensible static one."
676 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
677 (mdw-do-auto-fill)))
678
679(defun mdw-fill-paragraph ()
680 "Fill paragraph, getting a dynamic fill prefix."
681 (interactive)
682 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
683 (fill-paragraph nil)))
684
685(defun mdw-standard-fill-prefix (rx &optional mat)
686 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
687This is just a short-cut for setting the thing by hand, and by
688design it doesn't cope with anything approximating a complicated
689case."
690 (setq mdw-fill-prefix
691 `((,(concat rx mdw-hanging-indents)
692 (match . 1)
693 (pad . ,(or mat 2))))))
694
695;;;--------------------------------------------------------------------------
696;;; Other common declarations.
697
698;; Common mode settings.
699
700(defvar mdw-auto-indent t
701 "Whether to indent automatically after a newline.")
702
703(defun mdw-whitespace-mode (&optional arg)
704 "Turn on/off whitespace mode, but don't highlight trailing space."
705 (interactive "P")
706 (when (and (boundp 'whitespace-style)
707 (fboundp 'whitespace-mode))
708 (let ((whitespace-style (remove 'trailing whitespace-style)))
709 (whitespace-mode arg))
710 (setq show-trailing-whitespace whitespace-mode)))
711
712(defun mdw-misc-mode-config ()
713 (and mdw-auto-indent
714 (cond ((eq major-mode 'lisp-mode)
715 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
716 ((or (eq major-mode 'slime-repl-mode)
717 (eq major-mode 'asm-mode))
718 nil)
719 (t
720 (local-set-key "\C-m" 'newline-and-indent))))
721 (local-set-key [C-return] 'newline)
722 (make-local-variable 'page-delimiter)
723 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
724 (setq comment-column 40)
725 (auto-fill-mode 1)
726 (setq fill-column 77)
727 (setq show-trailing-whitespace t)
728 (mdw-whitespace-mode 1)
729 (and (fboundp 'gtags-mode)
730 (gtags-mode))
731 (outline-minor-mode t)
732 (hs-minor-mode t)
733 (reveal-mode t)
734 (trap (turn-on-font-lock)))
735
736(defun mdw-post-config-mode-hack ()
737 (mdw-whitespace-mode 1))
738
739(eval-after-load 'gtags
740 '(progn
741 (dolist (key '([mouse-2] [mouse-3]))
742 (define-key gtags-mode-map key nil))
743 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
744 (define-key gtags-select-mode-map [C-S-mouse-2]
745 'gtags-select-tag-by-event)
746 (dolist (map (list gtags-mode-map gtags-select-mode-map))
747 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
748
749;; Backup file handling.
750
751(defvar mdw-backup-disable-regexps nil
752 "*List of regular expressions: if a file name matches any of
753these then the file is not backed up.")
754
755(defun mdw-backup-enable-predicate (name)
756 "[mdw]'s default backup predicate.
757Allows a backup if the standard predicate would allow it, and it
758doesn't match any of the regular expressions in
759`mdw-backup-disable-regexps'."
760 (and (normal-backup-enable-predicate name)
761 (let ((answer t) (list mdw-backup-disable-regexps))
762 (save-match-data
763 (while list
764 (if (string-match (car list) name)
765 (setq answer nil))
766 (setq list (cdr list)))
767 answer))))
768(setq backup-enable-predicate 'mdw-backup-enable-predicate)
769
770;; Frame cleanup.
771
772(defun mdw-last-one-out-turn-off-the-lights (frame)
773 "Disconnect from an X display if this was the last frame on that display."
774 (let ((frame-display (frame-parameter frame 'display)))
775 (when (and frame-display
776 (eq window-system 'x)
777 (not (some (lambda (fr)
778 (and (not (eq fr frame))
779 (string= (frame-parameter fr 'display)
780 frame-display)))
781 (frame-list))))
782 (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
783(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
784
785;;;--------------------------------------------------------------------------
786;;; General fontification.
787
788(defmacro mdw-define-face (name &rest body)
789 "Define a face, and make sure it's actually set as the definition."
790 (declare (indent 1)
791 (debug 0))
792 `(progn
793 (make-face ',name)
794 (defvar ,name ',name)
795 (put ',name 'face-defface-spec ',body)
796 (face-spec-set ',name ',body nil)))
797
798(mdw-define-face default
799 (((type w32)) :family "courier new" :height 85)
800 (((type x)) :family "6x13" :height 130)
801 (((type color)) :foreground "white" :background "black")
802 (t nil))
803(mdw-define-face fixed-pitch
804 (((type w32)) :family "courier new" :height 85)
805 (((type x)) :family "6x13" :height 130)
806 (t :foreground "white" :background "black"))
807(if (>= emacs-major-version 23)
808 (mdw-define-face variable-pitch
809 (((type x)) :family "sans" :height 100))
810 (mdw-define-face variable-pitch
811 (((type x)) :family "helvetica" :height 90)))
812(mdw-define-face region
813 (((type tty) (class color)) :background "blue")
814 (((type tty) (class mono)) :inverse-video t)
815 (t :background "grey30"))
816(mdw-define-face minibuffer-prompt
817 (t :weight bold))
818(mdw-define-face mode-line
819 (((class color)) :foreground "blue" :background "yellow"
820 :box (:line-width 1 :style released-button))
821 (t :inverse-video t))
822(mdw-define-face mode-line-inactive
823 (((class color)) :foreground "yellow" :background "blue"
824 :box (:line-width 1 :style released-button))
825 (t :inverse-video t))
826(mdw-define-face scroll-bar
827 (t :foreground "black" :background "lightgrey"))
828(mdw-define-face fringe
829 (t :foreground "yellow"))
830(mdw-define-face show-paren-match
831 (((class color)) :background "darkgreen")
832 (t :underline t))
833(mdw-define-face show-paren-mismatch
834 (((class color)) :background "red")
835 (t :inverse-video t))
836(mdw-define-face highlight
837 (((class color)) :background "DarkSeaGreen4")
838 (t :inverse-video t))
839
840(mdw-define-face holiday-face
841 (t :background "red"))
842(mdw-define-face calendar-today-face
843 (t :foreground "yellow" :weight bold))
844
845(mdw-define-face comint-highlight-prompt
846 (t :weight bold))
847(mdw-define-face comint-highlight-input
848 (t nil))
849
850(mdw-define-face trailing-whitespace
851 (((class color)) :background "red")
852 (t :inverse-video t))
853(mdw-define-face mdw-punct-face
854 (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
855(mdw-define-face mdw-number-face
856 (t :foreground "yellow"))
857(mdw-define-face font-lock-function-name-face
858 (t :slant italic))
859(mdw-define-face font-lock-keyword-face
860 (t :weight bold))
861(mdw-define-face font-lock-constant-face
862 (t :slant italic))
863(mdw-define-face font-lock-builtin-face
864 (t :weight bold))
865(mdw-define-face font-lock-type-face
866 (t :weight bold :slant italic))
867(mdw-define-face font-lock-reference-face
868 (t :weight bold))
869(mdw-define-face font-lock-variable-name-face
870 (t :slant italic))
871(mdw-define-face font-lock-comment-delimiter-face
872 (((class mono)) :weight bold)
873 (((type tty) (class color)) :foreground "green")
874 (t :slant italic :foreground "SeaGreen1"))
875(mdw-define-face font-lock-comment-face
876 (((class mono)) :weight bold)
877 (((type tty) (class color)) :foreground "green")
878 (t :slant italic :foreground "SeaGreen1"))
879(mdw-define-face font-lock-string-face
880 (((class mono)) :weight bold)
881 (((class color)) :foreground "SkyBlue1"))
882(mdw-define-face message-separator
883 (t :background "red" :foreground "white" :weight bold))
884(mdw-define-face message-cited-text
885 (default :slant italic)
886 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
887(mdw-define-face message-header-cc
888 (default :weight bold)
889 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
890(mdw-define-face message-header-newsgroups
891 (default :weight bold)
892 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
893(mdw-define-face message-header-subject
894 (default :weight bold)
895 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
896(mdw-define-face message-header-to
897 (default :weight bold)
898 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
899(mdw-define-face message-header-xheader
900 (default :weight bold)
901 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
902(mdw-define-face message-header-other
903 (default :weight bold)
904 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
905(mdw-define-face message-header-name
906 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
907
908(mdw-define-face diff-index
909 (t :weight bold))
910(mdw-define-face diff-file-header
911 (t :weight bold))
912(mdw-define-face diff-hunk-header
913 (t :foreground "SkyBlue1"))
914(mdw-define-face diff-function
915 (t :foreground "SkyBlue1" :weight bold))
916(mdw-define-face diff-header
917 (t :background "grey10"))
918(mdw-define-face diff-added
919 (t :foreground "green"))
920(mdw-define-face diff-removed
921 (t :foreground "red"))
922(mdw-define-face diff-context
923 (t nil))
924
925(mdw-define-face erc-input-face
926 (t :foreground "red"))
927
928(mdw-define-face woman-bold
929 (t :weight bold))
930(mdw-define-face woman-italic
931 (t :slant italic))
932
933(mdw-define-face p4-depot-added-face
934 (t :foreground "green"))
935(mdw-define-face p4-depot-branch-op-face
936 (t :foreground "yellow"))
937(mdw-define-face p4-depot-deleted-face
938 (t :foreground "red"))
939(mdw-define-face p4-depot-unmapped-face
940 (t :foreground "SkyBlue1"))
941(mdw-define-face p4-diff-change-face
942 (t :foreground "yellow"))
943(mdw-define-face p4-diff-del-face
944 (t :foreground "red"))
945(mdw-define-face p4-diff-file-face
946 (t :foreground "SkyBlue1"))
947(mdw-define-face p4-diff-head-face
948 (t :background "grey10"))
949(mdw-define-face p4-diff-ins-face
950 (t :foreground "green"))
951
952(mdw-define-face whizzy-slice-face
953 (t :background "grey10"))
954(mdw-define-face whizzy-error-face
955 (t :background "darkred"))
956
957;;;--------------------------------------------------------------------------
958;;; C programming configuration.
959
960;; Linux kernel hacking.
961
962(defvar linux-c-mode-hook)
963
964(defun linux-c-mode ()
965 (interactive)
966 (c-mode)
967 (setq major-mode 'linux-c-mode)
968 (setq mode-name "Linux C")
969 (run-hooks 'linux-c-mode-hook))
970
971;; Make C indentation nice.
972
973(defun mdw-c-lineup-arglist (langelem)
974 "Hack for DWIMmery in c-lineup-arglist."
975 (if (save-excursion
976 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
977 0
978 (c-lineup-arglist langelem)))
979
980(defun mdw-c-indent-extern-mumble (langelem)
981 "Indent `extern \"...\" {' lines."
982 (save-excursion
983 (back-to-indentation)
984 (if (looking-at
985 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
986 c-basic-offset
987 nil)))
988
989(defun mdw-c-style ()
990 (c-add-style "[mdw] C and C++ style"
991 '((c-basic-offset . 2)
992 (comment-column . 40)
993 (c-class-key . "class")
994 (c-backslash-column . 72)
995 (c-offsets-alist
996 (substatement-open . (add 0 c-indent-one-line-block))
997 (defun-open . (add 0 c-indent-one-line-block))
998 (arglist-cont-nonempty . mdw-c-lineup-arglist)
999 (topmost-intro . mdw-c-indent-extern-mumble)
1000 (cpp-define-intro . 0)
1001 (inextern-lang . [0])
1002 (label . 0)
1003 (case-label . +)
1004 (access-label . -)
1005 (inclass . +)
1006 (inline-open . ++)
1007 (statement-cont . 0)
1008 (statement-case-intro . +)))
1009 t))
1010
1011(defvar mdw-c-comment-fill-prefix
1012 `((,(concat "\\([ \t]*/?\\)"
1013 "\\(\*\\|//]\\)"
1014 "\\([ \t]*\\)"
1015 "\\([A-Za-z]+:[ \t]*\\)?"
1016 mdw-hanging-indents)
1017 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1018 "Fill prefix matching C comments (both kinds).")
1019
1020(defun mdw-fontify-c-and-c++ ()
1021
1022 ;; Fiddle with some syntax codes.
1023 (modify-syntax-entry ?* ". 23")
1024 (modify-syntax-entry ?/ ". 124b")
1025 (modify-syntax-entry ?\n "> b")
1026
1027 ;; Other stuff.
1028 (mdw-c-style)
1029 (setq c-hanging-comment-ender-p nil)
1030 (setq c-backslash-column 72)
1031 (setq c-label-minimum-indentation 0)
1032 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1033
1034 ;; Now define things to be fontified.
1035 (make-local-variable 'font-lock-keywords)
1036 (let ((c-keywords
1037 (mdw-regexps "and" ;C++
1038 "and_eq" ;C++
1039 "asm" ;K&R, GCC
1040 "auto" ;K&R, C89
1041 "bitand" ;C++
1042 "bitor" ;C++
1043 "bool" ;C++, C9X macro
1044 "break" ;K&R, C89
1045 "case" ;K&R, C89
1046 "catch" ;C++
1047 "char" ;K&R, C89
1048 "class" ;C++
1049 "complex" ;C9X macro, C++ template type
1050 "compl" ;C++
1051 "const" ;C89
1052 "const_cast" ;C++
1053 "continue" ;K&R, C89
1054 "defined" ;C89 preprocessor
1055 "default" ;K&R, C89
1056 "delete" ;C++
1057 "do" ;K&R, C89
1058 "double" ;K&R, C89
1059 "dynamic_cast" ;C++
1060 "else" ;K&R, C89
1061 ;; "entry" ;K&R -- never used
1062 "enum" ;C89
1063 "explicit" ;C++
1064 "export" ;C++
1065 "extern" ;K&R, C89
1066 "false" ;C++, C9X macro
1067 "float" ;K&R, C89
1068 "for" ;K&R, C89
1069 ;; "fortran" ;K&R
1070 "friend" ;C++
1071 "goto" ;K&R, C89
1072 "if" ;K&R, C89
1073 "imaginary" ;C9X macro
1074 "inline" ;C++, C9X, GCC
1075 "int" ;K&R, C89
1076 "long" ;K&R, C89
1077 "mutable" ;C++
1078 "namespace" ;C++
1079 "new" ;C++
1080 "operator" ;C++
1081 "or" ;C++
1082 "or_eq" ;C++
1083 "private" ;C++
1084 "protected" ;C++
1085 "public" ;C++
1086 "register" ;K&R, C89
1087 "reinterpret_cast" ;C++
1088 "restrict" ;C9X
1089 "return" ;K&R, C89
1090 "short" ;K&R, C89
1091 "signed" ;C89
1092 "sizeof" ;K&R, C89
1093 "static" ;K&R, C89
1094 "static_cast" ;C++
1095 "struct" ;K&R, C89
1096 "switch" ;K&R, C89
1097 "template" ;C++
1098 "this" ;C++
1099 "throw" ;C++
1100 "true" ;C++, C9X macro
1101 "try" ;C++
1102 "this" ;C++
1103 "typedef" ;C89
1104 "typeid" ;C++
1105 "typeof" ;GCC
1106 "typename" ;C++
1107 "union" ;K&R, C89
1108 "unsigned" ;K&R, C89
1109 "using" ;C++
1110 "virtual" ;C++
1111 "void" ;C89
1112 "volatile" ;C89
1113 "wchar_t" ;C++, C89 library type
1114 "while" ;K&R, C89
1115 "xor" ;C++
1116 "xor_eq" ;C++
1117 "_Bool" ;C9X
1118 "_Complex" ;C9X
1119 "_Imaginary" ;C9X
1120 "_Pragma" ;C9X preprocessor
1121 "__alignof__" ;GCC
1122 "__asm__" ;GCC
1123 "__attribute__" ;GCC
1124 "__complex__" ;GCC
1125 "__const__" ;GCC
1126 "__extension__" ;GCC
1127 "__imag__" ;GCC
1128 "__inline__" ;GCC
1129 "__label__" ;GCC
1130 "__real__" ;GCC
1131 "__signed__" ;GCC
1132 "__typeof__" ;GCC
1133 "__volatile__" ;GCC
1134 ))
1135 (preprocessor-keywords
1136 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1137 "ident" "if" "ifdef" "ifndef" "import" "include"
1138 "line" "pragma" "unassert" "undef" "warning"))
1139 (objc-keywords
1140 (mdw-regexps "class" "defs" "encode" "end" "implementation"
1141 "interface" "private" "protected" "protocol" "public"
1142 "selector")))
1143
1144 (setq font-lock-keywords
1145 (list
1146
1147 ;; Fontify include files as strings.
1148 (list (concat "^[ \t]*\\#[ \t]*"
1149 "\\(include\\|import\\)"
1150 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1151 '(2 font-lock-string-face))
1152
1153 ;; Preprocessor directives are `references'?.
1154 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1155 preprocessor-keywords
1156 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1157 '(1 font-lock-keyword-face))
1158
1159 ;; Handle the keywords defined above.
1160 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1161 '(0 font-lock-keyword-face))
1162
1163 (list (concat "\\<\\(" c-keywords "\\)\\>")
1164 '(0 font-lock-keyword-face))
1165
1166 ;; Handle numbers too.
1167 ;;
1168 ;; This looks strange, I know. It corresponds to the
1169 ;; preprocessor's idea of what a number looks like, rather than
1170 ;; anything sensible.
1171 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1172 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1173 '(0 mdw-number-face))
1174
1175 ;; And anything else is punctuation.
1176 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1177 '(0 mdw-punct-face))))
1178
1179 (mdw-post-config-mode-hack)))
1180
1181;;;--------------------------------------------------------------------------
1182;;; AP calc mode.
1183
1184(defun apcalc-mode ()
1185 (interactive)
1186 (c-mode)
1187 (setq major-mode 'apcalc-mode)
1188 (setq mode-name "AP Calc")
1189 (run-hooks 'apcalc-mode-hook))
1190
1191(defun mdw-fontify-apcalc ()
1192
1193 ;; Fiddle with some syntax codes.
1194 (modify-syntax-entry ?* ". 23")
1195 (modify-syntax-entry ?/ ". 14")
1196
1197 ;; Other stuff.
1198 (mdw-c-style)
1199 (setq c-hanging-comment-ender-p nil)
1200 (setq c-backslash-column 72)
1201 (setq comment-start "/* ")
1202 (setq comment-end " */")
1203 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1204
1205 ;; Now define things to be fontified.
1206 (make-local-variable 'font-lock-keywords)
1207 (let ((c-keywords
1208 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1209 "do" "else" "exit" "for" "global" "goto" "help" "if"
1210 "local" "mat" "obj" "print" "quit" "read" "return"
1211 "show" "static" "switch" "while" "write")))
1212
1213 (setq font-lock-keywords
1214 (list
1215
1216 ;; Handle the keywords defined above.
1217 (list (concat "\\<\\(" c-keywords "\\)\\>")
1218 '(0 font-lock-keyword-face))
1219
1220 ;; Handle numbers too.
1221 ;;
1222 ;; This looks strange, I know. It corresponds to the
1223 ;; preprocessor's idea of what a number looks like, rather than
1224 ;; anything sensible.
1225 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1226 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1227 '(0 mdw-number-face))
1228
1229 ;; And anything else is punctuation.
1230 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1231 '(0 mdw-punct-face)))))
1232
1233 (mdw-post-config-mode-hack))
1234
1235;;;--------------------------------------------------------------------------
1236;;; Java programming configuration.
1237
1238;; Make indentation nice.
1239
1240(defun mdw-java-style ()
1241 (c-add-style "[mdw] Java style"
1242 '((c-basic-offset . 2)
1243 (c-offsets-alist (substatement-open . 0)
1244 (label . +)
1245 (case-label . +)
1246 (access-label . 0)
1247 (inclass . +)
1248 (statement-case-intro . +)))
1249 t))
1250
1251;; Declare Java fontification style.
1252
1253(defun mdw-fontify-java ()
1254
1255 ;; Other stuff.
1256 (mdw-java-style)
1257 (setq c-hanging-comment-ender-p nil)
1258 (setq c-backslash-column 72)
1259 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1260
1261 ;; Now define things to be fontified.
1262 (make-local-variable 'font-lock-keywords)
1263 (let ((java-keywords
1264 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1265 "char" "class" "const" "continue" "default" "do"
1266 "double" "else" "extends" "final" "finally" "float"
1267 "for" "goto" "if" "implements" "import" "instanceof"
1268 "int" "interface" "long" "native" "new" "package"
1269 "private" "protected" "public" "return" "short"
1270 "static" "super" "switch" "synchronized" "this"
1271 "throw" "throws" "transient" "try" "void" "volatile"
1272 "while"
1273
1274 "false" "null" "true")))
1275
1276 (setq font-lock-keywords
1277 (list
1278
1279 ;; Handle the keywords defined above.
1280 (list (concat "\\<\\(" java-keywords "\\)\\>")
1281 '(0 font-lock-keyword-face))
1282
1283 ;; Handle numbers too.
1284 ;;
1285 ;; The following isn't quite right, but it's close enough.
1286 (list (concat "\\<\\("
1287 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1288 "[0-9]+\\(\\.[0-9]*\\|\\)"
1289 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1290 "[lLfFdD]?")
1291 '(0 mdw-number-face))
1292
1293 ;; And anything else is punctuation.
1294 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1295 '(0 mdw-punct-face)))))
1296
1297 (mdw-post-config-mode-hack))
1298
1299;;;--------------------------------------------------------------------------
1300;;; C# programming configuration.
1301
1302;; Make indentation nice.
1303
1304(defun mdw-csharp-style ()
1305 (c-add-style "[mdw] C# style"
1306 '((c-basic-offset . 2)
1307 (c-offsets-alist (substatement-open . 0)
1308 (label . 0)
1309 (case-label . +)
1310 (access-label . 0)
1311 (inclass . +)
1312 (statement-case-intro . +)))
1313 t))
1314
1315;; Declare C# fontification style.
1316
1317(defun mdw-fontify-csharp ()
1318
1319 ;; Other stuff.
1320 (mdw-csharp-style)
1321 (setq c-hanging-comment-ender-p nil)
1322 (setq c-backslash-column 72)
1323 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1324
1325 ;; Now define things to be fontified.
1326 (make-local-variable 'font-lock-keywords)
1327 (let ((csharp-keywords
1328 (mdw-regexps "abstract" "as" "base" "bool" "break"
1329 "byte" "case" "catch" "char" "checked"
1330 "class" "const" "continue" "decimal" "default"
1331 "delegate" "do" "double" "else" "enum"
1332 "event" "explicit" "extern" "false" "finally"
1333 "fixed" "float" "for" "foreach" "goto"
1334 "if" "implicit" "in" "int" "interface"
1335 "internal" "is" "lock" "long" "namespace"
1336 "new" "null" "object" "operator" "out"
1337 "override" "params" "private" "protected" "public"
1338 "readonly" "ref" "return" "sbyte" "sealed"
1339 "short" "sizeof" "stackalloc" "static" "string"
1340 "struct" "switch" "this" "throw" "true"
1341 "try" "typeof" "uint" "ulong" "unchecked"
1342 "unsafe" "ushort" "using" "virtual" "void"
1343 "volatile" "while" "yield")))
1344
1345 (setq font-lock-keywords
1346 (list
1347
1348 ;; Handle the keywords defined above.
1349 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1350 '(0 font-lock-keyword-face))
1351
1352 ;; Handle numbers too.
1353 ;;
1354 ;; The following isn't quite right, but it's close enough.
1355 (list (concat "\\<\\("
1356 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1357 "[0-9]+\\(\\.[0-9]*\\|\\)"
1358 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1359 "[lLfFdD]?")
1360 '(0 mdw-number-face))
1361
1362 ;; And anything else is punctuation.
1363 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1364 '(0 mdw-punct-face)))))
1365
1366 (mdw-post-config-mode-hack))
1367
1368(define-derived-mode csharp-mode java-mode "C#"
1369 "Major mode for editing C# code.")
1370
1371;;;--------------------------------------------------------------------------
1372;;; Go programming configuration.
1373
1374(defun mdw-fontify-go ()
1375
1376 (make-local-variable 'font-lock-keywords)
1377 (let ((go-keywords
1378 (mdw-regexps "break" "case" "chan" "const" "continue"
1379 "default" "defer" "else" "fallthrough" "for"
1380 "func" "go" "goto" "if" "import"
1381 "interface" "map" "package" "range" "return"
1382 "select" "struct" "switch" "type" "var")))
1383
1384 (setq font-lock-keywords
1385 (list
1386
1387 ;; Handle the keywords defined above.
1388 (list (concat "\\<\\(" go-keywords "\\)\\>")
1389 '(0 font-lock-keyword-face))
1390
1391 ;; Handle numbers too.
1392 ;;
1393 ;; The following isn't quite right, but it's close enough.
1394 (list (concat "\\<\\("
1395 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1396 "[0-9]+\\(\\.[0-9]*\\|\\)"
1397 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1398 '(0 mdw-number-face))
1399
1400 ;; And anything else is punctuation.
1401 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1402 '(0 mdw-punct-face)))))
1403
1404 (mdw-post-config-mode-hack))
1405
1406;;;--------------------------------------------------------------------------
1407;;; Awk programming configuration.
1408
1409;; Make Awk indentation nice.
1410
1411(defun mdw-awk-style ()
1412 (c-add-style "[mdw] Awk style"
1413 '((c-basic-offset . 2)
1414 (c-offsets-alist (substatement-open . 0)
1415 (statement-cont . 0)
1416 (statement-case-intro . +)))
1417 t))
1418
1419;; Declare Awk fontification style.
1420
1421(defun mdw-fontify-awk ()
1422
1423 ;; Miscellaneous fiddling.
1424 (mdw-awk-style)
1425 (setq c-backslash-column 72)
1426 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1427
1428 ;; Now define things to be fontified.
1429 (make-local-variable 'font-lock-keywords)
1430 (let ((c-keywords
1431 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1432 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1433 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1434 "RSTART" "RLENGTH" "RT" "SUBSEP"
1435 "atan2" "break" "close" "continue" "cos" "delete"
1436 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1437 "function" "gensub" "getline" "gsub" "if" "in"
1438 "index" "int" "length" "log" "match" "next" "rand"
1439 "return" "print" "printf" "sin" "split" "sprintf"
1440 "sqrt" "srand" "strftime" "sub" "substr" "system"
1441 "systime" "tolower" "toupper" "while")))
1442
1443 (setq font-lock-keywords
1444 (list
1445
1446 ;; Handle the keywords defined above.
1447 (list (concat "\\<\\(" c-keywords "\\)\\>")
1448 '(0 font-lock-keyword-face))
1449
1450 ;; Handle numbers too.
1451 ;;
1452 ;; The following isn't quite right, but it's close enough.
1453 (list (concat "\\<\\("
1454 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1455 "[0-9]+\\(\\.[0-9]*\\|\\)"
1456 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1457 "[uUlL]*")
1458 '(0 mdw-number-face))
1459
1460 ;; And anything else is punctuation.
1461 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1462 '(0 mdw-punct-face)))))
1463
1464 (mdw-post-config-mode-hack))
1465
1466;;;--------------------------------------------------------------------------
1467;;; Perl programming style.
1468
1469;; Perl indentation style.
1470
1471(setq cperl-indent-level 2)
1472(setq cperl-continued-statement-offset 2)
1473(setq cperl-continued-brace-offset 0)
1474(setq cperl-brace-offset -2)
1475(setq cperl-brace-imaginary-offset 0)
1476(setq cperl-label-offset 0)
1477
1478;; Define perl fontification style.
1479
1480(defun mdw-fontify-perl ()
1481
1482 ;; Miscellaneous fiddling.
1483 (modify-syntax-entry ?$ "\\")
1484 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1485 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1486
1487 ;; Now define fontification things.
1488 (make-local-variable 'font-lock-keywords)
1489 (let ((perl-keywords
1490 (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1491 "for" "foreach" "ge" "gt" "goto" "if"
1492 "last" "le" "lt" "local" "my" "ne" "next" "or"
1493 "package" "redo" "require" "return" "sub"
1494 "undef" "unless" "until" "use" "while")))
1495
1496 (setq font-lock-keywords
1497 (list
1498
1499 ;; Set up the keywords defined above.
1500 (list (concat "\\<\\(" perl-keywords "\\)\\>")
1501 '(0 font-lock-keyword-face))
1502
1503 ;; At least numbers are simpler than C.
1504 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1505 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1506 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1507 '(0 mdw-number-face))
1508
1509 ;; And anything else is punctuation.
1510 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1511 '(0 mdw-punct-face)))))
1512
1513 (mdw-post-config-mode-hack))
1514
1515(defun perl-number-tests (&optional arg)
1516 "Assign consecutive numbers to lines containing `#t'. With ARG,
1517strip numbers instead."
1518 (interactive "P")
1519 (save-excursion
1520 (goto-char (point-min))
1521 (let ((i 0) (fmt (if arg "" " %4d")))
1522 (while (search-forward "#t" nil t)
1523 (delete-region (point) (line-end-position))
1524 (setq i (1+ i))
1525 (insert (format fmt i)))
1526 (goto-char (point-min))
1527 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1528 (replace-match (format "\\1%d" i))))))
1529
1530;;;--------------------------------------------------------------------------
1531;;; Python programming style.
1532
1533(defun mdw-fontify-pythonic (keywords)
1534
1535 ;; Miscellaneous fiddling.
1536 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1537 (setq indent-tabs-mode nil)
1538
1539 ;; Now define fontification things.
1540 (make-local-variable 'font-lock-keywords)
1541 (setq font-lock-keywords
1542 (list
1543
1544 ;; Set up the keywords defined above.
1545 (list (concat "\\<\\(" keywords "\\)\\>")
1546 '(0 font-lock-keyword-face))
1547
1548 ;; At least numbers are simpler than C.
1549 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1550 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1551 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1552 '(0 mdw-number-face))
1553
1554 ;; And anything else is punctuation.
1555 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1556 '(0 mdw-punct-face))))
1557
1558 (mdw-post-config-mode-hack))
1559
1560;; Define Python fontification styles.
1561
1562(defun mdw-fontify-python ()
1563 (mdw-fontify-pythonic
1564 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1565 "del" "elif" "else" "except" "exec" "finally" "for"
1566 "from" "global" "if" "import" "in" "is" "lambda"
1567 "not" "or" "pass" "print" "raise" "return" "try"
1568 "while" "with" "yield")))
1569
1570(defun mdw-fontify-pyrex ()
1571 (mdw-fontify-pythonic
1572 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1573 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1574 "extern" "finally" "for" "from" "global" "if"
1575 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1576 "raise" "return" "struct" "try" "while" "with"
1577 "yield")))
1578
1579;;;--------------------------------------------------------------------------
1580;;; Icon programming style.
1581
1582;; Icon indentation style.
1583
1584(setq icon-brace-offset 0
1585 icon-continued-brace-offset 0
1586 icon-continued-statement-offset 2
1587 icon-indent-level 2)
1588
1589;; Define Icon fontification style.
1590
1591(defun mdw-fontify-icon ()
1592
1593 ;; Miscellaneous fiddling.
1594 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1595
1596 ;; Now define fontification things.
1597 (make-local-variable 'font-lock-keywords)
1598 (let ((icon-keywords
1599 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1600 "end" "every" "fail" "global" "if" "initial"
1601 "invocable" "link" "local" "next" "not" "of"
1602 "procedure" "record" "repeat" "return" "static"
1603 "suspend" "then" "to" "until" "while"))
1604 (preprocessor-keywords
1605 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1606 "include" "line" "undef")))
1607 (setq font-lock-keywords
1608 (list
1609
1610 ;; Set up the keywords defined above.
1611 (list (concat "\\<\\(" icon-keywords "\\)\\>")
1612 '(0 font-lock-keyword-face))
1613
1614 ;; The things that Icon calls keywords.
1615 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1616
1617 ;; At least numbers are simpler than C.
1618 (list (concat "\\<[0-9]+"
1619 "\\([rR][0-9a-zA-Z]+\\|"
1620 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1621 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1622 '(0 mdw-number-face))
1623
1624 ;; Preprocessor.
1625 (list (concat "^[ \t]*$[ \t]*\\<\\("
1626 preprocessor-keywords
1627 "\\)\\>")
1628 '(0 font-lock-keyword-face))
1629
1630 ;; And anything else is punctuation.
1631 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1632 '(0 mdw-punct-face)))))
1633
1634 (mdw-post-config-mode-hack))
1635
1636;;;--------------------------------------------------------------------------
1637;;; ARM assembler programming configuration.
1638
1639;; There doesn't appear to be an Emacs mode for this yet.
1640;;
1641;; Better do something about that, I suppose.
1642
1643(defvar arm-assembler-mode-map nil)
1644(defvar arm-assembler-abbrev-table nil)
1645(defvar arm-assembler-mode-syntax-table (make-syntax-table))
1646
1647(or arm-assembler-mode-map
1648 (progn
1649 (setq arm-assembler-mode-map (make-sparse-keymap))
1650 (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1651 (define-key arm-assembler-mode-map [C-return] 'newline)
1652 (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1653
1654(defun arm-assembler-mode ()
1655 "Major mode for ARM assembler programs"
1656 (interactive)
1657
1658 ;; Do standard major mode things.
1659 (kill-all-local-variables)
1660 (use-local-map arm-assembler-mode-map)
1661 (setq local-abbrev-table arm-assembler-abbrev-table)
1662 (setq major-mode 'arm-assembler-mode)
1663 (setq mode-name "ARM assembler")
1664
1665 ;; Set up syntax table.
1666 (set-syntax-table arm-assembler-mode-syntax-table)
1667 (modify-syntax-entry ?; ; Nasty hack
1668 "<" arm-assembler-mode-syntax-table)
1669 (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1670 (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1671
1672 (make-local-variable 'comment-start)
1673 (setq comment-start ";")
1674 (make-local-variable 'comment-end)
1675 (setq comment-end "")
1676 (make-local-variable 'comment-column)
1677 (setq comment-column 48)
1678 (make-local-variable 'comment-start-skip)
1679 (setq comment-start-skip ";+[ \t]*")
1680
1681 ;; Play with indentation.
1682 (make-local-variable 'indent-line-function)
1683 (setq indent-line-function 'indent-relative-maybe)
1684
1685 ;; Set fill prefix.
1686 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1687
1688 ;; Fiddle with fontification.
1689 (make-local-variable 'font-lock-keywords)
1690 (setq font-lock-keywords
1691 (list
1692
1693 ;; Handle numbers too.
1694 ;;
1695 ;; The following isn't quite right, but it's close enough.
1696 (list (concat "\\("
1697 "&[0-9a-fA-F]+\\|"
1698 "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1699 "\\)")
1700 '(0 mdw-number-face))
1701
1702 ;; Do something about operators.
1703 (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1704 '(1 font-lock-keyword-face)
1705 '(2 font-lock-string-face))
1706 (list ":[a-zA-Z]+:"
1707 '(0 font-lock-keyword-face))
1708
1709 ;; Do menemonics and directives.
1710 (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1711 '(1 font-lock-keyword-face))
1712
1713 ;; And anything else is punctuation.
1714 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1715 '(0 mdw-punct-face)))
1716
1717 (mdw-post-config-mode-hack))
1718 (run-hooks 'arm-assembler-mode-hook))
1719
1720;;;--------------------------------------------------------------------------
1721;;; Assembler mode.
1722
1723(defun mdw-fontify-asm ()
1724 (modify-syntax-entry ?' "\"")
1725 (modify-syntax-entry ?. "w")
1726 (setf fill-prefix nil)
1727 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1728
1729;;;--------------------------------------------------------------------------
1730;;; TCL configuration.
1731
1732(defun mdw-fontify-tcl ()
1733 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1734 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1735 (make-local-variable 'font-lock-keywords)
1736 (setq font-lock-keywords
1737 (list
1738 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1739 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1740 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1741 '(0 mdw-number-face))
1742 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1743 '(0 mdw-punct-face))))
1744 (mdw-post-config-mode-hack))
1745
1746;;;--------------------------------------------------------------------------
1747;;; REXX configuration.
1748
1749(defun mdw-rexx-electric-* ()
1750 (interactive)
1751 (insert ?*)
1752 (rexx-indent-line))
1753
1754(defun mdw-rexx-indent-newline-indent ()
1755 (interactive)
1756 (rexx-indent-line)
1757 (if abbrev-mode (expand-abbrev))
1758 (newline-and-indent))
1759
1760(defun mdw-fontify-rexx ()
1761
1762 ;; Various bits of fiddling.
1763 (setq mdw-auto-indent nil)
1764 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1765 (local-set-key [?*] 'mdw-rexx-electric-*)
1766 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1767 '(?! ?? ?# ?@ ?$))
1768 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1769
1770 ;; Set up keywords and things for fontification.
1771 (make-local-variable 'font-lock-keywords-case-fold-search)
1772 (setq font-lock-keywords-case-fold-search t)
1773
1774 (setq rexx-indent 2)
1775 (setq rexx-end-indent rexx-indent)
1776 (setq rexx-cont-indent rexx-indent)
1777
1778 (make-local-variable 'font-lock-keywords)
1779 (let ((rexx-keywords
1780 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1781 "else" "end" "engineering" "exit" "expose" "for"
1782 "forever" "form" "fuzz" "if" "interpret" "iterate"
1783 "leave" "linein" "name" "nop" "numeric" "off" "on"
1784 "options" "otherwise" "parse" "procedure" "pull"
1785 "push" "queue" "return" "say" "select" "signal"
1786 "scientific" "source" "then" "trace" "to" "until"
1787 "upper" "value" "var" "version" "when" "while"
1788 "with"
1789
1790 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1791 "center" "center" "charin" "charout" "chars"
1792 "compare" "condition" "copies" "c2d" "c2x"
1793 "datatype" "date" "delstr" "delword" "d2c" "d2x"
1794 "errortext" "format" "fuzz" "insert" "lastpos"
1795 "left" "length" "lineout" "lines" "max" "min"
1796 "overlay" "pos" "queued" "random" "reverse" "right"
1797 "sign" "sourceline" "space" "stream" "strip"
1798 "substr" "subword" "symbol" "time" "translate"
1799 "trunc" "value" "verify" "word" "wordindex"
1800 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1801 "x2d")))
1802
1803 (setq font-lock-keywords
1804 (list
1805
1806 ;; Set up the keywords defined above.
1807 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1808 '(0 font-lock-keyword-face))
1809
1810 ;; Fontify all symbols the same way.
1811 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1812 "[A-Za-z0-9.!?_#@$]+\\)")
1813 '(0 font-lock-variable-name-face))
1814
1815 ;; And everything else is punctuation.
1816 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1817 '(0 mdw-punct-face)))))
1818
1819 (mdw-post-config-mode-hack))
1820
1821;;;--------------------------------------------------------------------------
1822;;; Standard ML programming style.
1823
1824(defun mdw-fontify-sml ()
1825
1826 ;; Make underscore an honorary letter.
1827 (modify-syntax-entry ?' "w")
1828
1829 ;; Set fill prefix.
1830 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1831
1832 ;; Now define fontification things.
1833 (make-local-variable 'font-lock-keywords)
1834 (let ((sml-keywords
1835 (mdw-regexps "abstype" "and" "andalso" "as"
1836 "case"
1837 "datatype" "do"
1838 "else" "end" "eqtype" "exception"
1839 "fn" "fun" "functor"
1840 "handle"
1841 "if" "in" "include" "infix" "infixr"
1842 "let" "local"
1843 "nonfix"
1844 "of" "op" "open" "orelse"
1845 "raise" "rec"
1846 "sharing" "sig" "signature" "struct" "structure"
1847 "then" "type"
1848 "val"
1849 "where" "while" "with" "withtype")))
1850
1851 (setq font-lock-keywords
1852 (list
1853
1854 ;; Set up the keywords defined above.
1855 (list (concat "\\<\\(" sml-keywords "\\)\\>")
1856 '(0 font-lock-keyword-face))
1857
1858 ;; At least numbers are simpler than C.
1859 (list (concat "\\<\\(\\~\\|\\)"
1860 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1861 "[wW][0-9]+\\)\\|"
1862 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1863 "\\([eE]\\(\\~\\|\\)"
1864 "[0-9]+\\|\\)\\)\\)")
1865 '(0 mdw-number-face))
1866
1867 ;; And anything else is punctuation.
1868 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1869 '(0 mdw-punct-face)))))
1870
1871 (mdw-post-config-mode-hack))
1872
1873;;;--------------------------------------------------------------------------
1874;;; Haskell configuration.
1875
1876(defun mdw-fontify-haskell ()
1877
1878 ;; Fiddle with syntax table to get comments right.
1879 (modify-syntax-entry ?' "\"")
1880 (modify-syntax-entry ?- ". 123")
1881 (modify-syntax-entry ?{ ". 1b")
1882 (modify-syntax-entry ?} ". 4b")
1883 (modify-syntax-entry ?\n ">")
1884
1885 ;; Set fill prefix.
1886 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1887
1888 ;; Fiddle with fontification.
1889 (make-local-variable 'font-lock-keywords)
1890 (let ((haskell-keywords
1891 (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1892 "deriving" "do" "else" "foreign" "hiding" "if"
1893 "import" "in" "infix" "infixl" "infixr" "instance"
1894 "let" "module" "newtype" "of" "qualified" "safe"
1895 "stdcall" "then" "type" "unsafe" "where")))
1896
1897 (setq font-lock-keywords
1898 (list
1899 (list "--.*$"
1900 '(0 font-lock-comment-face))
1901 (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1902 '(0 font-lock-keyword-face))
1903 (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1904 "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1905 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1906 '(0 mdw-number-face))
1907 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1908 '(0 mdw-punct-face)))))
1909
1910 (mdw-post-config-mode-hack))
1911
1912;;;--------------------------------------------------------------------------
1913;;; Erlang configuration.
1914
1915(setq erlang-electric-commannds
1916 '(erlang-electric-newline erlang-electric-semicolon))
1917
1918(defun mdw-fontify-erlang ()
1919
1920 ;; Set fill prefix.
1921 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1922
1923 ;; Fiddle with fontification.
1924 (make-local-variable 'font-lock-keywords)
1925 (let ((erlang-keywords
1926 (mdw-regexps "after" "and" "andalso"
1927 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1928 "case" "catch" "cond"
1929 "div" "end" "fun" "if" "let" "not"
1930 "of" "or" "orelse"
1931 "query" "receive" "rem" "try" "when" "xor")))
1932
1933 (setq font-lock-keywords
1934 (list
1935 (list "%.*$"
1936 '(0 font-lock-comment-face))
1937 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1938 '(0 font-lock-keyword-face))
1939 (list (concat "^-\\sw+\\>")
1940 '(0 font-lock-keyword-face))
1941 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1942 '(0 mdw-number-face))
1943 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1944 '(0 mdw-punct-face)))))
1945
1946 (mdw-post-config-mode-hack))
1947
1948;;;--------------------------------------------------------------------------
1949;;; Texinfo configuration.
1950
1951(defun mdw-fontify-texinfo ()
1952
1953 ;; Set fill prefix.
1954 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1955
1956 ;; Real fontification things.
1957 (make-local-variable 'font-lock-keywords)
1958 (setq font-lock-keywords
1959 (list
1960
1961 ;; Environment names are keywords.
1962 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
1963 '(2 font-lock-keyword-face))
1964
1965 ;; Unmark escaped magic characters.
1966 (list "\\(@\\)\\([@{}]\\)"
1967 '(1 font-lock-keyword-face)
1968 '(2 font-lock-variable-name-face))
1969
1970 ;; Make sure we get comments properly.
1971 (list "@c\\(\\|omment\\)\\( .*\\)?$"
1972 '(0 font-lock-comment-face))
1973
1974 ;; Command names are keywords.
1975 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1976 '(0 font-lock-keyword-face))
1977
1978 ;; Fontify TeX special characters as punctuation.
1979 (list "[{}]+"
1980 '(0 mdw-punct-face))))
1981
1982 (mdw-post-config-mode-hack))
1983
1984;;;--------------------------------------------------------------------------
1985;;; TeX and LaTeX configuration.
1986
1987(defun mdw-fontify-tex ()
1988 (setq ispell-parser 'tex)
1989 (turn-on-reftex)
1990
1991 ;; Don't make maths into a string.
1992 (modify-syntax-entry ?$ ".")
1993 (modify-syntax-entry ?$ "." font-lock-syntax-table)
1994 (local-set-key [?$] 'self-insert-command)
1995
1996 ;; Set fill prefix.
1997 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1998
1999 ;; Real fontification things.
2000 (make-local-variable 'font-lock-keywords)
2001 (setq font-lock-keywords
2002 (list
2003
2004 ;; Environment names are keywords.
2005 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2006 "{\\([^}\n]*\\)}")
2007 '(2 font-lock-keyword-face))
2008
2009 ;; Suspended environment names are keywords too.
2010 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2011 "{\\([^}\n]*\\)}")
2012 '(3 font-lock-keyword-face))
2013
2014 ;; Command names are keywords.
2015 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2016 '(0 font-lock-keyword-face))
2017
2018 ;; Handle @/.../ for italics.
2019 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2020 ;; '(1 font-lock-keyword-face)
2021 ;; '(3 font-lock-keyword-face))
2022
2023 ;; Handle @*...* for boldness.
2024 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2025 ;; '(1 font-lock-keyword-face)
2026 ;; '(3 font-lock-keyword-face))
2027
2028 ;; Handle @`...' for literal syntax things.
2029 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2030 ;; '(1 font-lock-keyword-face)
2031 ;; '(3 font-lock-keyword-face))
2032
2033 ;; Handle @<...> for nonterminals.
2034 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2035 ;; '(1 font-lock-keyword-face)
2036 ;; '(3 font-lock-keyword-face))
2037
2038 ;; Handle other @-commands.
2039 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2040 ;; '(0 font-lock-keyword-face))
2041
2042 ;; Make sure we get comments properly.
2043 (list "%.*"
2044 '(0 font-lock-comment-face))
2045
2046 ;; Fontify TeX special characters as punctuation.
2047 (list "[$^_{}#&]"
2048 '(0 mdw-punct-face))))
2049
2050 (mdw-post-config-mode-hack))
2051
2052;;;--------------------------------------------------------------------------
2053;;; SGML hacking.
2054
2055(defun mdw-sgml-mode ()
2056 (interactive)
2057 (sgml-mode)
2058 (mdw-standard-fill-prefix "")
2059 (make-local-variable 'sgml-delimiters)
2060 (setq sgml-delimiters
2061 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2062 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2063 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2064 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2065 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2066 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2067 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2068 "NULL" ""))
2069 (setq major-mode 'mdw-sgml-mode)
2070 (setq mode-name "[mdw] SGML")
2071 (run-hooks 'mdw-sgml-mode-hook))
2072
2073;;;--------------------------------------------------------------------------
2074;;; Shell scripts.
2075
2076(defun mdw-setup-sh-script-mode ()
2077
2078 ;; Fetch the shell interpreter's name.
2079 (let ((shell-name sh-shell-file))
2080
2081 ;; Try reading the hash-bang line.
2082 (save-excursion
2083 (goto-char (point-min))
2084 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2085 (setq shell-name (match-string 1))))
2086
2087 ;; Now try to set the shell.
2088 ;;
2089 ;; Don't let `sh-set-shell' bugger up my script.
2090 (let ((executable-set-magic #'(lambda (s &rest r) s)))
2091 (sh-set-shell shell-name)))
2092
2093 ;; Now enable my keys and the fontification.
2094 (mdw-misc-mode-config)
2095
2096 ;; Set the indentation level correctly.
2097 (setq sh-indentation 2)
2098 (setq sh-basic-offset 2))
2099
2100;;;--------------------------------------------------------------------------
2101;;; Emacs shell mode.
2102
2103(defun mdw-eshell-prompt ()
2104 (let ((left "[") (right "]"))
2105 (when (= (user-uid) 0)
2106 (setq left "«" right "»"))
2107 (concat left
2108 (save-match-data
2109 (replace-regexp-in-string "\\..*$" "" (system-name)))
2110 " "
2111 (eshell/pwd)
2112 right)))
2113(setq eshell-prompt-function 'mdw-eshell-prompt)
2114(setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2115
2116(defalias 'eshell/e 'find-file)
2117(defalias 'eshell/w3m 'w3m-goto-url)
2118
2119(mdw-define-face eshell-prompt (t :weight bold))
2120(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2121(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2122(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2123(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2124(mdw-define-face eshell-ls-executable (t :weight bold))
2125(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2126(mdw-define-face eshell-ls-readonly (t nil))
2127(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2128
2129;;;--------------------------------------------------------------------------
2130;;; Messages-file mode.
2131
2132(defun messages-mode-guts ()
2133 (setq messages-mode-syntax-table (make-syntax-table))
2134 (set-syntax-table messages-mode-syntax-table)
2135 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2136 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2137 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2138 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2139 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2140 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2141 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2142 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2143 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2144 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2145 (make-local-variable 'comment-start)
2146 (make-local-variable 'comment-end)
2147 (make-local-variable 'indent-line-function)
2148 (setq indent-line-function 'indent-relative)
2149 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2150 (make-local-variable 'font-lock-defaults)
2151 (make-local-variable 'messages-mode-keywords)
2152 (let ((keywords
2153 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2154 "export" "enum" "fixed-octetstring" "flags"
2155 "harmless" "map" "nested" "optional"
2156 "optional-tagged" "package" "primitive"
2157 "primitive-nullfree" "relaxed[ \t]+enum"
2158 "set" "table" "tagged-optional" "union"
2159 "variadic" "vector" "version" "version-tag")))
2160 (setq messages-mode-keywords
2161 (list
2162 (list (concat "\\<\\(" keywords "\\)\\>:")
2163 '(0 font-lock-keyword-face))
2164 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2165 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2166 (0 font-lock-variable-name-face))
2167 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2168 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2169 (0 mdw-punct-face)))))
2170 (setq font-lock-defaults
2171 '(messages-mode-keywords nil nil nil nil))
2172 (run-hooks 'messages-file-hook))
2173
2174(defun messages-mode ()
2175 (interactive)
2176 (fundamental-mode)
2177 (setq major-mode 'messages-mode)
2178 (setq mode-name "Messages")
2179 (messages-mode-guts)
2180 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2181 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2182 (setq comment-start "# ")
2183 (setq comment-end "")
2184 (run-hooks 'messages-mode-hook))
2185
2186(defun cpp-messages-mode ()
2187 (interactive)
2188 (fundamental-mode)
2189 (setq major-mode 'cpp-messages-mode)
2190 (setq mode-name "CPP Messages")
2191 (messages-mode-guts)
2192 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2193 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2194 (setq comment-start "/* ")
2195 (setq comment-end " */")
2196 (let ((preprocessor-keywords
2197 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2198 "ident" "if" "ifdef" "ifndef" "import" "include"
2199 "line" "pragma" "unassert" "undef" "warning")))
2200 (setq messages-mode-keywords
2201 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2202 "\\(include\\|import\\)"
2203 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2204 '(2 font-lock-string-face))
2205 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2206 preprocessor-keywords
2207 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2208 '(1 font-lock-keyword-face)))
2209 messages-mode-keywords)))
2210 (run-hooks 'cpp-messages-mode-hook))
2211
2212(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2213(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2214; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2215
2216;;;--------------------------------------------------------------------------
2217;;; Messages-file mode.
2218
2219(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2220 "Face to use for subsittution directives.")
2221(make-face 'mallow-driver-substitution-face)
2222(defvar mallow-driver-text-face 'mallow-driver-text-face
2223 "Face to use for body text.")
2224(make-face 'mallow-driver-text-face)
2225
2226(defun mallow-driver-mode ()
2227 (interactive)
2228 (fundamental-mode)
2229 (setq major-mode 'mallow-driver-mode)
2230 (setq mode-name "Mallow driver")
2231 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2232 (set-syntax-table mallow-driver-mode-syntax-table)
2233 (make-local-variable 'comment-start)
2234 (make-local-variable 'comment-end)
2235 (make-local-variable 'indent-line-function)
2236 (setq indent-line-function 'indent-relative)
2237 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2238 (make-local-variable 'font-lock-defaults)
2239 (make-local-variable 'mallow-driver-mode-keywords)
2240 (let ((keywords
2241 (mdw-regexps "each" "divert" "file" "if"
2242 "perl" "set" "string" "type" "write")))
2243 (setq mallow-driver-mode-keywords
2244 (list
2245 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2246 '(0 font-lock-keyword-face))
2247 (list "^%\\s *\\(#.*\\|\\)$"
2248 '(0 font-lock-comment-face))
2249 (list "^%"
2250 '(0 font-lock-keyword-face))
2251 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2252 (list "\\${[^}]*}"
2253 '(0 mallow-driver-substitution-face t)))))
2254 (setq font-lock-defaults
2255 '(mallow-driver-mode-keywords nil nil nil nil))
2256 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2257 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2258 (setq comment-start "%# ")
2259 (setq comment-end "")
2260 (run-hooks 'mallow-driver-mode-hook))
2261
2262(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2263
2264;;;--------------------------------------------------------------------------
2265;;; NFast debugs.
2266
2267(defun nfast-debug-mode ()
2268 (interactive)
2269 (fundamental-mode)
2270 (setq major-mode 'nfast-debug-mode)
2271 (setq mode-name "NFast debug")
2272 (setq messages-mode-syntax-table (make-syntax-table))
2273 (set-syntax-table messages-mode-syntax-table)
2274 (make-local-variable 'font-lock-defaults)
2275 (make-local-variable 'nfast-debug-mode-keywords)
2276 (setq truncate-lines t)
2277 (setq nfast-debug-mode-keywords
2278 (list
2279 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2280 (0 font-lock-keyword-face))
2281 (list (concat "^[ \t]+\\(\\("
2282 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2283 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2284 "[ \t]+\\)*"
2285 "[0-9a-fA-F]+\\)[ \t]*$")
2286 '(0 mdw-number-face))
2287 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2288 (1 font-lock-keyword-face))
2289 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2290 (1 font-lock-warning-face))
2291 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2292 (1 nil))
2293 (list (concat "^[ \t]+\\.cmd=[ \t]+"
2294 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2295 '(1 font-lock-keyword-face))
2296 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2297 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2298 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2299 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2300 (setq font-lock-defaults
2301 '(nfast-debug-mode-keywords nil nil nil nil))
2302 (run-hooks 'nfast-debug-mode-hook))
2303
2304;;;--------------------------------------------------------------------------
2305;;; Other languages.
2306
2307;; Smalltalk.
2308
2309(defun mdw-setup-smalltalk ()
2310 (and mdw-auto-indent
2311 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2312 (make-local-variable 'mdw-auto-indent)
2313 (setq mdw-auto-indent nil)
2314 (local-set-key "\C-i" 'smalltalk-reindent))
2315
2316(defun mdw-fontify-smalltalk ()
2317 (make-local-variable 'font-lock-keywords)
2318 (setq font-lock-keywords
2319 (list
2320 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2321 '(0 font-lock-keyword-face))
2322 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2323 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2324 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2325 '(0 mdw-number-face))
2326 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2327 '(0 mdw-punct-face))))
2328 (mdw-post-config-mode-hack))
2329
2330;; Lispy languages.
2331
2332;; Unpleasant bodge.
2333(unless (boundp 'slime-repl-mode-map)
2334 (setq slime-repl-mode-map (make-sparse-keymap)))
2335
2336(defun mdw-indent-newline-and-indent ()
2337 (interactive)
2338 (indent-for-tab-command)
2339 (newline-and-indent))
2340
2341(eval-after-load "cl-indent"
2342 '(progn
2343 (mapc #'(lambda (pair)
2344 (put (car pair)
2345 'common-lisp-indent-function
2346 (cdr pair)))
2347 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2348 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2349
2350(defun mdw-common-lisp-indent ()
2351 (make-local-variable 'lisp-indent-function)
2352 (setq lisp-indent-function 'common-lisp-indent-function))
2353
2354(setq lisp-simple-loop-indentation 2
2355 lisp-loop-keyword-indentation 6
2356 lisp-loop-forms-indentation 6)
2357
2358(defun mdw-fontify-lispy ()
2359
2360 ;; Set fill prefix.
2361 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2362
2363 ;; Not much fontification needed.
2364 (make-local-variable 'font-lock-keywords)
2365 (setq font-lock-keywords
2366 (list
2367 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2368 '(0 mdw-punct-face))))
2369
2370 (mdw-post-config-mode-hack))
2371
2372(defun comint-send-and-indent ()
2373 (interactive)
2374 (comint-send-input)
2375 (and mdw-auto-indent
2376 (indent-for-tab-command)))
2377
2378(defun mdw-setup-m4 ()
2379 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2380
2381;;;--------------------------------------------------------------------------
2382;;; Text mode.
2383
2384(defun mdw-text-mode ()
2385 (setq fill-column 72)
2386 (flyspell-mode t)
2387 (mdw-standard-fill-prefix
2388 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2389 (auto-fill-mode 1))
2390
2391;;;--------------------------------------------------------------------------
2392;;; Outline and hide/show modes.
2393
2394(defun mdw-outline-collapse-all ()
2395 "Completely collapse everything in the entire buffer."
2396 (interactive)
2397 (save-excursion
2398 (goto-char (point-min))
2399 (while (< (point) (point-max))
2400 (hide-subtree)
2401 (forward-line))))
2402
2403(setq hs-hide-comments-when-hiding-all nil)
2404
2405(defadvice hs-hide-all (after hide-first-comment activate)
2406 (save-excursion (hs-hide-initial-comment-block)))
2407
2408;;;--------------------------------------------------------------------------
2409;;; Shell mode.
2410
2411(defun mdw-sh-mode-setup ()
2412 (local-set-key [?\C-a] 'comint-bol)
2413 (add-hook 'comint-output-filter-functions
2414 'comint-watch-for-password-prompt))
2415
2416(defun mdw-term-mode-setup ()
2417 (setq term-prompt-regexp shell-prompt-pattern)
2418 (make-local-variable 'mouse-yank-at-point)
2419 (make-local-variable 'transient-mark-mode)
2420 (setq mouse-yank-at-point t)
2421 (auto-fill-mode -1)
2422 (setq tab-width 8))
2423
2424(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2425(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
2426(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2427(defun term-send-meta-meta-something ()
2428 (interactive)
2429 (term-send-raw-string "\e\e")
2430 (term-send-raw))
2431(eval-after-load 'term
2432 '(progn
2433 (define-key term-raw-map [?\e ?\e] nil)
2434 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2435 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2436 (define-key term-raw-map [M-right] 'term-send-meta-right)
2437 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2438 (define-key term-raw-map [M-left] 'term-send-meta-left)
2439 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2440
2441;;;--------------------------------------------------------------------------
2442;;; Inferior Emacs Lisp.
2443
2444(setq comint-prompt-read-only t)
2445
2446(eval-after-load "comint"
2447 '(progn
2448 (define-key comint-mode-map "\C-w" 'comint-kill-region)
2449 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2450
2451(eval-after-load "ielm"
2452 '(progn
2453 (define-key ielm-map "\C-w" 'comint-kill-region)
2454 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2455
2456;;;----- That's all, folks --------------------------------------------------
2457
2458(provide 'dot-emacs)