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