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