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