dot/emacs, el/dot-emacs.el: Set up Viper mode.
[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 1680
d54399be
MW
1681(mdw-define-face viper-minibuffer-emacs (t nil))
1682(mdw-define-face viper-minibuffer-insert (t nil))
1683(mdw-define-face viper-minibuffer-vi (t nil))
1684(mdw-define-face viper-replace-overlay
1685 (((min-colors 64)) :background "darkred")
1686 (((class color)) :background "red")
1687 (t :inverse-video t))
1688(mdw-define-face viper-search (t :inherit isearch))
1689
1e7a9479
MW
1690(mdw-define-face holiday-face
1691 (t :background "red"))
1692(mdw-define-face calendar-today-face
1693 (t :foreground "yellow" :weight bold))
1694
1695(mdw-define-face comint-highlight-prompt
1696 (t :weight bold))
5fd055c2
MW
1697(mdw-define-face comint-highlight-input
1698 (t nil))
1e7a9479 1699
13c19c5d
MW
1700(mdw-define-face Man-underline
1701 (((type tty)) :underline t)
1702 (t :slant italic))
1703
2e97e639
MW
1704(mdw-define-face ido-subdir
1705 (t :foreground "cyan" :weight bold))
1706
e0e2aca3
MW
1707(mdw-define-face dired-directory
1708 (t :foreground "cyan" :weight bold))
1709(mdw-define-face dired-symlink
1710 (t :foreground "cyan"))
1711(mdw-define-face dired-perm-write
1712 (t nil))
1713
1e7a9479 1714(mdw-define-face trailing-whitespace
db10ce0a
MW
1715 (((class color)) :background "red")
1716 (t :inverse-video t))
33aa287b
MW
1717(mdw-define-face whitespace-line
1718 (((class color)) :background "darkred")
a52bc3ca 1719 (t :inverse-video t))
1e7a9479 1720(mdw-define-face mdw-punct-face
fefae026
MW
1721 (((min-colors 64)) :foreground "burlywood2")
1722 (((class color)) :foreground "yellow"))
1e7a9479
MW
1723(mdw-define-face mdw-number-face
1724 (t :foreground "yellow"))
52bcde59 1725(mdw-define-face mdw-trivial-face)
1e7a9479 1726(mdw-define-face font-lock-function-name-face
c383eb8a 1727 (t :slant italic))
1e7a9479
MW
1728(mdw-define-face font-lock-keyword-face
1729 (t :weight bold))
1730(mdw-define-face font-lock-constant-face
1731 (t :slant italic))
1732(mdw-define-face font-lock-builtin-face
1733 (t :weight bold))
07965a39
MW
1734(mdw-define-face font-lock-type-face
1735 (t :weight bold :slant italic))
1e7a9479
MW
1736(mdw-define-face font-lock-reference-face
1737 (t :weight bold))
1738(mdw-define-face font-lock-variable-name-face
1739 (t :slant italic))
1740(mdw-define-face font-lock-comment-delimiter-face
fefae026
MW
1741 (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1742 (((class color)) :foreground "green")
1743 (t :weight bold))
1e7a9479 1744(mdw-define-face font-lock-comment-face
fefae026
MW
1745 (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1746 (((class color)) :foreground "green")
1747 (t :weight bold))
1e7a9479 1748(mdw-define-face font-lock-string-face
fefae026
MW
1749 (((min-colors 64)) :foreground "SkyBlue1")
1750 (((class color)) :foreground "cyan")
1751 (t :weight bold))
898c7efb 1752
1e7a9479
MW
1753(mdw-define-face message-separator
1754 (t :background "red" :foreground "white" :weight bold))
1755(mdw-define-face message-cited-text
1756 (default :slant italic)
fefae026
MW
1757 (((min-colors 64)) :foreground "SkyBlue1")
1758 (((class color)) :foreground "cyan"))
1e7a9479 1759(mdw-define-face message-header-cc
4790fcb7 1760 (default :slant italic)
fefae026
MW
1761 (((min-colors 64)) :foreground "SeaGreen1")
1762 (((class color)) :foreground "green"))
1e7a9479 1763(mdw-define-face message-header-newsgroups
4790fcb7 1764 (default :slant italic)
fefae026
MW
1765 (((min-colors 64)) :foreground "SeaGreen1")
1766 (((class color)) :foreground "green"))
1e7a9479 1767(mdw-define-face message-header-subject
fefae026
MW
1768 (((min-colors 64)) :foreground "SeaGreen1")
1769 (((class color)) :foreground "green"))
1e7a9479 1770(mdw-define-face message-header-to
fefae026
MW
1771 (((min-colors 64)) :foreground "SeaGreen1")
1772 (((class color)) :foreground "green"))
1e7a9479 1773(mdw-define-face message-header-xheader
4790fcb7 1774 (default :slant italic)
fefae026
MW
1775 (((min-colors 64)) :foreground "SeaGreen1")
1776 (((class color)) :foreground "green"))
1e7a9479 1777(mdw-define-face message-header-other
4790fcb7 1778 (default :slant italic)
fefae026
MW
1779 (((min-colors 64)) :foreground "SeaGreen1")
1780 (((class color)) :foreground "green"))
1e7a9479 1781(mdw-define-face message-header-name
4790fcb7 1782 (default :weight bold)
fefae026
MW
1783 (((min-colors 64)) :foreground "SeaGreen1")
1784 (((class color)) :foreground "green"))
4790fcb7 1785
69498691
MW
1786(mdw-define-face which-func
1787 (t nil))
1e7a9479 1788
4790fcb7
MW
1789(mdw-define-face gnus-header-name
1790 (default :weight bold)
fefae026
MW
1791 (((min-colors 64)) :foreground "SeaGreen1")
1792 (((class color)) :foreground "green"))
4790fcb7 1793(mdw-define-face gnus-header-subject
fefae026
MW
1794 (((min-colors 64)) :foreground "SeaGreen1")
1795 (((class color)) :foreground "green"))
4790fcb7 1796(mdw-define-face gnus-header-from
fefae026
MW
1797 (((min-colors 64)) :foreground "SeaGreen1")
1798 (((class color)) :foreground "green"))
4790fcb7 1799(mdw-define-face gnus-header-to
fefae026
MW
1800 (((min-colors 64)) :foreground "SeaGreen1")
1801 (((class color)) :foreground "green"))
4790fcb7
MW
1802(mdw-define-face gnus-header-content
1803 (default :slant italic)
fefae026
MW
1804 (((min-colors 64)) :foreground "SeaGreen1")
1805 (((class color)) :foreground "green"))
4790fcb7
MW
1806
1807(mdw-define-face gnus-cite-1
fefae026
MW
1808 (((min-colors 64)) :foreground "SkyBlue1")
1809 (((class color)) :foreground "cyan"))
4790fcb7 1810(mdw-define-face gnus-cite-2
fefae026
MW
1811 (((min-colors 64)) :foreground "RoyalBlue2")
1812 (((class color)) :foreground "blue"))
4790fcb7 1813(mdw-define-face gnus-cite-3
fefae026
MW
1814 (((min-colors 64)) :foreground "MediumOrchid")
1815 (((class color)) :foreground "magenta"))
4790fcb7 1816(mdw-define-face gnus-cite-4
fefae026
MW
1817 (((min-colors 64)) :foreground "firebrick2")
1818 (((class color)) :foreground "red"))
4790fcb7 1819(mdw-define-face gnus-cite-5
fefae026
MW
1820 (((min-colors 64)) :foreground "burlywood2")
1821 (((class color)) :foreground "yellow"))
4790fcb7 1822(mdw-define-face gnus-cite-6
fefae026
MW
1823 (((min-colors 64)) :foreground "SeaGreen1")
1824 (((class color)) :foreground "green"))
4790fcb7 1825(mdw-define-face gnus-cite-7
fefae026
MW
1826 (((min-colors 64)) :foreground "SlateBlue1")
1827 (((class color)) :foreground "cyan"))
4790fcb7 1828(mdw-define-face gnus-cite-8
fefae026
MW
1829 (((min-colors 64)) :foreground "RoyalBlue2")
1830 (((class color)) :foreground "blue"))
4790fcb7 1831(mdw-define-face gnus-cite-9
fefae026
MW
1832 (((min-colors 64)) :foreground "purple2")
1833 (((class color)) :foreground "magenta"))
4790fcb7 1834(mdw-define-face gnus-cite-10
fefae026
MW
1835 (((min-colors 64)) :foreground "DarkOrange2")
1836 (((class color)) :foreground "red"))
4790fcb7
MW
1837(mdw-define-face gnus-cite-11
1838 (t :foreground "grey"))
1839
b911d2f6
MW
1840(mdw-define-face gnus-emphasis-underline
1841 (((type tty)) :underline t)
1842 (t :slant italic))
1843
2f238de8
MW
1844(mdw-define-face diff-header
1845 (t nil))
1e7a9479
MW
1846(mdw-define-face diff-index
1847 (t :weight bold))
1848(mdw-define-face diff-file-header
1849 (t :weight bold))
1850(mdw-define-face diff-hunk-header
fefae026
MW
1851 (((min-colors 64)) :foreground "SkyBlue1")
1852 (((class color)) :foreground "cyan"))
1e7a9479 1853(mdw-define-face diff-function
fefae026
MW
1854 (default :weight bold)
1855 (((min-colors 64)) :foreground "SkyBlue1")
1856 (((class color)) :foreground "cyan"))
1e7a9479 1857(mdw-define-face diff-header
fefae026 1858 (((min-colors 64)) :background "grey10"))
1e7a9479 1859(mdw-define-face diff-added
fefae026 1860 (((class color)) :foreground "green"))
1e7a9479 1861(mdw-define-face diff-removed
fefae026 1862 (((class color)) :foreground "red"))
5fd055c2
MW
1863(mdw-define-face diff-context
1864 (t nil))
2f238de8 1865(mdw-define-face diff-refine-change
fefae026 1866 (((min-colors 64)) :background "RoyalBlue4")
b31f422b 1867 (t :underline t))
5f454d3e 1868(mdw-define-face diff-refine-removed
fefae026 1869 (((min-colors 64)) :background "#500")
5f454d3e
MW
1870 (t :underline t))
1871(mdw-define-face diff-refine-added
fefae026 1872 (((min-colors 64)) :background "#050")
5f454d3e 1873 (t :underline t))
1e7a9479 1874
a62d0541
MW
1875(setq ediff-force-faces t)
1876(mdw-define-face ediff-current-diff-A
fefae026
MW
1877 (((min-colors 64)) :background "darkred")
1878 (((class color)) :background "red")
a62d0541
MW
1879 (t :inverse-video t))
1880(mdw-define-face ediff-fine-diff-A
fefae026
MW
1881 (((min-colors 64)) :background "red3")
1882 (((class color)) :inverse-video t)
a62d0541
MW
1883 (t :inverse-video nil))
1884(mdw-define-face ediff-even-diff-A
fefae026 1885 (((min-colors 64)) :background "#300"))
a62d0541 1886(mdw-define-face ediff-odd-diff-A
fefae026 1887 (((min-colors 64)) :background "#300"))
a62d0541 1888(mdw-define-face ediff-current-diff-B
fefae026
MW
1889 (((min-colors 64)) :background "darkgreen")
1890 (((class color)) :background "magenta")
a62d0541
MW
1891 (t :inverse-video t))
1892(mdw-define-face ediff-fine-diff-B
fefae026
MW
1893 (((min-colors 64)) :background "green4")
1894 (((class color)) :inverse-video t)
a62d0541
MW
1895 (t :inverse-video nil))
1896(mdw-define-face ediff-even-diff-B
fefae026 1897 (((min-colors 64)) :background "#020"))
a62d0541 1898(mdw-define-face ediff-odd-diff-B
fefae026 1899 (((min-colors 64)) :background "#020"))
a62d0541 1900(mdw-define-face ediff-current-diff-C
fefae026
MW
1901 (((min-colors 64)) :background "darkblue")
1902 (((class color)) :background "blue")
a62d0541
MW
1903 (t :inverse-video t))
1904(mdw-define-face ediff-fine-diff-C
fefae026
MW
1905 (((min-colors 64)) :background "blue1")
1906 (((class color)) :inverse-video t)
a62d0541
MW
1907 (t :inverse-video nil))
1908(mdw-define-face ediff-even-diff-C
fefae026 1909 (((min-colors 64)) :background "#004"))
a62d0541 1910(mdw-define-face ediff-odd-diff-C
fefae026 1911 (((min-colors 64)) :background "#004"))
a62d0541 1912(mdw-define-face ediff-current-diff-Ancestor
fefae026
MW
1913 (((min-colors 64)) :background "#630")
1914 (((class color)) :background "blue")
a62d0541
MW
1915 (t :inverse-video t))
1916(mdw-define-face ediff-even-diff-Ancestor
fefae026 1917 (((min-colors 64)) :background "#320"))
a62d0541 1918(mdw-define-face ediff-odd-diff-Ancestor
fefae026 1919 (((min-colors 64)) :background "#320"))
a62d0541 1920
53f93f0d 1921(mdw-define-face magit-hash
fefae026
MW
1922 (((min-colors 64)) :foreground "grey40")
1923 (((class color)) :foreground "blue"))
53f93f0d 1924(mdw-define-face magit-diff-hunk-heading
fefae026
MW
1925 (((min-colors 64)) :foreground "grey70" :background "grey25")
1926 (((class color)) :foreground "yellow"))
53f93f0d 1927(mdw-define-face magit-diff-hunk-heading-highlight
fefae026
MW
1928 (((min-colors 64)) :foreground "grey70" :background "grey35")
1929 (((class color)) :foreground "yellow" :background "blue"))
53f93f0d 1930(mdw-define-face magit-diff-added
fefae026
MW
1931 (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
1932 (((class color)) :foreground "green"))
53f93f0d 1933(mdw-define-face magit-diff-added-highlight
fefae026
MW
1934 (((min-colors 64)) :foreground "#cceecc" :background "#336633")
1935 (((class color)) :foreground "green" :background "blue"))
53f93f0d 1936(mdw-define-face magit-diff-removed
fefae026
MW
1937 (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
1938 (((class color)) :foreground "red"))
53f93f0d 1939(mdw-define-face magit-diff-removed-highlight
fefae026
MW
1940 (((min-colors 64)) :foreground "#eecccc" :background "#663333")
1941 (((class color)) :foreground "red" :background "blue"))
857045c6
MW
1942(mdw-define-face magit-blame-heading
1943 (((min-colors 64)) :foreground "white" :background "grey25"
1944 :weight normal :slant normal)
1945 (((class color)) :foreground "white" :background "blue"
1946 :weight normal :slant normal))
1947(mdw-define-face magit-blame-name
1948 (t :inherit magit-blame-heading :slant italic))
1949(mdw-define-face magit-blame-date
1950 (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
1951 (((class color)) :inherit magit-blame-heading :foreground "cyan"))
1952(mdw-define-face magit-blame-summary
1953 (t :inherit magit-blame-heading :weight bold))
53f93f0d 1954
ad305d7e 1955(mdw-define-face dylan-header-background
fefae026
MW
1956 (((min-colors 64)) :background "NavyBlue")
1957 (((class color)) :background "blue"))
ad305d7e 1958
e1b8de18
MW
1959(mdw-define-face erc-input-face
1960 (t :foreground "red"))
1961
1e7a9479
MW
1962(mdw-define-face woman-bold
1963 (t :weight bold))
1964(mdw-define-face woman-italic
1965 (t :slant italic))
1966
5a83259f
MW
1967(eval-after-load "rst"
1968 '(progn
1969 (mdw-define-face rst-level-1-face
1970 (t :foreground "SkyBlue1" :weight bold))
1971 (mdw-define-face rst-level-2-face
1972 (t :foreground "SeaGreen1" :weight bold))
1973 (mdw-define-face rst-level-3-face
1974 (t :weight bold))
1975 (mdw-define-face rst-level-4-face
1976 (t :slant italic))
1977 (mdw-define-face rst-level-5-face
1978 (t :underline t))
1979 (mdw-define-face rst-level-6-face
1980 ())))
4f251391 1981
1e7a9479
MW
1982(mdw-define-face p4-depot-added-face
1983 (t :foreground "green"))
1984(mdw-define-face p4-depot-branch-op-face
1985 (t :foreground "yellow"))
1986(mdw-define-face p4-depot-deleted-face
1987 (t :foreground "red"))
1988(mdw-define-face p4-depot-unmapped-face
1989 (t :foreground "SkyBlue1"))
1990(mdw-define-face p4-diff-change-face
1991 (t :foreground "yellow"))
1992(mdw-define-face p4-diff-del-face
1993 (t :foreground "red"))
1994(mdw-define-face p4-diff-file-face
1995 (t :foreground "SkyBlue1"))
1996(mdw-define-face p4-diff-head-face
1997 (t :background "grey10"))
1998(mdw-define-face p4-diff-ins-face
1999 (t :foreground "green"))
2000
4c39e530
MW
2001(mdw-define-face w3m-anchor-face
2002 (t :foreground "SkyBlue1" :underline t))
2003(mdw-define-face w3m-arrived-anchor-face
2004 (t :foreground "SkyBlue1" :underline t))
2005
1e7a9479
MW
2006(mdw-define-face whizzy-slice-face
2007 (t :background "grey10"))
2008(mdw-define-face whizzy-error-face
2009 (t :background "darkred"))
f617db13 2010
5fedb342
MW
2011;; Ellipses used to indicate hidden text (and similar).
2012(mdw-define-face mdw-ellipsis-face
2013 (((type tty)) :foreground "blue") (t :foreground "grey60"))
c11ac343 2014(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
a8a7976a 2015 (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
c11ac343
MW
2016 (dot (make-glyph-code ?. 'mdw-ellipsis-face))
2017 (bar (make-glyph-code ?| mdw-ellipsis-face)))
2018 (set-display-table-slot standard-display-table 0 dollar)
2019 (set-display-table-slot standard-display-table 1 backslash)
5fedb342 2020 (set-display-table-slot standard-display-table 4
c11ac343
MW
2021 (vector dot dot dot))
2022 (set-display-table-slot standard-display-table 5 bar))
5fedb342 2023
6132bc01 2024;;;--------------------------------------------------------------------------
c70e3179
MW
2025;;; Where is point?
2026
6a2d05ae 2027(mdw-define-face mdw-point-overlay-face
3f32879e 2028 (((type graphic)))
c70e3179
MW
2029 (((min-colors 64)) :background "darkblue")
2030 (((class color)) :background "blue")
2031 (((type tty) (class mono)) :inverse-video t))
2032
2033(defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
2034
2035(defun mdw-configure-point-overlay ()
2036 (let ((ov (make-overlay 0 0)))
2037 (overlay-put ov 'priority 0)
2038 (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
2039 (left (car fringe)) (right (cdr fringe))
2040 (s ""))
2041 (when left
2042 (let ((ss "."))
2043 (put-text-property 0 1 'display `(left-fringe ,left) ss)
2044 (setq s (concat s ss))))
2045 (when right
2046 (let ((ss "."))
2047 (put-text-property 0 1 'display `(right-fringe ,right) ss)
2048 (setq s (concat s ss))))
2049 (when (or left right)
2050 (overlay-put ov 'before-string s)))
6a2d05ae 2051 (overlay-put ov 'face 'mdw-point-overlay-face)
c70e3179
MW
2052 (delete-overlay ov)
2053 ov))
2054
2055(defvar mdw-point-overlay (mdw-configure-point-overlay)
2056 "An overlay used for showing where point is in the selected window.")
2057(defun mdw-reconfigure-point-overlay ()
2058 (interactive)
2059 (setq mdw-point-overlay (mdw-configure-point-overlay)))
2060
2061(defun mdw-remove-point-overlay ()
2062 "Remove the current-point overlay."
2063 (delete-overlay mdw-point-overlay))
2064
2065(defun mdw-update-point-overlay ()
2066 "Mark the current point position with an overlay."
2067 (if (not mdw-point-overlay-mode)
2068 (mdw-remove-point-overlay)
2069 (overlay-put mdw-point-overlay 'window (selected-window))
2070 (move-overlay mdw-point-overlay
2071 (line-beginning-position)
2072 (+ (line-end-position) 1))))
2073
2074(defvar mdw-point-overlay-buffers nil
2075 "List of buffers using `mdw-point-overlay-mode'.")
2076
2077(define-minor-mode mdw-point-overlay-mode
2078 "Indicate current line with an overlay."
2079 :global nil
2080 (let ((buffer (current-buffer)))
2081 (setq mdw-point-overlay-buffers
535c927f
MW
2082 (mapcan (lambda (buf)
2083 (if (and (buffer-live-p buf)
2084 (not (eq buf buffer)))
2085 (list buf)))
2086 mdw-point-overlay-buffers))
c70e3179
MW
2087 (if mdw-point-overlay-mode
2088 (setq mdw-point-overlay-buffers
535c927f 2089 (cons buffer mdw-point-overlay-buffers))))
c70e3179
MW
2090 (cond (mdw-point-overlay-buffers
2091 (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
2092 (add-hook 'post-command-hook 'mdw-update-point-overlay))
2093 (t
2094 (mdw-remove-point-overlay)
2095 (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
2096 (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
2097
2098(define-globalized-minor-mode mdw-global-point-overlay-mode
2099 mdw-point-overlay-mode
2100 (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
2101
07e1e1f8 2102(defvar mdw-terminal-title-alist nil)
18cdb023
MW
2103(defun mdw-update-terminal-title ()
2104 (when (let ((term (frame-parameter nil 'tty-type)))
2105 (and term (string-match "^xterm" term)))
2106 (let* ((tty (frame-parameter nil 'tty))
07e1e1f8 2107 (old (assoc tty mdw-terminal-title-alist))
18cdb023 2108 (new (format-mode-line frame-title-format)))
165a1e68 2109 (unless (and old (equal (cdr old) new))
18cdb023 2110 (if old (rplacd old new)
07e1e1f8 2111 (setq mdw-terminal-title-alist
535c927f 2112 (cons (cons tty new) mdw-terminal-title-alist)))
18cdb023
MW
2113 (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
2114
2115(add-hook 'post-command-hook 'mdw-update-terminal-title)
2116
c70e3179 2117;;;--------------------------------------------------------------------------
6132bc01 2118;;; C programming configuration.
f617db13 2119
6132bc01 2120;; Make C indentation nice.
f617db13 2121
f50c1bed
MW
2122(defun mdw-c-lineup-arglist (langelem)
2123 "Hack for DWIMmery in c-lineup-arglist."
2124 (if (save-excursion
2125 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
2126 0
2127 (c-lineup-arglist langelem)))
2128
2129(defun mdw-c-indent-extern-mumble (langelem)
2130 "Indent `extern \"...\" {' lines."
2131 (save-excursion
2132 (back-to-indentation)
2133 (if (looking-at
2134 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
2135 c-basic-offset
2136 nil)))
2137
b521d36a
MW
2138(defun mdw-c-indent-arglist-nested (langelem)
2139 "Indent continued argument lists.
2140If we've nested more than one argument list, then only introduce a single
2141indentation anyway."
2142 (let ((context c-syntactic-context)
2143 (pos (c-langelem-2nd-pos c-syntactic-element))
2144 (should-indent-p t))
2145 (while (and context
2146 (eq (caar context) 'arglist-cont-nonempty))
2147 (when (and (= (caddr (pop context)) pos)
2148 context
2149 (memq (caar context) '(arglist-intro
2150 arglist-cont-nonempty)))
2151 (setq should-indent-p nil)))
2152 (if should-indent-p '+ 0)))
2153
c56296d0
MW
2154(defvar mdw-define-c-styles-hook nil
2155 "Hook run when `cc-mode' starts up to define styles.")
2156
e5751a93
MW
2157(defun mdw-merge-style-alists (first second)
2158 (let ((output nil))
2159 (dolist (item first)
2160 (let ((key (car item)) (value (cdr item)))
2161 (if (string-suffix-p "-alist" (symbol-name key))
2162 (push (cons key
2163 (mdw-merge-style-alists value
2164 (cdr (assoc key second))))
2165 output)
2166 (push item output))))
2167 (dolist (item second)
2168 (unless (assoc (car item) first)
2169 (push item output)))
2170 (nreverse output)))
2171
2172(cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
2173 "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
c56296d0
MW
2174A function, named `mdw-define-c-style/NAME', is defined to actually install
2175the style using `c-add-style', and added to the hook
2176`mdw-define-c-styles-hook'. If CC Mode is already loaded, then the style is
2177set."
2178 (declare (indent defun))
2179 (let* ((name-string (symbol-name name))
e5751a93 2180 (var (intern (concat "mdw-c-style/" name-string)))
c56296d0
MW
2181 (func (intern (concat "mdw-define-c-style/" name-string))))
2182 `(progn
e5751a93 2183 (setq ,var
535c927f
MW
2184 ,(if (null parent)
2185 `',assocs
2186 (let ((parent-list (intern (concat "mdw-c-style/"
2187 (symbol-name parent)))))
2188 `(mdw-merge-style-alists ',assocs ,parent-list))))
e5751a93 2189 (defun ,func () (c-add-style ,name-string ,var))
c56296d0 2190 (and (featurep 'cc-mode) (,func))
e5751a93
MW
2191 (add-hook 'mdw-define-c-styles-hook ',func)
2192 ',name)))
c56296d0
MW
2193
2194(eval-after-load "cc-mode"
2195 '(run-hooks 'mdw-define-c-styles-hook))
2196
e5751a93 2197(mdw-define-c-style mdw-c ()
8ad8e046
MW
2198 (c-basic-offset . 2)
2199 (comment-column . 40)
b521d36a 2200 (c-class-key . "class")
8ad8e046 2201 (c-backslash-column . 72)
b521d36a
MW
2202 (c-label-minimum-indentation . 0)
2203 (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
2204 (defun-open . (add 0 c-indent-one-line-block))
8ad8e046 2205 (arglist-cont-nonempty . mdw-c-lineup-arglist)
b521d36a
MW
2206 (topmost-intro . mdw-c-indent-extern-mumble)
2207 (cpp-define-intro . 0)
2208 (knr-argdecl . 0)
2209 (inextern-lang . [0])
2210 (label . 0)
2211 (case-label . +)
8ad8e046 2212 (access-label . -)
b521d36a
MW
2213 (inclass . +)
2214 (inline-open . ++)
2215 (statement-cont . +)
2216 (statement-case-intro . +)))
2217
28082234 2218(mdw-define-c-style mdw-trustonic-c (mdw-c)
8ad8e046 2219 (c-basic-offset . 4)
8ad8e046
MW
2220 (c-indent-comment-alist (anchored-comment . (column . 0))
2221 (end-block . (space . 1))
2222 (cpp-end-block . (space . 1))
2223 (other . (space . 1)))
e555fac7
MW
2224 (c-offsets-alist (access-label . -2)))
2225
28082234
MW
2226(mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c)
2227 (comment-column . 0)
e555fac7 2228 (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
c56296d0
MW
2229
2230(defun mdw-set-default-c-style (modes style)
2231 "Update the default CC Mode style for MODES to be STYLE.
2232
2233MODES may be a list of major mode names or a singleton. STYLE is a style
2234name, as a symbol."
2235 (let ((modes (if (listp modes) modes (list modes)))
2236 (style (symbol-name style)))
2237 (setq c-default-style
535c927f
MW
2238 (append (mapcar (lambda (mode)
2239 (cons mode style))
2240 modes)
2241 (remove-if (lambda (assoc)
2242 (memq (car assoc) modes))
2243 (if (listp c-default-style)
2244 c-default-style
2245 (list (cons 'other c-default-style))))))))
c56296d0
MW
2246(setq c-default-style "mdw-c")
2247
2248(mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
f617db13 2249
0e7d960b
MW
2250(defvar mdw-c-comment-fill-prefix
2251 `((,(concat "\\([ \t]*/?\\)"
a7474429 2252 "\\(\\*\\|//\\)"
0e7d960b
MW
2253 "\\([ \t]*\\)"
2254 "\\([A-Za-z]+:[ \t]*\\)?"
2255 mdw-hanging-indents)
2256 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
2257 "Fill prefix matching C comments (both kinds).")
2258
f617db13
MW
2259(defun mdw-fontify-c-and-c++ ()
2260
6132bc01 2261 ;; Fiddle with some syntax codes.
f617db13
MW
2262 (modify-syntax-entry ?* ". 23")
2263 (modify-syntax-entry ?/ ". 124b")
2264 (modify-syntax-entry ?\n "> b")
2265
6132bc01 2266 ;; Other stuff.
c56296d0 2267 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 2268
6132bc01 2269 ;; Now define things to be fontified.
02109a0d 2270 (make-local-variable 'font-lock-keywords)
f617db13 2271 (let ((c-keywords
fe307a8c
MW
2272 (mdw-regexps "alignas" ;C11 macro, C++11
2273 "alignof" ;C++11
2274 "and" ;C++, C95 macro
0681f29e 2275 "and_eq" ;C++, C95 macro
7b84c078 2276 "asm" ;K&R, C++, GCC
fe307a8c 2277 "atomic" ;C11 macro, C++11 template type
26f18bd1 2278 "auto" ;K&R, C89
0681f29e
MW
2279 "bitand" ;C++, C95 macro
2280 "bitor" ;C++, C95 macro
d4783d9c 2281 "bool" ;C++, C99 macro
26f18bd1
MW
2282 "break" ;K&R, C89
2283 "case" ;K&R, C89
2284 "catch" ;C++
2285 "char" ;K&R, C89
fe307a8c
MW
2286 "char16_t" ;C++11, C11 library type
2287 "char32_t" ;C++11, C11 library type
26f18bd1 2288 "class" ;C++
d4783d9c 2289 "complex" ;C99 macro, C++ template type
0681f29e 2290 "compl" ;C++, C95 macro
26f18bd1 2291 "const" ;C89
fe307a8c 2292 "constexpr" ;C++11
26f18bd1
MW
2293 "const_cast" ;C++
2294 "continue" ;K&R, C89
fe307a8c 2295 "decltype" ;C++11
26f18bd1
MW
2296 "defined" ;C89 preprocessor
2297 "default" ;K&R, C89
2298 "delete" ;C++
2299 "do" ;K&R, C89
2300 "double" ;K&R, C89
2301 "dynamic_cast" ;C++
2302 "else" ;K&R, C89
2303 ;; "entry" ;K&R -- never used
2304 "enum" ;C89
2305 "explicit" ;C++
2306 "export" ;C++
2307 "extern" ;K&R, C89
2308 "float" ;K&R, C89
2309 "for" ;K&R, C89
2310 ;; "fortran" ;K&R
2311 "friend" ;C++
2312 "goto" ;K&R, C89
2313 "if" ;K&R, C89
d4783d9c
MW
2314 "imaginary" ;C99 macro
2315 "inline" ;C++, C99, GCC
26f18bd1
MW
2316 "int" ;K&R, C89
2317 "long" ;K&R, C89
2318 "mutable" ;C++
2319 "namespace" ;C++
2320 "new" ;C++
fe307a8c
MW
2321 "noexcept" ;C++11
2322 "noreturn" ;C11 macro
0681f29e
MW
2323 "not" ;C++, C95 macro
2324 "not_eq" ;C++, C95 macro
fe307a8c 2325 "nullptr" ;C++11
26f18bd1 2326 "operator" ;C++
0681f29e
MW
2327 "or" ;C++, C95 macro
2328 "or_eq" ;C++, C95 macro
26f18bd1
MW
2329 "private" ;C++
2330 "protected" ;C++
2331 "public" ;C++
2332 "register" ;K&R, C89
8d6d55b9 2333 "reinterpret_cast" ;C++
d4783d9c 2334 "restrict" ;C99
8d6d55b9
MW
2335 "return" ;K&R, C89
2336 "short" ;K&R, C89
2337 "signed" ;C89
2338 "sizeof" ;K&R, C89
2339 "static" ;K&R, C89
fe307a8c 2340 "static_assert" ;C11 macro, C++11
8d6d55b9
MW
2341 "static_cast" ;C++
2342 "struct" ;K&R, C89
2343 "switch" ;K&R, C89
2344 "template" ;C++
8d6d55b9 2345 "throw" ;C++
8d6d55b9 2346 "try" ;C++
fe307a8c 2347 "thread_local" ;C11 macro, C++11
8d6d55b9
MW
2348 "typedef" ;C89
2349 "typeid" ;C++
2350 "typeof" ;GCC
2351 "typename" ;C++
2352 "union" ;K&R, C89
2353 "unsigned" ;K&R, C89
2354 "using" ;C++
2355 "virtual" ;C++
2356 "void" ;C89
2357 "volatile" ;C89
2358 "wchar_t" ;C++, C89 library type
2359 "while" ;K&R, C89
0681f29e
MW
2360 "xor" ;C++, C95 macro
2361 "xor_eq" ;C++, C95 macro
fe307a8c
MW
2362 "_Alignas" ;C11
2363 "_Alignof" ;C11
2364 "_Atomic" ;C11
d4783d9c
MW
2365 "_Bool" ;C99
2366 "_Complex" ;C99
fe307a8c 2367 "_Generic" ;C11
d4783d9c 2368 "_Imaginary" ;C99
fe307a8c 2369 "_Noreturn" ;C11
d4783d9c 2370 "_Pragma" ;C99 preprocessor
fe307a8c
MW
2371 "_Static_assert" ;C11
2372 "_Thread_local" ;C11
8d6d55b9
MW
2373 "__alignof__" ;GCC
2374 "__asm__" ;GCC
2375 "__attribute__" ;GCC
2376 "__complex__" ;GCC
2377 "__const__" ;GCC
2378 "__extension__" ;GCC
2379 "__imag__" ;GCC
2380 "__inline__" ;GCC
2381 "__label__" ;GCC
2382 "__real__" ;GCC
2383 "__signed__" ;GCC
2384 "__typeof__" ;GCC
2385 "__volatile__" ;GCC
2386 ))
300f8827 2387 (c-builtins
26f18bd1 2388 (mdw-regexps "false" ;C++, C99 macro
165cecf8 2389 "this" ;C++
26f18bd1 2390 "true" ;C++, C99 macro
165cecf8 2391 ))
f617db13 2392 (preprocessor-keywords
8d6d55b9
MW
2393 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2394 "ident" "if" "ifdef" "ifndef" "import" "include"
2395 "line" "pragma" "unassert" "undef" "warning"))
f617db13 2396 (objc-keywords
8d6d55b9
MW
2397 (mdw-regexps "class" "defs" "encode" "end" "implementation"
2398 "interface" "private" "protected" "protocol" "public"
2399 "selector")))
f617db13
MW
2400
2401 (setq font-lock-keywords
535c927f 2402 (list
f617db13 2403
535c927f
MW
2404 ;; Fontify include files as strings.
2405 (list (concat "^[ \t]*\\#[ \t]*"
2406 "\\(include\\|import\\)"
2407 "[ \t]*\\(<[^>]+>?\\)")
2408 '(2 font-lock-string-face))
2409
2410 ;; Preprocessor directives are `references'?.
2411 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2412 preprocessor-keywords
2413 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2414 '(1 font-lock-keyword-face))
2415
2416 ;; Handle the keywords defined above.
2417 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2418 '(0 font-lock-keyword-face))
2419
2420 (list (concat "\\<\\(" c-keywords "\\)\\>")
2421 '(0 font-lock-keyword-face))
2422
2423 (list (concat "\\<\\(" c-builtins "\\)\\>")
2424 '(0 font-lock-variable-name-face))
2425
2426 ;; Handle numbers too.
2427 ;;
2428 ;; This looks strange, I know. It corresponds to the
2429 ;; preprocessor's idea of what a number looks like, rather than
2430 ;; anything sensible.
2431 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2432 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2433 '(0 mdw-number-face))
2434
2435 ;; And anything else is punctuation.
2436 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2437 '(0 mdw-punct-face))))))
f617db13 2438
fb16ed85
MW
2439(define-derived-mode sod-mode c-mode "Sod"
2440 "Major mode for editing Sod code.")
2441(push '("\\.sod$" . sod-mode) auto-mode-alist)
2442
b50c6712
MW
2443(dolist (hook '(c-mode-hook objc-mode-hook c++-mode-hook))
2444 (add-hook hook 'mdw-misc-mode-config t)
2445 (add-hook hook 'mdw-fontify-c-and-c++ t))
2446
6132bc01
MW
2447;;;--------------------------------------------------------------------------
2448;;; AP calc mode.
f617db13 2449
e7186cbe
MW
2450(define-derived-mode apcalc-mode c-mode "AP Calc"
2451 "Major mode for editing Calc code.")
f617db13
MW
2452
2453(defun mdw-fontify-apcalc ()
2454
6132bc01 2455 ;; Fiddle with some syntax codes.
f617db13
MW
2456 (modify-syntax-entry ?* ". 23")
2457 (modify-syntax-entry ?/ ". 14")
2458
6132bc01 2459 ;; Other stuff.
f617db13
MW
2460 (setq comment-start "/* ")
2461 (setq comment-end " */")
0e7d960b 2462 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 2463
6132bc01 2464 ;; Now define things to be fontified.
02109a0d 2465 (make-local-variable 'font-lock-keywords)
f617db13 2466 (let ((c-keywords
8d6d55b9
MW
2467 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2468 "do" "else" "exit" "for" "global" "goto" "help" "if"
2469 "local" "mat" "obj" "print" "quit" "read" "return"
2470 "show" "static" "switch" "while" "write")))
f617db13
MW
2471
2472 (setq font-lock-keywords
535c927f 2473 (list
f617db13 2474
535c927f
MW
2475 ;; Handle the keywords defined above.
2476 (list (concat "\\<\\(" c-keywords "\\)\\>")
2477 '(0 font-lock-keyword-face))
f617db13 2478
535c927f
MW
2479 ;; Handle numbers too.
2480 ;;
2481 ;; This looks strange, I know. It corresponds to the
2482 ;; preprocessor's idea of what a number looks like, rather than
2483 ;; anything sensible.
2484 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2485 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2486 '(0 mdw-number-face))
f617db13 2487
535c927f
MW
2488 ;; And anything else is punctuation.
2489 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2490 '(0 mdw-punct-face))))))
f617db13 2491
b50c6712
MW
2492(progn
2493 (add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
2494 (add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t))
2495
6132bc01
MW
2496;;;--------------------------------------------------------------------------
2497;;; Java programming configuration.
f617db13 2498
6132bc01 2499;; Make indentation nice.
f617db13 2500
a5807b1e 2501(mdw-define-c-style mdw-java ()
c56296d0
MW
2502 (c-basic-offset . 2)
2503 (c-backslash-column . 72)
2504 (c-offsets-alist (substatement-open . 0)
2505 (label . +)
2506 (case-label . +)
2507 (access-label . 0)
2508 (inclass . +)
2509 (statement-case-intro . +)))
2510(mdw-set-default-c-style 'java-mode 'mdw-java)
f617db13 2511
6132bc01 2512;; Declare Java fontification style.
f617db13
MW
2513
2514(defun mdw-fontify-java ()
2515
36eabf61
MW
2516 ;; Fiddle with some syntax codes.
2517 (modify-syntax-entry ?@ ".")
2518 (modify-syntax-entry ?@ "." font-lock-syntax-table)
2519
6132bc01 2520 ;; Other stuff.
0e7d960b 2521 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 2522
6132bc01 2523 ;; Now define things to be fontified.
02109a0d 2524 (make-local-variable 'font-lock-keywords)
f617db13 2525 (let ((java-keywords
853d8555
MW
2526 (mdw-regexps "abstract" "assert"
2527 "boolean" "break" "byte"
2528 "case" "catch" "char" "class" "const" "continue"
2529 "default" "do" "double"
2530 "else" "enum" "extends"
2531 "final" "finally" "float" "for"
2532 "goto"
2533 "if" "implements" "import" "instanceof" "int"
2534 "interface"
2535 "long"
2536 "native" "new"
2537 "package" "private" "protected" "public"
2538 "return"
2539 "short" "static" "strictfp" "switch" "synchronized"
2540 "throw" "throws" "transient" "try"
2541 "void" "volatile"
2542 "while"))
8d6d55b9 2543
300f8827 2544 (java-builtins
165cecf8 2545 (mdw-regexps "false" "null" "super" "this" "true")))
f617db13
MW
2546
2547 (setq font-lock-keywords
535c927f 2548 (list
f617db13 2549
535c927f
MW
2550 ;; Handle the keywords defined above.
2551 (list (concat "\\<\\(" java-keywords "\\)\\>")
2552 '(0 font-lock-keyword-face))
f617db13 2553
535c927f
MW
2554 ;; Handle the magic builtins defined above.
2555 (list (concat "\\<\\(" java-builtins "\\)\\>")
2556 '(0 font-lock-variable-name-face))
f617db13 2557
535c927f
MW
2558 ;; Handle numbers too.
2559 ;;
2560 ;; The following isn't quite right, but it's close enough.
2561 (list (concat "\\<\\("
2562 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2563 "[0-9]+\\(\\.[0-9]*\\)?"
2564 "\\([eE][-+]?[0-9]+\\)?\\)"
2565 "[lLfFdD]?")
2566 '(0 mdw-number-face))
2567
2568 ;; And anything else is punctuation.
2569 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2570 '(0 mdw-punct-face))))))
f617db13 2571
b50c6712
MW
2572(progn
2573 (add-hook 'java-mode-hook 'mdw-misc-mode-config t)
2574 (add-hook 'java-mode-hook 'mdw-fontify-java t))
2575
6132bc01 2576;;;--------------------------------------------------------------------------
61d63206
MW
2577;;; Javascript programming configuration.
2578
2579(defun mdw-javascript-style ()
2580 (setq js-indent-level 2)
2581 (setq js-expr-indent-offset 0))
2582
2583(defun mdw-fontify-javascript ()
2584
2585 ;; Other stuff.
2586 (mdw-javascript-style)
2587 (setq js-auto-indent-flag t)
2588
2589 ;; Now define things to be fontified.
2590 (make-local-variable 'font-lock-keywords)
2591 (let ((javascript-keywords
2592 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2593 "char" "class" "const" "continue" "debugger" "default"
2594 "delete" "do" "double" "else" "enum" "export" "extends"
2595 "final" "finally" "float" "for" "function" "goto" "if"
2596 "implements" "import" "in" "instanceof" "int"
2597 "interface" "let" "long" "native" "new" "package"
2598 "private" "protected" "public" "return" "short"
2599 "static" "super" "switch" "synchronized" "throw"
2600 "throws" "transient" "try" "typeof" "var" "void"
4e23ea53 2601 "volatile" "while" "with" "yield"))
300f8827 2602 (javascript-builtins
61d63206
MW
2603 (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2604 "arguments" "this")))
2605
2606 (setq font-lock-keywords
535c927f 2607 (list
61d63206 2608
535c927f
MW
2609 ;; Handle the keywords defined above.
2610 (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2611 '(0 font-lock-keyword-face))
61d63206 2612
535c927f
MW
2613 ;; Handle the predefined builtins defined above.
2614 (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
2615 '(0 font-lock-variable-name-face))
61d63206 2616
535c927f
MW
2617 ;; Handle numbers too.
2618 ;;
2619 ;; The following isn't quite right, but it's close enough.
2620 (list (concat "\\_<\\("
2621 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2622 "[0-9]+\\(\\.[0-9]*\\)?"
2623 "\\([eE][-+]?[0-9]+\\)?\\)"
2624 "[lLfFdD]?")
2625 '(0 mdw-number-face))
2626
2627 ;; And anything else is punctuation.
2628 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2629 '(0 mdw-punct-face))))))
61d63206 2630
b50c6712
MW
2631(progn
2632 (add-hook 'js-mode-hook 'mdw-misc-mode-config t)
2633 (add-hook 'js-mode-hook 'mdw-fontify-javascript t))
2634
61d63206 2635;;;--------------------------------------------------------------------------
ee7c3dea
MW
2636;;; Scala programming configuration.
2637
2638(defun mdw-fontify-scala ()
2639
7b5903d8
MW
2640 ;; Comment filling.
2641 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2642
ee7c3dea
MW
2643 ;; Define things to be fontified.
2644 (make-local-variable 'font-lock-keywords)
2645 (let ((scala-keywords
2646 (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2647 "extends" "final" "finally" "for" "forSome" "if"
2648 "implicit" "import" "lazy" "match" "new" "object"
3f017188
MW
2649 "override" "package" "private" "protected" "return"
2650 "sealed" "throw" "trait" "try" "type" "val"
ee7c3dea
MW
2651 "var" "while" "with" "yield"))
2652 (scala-constants
3f017188 2653 (mdw-regexps "false" "null" "super" "this" "true"))
7b5903d8 2654 (punctuation "[-!%^&*=+:@#~/?\\|`]"))
ee7c3dea
MW
2655
2656 (setq font-lock-keywords
535c927f 2657 (list
ee7c3dea 2658
535c927f
MW
2659 ;; Magical identifiers between backticks.
2660 (list (concat "`\\([^`]+\\)`")
2661 '(1 font-lock-variable-name-face))
ee7c3dea 2662
535c927f
MW
2663 ;; Handle the keywords defined above.
2664 (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2665 '(0 font-lock-keyword-face))
ee7c3dea 2666
535c927f
MW
2667 ;; Handle the constants defined above.
2668 (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2669 '(0 font-lock-variable-name-face))
ee7c3dea 2670
535c927f
MW
2671 ;; Magical identifiers between backticks.
2672 (list (concat "`\\([^`]+\\)`")
2673 '(1 font-lock-variable-name-face))
2674
2675 ;; Handle numbers too.
2676 ;;
2677 ;; As usual, not quite right.
2678 (list (concat "\\_<\\("
2679 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2680 "[0-9]+\\(\\.[0-9]*\\)?"
2681 "\\([eE][-+]?[0-9]+\\)?\\)"
2682 "[lLfFdD]?")
2683 '(0 mdw-number-face))
2684
2685 ;; And everything else is punctuation.
2686 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2687 '(0 mdw-punct-face)))
ee7c3dea
MW
2688
2689 font-lock-syntactic-keywords
535c927f 2690 (list
ee7c3dea 2691
535c927f
MW
2692 ;; Single quotes around characters. But not when used to quote
2693 ;; symbol names. Ugh.
2694 (list (concat "\\('\\)"
2695 "\\(" "."
2696 "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
2697 "u+" "[0-9a-fA-F]\\{4\\}"
2698 "\\|" "\\\\" "[0-7]\\{1,3\\}"
2699 "\\|" "\\\\" "." "\\)"
2700 "\\('\\)")
2701 '(1 "\"")
2702 '(4 "\""))))))
ee7c3dea 2703
b50c6712
MW
2704(progn
2705 (add-hook 'scala-mode-hook 'mdw-misc-mode-config t)
2706 (add-hook 'scala-mode-hook 'mdw-fontify-scala t))
2707
ee7c3dea 2708;;;--------------------------------------------------------------------------
6132bc01 2709;;; C# programming configuration.
e808c1e5 2710
6132bc01 2711;; Make indentation nice.
e808c1e5 2712
a5807b1e 2713(mdw-define-c-style mdw-csharp ()
c56296d0
MW
2714 (c-basic-offset . 2)
2715 (c-backslash-column . 72)
2716 (c-offsets-alist (substatement-open . 0)
2717 (label . 0)
2718 (case-label . +)
2719 (access-label . 0)
2720 (inclass . +)
2721 (statement-case-intro . +)))
2722(mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
e808c1e5 2723
6132bc01 2724;; Declare C# fontification style.
e808c1e5
MW
2725
2726(defun mdw-fontify-csharp ()
2727
6132bc01 2728 ;; Other stuff.
0e7d960b 2729 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
e808c1e5 2730
6132bc01 2731 ;; Now define things to be fontified.
e808c1e5
MW
2732 (make-local-variable 'font-lock-keywords)
2733 (let ((csharp-keywords
165cecf8
MW
2734 (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
2735 "char" "checked" "class" "const" "continue" "decimal"
2736 "default" "delegate" "do" "double" "else" "enum"
2737 "event" "explicit" "extern" "finally" "fixed" "float"
2738 "for" "foreach" "goto" "if" "implicit" "in" "int"
2739 "interface" "internal" "is" "lock" "long" "namespace"
2740 "new" "object" "operator" "out" "override" "params"
2741 "private" "protected" "public" "readonly" "ref"
2742 "return" "sbyte" "sealed" "short" "sizeof"
2743 "stackalloc" "static" "string" "struct" "switch"
2744 "throw" "try" "typeof" "uint" "ulong" "unchecked"
2745 "unsafe" "ushort" "using" "virtual" "void" "volatile"
2746 "while" "yield"))
2747
300f8827 2748 (csharp-builtins
165cecf8 2749 (mdw-regexps "base" "false" "null" "this" "true")))
e808c1e5
MW
2750
2751 (setq font-lock-keywords
535c927f 2752 (list
e808c1e5 2753
535c927f
MW
2754 ;; Handle the keywords defined above.
2755 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
2756 '(0 font-lock-keyword-face))
e808c1e5 2757
535c927f
MW
2758 ;; Handle the magic builtins defined above.
2759 (list (concat "\\<\\(" csharp-builtins "\\)\\>")
2760 '(0 font-lock-variable-name-face))
e808c1e5 2761
535c927f
MW
2762 ;; Handle numbers too.
2763 ;;
2764 ;; The following isn't quite right, but it's close enough.
2765 (list (concat "\\<\\("
2766 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2767 "[0-9]+\\(\\.[0-9]*\\)?"
2768 "\\([eE][-+]?[0-9]+\\)?\\)"
2769 "[lLfFdD]?")
2770 '(0 mdw-number-face))
2771
2772 ;; And anything else is punctuation.
2773 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2774 '(0 mdw-punct-face))))))
e808c1e5 2775
103c5923
MW
2776(define-derived-mode csharp-mode java-mode "C#"
2777 "Major mode for editing C# code.")
e808c1e5 2778
b50c6712
MW
2779(add-hook 'csharp-mode-hook 'mdw-fontify-csharp t)
2780
6132bc01 2781;;;--------------------------------------------------------------------------
81fb08fc
MW
2782;;; F# programming configuration.
2783
2784(setq fsharp-indent-offset 2)
2785
2786(defun mdw-fontify-fsharp ()
2787
2788 (let ((punct "=<>+-*/|&%!@?"))
2789 (do ((i 0 (1+ i)))
2790 ((>= i (length punct)))
2791 (modify-syntax-entry (aref punct i) ".")))
2792
2793 (modify-syntax-entry ?_ "_")
2794 (modify-syntax-entry ?( "(")
2795 (modify-syntax-entry ?) ")")
2796
2797 (setq indent-tabs-mode nil)
2798
2799 (let ((fsharp-keywords
2800 (mdw-regexps "abstract" "and" "as" "assert" "atomic"
165cecf8 2801 "begin" "break"
81fb08fc
MW
2802 "checked" "class" "component" "const" "constraint"
2803 "constructor" "continue"
2804 "default" "delegate" "do" "done" "downcast" "downto"
2805 "eager" "elif" "else" "end" "exception" "extern"
165cecf8 2806 "finally" "fixed" "for" "fori" "fun" "function"
81fb08fc
MW
2807 "functor"
2808 "global"
2809 "if" "in" "include" "inherit" "inline" "interface"
2810 "internal"
2811 "lazy" "let"
2812 "match" "measure" "member" "method" "mixin" "module"
2813 "mutable"
165cecf8
MW
2814 "namespace" "new"
2815 "object" "of" "open" "or" "override"
81fb08fc
MW
2816 "parallel" "params" "private" "process" "protected"
2817 "public" "pure"
2818 "rec" "recursive" "return"
2819 "sealed" "sig" "static" "struct"
165cecf8 2820 "tailcall" "then" "to" "trait" "try" "type"
81fb08fc
MW
2821 "upcast" "use"
2822 "val" "virtual" "void" "volatile"
2823 "when" "while" "with"
2824 "yield"))
2825
2826 (fsharp-builtins
165cecf8
MW
2827 (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
2828 "base" "false" "null" "true"))
81fb08fc
MW
2829
2830 (bang-keywords
2831 (mdw-regexps "do" "let" "return" "use" "yield"))
2832
2833 (preprocessor-keywords
2834 (mdw-regexps "if" "indent" "else" "endif")))
2835
2836 (setq font-lock-keywords
535c927f
MW
2837 (list (list (concat "\\(^\\|[^\"]\\)"
2838 "\\(" "(\\*"
2839 "[^*]*\\*+"
2840 "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
2841 ")"
81fb08fc 2842 "\\|"
535c927f
MW
2843 "//.*"
2844 "\\)")
2845 '(2 font-lock-comment-face))
2846
2847 (list (concat "'" "\\("
2848 "\\\\"
2849 "\\(" "[ntbr'\\]"
2850 "\\|" "[0-9][0-9][0-9]"
2851 "\\|" "u" "[0-9a-fA-F]\\{4\\}"
2852 "\\|" "U" "[0-9a-fA-F]\\{8\\}"
2853 "\\)"
2854 "\\|"
2855 "." "\\)" "'"
81fb08fc 2856 "\\|"
535c927f
MW
2857 "\"" "[^\"\\]*"
2858 "\\(" "\\\\" "\\(.\\|\n\\)"
2859 "[^\"\\]*" "\\)*"
2860 "\\(\"\\|\\'\\)")
2861 '(0 font-lock-string-face))
2862
2863 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
2864 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
2865 "\\|"
2866 "\\_<\\(" fsharp-keywords "\\)\\_>")
2867 '(0 font-lock-keyword-face))
2868 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
2869 '(0 font-lock-variable-name-face))
2870
2871 (list (concat "\\_<"
2872 "\\(" "0[bB][01]+" "\\|"
2873 "0[oO][0-7]+" "\\|"
2874 "0[xX][0-9a-fA-F]+" "\\)"
2875 "\\(" "lf\\|LF" "\\|"
2876 "[uU]?[ysnlL]?" "\\)"
2877 "\\|"
2878 "\\_<"
2879 "[0-9]+" "\\("
2880 "[mMQRZING]"
2881 "\\|"
2882 "\\(\\.[0-9]*\\)?"
2883 "\\([eE][-+]?[0-9]+\\)?"
2884 "[fFmM]?"
2885 "\\|"
2886 "[uU]?[ysnlL]?"
2887 "\\)")
2888 '(0 mdw-number-face))
81fb08fc 2889
535c927f
MW
2890 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2891 '(0 mdw-punct-face))))))
81fb08fc
MW
2892
2893(defun mdw-fontify-inferior-fsharp ()
2894 (mdw-fontify-fsharp)
2895 (setq font-lock-keywords
535c927f
MW
2896 (append (list (list "^[#-]" '(0 font-lock-comment-face))
2897 (list "^>" '(0 font-lock-keyword-face)))
2898 font-lock-keywords)))
81fb08fc 2899
b50c6712
MW
2900(progn
2901 (add-hook 'fsharp-mode-hook 'mdw-misc-mode-config t)
2902 (add-hook 'fsharp-mode-hook 'mdw-fontify-fsharp t)
2903 (add-hook 'inferior-fsharp-mode-hooks 'mdw-fontify-inferior-fsharp t))
2904
81fb08fc 2905;;;--------------------------------------------------------------------------
07965a39
MW
2906;;; Go programming configuration.
2907
2908(defun mdw-fontify-go ()
2909
2910 (make-local-variable 'font-lock-keywords)
2911 (let ((go-keywords
2912 (mdw-regexps "break" "case" "chan" "const" "continue"
2913 "default" "defer" "else" "fallthrough" "for"
2914 "func" "go" "goto" "if" "import"
2915 "interface" "map" "package" "range" "return"
fc79ff88
MW
2916 "select" "struct" "switch" "type" "var"))
2917 (go-intrinsics
2918 (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2919 "float32" "float64" "int" "uint8" "int16" "int32"
2920 "int64" "rune" "string" "uint" "uint8" "uint16"
2921 "uint32" "uint64" "uintptr" "void"
2922 "false" "iota" "nil" "true"
2923 "init" "main"
2924 "append" "cap" "copy" "delete" "imag" "len" "make"
2925 "new" "panic" "real" "recover")))
07965a39
MW
2926
2927 (setq font-lock-keywords
535c927f 2928 (list
07965a39 2929
535c927f
MW
2930 ;; Handle the keywords defined above.
2931 (list (concat "\\<\\(" go-keywords "\\)\\>")
2932 '(0 font-lock-keyword-face))
2933 (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2934 '(0 font-lock-variable-name-face))
2935
2936 ;; Strings and characters.
2937 (list (concat "'"
2938 "\\(" "[^\\']" "\\|"
2939 "\\\\"
2940 "\\(" "[abfnrtv\\'\"]" "\\|"
2941 "[0-7]\\{3\\}" "\\|"
2942 "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2943 "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2944 "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2945 "'"
2946 "\\|"
2947 "\""
2948 "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2949 "\\(\"\\|$\\)"
2950 "\\|"
2951 "`" "[^`]+" "`")
2952 '(0 font-lock-string-face))
2953
2954 ;; Handle numbers too.
2955 ;;
2956 ;; The following isn't quite right, but it's close enough.
2957 (list (concat "\\<\\("
2958 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2959 "[0-9]+\\(\\.[0-9]*\\)?"
2960 "\\([eE][-+]?[0-9]+\\)?\\)")
2961 '(0 mdw-number-face))
2962
2963 ;; And anything else is punctuation.
2964 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2965 '(0 mdw-punct-face))))))
b50c6712
MW
2966(progn
2967 (add-hook 'go-mode-hook 'mdw-misc-mode-config t)
2968 (add-hook 'go-mode-hook 'mdw-fontify-go t))
07965a39
MW
2969
2970;;;--------------------------------------------------------------------------
36db1ea7
MW
2971;;; Rust programming configuration.
2972
2973(setq-default rust-indent-offset 2)
2974
2975(defun mdw-self-insert-and-indent (count)
2976 (interactive "p")
2977 (self-insert-command count)
2978 (indent-according-to-mode))
2979
2980(defun mdw-fontify-rust ()
2981
2982 ;; Hack syntax categories.
cbd69b16 2983 (modify-syntax-entry ?$ ".")
8e234929 2984 (modify-syntax-entry ?% ".")
36db1ea7
MW
2985 (modify-syntax-entry ?= ".")
2986
2987 ;; Fontify keywords and things.
2988 (make-local-variable 'font-lock-keywords)
2989 (let ((rust-keywords
87def30c 2990 (mdw-regexps "abstract" "alignof" "as" "async" "await"
36db1ea7 2991 "become" "box" "break"
260564a3 2992 "const" "continue" "crate"
87def30c 2993 "do" "dyn"
36db1ea7 2994 "else" "enum" "extern"
b6f44b18 2995 "final" "fn" "for"
36db1ea7
MW
2996 "if" "impl" "in"
2997 "let" "loop"
2998 "macro" "match" "mod" "move" "mut"
2999 "offsetof" "override"
b6f44b18 3000 "priv" "proc" "pub" "pure"
36db1ea7 3001 "ref" "return"
b6f44b18 3002 "sizeof" "static" "struct" "super"
87def30c
MW
3003 "trait" "try" "type" "typeof"
3004 "union" "unsafe" "unsized" "use"
36db1ea7
MW
3005 "virtual"
3006 "where" "while"
3007 "yield"))
3008 (rust-builtins
3009 (mdw-regexps "array" "pointer" "slice" "tuple"
3010 "bool" "true" "false"
3011 "f32" "f64"
3012 "i8" "i16" "i32" "i64" "isize"
3013 "u8" "u16" "u32" "u64" "usize"
b6f44b18
MW
3014 "char" "str"
3015 "self" "Self")))
36db1ea7 3016 (setq font-lock-keywords
535c927f 3017 (list
36db1ea7 3018
535c927f
MW
3019 ;; Handle the keywords defined above.
3020 (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
3021 '(0 font-lock-keyword-face))
3022 (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
3023 '(0 font-lock-variable-name-face))
3024
3025 ;; Handle numbers too.
3026 (list (concat "\\_<\\("
3027 "[0-9][0-9_]*"
3028 "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
3029 "\\|" "\\.[0-9_]+"
3030 "\\)"
3031 "\\(f32\\|f64\\)?"
3032 "\\|" "\\(" "[0-9][0-9_]*"
3033 "\\|" "0x[0-9a-fA-F_]+"
3034 "\\|" "0o[0-7_]+"
3035 "\\|" "0b[01_]+"
3036 "\\)"
3037 "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
3038 "\\)\\_>")
3039 '(0 mdw-number-face))
3040
3041 ;; And anything else is punctuation.
3042 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3043 '(0 mdw-punct-face)))))
36db1ea7
MW
3044
3045 ;; Hack key bindings.
d2f85967 3046 (local-set-key [?{] 'mdw-self-insert-and-indent)
2e7c6a86 3047 (local-set-key [?}] 'mdw-self-insert-and-indent))
36db1ea7 3048
b50c6712
MW
3049(progn
3050 (add-hook 'rust-mode-hook 'mdw-misc-mode-config t)
3051 (add-hook 'rust-mode-hook 'mdw-fontify-rust t))
3052
36db1ea7 3053;;;--------------------------------------------------------------------------
6132bc01 3054;;; Awk programming configuration.
f617db13 3055
6132bc01 3056;; Make Awk indentation nice.
f617db13 3057
e0de0009 3058(mdw-define-c-style mdw-awk ()
c56296d0
MW
3059 (c-basic-offset . 2)
3060 (c-offsets-alist (substatement-open . 0)
3061 (c-backslash-column . 72)
3062 (statement-cont . 0)
3063 (statement-case-intro . +)))
3064(mdw-set-default-c-style 'awk-mode 'mdw-awk)
f617db13 3065
6132bc01 3066;; Declare Awk fontification style.
f617db13
MW
3067
3068(defun mdw-fontify-awk ()
3069
6132bc01 3070 ;; Miscellaneous fiddling.
f617db13
MW
3071 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3072
6132bc01 3073 ;; Now define things to be fontified.
02109a0d 3074 (make-local-variable 'font-lock-keywords)
f617db13 3075 (let ((c-keywords
8d6d55b9
MW
3076 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
3077 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
3078 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
3079 "RSTART" "RLENGTH" "RT" "SUBSEP"
3080 "atan2" "break" "close" "continue" "cos" "delete"
3081 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
3082 "function" "gensub" "getline" "gsub" "if" "in"
3083 "index" "int" "length" "log" "match" "next" "rand"
3084 "return" "print" "printf" "sin" "split" "sprintf"
3085 "sqrt" "srand" "strftime" "sub" "substr" "system"
3086 "systime" "tolower" "toupper" "while")))
f617db13
MW
3087
3088 (setq font-lock-keywords
535c927f 3089 (list
f617db13 3090
535c927f
MW
3091 ;; Handle the keywords defined above.
3092 (list (concat "\\<\\(" c-keywords "\\)\\>")
3093 '(0 font-lock-keyword-face))
f617db13 3094
535c927f
MW
3095 ;; Handle numbers too.
3096 ;;
3097 ;; The following isn't quite right, but it's close enough.
3098 (list (concat "\\<\\("
3099 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3100 "[0-9]+\\(\\.[0-9]*\\)?"
3101 "\\([eE][-+]?[0-9]+\\)?\\)"
3102 "[uUlL]*")
3103 '(0 mdw-number-face))
f617db13 3104
535c927f
MW
3105 ;; And anything else is punctuation.
3106 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3107 '(0 mdw-punct-face))))))
f617db13 3108
b50c6712
MW
3109(progn
3110 (add-hook 'awk-mode-hook 'mdw-misc-mode-config t)
3111 (add-hook 'awk-mode-hook 'mdw-fontify-awk t))
3112
6132bc01
MW
3113;;;--------------------------------------------------------------------------
3114;;; Perl programming style.
f617db13 3115
6132bc01 3116;; Perl indentation style.
f617db13 3117
08b1b191 3118(setq-default perl-indent-level 2)
88158daf 3119
08b1b191
MW
3120(setq-default cperl-indent-level 2
3121 cperl-continued-statement-offset 2
3122 cperl-continued-brace-offset 0
3123 cperl-brace-offset -2
3124 cperl-brace-imaginary-offset 0
3125 cperl-label-offset 0)
f617db13 3126
6132bc01 3127;; Define perl fontification style.
f617db13
MW
3128
3129(defun mdw-fontify-perl ()
3130
6132bc01 3131 ;; Miscellaneous fiddling.
f617db13
MW
3132 (modify-syntax-entry ?$ "\\")
3133 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
a3b8176f 3134 (modify-syntax-entry ?: "." font-lock-syntax-table)
f617db13
MW
3135 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3136
6132bc01 3137 ;; Now define fontification things.
02109a0d 3138 (make-local-variable 'font-lock-keywords)
f617db13 3139 (let ((perl-keywords
821c4945
MW
3140 (mdw-regexps "and"
3141 "break"
3142 "cmp" "continue"
3143 "default" "do"
3144 "else" "elsif" "eq"
3145 "for" "foreach"
3146 "ge" "given" "gt" "goto"
3147 "if"
3148 "last" "le" "local" "lt"
3149 "my"
3150 "ne" "next"
3151 "or" "our"
3152 "package"
3153 "redo" "require" "return"
3154 "sub"
3155 "undef" "unless" "until" "use"
3156 "when" "while")))
f617db13
MW
3157
3158 (setq font-lock-keywords
535c927f 3159 (list
f617db13 3160
535c927f
MW
3161 ;; Set up the keywords defined above.
3162 (list (concat "\\<\\(" perl-keywords "\\)\\>")
3163 '(0 font-lock-keyword-face))
f617db13 3164
535c927f
MW
3165 ;; At least numbers are simpler than C.
3166 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3167 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
3168 "\\([eE][-+]?[0-9_]+\\)?")
3169 '(0 mdw-number-face))
f617db13 3170
535c927f
MW
3171 ;; And anything else is punctuation.
3172 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3173 '(0 mdw-punct-face))))))
f617db13
MW
3174
3175(defun perl-number-tests (&optional arg)
3176 "Assign consecutive numbers to lines containing `#t'. With ARG,
3177strip numbers instead."
3178 (interactive "P")
3179 (save-excursion
3180 (goto-char (point-min))
3181 (let ((i 0) (fmt (if arg "" " %4d")))
3182 (while (search-forward "#t" nil t)
3183 (delete-region (point) (line-end-position))
3184 (setq i (1+ i))
3185 (insert (format fmt i)))
3186 (goto-char (point-min))
3187 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
3188 (replace-match (format "\\1%d" i))))))
3189
b50c6712
MW
3190(dolist (hook '(perl-mode-hook cperl-mode-hook))
3191 (add-hook hook 'mdw-misc-mode-config t)
3192 (add-hook hook 'mdw-fontify-perl t))
3193
6132bc01
MW
3194;;;--------------------------------------------------------------------------
3195;;; Python programming style.
f617db13 3196
b50c6712
MW
3197(setq-default py-indent-offset 2
3198 python-indent 2
3199 python-indent-offset 2
3200 python-fill-docstring-style 'symmetric)
3201
99fe6ef5 3202(defun mdw-fontify-pythonic (keywords)
f617db13 3203
6132bc01 3204 ;; Miscellaneous fiddling.
f617db13 3205 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
7c0fcfde 3206 (setq indent-tabs-mode nil)
f617db13 3207
6132bc01 3208 ;; Now define fontification things.
02109a0d 3209 (make-local-variable 'font-lock-keywords)
99fe6ef5 3210 (setq font-lock-keywords
535c927f 3211 (list
f617db13 3212
535c927f
MW
3213 ;; Set up the keywords defined above.
3214 (list (concat "\\_<\\(" keywords "\\)\\_>")
3215 '(0 font-lock-keyword-face))
f617db13 3216
535c927f
MW
3217 ;; At least numbers are simpler than C.
3218 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
3219 "\\_<[0-9][0-9]*\\(\\.[0-9]*\\)?"
3220 "\\([eE][-+]?[0-9]+\\|[lL]\\)?")
3221 '(0 mdw-number-face))
f617db13 3222
535c927f
MW
3223 ;; And anything else is punctuation.
3224 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3225 '(0 mdw-punct-face)))))
99fe6ef5 3226
be2cc788 3227;; Define Python fontification styles.
99fe6ef5
MW
3228
3229(defun mdw-fontify-python ()
3230 (mdw-fontify-pythonic
3231 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
3232 "del" "elif" "else" "except" "exec" "finally" "for"
3233 "from" "global" "if" "import" "in" "is" "lambda"
3234 "not" "or" "pass" "print" "raise" "return" "try"
3235 "while" "with" "yield")))
3236
3237(defun mdw-fontify-pyrex ()
3238 (mdw-fontify-pythonic
3239 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
a63efb67 3240 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
99fe6ef5
MW
3241 "extern" "finally" "for" "from" "global" "if"
3242 "import" "in" "is" "lambda" "not" "or" "pass" "print"
a63efb67 3243 "property" "raise" "return" "struct" "try" "while" "with"
99fe6ef5 3244 "yield")))
f617db13 3245
b5263ae5
MW
3246(define-derived-mode pyrex-mode python-mode "Pyrex"
3247 "Major mode for editing Pyrex source code")
3248(setq auto-mode-alist
535c927f
MW
3249 (append '(("\\.pyx$" . pyrex-mode)
3250 ("\\.pxd$" . pyrex-mode)
3251 ("\\.pxi$" . pyrex-mode))
3252 auto-mode-alist))
b5263ae5 3253
b50c6712
MW
3254(progn
3255 (add-hook 'python-mode-hook 'mdw-misc-mode-config t)
3256 (add-hook 'python-mode-hook 'mdw-fontify-python t)
3257 (add-hook 'pyrex-mode-hook 'mdw-fontify-pyrex t))
3258
6132bc01 3259;;;--------------------------------------------------------------------------
772a7a3b
MW
3260;;; Lua programming style.
3261
08b1b191 3262(setq-default lua-indent-level 2)
772a7a3b
MW
3263
3264(defun mdw-fontify-lua ()
3265
3266 ;; Miscellaneous fiddling.
3267 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3268
3269 ;; Now define fontification things.
3270 (make-local-variable 'font-lock-keywords)
3271 (let ((lua-keywords
3272 (mdw-regexps "and" "break" "do" "else" "elseif" "end"
3273 "false" "for" "function" "goto" "if" "in" "local"
3274 "nil" "not" "or" "repeat" "return" "then" "true"
3275 "until" "while")))
3276 (setq font-lock-keywords
535c927f 3277 (list
772a7a3b 3278
535c927f
MW
3279 ;; Set up the keywords defined above.
3280 (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
3281 '(0 font-lock-keyword-face))
3282
3283 ;; At least numbers are simpler than C.
3284 (list (concat "\\_<\\(" "0[xX]"
3285 "\\(" "[0-9a-fA-F]+"
3286 "\\(\\.[0-9a-fA-F]*\\)?"
3287 "\\|" "\\.[0-9a-fA-F]+"
3288 "\\)"
3289 "\\([pP][-+]?[0-9]+\\)?"
3290 "\\|" "\\(" "[0-9]+"
3291 "\\(\\.[0-9]*\\)?"
3292 "\\|" "\\.[0-9]+"
3293 "\\)"
3294 "\\([eE][-+]?[0-9]+\\)?"
3295 "\\)")
3296 '(0 mdw-number-face))
3297
3298 ;; And anything else is punctuation.
3299 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3300 '(0 mdw-punct-face))))))
772a7a3b 3301
b50c6712
MW
3302(progn
3303 (add-hook 'lua-mode-hook 'mdw-misc-mode-config t)
3304 (add-hook 'lua-mode-hook 'mdw-fontify-lua t))
3305
772a7a3b 3306;;;--------------------------------------------------------------------------
6132bc01 3307;;; Icon programming style.
cc1980e1 3308
6132bc01 3309;; Icon indentation style.
cc1980e1 3310
08b1b191
MW
3311(setq-default icon-brace-offset 0
3312 icon-continued-brace-offset 0
3313 icon-continued-statement-offset 2
3314 icon-indent-level 2)
cc1980e1 3315
6132bc01 3316;; Define Icon fontification style.
cc1980e1
MW
3317
3318(defun mdw-fontify-icon ()
3319
6132bc01 3320 ;; Miscellaneous fiddling.
cc1980e1
MW
3321 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3322
6132bc01 3323 ;; Now define fontification things.
cc1980e1
MW
3324 (make-local-variable 'font-lock-keywords)
3325 (let ((icon-keywords
3326 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
3327 "end" "every" "fail" "global" "if" "initial"
3328 "invocable" "link" "local" "next" "not" "of"
3329 "procedure" "record" "repeat" "return" "static"
3330 "suspend" "then" "to" "until" "while"))
3331 (preprocessor-keywords
3332 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
3333 "include" "line" "undef")))
3334 (setq font-lock-keywords
535c927f 3335 (list
cc1980e1 3336
535c927f
MW
3337 ;; Set up the keywords defined above.
3338 (list (concat "\\<\\(" icon-keywords "\\)\\>")
3339 '(0 font-lock-keyword-face))
cc1980e1 3340
535c927f
MW
3341 ;; The things that Icon calls keywords.
3342 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
cc1980e1 3343
535c927f
MW
3344 ;; At least numbers are simpler than C.
3345 (list (concat "\\<[0-9]+"
3346 "\\([rR][0-9a-zA-Z]+\\|"
3347 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
3348 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
3349 '(0 mdw-number-face))
cc1980e1 3350
535c927f
MW
3351 ;; Preprocessor.
3352 (list (concat "^[ \t]*$[ \t]*\\<\\("
3353 preprocessor-keywords
3354 "\\)\\>")
3355 '(0 font-lock-keyword-face))
cc1980e1 3356
535c927f
MW
3357 ;; And anything else is punctuation.
3358 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3359 '(0 mdw-punct-face))))))
cc1980e1 3360
b50c6712
MW
3361(progn
3362 (add-hook 'icon-mode-hook 'mdw-misc-mode-config t)
3363 (add-hook 'icon-mode-hook 'mdw-fontify-icon t))
3364
6132bc01 3365;;;--------------------------------------------------------------------------
8d00d2f4
MW
3366;;; Fortran mode.
3367
3368(defun mdw-fontify-fortran-common ()
3369 (let ((fortran-keywords
3370 (mdw-regexps "access"
3371 "assign"
3372 "associate"
3373 "backspace"
3374 "blank"
3375 "block\\s-*data"
3376 "call"
3377 "case"
3378 "character"
3379 "class"
3380 "close"
3381 "common"
3382 "complex"
3383 "continue"
3384 "critical"
3385 "data"
3386 "dimension"
3387 "do"
3388 "double\\s-*precision"
3389 "else" "elseif" "elsewhere"
3390 "end"
3391 "endblock" "endblockdata"
3392 "endcritical"
3393 "enddo"
3394 "endinterface"
3395 "endmodule"
3396 "endprocedure"
3397 "endprogram"
3398 "endselect"
3399 "endsubmodule"
3400 "endsubroutine"
3401 "endtype"
3402 "endwhere"
3403 "endenum"
3404 "end\\s-*file"
3405 "endforall"
3406 "endfunction"
3407 "endif"
3408 "entry"
3409 "enum"
3410 "equivalence"
3411 "err"
3412 "external"
3413 "file"
3414 "fmt"
3415 "forall"
3416 "form"
3417 "format"
3418 "function"
3419 "go\\s-*to"
3420 "if"
3421 "implicit"
3422 "in" "inout"
3423 "inquire"
3424 "include"
3425 "integer"
3426 "interface"
3427 "intrinsic"
3428 "iostat"
3429 "len"
3430 "logical"
3431 "module"
3432 "open"
3433 "out"
3434 "parameter"
3435 "pause"
3436 "procedure"
3437 "program"
3438 "precision"
3439 "program"
3440 "read"
3441 "real"
3442 "rec"
3443 "recl"
3444 "return"
3445 "rewind"
3446 "save"
3447 "select" "selectcase" "selecttype"
3448 "status"
3449 "stop"
3450 "submodule"
3451 "subroutine"
3452 "then"
3453 "to"
3454 "type"
3455 "unit"
3456 "where"
3457 "write"))
3458 (fortran-operators (mdw-regexps "and"
3459 "eq"
3460 "eqv"
3461 "false"
3462 "ge"
3463 "gt"
3464 "le"
3465 "lt"
3466 "ne"
3467 "neqv"
3468 "not"
3469 "or"
3470 "true"))
3471 (fortran-intrinsics (mdw-regexps "abs" "dabs" "iabs" "cabs"
3472 "atan" "datan" "atan2" "datan2"
3473 "cmplx"
3474 "conjg"
3475 "cos" "dcos" "ccos"
3476 "dble"
3477 "dim" "idim"
3478 "exp" "dexp" "cexp"
3479 "float"
3480 "ifix"
3481 "aimag"
3482 "int" "aint" "idint"
3483 "alog" "dlog" "clog"
3484 "alog10" "dlog10"
3485 "max"
3486 "amax0" "amax1"
3487 "max0" "max1"
3488 "dmax1"
3489 "min"
3490 "amin0" "amin1"
3491 "min0" "min1"
3492 "dmin1"
3493 "mod" "amod" "dmod"
3494 "sin" "dsin" "csin"
3495 "sign" "isign" "dsign"
3496 "sngl"
3497 "sqrt" "dsqrt" "csqrt"
3498 "tanh"))
3499 (preprocessor-keywords
3500 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3501 "ident" "if" "ifdef" "ifndef" "import" "include"
3502 "line" "pragma" "unassert" "undef" "warning")))
3503 (setq font-lock-keywords-case-fold-search t
3504 font-lock-keywords
3505 (list
3506
3507 ;; Fontify include files as strings.
3508 (list (concat "^[ \t]*\\#[ \t]*" "include"
3509 "[ \t]*\\(<[^>]+>?\\)")
3510 '(1 font-lock-string-face))
3511
3512 ;; Preprocessor directives are `references'?.
3513 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3514 preprocessor-keywords
3515 "\\)\\>\\|[0-9]+\\|$\\)\\)")
3516 '(1 font-lock-keyword-face))
3517
3518 ;; Set up the keywords defined above.
3519 (list (concat "\\<\\(" fortran-keywords "\\)\\>")
3520 '(0 font-lock-keyword-face))
3521
3522 ;; Set up the `.foo.' operators.
3523 (list (concat "\\.\\(" fortran-operators "\\)\\.")
3524 '(0 font-lock-keyword-face))
3525
3526 ;; Set up the intrinsic functions.
3527 (list (concat "\\<\\(" fortran-intrinsics "\\)\\>")
3528 '(0 font-lock-variable-name-face))
3529
3530 ;; Numbers.
3531 (list (concat "\\(" "\\<" "[0-9]+" "\\(\\.[0-9]*\\)?"
3532 "\\|" "\\.[0-9]+"
3533 "\\)"
3534 "\\(" "[de]" "[+-]?" "[0-9]+" "\\)?"
3535 "\\(" "_" "\\sw+" "\\)?"
3536 "\\|" "b'[01]*'" "\\|" "'[01]*'b"
3537 "\\|" "b\"[01]*\"" "\\|" "\"[01]*\"b"
3538 "\\|" "o'[0-7]*'" "\\|" "'[0-7]*'o"
3539 "\\|" "o\"[0-7]*\"" "\\|" "\"[0-7]*\"o"
3540 "\\|" "[xz]'[0-9a-f]*'" "\\|" "'[0-9a-f]*'[xz]"
3541 "\\|" "[xz]\"[0-9a-f]*\"" "\\|" "\"[0-9a-f]*\"[xz]")
3542 '(0 mdw-number-face))
3543
3544 ;; Any anything else is punctuation.
3545 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3546 '(0 mdw-punct-face))))
3547
3548 (modify-syntax-entry ?/ "." font-lock-syntax-table)
3549 (modify-syntax-entry ?< ".")
3550 (modify-syntax-entry ?> ".")))
3551
3552(defun mdw-fontify-fortran () (mdw-fontify-fortran-common))
3553(defun mdw-fontify-f90 () (mdw-fontify-fortran-common))
3554
3555(setq fortran-do-indent 2
3556 fortran-if-indent 2
3557 fortran-structure-indent 2
3558 fortran-comment-line-start "*"
3559 fortran-comment-indent-style 'relative
3560 fortran-continuation-string "&"
3561 fortran-continuation-indent 4)
3562
3563(setq f90-do-indent 2
3564 f90-if-indent 2
3565 f90-program-indent 2
3566 f90-continuation-indent 4
3567 f90-smart-end-names nil
3568 f90-smart-end 'no-blink)
3569
3570(progn
3571 (add-hook 'fortran-mode-hook 'mdw-misc-mode-config t)
3572 (add-hook 'fortran-mode-hook 'mdw-fontify-fortran t)
3573 (add-hook 'f90-mode-hook 'mdw-misc-mode-config t)
3574 (add-hook 'f90-mode-hook 'mdw-fontify-f90 t))
3575
3576;;;--------------------------------------------------------------------------
6132bc01 3577;;; Assembler mode.
30c8a8fb
MW
3578
3579(defun mdw-fontify-asm ()
3580 (modify-syntax-entry ?' "\"")
3581 (modify-syntax-entry ?. "w")
9032280b 3582 (modify-syntax-entry ?\n ">")
30c8a8fb 3583 (setf fill-prefix nil)
5edd6d49
MW
3584 (modify-syntax-entry ?. "_")
3585 (modify-syntax-entry ?* ". 23")
3586 (modify-syntax-entry ?/ ". 124b")
3587 (modify-syntax-entry ?\n "> b")
b90c2a2c 3588 (local-set-key ";" 'self-insert-command)
30c8a8fb
MW
3589 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
3590
227b2b2b
MW
3591(defun mdw-asm-set-comment ()
3592 (modify-syntax-entry ?; "."
3593 )
5edd6d49 3594 (modify-syntax-entry asm-comment-char "< b")
227b2b2b
MW
3595 (setq comment-start (string asm-comment-char ? )))
3596(add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
3597(put 'asm-comment-char 'safe-local-variable 'characterp)
9032280b 3598
b50c6712
MW
3599(progn
3600 (add-hook 'asm-mode-hook 'mdw-misc-mode-config t)
3601 (add-hook 'asm-mode-hook 'mdw-fontify-asm t))
3602
6132bc01
MW
3603;;;--------------------------------------------------------------------------
3604;;; TCL configuration.
f617db13 3605
b50c6712
MW
3606(setq-default tcl-indent-level 2)
3607
f617db13 3608(defun mdw-fontify-tcl ()
6c4bd06b
MW
3609 (dolist (ch '(?$))
3610 (modify-syntax-entry ch "."))
f617db13 3611 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
02109a0d 3612 (make-local-variable 'font-lock-keywords)
f617db13 3613 (setq font-lock-keywords
535c927f
MW
3614 (list
3615 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3616 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
3617 "\\([eE][-+]?[0-9_]+\\)?")
3618 '(0 mdw-number-face))
3619 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3620 '(0 mdw-punct-face)))))
f617db13 3621
b50c6712
MW
3622(progn
3623 (add-hook 'tcl-mode-hook 'mdw-misc-mode-config t)
3624 (add-hook 'tcl-mode-hook 'mdw-fontify-tcl t))
3625
6132bc01 3626;;;--------------------------------------------------------------------------
ad305d7e
MW
3627;;; Dylan programming configuration.
3628
3629(defun mdw-fontify-dylan ()
3630
3631 (make-local-variable 'font-lock-keywords)
3632
3633 ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
3634 ;; hook, which undoes all of our configuration.
3635 (setq major-mode 'dylan-mode)
3636 (font-lock-set-defaults)
3637
3638 (let* ((word "[-_a-zA-Z!*@<>$%]+")
3639 (dylan-keywords (mdw-regexps
3640
3641 "C-address" "C-callable-wrapper" "C-function"
3642 "C-mapped-subtype" "C-pointer-type" "C-struct"
3643 "C-subtype" "C-union" "C-variable"
3644
3645 "above" "abstract" "afterwards" "all"
3646 "begin" "below" "block" "by"
3647 "case" "class" "cleanup" "constant" "create"
3648 "define" "domain"
3649 "else" "elseif" "end" "exception" "export"
3650 "finally" "for" "from" "function"
3651 "generic"
3652 "handler"
3653 "if" "in" "instance" "interface" "iterate"
3654 "keyed-by"
3655 "let" "library" "local"
3656 "macro" "method" "module"
3657 "otherwise"
3658 "profiling"
3659 "select" "slot" "subclass"
3660 "table" "then" "to"
3661 "unless" "until" "use"
3662 "variable" "virtual"
3663 "when" "while"))
3664 (sharp-keywords (mdw-regexps
3665 "all-keys" "key" "next" "rest" "include"
3666 "t" "f")))
3667 (setq font-lock-keywords
535c927f
MW
3668 (list (list (concat "\\<\\(" dylan-keywords
3669 "\\|" "with\\(out\\)?-" word
3670 "\\)\\>")
3671 '(0 font-lock-keyword-face))
3672 (list (concat "\\<" word ":" "\\|"
3673 "#\\(" sharp-keywords "\\)\\>")
3674 '(0 font-lock-variable-name-face))
3675 (list (concat "\\("
3676 "\\([-+]\\|\\<\\)[0-9]+" "\\("
3677 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
3678 "\\|" "/[0-9]+"
3679 "\\)"
3680 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
3681 "\\|" "#b[01]+"
3682 "\\|" "#o[0-7]+"
3683 "\\|" "#x[0-9a-zA-Z]+"
3684 "\\)\\>")
3685 '(0 mdw-number-face))
3686 (list (concat "\\("
3687 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
3688 "\\_<[-+*/=<>:&|]+\\_>"
3689 "\\)")
3690 '(0 mdw-punct-face))))))
ad305d7e 3691
b50c6712
MW
3692(progn
3693 (add-hook 'dylan-mode-hook 'mdw-misc-mode-config t)
3694 (add-hook 'dylan-mode-hook 'mdw-fontify-dylan t))
3695
ad305d7e 3696;;;--------------------------------------------------------------------------
7fce54c3
MW
3697;;; Algol 68 configuration.
3698
08b1b191 3699(setq-default a68-indent-step 2)
7fce54c3
MW
3700
3701(defun mdw-fontify-algol-68 ()
3702
3703 ;; Fix up the syntax table.
3704 (modify-syntax-entry ?# "!" a68-mode-syntax-table)
3705 (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
3706 (modify-syntax-entry ch "." a68-mode-syntax-table))
3707
3708 (make-local-variable 'font-lock-keywords)
3709
3710 (let ((not-comment
3711 (let ((word "COMMENT"))
3712 (do ((regexp (concat "[^" (substring word 0 1) "]+")
3713 (concat regexp "\\|"
3714 (substring word 0 i)
3715 "[^" (substring word i (1+ i)) "]"))
3716 (i 1 (1+ i)))
3717 ((>= i (length word)) regexp)))))
3718 (setq font-lock-keywords
535c927f
MW
3719 (list (list (concat "\\<COMMENT\\>"
3720 "\\(" not-comment "\\)\\{0,5\\}"
3721 "\\(\\'\\|\\<COMMENT\\>\\)")
3722 '(0 font-lock-comment-face))
3723 (list (concat "\\<CO\\>"
3724 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
3725 "\\($\\|\\<CO\\>\\)")
3726 '(0 font-lock-comment-face))
3727 (list "\\<[A-Z_]+\\>"
3728 '(0 font-lock-keyword-face))
3729 (list (concat "\\<"
3730 "[0-9]+"
3731 "\\(\\.[0-9]+\\)?"
3732 "\\([eE][-+]?[0-9]+\\)?"
3733 "\\>")
3734 '(0 mdw-number-face))
3735 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
3736 '(0 mdw-punct-face))))))
7fce54c3 3737
b50c6712
MW
3738(dolist (hook '(a68-mode-hook a68-mode-hooks))
3739 (add-hook hook 'mdw-misc-mode-config t)
3740 (add-hook hook 'mdw-fontify-algol-68 t))
3741
7fce54c3 3742;;;--------------------------------------------------------------------------
6132bc01 3743;;; REXX configuration.
f617db13
MW
3744
3745(defun mdw-rexx-electric-* ()
3746 (interactive)
3747 (insert ?*)
3748 (rexx-indent-line))
3749
3750(defun mdw-rexx-indent-newline-indent ()
3751 (interactive)
3752 (rexx-indent-line)
3753 (if abbrev-mode (expand-abbrev))
3754 (newline-and-indent))
3755
3756(defun mdw-fontify-rexx ()
3757
6132bc01 3758 ;; Various bits of fiddling.
f617db13
MW
3759 (setq mdw-auto-indent nil)
3760 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
3761 (local-set-key [?*] 'mdw-rexx-electric-*)
6c4bd06b
MW
3762 (dolist (ch '(?! ?? ?# ?@ ?$)) (modify-syntax-entry ch "w"))
3763 (dolist (ch '(?¬)) (modify-syntax-entry ch "."))
f617db13
MW
3764 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
3765
6132bc01 3766 ;; Set up keywords and things for fontification.
f617db13
MW
3767 (make-local-variable 'font-lock-keywords-case-fold-search)
3768 (setq font-lock-keywords-case-fold-search t)
3769
3770 (setq rexx-indent 2)
3771 (setq rexx-end-indent rexx-indent)
f617db13
MW
3772 (setq rexx-cont-indent rexx-indent)
3773
02109a0d 3774 (make-local-variable 'font-lock-keywords)
f617db13 3775 (let ((rexx-keywords
8d6d55b9
MW
3776 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
3777 "else" "end" "engineering" "exit" "expose" "for"
3778 "forever" "form" "fuzz" "if" "interpret" "iterate"
3779 "leave" "linein" "name" "nop" "numeric" "off" "on"
3780 "options" "otherwise" "parse" "procedure" "pull"
3781 "push" "queue" "return" "say" "select" "signal"
3782 "scientific" "source" "then" "trace" "to" "until"
3783 "upper" "value" "var" "version" "when" "while"
3784 "with"
3785
3786 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
3787 "center" "center" "charin" "charout" "chars"
3788 "compare" "condition" "copies" "c2d" "c2x"
3789 "datatype" "date" "delstr" "delword" "d2c" "d2x"
3790 "errortext" "format" "fuzz" "insert" "lastpos"
3791 "left" "length" "lineout" "lines" "max" "min"
3792 "overlay" "pos" "queued" "random" "reverse" "right"
3793 "sign" "sourceline" "space" "stream" "strip"
3794 "substr" "subword" "symbol" "time" "translate"
3795 "trunc" "value" "verify" "word" "wordindex"
3796 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
3797 "x2d")))
f617db13
MW
3798
3799 (setq font-lock-keywords
535c927f 3800 (list
f617db13 3801
535c927f
MW
3802 ;; Set up the keywords defined above.
3803 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
3804 '(0 font-lock-keyword-face))
f617db13 3805
535c927f
MW
3806 ;; Fontify all symbols the same way.
3807 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
3808 "[A-Za-z0-9.!?_#@$]+\\)")
3809 '(0 font-lock-variable-name-face))
f617db13 3810
535c927f
MW
3811 ;; And everything else is punctuation.
3812 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3813 '(0 mdw-punct-face))))))
f617db13 3814
b50c6712
MW
3815(progn
3816 (add-hook 'rexx-mode-hook 'mdw-misc-mode-config t)
3817 (add-hook 'rexx-mode-hook 'mdw-fontify-rexx t))
3818
6132bc01
MW
3819;;;--------------------------------------------------------------------------
3820;;; Standard ML programming style.
f617db13 3821
b50c6712
MW
3822(setq-default sml-nested-if-indent t
3823 sml-case-indent nil
3824 sml-indent-level 4
3825 sml-type-of-indent nil)
3826
f617db13
MW
3827(defun mdw-fontify-sml ()
3828
6132bc01 3829 ;; Make underscore an honorary letter.
f617db13
MW
3830 (modify-syntax-entry ?' "w")
3831
6132bc01 3832 ;; Set fill prefix.
f617db13
MW
3833 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
3834
6132bc01 3835 ;; Now define fontification things.
02109a0d 3836 (make-local-variable 'font-lock-keywords)
f617db13 3837 (let ((sml-keywords
8d6d55b9
MW
3838 (mdw-regexps "abstype" "and" "andalso" "as"
3839 "case"
3840 "datatype" "do"
3841 "else" "end" "eqtype" "exception"
3842 "fn" "fun" "functor"
3843 "handle"
3844 "if" "in" "include" "infix" "infixr"
3845 "let" "local"
3846 "nonfix"
3847 "of" "op" "open" "orelse"
3848 "raise" "rec"
3849 "sharing" "sig" "signature" "struct" "structure"
3850 "then" "type"
3851 "val"
3852 "where" "while" "with" "withtype")))
f617db13
MW
3853
3854 (setq font-lock-keywords
535c927f 3855 (list
f617db13 3856
535c927f
MW
3857 ;; Set up the keywords defined above.
3858 (list (concat "\\<\\(" sml-keywords "\\)\\>")
3859 '(0 font-lock-keyword-face))
f617db13 3860
535c927f
MW
3861 ;; At least numbers are simpler than C.
3862 (list (concat "\\<\\~?"
3863 "\\(0\\([wW]?[xX][0-9a-fA-F]+\\|"
3864 "[wW][0-9]+\\)\\|"
3865 "\\([0-9]+\\(\\.[0-9]+\\)?"
3866 "\\([eE]\\~?"
3867 "[0-9]+\\)?\\)\\)")
3868 '(0 mdw-number-face))
f617db13 3869
535c927f
MW
3870 ;; And anything else is punctuation.
3871 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3872 '(0 mdw-punct-face))))))
f617db13 3873
b50c6712
MW
3874(progn
3875 (add-hook 'sml-mode-hook 'mdw-misc-mode-config t)
3876 (add-hook 'sml-mode-hook 'mdw-fontify-sml t))
3877
6132bc01
MW
3878;;;--------------------------------------------------------------------------
3879;;; Haskell configuration.
f617db13 3880
b50c6712
MW
3881(setq-default haskell-indent-offset 2)
3882
f617db13
MW
3883(defun mdw-fontify-haskell ()
3884
6132bc01 3885 ;; Fiddle with syntax table to get comments right.
5952a020
MW
3886 (modify-syntax-entry ?' "_")
3887 (modify-syntax-entry ?- ". 12")
f617db13
MW
3888 (modify-syntax-entry ?\n ">")
3889
4d90cf3d
MW
3890 ;; Make punctuation be punctuation
3891 (let ((punct "=<>+-*/|&%!@?$.^:#`"))
3892 (do ((i 0 (1+ i)))
3893 ((>= i (length punct)))
3894 (modify-syntax-entry (aref punct i) ".")))
3895
6132bc01 3896 ;; Set fill prefix.
f617db13
MW
3897 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
3898
6132bc01 3899 ;; Fiddle with fontification.
02109a0d 3900 (make-local-variable 'font-lock-keywords)
f617db13 3901 (let ((haskell-keywords
5952a020
MW
3902 (mdw-regexps "as"
3903 "case" "ccall" "class"
3904 "data" "default" "deriving" "do"
3905 "else" "exists"
3906 "forall" "foreign"
3907 "hiding"
3908 "if" "import" "in" "infix" "infixl" "infixr" "instance"
3909 "let"
3910 "mdo" "module"
3911 "newtype"
3912 "of"
3913 "proc"
3914 "qualified"
3915 "rec"
3916 "safe" "stdcall"
3917 "then" "type"
3918 "unsafe"
3919 "where"))
3920 (control-sequences
3921 (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
3922 "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
3923 "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
3924 "SP" "STX" "SUB" "SYN" "US" "VT")))
f617db13
MW
3925
3926 (setq font-lock-keywords
535c927f
MW
3927 (list
3928 (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
3929 "\\(-+}\\|-*\\'\\)"
3930 "\\|"
3931 "--.*$")
3932 '(0 font-lock-comment-face))
3933 (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
3934 '(0 font-lock-keyword-face))
3935 (list (concat "'\\("
3936 "[^\\]"
3937 "\\|"
3938 "\\\\"
3939 "\\(" "[abfnrtv\\\"']" "\\|"
3940 "^" "\\(" control-sequences "\\|"
3941 "[]A-Z@[\\^_]" "\\)" "\\|"
3942 "\\|"
3943 "[0-9]+" "\\|"
3944 "[oO][0-7]+" "\\|"
3945 "[xX][0-9A-Fa-f]+"
3946 "\\)"
3947 "\\)'")
3948 '(0 font-lock-string-face))
3949 (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
3950 '(0 font-lock-variable-name-face))
3951 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
3952 "\\_<[0-9]+\\(\\.[0-9]*\\)?"
3953 "\\([eE][-+]?[0-9]+\\)?")
3954 '(0 mdw-number-face))
3955 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3956 '(0 mdw-punct-face))))))
f617db13 3957
b50c6712
MW
3958(progn
3959 (add-hook 'haskell-mode-hook 'mdw-misc-mode-config t)
3960 (add-hook 'haskell-mode-hook 'mdw-fontify-haskell t))
3961
6132bc01
MW
3962;;;--------------------------------------------------------------------------
3963;;; Erlang configuration.
2ded9493 3964
08b1b191 3965(setq-default erlang-electric-commands nil)
2ded9493
MW
3966
3967(defun mdw-fontify-erlang ()
3968
6132bc01 3969 ;; Set fill prefix.
2ded9493
MW
3970 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
3971
6132bc01 3972 ;; Fiddle with fontification.
2ded9493
MW
3973 (make-local-variable 'font-lock-keywords)
3974 (let ((erlang-keywords
3975 (mdw-regexps "after" "and" "andalso"
3976 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
3977 "case" "catch" "cond"
3978 "div" "end" "fun" "if" "let" "not"
3979 "of" "or" "orelse"
3980 "query" "receive" "rem" "try" "when" "xor")))
3981
3982 (setq font-lock-keywords
535c927f
MW
3983 (list
3984 (list "%.*$"
3985 '(0 font-lock-comment-face))
3986 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
3987 '(0 font-lock-keyword-face))
3988 (list (concat "^-\\sw+\\>")
3989 '(0 font-lock-keyword-face))
3990 (list "\\<[0-9]+\\(#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)?\\>"
3991 '(0 mdw-number-face))
3992 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3993 '(0 mdw-punct-face))))))
2ded9493 3994
b50c6712
MW
3995(progn
3996 (add-hook 'erlang-mode-hook 'mdw-misc-mode-config t)
3997 (add-hook 'erlang-mode-hook 'mdw-fontify-erlang t))
3998
6132bc01
MW
3999;;;--------------------------------------------------------------------------
4000;;; Texinfo configuration.
f617db13
MW
4001
4002(defun mdw-fontify-texinfo ()
4003
6132bc01 4004 ;; Set fill prefix.
f617db13
MW
4005 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
4006
6132bc01 4007 ;; Real fontification things.
02109a0d 4008 (make-local-variable 'font-lock-keywords)
f617db13 4009 (setq font-lock-keywords
535c927f 4010 (list
f617db13 4011
535c927f
MW
4012 ;; Environment names are keywords.
4013 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
4014 '(2 font-lock-keyword-face))
f617db13 4015
535c927f
MW
4016 ;; Unmark escaped magic characters.
4017 (list "\\(@\\)\\([@{}]\\)"
4018 '(1 font-lock-keyword-face)
4019 '(2 font-lock-variable-name-face))
f617db13 4020
535c927f
MW
4021 ;; Make sure we get comments properly.
4022 (list "@c\\(omment\\)?\\( .*\\)?$"
4023 '(0 font-lock-comment-face))
f617db13 4024
535c927f
MW
4025 ;; Command names are keywords.
4026 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4027 '(0 font-lock-keyword-face))
f617db13 4028
535c927f
MW
4029 ;; Fontify TeX special characters as punctuation.
4030 (list "[{}]+"
4031 '(0 mdw-punct-face)))))
f617db13 4032
b50c6712
MW
4033(dolist (hook '(texinfo-mode-hook TeXinfo-mode-hook))
4034 (add-hook hook 'mdw-misc-mode-config t)
4035 (add-hook hook 'mdw-fontify-texinfo t))
4036
6132bc01
MW
4037;;;--------------------------------------------------------------------------
4038;;; TeX and LaTeX configuration.
f617db13 4039
b50c6712
MW
4040(setq-default LaTeX-table-label "tbl:"
4041 TeX-auto-untabify nil
4042 LaTeX-syntactic-comments nil
4043 LaTeX-fill-break-at-separators '(\\\[))
4044
f617db13
MW
4045(defun mdw-fontify-tex ()
4046 (setq ispell-parser 'tex)
55f80fae 4047 (turn-on-reftex)
f617db13 4048
6132bc01 4049 ;; Don't make maths into a string.
f617db13
MW
4050 (modify-syntax-entry ?$ ".")
4051 (modify-syntax-entry ?$ "." font-lock-syntax-table)
4052 (local-set-key [?$] 'self-insert-command)
4053
df200ecd 4054 ;; Make `tab' be useful, given that tab stops in TeX don't work well.
060c23ce 4055 (local-set-key "\C-\M-i" 'indent-relative)
df200ecd
MW
4056 (setq indent-tabs-mode nil)
4057
6132bc01 4058 ;; Set fill prefix.
f617db13
MW
4059 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
4060
6132bc01 4061 ;; Real fontification things.
02109a0d 4062 (make-local-variable 'font-lock-keywords)
f617db13 4063 (setq font-lock-keywords
535c927f
MW
4064 (list
4065
4066 ;; Environment names are keywords.
4067 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
4068 "{\\([^}\n]*\\)}")
4069 '(2 font-lock-keyword-face))
4070
4071 ;; Suspended environment names are keywords too.
4072 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
4073 "{\\([^}\n]*\\)}")
4074 '(3 font-lock-keyword-face))
4075
4076 ;; Command names are keywords.
4077 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4078 '(0 font-lock-keyword-face))
4079
4080 ;; Handle @/.../ for italics.
4081 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
4082 ;; '(1 font-lock-keyword-face)
4083 ;; '(3 font-lock-keyword-face))
4084
4085 ;; Handle @*...* for boldness.
4086 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
4087 ;; '(1 font-lock-keyword-face)
4088 ;; '(3 font-lock-keyword-face))
4089
4090 ;; Handle @`...' for literal syntax things.
4091 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
4092 ;; '(1 font-lock-keyword-face)
4093 ;; '(3 font-lock-keyword-face))
4094
4095 ;; Handle @<...> for nonterminals.
4096 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
4097 ;; '(1 font-lock-keyword-face)
4098 ;; '(3 font-lock-keyword-face))
4099
4100 ;; Handle other @-commands.
4101 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
4102 ;; '(0 font-lock-keyword-face))
4103
4104 ;; Make sure we get comments properly.
4105 (list "%.*"
4106 '(0 font-lock-comment-face))
4107
4108 ;; Fontify TeX special characters as punctuation.
4109 (list "[$^_{}#&]"
4110 '(0 mdw-punct-face)))))
f617db13 4111
d9bba20d
MW
4112(setq TeX-install-font-lock 'tex-font-setup)
4113
8638f2f3
MW
4114(eval-after-load 'font-latex
4115 '(defun font-latex-jit-lock-force-redisplay (buf start end)
4116 "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
4117 ;; The following block is an expansion of `jit-lock-force-redisplay'
4118 ;; and involved macros taken from CVS Emacs on 2007-04-28.
4119 (with-current-buffer buf
4120 (let ((modified (buffer-modified-p)))
4121 (unwind-protect
4122 (let ((buffer-undo-list t)
4123 (inhibit-read-only t)
4124 (inhibit-point-motion-hooks t)
4125 (inhibit-modification-hooks t)
4126 deactivate-mark
4127 buffer-file-name
4128 buffer-file-truename)
4129 (put-text-property start end 'fontified t))
4130 (unless modified
4131 (restore-buffer-modified-p nil)))))))
4132
b50c6712 4133(setq TeX-output-view-style
535c927f
MW
4134 '(("^dvi$"
4135 ("^landscape$" "^pstricks$\\|^pst-\\|^psfrag$")
4136 "%(o?)dvips -t landscape %d -o && xdg-open %f")
4137 ("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$"
4138 "%(o?)dvips %d -o && xdg-open %f")
4139 ("^dvi$"
4140 ("^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$" "^landscape$")
4141 "%(o?)xdvi %dS -paper a4r -s 0 %d")
4142 ("^dvi$" "^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$"
4143 "%(o?)xdvi %dS -paper a4 %d")
4144 ("^dvi$"
4145 ("^a5\\(?:comb\\|paper\\)$" "^landscape$")
4146 "%(o?)xdvi %dS -paper a5r -s 0 %d")
4147 ("^dvi$" "^a5\\(?:comb\\|paper\\)$" "%(o?)xdvi %dS -paper a5 %d")
4148 ("^dvi$" "^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
4149 ("^dvi$" "^letterpaper$" "%(o?)xdvi %dS -paper us %d")
4150 ("^dvi$" "^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
4151 ("^dvi$" "^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
4152 ("^dvi$" "." "%(o?)xdvi %dS %d")
4153 ("^pdf$" "." "xdg-open %o")
4154 ("^html?$" "." "sensible-browser %o")))
b50c6712
MW
4155
4156(setq TeX-view-program-list
535c927f 4157 '(("mupdf" ("mupdf %o" (mode-io-correlate " %(outpage)")))))
b50c6712
MW
4158
4159(setq TeX-view-program-selection
535c927f
MW
4160 '(((output-dvi style-pstricks) "dvips and gv")
4161 (output-dvi "xdvi")
4162 (output-pdf "mupdf")
4163 (output-html "sensible-browser")))
b50c6712
MW
4164
4165(setq TeX-open-quote "\""
4166 TeX-close-quote "\"")
4167
4168(setq reftex-use-external-file-finders t
4169 reftex-auto-recenter-toc t)
4170
4171(setq reftex-label-alist
535c927f
MW
4172 '(("theorem" ?T "th:" "~\\ref{%s}" t ("theorems?" "th\\.") -2)
4173 ("axiom" ?A "ax:" "~\\ref{%s}" t ("axioms?" "ax\\.") -2)
4174 ("definition" ?D "def:" "~\\ref{%s}" t ("definitions?" "def\\.") -2)
4175 ("proposition" ?P "prop:" "~\\ref{%s}" t
4176 ("propositions?" "prop\\.") -2)
4177 ("lemma" ?L "lem:" "~\\ref{%s}" t ("lemmas?" "lem\\.") -2)
4178 ("example" ?X "eg:" "~\\ref{%s}" t ("examples?") -2)
4179 ("exercise" ?E "ex:" "~\\ref{%s}" t ("exercises?" "ex\\.") -2)
4180 ("enumerate" ?i "i:" "~\\ref{%s}" item ("items?"))))
b50c6712 4181(setq reftex-section-prefixes
535c927f
MW
4182 '((0 . "part:")
4183 (1 . "ch:")
4184 (t . "sec:")))
b50c6712
MW
4185
4186(setq bibtex-field-delimiters 'double-quotes
4187 bibtex-align-at-equal-sign t
4188 bibtex-entry-format '(realign opts-or-alts required-fields
4189 numerical-fields last-comma delimiters
4190 unify-case sort-fields braces)
4191 bibtex-sort-ignore-string-entries nil
4192 bibtex-maintain-sorted-entries 'entry-class
4193 bibtex-include-OPTkey t
4194 bibtex-autokey-names-stretch 1
4195 bibtex-autokey-expand-strings t
4196 bibtex-autokey-name-separator "-"
4197 bibtex-autokey-year-length 4
4198 bibtex-autokey-titleword-separator "-"
4199 bibtex-autokey-name-year-separator "-"
4200 bibtex-autokey-year-title-separator ":")
4201
4202(progn
4203 (dolist (hook '(tex-mode-hook latex-mode-hook
4204 TeX-mode-hook LaTeX-mode-hook))
4205 (add-hook hook 'mdw-misc-mode-config t)
4206 (add-hook hook 'mdw-fontify-tex t))
4207 (add-hook 'bibtex-mode-hook (lambda () (setq fill-column 76))))
ad14c2fe 4208
6132bc01 4209;;;--------------------------------------------------------------------------
445ddb61
MW
4210;;; HTML, CSS, and other web foolishness.
4211
08b1b191 4212(setq-default css-indent-offset 2)
445ddb61
MW
4213
4214;;;--------------------------------------------------------------------------
6132bc01 4215;;; SGML hacking.
f25cf300 4216
b50c6712
MW
4217(setq-default psgml-html-build-new-buffer nil)
4218
f25cf300
MW
4219(defun mdw-sgml-mode ()
4220 (interactive)
4221 (sgml-mode)
4222 (mdw-standard-fill-prefix "")
8a425bd7 4223 (make-local-variable 'sgml-delimiters)
f25cf300 4224 (setq sgml-delimiters
535c927f
MW
4225 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
4226 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT"
4227 "\"" "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]"
4228 "NESTC" "{" "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">"
4229 "PIO" "<?" "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" ","
4230 "STAGO" ":" "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
4231 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE"
4232 "/>" "NULL" ""))
f25cf300
MW
4233 (setq major-mode 'mdw-sgml-mode)
4234 (setq mode-name "[mdw] SGML")
4235 (run-hooks 'mdw-sgml-mode-hook))
6cb52f8b
MW
4236
4237;;;--------------------------------------------------------------------------
4238;;; Configuration files.
4239
4240(defvar mdw-conf-quote-normal nil
4241 "*Control syntax category of quote characters `\"' and `''.
4242If this is `t', consider quote characters to be normal
4243punctuation, as for `conf-quote-normal'. If this is `nil' then
4244leave quote characters as quotes. If this is a list, then
4245consider the quote characters in the list to be normal
4246punctuation. If this is a single quote character, then consider
4247that character only to be normal punctuation.")
4248(defun mdw-conf-quote-normal-acceptable-value-p (value)
4249 "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
4250 (or (booleanp value)
4251 (every (lambda (v) (memq v '(?\" ?')))
4252 (if (listp value) value (list value)))))
18bb0f77
MW
4253(put 'mdw-conf-quote-normal 'safe-local-variable
4254 'mdw-conf-quote-normal-acceptable-value-p)
6cb52f8b
MW
4255
4256(defun mdw-fix-up-quote ()
4257 "Apply the setting of `mdw-conf-quote-normal'."
4258 (let ((flag mdw-conf-quote-normal))
4259 (cond ((eq flag t)
4260 (conf-quote-normal t))
4261 ((not flag)
4262 nil)
4263 (t
4264 (let ((table (copy-syntax-table (syntax-table))))
6c4bd06b
MW
4265 (dolist (ch (if (listp flag) flag (list flag)))
4266 (modify-syntax-entry ch "." table))
6cb52f8b
MW
4267 (set-syntax-table table)
4268 (and font-lock-mode (font-lock-fontify-buffer)))))))
b50c6712
MW
4269
4270(progn
4271 (add-hook 'conf-mode-hook 'mdw-misc-mode-config t)
4272 (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t))
f25cf300 4273
6132bc01
MW
4274;;;--------------------------------------------------------------------------
4275;;; Shell scripts.
f617db13
MW
4276
4277(defun mdw-setup-sh-script-mode ()
4278
6132bc01 4279 ;; Fetch the shell interpreter's name.
f617db13
MW
4280 (let ((shell-name sh-shell-file))
4281
6132bc01 4282 ;; Try reading the hash-bang line.
f617db13
MW
4283 (save-excursion
4284 (goto-char (point-min))
4285 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
4286 (setq shell-name (match-string 1))))
4287
6132bc01 4288 ;; Now try to set the shell.
f617db13
MW
4289 ;;
4290 ;; Don't let `sh-set-shell' bugger up my script.
f617db13
MW
4291 (let ((executable-set-magic #'(lambda (s &rest r) s)))
4292 (sh-set-shell shell-name)))
4293
10c51541
MW
4294 ;; Don't insert here-document scaffolding automatically.
4295 (local-set-key "<" 'self-insert-command)
4296
6132bc01 4297 ;; Now enable my keys and the fontification.
f617db13
MW
4298 (mdw-misc-mode-config)
4299
6132bc01 4300 ;; Set the indentation level correctly.
f617db13
MW
4301 (setq sh-indentation 2)
4302 (setq sh-basic-offset 2))
4303
070c1dca
MW
4304(setq sh-shell-file "/bin/sh")
4305
6d6e095a
MW
4306;; Awful hacking to override the shell detection for particular scripts.
4307(defmacro define-custom-shell-mode (name shell)
4308 `(defun ,name ()
4309 (interactive)
4310 (set (make-local-variable 'sh-shell-file) ,shell)
4311 (sh-mode)))
4312(define-custom-shell-mode bash-mode "/bin/bash")
4313(define-custom-shell-mode rc-mode "/usr/bin/rc")
4314(put 'sh-shell-file 'permanent-local t)
4315
4316;; Hack the rc syntax table. Backquotes aren't paired in rc.
4317(eval-after-load "sh-script"
4318 '(or (assq 'rc sh-mode-syntax-table-input)
4319 (let ((frag '(nil
4320 ?# "<"
4321 ?\n ">#"
4322 ?\" "\"\""
4323 ?\' "\"\'"
4324 ?$ "'"
4325 ?\` "."
4326 ?! "_"
4327 ?% "_"
4328 ?. "_"
4329 ?^ "_"
4330 ?~ "_"
4331 ?, "_"
4332 ?= "."
4333 ?< "."
4334 ?> "."))
4335 (assoc (assq 'rc sh-mode-syntax-table-input)))
4336 (if assoc
4337 (rplacd assoc frag)
4338 (setq sh-mode-syntax-table-input
535c927f
MW
4339 (cons (cons 'rc frag)
4340 sh-mode-syntax-table-input))))))
6d6e095a 4341
b50c6712
MW
4342(progn
4343 (add-hook 'sh-mode-hook 'mdw-misc-mode-config t)
4344 (add-hook 'sh-mode-hook 'mdw-setup-sh-script-mode t))
4345
6132bc01 4346;;;--------------------------------------------------------------------------
092f0a38
MW
4347;;; Emacs shell mode.
4348
4349(defun mdw-eshell-prompt ()
4350 (let ((left "[") (right "]"))
4351 (when (= (user-uid) 0)
4352 (setq left "«" right "»"))
4353 (concat left
4354 (save-match-data
4355 (replace-regexp-in-string "\\..*$" "" (system-name)))
4356 " "
2d8b2924
MW
4357 (let* ((pwd (eshell/pwd)) (npwd (length pwd))
4358 (home (expand-file-name "~")) (nhome (length home)))
4359 (if (and (>= npwd nhome)
4360 (or (= nhome npwd)
5801e199
MW
4361 (= (elt pwd nhome) ?/))
4362 (string= (substring pwd 0 nhome) home))
2d8b2924
MW
4363 (concat "~" (substring pwd (length home)))
4364 pwd))
092f0a38 4365 right)))
08b1b191
MW
4366(setq-default eshell-prompt-function 'mdw-eshell-prompt)
4367(setq-default eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
092f0a38 4368
2d8b2924
MW
4369(defun eshell/e (file) (find-file file) nil)
4370(defun eshell/ee (file) (find-file-other-window file) nil)
4371(defun eshell/w3m (url) (w3m-goto-url url) nil)
415a23dd 4372
092f0a38
MW
4373(mdw-define-face eshell-prompt (t :weight bold))
4374(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
4375(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
4376(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
4377(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
4378(mdw-define-face eshell-ls-executable (t :weight bold))
4379(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
4380(mdw-define-face eshell-ls-readonly (t nil))
4381(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
4382
b1a598dc 4383(defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
8845865d
MW
4384(add-hook 'eshell-mode-hook 'mdw-eshell-hack)
4385
092f0a38 4386;;;--------------------------------------------------------------------------
6132bc01 4387;;; Messages-file mode.
f617db13 4388
4bb22eea 4389(defun messages-mode-guts ()
f617db13
MW
4390 (setq messages-mode-syntax-table (make-syntax-table))
4391 (set-syntax-table messages-mode-syntax-table)
f617db13
MW
4392 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
4393 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
4394 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
4395 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
4396 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
4397 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
4398 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
4399 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
4400 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
4401 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
4402 (make-local-variable 'comment-start)
4403 (make-local-variable 'comment-end)
4404 (make-local-variable 'indent-line-function)
4405 (setq indent-line-function 'indent-relative)
4406 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4407 (make-local-variable 'font-lock-defaults)
4bb22eea 4408 (make-local-variable 'messages-mode-keywords)
f617db13 4409 (let ((keywords
8d6d55b9
MW
4410 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
4411 "export" "enum" "fixed-octetstring" "flags"
4412 "harmless" "map" "nested" "optional"
4413 "optional-tagged" "package" "primitive"
4414 "primitive-nullfree" "relaxed[ \t]+enum"
4415 "set" "table" "tagged-optional" "union"
4416 "variadic" "vector" "version" "version-tag")))
4bb22eea 4417 (setq messages-mode-keywords
535c927f
MW
4418 (list
4419 (list (concat "\\<\\(" keywords "\\)\\>:")
4420 '(0 font-lock-keyword-face))
4421 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
4422 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
4423 (0 font-lock-variable-name-face))
4424 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
4425 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4426 (0 mdw-punct-face)))))
f617db13 4427 (setq font-lock-defaults
535c927f 4428 '(messages-mode-keywords nil nil nil nil))
f617db13
MW
4429 (run-hooks 'messages-file-hook))
4430
4431(defun messages-mode ()
4432 (interactive)
4433 (fundamental-mode)
4434 (setq major-mode 'messages-mode)
4435 (setq mode-name "Messages")
4bb22eea 4436 (messages-mode-guts)
f617db13
MW
4437 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
4438 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
4439 (setq comment-start "# ")
4440 (setq comment-end "")
f617db13
MW
4441 (run-hooks 'messages-mode-hook))
4442
4443(defun cpp-messages-mode ()
4444 (interactive)
4445 (fundamental-mode)
4446 (setq major-mode 'cpp-messages-mode)
4447 (setq mode-name "CPP Messages")
4bb22eea 4448 (messages-mode-guts)
f617db13
MW
4449 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
4450 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
4451 (setq comment-start "/* ")
4452 (setq comment-end " */")
4453 (let ((preprocessor-keywords
8d6d55b9
MW
4454 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
4455 "ident" "if" "ifdef" "ifndef" "import" "include"
4456 "line" "pragma" "unassert" "undef" "warning")))
4bb22eea 4457 (setq messages-mode-keywords
535c927f
MW
4458 (append (list (list (concat "^[ \t]*\\#[ \t]*"
4459 "\\(include\\|import\\)"
4460 "[ \t]*\\(<[^>]+\\(>\\)?\\)")
4461 '(2 font-lock-string-face))
4462 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
4463 preprocessor-keywords
4464 "\\)\\>\\|[0-9]+\\|$\\)\\)")
4465 '(1 font-lock-keyword-face)))
4466 messages-mode-keywords)))
297d60aa 4467 (run-hooks 'cpp-messages-mode-hook))
f617db13 4468
b50c6712
MW
4469(progn
4470 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
4471 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
4472 ;; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
4473 )
f617db13 4474
6132bc01
MW
4475;;;--------------------------------------------------------------------------
4476;;; Messages-file mode.
f617db13
MW
4477
4478(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
4479 "Face to use for subsittution directives.")
4480(make-face 'mallow-driver-substitution-face)
4481(defvar mallow-driver-text-face 'mallow-driver-text-face
4482 "Face to use for body text.")
4483(make-face 'mallow-driver-text-face)
4484
4485(defun mallow-driver-mode ()
4486 (interactive)
4487 (fundamental-mode)
4488 (setq major-mode 'mallow-driver-mode)
4489 (setq mode-name "Mallow driver")
4490 (setq mallow-driver-mode-syntax-table (make-syntax-table))
4491 (set-syntax-table mallow-driver-mode-syntax-table)
4492 (make-local-variable 'comment-start)
4493 (make-local-variable 'comment-end)
4494 (make-local-variable 'indent-line-function)
4495 (setq indent-line-function 'indent-relative)
4496 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4497 (make-local-variable 'font-lock-defaults)
4498 (make-local-variable 'mallow-driver-mode-keywords)
4499 (let ((keywords
8d6d55b9
MW
4500 (mdw-regexps "each" "divert" "file" "if"
4501 "perl" "set" "string" "type" "write")))
f617db13 4502 (setq mallow-driver-mode-keywords
535c927f
MW
4503 (list
4504 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
4505 '(0 font-lock-keyword-face))
4506 (list "^%\\s *\\(#.*\\)?$"
4507 '(0 font-lock-comment-face))
4508 (list "^%"
4509 '(0 font-lock-keyword-face))
4510 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
4511 (list "\\${[^}]*}"
4512 '(0 mallow-driver-substitution-face t)))))
f617db13
MW
4513 (setq font-lock-defaults
4514 '(mallow-driver-mode-keywords nil nil nil nil))
4515 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
4516 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
4517 (setq comment-start "%# ")
4518 (setq comment-end "")
f617db13
MW
4519 (run-hooks 'mallow-driver-mode-hook))
4520
b50c6712
MW
4521(progn
4522 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t))
f617db13 4523
6132bc01
MW
4524;;;--------------------------------------------------------------------------
4525;;; NFast debugs.
f617db13
MW
4526
4527(defun nfast-debug-mode ()
4528 (interactive)
4529 (fundamental-mode)
4530 (setq major-mode 'nfast-debug-mode)
4531 (setq mode-name "NFast debug")
4532 (setq messages-mode-syntax-table (make-syntax-table))
4533 (set-syntax-table messages-mode-syntax-table)
4534 (make-local-variable 'font-lock-defaults)
4535 (make-local-variable 'nfast-debug-mode-keywords)
4536 (setq truncate-lines t)
4537 (setq nfast-debug-mode-keywords
535c927f
MW
4538 (list
4539 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
4540 (0 font-lock-keyword-face))
4541 (list (concat "^[ \t]+\\(\\("
4542 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
4543 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
4544 "[ \t]+\\)*"
4545 "[0-9a-fA-F]+\\)[ \t]*$")
4546 '(0 mdw-number-face))
4547 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
4548 (1 font-lock-keyword-face))
4549 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
4550 (1 font-lock-warning-face))
4551 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
4552 (1 nil))
4553 (list (concat "^[ \t]+\\.cmd=[ \t]+"
4554 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
4555 '(1 font-lock-keyword-face))
4556 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
4557 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
4558 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
4559 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
f617db13 4560 (setq font-lock-defaults
535c927f 4561 '(nfast-debug-mode-keywords nil nil nil nil))
f617db13
MW
4562 (run-hooks 'nfast-debug-mode-hook))
4563
6132bc01 4564;;;--------------------------------------------------------------------------
658bc848 4565;;; Lispy languages.
f617db13 4566
873d87df
MW
4567;; Unpleasant bodge.
4568(unless (boundp 'slime-repl-mode-map)
4569 (setq slime-repl-mode-map (make-sparse-keymap)))
4570
f617db13
MW
4571(defun mdw-indent-newline-and-indent ()
4572 (interactive)
4573 (indent-for-tab-command)
4574 (newline-and-indent))
4575
4576(eval-after-load "cl-indent"
4577 '(progn
4578 (mapc #'(lambda (pair)
4579 (put (car pair)
4580 'common-lisp-indent-function
4581 (cdr pair)))
4582 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
4583 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
4584
4585(defun mdw-common-lisp-indent ()
8a425bd7 4586 (make-local-variable 'lisp-indent-function)
f617db13
MW
4587 (setq lisp-indent-function 'common-lisp-indent-function))
4588
36cd5c10
MW
4589(defmacro mdw-advise-hyperspec-lookup (func args)
4590 `(defadvice ,func (around mdw-browse-w3m ,args activate compile)
4591 (if (fboundp 'w3m)
4592 (let ((browse-url-browser-function #'mdw-w3m-browse-url))
4593 ad-do-it)
4594 ad-do-it)))
0c3e50d5
MW
4595(mdw-advise-hyperspec-lookup common-lisp-hyperspec (symbol))
4596(mdw-advise-hyperspec-lookup common-lisp-hyperspec-format (char))
4597(mdw-advise-hyperspec-lookup common-lisp-hyperspec-lookup-reader-macro (char))
36cd5c10 4598
f617db13
MW
4599(defun mdw-fontify-lispy ()
4600
6132bc01 4601 ;; Set fill prefix.
f617db13
MW
4602 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
4603
6132bc01 4604 ;; Not much fontification needed.
02109a0d 4605 (make-local-variable 'font-lock-keywords)
535c927f
MW
4606 (setq font-lock-keywords
4607 (list (list (concat "\\("
4608 "\\_<[-+]?"
4609 "\\(" "[0-9]+/[0-9]+"
4610 "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
4611 "\\.[0-9]+" "\\)"
4612 "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
4613 "\\)"
4614 "\\|"
4615 "#"
4616 "\\(" "x" "[-+]?"
4617 "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
4618 "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
4619 "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
4620 "\\|" "[0-9]+" "r" "[-+]?"
4621 "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
4622 "\\)"
4623 "\\)\\_>")
4624 '(0 mdw-number-face))
4625 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4626 '(0 mdw-punct-face)))))
f617db13 4627
7ab487de
MW
4628;; Special indentation.
4629
1be8ceca 4630(defvar mdw-lisp-loop-default-indent 2)
fcbac48d 4631(defvar mdw-lisp-setf-value-indent 2)
1be8ceca
MW
4632
4633(setq lisp-simple-loop-indentation 0
4634 lisp-loop-keyword-indentation 0
4635 lisp-loop-forms-indentation 2
4636 lisp-lambda-list-keyword-parameter-alignment t)
7ab487de 4637
48e4a665
MW
4638(defun mdw-indent-funcall
4639 (path state &optional indent-point sexp-column normal-indent)
a0075a4a
MW
4640 "Indent `funcall' more usefully.
4641Essentially, treat `funcall foo' as a function name, and align the arguments
4642to `foo'."
48e4a665 4643 (and (or (not (consp path)) (null (cadr path)))
a0075a4a
MW
4644 (save-excursion
4645 (goto-char (cadr state))
4646 (forward-char 1)
4647 (let ((start-line (line-number-at-pos)))
4648 (and (condition-case nil (progn (forward-sexp 3) t)
4649 (scan-error nil))
4650 (progn
4651 (forward-sexp -1)
4652 (and (= start-line (line-number-at-pos))
4653 (current-column))))))))
48e4a665
MW
4654(progn
4655 (put 'funcall 'common-lisp-indent-function 'mdw-indent-funcall)
4656 (put 'funcall 'lisp-indent-function 'mdw-indent-funcall))
a0075a4a 4657
fcbac48d
MW
4658(defun mdw-indent-setf
4659 (path state &optional indent-point sexp-column normal-indent)
4660 "Indent `setf' more usefully.
4661If the values aren't on the same lines as their variables then indent them
4662by `mdw-lisp-setf-value-indent' spaces."
4663 (and (or (not (consp path)) (null (cadr path)))
4664 (let ((basic-indent (save-excursion
4665 (goto-char (cadr state))
4666 (forward-char 1)
4667 (and (condition-case nil
4668 (progn (forward-sexp 2) t)
4669 (scan-error nil))
4670 (progn
4671 (forward-sexp -1)
4672 (current-column)))))
4673 (offset (if (consp path) (car path)
4674 (catch 'done
4675 (save-excursion
4676 (let ((start path)
4677 (count 0))
4678 (goto-char (cadr state))
4679 (forward-char 1)
4680 (while (< (point) start)
4681 (condition-case nil (forward-sexp 1)
4682 (scan-error (throw 'done nil)))
4683 (incf count))
4684 (1- count)))))))
4685 (and basic-indent offset
4686 (list (+ basic-indent
4687 (if (oddp offset) 0
4688 mdw-lisp-setf-value-indent))
4689 basic-indent)))))
4690(progn
4691 (put 'setf 'common-lisp-indent-functopion 'mdw-indent-setf)
4692 (put 'psetf 'common-lisp-indent-function 'mdw-indent-setf)
4693 (put 'setq 'common-lisp-indent-function 'mdw-indent-setf)
4694 (put 'setf 'lisp-indent-function 'mdw-indent-setf)
4695 (put 'setq 'lisp-indent-function 'mdw-indent-setf)
4696 (put 'setq-local 'lisp-indent-function 'mdw-indent-setf)
4697 (put 'setq-default 'lisp-indent-function 'mdw-indent-setf))
4698
1be8ceca
MW
4699(defadvice common-lisp-loop-part-indentation
4700 (around mdw-fix-loop-indentation (indent-point state) activate compile)
4701 "Improve `loop' indentation.
4702If the first subform is on the same line as the `loop' keyword, then
4703align the other subforms beneath it. Otherwise, indent them
4704`mdw-lisp-loop-default-indent' columns in from the opening parenthesis."
4705
4706 (let* ((loop-indentation (save-excursion
4707 (goto-char (elt state 1))
4708 (current-column))))
4709
4710 ;; Don't really care about this.
dede52e3
MW
4711 (when (and (boundp 'lisp-indent-backquote-substitution-mode)
4712 (eq lisp-indent-backquote-substitution-mode 'corrected))
1be8ceca
MW
4713 (save-excursion
4714 (goto-char (elt state 1))
4715 (cl-incf loop-indentation
4716 (cond ((eq (char-before) ?,) -1)
4717 ((and (eq (char-before) ?@)
4718 (progn (backward-char)
4719 (eq (char-before) ?,)))
4720 -2)
4721 (t 0)))))
4722
4723 ;; If the first loop item is on the same line as the `loop' itself then
4724 ;; use that as the baseline. Otherwise advance by the default indent.
4725 (goto-char (cadr state))
4726 (forward-char 1)
4727 (let ((baseline-indent
4728 (if (= (line-number-at-pos)
4729 (if (condition-case nil (progn (forward-sexp 2) t)
4730 (scan-error nil))
4731 (progn (forward-sexp -1) (line-number-at-pos))
4732 -1))
4733 (current-column)
4734 (+ loop-indentation mdw-lisp-loop-default-indent))))
4735
4736 (goto-char indent-point)
4737 (beginning-of-line)
4738
4739 (setq ad-return-value
535c927f 4740 (list
dede52e3
MW
4741 (cond ((condition-case ()
4742 (save-excursion
4743 (goto-char (elt state 1))
4744 (forward-char 1)
4745 (forward-sexp 2)
4746 (backward-sexp 1)
4747 (not (looking-at "\\(:\\|\\sw\\)")))
4748 (error nil))
535c927f
MW
4749 (+ baseline-indent lisp-simple-loop-indentation))
4750 ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
4751 (+ baseline-indent lisp-loop-keyword-indentation))
4752 (t
4753 (+ baseline-indent lisp-loop-forms-indentation)))
4754
4755 ;; Tell the caller that the next line needs recomputation,
4756 ;; even though it doesn't start a sexp.
4757 loop-indentation)))))
1be8ceca 4758
b50c6712
MW
4759;; SLIME setup.
4760
5432b9cd
MW
4761(defvar mdw-friendly-name "[mdw]"
4762 "How I want to be addressed.")
4763(defadvice slime-user-first-name
4764 (around mdw-use-friendly-name compile activate)
4765 (if mdw-friendly-name (setq ad-return-value mdw-friendly-name)
4766 ad-do-it))
4767
b50c6712
MW
4768(trap
4769 (if (not mdw-fast-startup)
4770 (progn
4771 (require 'slime-autoloads)
4772 (slime-setup '(slime-autodoc slime-c-p-c)))))
4773
4774(let ((stuff '((cmucl ("cmucl"))
4775 (sbcl ("sbcl") :coding-system utf-8-unix)
4776 (clisp ("clisp") :coding-system utf-8-unix))))
4777 (or (boundp 'slime-lisp-implementations)
4778 (setq slime-lisp-implementations nil))
4779 (while stuff
4780 (let* ((head (car stuff))
4781 (found (assq (car head) slime-lisp-implementations)))
4782 (setq stuff (cdr stuff))
4783 (if found
4784 (rplacd found (cdr head))
4785 (setq slime-lisp-implementations
535c927f 4786 (cons head slime-lisp-implementations))))))
b50c6712
MW
4787(setq slime-default-lisp 'sbcl)
4788
4789;; Hooks.
4790
4791(progn
4792 (dolist (hook '(emacs-lisp-mode-hook
4793 scheme-mode-hook
4794 lisp-mode-hook
4795 inferior-lisp-mode-hook
4796 lisp-interaction-mode-hook
4797 ielm-mode-hook
4798 slime-repl-mode-hook))
4799 (add-hook hook 'mdw-misc-mode-config t)
4800 (add-hook hook 'mdw-fontify-lispy t))
4801 (add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
4802 (add-hook 'inferior-lisp-mode-hook
4803 #'(lambda () (local-set-key "\C-m" 'comint-send-and-indent)) t))
4804
658bc848
MW
4805;;;--------------------------------------------------------------------------
4806;;; Other languages.
4807
4808;; Smalltalk.
4809
4810(defun mdw-setup-smalltalk ()
4811 (and mdw-auto-indent
4812 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
4813 (make-local-variable 'mdw-auto-indent)
4814 (setq mdw-auto-indent nil)
4815 (local-set-key "\C-i" 'smalltalk-reindent))
4816
4817(defun mdw-fontify-smalltalk ()
4818 (make-local-variable 'font-lock-keywords)
4819 (setq font-lock-keywords
535c927f
MW
4820 (list
4821 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
4822 '(0 font-lock-keyword-face))
4823 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
4824 "[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
4825 "\\([eE][-+]?[0-9_]+\\)?")
4826 '(0 mdw-number-face))
4827 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4828 '(0 mdw-punct-face)))))
658bc848 4829
b50c6712
MW
4830(progn
4831 (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
4832 (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
4833
df77a575
MW
4834;; m4.
4835
ec007bea 4836(defun mdw-setup-m4 ()
ed5d93a4
MW
4837
4838 ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
4839 ;; annoying: fix it.
4840 (modify-syntax-entry ?{ "(")
4841 (modify-syntax-entry ?} ")")
4842
4843 ;; Fill prefix.
ec007bea
MW
4844 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
4845
b50c6712
MW
4846(dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
4847 (add-hook hook #'mdw-misc-mode-config t)
4848 (add-hook hook #'mdw-setup-m4 t))
4849
4850;; Make.
4851
4852(progn
4853 (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
4854
6132bc01
MW
4855;;;--------------------------------------------------------------------------
4856;;; Text mode.
f617db13
MW
4857
4858(defun mdw-text-mode ()
4859 (setq fill-column 72)
4860 (flyspell-mode t)
4861 (mdw-standard-fill-prefix
c7a8da49 4862 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
f617db13
MW
4863 (auto-fill-mode 1))
4864
060c23ce
MW
4865(eval-after-load "flyspell"
4866 '(define-key flyspell-mode-map "\C-\M-i" nil))
4867
b50c6712
MW
4868(progn
4869 (add-hook 'text-mode-hook 'mdw-text-mode t))
4870
6132bc01 4871;;;--------------------------------------------------------------------------
faf2cef7 4872;;; Outline and hide/show modes.
5de5db48
MW
4873
4874(defun mdw-outline-collapse-all ()
4875 "Completely collapse everything in the entire buffer."
4876 (interactive)
4877 (save-excursion
4878 (goto-char (point-min))
4879 (while (< (point) (point-max))
4880 (hide-subtree)
4881 (forward-line))))
4882
faf2cef7
MW
4883(setq hs-hide-comments-when-hiding-all nil)
4884
b200af26 4885(defadvice hs-hide-all (after hide-first-comment activate)
941c29ba 4886 (save-excursion (hs-hide-initial-comment-block)))
b200af26 4887
6132bc01
MW
4888;;;--------------------------------------------------------------------------
4889;;; Shell mode.
f617db13
MW
4890
4891(defun mdw-sh-mode-setup ()
4892 (local-set-key [?\C-a] 'comint-bol)
4893 (add-hook 'comint-output-filter-functions
4894 'comint-watch-for-password-prompt))
4895
4896(defun mdw-term-mode-setup ()
3d9147ea 4897 (setq term-prompt-regexp shell-prompt-pattern)
f617db13
MW
4898 (make-local-variable 'mouse-yank-at-point)
4899 (make-local-variable 'transient-mark-mode)
4900 (setq mouse-yank-at-point t)
f617db13
MW
4901 (auto-fill-mode -1)
4902 (setq tab-width 8))
4903
3d9147ea
MW
4904(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
4905(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
4906(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
4907(defun term-send-meta-meta-something ()
4908 (interactive)
4909 (term-send-raw-string "\e\e")
4910 (term-send-raw))
4911(eval-after-load 'term
4912 '(progn
4913 (define-key term-raw-map [?\e ?\e] nil)
4914 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
4915 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
4916 (define-key term-raw-map [M-right] 'term-send-meta-right)
4917 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
4918 (define-key term-raw-map [M-left] 'term-send-meta-left)
4919 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
4920
c4434c20
MW
4921(defadvice term-exec (before program-args-list compile activate)
4922 "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
4923This allows you to pass a list of arguments through `ansi-term'."
4924 (let ((program (ad-get-arg 2)))
4925 (if (listp program)
4926 (progn
4927 (ad-set-arg 2 (car program))
4928 (ad-set-arg 4 (cdr program))))))
4929
8845865d
MW
4930(defadvice term-exec-1 (around hack-environment compile activate)
4931 "Hack the environment inherited by inferiors in the terminal."
f8592fee 4932 (let ((process-environment (copy-tree process-environment)))
8845865d
MW
4933 (setenv "LD_PRELOAD" nil)
4934 ad-do-it))
4935
4936(defadvice shell (around hack-environment compile activate)
4937 "Hack the environment inherited by inferiors in the shell."
f8592fee 4938 (let ((process-environment (copy-tree process-environment)))
8845865d
MW
4939 (setenv "LD_PRELOAD" nil)
4940 ad-do-it))
4941
c4434c20
MW
4942(defun ssh (host)
4943 "Open a terminal containing an ssh session to the HOST."
4944 (interactive "sHost: ")
4945 (ansi-term (list "ssh" host) (format "ssh@%s" host)))
4946
5aa1b95f 4947(defvar git-grep-command
20b6cd68 4948 "env GIT_PAGER=cat git grep --no-color -nH -e "
5aa1b95f
MW
4949 "*The default command for \\[git-grep].")
4950
4951(defvar git-grep-history nil)
4952
4953(defun git-grep (command-args)
4954 "Run `git grep' with user-specified args and collect output in a buffer."
4955 (interactive
4956 (list (read-shell-command "Run git grep (like this): "
4957 git-grep-command 'git-grep-history)))
6a0a9a51
MW
4958 (let ((grep-use-null-device nil))
4959 (grep command-args)))
5aa1b95f 4960
c63bce81
MW
4961;;;--------------------------------------------------------------------------
4962;;; Magit configuration.
4963
30702ee3 4964(setq magit-diff-refine-hunk 't
c14a5ec3 4965 magit-view-git-manual-method 'man
83d2acdd 4966 magit-log-margin '(nil age magit-log-margin-width t 18)
c14a5ec3
MW
4967 magit-wip-after-save-local-mode-lighter ""
4968 magit-wip-after-apply-mode-lighter ""
4969 magit-wip-before-change-mode-lighter "")
4970(eval-after-load "magit"
4971 '(progn (global-magit-file-mode 1)
4972 (magit-wip-after-save-mode 1)
4973 (magit-wip-after-apply-mode 1)
4974 (magit-wip-before-change-mode 1)
60c22e1b 4975 (add-to-list 'magit-no-confirm 'safe-with-wip)
2a67803a 4976 (add-to-list 'magit-no-confirm 'trash)
87746eb7
MW
4977 (push '(:eval (if (or magit-wip-after-save-local-mode
4978 magit-wip-after-apply-mode
4979 magit-wip-before-change-mode)
4980 (format " wip:%s%s%s"
4981 (if magit-wip-after-apply-mode "A" "")
4982 (if magit-wip-before-change-mode "C" "")
4983 (if magit-wip-after-save-local-mode "S" ""))))
4984 minor-mode-alist)
60c22e1b
MW
4985 (dolist (popup '(magit-diff-popup
4986 magit-diff-refresh-popup
4987 magit-diff-mode-refresh-popup
4988 magit-revision-mode-refresh-popup))
4989 (magit-define-popup-switch popup ?R "Reverse diff" "-R"))))
c14a5ec3 4990
28509f06
MW
4991(defadvice magit-wip-commit-buffer-file
4992 (around mdw-just-this-buffer activate compile)
4993 (let ((magit-save-repository-buffers nil)) ad-do-it))
4994
2a67803a
MW
4995(defadvice magit-discard
4996 (around mdw-delete-if-prefix-argument activate compile)
4997 (let ((magit-delete-by-moving-to-trash
4998 (and (null current-prefix-arg)
4999 magit-delete-by-moving-to-trash)))
5000 ad-do-it))
5001
ff6a7bee 5002(setq magit-repolist-columns
535c927f
MW
5003 '(("Name" 16 magit-repolist-column-ident nil)
5004 ("Version" 18 magit-repolist-column-version nil)
5005 ("St" 2 magit-repolist-column-dirty nil)
5006 ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
5007 ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
5008 ("Path" 32 magit-repolist-column-path nil)))
ff6a7bee
MW
5009
5010(setq magit-repository-directories '(("~/etc/profile" . 0)
5011 ("~/src/" . 1)))
5012
5013(defadvice magit-list-repos (around mdw-dirname () activate compile)
5014 "Make sure the returned names are directory names.
5015Otherwise child processes get started in the wrong directory and
5016there is sadness."
5017 (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
5018
5019(defun mdw-repolist-column-unpulled-from-upstream (_id)
5020 "Insert number of upstream commits not in the current branch."
5021 (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5022 (and upstream
5023 (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
5024 (propertize (number-to-string n) 'face
5025 (if (> n 0) 'bold 'shadow))))))
5026
5027(defun mdw-repolist-column-unpushed-to-upstream (_id)
5028 "Insert number of commits in the current branch but not its upstream."
5029 (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5030 (and upstream
5031 (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
5032 (propertize (number-to-string n) 'face
5033 (if (> n 0) 'bold 'shadow))))))
5034
5d824e2f
MW
5035(defun mdw-try-smerge ()
5036 (save-excursion
5037 (goto-char (point-min))
5038 (when (re-search-forward "^<<<<<<< " nil t)
5039 (smerge-mode 1))))
5040(add-hook 'find-file-hook 'mdw-try-smerge t)
5041
e07e3320 5042;;;--------------------------------------------------------------------------
e48c2e5b
MW
5043;;; GUD, and especially GDB.
5044
5045;; Inhibit window dedication. I mean, seriously, wtf?
5046(defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
5047 "Don't make windows dedicated. Seriously."
5048 (set-window-dedicated-p ad-return-value nil))
5049(defadvice gdb-set-window-buffer
5050 (after mdw-undedicated (name &optional ignore-dedicated window)
5051 compile activate)
5052 "Don't make windows dedicated. Seriously."
5053 (set-window-dedicated-p (or window (selected-window)) nil))
5054
5055;;;--------------------------------------------------------------------------
234ade9d
MW
5056;;; Man pages.
5057
5058;; Turn off `noip' when running `man': it interferes with `man-db''s own
5059;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
5060;; better.
5061(defadvice Man-getpage-in-background
5062 (around mdw-inhibit-noip (topic) compile activate)
5063 "Inhibit the `noip' preload hack when invoking `man'."
5064 (let* ((old-preload (getenv "LD_PRELOAD"))
15e3b2e2
MW
5065 (preloads (and old-preload
5066 (save-match-data (split-string old-preload ":"))))
234ade9d
MW
5067 (any nil)
5068 (filtered nil))
4b7a0fa8
MW
5069 (save-match-data
5070 (while preloads
5071 (let ((item (pop preloads)))
5072 (if (string-match "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item)
5073 (setq any t)
5074 (push item filtered)))))
234ade9d
MW
5075 (if any
5076 (unwind-protect
5077 (progn
5078 (setenv "LD_PRELOAD"
5079 (and filtered
5080 (with-output-to-string
5081 (setq filtered (nreverse filtered))
5082 (let ((first t))
5083 (while filtered
5084 (if first (setq first nil)
5085 (write-char ?:))
5086 (write-string (pop filtered)))))))
5087 ad-do-it)
5088 (setenv "LD_PRELOAD" old-preload))
5089 ad-do-it)))
5090
5091;;;--------------------------------------------------------------------------
0f81a131
MW
5092;;; MPC configuration.
5093
50a77b30
MW
5094(eval-when-compile (trap (require 'mpc)))
5095
0f81a131
MW
5096(setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
5097
5098(defun mdw-mpc-now-playing ()
5099 (interactive)
5100 (require 'mpc)
5101 (save-excursion
5102 (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
5103 (mpc--status-callback))
5104 (let ((state (cdr (assq 'state mpc-status))))
5105 (cond ((member state '("stop"))
5106 (message "mpd stopped."))
5107 ((member state '("play" "pause"))
5108 (let* ((artist (cdr (assq 'Artist mpc-status)))
5109 (album (cdr (assq 'Album mpc-status)))
5110 (title (cdr (assq 'Title mpc-status)))
5111 (file (cdr (assq 'file mpc-status)))
5112 (duration-string (cdr (assq 'Time mpc-status)))
5113 (time-string (cdr (assq 'time mpc-status)))
5114 (time (and time-string
355d1336 5115 (string-to-number
0f81a131
MW
5116 (if (string-match ":" time-string)
5117 (substring time-string
5118 0 (match-beginning 0))
5119 (time-string)))))
5120 (duration (and duration-string
355d1336 5121 (string-to-number duration-string)))
0f81a131
MW
5122 (pos (and time duration
5123 (format " [%d:%02d/%d:%02d]"
5124 (/ time 60) (mod time 60)
5125 (/ duration 60) (mod duration 60))))
5126 (fmt (cond ((and artist title)
5127 (format "`%s' by %s%s" title artist
5128 (if album (format ", from `%s'" album)
5129 "")))
5130 (file
5131 (format "`%s' (no tags)" file))
5132 (t
5133 "(no idea what's playing!)"))))
5134 (if (string= state "play")
5135 (message "mpd playing %s%s" fmt (or pos ""))
5136 (message "mpd paused in %s%s" fmt (or pos "")))))
5137 (t
5138 (message "mpd in unknown state `%s'" state)))))
5139
4aba12fa
MW
5140(defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
5141 `(defun ,func ,bvl
5142 (interactive ,@interactive)
5143 (require 'mpc)
5144 ,@body
5145 (mdw-mpc-now-playing)))
5146
5147(mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
5148 (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
5149 (mpc-pause)
5150 (mpc-play)))
5151
5152(mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
5153(mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
5154(mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
0f81a131 5155
5147578f
MW
5156(defun mdw-mpc-louder (step)
5157 (interactive (list (if current-prefix-arg
5158 (prefix-numeric-value current-prefix-arg)
5159 +10)))
5160 (mpc-proc-cmd (format "volume %+d" step)))
5161
5162(defun mdw-mpc-quieter (step)
5163 (interactive (list (if current-prefix-arg
5164 (prefix-numeric-value current-prefix-arg)
5165 +10)))
5166 (mpc-proc-cmd (format "volume %+d" (- step))))
5167
6dbdfe26
MW
5168(defun mdw-mpc-hack-lines (arg interactivep func)
5169 (if (and interactivep (use-region-p))
5170 (let ((from (region-beginning)) (to (region-end)))
5171 (goto-char from)
5172 (beginning-of-line)
5173 (funcall func)
5174 (forward-line)
5175 (while (< (point) to)
5176 (funcall func)
5177 (forward-line)))
5178 (let ((n (prefix-numeric-value arg)))
5179 (cond ((minusp n)
5180 (unless (bolp)
5181 (beginning-of-line)
5182 (funcall func)
5183 (incf n))
5184 (while (minusp n)
5185 (forward-line -1)
5186 (funcall func)
5187 (incf n)))
5188 (t
5189 (beginning-of-line)
5190 (while (plusp n)
5191 (funcall func)
5192 (forward-line)
5193 (decf n)))))))
5194
5195(defun mdw-mpc-select-one ()
4466dfac
MW
5196 (when (and (get-char-property (point) 'mpc-file)
5197 (not (get-char-property (point) 'mpc-select)))
6dbdfe26
MW
5198 (mpc-select-toggle)))
5199
5200(defun mdw-mpc-unselect-one ()
5201 (when (get-char-property (point) 'mpc-select)
5202 (mpc-select-toggle)))
5203
5204(defun mdw-mpc-select (&optional arg interactivep)
5205 (interactive (list current-prefix-arg t))
a30d0e33 5206 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
6dbdfe26
MW
5207
5208(defun mdw-mpc-unselect (&optional arg interactivep)
5209 (interactive (list current-prefix-arg t))
a30d0e33 5210 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
6dbdfe26
MW
5211
5212(defun mdw-mpc-unselect-backwards (arg)
5213 (interactive "p")
a30d0e33 5214 (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
6dbdfe26
MW
5215
5216(defun mdw-mpc-unselect-all ()
5217 (interactive)
5218 (setq mpc-select nil)
5219 (mpc-selection-refresh))
5220
5221(defun mdw-mpc-next-line (arg)
5222 (interactive "p")
5223 (beginning-of-line)
5224 (forward-line arg))
5225
5226(defun mdw-mpc-previous-line (arg)
5227 (interactive "p")
5228 (beginning-of-line)
5229 (forward-line (- arg)))
5230
6d6f2b51
MW
5231(defun mdw-mpc-playlist-add (&optional arg interactivep)
5232 (interactive (list current-prefix-arg t))
5233 (let ((mpc-select mpc-select))
5234 (when (or arg (and interactivep (use-region-p)))
5235 (setq mpc-select nil)
5236 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5237 (setq mpc-select (reverse mpc-select))
5238 (mpc-playlist-add)))
5239
5240(defun mdw-mpc-playlist-delete (&optional arg interactivep)
5241 (interactive (list current-prefix-arg t))
5242 (setq mpc-select (nreverse mpc-select))
5243 (mpc-select-save
5244 (when (or arg (and interactivep (use-region-p)))
5245 (setq mpc-select nil)
5246 (mpc-selection-refresh)
5247 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5248 (mpc-playlist-delete)))
5249
75019c66
MW
5250(defun mdw-mpc-hack-tagbrowsers ()
5251 (setq-local mode-line-format
535c927f
MW
5252 '("%e"
5253 mode-line-frame-identification
5254 mode-line-buffer-identification)))
75019c66
MW
5255(add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
5256
65f6a37a
MW
5257(defun mdw-mpc-hack-songs ()
5258 (setq-local header-line-format
5259 ;; '("MPC " mpc-volume " " mpc-current-song)
5260 (list (propertize " " 'display '(space :align-to 0))
5261 ;; 'mpc-songs-format-description
5262 '(:eval
5263 (let ((deactivate-mark) (hscroll (window-hscroll)))
5264 (with-temp-buffer
5265 (mpc-format mpc-songs-format 'self hscroll)
5266 ;; That would be simpler than the hscroll handling in
5267 ;; mpc-format, but currently move-to-column does not
5268 ;; recognize :space display properties.
5269 ;; (move-to-column hscroll)
5270 ;; (delete-region (point-min) (point))
5271 (buffer-string)))))))
5272(add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
5273
6dbdfe26
MW
5274(eval-after-load "mpc"
5275 '(progn
5276 (define-key mpc-mode-map "m" 'mdw-mpc-select)
5277 (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
5278 (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
5279 (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
5280 (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
5281 (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
56ba17be 5282 (define-key mpc-mode-map "/" 'mpc-songs-search)
6dbdfe26
MW
5283 (setq mpc-songs-mode-map (make-sparse-keymap))
5284 (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
5285 (define-key mpc-songs-mode-map "l" 'mpc-playlist)
6d6f2b51
MW
5286 (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
5287 (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
56ba17be 5288 (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
6dbdfe26 5289
0f81a131 5290;;;--------------------------------------------------------------------------
e07e3320
MW
5291;;; Inferior Emacs Lisp.
5292
5293(setq comint-prompt-read-only t)
5294
5295(eval-after-load "comint"
5296 '(progn
5297 (define-key comint-mode-map "\C-w" 'comint-kill-region)
5298 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
5299
5300(eval-after-load "ielm"
5301 '(progn
5302 (define-key ielm-map "\C-w" 'comint-kill-region)
5303 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
5304
f617db13
MW
5305;;;----- That's all, folks --------------------------------------------------
5306
5307(provide 'dot-emacs)