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