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