chiark / gitweb /
dot/emacs: Put `org-remember' in with the rest of the Org-mode bindings.
[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
6132bc01
MW
24;;;--------------------------------------------------------------------------
25;;; Check command-line.
c7a8da49
MW
26
27(defvar mdw-fast-startup nil
28 "Whether .emacs should optimize for rapid startup.
29This may be at the expense of cool features.")
30(let ((probe nil) (next command-line-args))
c7a8da49
MW
31 (while next
32 (cond ((string= (car next) "--mdw-fast-startup")
33 (setq mdw-fast-startup t)
34 (if probe
35 (rplacd probe (cdr next))
36 (setq command-line-args (cdr next))))
37 (t
38 (setq probe next)))
39 (setq next (cdr next))))
40
6132bc01
MW
41;;;--------------------------------------------------------------------------
42;;; Some general utilities.
f617db13 43
417dcddd
MW
44(eval-when-compile
45 (unless (fboundp 'make-regexp)
46 (load "make-regexp"))
47 (require 'cl))
c7a8da49
MW
48
49(defmacro mdw-regexps (&rest list)
50 "Turn a LIST of strings into a single regular expression at compile-time."
9e789ed5
MW
51 (declare (indent nil)
52 (debug 0))
417dcddd 53 `',(make-regexp list))
c7a8da49 54
a1b01eb3
MW
55(defun mdw-wrong ()
56 "This is not the key sequence you're looking for."
57 (interactive)
58 (error "wrong button"))
59
e8ea88ba
MW
60(defun mdw-emacs-version-p (major &optional minor)
61 "Return non-nil if the running Emacs is at least version MAJOR.MINOR."
62 (or (> emacs-major-version major)
63 (and (= emacs-major-version major)
64 (>= emacs-minor-version (or minor 0)))))
65
6132bc01 66;; Some error trapping.
f617db13
MW
67;;
68;; If individual bits of this file go tits-up, we don't particularly want
69;; the whole lot to stop right there and then, because it's bloody annoying.
70
71(defmacro trap (&rest forms)
72 "Execute FORMS without allowing errors to propagate outside."
9e789ed5
MW
73 (declare (indent 0)
74 (debug t))
f617db13
MW
75 `(condition-case err
76 ,(if (cdr forms) (cons 'progn forms) (car forms))
8df912e4
MW
77 (error (message "Error (trapped): %s in %s"
78 (error-message-string err)
79 ',forms))))
f617db13 80
6132bc01 81;; Configuration reading.
f141fe0f
MW
82
83(defvar mdw-config nil)
84(defun mdw-config (sym)
85 "Read the configuration variable named SYM."
86 (unless mdw-config
daff679f
MW
87 (setq mdw-config
88 (flet ((replace (what with)
89 (goto-char (point-min))
90 (while (re-search-forward what nil t)
91 (replace-match with t))))
92 (with-temp-buffer
93 (insert-file-contents "~/.mdw.conf")
94 (replace "^[ \t]*\\(#.*\\|\\)\n" "")
95 (replace (concat "^[ \t]*"
96 "\\([-a-zA-Z0-9_.]*\\)"
97 "[ \t]*=[ \t]*"
98 "\\(.*[^ \t\n]\\|\\)"
99 "[ \t]**\\(\n\\|$\\)")
100 "(\\1 . \"\\2\")\n")
101 (car (read-from-string
102 (concat "(" (buffer-string) ")")))))))
f141fe0f
MW
103 (cdr (assq sym mdw-config)))
104
18bb0f77
MW
105;; Local variables hacking.
106
107(defun run-local-vars-mode-hook ()
108 "Run a hook for the major-mode after local variables have been processed."
109 (run-hooks (intern (concat (symbol-name major-mode)
110 "-local-variables-hook"))))
111(add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook)
112
6132bc01 113;; Set up the load path convincingly.
eac7b622
MW
114
115(dolist (dir (append (and (boundp 'debian-emacs-flavor)
116 (list (concat "/usr/share/"
117 (symbol-name debian-emacs-flavor)
118 "/site-lisp")))))
119 (dolist (sub (directory-files dir t))
120 (when (and (file-accessible-directory-p sub)
121 (not (member sub load-path)))
122 (setq load-path (nconc load-path (list sub))))))
123
6132bc01 124;; Is an Emacs library available?
cb6e2cd1
MW
125
126(defun library-exists-p (name)
6132bc01
MW
127 "Return non-nil if NAME is an available library.
128Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
129load path. The non-nil value is the filename we found for the
130library."
cb6e2cd1
MW
131 (let ((path load-path) elt (foundp nil))
132 (while (and path (not foundp))
133 (setq elt (car path))
134 (setq path (cdr path))
135 (setq foundp (or (let ((file (concat elt "/" name ".elc")))
136 (and (file-exists-p file) file))
137 (let ((file (concat elt "/" name ".el")))
138 (and (file-exists-p file) file)))))
139 foundp))
140
141(defun maybe-autoload (symbol file &optional docstring interactivep type)
142 "Set an autoload if the file actually exists."
143 (and (library-exists-p file)
144 (autoload symbol file docstring interactivep type)))
145
8183de08
MW
146(defun mdw-kick-menu-bar (&optional frame)
147 "Regenerate FRAME's menu bar so it doesn't have empty menus."
148 (interactive)
149 (unless frame (setq frame (selected-frame)))
150 (let ((old (frame-parameter frame 'menu-bar-lines)))
151 (set-frame-parameter frame 'menu-bar-lines 0)
152 (set-frame-parameter frame 'menu-bar-lines old)))
153
6132bc01 154;; Splitting windows.
f617db13 155
8c2b05d5
MW
156(unless (fboundp 'scroll-bar-columns)
157 (defun scroll-bar-columns (side)
158 (cond ((eq side 'left) 0)
159 (window-system 3)
160 (t 1))))
161(unless (fboundp 'fringe-columns)
162 (defun fringe-columns (side)
163 (cond ((not window-system) 0)
164 ((eq side 'left) 1)
165 (t 2))))
166
3ba0b777
MW
167(defun mdw-horizontal-window-overhead ()
168 "Computes the horizontal window overhead.
169This is the number of columns used by fringes, scroll bars and other such
170cruft."
171 (if (not window-system)
172 1
173 (let ((tot 0))
174 (dolist (what '(scroll-bar fringe))
175 (dolist (side '(left right))
176 (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
177 side))))
178 tot)))
179
180(defun mdw-split-window-horizontally (&optional width)
181 "Split a window horizontally.
182Without a numeric argument, split the window approximately in
183half. With a numeric argument WIDTH, allocate WIDTH columns to
184the left-hand window (if positive) or -WIDTH columns to the
185right-hand window (if negative). Space for scroll bars and
186fringes is not taken out of the allowance for WIDTH, unlike
187\\[split-window-horizontally]."
188 (interactive "P")
189 (split-window-horizontally
190 (cond ((null width) nil)
191 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
192 ((< width 0) width))))
193
8c2b05d5 194(defun mdw-divvy-window (&optional width)
f617db13 195 "Split a wide window into appropriate widths."
8c2b05d5
MW
196 (interactive "P")
197 (setq width (cond (width (prefix-numeric-value width))
e8ea88ba 198 ((and window-system (mdw-emacs-version-p 22))
8c2b05d5
MW
199 77)
200 (t 78)))
b5d724dd 201 (let* ((win (selected-window))
3ba0b777 202 (sb-width (mdw-horizontal-window-overhead))
b5d724dd 203 (c (/ (+ (window-width) sb-width)
8c2b05d5 204 (+ width sb-width))))
f617db13
MW
205 (while (> c 1)
206 (setq c (1- c))
8c2b05d5 207 (split-window-horizontally (+ width sb-width))
f617db13
MW
208 (other-window 1))
209 (select-window win)))
210
cc2be23e
MW
211;; Don't raise windows unless I say so.
212
213(defvar mdw-inhibit-raise-frame nil
214 "*Whether `raise-frame' should do nothing when the frame is mapped.")
215
216(defadvice raise-frame
217 (around mdw-inhibit (&optional frame) activate compile)
218 "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
219frame is actually mapped on the screen."
220 (if mdw-inhibit-raise-frame
221 (make-frame-visible frame)
222 ad-do-it))
223
224(defmacro mdw-advise-to-inhibit-raise-frame (function)
225 "Advise the FUNCTION not to raise frames, even if it wants to."
226 `(defadvice ,function
227 (around mdw-inhibit-raise (&rest hunoz) activate compile)
228 "Don't raise the window unless you have to."
229 (let ((mdw-inhibit-raise-frame t))
230 ad-do-it)))
231
232(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
233
a1e4004c
MW
234;; Bug fix for markdown-mode, which breaks point positioning during
235;; `query-replace'.
236(defadvice markdown-check-change-for-wiki-link
237 (around mdw-save-match activate compile)
238 "Save match data around the `markdown-mode' `after-change-functions' hook."
239 (save-match-data ad-do-it))
240
c4b18360
MW
241;; Transient mark mode hacks.
242
243(defadvice exchange-point-and-mark
244 (around mdw-highlight (&optional arg) activate compile)
245 "Maybe don't actually exchange point and mark.
246If `transient-mark-mode' is on and the mark is inactive, then
247just activate it. A non-trivial prefix argument will force the
248usual behaviour. A trivial prefix argument (i.e., just C-u) will
249activate the mark and temporarily enable `transient-mark-mode' if
250it's currently off."
251 (cond ((or mark-active
252 (and (not transient-mark-mode) (not arg))
253 (and arg (or (not (consp arg))
254 (not (= (car arg) 4)))))
255 ad-do-it)
256 (t
257 (or transient-mark-mode (setq transient-mark-mode 'only))
258 (set-mark (mark t)))))
259
6132bc01 260;; Functions for sexp diary entries.
f617db13
MW
261
262(defun mdw-weekday (l)
263 "Return non-nil if `date' falls on one of the days of the week in L.
6132bc01
MW
264L is a list of day numbers (from 0 to 6 for Sunday through to
265Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
266the date stored in `date' falls on a listed day, then the
267function returns non-nil."
f617db13
MW
268 (let ((d (calendar-day-of-week date)))
269 (or (memq d l)
270 (memq (nth d '(sunday monday tuesday wednesday
271 thursday friday saturday)) l))))
272
d401f71b
MW
273(defun mdw-discordian-date (date)
274 "Return the Discordian calendar date corresponding to DATE.
275
276The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
277
278The original is by David Pearson. I modified it to produce date components
279as output rather than a string."
280 (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
281 "Prickle-Prickle" "Setting Orange"])
282 (months ["Chaos" "Discord" "Confusion"
283 "Bureaucracy" "Aftermath"])
284 (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
285 (year (- (extract-calendar-year date) 1900))
286 (month (1- (extract-calendar-month date)))
287 (day (1- (extract-calendar-day date)))
288 (julian (+ (aref day-count month) day))
289 (dyear (+ year 3066)))
290 (if (and (= month 1) (= day 28))
291 (cons dyear 'st-tibs-day)
292 (list dyear
293 (aref months (floor (/ julian 73)))
294 (1+ (mod julian 73))
295 (aref days (mod julian 5))))))
296
297(defun mdw-diary-discordian-date ()
298 "Convert the date in `date' to a string giving the Discordian date."
299 (let* ((ddate (mdw-discordian-date date))
300 (tail (format "in the YOLD %d" (car ddate))))
301 (if (eq (cdr ddate) 'st-tibs-day)
302 (format "St Tib's Day %s" tail)
303 (let ((season (cadr ddate))
304 (daynum (caddr ddate))
305 (dayname (cadddr ddate)))
306 (format "%s, the %d%s day of %s %s"
307 dayname
308 daynum
309 (let ((ldig (mod daynum 10)))
310 (cond ((= ldig 1) "st")
311 ((= ldig 2) "nd")
312 ((= ldig 3) "rd")
313 (t "th")))
314 season
315 tail)))))
316
f617db13
MW
317(defun mdw-todo (&optional when)
318 "Return non-nil today, or on WHEN, whichever is later."
319 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
320 (d (calendar-absolute-from-gregorian date)))
321 (if when
322 (setq w (max w (calendar-absolute-from-gregorian
323 (cond
324 ((not european-calendar-style)
325 when)
326 ((> (car when) 100)
327 (list (nth 1 when)
328 (nth 2 when)
329 (nth 0 when)))
330 (t
331 (list (nth 1 when)
332 (nth 0 when)
333 (nth 2 when))))))))
334 (eq w d)))
335
9f58a8d2
MW
336(defadvice diary-add-to-list (before mdw-trim-leading-space activate)
337 "Trim leading space from the diary entry string."
338 (save-match-data
339 (let ((str (ad-get-arg 1)))
340 (if (and str (string-match "^[ \t]+" str))
341 (let ((new (replace-match "" nil nil str)))
342 (ad-set-arg 1 new))))))
343
6132bc01 344;; Fighting with Org-mode's evil key maps.
16fe7c41
MW
345
346(defvar mdw-evil-keymap-keys
347 '(([S-up] . [?\C-c up])
348 ([S-down] . [?\C-c down])
349 ([S-left] . [?\C-c left])
350 ([S-right] . [?\C-c right])
351 (([M-up] [?\e up]) . [C-up])
352 (([M-down] [?\e down]) . [C-down])
353 (([M-left] [?\e left]) . [C-left])
354 (([M-right] [?\e right]) . [C-right]))
355 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
356The value is an alist mapping evil keys (as a list, or singleton)
357to good keys (in the same form).")
358
359(defun mdw-clobber-evil-keymap (keymap)
360 "Replace evil key bindings in the KEYMAP.
361Evil key bindings are defined in `mdw-evil-keymap-keys'."
362 (dolist (entry mdw-evil-keymap-keys)
363 (let ((binding nil)
364 (keys (if (listp (car entry))
365 (car entry)
366 (list (car entry))))
367 (replacements (if (listp (cdr entry))
368 (cdr entry)
369 (list (cdr entry)))))
370 (catch 'found
371 (dolist (key keys)
372 (setq binding (lookup-key keymap key))
373 (when binding
374 (throw 'found nil))))
375 (when binding
376 (dolist (key keys)
377 (define-key keymap key nil))
378 (dolist (key replacements)
379 (define-key keymap key binding))))))
380
0f6be0b1 381(eval-after-load "org-latex"
f0dbee84
MW
382 '(progn
383 (push '("strayman"
384 "\\documentclass{strayman}
385\\usepackage[utf8]{inputenc}
386\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
387\\usepackage[T1]{fontenc}
388\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
389 ("\\section{%s}" . "\\section*{%s}")
390 ("\\subsection{%s}" . "\\subsection*{%s}")
391 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
392 ("\\paragraph{%s}" . "\\paragraph*{%s}")
393 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
394 org-export-latex-classes)))
395
8ba985cb
MW
396(setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
397 org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
398 org-export-docbook-xslt-stylesheet
399 "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
400
5dccbe61
MW
401;; Some hacks to do with window placement.
402
403(defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
404 "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
405 (interactive "bBuffer: ")
406 (let ((home-frame (selected-frame))
407 (buffer (get-buffer buffer-or-name))
408 (safe-buffer (get-buffer "*scratch*")))
409 (mapc (lambda (frame)
410 (or (eq frame home-frame)
411 (mapc (lambda (window)
412 (and (eq (window-buffer window) buffer)
413 (set-window-buffer window safe-buffer)))
414 (window-list frame))))
415 (frame-list))))
416
417(defvar mdw-inhibit-walk-windows nil
418 "If non-nil, then `walk-windows' does nothing.
419This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
420buffers in random frames.")
421
422(defadvice walk-windows (around mdw-inhibit activate)
423 "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
424 (and (not mdw-inhibit-walk-windows)
425 ad-do-it))
426
427(defadvice switch-to-buffer-other-frame
428 (around mdw-always-new-frame activate)
429 "Always make a new frame.
430Even if an existing window in some random frame looks tempting."
431 (let ((mdw-inhibit-walk-windows t)) ad-do-it))
432
433(defadvice display-buffer (before mdw-inhibit-other-frames activate)
434 "Don't try to do anything fancy with other frames.
435Pretend they don't exist. They might be on other display devices."
436 (ad-set-arg 2 nil))
437
6132bc01
MW
438;;;--------------------------------------------------------------------------
439;;; Mail and news hacking.
a3bdb4d9
MW
440
441(define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
6132bc01 442 "Major mode for editing news and mail messages from external programs.
a3bdb4d9
MW
443Not much right now. Just support for doing MailCrypt stuff."
444 :syntax-table nil
445 :abbrev-table nil
446 (run-hooks 'mail-setup-hook))
447
448(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
449
450(add-hook 'mdwail-mode-hook
451 (lambda ()
452 (set-buffer-file-coding-system 'utf-8)
453 (make-local-variable 'paragraph-separate)
454 (make-local-variable 'paragraph-start)
455 (setq paragraph-start
456 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
457 paragraph-start))
458 (setq paragraph-separate
459 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
460 paragraph-separate))))
461
6132bc01 462;; How to encrypt in mdwmail.
a3bdb4d9
MW
463
464(defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
465 (or start
466 (setq start (save-excursion
467 (goto-char (point-min))
468 (or (search-forward "\n\n" nil t) (point-min)))))
469 (or end
470 (setq end (point-max)))
471 (mc-encrypt-generic recip scm start end from sign))
472
6132bc01 473;; How to sign in mdwmail.
a3bdb4d9
MW
474
475(defun mdwmail-mc-sign (key scm start end uclr)
476 (or start
477 (setq start (save-excursion
478 (goto-char (point-min))
479 (or (search-forward "\n\n" nil t) (point-min)))))
480 (or end
481 (setq end (point-max)))
482 (mc-sign-generic key scm start end uclr))
483
6132bc01 484;; Some signature mangling.
a3bdb4d9
MW
485
486(defun mdwmail-mangle-signature ()
487 (save-excursion
488 (goto-char (point-min))
489 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
490(add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
491(add-hook 'message-setup-hook 'mdwmail-mangle-signature)
492
6132bc01 493;; Insert my login name into message-ids, so I can score replies.
a3bdb4d9
MW
494
495(defadvice message-unique-id (after mdw-user-name last activate compile)
496 "Ensure that the user's name appears at the end of the message-id string,
497so that it can be used for convenient filtering."
498 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
499
6132bc01 500;; Tell my movemail hack where movemail is.
a3bdb4d9
MW
501;;
502;; This is needed to shup up warnings about LD_PRELOAD.
503
504(let ((path exec-path))
505 (while path
506 (let ((try (expand-file-name "movemail" (car path))))
507 (if (file-executable-p try)
508 (setenv "REAL_MOVEMAIL" try))
509 (setq path (cdr path)))))
510
4d5799eb
MW
511;; AUTHINFO GENERIC kludge.
512
513(defvar nntp-authinfo-generic nil
514 "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
515
516Use this to arrange for per-server settings.")
517
518(defun nntp-open-authinfo-kludge (buffer)
519 "Open a connection to SERVER using `authinfo-kludge'."
520 (let ((proc (start-process "nntpd" buffer
521 "env" (concat "NNTPAUTH="
522 (or nntp-authinfo-generic
523 (getenv "NNTPAUTH")
524 (error "NNTPAUTH unset")))
525 "authinfo-kludge" nntp-address)))
526 (set-buffer buffer)
527 (nntp-wait-for-string "^\r*200")
528 (beginning-of-line)
529 (delete-region (point-min) (point))
530 proc))
531
d17c6756
MW
532(eval-after-load "erc"
533 '(load "~/.ercrc.el"))
534
6132bc01
MW
535;;;--------------------------------------------------------------------------
536;;; Utility functions.
f617db13 537
b5d724dd
MW
538(or (fboundp 'line-number-at-pos)
539 (defun line-number-at-pos (&optional pos)
540 (let ((opoint (or pos (point))) start)
541 (save-excursion
542 (save-restriction
543 (goto-char (point-min))
544 (widen)
545 (forward-line 0)
546 (setq start (point))
547 (goto-char opoint)
548 (forward-line 0)
549 (1+ (count-lines 1 (point))))))))
459c9fb2 550
f617db13 551(defun mdw-uniquify-alist (&rest alists)
f617db13 552 "Return the concatenation of the ALISTS with duplicate elements removed.
6132bc01
MW
553The first association with a given key prevails; others are
554ignored. The input lists are not modified, although they'll
555probably become garbage."
f617db13
MW
556 (and alists
557 (let ((start-list (cons nil nil)))
558 (mdw-do-uniquify start-list
559 start-list
560 (car alists)
561 (cdr alists)))))
562
f617db13 563(defun mdw-do-uniquify (done end l rest)
6132bc01
MW
564 "A helper function for mdw-uniquify-alist.
565The DONE argument is a list whose first element is `nil'. It
566contains the uniquified alist built so far. The leading `nil' is
567stripped off at the end of the operation; it's only there so that
568DONE always references a cons cell. END refers to the final cons
569cell in the DONE list; it is modified in place each time to avoid
570the overheads of `append'ing all the time. The L argument is the
571alist we're currently processing; the remaining alists are given
572in REST."
573
574 ;; There are several different cases to deal with here.
f617db13
MW
575 (cond
576
6132bc01
MW
577 ;; Current list isn't empty. Add the first item to the DONE list if
578 ;; there's not an item with the same KEY already there.
f617db13
MW
579 (l (or (assoc (car (car l)) done)
580 (progn
581 (setcdr end (cons (car l) nil))
582 (setq end (cdr end))))
583 (mdw-do-uniquify done end (cdr l) rest))
584
6132bc01
MW
585 ;; The list we were working on is empty. Shunt the next list into the
586 ;; current list position and go round again.
f617db13
MW
587 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
588
6132bc01
MW
589 ;; Everything's done. Remove the leading `nil' from the DONE list and
590 ;; return it. Finished!
f617db13
MW
591 (t (cdr done))))
592
f617db13
MW
593(defun date ()
594 "Insert the current date in a pleasing way."
595 (interactive)
596 (insert (save-excursion
597 (let ((buffer (get-buffer-create "*tmp*")))
598 (unwind-protect (progn (set-buffer buffer)
599 (erase-buffer)
600 (shell-command "date +%Y-%m-%d" t)
601 (goto-char (mark))
602 (delete-backward-char 1)
603 (buffer-string))
604 (kill-buffer buffer))))))
605
f617db13
MW
606(defun uuencode (file &optional name)
607 "UUencodes a file, maybe calling it NAME, into the current buffer."
608 (interactive "fInput file name: ")
609
6132bc01 610 ;; If NAME isn't specified, then guess from the filename.
f617db13
MW
611 (if (not name)
612 (setq name
613 (substring file
614 (or (string-match "[^/]*$" file) 0))))
f617db13
MW
615 (print (format "uuencode `%s' `%s'" file name))
616
6132bc01 617 ;; Now actually do the thing.
f617db13
MW
618 (call-process "uuencode" file t nil name))
619
620(defvar np-file "~/.np"
621 "*Where the `now-playing' file is.")
622
623(defun np (&optional arg)
624 "Grabs a `now-playing' string."
625 (interactive)
626 (save-excursion
627 (or arg (progn
852cd5fb 628 (goto-char (point-max))
f617db13 629 (insert "\nNP: ")
daff679f 630 (insert-file-contents np-file)))))
f617db13 631
ae7460d4
MW
632(defun mdw-version-< (ver-a ver-b)
633 "Answer whether VER-A is strictly earlier than VER-B.
634VER-A and VER-B are version numbers, which are strings containing digit
635sequences separated by `.'."
636 (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
637 (split-string ver-a "\\.")))
638 (lb (mapcar (lambda (x) (car (read-from-string x)))
639 (split-string ver-b "\\."))))
640 (catch 'done
641 (while t
642 (cond ((null la) (throw 'done lb))
643 ((null lb) (throw 'done nil))
644 ((< (car la) (car lb)) (throw 'done t))
645 ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
646
c7a8da49 647(defun mdw-check-autorevert ()
6132bc01
MW
648 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
649This takes into consideration whether it's been found using
650tramp, which seems to get itself into a twist."
46e69f55
MW
651 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
652 nil)
653 ((and (buffer-file-name)
654 (fboundp 'tramp-tramp-file-p)
c7a8da49
MW
655 (tramp-tramp-file-p (buffer-file-name)))
656 (unless global-auto-revert-ignore-buffer
657 (setq global-auto-revert-ignore-buffer 'tramp)))
658 ((eq global-auto-revert-ignore-buffer 'tramp)
659 (setq global-auto-revert-ignore-buffer nil))))
660
661(defadvice find-file (after mdw-autorevert activate)
662 (mdw-check-autorevert))
663(defadvice write-file (after mdw-autorevert activate)
4d9f2d65 664 (mdw-check-autorevert))
eae0aa6d 665
6132bc01
MW
666;;;--------------------------------------------------------------------------
667;;; Dired hacking.
5195cbc3
MW
668
669(defadvice dired-maybe-insert-subdir
670 (around mdw-marked-insertion first activate)
6132bc01
MW
671 "The DIRNAME may be a list of directory names to insert.
672Interactively, if files are marked, then insert all of them.
673With a numeric prefix argument, select that many entries near
674point; with a non-numeric prefix argument, prompt for listing
675options."
5195cbc3
MW
676 (interactive
677 (list (dired-get-marked-files nil
678 (and (integerp current-prefix-arg)
679 current-prefix-arg)
680 #'file-directory-p)
681 (and current-prefix-arg
682 (not (integerp current-prefix-arg))
683 (read-string "Switches for listing: "
684 (or dired-subdir-switches
685 dired-actual-switches)))))
686 (let ((dirs (ad-get-arg 0)))
687 (dolist (dir (if (listp dirs) dirs (list dirs)))
688 (ad-set-arg 0 dir)
689 ad-do-it)))
690
6132bc01
MW
691;;;--------------------------------------------------------------------------
692;;; URL viewing.
a203fba8
MW
693
694(defun mdw-w3m-browse-url (url &optional new-session-p)
695 "Invoke w3m on the URL in its current window, or at least a different one.
696If NEW-SESSION-P, start a new session."
697 (interactive "sURL: \nP")
698 (save-excursion
63fb20c1
MW
699 (let ((window (selected-window)))
700 (unwind-protect
701 (progn
702 (select-window (or (and (not new-session-p)
703 (get-buffer-window "*w3m*"))
704 (progn
705 (if (one-window-p t) (split-window))
706 (get-lru-window))))
707 (w3m-browse-url url new-session-p))
708 (select-window window)))))
a203fba8
MW
709
710(defvar mdw-good-url-browsers
a0d16e44
MW
711 '(browse-url-mozilla
712 browse-url-generic
ed5e20a5 713 (w3m . mdw-w3m-browse-url)
a0d16e44 714 browse-url-w3)
6132bc01
MW
715 "List of good browsers for mdw-good-url-browsers.
716Each item is a browser function name, or a cons (CHECK . FUNC).
717A symbol FOO stands for (FOO . FOO).")
a203fba8
MW
718
719(defun mdw-good-url-browser ()
6132bc01
MW
720 "Return a good URL browser.
721Trundle the list of such things, finding the first item for which
722CHECK is fboundp, and returning the correponding FUNC."
a203fba8
MW
723 (let ((bs mdw-good-url-browsers) b check func answer)
724 (while (and bs (not answer))
725 (setq b (car bs)
726 bs (cdr bs))
727 (if (consp b)
728 (setq check (car b) func (cdr b))
729 (setq check b func b))
730 (if (fboundp check)
731 (setq answer func)))
732 answer))
733
f36cdb77
MW
734(eval-after-load "w3m-search"
735 '(progn
736 (dolist
737 (item
738 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
739 ("gd" "Google Directory"
740 "http://www.google.com/search?cat=gwd/Top&q=%s")
741 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
742 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
743 ("gi" "Images" "http://images.google.com/images?q=%s")
744 ("rfc" "RFC"
745 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
746 ("wp" "Wikipedia"
747 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
748 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
749 ("nc-wiki" "nCipher wiki"
750 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
751 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
752 ("lp" "Launchpad bug by number"
753 "https://bugs.launchpad.net/bugs/%s")
754 ("lppkg" "Launchpad bugs by package"
755 "https://bugs.launchpad.net/%s")
756 ("msdn" "MSDN"
757 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
758 ("debbug" "Debian bug by number"
759 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
760 ("debbugpkg" "Debian bugs by package"
761 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
762 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
763 (add-to-list 'w3m-search-engine-alist
764 (list (cadr item) (caddr item) nil))
765 (add-to-list 'w3m-uri-replace-alist
766 (list (concat "\\`" (car item) ":")
767 'w3m-search-uri-replace
768 (cadr item))))))
769
6132bc01
MW
770;;;--------------------------------------------------------------------------
771;;; Paragraph filling.
f617db13 772
6132bc01 773;; Useful variables.
f617db13
MW
774
775(defvar mdw-fill-prefix nil
6132bc01
MW
776 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
777If there's no fill prefix currently set (by the `fill-prefix'
778variable) and there's a match from one of the regexps here, it
779gets used to set the fill-prefix for the current operation.
f617db13 780
6132bc01
MW
781The variable is a list of items of the form `REGEXP . PREFIX'; if
782the REGEXP matches, the PREFIX is used to set the fill prefix.
783It in turn is a list of things:
f617db13
MW
784
785 STRING -- insert a literal string
786 (match . N) -- insert the thing matched by bracketed subexpression N
787 (pad . N) -- a string of whitespace the same width as subexpression N
788 (expr . FORM) -- the result of evaluating FORM")
789
790(make-variable-buffer-local 'mdw-fill-prefix)
791
792(defvar mdw-hanging-indents
10fa2414 793 (concat "\\(\\("
f8bfe560 794 "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
10fa2414
MW
795 "[ \t]+"
796 "\\)?\\)")
6132bc01
MW
797 "*Standard regexp matching parts of a hanging indent.
798This is mainly useful in `auto-fill-mode'.")
f617db13 799
6132bc01 800;; Setting things up.
f617db13
MW
801
802(fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
803
6132bc01 804;; Utility functions.
f617db13 805
cd07f97f
MW
806(defun mdw-maybe-tabify (s)
807 "Tabify or untabify the string S, according to `indent-tabs-mode'."
c736b08b
MW
808 (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
809 (with-temp-buffer
810 (save-match-data
f617db13 811 (insert s "\n")
cd07f97f 812 (let ((start (point-min)) (end (point-max)))
c736b08b
MW
813 (funcall tabfun (point-min) (point-max))
814 (setq s (buffer-substring (point-min) (1- (point-max)))))))))
f617db13
MW
815
816(defun mdw-examine-fill-prefixes (l)
6132bc01
MW
817 "Given a list of dynamic fill prefixes, pick one which matches
818context and return the static fill prefix to use. Point must be
819at the start of a line, and match data must be saved."
f617db13
MW
820 (cond ((not l) nil)
821 ((looking-at (car (car l)))
cd07f97f
MW
822 (mdw-maybe-tabify (apply #'concat
823 (mapcar #'mdw-do-prefix-match
824 (cdr (car l))))))
f617db13
MW
825 (t (mdw-examine-fill-prefixes (cdr l)))))
826
827(defun mdw-maybe-car (p)
828 "If P is a pair, return (car P), otherwise just return P."
829 (if (consp p) (car p) p))
830
831(defun mdw-padding (s)
832 "Return a string the same width as S but made entirely from whitespace."
833 (let* ((l (length s)) (i 0) (n (make-string l ? )))
834 (while (< i l)
835 (if (= 9 (aref s i))
836 (aset n i 9))
837 (setq i (1+ i)))
838 n))
839
840(defun mdw-do-prefix-match (m)
6132bc01
MW
841 "Expand a dynamic prefix match element.
842See `mdw-fill-prefix' for details."
f617db13
MW
843 (cond ((not (consp m)) (format "%s" m))
844 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
845 ((eq (car m) 'pad) (mdw-padding (match-string
846 (mdw-maybe-car (cdr m)))))
847 ((eq (car m) 'eval) (eval (cdr m)))
848 (t "")))
849
850(defun mdw-choose-dynamic-fill-prefix ()
851 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
852 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
853 ((not mdw-fill-prefix) fill-prefix)
854 (t (save-excursion
855 (beginning-of-line)
856 (save-match-data
857 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
858
859(defun do-auto-fill ()
6132bc01
MW
860 "Handle auto-filling, working out a dynamic fill prefix in the
861case where there isn't a sensible static one."
f617db13
MW
862 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
863 (mdw-do-auto-fill)))
864
865(defun mdw-fill-paragraph ()
866 "Fill paragraph, getting a dynamic fill prefix."
867 (interactive)
868 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
869 (fill-paragraph nil)))
870
871(defun mdw-standard-fill-prefix (rx &optional mat)
872 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
6132bc01
MW
873This is just a short-cut for setting the thing by hand, and by
874design it doesn't cope with anything approximating a complicated
875case."
f617db13
MW
876 (setq mdw-fill-prefix
877 `((,(concat rx mdw-hanging-indents)
878 (match . 1)
879 (pad . ,(or mat 2))))))
880
6132bc01
MW
881;;;--------------------------------------------------------------------------
882;;; Other common declarations.
f617db13 883
6132bc01 884;; Common mode settings.
f617db13
MW
885
886(defvar mdw-auto-indent t
887 "Whether to indent automatically after a newline.")
888
0e58a7c2
MW
889(defun mdw-whitespace-mode (&optional arg)
890 "Turn on/off whitespace mode, but don't highlight trailing space."
891 (interactive "P")
892 (when (and (boundp 'whitespace-style)
893 (fboundp 'whitespace-mode))
894 (let ((whitespace-style (remove 'trailing whitespace-style)))
558fc014
MW
895 (whitespace-mode arg))
896 (setq show-trailing-whitespace whitespace-mode)))
0e58a7c2 897
21beda17
MW
898(defvar mdw-do-misc-mode-hacking nil)
899
f617db13
MW
900(defun mdw-misc-mode-config ()
901 (and mdw-auto-indent
902 (cond ((eq major-mode 'lisp-mode)
903 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
30c8a8fb
MW
904 ((or (eq major-mode 'slime-repl-mode)
905 (eq major-mode 'asm-mode))
906 nil)
f617db13
MW
907 (t
908 (local-set-key "\C-m" 'newline-and-indent))))
2e7c6a86 909 (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
f617db13 910 (local-set-key [C-return] 'newline)
8a425bd7 911 (make-local-variable 'page-delimiter)
8cb7626b 912 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
f617db13
MW
913 (setq comment-column 40)
914 (auto-fill-mode 1)
915 (setq fill-column 77)
253f61b4
MW
916 (and (fboundp 'gtags-mode)
917 (gtags-mode))
ddf6e116 918 (if (fboundp 'hs-minor-mode)
612717ec 919 (trap (hs-minor-mode t))
ddf6e116 920 (outline-minor-mode t))
49b2646e 921 (reveal-mode t)
1e7a9479 922 (trap (turn-on-font-lock)))
f617db13 923
2e7c6a86 924(defun mdw-post-local-vars-misc-mode-config ()
2717a191
MW
925 (when (and mdw-do-misc-mode-hacking
926 (not buffer-read-only))
2e7c6a86
MW
927 (setq show-trailing-whitespace t)
928 (mdw-whitespace-mode 1)))
929(add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
ed7b46b9 930
2717a191
MW
931(defadvice toggle-read-only (after mdw-angry-fruit-salad activate)
932 (when mdw-do-misc-mode-hacking
933 (setq show-trailing-whitespace (not buffer-read-only))
934 (mdw-whitespace-mode (if buffer-read-only 0 1))))
935
253f61b4 936(eval-after-load 'gtags
506bada9
MW
937 '(progn
938 (dolist (key '([mouse-2] [mouse-3]))
939 (define-key gtags-mode-map key nil))
940 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
941 (define-key gtags-select-mode-map [C-S-mouse-2]
942 'gtags-select-tag-by-event)
943 (dolist (map (list gtags-mode-map gtags-select-mode-map))
944 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
253f61b4 945
6132bc01 946;; Backup file handling.
2ae647c4
MW
947
948(defvar mdw-backup-disable-regexps nil
6132bc01
MW
949 "*List of regular expressions: if a file name matches any of
950these then the file is not backed up.")
2ae647c4
MW
951
952(defun mdw-backup-enable-predicate (name)
6132bc01
MW
953 "[mdw]'s default backup predicate.
954Allows a backup if the standard predicate would allow it, and it
955doesn't match any of the regular expressions in
956`mdw-backup-disable-regexps'."
2ae647c4
MW
957 (and (normal-backup-enable-predicate name)
958 (let ((answer t) (list mdw-backup-disable-regexps))
959 (save-match-data
960 (while list
961 (if (string-match (car list) name)
962 (setq answer nil))
963 (setq list (cdr list)))
964 answer))))
965(setq backup-enable-predicate 'mdw-backup-enable-predicate)
966
7bb78c67
MW
967;; Frame cleanup.
968
969(defun mdw-last-one-out-turn-off-the-lights (frame)
970 "Disconnect from an X display if this was the last frame on that display."
971 (let ((frame-display (frame-parameter frame 'display)))
972 (when (and frame-display
973 (eq window-system 'x)
974 (not (some (lambda (fr)
7bb78c67 975 (and (not (eq fr frame))
a04d8f3d 976 (string= (frame-parameter fr 'display)
d70716b5 977 frame-display)))
7bb78c67 978 (frame-list))))
7bb78c67
MW
979 (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
980(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
981
cfa1824e
MW
982;;;--------------------------------------------------------------------------
983;;; Where is point?
984
985(defvar mdw-point-overlay
986 (let ((ov (make-overlay 0 0))
987 (s "."))
988 (overlay-put ov 'priority 2)
989 (put-text-property 0 1 'display '(left-fringe vertical-bar) s)
990 (overlay-put ov 'before-string s)
991 (delete-overlay ov)
992 ov)
993 "An overlay used for showing where point is in the selected window.")
994
995(defun mdw-remove-point-overlay ()
996 "Remove the current-point overlay."
997 (delete-overlay mdw-point-overlay))
998
999(defun mdw-update-point-overlay ()
1000 "Mark the current point position with an overlay."
1001 (if (not mdw-point-overlay-mode)
1002 (mdw-remove-point-overlay)
1003 (overlay-put mdw-point-overlay 'window (selected-window))
f3674a83
MW
1004 (if (bolp)
1005 (move-overlay mdw-point-overlay
1006 (point) (1+ (point)) (current-buffer))
1007 (move-overlay mdw-point-overlay
1008 (1- (point)) (point) (current-buffer)))))
cfa1824e
MW
1009
1010(defvar mdw-point-overlay-buffers nil
1011 "List of buffers using `mdw-point-overlay-mode'.")
1012
1013(define-minor-mode mdw-point-overlay-mode
1014 "Indicate current line with an overlay."
1015 :global nil
1016 (let ((buffer (current-buffer)))
1017 (setq mdw-point-overlay-buffers
1018 (mapcan (lambda (buf)
1019 (if (and (buffer-live-p buf)
1020 (not (eq buf buffer)))
1021 (list buf)))
1022 mdw-point-overlay-buffers))
1023 (if mdw-point-overlay-mode
1024 (setq mdw-point-overlay-buffers
1025 (cons buffer mdw-point-overlay-buffers))))
1026 (cond (mdw-point-overlay-buffers
1027 (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
1028 (add-hook 'post-command-hook 'mdw-update-point-overlay))
1029 (t
1030 (mdw-remove-point-overlay)
1031 (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
1032 (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
1033
1034(define-globalized-minor-mode mdw-global-point-overlay-mode
1035 mdw-point-overlay-mode
1036 (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
1037
f3674a83
MW
1038;;;--------------------------------------------------------------------------
1039;;; Fullscreen-ness.
1040
1041(defvar mdw-full-screen-parameters
1042 '((menu-bar-lines . 0)
1043 ;(vertical-scroll-bars . nil)
1044 )
1045 "Frame parameters to set when making a frame fullscreen.")
1046
1047(defvar mdw-full-screen-save
1048 '(width height)
1049 "Extra frame parameters to save when setting fullscreen.")
1050
1051(defun mdw-toggle-full-screen (&optional frame)
1052 "Show the FRAME fullscreen."
1053 (interactive)
1054 (when window-system
1055 (cond ((frame-parameter frame 'fullscreen)
1056 (set-frame-parameter frame 'fullscreen nil)
1057 (modify-frame-parameters
1058 nil
1059 (or (frame-parameter frame 'mdw-full-screen-saved)
1060 (mapcar (lambda (assoc)
1061 (assq (car assoc) default-frame-alist))
1062 mdw-full-screen-parameters))))
1063 (t
1064 (let ((saved (mapcar (lambda (param)
1065 (cons param (frame-parameter frame param)))
1066 (append (mapcar #'car
1067 mdw-full-screen-parameters)
1068 mdw-full-screen-save))))
1069 (set-frame-parameter frame 'mdw-full-screen-saved saved))
1070 (modify-frame-parameters frame mdw-full-screen-parameters)
1071 (set-frame-parameter frame 'fullscreen 'fullboth)))))
1072
6132bc01
MW
1073;;;--------------------------------------------------------------------------
1074;;; General fontification.
f617db13 1075
1e7a9479
MW
1076(defmacro mdw-define-face (name &rest body)
1077 "Define a face, and make sure it's actually set as the definition."
1078 (declare (indent 1)
1079 (debug 0))
1080 `(progn
1081 (make-face ',name)
1082 (defvar ,name ',name)
1083 (put ',name 'face-defface-spec ',body)
88cb9c2b 1084 (face-spec-set ',name ',body nil)))
1e7a9479
MW
1085
1086(mdw-define-face default
1087 (((type w32)) :family "courier new" :height 85)
caa63513 1088 (((type x)) :family "6x13" :foundry "trad" :height 130)
db10ce0a
MW
1089 (((type color)) :foreground "white" :background "black")
1090 (t nil))
1e7a9479
MW
1091(mdw-define-face fixed-pitch
1092 (((type w32)) :family "courier new" :height 85)
caa63513 1093 (((type x)) :family "6x13" :foundry "trad" :height 130)
1e7a9479 1094 (t :foreground "white" :background "black"))
e8ea88ba 1095(if (mdw-emacs-version-p 23)
c383eb8a
MW
1096 (mdw-define-face variable-pitch
1097 (((type x)) :family "sans" :height 100))
1098 (mdw-define-face variable-pitch
3f001ff6 1099 (((type x)) :family "helvetica" :height 90)))
1e7a9479 1100(mdw-define-face region
db10ce0a
MW
1101 (((type tty) (class color)) :background "blue")
1102 (((type tty) (class mono)) :inverse-video t)
1103 (t :background "grey30"))
fa156643
MW
1104(mdw-define-face match
1105 (((type tty) (class color)) :background "blue")
1106 (((type tty) (class mono)) :inverse-video t)
1107 (t :background "blue"))
c6fe19d5
MW
1108(mdw-define-face mc/cursor-face
1109 (((type tty) (class mono)) :inverse-video t)
1110 (t :background "red"))
1e7a9479
MW
1111(mdw-define-face minibuffer-prompt
1112 (t :weight bold))
1113(mdw-define-face mode-line
db10ce0a
MW
1114 (((class color)) :foreground "blue" :background "yellow"
1115 :box (:line-width 1 :style released-button))
1116 (t :inverse-video t))
1e7a9479 1117(mdw-define-face mode-line-inactive
db10ce0a
MW
1118 (((class color)) :foreground "yellow" :background "blue"
1119 :box (:line-width 1 :style released-button))
1120 (t :inverse-video t))
ae0a853f
MW
1121(mdw-define-face nobreak-space
1122 (((type tty)))
1123 (t :inherit escape-glyph :underline t))
1e7a9479
MW
1124(mdw-define-face scroll-bar
1125 (t :foreground "black" :background "lightgrey"))
1126(mdw-define-face fringe
1127 (t :foreground "yellow"))
c383eb8a 1128(mdw-define-face show-paren-match
db10ce0a
MW
1129 (((class color)) :background "darkgreen")
1130 (t :underline t))
c383eb8a 1131(mdw-define-face show-paren-mismatch
db10ce0a
MW
1132 (((class color)) :background "red")
1133 (t :inverse-video t))
1e7a9479 1134(mdw-define-face highlight
b31f422b
MW
1135 (((type x) (class color)) :background "DarkSeaGreen4")
1136 (((type tty) (class color)) :background "cyan")
db10ce0a 1137 (t :inverse-video t))
1e7a9479
MW
1138
1139(mdw-define-face holiday-face
1140 (t :background "red"))
1141(mdw-define-face calendar-today-face
1142 (t :foreground "yellow" :weight bold))
1143
1144(mdw-define-face comint-highlight-prompt
1145 (t :weight bold))
5fd055c2
MW
1146(mdw-define-face comint-highlight-input
1147 (t nil))
1e7a9479 1148
e0e2aca3
MW
1149(mdw-define-face dired-directory
1150 (t :foreground "cyan" :weight bold))
1151(mdw-define-face dired-symlink
1152 (t :foreground "cyan"))
1153(mdw-define-face dired-perm-write
1154 (t nil))
1155
1e7a9479 1156(mdw-define-face trailing-whitespace
db10ce0a
MW
1157 (((class color)) :background "red")
1158 (t :inverse-video t))
1e7a9479
MW
1159(mdw-define-face mdw-punct-face
1160 (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
1161(mdw-define-face mdw-number-face
1162 (t :foreground "yellow"))
52bcde59 1163(mdw-define-face mdw-trivial-face)
1e7a9479 1164(mdw-define-face font-lock-function-name-face
c383eb8a 1165 (t :slant italic))
1e7a9479
MW
1166(mdw-define-face font-lock-keyword-face
1167 (t :weight bold))
1168(mdw-define-face font-lock-constant-face
1169 (t :slant italic))
1170(mdw-define-face font-lock-builtin-face
1171 (t :weight bold))
07965a39
MW
1172(mdw-define-face font-lock-type-face
1173 (t :weight bold :slant italic))
1e7a9479
MW
1174(mdw-define-face font-lock-reference-face
1175 (t :weight bold))
1176(mdw-define-face font-lock-variable-name-face
1177 (t :slant italic))
1178(mdw-define-face font-lock-comment-delimiter-face
db10ce0a
MW
1179 (((class mono)) :weight bold)
1180 (((type tty) (class color)) :foreground "green")
1181 (t :slant italic :foreground "SeaGreen1"))
1e7a9479 1182(mdw-define-face font-lock-comment-face
db10ce0a
MW
1183 (((class mono)) :weight bold)
1184 (((type tty) (class color)) :foreground "green")
1185 (t :slant italic :foreground "SeaGreen1"))
1e7a9479 1186(mdw-define-face font-lock-string-face
db10ce0a
MW
1187 (((class mono)) :weight bold)
1188 (((class color)) :foreground "SkyBlue1"))
898c7efb 1189
1e7a9479
MW
1190(mdw-define-face message-separator
1191 (t :background "red" :foreground "white" :weight bold))
1192(mdw-define-face message-cited-text
1193 (default :slant italic)
1194 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1195(mdw-define-face message-header-cc
1196 (default :weight bold)
1197 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1198(mdw-define-face message-header-newsgroups
1199 (default :weight bold)
1200 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1201(mdw-define-face message-header-subject
1202 (default :weight bold)
1203 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1204(mdw-define-face message-header-to
1205 (default :weight bold)
1206 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1207(mdw-define-face message-header-xheader
1208 (default :weight bold)
1209 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1210(mdw-define-face message-header-other
1211 (default :weight bold)
1212 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1213(mdw-define-face message-header-name
1214 (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
69498691
MW
1215(mdw-define-face which-func
1216 (t nil))
1e7a9479 1217
2f238de8
MW
1218(mdw-define-face diff-header
1219 (t nil))
1e7a9479
MW
1220(mdw-define-face diff-index
1221 (t :weight bold))
1222(mdw-define-face diff-file-header
1223 (t :weight bold))
1224(mdw-define-face diff-hunk-header
1225 (t :foreground "SkyBlue1"))
1226(mdw-define-face diff-function
1227 (t :foreground "SkyBlue1" :weight bold))
1228(mdw-define-face diff-header
1229 (t :background "grey10"))
1230(mdw-define-face diff-added
1231 (t :foreground "green"))
1232(mdw-define-face diff-removed
1233 (t :foreground "red"))
5fd055c2
MW
1234(mdw-define-face diff-context
1235 (t nil))
2f238de8 1236(mdw-define-face diff-refine-change
b31f422b
MW
1237 (((class color) (type x)) :background "RoyalBlue4")
1238 (t :underline t))
1e7a9479 1239
ad305d7e
MW
1240(mdw-define-face dylan-header-background
1241 (((class color) (type x)) :background "NavyBlue")
1242 (t :background "blue"))
1243
df082bab
MW
1244(mdw-define-face magit-diff-add
1245 (t :foreground "green"))
1246(mdw-define-face magit-diff-del
1247 (t :foreground "red"))
1248(mdw-define-face magit-diff-file-header
1249 (t :weight bold))
1250(mdw-define-face magit-diff-hunk-header
1251 (t :foreground "SkyBlue1"))
fb690b64
MW
1252(mdw-define-face magit-item-highlight
1253 (((type tty)) :background "blue")
cc71d815 1254 (t :background "grey11"))
8afc6956
MW
1255(mdw-define-face magit-log-head-label-remote
1256 (((type tty)) :background "cyan" :foreground "green")
1257 (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1258(mdw-define-face magit-log-head-label-local
1259 (((type tty)) :background "cyan" :foreground "yellow")
1260 (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1261(mdw-define-face magit-log-head-label-tags
1262 (((type tty)) :background "red" :foreground "yellow")
1263 (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1264(mdw-define-face magit-log-graph
1265 (((type tty)) :foreground "magenta")
1266 (t :foreground "grey80"))
df082bab 1267
e1b8de18
MW
1268(mdw-define-face erc-input-face
1269 (t :foreground "red"))
1270
1e7a9479
MW
1271(mdw-define-face woman-bold
1272 (t :weight bold))
1273(mdw-define-face woman-italic
1274 (t :slant italic))
1275
5a83259f
MW
1276(eval-after-load "rst"
1277 '(progn
1278 (mdw-define-face rst-level-1-face
1279 (t :foreground "SkyBlue1" :weight bold))
1280 (mdw-define-face rst-level-2-face
1281 (t :foreground "SeaGreen1" :weight bold))
1282 (mdw-define-face rst-level-3-face
1283 (t :weight bold))
1284 (mdw-define-face rst-level-4-face
1285 (t :slant italic))
1286 (mdw-define-face rst-level-5-face
1287 (t :underline t))
1288 (mdw-define-face rst-level-6-face
1289 ())))
4f251391 1290
1e7a9479
MW
1291(mdw-define-face p4-depot-added-face
1292 (t :foreground "green"))
1293(mdw-define-face p4-depot-branch-op-face
1294 (t :foreground "yellow"))
1295(mdw-define-face p4-depot-deleted-face
1296 (t :foreground "red"))
1297(mdw-define-face p4-depot-unmapped-face
1298 (t :foreground "SkyBlue1"))
1299(mdw-define-face p4-diff-change-face
1300 (t :foreground "yellow"))
1301(mdw-define-face p4-diff-del-face
1302 (t :foreground "red"))
1303(mdw-define-face p4-diff-file-face
1304 (t :foreground "SkyBlue1"))
1305(mdw-define-face p4-diff-head-face
1306 (t :background "grey10"))
1307(mdw-define-face p4-diff-ins-face
1308 (t :foreground "green"))
1309
4c39e530
MW
1310(mdw-define-face w3m-anchor-face
1311 (t :foreground "SkyBlue1" :underline t))
1312(mdw-define-face w3m-arrived-anchor-face
1313 (t :foreground "SkyBlue1" :underline t))
1314
1e7a9479
MW
1315(mdw-define-face whizzy-slice-face
1316 (t :background "grey10"))
1317(mdw-define-face whizzy-error-face
1318 (t :background "darkred"))
f617db13 1319
5fedb342
MW
1320;; Ellipses used to indicate hidden text (and similar).
1321(mdw-define-face mdw-ellipsis-face
1322 (((type tty)) :foreground "blue") (t :foreground "grey60"))
c11ac343 1323(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
a8a7976a 1324 (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
c11ac343
MW
1325 (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1326 (bar (make-glyph-code ?| mdw-ellipsis-face)))
1327 (set-display-table-slot standard-display-table 0 dollar)
1328 (set-display-table-slot standard-display-table 1 backslash)
5fedb342 1329 (set-display-table-slot standard-display-table 4
c11ac343
MW
1330 (vector dot dot dot))
1331 (set-display-table-slot standard-display-table 5 bar))
5fedb342 1332
6132bc01
MW
1333;;;--------------------------------------------------------------------------
1334;;; C programming configuration.
f617db13 1335
6132bc01 1336;; Linux kernel hacking.
f617db13
MW
1337
1338(defvar linux-c-mode-hook)
1339
1340(defun linux-c-mode ()
1341 (interactive)
1342 (c-mode)
1343 (setq major-mode 'linux-c-mode)
1344 (setq mode-name "Linux C")
1345 (run-hooks 'linux-c-mode-hook))
1346
6132bc01 1347;; Make C indentation nice.
f617db13 1348
f50c1bed
MW
1349(defun mdw-c-lineup-arglist (langelem)
1350 "Hack for DWIMmery in c-lineup-arglist."
1351 (if (save-excursion
1352 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1353 0
1354 (c-lineup-arglist langelem)))
1355
1356(defun mdw-c-indent-extern-mumble (langelem)
1357 "Indent `extern \"...\" {' lines."
1358 (save-excursion
1359 (back-to-indentation)
1360 (if (looking-at
1361 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1362 c-basic-offset
1363 nil)))
1364
f617db13
MW
1365(defun mdw-c-style ()
1366 (c-add-style "[mdw] C and C++ style"
1367 '((c-basic-offset . 2)
f617db13
MW
1368 (comment-column . 40)
1369 (c-class-key . "class")
f50c1bed
MW
1370 (c-backslash-column . 72)
1371 (c-offsets-alist
1372 (substatement-open . (add 0 c-indent-one-line-block))
1373 (defun-open . (add 0 c-indent-one-line-block))
1374 (arglist-cont-nonempty . mdw-c-lineup-arglist)
1375 (topmost-intro . mdw-c-indent-extern-mumble)
1376 (cpp-define-intro . 0)
10598d75 1377 (knr-argdecl . 0)
f50c1bed
MW
1378 (inextern-lang . [0])
1379 (label . 0)
1380 (case-label . +)
1381 (access-label . -)
1382 (inclass . +)
1383 (inline-open . ++)
10598d75 1384 (statement-cont . +)
f50c1bed 1385 (statement-case-intro . +)))
f617db13
MW
1386 t))
1387
0e7d960b
MW
1388(defvar mdw-c-comment-fill-prefix
1389 `((,(concat "\\([ \t]*/?\\)"
1390 "\\(\*\\|//]\\)"
1391 "\\([ \t]*\\)"
1392 "\\([A-Za-z]+:[ \t]*\\)?"
1393 mdw-hanging-indents)
1394 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1395 "Fill prefix matching C comments (both kinds).")
1396
f617db13
MW
1397(defun mdw-fontify-c-and-c++ ()
1398
6132bc01 1399 ;; Fiddle with some syntax codes.
f617db13
MW
1400 (modify-syntax-entry ?* ". 23")
1401 (modify-syntax-entry ?/ ". 124b")
1402 (modify-syntax-entry ?\n "> b")
1403
6132bc01 1404 ;; Other stuff.
f617db13
MW
1405 (mdw-c-style)
1406 (setq c-hanging-comment-ender-p nil)
1407 (setq c-backslash-column 72)
1408 (setq c-label-minimum-indentation 0)
0e7d960b 1409 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1410
6132bc01 1411 ;; Now define things to be fontified.
02109a0d 1412 (make-local-variable 'font-lock-keywords)
f617db13 1413 (let ((c-keywords
fe307a8c
MW
1414 (mdw-regexps "alignas" ;C11 macro, C++11
1415 "alignof" ;C++11
1416 "and" ;C++, C95 macro
0681f29e 1417 "and_eq" ;C++, C95 macro
7b84c078 1418 "asm" ;K&R, C++, GCC
fe307a8c 1419 "atomic" ;C11 macro, C++11 template type
26f18bd1 1420 "auto" ;K&R, C89
0681f29e
MW
1421 "bitand" ;C++, C95 macro
1422 "bitor" ;C++, C95 macro
d4783d9c 1423 "bool" ;C++, C99 macro
26f18bd1
MW
1424 "break" ;K&R, C89
1425 "case" ;K&R, C89
1426 "catch" ;C++
1427 "char" ;K&R, C89
fe307a8c
MW
1428 "char16_t" ;C++11, C11 library type
1429 "char32_t" ;C++11, C11 library type
26f18bd1 1430 "class" ;C++
d4783d9c 1431 "complex" ;C99 macro, C++ template type
0681f29e 1432 "compl" ;C++, C95 macro
26f18bd1 1433 "const" ;C89
fe307a8c 1434 "constexpr" ;C++11
26f18bd1
MW
1435 "const_cast" ;C++
1436 "continue" ;K&R, C89
fe307a8c 1437 "decltype" ;C++11
26f18bd1
MW
1438 "defined" ;C89 preprocessor
1439 "default" ;K&R, C89
1440 "delete" ;C++
1441 "do" ;K&R, C89
1442 "double" ;K&R, C89
1443 "dynamic_cast" ;C++
1444 "else" ;K&R, C89
1445 ;; "entry" ;K&R -- never used
1446 "enum" ;C89
1447 "explicit" ;C++
1448 "export" ;C++
1449 "extern" ;K&R, C89
1450 "float" ;K&R, C89
1451 "for" ;K&R, C89
1452 ;; "fortran" ;K&R
1453 "friend" ;C++
1454 "goto" ;K&R, C89
1455 "if" ;K&R, C89
d4783d9c
MW
1456 "imaginary" ;C99 macro
1457 "inline" ;C++, C99, GCC
26f18bd1
MW
1458 "int" ;K&R, C89
1459 "long" ;K&R, C89
1460 "mutable" ;C++
1461 "namespace" ;C++
1462 "new" ;C++
fe307a8c
MW
1463 "noexcept" ;C++11
1464 "noreturn" ;C11 macro
0681f29e
MW
1465 "not" ;C++, C95 macro
1466 "not_eq" ;C++, C95 macro
fe307a8c 1467 "nullptr" ;C++11
26f18bd1 1468 "operator" ;C++
0681f29e
MW
1469 "or" ;C++, C95 macro
1470 "or_eq" ;C++, C95 macro
26f18bd1
MW
1471 "private" ;C++
1472 "protected" ;C++
1473 "public" ;C++
1474 "register" ;K&R, C89
8d6d55b9 1475 "reinterpret_cast" ;C++
d4783d9c 1476 "restrict" ;C99
8d6d55b9
MW
1477 "return" ;K&R, C89
1478 "short" ;K&R, C89
1479 "signed" ;C89
1480 "sizeof" ;K&R, C89
1481 "static" ;K&R, C89
fe307a8c 1482 "static_assert" ;C11 macro, C++11
8d6d55b9
MW
1483 "static_cast" ;C++
1484 "struct" ;K&R, C89
1485 "switch" ;K&R, C89
1486 "template" ;C++
8d6d55b9 1487 "throw" ;C++
8d6d55b9 1488 "try" ;C++
fe307a8c 1489 "thread_local" ;C11 macro, C++11
8d6d55b9
MW
1490 "typedef" ;C89
1491 "typeid" ;C++
1492 "typeof" ;GCC
1493 "typename" ;C++
1494 "union" ;K&R, C89
1495 "unsigned" ;K&R, C89
1496 "using" ;C++
1497 "virtual" ;C++
1498 "void" ;C89
1499 "volatile" ;C89
1500 "wchar_t" ;C++, C89 library type
1501 "while" ;K&R, C89
0681f29e
MW
1502 "xor" ;C++, C95 macro
1503 "xor_eq" ;C++, C95 macro
fe307a8c
MW
1504 "_Alignas" ;C11
1505 "_Alignof" ;C11
1506 "_Atomic" ;C11
d4783d9c
MW
1507 "_Bool" ;C99
1508 "_Complex" ;C99
fe307a8c 1509 "_Generic" ;C11
d4783d9c 1510 "_Imaginary" ;C99
fe307a8c 1511 "_Noreturn" ;C11
d4783d9c 1512 "_Pragma" ;C99 preprocessor
fe307a8c
MW
1513 "_Static_assert" ;C11
1514 "_Thread_local" ;C11
8d6d55b9
MW
1515 "__alignof__" ;GCC
1516 "__asm__" ;GCC
1517 "__attribute__" ;GCC
1518 "__complex__" ;GCC
1519 "__const__" ;GCC
1520 "__extension__" ;GCC
1521 "__imag__" ;GCC
1522 "__inline__" ;GCC
1523 "__label__" ;GCC
1524 "__real__" ;GCC
1525 "__signed__" ;GCC
1526 "__typeof__" ;GCC
1527 "__volatile__" ;GCC
1528 ))
165cecf8 1529 (c-constants
26f18bd1 1530 (mdw-regexps "false" ;C++, C99 macro
165cecf8 1531 "this" ;C++
26f18bd1 1532 "true" ;C++, C99 macro
165cecf8 1533 ))
f617db13 1534 (preprocessor-keywords
8d6d55b9
MW
1535 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1536 "ident" "if" "ifdef" "ifndef" "import" "include"
1537 "line" "pragma" "unassert" "undef" "warning"))
f617db13 1538 (objc-keywords
8d6d55b9
MW
1539 (mdw-regexps "class" "defs" "encode" "end" "implementation"
1540 "interface" "private" "protected" "protocol" "public"
1541 "selector")))
f617db13
MW
1542
1543 (setq font-lock-keywords
1544 (list
f617db13 1545
6132bc01 1546 ;; Fontify include files as strings.
f617db13
MW
1547 (list (concat "^[ \t]*\\#[ \t]*"
1548 "\\(include\\|import\\)"
1549 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1550 '(2 font-lock-string-face))
1551
6132bc01 1552 ;; Preprocessor directives are `references'?.
f617db13
MW
1553 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1554 preprocessor-keywords
1555 "\\)\\>\\|[0-9]+\\|$\\)\\)")
1556 '(1 font-lock-keyword-face))
1557
6132bc01 1558 ;; Handle the keywords defined above.
f617db13
MW
1559 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1560 '(0 font-lock-keyword-face))
1561
1562 (list (concat "\\<\\(" c-keywords "\\)\\>")
1563 '(0 font-lock-keyword-face))
1564
165cecf8
MW
1565 (list (concat "\\<\\(" c-constants "\\)\\>")
1566 '(0 font-lock-variable-name-face))
1567
6132bc01 1568 ;; Handle numbers too.
f617db13
MW
1569 ;;
1570 ;; This looks strange, I know. It corresponds to the
1571 ;; preprocessor's idea of what a number looks like, rather than
1572 ;; anything sensible.
f617db13
MW
1573 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1574 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1575 '(0 mdw-number-face))
1576
6132bc01 1577 ;; And anything else is punctuation.
f617db13 1578 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 1579 '(0 mdw-punct-face))))))
f617db13 1580
6132bc01
MW
1581;;;--------------------------------------------------------------------------
1582;;; AP calc mode.
f617db13
MW
1583
1584(defun apcalc-mode ()
1585 (interactive)
1586 (c-mode)
1587 (setq major-mode 'apcalc-mode)
1588 (setq mode-name "AP Calc")
1589 (run-hooks 'apcalc-mode-hook))
1590
1591(defun mdw-fontify-apcalc ()
1592
6132bc01 1593 ;; Fiddle with some syntax codes.
f617db13
MW
1594 (modify-syntax-entry ?* ". 23")
1595 (modify-syntax-entry ?/ ". 14")
1596
6132bc01 1597 ;; Other stuff.
f617db13
MW
1598 (mdw-c-style)
1599 (setq c-hanging-comment-ender-p nil)
1600 (setq c-backslash-column 72)
1601 (setq comment-start "/* ")
1602 (setq comment-end " */")
0e7d960b 1603 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1604
6132bc01 1605 ;; Now define things to be fontified.
02109a0d 1606 (make-local-variable 'font-lock-keywords)
f617db13 1607 (let ((c-keywords
8d6d55b9
MW
1608 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1609 "do" "else" "exit" "for" "global" "goto" "help" "if"
1610 "local" "mat" "obj" "print" "quit" "read" "return"
1611 "show" "static" "switch" "while" "write")))
f617db13
MW
1612
1613 (setq font-lock-keywords
1614 (list
f617db13 1615
6132bc01 1616 ;; Handle the keywords defined above.
f617db13
MW
1617 (list (concat "\\<\\(" c-keywords "\\)\\>")
1618 '(0 font-lock-keyword-face))
1619
6132bc01 1620 ;; Handle numbers too.
f617db13
MW
1621 ;;
1622 ;; This looks strange, I know. It corresponds to the
1623 ;; preprocessor's idea of what a number looks like, rather than
1624 ;; anything sensible.
f617db13
MW
1625 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1626 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1627 '(0 mdw-number-face))
1628
6132bc01 1629 ;; And anything else is punctuation.
f617db13 1630 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 1631 '(0 mdw-punct-face))))))
f617db13 1632
6132bc01
MW
1633;;;--------------------------------------------------------------------------
1634;;; Java programming configuration.
f617db13 1635
6132bc01 1636;; Make indentation nice.
f617db13
MW
1637
1638(defun mdw-java-style ()
1639 (c-add-style "[mdw] Java style"
1640 '((c-basic-offset . 2)
f617db13
MW
1641 (c-offsets-alist (substatement-open . 0)
1642 (label . +)
1643 (case-label . +)
1644 (access-label . 0)
1645 (inclass . +)
1646 (statement-case-intro . +)))
1647 t))
1648
6132bc01 1649;; Declare Java fontification style.
f617db13
MW
1650
1651(defun mdw-fontify-java ()
1652
6132bc01 1653 ;; Other stuff.
f617db13 1654 (mdw-java-style)
f617db13
MW
1655 (setq c-hanging-comment-ender-p nil)
1656 (setq c-backslash-column 72)
0e7d960b 1657 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1658
6132bc01 1659 ;; Now define things to be fontified.
02109a0d 1660 (make-local-variable 'font-lock-keywords)
f617db13 1661 (let ((java-keywords
8d6d55b9
MW
1662 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1663 "char" "class" "const" "continue" "default" "do"
1664 "double" "else" "extends" "final" "finally" "float"
1665 "for" "goto" "if" "implements" "import" "instanceof"
1666 "int" "interface" "long" "native" "new" "package"
1667 "private" "protected" "public" "return" "short"
165cecf8
MW
1668 "static" "switch" "synchronized" "throw" "throws"
1669 "transient" "try" "void" "volatile" "while"))
8d6d55b9 1670
165cecf8
MW
1671 (java-constants
1672 (mdw-regexps "false" "null" "super" "this" "true")))
f617db13
MW
1673
1674 (setq font-lock-keywords
1675 (list
f617db13 1676
6132bc01 1677 ;; Handle the keywords defined above.
f617db13
MW
1678 (list (concat "\\<\\(" java-keywords "\\)\\>")
1679 '(0 font-lock-keyword-face))
1680
165cecf8
MW
1681 ;; Handle the magic constants defined above.
1682 (list (concat "\\<\\(" java-constants "\\)\\>")
1683 '(0 font-lock-variable-name-face))
1684
6132bc01 1685 ;; Handle numbers too.
f617db13
MW
1686 ;;
1687 ;; The following isn't quite right, but it's close enough.
f617db13
MW
1688 (list (concat "\\<\\("
1689 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1690 "[0-9]+\\(\\.[0-9]*\\|\\)"
1691 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1692 "[lLfFdD]?")
1693 '(0 mdw-number-face))
1694
6132bc01 1695 ;; And anything else is punctuation.
f617db13 1696 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 1697 '(0 mdw-punct-face))))))
f617db13 1698
61d63206
MW
1699;;;--------------------------------------------------------------------------
1700;;; Javascript programming configuration.
1701
1702(defun mdw-javascript-style ()
1703 (setq js-indent-level 2)
1704 (setq js-expr-indent-offset 0))
1705
1706(defun mdw-fontify-javascript ()
1707
1708 ;; Other stuff.
1709 (mdw-javascript-style)
1710 (setq js-auto-indent-flag t)
1711
1712 ;; Now define things to be fontified.
1713 (make-local-variable 'font-lock-keywords)
1714 (let ((javascript-keywords
1715 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1716 "char" "class" "const" "continue" "debugger" "default"
1717 "delete" "do" "double" "else" "enum" "export" "extends"
1718 "final" "finally" "float" "for" "function" "goto" "if"
1719 "implements" "import" "in" "instanceof" "int"
1720 "interface" "let" "long" "native" "new" "package"
1721 "private" "protected" "public" "return" "short"
1722 "static" "super" "switch" "synchronized" "throw"
1723 "throws" "transient" "try" "typeof" "var" "void"
1724 "volatile" "while" "with" "yield"
1725
1726 "boolean" "byte" "char" "double" "float" "int" "long"
1727 "short" "void"))
1728 (javascript-constants
1729 (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1730 "arguments" "this")))
1731
1732 (setq font-lock-keywords
1733 (list
1734
1735 ;; Handle the keywords defined above.
f7856acd 1736 (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
61d63206
MW
1737 '(0 font-lock-keyword-face))
1738
1739 ;; Handle the predefined constants defined above.
f7856acd 1740 (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
61d63206
MW
1741 '(0 font-lock-variable-name-face))
1742
1743 ;; Handle numbers too.
1744 ;;
1745 ;; The following isn't quite right, but it's close enough.
f7856acd 1746 (list (concat "\\_<\\("
61d63206
MW
1747 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1748 "[0-9]+\\(\\.[0-9]*\\|\\)"
1749 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1750 "[lLfFdD]?")
1751 '(0 mdw-number-face))
1752
1753 ;; And anything else is punctuation.
1754 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 1755 '(0 mdw-punct-face))))))
61d63206 1756
ee7c3dea
MW
1757;;;--------------------------------------------------------------------------
1758;;; Scala programming configuration.
1759
1760(defun mdw-fontify-scala ()
1761
7b5903d8
MW
1762 ;; Comment filling.
1763 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1764
ee7c3dea
MW
1765 ;; Define things to be fontified.
1766 (make-local-variable 'font-lock-keywords)
1767 (let ((scala-keywords
1768 (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1769 "extends" "final" "finally" "for" "forSome" "if"
1770 "implicit" "import" "lazy" "match" "new" "object"
3f017188
MW
1771 "override" "package" "private" "protected" "return"
1772 "sealed" "throw" "trait" "try" "type" "val"
ee7c3dea
MW
1773 "var" "while" "with" "yield"))
1774 (scala-constants
3f017188 1775 (mdw-regexps "false" "null" "super" "this" "true"))
7b5903d8 1776 (punctuation "[-!%^&*=+:@#~/?\\|`]"))
ee7c3dea
MW
1777
1778 (setq font-lock-keywords
1779 (list
1780
1781 ;; Magical identifiers between backticks.
1782 (list (concat "`\\([^`]+\\)`")
1783 '(1 font-lock-variable-name-face))
1784
1785 ;; Handle the keywords defined above.
1786 (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1787 '(0 font-lock-keyword-face))
1788
1789 ;; Handle the constants defined above.
1790 (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1791 '(0 font-lock-variable-name-face))
1792
1793 ;; Magical identifiers between backticks.
1794 (list (concat "`\\([^`]+\\)`")
1795 '(1 font-lock-variable-name-face))
1796
1797 ;; Handle numbers too.
1798 ;;
1799 ;; As usual, not quite right.
1800 (list (concat "\\_<\\("
1801 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1802 "[0-9]+\\(\\.[0-9]*\\|\\)"
1803 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1804 "[lLfFdD]?")
1805 '(0 mdw-number-face))
1806
1807 ;; Identifiers with trailing operators.
1808 (list (concat "_\\(" punctuation "\\)+")
1809 '(0 mdw-trivial-face))
1810
1811 ;; And everything else is punctuation.
1812 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1813 '(0 mdw-punct-face)))
1814
1815 font-lock-syntactic-keywords
1816 (list
1817
1818 ;; Single quotes around characters. But not when used to quote
1819 ;; symbol names. Ugh.
1820 (list (concat "\\('\\)"
1821 "\\(" "."
1822 "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1823 "u+" "[0-9a-fA-F]\\{4\\}"
1824 "\\|" "\\\\" "[0-7]\\{1,3\\}"
1825 "\\|" "\\\\" "." "\\)"
1826 "\\('\\)")
1827 '(1 "\"")
2e7c6a86 1828 '(4 "\""))))))
ee7c3dea 1829
6132bc01
MW
1830;;;--------------------------------------------------------------------------
1831;;; C# programming configuration.
e808c1e5 1832
6132bc01 1833;; Make indentation nice.
e808c1e5
MW
1834
1835(defun mdw-csharp-style ()
1836 (c-add-style "[mdw] C# style"
1837 '((c-basic-offset . 2)
e808c1e5
MW
1838 (c-offsets-alist (substatement-open . 0)
1839 (label . 0)
1840 (case-label . +)
1841 (access-label . 0)
1842 (inclass . +)
1843 (statement-case-intro . +)))
1844 t))
1845
6132bc01 1846;; Declare C# fontification style.
e808c1e5
MW
1847
1848(defun mdw-fontify-csharp ()
1849
6132bc01 1850 ;; Other stuff.
e808c1e5 1851 (mdw-csharp-style)
e808c1e5
MW
1852 (setq c-hanging-comment-ender-p nil)
1853 (setq c-backslash-column 72)
0e7d960b 1854 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
e808c1e5 1855
6132bc01 1856 ;; Now define things to be fontified.
e808c1e5
MW
1857 (make-local-variable 'font-lock-keywords)
1858 (let ((csharp-keywords
165cecf8
MW
1859 (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1860 "char" "checked" "class" "const" "continue" "decimal"
1861 "default" "delegate" "do" "double" "else" "enum"
1862 "event" "explicit" "extern" "finally" "fixed" "float"
1863 "for" "foreach" "goto" "if" "implicit" "in" "int"
1864 "interface" "internal" "is" "lock" "long" "namespace"
1865 "new" "object" "operator" "out" "override" "params"
1866 "private" "protected" "public" "readonly" "ref"
1867 "return" "sbyte" "sealed" "short" "sizeof"
1868 "stackalloc" "static" "string" "struct" "switch"
1869 "throw" "try" "typeof" "uint" "ulong" "unchecked"
1870 "unsafe" "ushort" "using" "virtual" "void" "volatile"
1871 "while" "yield"))
1872
1873 (csharp-constants
1874 (mdw-regexps "base" "false" "null" "this" "true")))
e808c1e5
MW
1875
1876 (setq font-lock-keywords
1877 (list
e808c1e5 1878
6132bc01 1879 ;; Handle the keywords defined above.
e808c1e5
MW
1880 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1881 '(0 font-lock-keyword-face))
1882
165cecf8
MW
1883 ;; Handle the magic constants defined above.
1884 (list (concat "\\<\\(" csharp-constants "\\)\\>")
1885 '(0 font-lock-variable-name-face))
1886
6132bc01 1887 ;; Handle numbers too.
e808c1e5
MW
1888 ;;
1889 ;; The following isn't quite right, but it's close enough.
e808c1e5
MW
1890 (list (concat "\\<\\("
1891 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1892 "[0-9]+\\(\\.[0-9]*\\|\\)"
1893 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1894 "[lLfFdD]?")
1895 '(0 mdw-number-face))
1896
6132bc01 1897 ;; And anything else is punctuation.
e808c1e5 1898 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 1899 '(0 mdw-punct-face))))))
e808c1e5 1900
103c5923
MW
1901(define-derived-mode csharp-mode java-mode "C#"
1902 "Major mode for editing C# code.")
e808c1e5 1903
81fb08fc
MW
1904;;;--------------------------------------------------------------------------
1905;;; F# programming configuration.
1906
1907(setq fsharp-indent-offset 2)
1908
1909(defun mdw-fontify-fsharp ()
1910
1911 (let ((punct "=<>+-*/|&%!@?"))
1912 (do ((i 0 (1+ i)))
1913 ((>= i (length punct)))
1914 (modify-syntax-entry (aref punct i) ".")))
1915
1916 (modify-syntax-entry ?_ "_")
1917 (modify-syntax-entry ?( "(")
1918 (modify-syntax-entry ?) ")")
1919
1920 (setq indent-tabs-mode nil)
1921
1922 (let ((fsharp-keywords
1923 (mdw-regexps "abstract" "and" "as" "assert" "atomic"
165cecf8 1924 "begin" "break"
81fb08fc
MW
1925 "checked" "class" "component" "const" "constraint"
1926 "constructor" "continue"
1927 "default" "delegate" "do" "done" "downcast" "downto"
1928 "eager" "elif" "else" "end" "exception" "extern"
165cecf8 1929 "finally" "fixed" "for" "fori" "fun" "function"
81fb08fc
MW
1930 "functor"
1931 "global"
1932 "if" "in" "include" "inherit" "inline" "interface"
1933 "internal"
1934 "lazy" "let"
1935 "match" "measure" "member" "method" "mixin" "module"
1936 "mutable"
165cecf8
MW
1937 "namespace" "new"
1938 "object" "of" "open" "or" "override"
81fb08fc
MW
1939 "parallel" "params" "private" "process" "protected"
1940 "public" "pure"
1941 "rec" "recursive" "return"
1942 "sealed" "sig" "static" "struct"
165cecf8 1943 "tailcall" "then" "to" "trait" "try" "type"
81fb08fc
MW
1944 "upcast" "use"
1945 "val" "virtual" "void" "volatile"
1946 "when" "while" "with"
1947 "yield"))
1948
1949 (fsharp-builtins
165cecf8
MW
1950 (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1951 "base" "false" "null" "true"))
81fb08fc
MW
1952
1953 (bang-keywords
1954 (mdw-regexps "do" "let" "return" "use" "yield"))
1955
1956 (preprocessor-keywords
1957 (mdw-regexps "if" "indent" "else" "endif")))
1958
1959 (setq font-lock-keywords
1960 (list (list (concat "\\(^\\|[^\"]\\)"
1961 "\\(" "(\\*"
1962 "[^*]*\\*+"
1963 "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1964 ")"
1965 "\\|"
1966 "//.*"
1967 "\\)")
1968 '(2 font-lock-comment-face))
1969
1970 (list (concat "'" "\\("
1971 "\\\\"
1972 "\\(" "[ntbr'\\]"
1973 "\\|" "[0-9][0-9][0-9]"
1974 "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1975 "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1976 "\\)"
1977 "\\|"
1978 "." "\\)" "'"
1979 "\\|"
1980 "\"" "[^\"\\]*"
1981 "\\(" "\\\\" "\\(.\\|\n\\)"
1982 "[^\"\\]*" "\\)*"
1983 "\\(\"\\|\\'\\)")
1984 '(0 font-lock-string-face))
1985
1986 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1987 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1988 "\\|"
1989 "\\_<\\(" fsharp-keywords "\\)\\_>")
1990 '(0 font-lock-keyword-face))
1991 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1992 '(0 font-lock-variable-name-face))
1993
1994 (list (concat "\\_<"
1995 "\\(" "0[bB][01]+" "\\|"
1996 "0[oO][0-7]+" "\\|"
1997 "0[xX][0-9a-fA-F]+" "\\)"
1998 "\\(" "lf\\|LF" "\\|"
1999 "[uU]?[ysnlL]?" "\\)"
2000 "\\|"
2001 "\\_<"
2002 "[0-9]+" "\\("
2003 "[mMQRZING]"
2004 "\\|"
2005 "\\(\\.[0-9]*\\)?"
2006 "\\([eE][-+]?[0-9]+\\)?"
2007 "[fFmM]?"
2008 "\\|"
2009 "[uU]?[ysnlL]?"
2010 "\\)")
2011 '(0 mdw-number-face))
2012
2013 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2014 '(0 mdw-punct-face))))))
81fb08fc
MW
2015
2016(defun mdw-fontify-inferior-fsharp ()
2017 (mdw-fontify-fsharp)
2018 (setq font-lock-keywords
2019 (append (list (list "^[#-]" '(0 font-lock-comment-face))
2020 (list "^>" '(0 font-lock-keyword-face)))
2021 font-lock-keywords)))
2022
6132bc01 2023;;;--------------------------------------------------------------------------
07965a39
MW
2024;;; Go programming configuration.
2025
2026(defun mdw-fontify-go ()
2027
2028 (make-local-variable 'font-lock-keywords)
2029 (let ((go-keywords
2030 (mdw-regexps "break" "case" "chan" "const" "continue"
2031 "default" "defer" "else" "fallthrough" "for"
2032 "func" "go" "goto" "if" "import"
2033 "interface" "map" "package" "range" "return"
fc79ff88
MW
2034 "select" "struct" "switch" "type" "var"))
2035 (go-intrinsics
2036 (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2037 "float32" "float64" "int" "uint8" "int16" "int32"
2038 "int64" "rune" "string" "uint" "uint8" "uint16"
2039 "uint32" "uint64" "uintptr" "void"
2040 "false" "iota" "nil" "true"
2041 "init" "main"
2042 "append" "cap" "copy" "delete" "imag" "len" "make"
2043 "new" "panic" "real" "recover")))
07965a39
MW
2044
2045 (setq font-lock-keywords
2046 (list
2047
2048 ;; Handle the keywords defined above.
2049 (list (concat "\\<\\(" go-keywords "\\)\\>")
2050 '(0 font-lock-keyword-face))
fc79ff88
MW
2051 (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2052 '(0 font-lock-variable-name-face))
07965a39 2053
cbbea94e
MW
2054 ;; Strings and characters.
2055 (list (concat "'"
2056 "\\(" "[^\\']" "\\|"
2057 "\\\\"
2058 "\\(" "[abfnrtv\\'\"]" "\\|"
2059 "[0-7]\\{3\\}" "\\|"
2060 "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2061 "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2062 "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2063 "'"
2064 "\\|"
2065 "\""
2066 "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2067 "\\(\"\\|$\\)"
2068 "\\|"
2069 "`" "[^`]+" "`")
2070 '(0 font-lock-string-face))
2071
07965a39
MW
2072 ;; Handle numbers too.
2073 ;;
2074 ;; The following isn't quite right, but it's close enough.
2075 (list (concat "\\<\\("
2076 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2077 "[0-9]+\\(\\.[0-9]*\\|\\)"
2078 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
2079 '(0 mdw-number-face))
2080
2081 ;; And anything else is punctuation.
2082 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2083 '(0 mdw-punct-face))))))
07965a39 2084
36db1ea7
MW
2085;;;--------------------------------------------------------------------------
2086;;; Rust programming configuration.
2087
2088(setq-default rust-indent-offset 2)
2089
2090(defun mdw-self-insert-and-indent (count)
2091 (interactive "p")
2092 (self-insert-command count)
2093 (indent-according-to-mode))
2094
2095(defun mdw-fontify-rust ()
2096
2097 ;; Hack syntax categories.
2098 (modify-syntax-entry ?= ".")
2099
2100 ;; Fontify keywords and things.
2101 (make-local-variable 'font-lock-keywords)
2102 (let ((rust-keywords
2103 (mdw-regexps "abstract" "alignof" "as"
2104 "become" "box" "break"
2105 "const" "continue" "create"
2106 "do"
2107 "else" "enum" "extern"
2108 "false" "final" "fn" "for"
2109 "if" "impl" "in"
2110 "let" "loop"
2111 "macro" "match" "mod" "move" "mut"
2112 "offsetof" "override"
2113 "priv" "pub" "pure"
2114 "ref" "return"
2115 "self" "sizeof" "static" "struct" "super"
2116 "true" "trait" "type" "typeof"
2117 "unsafe" "unsized" "use"
2118 "virtual"
2119 "where" "while"
2120 "yield"))
2121 (rust-builtins
2122 (mdw-regexps "array" "pointer" "slice" "tuple"
2123 "bool" "true" "false"
2124 "f32" "f64"
2125 "i8" "i16" "i32" "i64" "isize"
2126 "u8" "u16" "u32" "u64" "usize"
2127 "char" "str")))
2128 (setq font-lock-keywords
2129 (list
2130
2131 ;; Handle the keywords defined above.
2132 (list (concat "\\<\\(" rust-keywords "\\)\\>")
2133 '(0 font-lock-keyword-face))
2134 (list (concat "\\<\\(" rust-builtins "\\)\\>")
2135 '(0 font-lock-variable-name-face))
2136
2137 ;; Handle numbers too.
2138 (list (concat "\\<\\("
2139 "[0-9][0-9_]*"
2140 "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2141 "\\|" "\\.[0-9_]+"
2142 "\\)"
2143 "\\(f32\\|f64\\)?"
2144 "\\|" "\\(" "[0-9][0-9_]*"
2145 "\\|" "0x[0-9a-fA-F_]+"
2146 "\\|" "0o[0-7_]+"
2147 "\\|" "0b[01_]+"
2148 "\\)"
2149 "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
2150 "\\)\\>")
2151 '(0 mdw-number-face))
2152
2153 ;; And anything else is punctuation.
2154 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2155 '(0 mdw-punct-face)))))
2156
2157 ;; Hack key bindings.
d2f85967 2158 (local-set-key [?{] 'mdw-self-insert-and-indent)
2e7c6a86 2159 (local-set-key [?}] 'mdw-self-insert-and-indent))
36db1ea7 2160
07965a39 2161;;;--------------------------------------------------------------------------
6132bc01 2162;;; Awk programming configuration.
f617db13 2163
6132bc01 2164;; Make Awk indentation nice.
f617db13
MW
2165
2166(defun mdw-awk-style ()
2167 (c-add-style "[mdw] Awk style"
2168 '((c-basic-offset . 2)
f617db13
MW
2169 (c-offsets-alist (substatement-open . 0)
2170 (statement-cont . 0)
2171 (statement-case-intro . +)))
2172 t))
2173
6132bc01 2174;; Declare Awk fontification style.
f617db13
MW
2175
2176(defun mdw-fontify-awk ()
2177
6132bc01 2178 ;; Miscellaneous fiddling.
f617db13
MW
2179 (mdw-awk-style)
2180 (setq c-backslash-column 72)
2181 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2182
6132bc01 2183 ;; Now define things to be fontified.
02109a0d 2184 (make-local-variable 'font-lock-keywords)
f617db13 2185 (let ((c-keywords
8d6d55b9
MW
2186 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2187 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2188 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2189 "RSTART" "RLENGTH" "RT" "SUBSEP"
2190 "atan2" "break" "close" "continue" "cos" "delete"
2191 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2192 "function" "gensub" "getline" "gsub" "if" "in"
2193 "index" "int" "length" "log" "match" "next" "rand"
2194 "return" "print" "printf" "sin" "split" "sprintf"
2195 "sqrt" "srand" "strftime" "sub" "substr" "system"
2196 "systime" "tolower" "toupper" "while")))
f617db13
MW
2197
2198 (setq font-lock-keywords
2199 (list
f617db13 2200
6132bc01 2201 ;; Handle the keywords defined above.
f617db13
MW
2202 (list (concat "\\<\\(" c-keywords "\\)\\>")
2203 '(0 font-lock-keyword-face))
2204
6132bc01 2205 ;; Handle numbers too.
f617db13
MW
2206 ;;
2207 ;; The following isn't quite right, but it's close enough.
f617db13
MW
2208 (list (concat "\\<\\("
2209 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2210 "[0-9]+\\(\\.[0-9]*\\|\\)"
2211 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2212 "[uUlL]*")
2213 '(0 mdw-number-face))
2214
6132bc01 2215 ;; And anything else is punctuation.
f617db13 2216 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2217 '(0 mdw-punct-face))))))
f617db13 2218
6132bc01
MW
2219;;;--------------------------------------------------------------------------
2220;;; Perl programming style.
f617db13 2221
6132bc01 2222;; Perl indentation style.
f617db13 2223
88158daf
MW
2224(setq perl-indent-level 2)
2225
f617db13
MW
2226(setq cperl-indent-level 2)
2227(setq cperl-continued-statement-offset 2)
2228(setq cperl-continued-brace-offset 0)
2229(setq cperl-brace-offset -2)
2230(setq cperl-brace-imaginary-offset 0)
2231(setq cperl-label-offset 0)
2232
6132bc01 2233;; Define perl fontification style.
f617db13
MW
2234
2235(defun mdw-fontify-perl ()
2236
6132bc01 2237 ;; Miscellaneous fiddling.
f617db13
MW
2238 (modify-syntax-entry ?$ "\\")
2239 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
a3b8176f 2240 (modify-syntax-entry ?: "." font-lock-syntax-table)
f617db13
MW
2241 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2242
6132bc01 2243 ;; Now define fontification things.
02109a0d 2244 (make-local-variable 'font-lock-keywords)
f617db13 2245 (let ((perl-keywords
821c4945
MW
2246 (mdw-regexps "and"
2247 "break"
2248 "cmp" "continue"
2249 "default" "do"
2250 "else" "elsif" "eq"
2251 "for" "foreach"
2252 "ge" "given" "gt" "goto"
2253 "if"
2254 "last" "le" "local" "lt"
2255 "my"
2256 "ne" "next"
2257 "or" "our"
2258 "package"
2259 "redo" "require" "return"
2260 "sub"
2261 "undef" "unless" "until" "use"
2262 "when" "while")))
f617db13
MW
2263
2264 (setq font-lock-keywords
2265 (list
f617db13 2266
6132bc01 2267 ;; Set up the keywords defined above.
f617db13
MW
2268 (list (concat "\\<\\(" perl-keywords "\\)\\>")
2269 '(0 font-lock-keyword-face))
2270
6132bc01 2271 ;; At least numbers are simpler than C.
f617db13
MW
2272 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2273 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2274 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2275 '(0 mdw-number-face))
2276
6132bc01 2277 ;; And anything else is punctuation.
f617db13 2278 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2279 '(0 mdw-punct-face))))))
f617db13
MW
2280
2281(defun perl-number-tests (&optional arg)
2282 "Assign consecutive numbers to lines containing `#t'. With ARG,
2283strip numbers instead."
2284 (interactive "P")
2285 (save-excursion
2286 (goto-char (point-min))
2287 (let ((i 0) (fmt (if arg "" " %4d")))
2288 (while (search-forward "#t" nil t)
2289 (delete-region (point) (line-end-position))
2290 (setq i (1+ i))
2291 (insert (format fmt i)))
2292 (goto-char (point-min))
2293 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2294 (replace-match (format "\\1%d" i))))))
2295
6132bc01
MW
2296;;;--------------------------------------------------------------------------
2297;;; Python programming style.
f617db13 2298
99fe6ef5 2299(defun mdw-fontify-pythonic (keywords)
f617db13 2300
6132bc01 2301 ;; Miscellaneous fiddling.
f617db13 2302 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
7c0fcfde 2303 (setq indent-tabs-mode nil)
f617db13 2304
6132bc01 2305 ;; Now define fontification things.
02109a0d 2306 (make-local-variable 'font-lock-keywords)
99fe6ef5
MW
2307 (setq font-lock-keywords
2308 (list
f617db13 2309
be2cc788 2310 ;; Set up the keywords defined above.
4b037109 2311 (list (concat "\\_<\\(" keywords "\\)\\_>")
99fe6ef5 2312 '(0 font-lock-keyword-face))
f617db13 2313
be2cc788 2314 ;; At least numbers are simpler than C.
4b037109
MW
2315 (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2316 "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
99fe6ef5
MW
2317 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2318 '(0 mdw-number-face))
f617db13 2319
be2cc788 2320 ;; And anything else is punctuation.
99fe6ef5 2321 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2322 '(0 mdw-punct-face)))))
99fe6ef5 2323
be2cc788 2324;; Define Python fontification styles.
99fe6ef5
MW
2325
2326(defun mdw-fontify-python ()
2327 (mdw-fontify-pythonic
2328 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2329 "del" "elif" "else" "except" "exec" "finally" "for"
2330 "from" "global" "if" "import" "in" "is" "lambda"
2331 "not" "or" "pass" "print" "raise" "return" "try"
2332 "while" "with" "yield")))
2333
2334(defun mdw-fontify-pyrex ()
2335 (mdw-fontify-pythonic
2336 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2337 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2338 "extern" "finally" "for" "from" "global" "if"
2339 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2340 "raise" "return" "struct" "try" "while" "with"
2341 "yield")))
f617db13 2342
6132bc01
MW
2343;;;--------------------------------------------------------------------------
2344;;; Icon programming style.
cc1980e1 2345
6132bc01 2346;; Icon indentation style.
cc1980e1
MW
2347
2348(setq icon-brace-offset 0
2349 icon-continued-brace-offset 0
2350 icon-continued-statement-offset 2
2351 icon-indent-level 2)
2352
6132bc01 2353;; Define Icon fontification style.
cc1980e1
MW
2354
2355(defun mdw-fontify-icon ()
2356
6132bc01 2357 ;; Miscellaneous fiddling.
cc1980e1
MW
2358 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2359
6132bc01 2360 ;; Now define fontification things.
cc1980e1
MW
2361 (make-local-variable 'font-lock-keywords)
2362 (let ((icon-keywords
2363 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2364 "end" "every" "fail" "global" "if" "initial"
2365 "invocable" "link" "local" "next" "not" "of"
2366 "procedure" "record" "repeat" "return" "static"
2367 "suspend" "then" "to" "until" "while"))
2368 (preprocessor-keywords
2369 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2370 "include" "line" "undef")))
2371 (setq font-lock-keywords
2372 (list
2373
6132bc01 2374 ;; Set up the keywords defined above.
cc1980e1
MW
2375 (list (concat "\\<\\(" icon-keywords "\\)\\>")
2376 '(0 font-lock-keyword-face))
2377
6132bc01 2378 ;; The things that Icon calls keywords.
cc1980e1
MW
2379 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2380
6132bc01 2381 ;; At least numbers are simpler than C.
cc1980e1
MW
2382 (list (concat "\\<[0-9]+"
2383 "\\([rR][0-9a-zA-Z]+\\|"
2384 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2385 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2386 '(0 mdw-number-face))
2387
6132bc01 2388 ;; Preprocessor.
cc1980e1
MW
2389 (list (concat "^[ \t]*$[ \t]*\\<\\("
2390 preprocessor-keywords
2391 "\\)\\>")
2392 '(0 font-lock-keyword-face))
2393
6132bc01 2394 ;; And anything else is punctuation.
cc1980e1 2395 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2396 '(0 mdw-punct-face))))))
cc1980e1 2397
6132bc01
MW
2398;;;--------------------------------------------------------------------------
2399;;; Assembler mode.
30c8a8fb
MW
2400
2401(defun mdw-fontify-asm ()
2402 (modify-syntax-entry ?' "\"")
2403 (modify-syntax-entry ?. "w")
9032280b 2404 (modify-syntax-entry ?\n ">")
30c8a8fb
MW
2405 (setf fill-prefix nil)
2406 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2407
227b2b2b
MW
2408(defun mdw-asm-set-comment ()
2409 (modify-syntax-entry ?; "."
2410 )
2411 (modify-syntax-entry asm-comment-char "<b")
2412 (setq comment-start (string asm-comment-char ? )))
2413(add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
2414(put 'asm-comment-char 'safe-local-variable 'characterp)
9032280b 2415
6132bc01
MW
2416;;;--------------------------------------------------------------------------
2417;;; TCL configuration.
f617db13
MW
2418
2419(defun mdw-fontify-tcl ()
2420 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2421 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
02109a0d 2422 (make-local-variable 'font-lock-keywords)
f617db13
MW
2423 (setq font-lock-keywords
2424 (list
f617db13
MW
2425 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2426 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2427 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2428 '(0 mdw-number-face))
2429 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2430 '(0 mdw-punct-face)))))
f617db13 2431
ad305d7e
MW
2432;;;--------------------------------------------------------------------------
2433;;; Dylan programming configuration.
2434
2435(defun mdw-fontify-dylan ()
2436
2437 (make-local-variable 'font-lock-keywords)
2438
2439 ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
2440 ;; hook, which undoes all of our configuration.
2441 (setq major-mode 'dylan-mode)
2442 (font-lock-set-defaults)
2443
2444 (let* ((word "[-_a-zA-Z!*@<>$%]+")
2445 (dylan-keywords (mdw-regexps
2446
2447 "C-address" "C-callable-wrapper" "C-function"
2448 "C-mapped-subtype" "C-pointer-type" "C-struct"
2449 "C-subtype" "C-union" "C-variable"
2450
2451 "above" "abstract" "afterwards" "all"
2452 "begin" "below" "block" "by"
2453 "case" "class" "cleanup" "constant" "create"
2454 "define" "domain"
2455 "else" "elseif" "end" "exception" "export"
2456 "finally" "for" "from" "function"
2457 "generic"
2458 "handler"
2459 "if" "in" "instance" "interface" "iterate"
2460 "keyed-by"
2461 "let" "library" "local"
2462 "macro" "method" "module"
2463 "otherwise"
2464 "profiling"
2465 "select" "slot" "subclass"
2466 "table" "then" "to"
2467 "unless" "until" "use"
2468 "variable" "virtual"
2469 "when" "while"))
2470 (sharp-keywords (mdw-regexps
2471 "all-keys" "key" "next" "rest" "include"
2472 "t" "f")))
2473 (setq font-lock-keywords
2474 (list (list (concat "\\<\\(" dylan-keywords
ce29694e 2475 "\\|" "with\\(out\\)?-" word
ad305d7e
MW
2476 "\\)\\>")
2477 '(0 font-lock-keyword-face))
ce29694e
MW
2478 (list (concat "\\<" word ":" "\\|"
2479 "#\\(" sharp-keywords "\\)\\>")
ad305d7e
MW
2480 '(0 font-lock-variable-name-face))
2481 (list (concat "\\("
2482 "\\([-+]\\|\\<\\)[0-9]+" "\\("
2483 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2484 "\\|" "/[0-9]+"
2485 "\\)"
2486 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2487 "\\|" "#b[01]+"
2488 "\\|" "#o[0-7]+"
2489 "\\|" "#x[0-9a-zA-Z]+"
2490 "\\)\\>")
2491 '(0 mdw-number-face))
2492 (list (concat "\\("
2493 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2494 "\\_<[-+*/=<>:&|]+\\_>"
2495 "\\)")
2e7c6a86 2496 '(0 mdw-punct-face))))))
ad305d7e 2497
7fce54c3
MW
2498;;;--------------------------------------------------------------------------
2499;;; Algol 68 configuration.
2500
2501(setq a68-indent-step 2)
2502
2503(defun mdw-fontify-algol-68 ()
2504
2505 ;; Fix up the syntax table.
2506 (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2507 (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2508 (modify-syntax-entry ch "." a68-mode-syntax-table))
2509
2510 (make-local-variable 'font-lock-keywords)
2511
2512 (let ((not-comment
2513 (let ((word "COMMENT"))
2514 (do ((regexp (concat "[^" (substring word 0 1) "]+")
2515 (concat regexp "\\|"
2516 (substring word 0 i)
2517 "[^" (substring word i (1+ i)) "]"))
2518 (i 1 (1+ i)))
2519 ((>= i (length word)) regexp)))))
2520 (setq font-lock-keywords
2521 (list (list (concat "\\<COMMENT\\>"
2522 "\\(" not-comment "\\)\\{0,5\\}"
2523 "\\(\\'\\|\\<COMMENT\\>\\)")
2524 '(0 font-lock-comment-face))
2525 (list (concat "\\<CO\\>"
2526 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2527 "\\($\\|\\<CO\\>\\)")
2528 '(0 font-lock-comment-face))
2529 (list "\\<[A-Z_]+\\>"
2530 '(0 font-lock-keyword-face))
2531 (list (concat "\\<"
2532 "[0-9]+"
2533 "\\(\\.[0-9]+\\)?"
2534 "\\([eE][-+]?[0-9]+\\)?"
2535 "\\>")
2536 '(0 mdw-number-face))
2537 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2e7c6a86 2538 '(0 mdw-punct-face))))))
7fce54c3 2539
6132bc01
MW
2540;;;--------------------------------------------------------------------------
2541;;; REXX configuration.
f617db13
MW
2542
2543(defun mdw-rexx-electric-* ()
2544 (interactive)
2545 (insert ?*)
2546 (rexx-indent-line))
2547
2548(defun mdw-rexx-indent-newline-indent ()
2549 (interactive)
2550 (rexx-indent-line)
2551 (if abbrev-mode (expand-abbrev))
2552 (newline-and-indent))
2553
2554(defun mdw-fontify-rexx ()
2555
6132bc01 2556 ;; Various bits of fiddling.
f617db13
MW
2557 (setq mdw-auto-indent nil)
2558 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2559 (local-set-key [?*] 'mdw-rexx-electric-*)
2560 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
e443a4cd 2561 '(?! ?? ?# ?@ ?$))
f617db13
MW
2562 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2563
6132bc01 2564 ;; Set up keywords and things for fontification.
f617db13
MW
2565 (make-local-variable 'font-lock-keywords-case-fold-search)
2566 (setq font-lock-keywords-case-fold-search t)
2567
2568 (setq rexx-indent 2)
2569 (setq rexx-end-indent rexx-indent)
f617db13
MW
2570 (setq rexx-cont-indent rexx-indent)
2571
02109a0d 2572 (make-local-variable 'font-lock-keywords)
f617db13 2573 (let ((rexx-keywords
8d6d55b9
MW
2574 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2575 "else" "end" "engineering" "exit" "expose" "for"
2576 "forever" "form" "fuzz" "if" "interpret" "iterate"
2577 "leave" "linein" "name" "nop" "numeric" "off" "on"
2578 "options" "otherwise" "parse" "procedure" "pull"
2579 "push" "queue" "return" "say" "select" "signal"
2580 "scientific" "source" "then" "trace" "to" "until"
2581 "upper" "value" "var" "version" "when" "while"
2582 "with"
2583
2584 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2585 "center" "center" "charin" "charout" "chars"
2586 "compare" "condition" "copies" "c2d" "c2x"
2587 "datatype" "date" "delstr" "delword" "d2c" "d2x"
2588 "errortext" "format" "fuzz" "insert" "lastpos"
2589 "left" "length" "lineout" "lines" "max" "min"
2590 "overlay" "pos" "queued" "random" "reverse" "right"
2591 "sign" "sourceline" "space" "stream" "strip"
2592 "substr" "subword" "symbol" "time" "translate"
2593 "trunc" "value" "verify" "word" "wordindex"
2594 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2595 "x2d")))
f617db13
MW
2596
2597 (setq font-lock-keywords
2598 (list
f617db13 2599
6132bc01 2600 ;; Set up the keywords defined above.
f617db13
MW
2601 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2602 '(0 font-lock-keyword-face))
2603
6132bc01 2604 ;; Fontify all symbols the same way.
f617db13
MW
2605 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2606 "[A-Za-z0-9.!?_#@$]+\\)")
2607 '(0 font-lock-variable-name-face))
2608
6132bc01 2609 ;; And everything else is punctuation.
f617db13 2610 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2611 '(0 mdw-punct-face))))))
f617db13 2612
6132bc01
MW
2613;;;--------------------------------------------------------------------------
2614;;; Standard ML programming style.
f617db13
MW
2615
2616(defun mdw-fontify-sml ()
2617
6132bc01 2618 ;; Make underscore an honorary letter.
f617db13
MW
2619 (modify-syntax-entry ?' "w")
2620
6132bc01 2621 ;; Set fill prefix.
f617db13
MW
2622 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2623
6132bc01 2624 ;; Now define fontification things.
02109a0d 2625 (make-local-variable 'font-lock-keywords)
f617db13 2626 (let ((sml-keywords
8d6d55b9
MW
2627 (mdw-regexps "abstype" "and" "andalso" "as"
2628 "case"
2629 "datatype" "do"
2630 "else" "end" "eqtype" "exception"
2631 "fn" "fun" "functor"
2632 "handle"
2633 "if" "in" "include" "infix" "infixr"
2634 "let" "local"
2635 "nonfix"
2636 "of" "op" "open" "orelse"
2637 "raise" "rec"
2638 "sharing" "sig" "signature" "struct" "structure"
2639 "then" "type"
2640 "val"
2641 "where" "while" "with" "withtype")))
f617db13
MW
2642
2643 (setq font-lock-keywords
2644 (list
f617db13 2645
6132bc01 2646 ;; Set up the keywords defined above.
f617db13
MW
2647 (list (concat "\\<\\(" sml-keywords "\\)\\>")
2648 '(0 font-lock-keyword-face))
2649
6132bc01 2650 ;; At least numbers are simpler than C.
f617db13
MW
2651 (list (concat "\\<\\(\\~\\|\\)"
2652 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
852cd5fb
MW
2653 "[wW][0-9]+\\)\\|"
2654 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2655 "\\([eE]\\(\\~\\|\\)"
2656 "[0-9]+\\|\\)\\)\\)")
f617db13
MW
2657 '(0 mdw-number-face))
2658
6132bc01 2659 ;; And anything else is punctuation.
f617db13 2660 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2661 '(0 mdw-punct-face))))))
f617db13 2662
6132bc01
MW
2663;;;--------------------------------------------------------------------------
2664;;; Haskell configuration.
f617db13
MW
2665
2666(defun mdw-fontify-haskell ()
2667
6132bc01 2668 ;; Fiddle with syntax table to get comments right.
5952a020
MW
2669 (modify-syntax-entry ?' "_")
2670 (modify-syntax-entry ?- ". 12")
f617db13
MW
2671 (modify-syntax-entry ?\n ">")
2672
4d90cf3d
MW
2673 ;; Make punctuation be punctuation
2674 (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2675 (do ((i 0 (1+ i)))
2676 ((>= i (length punct)))
2677 (modify-syntax-entry (aref punct i) ".")))
2678
6132bc01 2679 ;; Set fill prefix.
f617db13
MW
2680 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2681
6132bc01 2682 ;; Fiddle with fontification.
02109a0d 2683 (make-local-variable 'font-lock-keywords)
f617db13 2684 (let ((haskell-keywords
5952a020
MW
2685 (mdw-regexps "as"
2686 "case" "ccall" "class"
2687 "data" "default" "deriving" "do"
2688 "else" "exists"
2689 "forall" "foreign"
2690 "hiding"
2691 "if" "import" "in" "infix" "infixl" "infixr" "instance"
2692 "let"
2693 "mdo" "module"
2694 "newtype"
2695 "of"
2696 "proc"
2697 "qualified"
2698 "rec"
2699 "safe" "stdcall"
2700 "then" "type"
2701 "unsafe"
2702 "where"))
2703 (control-sequences
2704 (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2705 "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2706 "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2707 "SP" "STX" "SUB" "SYN" "US" "VT")))
f617db13
MW
2708
2709 (setq font-lock-keywords
2710 (list
5952a020
MW
2711 (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2712 "\\(-+}\\|-*\\'\\)"
2713 "\\|"
2714 "--.*$")
f617db13 2715 '(0 font-lock-comment-face))
5952a020 2716 (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
f617db13 2717 '(0 font-lock-keyword-face))
5952a020
MW
2718 (list (concat "'\\("
2719 "[^\\]"
2720 "\\|"
2721 "\\\\"
2722 "\\(" "[abfnrtv\\\"']" "\\|"
2723 "^" "\\(" control-sequences "\\|"
2724 "[]A-Z@[\\^_]" "\\)" "\\|"
2725 "\\|"
2726 "[0-9]+" "\\|"
2727 "[oO][0-7]+" "\\|"
2728 "[xX][0-9A-Fa-f]+"
2729 "\\)"
2730 "\\)'")
2731 '(0 font-lock-string-face))
2732 (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2733 '(0 font-lock-variable-name-face))
2734 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2735 "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
f617db13
MW
2736 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2737 '(0 mdw-number-face))
2738 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2739 '(0 mdw-punct-face))))))
f617db13 2740
6132bc01
MW
2741;;;--------------------------------------------------------------------------
2742;;; Erlang configuration.
2ded9493 2743
52941dec 2744(setq erlang-electric-commands nil)
2ded9493
MW
2745
2746(defun mdw-fontify-erlang ()
2747
6132bc01 2748 ;; Set fill prefix.
2ded9493
MW
2749 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2750
6132bc01 2751 ;; Fiddle with fontification.
2ded9493
MW
2752 (make-local-variable 'font-lock-keywords)
2753 (let ((erlang-keywords
2754 (mdw-regexps "after" "and" "andalso"
2755 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2756 "case" "catch" "cond"
2757 "div" "end" "fun" "if" "let" "not"
2758 "of" "or" "orelse"
2759 "query" "receive" "rem" "try" "when" "xor")))
2760
2761 (setq font-lock-keywords
2762 (list
2763 (list "%.*$"
2764 '(0 font-lock-comment-face))
2765 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2766 '(0 font-lock-keyword-face))
2767 (list (concat "^-\\sw+\\>")
2768 '(0 font-lock-keyword-face))
2769 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2770 '(0 mdw-number-face))
2771 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2772 '(0 mdw-punct-face))))))
2ded9493 2773
6132bc01
MW
2774;;;--------------------------------------------------------------------------
2775;;; Texinfo configuration.
f617db13
MW
2776
2777(defun mdw-fontify-texinfo ()
2778
6132bc01 2779 ;; Set fill prefix.
f617db13
MW
2780 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2781
6132bc01 2782 ;; Real fontification things.
02109a0d 2783 (make-local-variable 'font-lock-keywords)
f617db13
MW
2784 (setq font-lock-keywords
2785 (list
f617db13 2786
6132bc01 2787 ;; Environment names are keywords.
f617db13
MW
2788 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
2789 '(2 font-lock-keyword-face))
2790
6132bc01 2791 ;; Unmark escaped magic characters.
f617db13
MW
2792 (list "\\(@\\)\\([@{}]\\)"
2793 '(1 font-lock-keyword-face)
2794 '(2 font-lock-variable-name-face))
2795
6132bc01 2796 ;; Make sure we get comments properly.
f617db13
MW
2797 (list "@c\\(\\|omment\\)\\( .*\\)?$"
2798 '(0 font-lock-comment-face))
2799
6132bc01 2800 ;; Command names are keywords.
f617db13
MW
2801 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2802 '(0 font-lock-keyword-face))
2803
6132bc01 2804 ;; Fontify TeX special characters as punctuation.
f617db13 2805 (list "[{}]+"
2e7c6a86 2806 '(0 mdw-punct-face)))))
f617db13 2807
6132bc01
MW
2808;;;--------------------------------------------------------------------------
2809;;; TeX and LaTeX configuration.
f617db13
MW
2810
2811(defun mdw-fontify-tex ()
2812 (setq ispell-parser 'tex)
55f80fae 2813 (turn-on-reftex)
f617db13 2814
6132bc01 2815 ;; Don't make maths into a string.
f617db13
MW
2816 (modify-syntax-entry ?$ ".")
2817 (modify-syntax-entry ?$ "." font-lock-syntax-table)
2818 (local-set-key [?$] 'self-insert-command)
2819
df200ecd
MW
2820 ;; Make `tab' be useful, given that tab stops in TeX don't work well.
2821 (local-set-key "\C-i" 'indent-relative)
2822 (setq indent-tabs-mode nil)
2823
6132bc01 2824 ;; Set fill prefix.
f617db13
MW
2825 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2826
6132bc01 2827 ;; Real fontification things.
02109a0d 2828 (make-local-variable 'font-lock-keywords)
f617db13
MW
2829 (setq font-lock-keywords
2830 (list
f617db13 2831
6132bc01 2832 ;; Environment names are keywords.
f617db13
MW
2833 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2834 "{\\([^}\n]*\\)}")
2835 '(2 font-lock-keyword-face))
2836
6132bc01 2837 ;; Suspended environment names are keywords too.
f617db13
MW
2838 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2839 "{\\([^}\n]*\\)}")
2840 '(3 font-lock-keyword-face))
2841
6132bc01 2842 ;; Command names are keywords.
f617db13
MW
2843 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2844 '(0 font-lock-keyword-face))
2845
6132bc01 2846 ;; Handle @/.../ for italics.
f617db13 2847 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
852cd5fb
MW
2848 ;; '(1 font-lock-keyword-face)
2849 ;; '(3 font-lock-keyword-face))
f617db13 2850
6132bc01 2851 ;; Handle @*...* for boldness.
f617db13 2852 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
852cd5fb
MW
2853 ;; '(1 font-lock-keyword-face)
2854 ;; '(3 font-lock-keyword-face))
f617db13 2855
6132bc01 2856 ;; Handle @`...' for literal syntax things.
f617db13 2857 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
852cd5fb
MW
2858 ;; '(1 font-lock-keyword-face)
2859 ;; '(3 font-lock-keyword-face))
f617db13 2860
6132bc01 2861 ;; Handle @<...> for nonterminals.
f617db13 2862 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
852cd5fb
MW
2863 ;; '(1 font-lock-keyword-face)
2864 ;; '(3 font-lock-keyword-face))
f617db13 2865
6132bc01 2866 ;; Handle other @-commands.
f617db13 2867 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
852cd5fb 2868 ;; '(0 font-lock-keyword-face))
f617db13 2869
6132bc01 2870 ;; Make sure we get comments properly.
f617db13
MW
2871 (list "%.*"
2872 '(0 font-lock-comment-face))
2873
6132bc01 2874 ;; Fontify TeX special characters as punctuation.
f617db13 2875 (list "[$^_{}#&]"
2e7c6a86 2876 '(0 mdw-punct-face)))))
f617db13 2877
6132bc01
MW
2878;;;--------------------------------------------------------------------------
2879;;; SGML hacking.
f25cf300
MW
2880
2881(defun mdw-sgml-mode ()
2882 (interactive)
2883 (sgml-mode)
2884 (mdw-standard-fill-prefix "")
8a425bd7 2885 (make-local-variable 'sgml-delimiters)
f25cf300
MW
2886 (setq sgml-delimiters
2887 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2888 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2889 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2890 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2891 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2892 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2893 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2894 "NULL" ""))
2895 (setq major-mode 'mdw-sgml-mode)
2896 (setq mode-name "[mdw] SGML")
2897 (run-hooks 'mdw-sgml-mode-hook))
6cb52f8b
MW
2898
2899;;;--------------------------------------------------------------------------
2900;;; Configuration files.
2901
2902(defvar mdw-conf-quote-normal nil
2903 "*Control syntax category of quote characters `\"' and `''.
2904If this is `t', consider quote characters to be normal
2905punctuation, as for `conf-quote-normal'. If this is `nil' then
2906leave quote characters as quotes. If this is a list, then
2907consider the quote characters in the list to be normal
2908punctuation. If this is a single quote character, then consider
2909that character only to be normal punctuation.")
2910(defun mdw-conf-quote-normal-acceptable-value-p (value)
2911 "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2912 (or (booleanp value)
2913 (every (lambda (v) (memq v '(?\" ?')))
2914 (if (listp value) value (list value)))))
18bb0f77
MW
2915(put 'mdw-conf-quote-normal 'safe-local-variable
2916 'mdw-conf-quote-normal-acceptable-value-p)
6cb52f8b
MW
2917
2918(defun mdw-fix-up-quote ()
2919 "Apply the setting of `mdw-conf-quote-normal'."
2920 (let ((flag mdw-conf-quote-normal))
2921 (cond ((eq flag t)
2922 (conf-quote-normal t))
2923 ((not flag)
2924 nil)
2925 (t
2926 (let ((table (copy-syntax-table (syntax-table))))
2927 (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2928 (if (listp flag) flag (list flag)))
2929 (set-syntax-table table)
2930 (and font-lock-mode (font-lock-fontify-buffer)))))))
18bb0f77 2931(add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
f25cf300 2932
6132bc01
MW
2933;;;--------------------------------------------------------------------------
2934;;; Shell scripts.
f617db13
MW
2935
2936(defun mdw-setup-sh-script-mode ()
2937
6132bc01 2938 ;; Fetch the shell interpreter's name.
f617db13
MW
2939 (let ((shell-name sh-shell-file))
2940
6132bc01 2941 ;; Try reading the hash-bang line.
f617db13
MW
2942 (save-excursion
2943 (goto-char (point-min))
2944 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2945 (setq shell-name (match-string 1))))
2946
6132bc01 2947 ;; Now try to set the shell.
f617db13
MW
2948 ;;
2949 ;; Don't let `sh-set-shell' bugger up my script.
f617db13
MW
2950 (let ((executable-set-magic #'(lambda (s &rest r) s)))
2951 (sh-set-shell shell-name)))
2952
10c51541
MW
2953 ;; Don't insert here-document scaffolding automatically.
2954 (local-set-key "<" 'self-insert-command)
2955
6132bc01 2956 ;; Now enable my keys and the fontification.
f617db13
MW
2957 (mdw-misc-mode-config)
2958
6132bc01 2959 ;; Set the indentation level correctly.
f617db13
MW
2960 (setq sh-indentation 2)
2961 (setq sh-basic-offset 2))
2962
070c1dca
MW
2963(setq sh-shell-file "/bin/sh")
2964
6d6e095a
MW
2965;; Awful hacking to override the shell detection for particular scripts.
2966(defmacro define-custom-shell-mode (name shell)
2967 `(defun ,name ()
2968 (interactive)
2969 (set (make-local-variable 'sh-shell-file) ,shell)
2970 (sh-mode)))
2971(define-custom-shell-mode bash-mode "/bin/bash")
2972(define-custom-shell-mode rc-mode "/usr/bin/rc")
2973(put 'sh-shell-file 'permanent-local t)
2974
2975;; Hack the rc syntax table. Backquotes aren't paired in rc.
2976(eval-after-load "sh-script"
2977 '(or (assq 'rc sh-mode-syntax-table-input)
2978 (let ((frag '(nil
2979 ?# "<"
2980 ?\n ">#"
2981 ?\" "\"\""
2982 ?\' "\"\'"
2983 ?$ "'"
2984 ?\` "."
2985 ?! "_"
2986 ?% "_"
2987 ?. "_"
2988 ?^ "_"
2989 ?~ "_"
2990 ?, "_"
2991 ?= "."
2992 ?< "."
2993 ?> "."))
2994 (assoc (assq 'rc sh-mode-syntax-table-input)))
2995 (if assoc
2996 (rplacd assoc frag)
2997 (setq sh-mode-syntax-table-input
2998 (cons (cons 'rc frag)
2999 sh-mode-syntax-table-input))))))
3000
092f0a38
MW
3001;;;--------------------------------------------------------------------------
3002;;; Emacs shell mode.
3003
3004(defun mdw-eshell-prompt ()
3005 (let ((left "[") (right "]"))
3006 (when (= (user-uid) 0)
3007 (setq left "«" right "»"))
3008 (concat left
3009 (save-match-data
3010 (replace-regexp-in-string "\\..*$" "" (system-name)))
3011 " "
2d8b2924
MW
3012 (let* ((pwd (eshell/pwd)) (npwd (length pwd))
3013 (home (expand-file-name "~")) (nhome (length home)))
3014 (if (and (>= npwd nhome)
3015 (or (= nhome npwd)
5801e199
MW
3016 (= (elt pwd nhome) ?/))
3017 (string= (substring pwd 0 nhome) home))
2d8b2924
MW
3018 (concat "~" (substring pwd (length home)))
3019 pwd))
092f0a38
MW
3020 right)))
3021(setq eshell-prompt-function 'mdw-eshell-prompt)
ac4ae7cd 3022(setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
092f0a38 3023
2d8b2924
MW
3024(defun eshell/e (file) (find-file file) nil)
3025(defun eshell/ee (file) (find-file-other-window file) nil)
3026(defun eshell/w3m (url) (w3m-goto-url url) nil)
415a23dd 3027
092f0a38
MW
3028(mdw-define-face eshell-prompt (t :weight bold))
3029(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
3030(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
3031(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
3032(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
3033(mdw-define-face eshell-ls-executable (t :weight bold))
3034(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
3035(mdw-define-face eshell-ls-readonly (t nil))
3036(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
3037
6132bc01
MW
3038;;;--------------------------------------------------------------------------
3039;;; Messages-file mode.
f617db13 3040
4bb22eea 3041(defun messages-mode-guts ()
f617db13
MW
3042 (setq messages-mode-syntax-table (make-syntax-table))
3043 (set-syntax-table messages-mode-syntax-table)
f617db13
MW
3044 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
3045 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
3046 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
3047 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
3048 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
3049 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
3050 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
3051 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
3052 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
3053 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
3054 (make-local-variable 'comment-start)
3055 (make-local-variable 'comment-end)
3056 (make-local-variable 'indent-line-function)
3057 (setq indent-line-function 'indent-relative)
3058 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3059 (make-local-variable 'font-lock-defaults)
4bb22eea 3060 (make-local-variable 'messages-mode-keywords)
f617db13 3061 (let ((keywords
8d6d55b9
MW
3062 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
3063 "export" "enum" "fixed-octetstring" "flags"
3064 "harmless" "map" "nested" "optional"
3065 "optional-tagged" "package" "primitive"
3066 "primitive-nullfree" "relaxed[ \t]+enum"
3067 "set" "table" "tagged-optional" "union"
3068 "variadic" "vector" "version" "version-tag")))
4bb22eea 3069 (setq messages-mode-keywords
f617db13
MW
3070 (list
3071 (list (concat "\\<\\(" keywords "\\)\\>:")
3072 '(0 font-lock-keyword-face))
3073 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
3074 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
3075 (0 font-lock-variable-name-face))
3076 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
3077 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3078 (0 mdw-punct-face)))))
3079 (setq font-lock-defaults
4bb22eea 3080 '(messages-mode-keywords nil nil nil nil))
f617db13
MW
3081 (run-hooks 'messages-file-hook))
3082
3083(defun messages-mode ()
3084 (interactive)
3085 (fundamental-mode)
3086 (setq major-mode 'messages-mode)
3087 (setq mode-name "Messages")
4bb22eea 3088 (messages-mode-guts)
f617db13
MW
3089 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3090 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3091 (setq comment-start "# ")
3092 (setq comment-end "")
f617db13
MW
3093 (run-hooks 'messages-mode-hook))
3094
3095(defun cpp-messages-mode ()
3096 (interactive)
3097 (fundamental-mode)
3098 (setq major-mode 'cpp-messages-mode)
3099 (setq mode-name "CPP Messages")
4bb22eea 3100 (messages-mode-guts)
f617db13
MW
3101 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3102 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3103 (setq comment-start "/* ")
3104 (setq comment-end " */")
3105 (let ((preprocessor-keywords
8d6d55b9
MW
3106 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3107 "ident" "if" "ifdef" "ifndef" "import" "include"
3108 "line" "pragma" "unassert" "undef" "warning")))
4bb22eea 3109 (setq messages-mode-keywords
f617db13
MW
3110 (append (list (list (concat "^[ \t]*\\#[ \t]*"
3111 "\\(include\\|import\\)"
3112 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3113 '(2 font-lock-string-face))
3114 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3115 preprocessor-keywords
852cd5fb 3116 "\\)\\>\\|[0-9]+\\|$\\)\\)")
f617db13 3117 '(1 font-lock-keyword-face)))
4bb22eea 3118 messages-mode-keywords)))
297d60aa 3119 (run-hooks 'cpp-messages-mode-hook))
f617db13 3120
297d60aa
MW
3121(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3122(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
f617db13
MW
3123; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3124
6132bc01
MW
3125;;;--------------------------------------------------------------------------
3126;;; Messages-file mode.
f617db13
MW
3127
3128(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3129 "Face to use for subsittution directives.")
3130(make-face 'mallow-driver-substitution-face)
3131(defvar mallow-driver-text-face 'mallow-driver-text-face
3132 "Face to use for body text.")
3133(make-face 'mallow-driver-text-face)
3134
3135(defun mallow-driver-mode ()
3136 (interactive)
3137 (fundamental-mode)
3138 (setq major-mode 'mallow-driver-mode)
3139 (setq mode-name "Mallow driver")
3140 (setq mallow-driver-mode-syntax-table (make-syntax-table))
3141 (set-syntax-table mallow-driver-mode-syntax-table)
3142 (make-local-variable 'comment-start)
3143 (make-local-variable 'comment-end)
3144 (make-local-variable 'indent-line-function)
3145 (setq indent-line-function 'indent-relative)
3146 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3147 (make-local-variable 'font-lock-defaults)
3148 (make-local-variable 'mallow-driver-mode-keywords)
3149 (let ((keywords
8d6d55b9
MW
3150 (mdw-regexps "each" "divert" "file" "if"
3151 "perl" "set" "string" "type" "write")))
f617db13
MW
3152 (setq mallow-driver-mode-keywords
3153 (list
3154 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3155 '(0 font-lock-keyword-face))
3156 (list "^%\\s *\\(#.*\\|\\)$"
3157 '(0 font-lock-comment-face))
3158 (list "^%"
3159 '(0 font-lock-keyword-face))
3160 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3161 (list "\\${[^}]*}"
3162 '(0 mallow-driver-substitution-face t)))))
3163 (setq font-lock-defaults
3164 '(mallow-driver-mode-keywords nil nil nil nil))
3165 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3166 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3167 (setq comment-start "%# ")
3168 (setq comment-end "")
f617db13
MW
3169 (run-hooks 'mallow-driver-mode-hook))
3170
3171(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3172
6132bc01
MW
3173;;;--------------------------------------------------------------------------
3174;;; NFast debugs.
f617db13
MW
3175
3176(defun nfast-debug-mode ()
3177 (interactive)
3178 (fundamental-mode)
3179 (setq major-mode 'nfast-debug-mode)
3180 (setq mode-name "NFast debug")
3181 (setq messages-mode-syntax-table (make-syntax-table))
3182 (set-syntax-table messages-mode-syntax-table)
3183 (make-local-variable 'font-lock-defaults)
3184 (make-local-variable 'nfast-debug-mode-keywords)
3185 (setq truncate-lines t)
3186 (setq nfast-debug-mode-keywords
3187 (list
3188 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3189 (0 font-lock-keyword-face))
3190 (list (concat "^[ \t]+\\(\\("
3191 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3192 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3193 "[ \t]+\\)*"
3194 "[0-9a-fA-F]+\\)[ \t]*$")
3195 '(0 mdw-number-face))
3196 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3197 (1 font-lock-keyword-face))
3198 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3199 (1 font-lock-warning-face))
3200 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3201 (1 nil))
3202 (list (concat "^[ \t]+\\.cmd=[ \t]+"
3203 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3204 '(1 font-lock-keyword-face))
3205 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3206 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3207 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3208 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3209 (setq font-lock-defaults
3210 '(nfast-debug-mode-keywords nil nil nil nil))
f617db13
MW
3211 (run-hooks 'nfast-debug-mode-hook))
3212
6132bc01
MW
3213;;;--------------------------------------------------------------------------
3214;;; Other languages.
f617db13 3215
6132bc01 3216;; Smalltalk.
f617db13
MW
3217
3218(defun mdw-setup-smalltalk ()
3219 (and mdw-auto-indent
3220 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
8a425bd7 3221 (make-local-variable 'mdw-auto-indent)
f617db13
MW
3222 (setq mdw-auto-indent nil)
3223 (local-set-key "\C-i" 'smalltalk-reindent))
3224
3225(defun mdw-fontify-smalltalk ()
02109a0d 3226 (make-local-variable 'font-lock-keywords)
f617db13
MW
3227 (setq font-lock-keywords
3228 (list
f617db13
MW
3229 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3230 '(0 font-lock-keyword-face))
3231 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3232 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3233 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3234 '(0 mdw-number-face))
3235 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3236 '(0 mdw-punct-face)))))
f617db13 3237
6132bc01 3238;; Lispy languages.
f617db13 3239
873d87df
MW
3240;; Unpleasant bodge.
3241(unless (boundp 'slime-repl-mode-map)
3242 (setq slime-repl-mode-map (make-sparse-keymap)))
3243
f617db13
MW
3244(defun mdw-indent-newline-and-indent ()
3245 (interactive)
3246 (indent-for-tab-command)
3247 (newline-and-indent))
3248
3249(eval-after-load "cl-indent"
3250 '(progn
3251 (mapc #'(lambda (pair)
3252 (put (car pair)
3253 'common-lisp-indent-function
3254 (cdr pair)))
3255 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3256 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3257
3258(defun mdw-common-lisp-indent ()
8a425bd7 3259 (make-local-variable 'lisp-indent-function)
f617db13
MW
3260 (setq lisp-indent-function 'common-lisp-indent-function))
3261
037be6de 3262(setq lisp-simple-loop-indentation 2
95575d1f
MW
3263 lisp-loop-keyword-indentation 6
3264 lisp-loop-forms-indentation 6)
3265
f617db13
MW
3266(defun mdw-fontify-lispy ()
3267
6132bc01 3268 ;; Set fill prefix.
f617db13
MW
3269 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3270
6132bc01 3271 ;; Not much fontification needed.
02109a0d 3272 (make-local-variable 'font-lock-keywords)
f617db13 3273 (setq font-lock-keywords
2287504f
MW
3274 (list (list (concat "\\("
3275 "\\_<[-+]?"
3276 "\\(" "[0-9]+/[0-9]+"
3277 "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3278 "\\.[0-9]+" "\\)"
3279 "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3280 "\\)"
3281 "\\|"
3282 "#"
3283 "\\(" "x" "[-+]?"
3284 "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3285 "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3286 "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3287 "\\|" "[0-9]+" "r" "[-+]?"
3288 "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3289 "\\)"
3290 "\\)\\_>")
3291 '(0 mdw-number-face))
3292 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3293 '(0 mdw-punct-face)))))
f617db13
MW
3294
3295(defun comint-send-and-indent ()
3296 (interactive)
3297 (comint-send-input)
3298 (and mdw-auto-indent
3299 (indent-for-tab-command)))
3300
ec007bea 3301(defun mdw-setup-m4 ()
ed5d93a4
MW
3302
3303 ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
3304 ;; annoying: fix it.
3305 (modify-syntax-entry ?{ "(")
3306 (modify-syntax-entry ?} ")")
3307
3308 ;; Fill prefix.
ec007bea
MW
3309 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3310
6132bc01
MW
3311;;;--------------------------------------------------------------------------
3312;;; Text mode.
f617db13
MW
3313
3314(defun mdw-text-mode ()
3315 (setq fill-column 72)
3316 (flyspell-mode t)
3317 (mdw-standard-fill-prefix
c7a8da49 3318 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
f617db13
MW
3319 (auto-fill-mode 1))
3320
6132bc01 3321;;;--------------------------------------------------------------------------
faf2cef7 3322;;; Outline and hide/show modes.
5de5db48
MW
3323
3324(defun mdw-outline-collapse-all ()
3325 "Completely collapse everything in the entire buffer."
3326 (interactive)
3327 (save-excursion
3328 (goto-char (point-min))
3329 (while (< (point) (point-max))
3330 (hide-subtree)
3331 (forward-line))))
3332
faf2cef7
MW
3333(setq hs-hide-comments-when-hiding-all nil)
3334
b200af26 3335(defadvice hs-hide-all (after hide-first-comment activate)
941c29ba 3336 (save-excursion (hs-hide-initial-comment-block)))
b200af26 3337
6132bc01
MW
3338;;;--------------------------------------------------------------------------
3339;;; Shell mode.
f617db13
MW
3340
3341(defun mdw-sh-mode-setup ()
3342 (local-set-key [?\C-a] 'comint-bol)
3343 (add-hook 'comint-output-filter-functions
3344 'comint-watch-for-password-prompt))
3345
3346(defun mdw-term-mode-setup ()
3d9147ea 3347 (setq term-prompt-regexp shell-prompt-pattern)
f617db13
MW
3348 (make-local-variable 'mouse-yank-at-point)
3349 (make-local-variable 'transient-mark-mode)
3350 (setq mouse-yank-at-point t)
f617db13
MW
3351 (auto-fill-mode -1)
3352 (setq tab-width 8))
3353
3d9147ea
MW
3354(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3355(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
3356(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3357(defun term-send-meta-meta-something ()
3358 (interactive)
3359 (term-send-raw-string "\e\e")
3360 (term-send-raw))
3361(eval-after-load 'term
3362 '(progn
3363 (define-key term-raw-map [?\e ?\e] nil)
3364 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3365 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3366 (define-key term-raw-map [M-right] 'term-send-meta-right)
3367 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3368 (define-key term-raw-map [M-left] 'term-send-meta-left)
3369 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3370
c4434c20
MW
3371(defadvice term-exec (before program-args-list compile activate)
3372 "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3373This allows you to pass a list of arguments through `ansi-term'."
3374 (let ((program (ad-get-arg 2)))
3375 (if (listp program)
3376 (progn
3377 (ad-set-arg 2 (car program))
3378 (ad-set-arg 4 (cdr program))))))
3379
3380(defun ssh (host)
3381 "Open a terminal containing an ssh session to the HOST."
3382 (interactive "sHost: ")
3383 (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3384
5aa1b95f
MW
3385(defvar git-grep-command
3386 "env PAGER=cat git grep --no-color -nH -e "
3387 "*The default command for \\[git-grep].")
3388
3389(defvar git-grep-history nil)
3390
3391(defun git-grep (command-args)
3392 "Run `git grep' with user-specified args and collect output in a buffer."
3393 (interactive
3394 (list (read-shell-command "Run git grep (like this): "
3395 git-grep-command 'git-grep-history)))
3396 (grep command-args))
3397
e07e3320
MW
3398;;;--------------------------------------------------------------------------
3399;;; Inferior Emacs Lisp.
3400
3401(setq comint-prompt-read-only t)
3402
3403(eval-after-load "comint"
3404 '(progn
3405 (define-key comint-mode-map "\C-w" 'comint-kill-region)
3406 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3407
3408(eval-after-load "ielm"
3409 '(progn
3410 (define-key ielm-map "\C-w" 'comint-kill-region)
3411 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3412
f617db13
MW
3413;;;----- That's all, folks --------------------------------------------------
3414
3415(provide 'dot-emacs)