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