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