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