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