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