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