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