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