chiark / gitweb /
bg/hypatia.jpg: New background.
[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
c14d7793
MW
814(eval-after-load "cc-mode"
815 '(progn
816 (define-key c-mode-map "*" nil)
817 (define-key c-mode-map "/" nil)))
f06dee7a 818
f50c1bed
MW
819(defun mdw-c-lineup-arglist (langelem)
820 "Hack for DWIMmery in c-lineup-arglist."
821 (if (save-excursion
822 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
823 0
824 (c-lineup-arglist langelem)))
825
826(defun mdw-c-indent-extern-mumble (langelem)
827 "Indent `extern \"...\" {' lines."
828 (save-excursion
829 (back-to-indentation)
830 (if (looking-at
831 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
832 c-basic-offset
833 nil)))
834
f617db13
MW
835(defun mdw-c-style ()
836 (c-add-style "[mdw] C and C++ style"
837 '((c-basic-offset . 2)
f617db13
MW
838 (comment-column . 40)
839 (c-class-key . "class")
f50c1bed
MW
840 (c-backslash-column . 72)
841 (c-offsets-alist
842 (substatement-open . (add 0 c-indent-one-line-block))
843 (defun-open . (add 0 c-indent-one-line-block))
844 (arglist-cont-nonempty . mdw-c-lineup-arglist)
845 (topmost-intro . mdw-c-indent-extern-mumble)
846 (cpp-define-intro . 0)
847 (inextern-lang . [0])
848 (label . 0)
849 (case-label . +)
850 (access-label . -)
851 (inclass . +)
852 (inline-open . ++)
853 (statement-cont . 0)
854 (statement-case-intro . +)))
f617db13
MW
855 t))
856
857(defun mdw-fontify-c-and-c++ ()
858
859 ;; --- Fiddle with some syntax codes ---
860
f617db13
MW
861 (modify-syntax-entry ?* ". 23")
862 (modify-syntax-entry ?/ ". 124b")
863 (modify-syntax-entry ?\n "> b")
864
865 ;; --- Other stuff ---
866
867 (mdw-c-style)
868 (setq c-hanging-comment-ender-p nil)
869 (setq c-backslash-column 72)
870 (setq c-label-minimum-indentation 0)
f617db13
MW
871 (setq mdw-fill-prefix
872 `((,(concat "\\([ \t]*/?\\)"
873 "\\([\*/][ \t]*\\)"
874 "\\([A-Za-z]+:[ \t]*\\)?"
875 mdw-hanging-indents)
876 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
877
878 ;; --- Now define things to be fontified ---
879
02109a0d 880 (make-local-variable 'font-lock-keywords)
f617db13 881 (let ((c-keywords
8d6d55b9
MW
882 (mdw-regexps "and" ;C++
883 "and_eq" ;C++
884 "asm" ;K&R, GCC
885 "auto" ;K&R, C89
886 "bitand" ;C++
887 "bitor" ;C++
888 "bool" ;C++, C9X macro
889 "break" ;K&R, C89
890 "case" ;K&R, C89
891 "catch" ;C++
892 "char" ;K&R, C89
893 "class" ;C++
894 "complex" ;C9X macro, C++ template type
895 "compl" ;C++
896 "const" ;C89
897 "const_cast" ;C++
898 "continue" ;K&R, C89
899 "defined" ;C89 preprocessor
900 "default" ;K&R, C89
901 "delete" ;C++
902 "do" ;K&R, C89
903 "double" ;K&R, C89
904 "dynamic_cast" ;C++
905 "else" ;K&R, C89
906 ;; "entry" ;K&R -- never used
907 "enum" ;C89
908 "explicit" ;C++
909 "export" ;C++
910 "extern" ;K&R, C89
911 "false" ;C++, C9X macro
912 "float" ;K&R, C89
913 "for" ;K&R, C89
914 ;; "fortran" ;K&R
915 "friend" ;C++
916 "goto" ;K&R, C89
917 "if" ;K&R, C89
918 "imaginary" ;C9X macro
919 "inline" ;C++, C9X, GCC
920 "int" ;K&R, C89
921 "long" ;K&R, C89
922 "mutable" ;C++
923 "namespace" ;C++
924 "new" ;C++
925 "operator" ;C++
926 "or" ;C++
927 "or_eq" ;C++
928 "private" ;C++
929 "protected" ;C++
930 "public" ;C++
931 "register" ;K&R, C89
932 "reinterpret_cast" ;C++
933 "restrict" ;C9X
934 "return" ;K&R, C89
935 "short" ;K&R, C89
936 "signed" ;C89
937 "sizeof" ;K&R, C89
938 "static" ;K&R, C89
939 "static_cast" ;C++
940 "struct" ;K&R, C89
941 "switch" ;K&R, C89
942 "template" ;C++
943 "this" ;C++
944 "throw" ;C++
945 "true" ;C++, C9X macro
946 "try" ;C++
947 "this" ;C++
948 "typedef" ;C89
949 "typeid" ;C++
950 "typeof" ;GCC
951 "typename" ;C++
952 "union" ;K&R, C89
953 "unsigned" ;K&R, C89
954 "using" ;C++
955 "virtual" ;C++
956 "void" ;C89
957 "volatile" ;C89
958 "wchar_t" ;C++, C89 library type
959 "while" ;K&R, C89
960 "xor" ;C++
961 "xor_eq" ;C++
962 "_Bool" ;C9X
963 "_Complex" ;C9X
964 "_Imaginary" ;C9X
965 "_Pragma" ;C9X preprocessor
966 "__alignof__" ;GCC
967 "__asm__" ;GCC
968 "__attribute__" ;GCC
969 "__complex__" ;GCC
970 "__const__" ;GCC
971 "__extension__" ;GCC
972 "__imag__" ;GCC
973 "__inline__" ;GCC
974 "__label__" ;GCC
975 "__real__" ;GCC
976 "__signed__" ;GCC
977 "__typeof__" ;GCC
978 "__volatile__" ;GCC
979 ))
f617db13 980 (preprocessor-keywords
8d6d55b9
MW
981 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
982 "ident" "if" "ifdef" "ifndef" "import" "include"
983 "line" "pragma" "unassert" "undef" "warning"))
f617db13 984 (objc-keywords
8d6d55b9
MW
985 (mdw-regexps "class" "defs" "encode" "end" "implementation"
986 "interface" "private" "protected" "protocol" "public"
987 "selector")))
f617db13
MW
988
989 (setq font-lock-keywords
990 (list
f617db13
MW
991
992 ;; --- Fontify include files as strings ---
993
994 (list (concat "^[ \t]*\\#[ \t]*"
995 "\\(include\\|import\\)"
996 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
997 '(2 font-lock-string-face))
998
999 ;; --- Preprocessor directives are `references'? ---
1000
1001 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1002 preprocessor-keywords
1003 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1004 '(1 font-lock-keyword-face))
1005
1006 ;; --- Handle the keywords defined above ---
1007
1008 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1009 '(0 font-lock-keyword-face))
1010
1011 (list (concat "\\<\\(" c-keywords "\\)\\>")
1012 '(0 font-lock-keyword-face))
1013
1014 ;; --- Handle numbers too ---
1015 ;;
1016 ;; This looks strange, I know. It corresponds to the
1017 ;; preprocessor's idea of what a number looks like, rather than
1018 ;; anything sensible.
1019
1020 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1021 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1022 '(0 mdw-number-face))
1023
1024 ;; --- And anything else is punctuation ---
1025
1026 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1027 '(0 mdw-punct-face))))))
1028
1029;;;----- AP calc mode -------------------------------------------------------
1030
1031(defun apcalc-mode ()
1032 (interactive)
1033 (c-mode)
1034 (setq major-mode 'apcalc-mode)
1035 (setq mode-name "AP Calc")
1036 (run-hooks 'apcalc-mode-hook))
1037
1038(defun mdw-fontify-apcalc ()
1039
1040 ;; --- Fiddle with some syntax codes ---
1041
f617db13
MW
1042 (modify-syntax-entry ?* ". 23")
1043 (modify-syntax-entry ?/ ". 14")
1044
1045 ;; --- Other stuff ---
1046
1047 (mdw-c-style)
1048 (setq c-hanging-comment-ender-p nil)
1049 (setq c-backslash-column 72)
1050 (setq comment-start "/* ")
1051 (setq comment-end " */")
1052 (setq mdw-fill-prefix
1053 `((,(concat "\\([ \t]*/?\\)"
1054 "\\([\*/][ \t]*\\)"
1055 "\\([A-Za-z]+:[ \t]*\\)?"
1056 mdw-hanging-indents)
1057 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1058
1059 ;; --- Now define things to be fontified ---
1060
02109a0d 1061 (make-local-variable 'font-lock-keywords)
f617db13 1062 (let ((c-keywords
8d6d55b9
MW
1063 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1064 "do" "else" "exit" "for" "global" "goto" "help" "if"
1065 "local" "mat" "obj" "print" "quit" "read" "return"
1066 "show" "static" "switch" "while" "write")))
f617db13
MW
1067
1068 (setq font-lock-keywords
1069 (list
f617db13
MW
1070
1071 ;; --- Handle the keywords defined above ---
1072
1073 (list (concat "\\<\\(" c-keywords "\\)\\>")
1074 '(0 font-lock-keyword-face))
1075
1076 ;; --- Handle numbers too ---
1077 ;;
1078 ;; This looks strange, I know. It corresponds to the
1079 ;; preprocessor's idea of what a number looks like, rather than
1080 ;; anything sensible.
1081
1082 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1083 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1084 '(0 mdw-number-face))
1085
1086 ;; --- And anything else is punctuation ---
1087
1088 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1089 '(0 mdw-punct-face))))))
1090
1091;;;----- Java programming configuration -------------------------------------
1092
1093;; --- Make indentation nice ---
1094
1095(defun mdw-java-style ()
1096 (c-add-style "[mdw] Java style"
1097 '((c-basic-offset . 2)
f617db13
MW
1098 (c-offsets-alist (substatement-open . 0)
1099 (label . +)
1100 (case-label . +)
1101 (access-label . 0)
1102 (inclass . +)
1103 (statement-case-intro . +)))
1104 t))
1105
1106;; --- Declare Java fontification style ---
1107
1108(defun mdw-fontify-java ()
1109
1110 ;; --- Other stuff ---
1111
1112 (mdw-java-style)
f617db13
MW
1113 (setq c-hanging-comment-ender-p nil)
1114 (setq c-backslash-column 72)
1115 (setq comment-start "/* ")
1116 (setq comment-end " */")
1117 (setq mdw-fill-prefix
1118 `((,(concat "\\([ \t]*/?\\)"
1119 "\\([\*/][ \t]*\\)"
1120 "\\([A-Za-z]+:[ \t]*\\)?"
1121 mdw-hanging-indents)
1122 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1123
1124 ;; --- Now define things to be fontified ---
1125
02109a0d 1126 (make-local-variable 'font-lock-keywords)
f617db13 1127 (let ((java-keywords
8d6d55b9
MW
1128 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1129 "char" "class" "const" "continue" "default" "do"
1130 "double" "else" "extends" "final" "finally" "float"
1131 "for" "goto" "if" "implements" "import" "instanceof"
1132 "int" "interface" "long" "native" "new" "package"
1133 "private" "protected" "public" "return" "short"
1134 "static" "super" "switch" "synchronized" "this"
1135 "throw" "throws" "transient" "try" "void" "volatile"
1136 "while"
1137
1138 "false" "null" "true")))
f617db13
MW
1139
1140 (setq font-lock-keywords
1141 (list
f617db13
MW
1142
1143 ;; --- Handle the keywords defined above ---
1144
1145 (list (concat "\\<\\(" java-keywords "\\)\\>")
1146 '(0 font-lock-keyword-face))
1147
1148 ;; --- Handle numbers too ---
1149 ;;
1150 ;; The following isn't quite right, but it's close enough.
1151
1152 (list (concat "\\<\\("
1153 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1154 "[0-9]+\\(\\.[0-9]*\\|\\)"
1155 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1156 "[lLfFdD]?")
1157 '(0 mdw-number-face))
1158
1159 ;; --- And anything else is punctuation ---
1160
1161 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1162 '(0 mdw-punct-face))))))
1163
e808c1e5
MW
1164;;;----- C# programming configuration ---------------------------------------
1165
1166;; --- Make indentation nice ---
1167
1168(defun mdw-csharp-style ()
1169 (c-add-style "[mdw] C# style"
1170 '((c-basic-offset . 2)
e808c1e5
MW
1171 (c-offsets-alist (substatement-open . 0)
1172 (label . 0)
1173 (case-label . +)
1174 (access-label . 0)
1175 (inclass . +)
1176 (statement-case-intro . +)))
1177 t))
1178
1179;; --- Declare C# fontification style ---
1180
1181(defun mdw-fontify-csharp ()
1182
1183 ;; --- Other stuff ---
1184
1185 (mdw-csharp-style)
e808c1e5
MW
1186 (setq c-hanging-comment-ender-p nil)
1187 (setq c-backslash-column 72)
1188 (setq comment-start "/* ")
1189 (setq comment-end " */")
1190 (setq mdw-fill-prefix
1191 `((,(concat "\\([ \t]*/?\\)"
1192 "\\([\*/][ \t]*\\)"
1193 "\\([A-Za-z]+:[ \t]*\\)?"
1194 mdw-hanging-indents)
1195 (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1196
1197 ;; --- Now define things to be fontified ---
1198
1199 (make-local-variable 'font-lock-keywords)
1200 (let ((csharp-keywords
8d6d55b9
MW
1201 (mdw-regexps "abstract" "as" "base" "bool" "break"
1202 "byte" "case" "catch" "char" "checked"
1203 "class" "const" "continue" "decimal" "default"
1204 "delegate" "do" "double" "else" "enum"
1205 "event" "explicit" "extern" "false" "finally"
1206 "fixed" "float" "for" "foreach" "goto"
1207 "if" "implicit" "in" "int" "interface"
1208 "internal" "is" "lock" "long" "namespace"
1209 "new" "null" "object" "operator" "out"
1210 "override" "params" "private" "protected" "public"
1211 "readonly" "ref" "return" "sbyte" "sealed"
1212 "short" "sizeof" "stackalloc" "static" "string"
1213 "struct" "switch" "this" "throw" "true"
1214 "try" "typeof" "uint" "ulong" "unchecked"
1215 "unsafe" "ushort" "using" "virtual" "void"
1216 "volatile" "while" "yield")))
e808c1e5
MW
1217
1218 (setq font-lock-keywords
1219 (list
e808c1e5
MW
1220
1221 ;; --- Handle the keywords defined above ---
1222
1223 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1224 '(0 font-lock-keyword-face))
1225
1226 ;; --- Handle numbers too ---
1227 ;;
1228 ;; The following isn't quite right, but it's close enough.
1229
1230 (list (concat "\\<\\("
1231 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1232 "[0-9]+\\(\\.[0-9]*\\|\\)"
1233 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1234 "[lLfFdD]?")
1235 '(0 mdw-number-face))
1236
1237 ;; --- And anything else is punctuation ---
1238
1239 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1240 '(0 mdw-punct-face))))))
1241
1242(defun csharp-mode ()
1243 (interactive)
1244 (java-mode)
1245 (setq major-mode 'csharp-mode)
1246 (setq mode-name "C#")
1247 (mdw-fontify-csharp)
1248 (run-hooks 'csharp-mode-hook))
1249
f617db13
MW
1250;;;----- Awk programming configuration --------------------------------------
1251
1252;; --- Make Awk indentation nice ---
1253
1254(defun mdw-awk-style ()
1255 (c-add-style "[mdw] Awk style"
1256 '((c-basic-offset . 2)
f617db13
MW
1257 (c-offsets-alist (substatement-open . 0)
1258 (statement-cont . 0)
1259 (statement-case-intro . +)))
1260 t))
1261
1262;; --- Declare Awk fontification style ---
1263
1264(defun mdw-fontify-awk ()
1265
1266 ;; --- Miscellaneous fiddling ---
1267
f617db13
MW
1268 (mdw-awk-style)
1269 (setq c-backslash-column 72)
1270 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1271
1272 ;; --- Now define things to be fontified ---
1273
02109a0d 1274 (make-local-variable 'font-lock-keywords)
f617db13 1275 (let ((c-keywords
8d6d55b9
MW
1276 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1277 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1278 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1279 "RSTART" "RLENGTH" "RT" "SUBSEP"
1280 "atan2" "break" "close" "continue" "cos" "delete"
1281 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1282 "function" "gensub" "getline" "gsub" "if" "in"
1283 "index" "int" "length" "log" "match" "next" "rand"
1284 "return" "print" "printf" "sin" "split" "sprintf"
1285 "sqrt" "srand" "strftime" "sub" "substr" "system"
1286 "systime" "tolower" "toupper" "while")))
f617db13
MW
1287
1288 (setq font-lock-keywords
1289 (list
f617db13
MW
1290
1291 ;; --- Handle the keywords defined above ---
1292
1293 (list (concat "\\<\\(" c-keywords "\\)\\>")
1294 '(0 font-lock-keyword-face))
1295
1296 ;; --- Handle numbers too ---
1297 ;;
1298 ;; The following isn't quite right, but it's close enough.
1299
1300 (list (concat "\\<\\("
1301 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1302 "[0-9]+\\(\\.[0-9]*\\|\\)"
1303 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1304 "[uUlL]*")
1305 '(0 mdw-number-face))
1306
1307 ;; --- And anything else is punctuation ---
1308
1309 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1310 '(0 mdw-punct-face))))))
1311
1312;;;----- Perl programming style ---------------------------------------------
1313
1314;; --- Perl indentation style ---
1315
f617db13
MW
1316(setq cperl-indent-level 2)
1317(setq cperl-continued-statement-offset 2)
1318(setq cperl-continued-brace-offset 0)
1319(setq cperl-brace-offset -2)
1320(setq cperl-brace-imaginary-offset 0)
1321(setq cperl-label-offset 0)
1322
1323;; --- Define perl fontification style ---
1324
1325(defun mdw-fontify-perl ()
1326
1327 ;; --- Miscellaneous fiddling ---
1328
f617db13
MW
1329 (modify-syntax-entry ?$ "\\")
1330 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1331 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1332
1333 ;; --- Now define fontification things ---
1334
02109a0d 1335 (make-local-variable 'font-lock-keywords)
f617db13 1336 (let ((perl-keywords
8d6d55b9
MW
1337 (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1338 "for" "foreach" "ge" "gt" "goto" "if"
1339 "last" "le" "lt" "local" "my" "ne" "next" "or"
1340 "package" "redo" "require" "return" "sub"
1341 "undef" "unless" "until" "use" "while")))
f617db13
MW
1342
1343 (setq font-lock-keywords
1344 (list
f617db13
MW
1345
1346 ;; --- Set up the keywords defined above ---
1347
1348 (list (concat "\\<\\(" perl-keywords "\\)\\>")
1349 '(0 font-lock-keyword-face))
1350
1351 ;; --- At least numbers are simpler than C ---
1352
1353 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1354 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1355 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1356 '(0 mdw-number-face))
1357
1358 ;; --- And anything else is punctuation ---
1359
1360 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1361 '(0 mdw-punct-face))))))
1362
1363(defun perl-number-tests (&optional arg)
1364 "Assign consecutive numbers to lines containing `#t'. With ARG,
1365strip numbers instead."
1366 (interactive "P")
1367 (save-excursion
1368 (goto-char (point-min))
1369 (let ((i 0) (fmt (if arg "" " %4d")))
1370 (while (search-forward "#t" nil t)
1371 (delete-region (point) (line-end-position))
1372 (setq i (1+ i))
1373 (insert (format fmt i)))
1374 (goto-char (point-min))
1375 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1376 (replace-match (format "\\1%d" i))))))
1377
1378;;;----- Python programming style -------------------------------------------
1379
1380;; --- Define Python fontification style ---
1381
f617db13
MW
1382(defun mdw-fontify-python ()
1383
1384 ;; --- Miscellaneous fiddling ---
1385
f617db13
MW
1386 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1387
1388 ;; --- Now define fontification things ---
1389
02109a0d 1390 (make-local-variable 'font-lock-keywords)
f617db13 1391 (let ((python-keywords
8d6d55b9
MW
1392 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1393 "del" "elif" "else" "except" "exec" "finally" "for"
1394 "from" "global" "if" "import" "in" "is" "lambda"
1395 "not" "or" "pass" "print" "raise" "return" "try"
e61fa1ae 1396 "while" "with" "yield")))
f617db13
MW
1397 (setq font-lock-keywords
1398 (list
f617db13
MW
1399
1400 ;; --- Set up the keywords defined above ---
1401
1402 (list (concat "\\<\\(" python-keywords "\\)\\>")
1403 '(0 font-lock-keyword-face))
1404
1405 ;; --- At least numbers are simpler than C ---
1406
1407 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1408 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1409 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1410 '(0 mdw-number-face))
1411
1412 ;; --- And anything else is punctuation ---
1413
1414 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1415 '(0 mdw-punct-face))))))
1416
cc1980e1
MW
1417;;;----- Icon programming style ---------------------------------------------
1418
1419;; --- Icon indentation style ---
1420
1421(setq icon-brace-offset 0
1422 icon-continued-brace-offset 0
1423 icon-continued-statement-offset 2
1424 icon-indent-level 2)
1425
1426;; --- Define Icon fontification style ---
1427
1428(defun mdw-fontify-icon ()
1429
1430 ;; --- Miscellaneous fiddling ---
1431
1432 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1433
1434 ;; --- Now define fontification things ---
1435
1436 (make-local-variable 'font-lock-keywords)
1437 (let ((icon-keywords
1438 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1439 "end" "every" "fail" "global" "if" "initial"
1440 "invocable" "link" "local" "next" "not" "of"
1441 "procedure" "record" "repeat" "return" "static"
1442 "suspend" "then" "to" "until" "while"))
1443 (preprocessor-keywords
1444 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1445 "include" "line" "undef")))
1446 (setq font-lock-keywords
1447 (list
1448
1449 ;; --- Set up the keywords defined above ---
1450
1451 (list (concat "\\<\\(" icon-keywords "\\)\\>")
1452 '(0 font-lock-keyword-face))
1453
1454 ;; --- The things that Icon calls keywords ---
1455
1456 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1457
1458 ;; --- At least numbers are simpler than C ---
1459
1460 (list (concat "\\<[0-9]+"
1461 "\\([rR][0-9a-zA-Z]+\\|"
1462 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1463 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1464 '(0 mdw-number-face))
1465
1466 ;; --- Preprocessor ---
1467
1468 (list (concat "^[ \t]*$[ \t]*\\<\\("
1469 preprocessor-keywords
1470 "\\)\\>")
1471 '(0 font-lock-keyword-face))
1472
1473 ;; --- And anything else is punctuation ---
1474
1475 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1476 '(0 mdw-punct-face))))))
1477
f617db13
MW
1478;;;----- ARM assembler programming configuration ----------------------------
1479
1480;; --- There doesn't appear to be an Emacs mode for this yet ---
1481;;
1482;; Better do something about that, I suppose.
1483
1484(defvar arm-assembler-mode-map nil)
1485(defvar arm-assembler-abbrev-table nil)
1486(defvar arm-assembler-mode-syntax-table (make-syntax-table))
1487
1488(or arm-assembler-mode-map
1489 (progn
1490 (setq arm-assembler-mode-map (make-sparse-keymap))
1491 (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1492 (define-key arm-assembler-mode-map [C-return] 'newline)
1493 (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1494
1495(defun arm-assembler-mode ()
1496 "Major mode for ARM assembler programs"
1497 (interactive)
1498
1499 ;; --- Do standard major mode things ---
1500
1501 (kill-all-local-variables)
1502 (use-local-map arm-assembler-mode-map)
1503 (setq local-abbrev-table arm-assembler-abbrev-table)
1504 (setq major-mode 'arm-assembler-mode)
1505 (setq mode-name "ARM assembler")
1506
1507 ;; --- Set up syntax table ---
1508
1509 (set-syntax-table arm-assembler-mode-syntax-table)
1510 (modify-syntax-entry ?; ; Nasty hack
1511 "<" arm-assembler-mode-syntax-table)
1512 (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1513 (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1514
1515 (make-local-variable 'comment-start)
1516 (setq comment-start ";")
1517 (make-local-variable 'comment-end)
1518 (setq comment-end "")
1519 (make-local-variable 'comment-column)
1520 (setq comment-column 48)
1521 (make-local-variable 'comment-start-skip)
1522 (setq comment-start-skip ";+[ \t]*")
1523
1524 ;; --- Play with indentation ---
1525
1526 (make-local-variable 'indent-line-function)
1527 (setq indent-line-function 'indent-relative-maybe)
1528
1529 ;; --- Set fill prefix ---
1530
1531 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1532
1533 ;; --- Fiddle with fontification ---
1534
02109a0d 1535 (make-local-variable 'font-lock-keywords)
f617db13
MW
1536 (setq font-lock-keywords
1537 (list
f617db13
MW
1538
1539 ;; --- Handle numbers too ---
1540 ;;
1541 ;; The following isn't quite right, but it's close enough.
1542
1543 (list (concat "\\("
1544 "&[0-9a-fA-F]+\\|"
1545 "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1546 "\\)")
1547 '(0 mdw-number-face))
1548
1549 ;; --- Do something about operators ---
1550
1551 (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1552 '(1 font-lock-keyword-face)
1553 '(2 font-lock-string-face))
1554 (list ":[a-zA-Z]+:"
1555 '(0 font-lock-keyword-face))
1556
1557 ;; --- Do menemonics and directives ---
1558
1559 (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1560 '(1 font-lock-keyword-face))
1561
1562 ;; --- And anything else is punctuation ---
1563
1564 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1565 '(0 mdw-punct-face))))
1566
1567 (run-hooks 'arm-assembler-mode-hook))
1568
30c8a8fb
MW
1569;;;----- Assembler mode -----------------------------------------------------
1570
1571(defun mdw-fontify-asm ()
1572 (modify-syntax-entry ?' "\"")
1573 (modify-syntax-entry ?. "w")
1574 (setf fill-prefix nil)
1575 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1576
f617db13
MW
1577;;;----- TCL configuration --------------------------------------------------
1578
1579(defun mdw-fontify-tcl ()
1580 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1581 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
02109a0d 1582 (make-local-variable 'font-lock-keywords)
f617db13
MW
1583 (setq font-lock-keywords
1584 (list
f617db13
MW
1585 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1586 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1587 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1588 '(0 mdw-number-face))
1589 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1590 '(0 mdw-punct-face)))))
1591
1592;;;----- REXX configuration -------------------------------------------------
1593
1594(defun mdw-rexx-electric-* ()
1595 (interactive)
1596 (insert ?*)
1597 (rexx-indent-line))
1598
1599(defun mdw-rexx-indent-newline-indent ()
1600 (interactive)
1601 (rexx-indent-line)
1602 (if abbrev-mode (expand-abbrev))
1603 (newline-and-indent))
1604
1605(defun mdw-fontify-rexx ()
1606
1607 ;; --- Various bits of fiddling ---
1608
1609 (setq mdw-auto-indent nil)
1610 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1611 (local-set-key [?*] 'mdw-rexx-electric-*)
1612 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
e443a4cd 1613 '(?! ?? ?# ?@ ?$))
f617db13
MW
1614 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1615
1616 ;; --- Set up keywords and things for fontification ---
1617
1618 (make-local-variable 'font-lock-keywords-case-fold-search)
1619 (setq font-lock-keywords-case-fold-search t)
1620
1621 (setq rexx-indent 2)
1622 (setq rexx-end-indent rexx-indent)
f617db13
MW
1623 (setq rexx-cont-indent rexx-indent)
1624
02109a0d 1625 (make-local-variable 'font-lock-keywords)
f617db13 1626 (let ((rexx-keywords
8d6d55b9
MW
1627 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1628 "else" "end" "engineering" "exit" "expose" "for"
1629 "forever" "form" "fuzz" "if" "interpret" "iterate"
1630 "leave" "linein" "name" "nop" "numeric" "off" "on"
1631 "options" "otherwise" "parse" "procedure" "pull"
1632 "push" "queue" "return" "say" "select" "signal"
1633 "scientific" "source" "then" "trace" "to" "until"
1634 "upper" "value" "var" "version" "when" "while"
1635 "with"
1636
1637 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1638 "center" "center" "charin" "charout" "chars"
1639 "compare" "condition" "copies" "c2d" "c2x"
1640 "datatype" "date" "delstr" "delword" "d2c" "d2x"
1641 "errortext" "format" "fuzz" "insert" "lastpos"
1642 "left" "length" "lineout" "lines" "max" "min"
1643 "overlay" "pos" "queued" "random" "reverse" "right"
1644 "sign" "sourceline" "space" "stream" "strip"
1645 "substr" "subword" "symbol" "time" "translate"
1646 "trunc" "value" "verify" "word" "wordindex"
1647 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1648 "x2d")))
f617db13
MW
1649
1650 (setq font-lock-keywords
1651 (list
f617db13
MW
1652
1653 ;; --- Set up the keywords defined above ---
1654
1655 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1656 '(0 font-lock-keyword-face))
1657
1658 ;; --- Fontify all symbols the same way ---
1659
1660 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1661 "[A-Za-z0-9.!?_#@$]+\\)")
1662 '(0 font-lock-variable-name-face))
1663
1664 ;; --- And everything else is punctuation ---
1665
1666 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1667 '(0 mdw-punct-face))))))
1668
1669;;;----- Standard ML programming style --------------------------------------
1670
1671(defun mdw-fontify-sml ()
1672
1673 ;; --- Make underscore an honorary letter ---
1674
f617db13
MW
1675 (modify-syntax-entry ?' "w")
1676
1677 ;; --- Set fill prefix ---
1678
1679 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1680
1681 ;; --- Now define fontification things ---
1682
02109a0d 1683 (make-local-variable 'font-lock-keywords)
f617db13 1684 (let ((sml-keywords
8d6d55b9
MW
1685 (mdw-regexps "abstype" "and" "andalso" "as"
1686 "case"
1687 "datatype" "do"
1688 "else" "end" "eqtype" "exception"
1689 "fn" "fun" "functor"
1690 "handle"
1691 "if" "in" "include" "infix" "infixr"
1692 "let" "local"
1693 "nonfix"
1694 "of" "op" "open" "orelse"
1695 "raise" "rec"
1696 "sharing" "sig" "signature" "struct" "structure"
1697 "then" "type"
1698 "val"
1699 "where" "while" "with" "withtype")))
f617db13
MW
1700
1701 (setq font-lock-keywords
1702 (list
f617db13
MW
1703
1704 ;; --- Set up the keywords defined above ---
1705
1706 (list (concat "\\<\\(" sml-keywords "\\)\\>")
1707 '(0 font-lock-keyword-face))
1708
1709 ;; --- At least numbers are simpler than C ---
1710
1711 (list (concat "\\<\\(\\~\\|\\)"
1712 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
852cd5fb
MW
1713 "[wW][0-9]+\\)\\|"
1714 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1715 "\\([eE]\\(\\~\\|\\)"
1716 "[0-9]+\\|\\)\\)\\)")
f617db13
MW
1717 '(0 mdw-number-face))
1718
1719 ;; --- And anything else is punctuation ---
1720
1721 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1722 '(0 mdw-punct-face))))))
1723
1724;;;----- Haskell configuration ----------------------------------------------
1725
1726(defun mdw-fontify-haskell ()
1727
1728 ;; --- Fiddle with syntax table to get comments right ---
1729
f617db13
MW
1730 (modify-syntax-entry ?' "\"")
1731 (modify-syntax-entry ?- ". 123")
1732 (modify-syntax-entry ?{ ". 1b")
1733 (modify-syntax-entry ?} ". 4b")
1734 (modify-syntax-entry ?\n ">")
1735
1736 ;; --- Set fill prefix ---
1737
1738 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1739
1740 ;; --- Fiddle with fontification ---
1741
02109a0d 1742 (make-local-variable 'font-lock-keywords)
f617db13 1743 (let ((haskell-keywords
8d6d55b9
MW
1744 (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1745 "deriving" "do" "else" "foreign" "hiding" "if"
1746 "import" "in" "infix" "infixl" "infixr" "instance"
1747 "let" "module" "newtype" "of" "qualified" "safe"
1748 "stdcall" "then" "type" "unsafe" "where")))
f617db13
MW
1749
1750 (setq font-lock-keywords
1751 (list
f617db13
MW
1752 (list "--.*$"
1753 '(0 font-lock-comment-face))
1754 (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1755 '(0 font-lock-keyword-face))
1756 (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1757 "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1758 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1759 '(0 mdw-number-face))
1760 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1761 '(0 mdw-punct-face))))))
1762
2ded9493
MW
1763;;;----- Erlang configuration -----------------------------------------------
1764
1765(setq erlang-electric-commannds
1766 '(erlang-electric-newline erlang-electric-semicolon))
1767
1768(defun mdw-fontify-erlang ()
1769
1770 ;; --- Set fill prefix ---
1771
1772 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1773
1774 ;; --- Fiddle with fontification ---
1775
1776 (make-local-variable 'font-lock-keywords)
1777 (let ((erlang-keywords
1778 (mdw-regexps "after" "and" "andalso"
1779 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1780 "case" "catch" "cond"
1781 "div" "end" "fun" "if" "let" "not"
1782 "of" "or" "orelse"
1783 "query" "receive" "rem" "try" "when" "xor")))
1784
1785 (setq font-lock-keywords
1786 (list
1787 (list "%.*$"
1788 '(0 font-lock-comment-face))
1789 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1790 '(0 font-lock-keyword-face))
1791 (list (concat "^-\\sw+\\>")
1792 '(0 font-lock-keyword-face))
1793 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1794 '(0 mdw-number-face))
1795 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1796 '(0 mdw-punct-face))))))
1797
f617db13
MW
1798;;;----- Texinfo configuration ----------------------------------------------
1799
1800(defun mdw-fontify-texinfo ()
1801
1802 ;; --- Set fill prefix ---
1803
1804 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1805
1806 ;; --- Real fontification things ---
1807
02109a0d 1808 (make-local-variable 'font-lock-keywords)
f617db13
MW
1809 (setq font-lock-keywords
1810 (list
f617db13
MW
1811
1812 ;; --- Environment names are keywords ---
1813
1814 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
1815 '(2 font-lock-keyword-face))
1816
1817 ;; --- Unmark escaped magic characters ---
1818
1819 (list "\\(@\\)\\([@{}]\\)"
1820 '(1 font-lock-keyword-face)
1821 '(2 font-lock-variable-name-face))
1822
1823 ;; --- Make sure we get comments properly ---
1824
1825 (list "@c\\(\\|omment\\)\\( .*\\)?$"
1826 '(0 font-lock-comment-face))
1827
1828 ;; --- Command names are keywords ---
1829
1830 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1831 '(0 font-lock-keyword-face))
1832
1833 ;; --- Fontify TeX special characters as punctuation ---
1834
1835 (list "[{}]+"
1836 '(0 mdw-punct-face)))))
1837
1838;;;----- TeX and LaTeX configuration ----------------------------------------
1839
1840(defun mdw-fontify-tex ()
1841 (setq ispell-parser 'tex)
55f80fae 1842 (turn-on-reftex)
f617db13
MW
1843
1844 ;; --- Don't make maths into a string ---
1845
1846 (modify-syntax-entry ?$ ".")
1847 (modify-syntax-entry ?$ "." font-lock-syntax-table)
1848 (local-set-key [?$] 'self-insert-command)
1849
1850 ;; --- Set fill prefix ---
1851
1852 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1853
1854 ;; --- Real fontification things ---
1855
02109a0d 1856 (make-local-variable 'font-lock-keywords)
f617db13
MW
1857 (setq font-lock-keywords
1858 (list
f617db13
MW
1859
1860 ;; --- Environment names are keywords ---
1861
1862 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1863 "{\\([^}\n]*\\)}")
1864 '(2 font-lock-keyword-face))
1865
1866 ;; --- Suspended environment names are keywords too ---
1867
1868 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1869 "{\\([^}\n]*\\)}")
1870 '(3 font-lock-keyword-face))
1871
1872 ;; --- Command names are keywords ---
1873
1874 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1875 '(0 font-lock-keyword-face))
1876
1877 ;; --- Handle @/.../ for italics ---
1878
1879 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
852cd5fb
MW
1880 ;; '(1 font-lock-keyword-face)
1881 ;; '(3 font-lock-keyword-face))
f617db13
MW
1882
1883 ;; --- Handle @*...* for boldness ---
1884
1885 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
852cd5fb
MW
1886 ;; '(1 font-lock-keyword-face)
1887 ;; '(3 font-lock-keyword-face))
f617db13
MW
1888
1889 ;; --- Handle @`...' for literal syntax things ---
1890
1891 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
852cd5fb
MW
1892 ;; '(1 font-lock-keyword-face)
1893 ;; '(3 font-lock-keyword-face))
f617db13
MW
1894
1895 ;; --- Handle @<...> for nonterminals ---
1896
1897 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
852cd5fb
MW
1898 ;; '(1 font-lock-keyword-face)
1899 ;; '(3 font-lock-keyword-face))
f617db13
MW
1900
1901 ;; --- Handle other @-commands ---
1902
1903 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
852cd5fb 1904 ;; '(0 font-lock-keyword-face))
f617db13
MW
1905
1906 ;; --- Make sure we get comments properly ---
1907
1908 (list "%.*"
1909 '(0 font-lock-comment-face))
1910
1911 ;; --- Fontify TeX special characters as punctuation ---
1912
1913 (list "[$^_{}#&]"
1914 '(0 mdw-punct-face)))))
1915
f25cf300
MW
1916;;;----- SGML hacking -------------------------------------------------------
1917
1918(defun mdw-sgml-mode ()
1919 (interactive)
1920 (sgml-mode)
1921 (mdw-standard-fill-prefix "")
1922 (make-variable-buffer-local 'sgml-delimiters)
1923 (setq sgml-delimiters
1924 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1925 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1926 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1927 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1928 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1929 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1930 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1931 "NULL" ""))
1932 (setq major-mode 'mdw-sgml-mode)
1933 (setq mode-name "[mdw] SGML")
1934 (run-hooks 'mdw-sgml-mode-hook))
1935
f617db13
MW
1936;;;----- Shell scripts ------------------------------------------------------
1937
1938(defun mdw-setup-sh-script-mode ()
1939
1940 ;; --- Fetch the shell interpreter's name ---
1941
1942 (let ((shell-name sh-shell-file))
1943
1944 ;; --- Try reading the hash-bang line ---
1945
1946 (save-excursion
1947 (goto-char (point-min))
1948 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1949 (setq shell-name (match-string 1))))
1950
1951 ;; --- Now try to set the shell ---
1952 ;;
1953 ;; Don't let `sh-set-shell' bugger up my script.
1954
1955 (let ((executable-set-magic #'(lambda (s &rest r) s)))
1956 (sh-set-shell shell-name)))
1957
1958 ;; --- Now enable my keys and the fontification ---
1959
1960 (mdw-misc-mode-config)
1961
1962 ;; --- Set the indentation level correctly ---
1963
1964 (setq sh-indentation 2)
1965 (setq sh-basic-offset 2))
1966
1967;;;----- Messages-file mode -------------------------------------------------
1968
4bb22eea 1969(defun messages-mode-guts ()
f617db13
MW
1970 (setq messages-mode-syntax-table (make-syntax-table))
1971 (set-syntax-table messages-mode-syntax-table)
f617db13
MW
1972 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1973 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1974 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1975 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1976 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1977 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1978 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1979 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1980 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1981 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1982 (make-local-variable 'comment-start)
1983 (make-local-variable 'comment-end)
1984 (make-local-variable 'indent-line-function)
1985 (setq indent-line-function 'indent-relative)
1986 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1987 (make-local-variable 'font-lock-defaults)
4bb22eea 1988 (make-local-variable 'messages-mode-keywords)
f617db13 1989 (let ((keywords
8d6d55b9
MW
1990 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1991 "export" "enum" "fixed-octetstring" "flags"
1992 "harmless" "map" "nested" "optional"
1993 "optional-tagged" "package" "primitive"
1994 "primitive-nullfree" "relaxed[ \t]+enum"
1995 "set" "table" "tagged-optional" "union"
1996 "variadic" "vector" "version" "version-tag")))
4bb22eea 1997 (setq messages-mode-keywords
f617db13
MW
1998 (list
1999 (list (concat "\\<\\(" keywords "\\)\\>:")
2000 '(0 font-lock-keyword-face))
2001 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2002 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2003 (0 font-lock-variable-name-face))
2004 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2005 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2006 (0 mdw-punct-face)))))
2007 (setq font-lock-defaults
4bb22eea 2008 '(messages-mode-keywords nil nil nil nil))
f617db13
MW
2009 (run-hooks 'messages-file-hook))
2010
2011(defun messages-mode ()
2012 (interactive)
2013 (fundamental-mode)
2014 (setq major-mode 'messages-mode)
2015 (setq mode-name "Messages")
4bb22eea 2016 (messages-mode-guts)
f617db13
MW
2017 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2018 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2019 (setq comment-start "# ")
2020 (setq comment-end "")
2021 (turn-on-font-lock-if-enabled)
2022 (run-hooks 'messages-mode-hook))
2023
2024(defun cpp-messages-mode ()
2025 (interactive)
2026 (fundamental-mode)
2027 (setq major-mode 'cpp-messages-mode)
2028 (setq mode-name "CPP Messages")
4bb22eea 2029 (messages-mode-guts)
f617db13
MW
2030 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2031 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2032 (setq comment-start "/* ")
2033 (setq comment-end " */")
2034 (let ((preprocessor-keywords
8d6d55b9
MW
2035 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2036 "ident" "if" "ifdef" "ifndef" "import" "include"
2037 "line" "pragma" "unassert" "undef" "warning")))
4bb22eea 2038 (setq messages-mode-keywords
f617db13
MW
2039 (append (list (list (concat "^[ \t]*\\#[ \t]*"
2040 "\\(include\\|import\\)"
2041 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2042 '(2 font-lock-string-face))
2043 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2044 preprocessor-keywords
852cd5fb 2045 "\\)\\>\\|[0-9]+\\|$\\)\\)")
f617db13 2046 '(1 font-lock-keyword-face)))
4bb22eea 2047 messages-mode-keywords)))
f617db13 2048 (turn-on-font-lock-if-enabled)
297d60aa 2049 (run-hooks 'cpp-messages-mode-hook))
f617db13 2050
297d60aa
MW
2051(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2052(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
f617db13
MW
2053; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2054
2055;;;----- Messages-file mode -------------------------------------------------
2056
2057(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2058 "Face to use for subsittution directives.")
2059(make-face 'mallow-driver-substitution-face)
2060(defvar mallow-driver-text-face 'mallow-driver-text-face
2061 "Face to use for body text.")
2062(make-face 'mallow-driver-text-face)
2063
2064(defun mallow-driver-mode ()
2065 (interactive)
2066 (fundamental-mode)
2067 (setq major-mode 'mallow-driver-mode)
2068 (setq mode-name "Mallow driver")
2069 (setq mallow-driver-mode-syntax-table (make-syntax-table))
2070 (set-syntax-table mallow-driver-mode-syntax-table)
2071 (make-local-variable 'comment-start)
2072 (make-local-variable 'comment-end)
2073 (make-local-variable 'indent-line-function)
2074 (setq indent-line-function 'indent-relative)
2075 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2076 (make-local-variable 'font-lock-defaults)
2077 (make-local-variable 'mallow-driver-mode-keywords)
2078 (let ((keywords
8d6d55b9
MW
2079 (mdw-regexps "each" "divert" "file" "if"
2080 "perl" "set" "string" "type" "write")))
f617db13
MW
2081 (setq mallow-driver-mode-keywords
2082 (list
2083 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2084 '(0 font-lock-keyword-face))
2085 (list "^%\\s *\\(#.*\\|\\)$"
2086 '(0 font-lock-comment-face))
2087 (list "^%"
2088 '(0 font-lock-keyword-face))
2089 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2090 (list "\\${[^}]*}"
2091 '(0 mallow-driver-substitution-face t)))))
2092 (setq font-lock-defaults
2093 '(mallow-driver-mode-keywords nil nil nil nil))
2094 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2095 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2096 (setq comment-start "%# ")
2097 (setq comment-end "")
2098 (turn-on-font-lock-if-enabled)
2099 (run-hooks 'mallow-driver-mode-hook))
2100
2101(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2102
2103;;;----- NFast debugs -------------------------------------------------------
2104
2105(defun nfast-debug-mode ()
2106 (interactive)
2107 (fundamental-mode)
2108 (setq major-mode 'nfast-debug-mode)
2109 (setq mode-name "NFast debug")
2110 (setq messages-mode-syntax-table (make-syntax-table))
2111 (set-syntax-table messages-mode-syntax-table)
2112 (make-local-variable 'font-lock-defaults)
2113 (make-local-variable 'nfast-debug-mode-keywords)
2114 (setq truncate-lines t)
2115 (setq nfast-debug-mode-keywords
2116 (list
2117 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2118 (0 font-lock-keyword-face))
2119 (list (concat "^[ \t]+\\(\\("
2120 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2121 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2122 "[ \t]+\\)*"
2123 "[0-9a-fA-F]+\\)[ \t]*$")
2124 '(0 mdw-number-face))
2125 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2126 (1 font-lock-keyword-face))
2127 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2128 (1 font-lock-warning-face))
2129 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2130 (1 nil))
2131 (list (concat "^[ \t]+\\.cmd=[ \t]+"
2132 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2133 '(1 font-lock-keyword-face))
2134 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2135 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2136 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2137 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2138 (setq font-lock-defaults
2139 '(nfast-debug-mode-keywords nil nil nil nil))
2140 (turn-on-font-lock-if-enabled)
2141 (run-hooks 'nfast-debug-mode-hook))
2142
2143;;;----- Other languages ----------------------------------------------------
2144
2145;; --- Smalltalk ---
2146
2147(defun mdw-setup-smalltalk ()
2148 (and mdw-auto-indent
2149 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2150 (make-variable-buffer-local 'mdw-auto-indent)
2151 (setq mdw-auto-indent nil)
2152 (local-set-key "\C-i" 'smalltalk-reindent))
2153
2154(defun mdw-fontify-smalltalk ()
02109a0d 2155 (make-local-variable 'font-lock-keywords)
f617db13
MW
2156 (setq font-lock-keywords
2157 (list
f617db13
MW
2158 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2159 '(0 font-lock-keyword-face))
2160 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2161 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2162 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2163 '(0 mdw-number-face))
2164 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2165 '(0 mdw-punct-face)))))
2166
2167;; --- Lispy languages ---
2168
873d87df
MW
2169;; Unpleasant bodge.
2170(unless (boundp 'slime-repl-mode-map)
2171 (setq slime-repl-mode-map (make-sparse-keymap)))
2172
f617db13
MW
2173(defun mdw-indent-newline-and-indent ()
2174 (interactive)
2175 (indent-for-tab-command)
2176 (newline-and-indent))
2177
2178(eval-after-load "cl-indent"
2179 '(progn
2180 (mapc #'(lambda (pair)
2181 (put (car pair)
2182 'common-lisp-indent-function
2183 (cdr pair)))
2184 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2185 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2186
2187(defun mdw-common-lisp-indent ()
2188 (make-variable-buffer-local 'lisp-indent-function)
2189 (setq lisp-indent-function 'common-lisp-indent-function))
2190
037be6de 2191(setq lisp-simple-loop-indentation 2
95575d1f
MW
2192 lisp-loop-keyword-indentation 6
2193 lisp-loop-forms-indentation 6)
2194
f617db13
MW
2195(defun mdw-fontify-lispy ()
2196
2197 ;; --- Set fill prefix ---
2198
2199 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2200
2201 ;; --- Not much fontification needed ---
2202
02109a0d 2203 (make-local-variable 'font-lock-keywords)
f617db13
MW
2204 (setq font-lock-keywords
2205 (list
f617db13
MW
2206 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2207 '(0 mdw-punct-face)))))
2208
2209(defun comint-send-and-indent ()
2210 (interactive)
2211 (comint-send-input)
2212 (and mdw-auto-indent
2213 (indent-for-tab-command)))
2214
ec007bea
MW
2215(defun mdw-setup-m4 ()
2216 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2217
f617db13
MW
2218;;;----- Text mode ----------------------------------------------------------
2219
2220(defun mdw-text-mode ()
2221 (setq fill-column 72)
2222 (flyspell-mode t)
2223 (mdw-standard-fill-prefix
c7a8da49 2224 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
f617db13
MW
2225 (auto-fill-mode 1))
2226
5de5db48
MW
2227;;;----- Outline mode -------------------------------------------------------
2228
2229(defun mdw-outline-collapse-all ()
2230 "Completely collapse everything in the entire buffer."
2231 (interactive)
2232 (save-excursion
2233 (goto-char (point-min))
2234 (while (< (point) (point-max))
2235 (hide-subtree)
2236 (forward-line))))
2237
f617db13
MW
2238;;;----- Shell mode ---------------------------------------------------------
2239
2240(defun mdw-sh-mode-setup ()
2241 (local-set-key [?\C-a] 'comint-bol)
2242 (add-hook 'comint-output-filter-functions
2243 'comint-watch-for-password-prompt))
2244
2245(defun mdw-term-mode-setup ()
3d9147ea 2246 (setq term-prompt-regexp shell-prompt-pattern)
f617db13
MW
2247 (make-local-variable 'mouse-yank-at-point)
2248 (make-local-variable 'transient-mark-mode)
2249 (setq mouse-yank-at-point t)
f617db13
MW
2250 (auto-fill-mode -1)
2251 (setq tab-width 8))
2252
3d9147ea
MW
2253(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2254(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
2255(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2256(defun term-send-meta-meta-something ()
2257 (interactive)
2258 (term-send-raw-string "\e\e")
2259 (term-send-raw))
2260(eval-after-load 'term
2261 '(progn
2262 (define-key term-raw-map [?\e ?\e] nil)
2263 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2264 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2265 (define-key term-raw-map [M-right] 'term-send-meta-right)
2266 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2267 (define-key term-raw-map [M-left] 'term-send-meta-left)
2268 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2269
f617db13
MW
2270;;;----- That's all, folks --------------------------------------------------
2271
2272(provide 'dot-emacs)