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