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