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