chiark / gitweb /
el/dot-emacs.el: Allow `+' as a list item marker.
[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 '((w3m . mdw-w3m-browse-url)
520 browse-url-w3
521 browse-url-mozilla)
522 "List of good browsers for mdw-good-url-browsers.
523Each item is a browser function name, or a cons (CHECK . FUNC).
524A symbol FOO stands for (FOO . FOO).")
525
526(defun mdw-good-url-browser ()
527 "Return a good URL browser.
528Trundle the list of such things, finding the first item for which
529CHECK is fboundp, and returning the correponding FUNC."
530 (let ((bs mdw-good-url-browsers) b check func answer)
531 (while (and bs (not answer))
532 (setq b (car bs)
533 bs (cdr bs))
534 (if (consp b)
535 (setq check (car b) func (cdr b))
536 (setq check b func b))
537 (if (fboundp check)
538 (setq answer func)))
539 answer))
540
541(eval-after-load "w3m-search"
542 '(progn
543 (dolist
544 (item
545 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
546 ("gd" "Google Directory"
547 "http://www.google.com/search?cat=gwd/Top&q=%s")
548 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
549 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
550 ("gi" "Images" "http://images.google.com/images?q=%s")
551 ("rfc" "RFC"
552 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
553 ("wp" "Wikipedia"
554 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
555 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
556 ("nc-wiki" "nCipher wiki"
557 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
558 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
559 ("lp" "Launchpad bug by number"
560 "https://bugs.launchpad.net/bugs/%s")
561 ("lppkg" "Launchpad bugs by package"
562 "https://bugs.launchpad.net/%s")
563 ("msdn" "MSDN"
564 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
565 ("debbug" "Debian bug by number"
566 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
567 ("debbugpkg" "Debian bugs by package"
568 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
569 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
570 (add-to-list 'w3m-search-engine-alist
571 (list (cadr item) (caddr item) nil))
572 (add-to-list 'w3m-uri-replace-alist
573 (list (concat "\\`" (car item) ":")
574 'w3m-search-uri-replace
575 (cadr item))))))
576
577;;;--------------------------------------------------------------------------
578;;; Paragraph filling.
579
580;; Useful variables.
581
582(defvar mdw-fill-prefix nil
583 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
584If there's no fill prefix currently set (by the `fill-prefix'
585variable) and there's a match from one of the regexps here, it
586gets used to set the fill-prefix for the current operation.
587
588The variable is a list of items of the form `REGEXP . PREFIX'; if
589the REGEXP matches, the PREFIX is used to set the fill prefix.
590It in turn is a list of things:
591
592 STRING -- insert a literal string
593 (match . N) -- insert the thing matched by bracketed subexpression N
594 (pad . N) -- a string of whitespace the same width as subexpression N
595 (expr . FORM) -- the result of evaluating FORM")
596
597(make-variable-buffer-local 'mdw-fill-prefix)
598
599(defvar mdw-hanging-indents
600 (concat "\\(\\("
601 "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
602 "[ \t]+"
603 "\\)?\\)")
604 "*Standard regexp matching parts of a hanging indent.
605This is mainly useful in `auto-fill-mode'.")
606
607;; Setting things up.
608
609(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
610
611;; Utility functions.
612
613(defun mdw-tabify (s)
614 "Tabify the string S. This is a horrid hack."
615 (save-excursion
616 (save-match-data
617 (let (start end)
618 (beginning-of-line)
619 (setq start (point-marker))
620 (insert s "\n")
621 (setq end (point-marker))
622 (tabify start end)
623 (setq s (buffer-substring start (1- end)))
624 (delete-region start end)
625 (set-marker start nil)
626 (set-marker end nil)
627 s))))
628
629(defun mdw-examine-fill-prefixes (l)
630 "Given a list of dynamic fill prefixes, pick one which matches
631context and return the static fill prefix to use. Point must be
632at the start of a line, and match data must be saved."
633 (cond ((not l) nil)
634 ((looking-at (car (car l)))
635 (mdw-tabify (apply (function concat)
636 (mapcar (function mdw-do-prefix-match)
637 (cdr (car l))))))
638 (t (mdw-examine-fill-prefixes (cdr l)))))
639
640(defun mdw-maybe-car (p)
641 "If P is a pair, return (car P), otherwise just return P."
642 (if (consp p) (car p) p))
643
644(defun mdw-padding (s)
645 "Return a string the same width as S but made entirely from whitespace."
646 (let* ((l (length s)) (i 0) (n (make-string l ? )))
647 (while (< i l)
648 (if (= 9 (aref s i))
649 (aset n i 9))
650 (setq i (1+ i)))
651 n))
652
653(defun mdw-do-prefix-match (m)
654 "Expand a dynamic prefix match element.
655See `mdw-fill-prefix' for details."
656 (cond ((not (consp m)) (format "%s" m))
657 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
658 ((eq (car m) 'pad) (mdw-padding (match-string
659 (mdw-maybe-car (cdr m)))))
660 ((eq (car m) 'eval) (eval (cdr m)))
661 (t "")))
662
663(defun mdw-choose-dynamic-fill-prefix ()
664 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
665 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
666 ((not mdw-fill-prefix) fill-prefix)
667 (t (save-excursion
668 (beginning-of-line)
669 (save-match-data
670 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
671
672(defun do-auto-fill ()
673 "Handle auto-filling, working out a dynamic fill prefix in the
674case where there isn't a sensible static one."
675 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
676 (mdw-do-auto-fill)))
677
678(defun mdw-fill-paragraph ()
679 "Fill paragraph, getting a dynamic fill prefix."
680 (interactive)
681 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
682 (fill-paragraph nil)))
683
684(defun mdw-standard-fill-prefix (rx &optional mat)
685 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
686This is just a short-cut for setting the thing by hand, and by
687design it doesn't cope with anything approximating a complicated
688case."
689 (setq mdw-fill-prefix
690 `((,(concat rx mdw-hanging-indents)
691 (match . 1)
692 (pad . ,(or mat 2))))))
693
694;;;--------------------------------------------------------------------------
695;;; Other common declarations.
696
697;; Common mode settings.
698
699(defvar mdw-auto-indent t
700 "Whether to indent automatically after a newline.")
701
702(defun mdw-whitespace-mode (&optional arg)
703 "Turn on/off whitespace mode, but don't highlight trailing space."
704 (interactive "P")
705 (when (and (boundp 'whitespace-style)
706 (fboundp 'whitespace-mode))
707 (let ((whitespace-style (remove 'trailing whitespace-style)))
708 (whitespace-mode arg))))
709
710(defun mdw-misc-mode-config ()
711 (and mdw-auto-indent
712 (cond ((eq major-mode 'lisp-mode)
713 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
714 ((or (eq major-mode 'slime-repl-mode)
715 (eq major-mode 'asm-mode))
716 nil)
717 (t
718 (local-set-key "\C-m" 'newline-and-indent))))
719 (local-set-key [C-return] 'newline)
720 (make-local-variable 'page-delimiter)
721 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
722 (setq comment-column 40)
723 (auto-fill-mode 1)
724 (setq fill-column 77)
725 (setq show-trailing-whitespace t)
726 (mdw-whitespace-mode 1)
727 (and (fboundp 'gtags-mode)
728 (gtags-mode))
729 (outline-minor-mode t)
730 (hs-minor-mode t)
731 (reveal-mode t)
732 (trap (turn-on-font-lock)))
733
734(defun mdw-post-config-mode-hack ()
735 (mdw-whitespace-mode 1))
736
737(eval-after-load 'gtags
738 '(progn
739 (dolist (key '([mouse-2] [mouse-3]))
740 (define-key gtags-mode-map key nil))
741 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
742 (define-key gtags-select-mode-map [C-S-mouse-2]
743 'gtags-select-tag-by-event)
744 (dolist (map (list gtags-mode-map gtags-select-mode-map))
745 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
746
747;; Backup file handling.
748
749(defvar mdw-backup-disable-regexps nil
750 "*List of regular expressions: if a file name matches any of
751these then the file is not backed up.")
752
753(defun mdw-backup-enable-predicate (name)
754 "[mdw]'s default backup predicate.
755Allows a backup if the standard predicate would allow it, and it
756doesn't match any of the regular expressions in
757`mdw-backup-disable-regexps'."
758 (and (normal-backup-enable-predicate name)
759 (let ((answer t) (list mdw-backup-disable-regexps))
760 (save-match-data
761 (while list
762 (if (string-match (car list) name)
763 (setq answer nil))
764 (setq list (cdr list)))
765 answer))))
766(setq backup-enable-predicate 'mdw-backup-enable-predicate)
767
768;; Frame cleanup.
769
770(defun mdw-last-one-out-turn-off-the-lights (frame)
771 "Disconnect from an X display if this was the last frame on that display."
772 (let ((frame-display (frame-parameter frame 'display)))
773 (when (and frame-display
774 (eq window-system 'x)
775 (not (some (lambda (fr)
776 (message "checking frame %s" frame)
777 (and (not (eq fr frame))
778 (string= (frame-parameter fr 'display)
779 frame-display)
780 (progn "frame %s still uses us" nil)))
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 120)))
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 (turn-on-font-lock-if-enabled)
2185 (run-hooks 'messages-mode-hook))
2186
2187(defun cpp-messages-mode ()
2188 (interactive)
2189 (fundamental-mode)
2190 (setq major-mode 'cpp-messages-mode)
2191 (setq mode-name "CPP Messages")
2192 (messages-mode-guts)
2193 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2194 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2195 (setq comment-start "/* ")
2196 (setq comment-end " */")
2197 (let ((preprocessor-keywords
2198 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2199 "ident" "if" "ifdef" "ifndef" "import" "include"
2200 "line" "pragma" "unassert" "undef" "warning")))
2201 (setq messages-mode-keywords
2202 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2203 "\\(include\\|import\\)"
2204 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2205 '(2 font-lock-string-face))
2206 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2207 preprocessor-keywords
2208 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2209 '(1 font-lock-keyword-face)))
2210 messages-mode-keywords)))
2211 (turn-on-font-lock-if-enabled)
2212 (run-hooks 'cpp-messages-mode-hook))
2213
2214(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2215(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2216; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2217
2218;;;--------------------------------------------------------------------------
2219;;; Messages-file mode.
2220
2221(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2222 "Face to use for subsittution directives.")
2223(make-face 'mallow-driver-substitution-face)
2224(defvar mallow-driver-text-face 'mallow-driver-text-face
2225 "Face to use for body text.")
2226(make-face 'mallow-driver-text-face)
2227
2228(defun mallow-driver-mode ()
2229 (interactive)
2230 (fundamental-mode)
2231 (setq major-mode 'mallow-driver-mode)
2232 (setq mode-name "Mallow driver")
2233 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2234 (set-syntax-table mallow-driver-mode-syntax-table)
2235 (make-local-variable 'comment-start)
2236 (make-local-variable 'comment-end)
2237 (make-local-variable 'indent-line-function)
2238 (setq indent-line-function 'indent-relative)
2239 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2240 (make-local-variable 'font-lock-defaults)
2241 (make-local-variable 'mallow-driver-mode-keywords)
2242 (let ((keywords
2243 (mdw-regexps "each" "divert" "file" "if"
2244 "perl" "set" "string" "type" "write")))
2245 (setq mallow-driver-mode-keywords
2246 (list
2247 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2248 '(0 font-lock-keyword-face))
2249 (list "^%\\s *\\(#.*\\|\\)$"
2250 '(0 font-lock-comment-face))
2251 (list "^%"
2252 '(0 font-lock-keyword-face))
2253 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2254 (list "\\${[^}]*}"
2255 '(0 mallow-driver-substitution-face t)))))
2256 (setq font-lock-defaults
2257 '(mallow-driver-mode-keywords nil nil nil nil))
2258 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2259 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2260 (setq comment-start "%# ")
2261 (setq comment-end "")
2262 (turn-on-font-lock-if-enabled)
2263 (run-hooks 'mallow-driver-mode-hook))
2264
2265(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2266
2267;;;--------------------------------------------------------------------------
2268;;; NFast debugs.
2269
2270(defun nfast-debug-mode ()
2271 (interactive)
2272 (fundamental-mode)
2273 (setq major-mode 'nfast-debug-mode)
2274 (setq mode-name "NFast debug")
2275 (setq messages-mode-syntax-table (make-syntax-table))
2276 (set-syntax-table messages-mode-syntax-table)
2277 (make-local-variable 'font-lock-defaults)
2278 (make-local-variable 'nfast-debug-mode-keywords)
2279 (setq truncate-lines t)
2280 (setq nfast-debug-mode-keywords
2281 (list
2282 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2283 (0 font-lock-keyword-face))
2284 (list (concat "^[ \t]+\\(\\("
2285 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2286 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2287 "[ \t]+\\)*"
2288 "[0-9a-fA-F]+\\)[ \t]*$")
2289 '(0 mdw-number-face))
2290 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2291 (1 font-lock-keyword-face))
2292 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2293 (1 font-lock-warning-face))
2294 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2295 (1 nil))
2296 (list (concat "^[ \t]+\\.cmd=[ \t]+"
2297 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2298 '(1 font-lock-keyword-face))
2299 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2300 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2301 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2302 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2303 (setq font-lock-defaults
2304 '(nfast-debug-mode-keywords nil nil nil nil))
2305 (turn-on-font-lock-if-enabled)
2306 (run-hooks 'nfast-debug-mode-hook))
2307
2308;;;--------------------------------------------------------------------------
2309;;; Other languages.
2310
2311;; Smalltalk.
2312
2313(defun mdw-setup-smalltalk ()
2314 (and mdw-auto-indent
2315 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2316 (make-local-variable 'mdw-auto-indent)
2317 (setq mdw-auto-indent nil)
2318 (local-set-key "\C-i" 'smalltalk-reindent))
2319
2320(defun mdw-fontify-smalltalk ()
2321 (make-local-variable 'font-lock-keywords)
2322 (setq font-lock-keywords
2323 (list
2324 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2325 '(0 font-lock-keyword-face))
2326 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2327 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2328 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2329 '(0 mdw-number-face))
2330 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2331 '(0 mdw-punct-face))))
2332 (mdw-post-config-mode-hack))
2333
2334;; Lispy languages.
2335
2336;; Unpleasant bodge.
2337(unless (boundp 'slime-repl-mode-map)
2338 (setq slime-repl-mode-map (make-sparse-keymap)))
2339
2340(defun mdw-indent-newline-and-indent ()
2341 (interactive)
2342 (indent-for-tab-command)
2343 (newline-and-indent))
2344
2345(eval-after-load "cl-indent"
2346 '(progn
2347 (mapc #'(lambda (pair)
2348 (put (car pair)
2349 'common-lisp-indent-function
2350 (cdr pair)))
2351 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2352 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2353
2354(defun mdw-common-lisp-indent ()
2355 (make-local-variable 'lisp-indent-function)
2356 (setq lisp-indent-function 'common-lisp-indent-function))
2357
2358(setq lisp-simple-loop-indentation 2
2359 lisp-loop-keyword-indentation 6
2360 lisp-loop-forms-indentation 6)
2361
2362(defun mdw-fontify-lispy ()
2363
2364 ;; Set fill prefix.
2365 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2366
2367 ;; Not much fontification needed.
2368 (make-local-variable 'font-lock-keywords)
2369 (setq font-lock-keywords
2370 (list
2371 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2372 '(0 mdw-punct-face))))
2373
2374 (mdw-post-config-mode-hack))
2375
2376(defun comint-send-and-indent ()
2377 (interactive)
2378 (comint-send-input)
2379 (and mdw-auto-indent
2380 (indent-for-tab-command)))
2381
2382(defun mdw-setup-m4 ()
2383 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2384
2385;;;--------------------------------------------------------------------------
2386;;; Text mode.
2387
2388(defun mdw-text-mode ()
2389 (setq fill-column 72)
2390 (flyspell-mode t)
2391 (mdw-standard-fill-prefix
2392 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2393 (auto-fill-mode 1))
2394
2395;;;--------------------------------------------------------------------------
2396;;; Outline and hide/show modes.
2397
2398(defun mdw-outline-collapse-all ()
2399 "Completely collapse everything in the entire buffer."
2400 (interactive)
2401 (save-excursion
2402 (goto-char (point-min))
2403 (while (< (point) (point-max))
2404 (hide-subtree)
2405 (forward-line))))
2406
2407(setq hs-hide-comments-when-hiding-all nil)
2408
2409(defadvice hs-hide-all (after hide-first-comment activate)
2410 (save-excursion (hs-hide-initial-comment-block)))
2411
2412;;;--------------------------------------------------------------------------
2413;;; Shell mode.
2414
2415(defun mdw-sh-mode-setup ()
2416 (local-set-key [?\C-a] 'comint-bol)
2417 (add-hook 'comint-output-filter-functions
2418 'comint-watch-for-password-prompt))
2419
2420(defun mdw-term-mode-setup ()
2421 (setq term-prompt-regexp shell-prompt-pattern)
2422 (make-local-variable 'mouse-yank-at-point)
2423 (make-local-variable 'transient-mark-mode)
2424 (setq mouse-yank-at-point t)
2425 (auto-fill-mode -1)
2426 (setq tab-width 8))
2427
2428(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2429(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
2430(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2431(defun term-send-meta-meta-something ()
2432 (interactive)
2433 (term-send-raw-string "\e\e")
2434 (term-send-raw))
2435(eval-after-load 'term
2436 '(progn
2437 (define-key term-raw-map [?\e ?\e] nil)
2438 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2439 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2440 (define-key term-raw-map [M-right] 'term-send-meta-right)
2441 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2442 (define-key term-raw-map [M-left] 'term-send-meta-left)
2443 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2444
2445;;;--------------------------------------------------------------------------
2446;;; Inferior Emacs Lisp.
2447
2448(setq comint-prompt-read-only t)
2449
2450(eval-after-load "comint"
2451 '(progn
2452 (define-key comint-mode-map "\C-w" 'comint-kill-region)
2453 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2454
2455(eval-after-load "ielm"
2456 '(progn
2457 (define-key ielm-map "\C-w" 'comint-kill-region)
2458 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2459
2460;;;----- That's all, folks --------------------------------------------------
2461
2462(provide 'dot-emacs)