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