dot/emacs, dot/xinitrc, el/dot-emacs.el: Flag for Emacs splash screen.
[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
61aab372
MW
27(defun mdw-check-command-line-switch (switch)
28 (let ((probe nil) (next command-line-args) (found nil))
29 (while next
30 (cond ((string= (car next) switch)
31 (setq found t)
32 (if probe (rplacd probe (cdr next))
33 (setq command-line-args (cdr next))))
34 (t
35 (setq probe next)))
36 (setq next (cdr next)))
37 found))
38
c7a8da49
MW
39(defvar mdw-fast-startup nil
40 "Whether .emacs should optimize for rapid startup.
41This may be at the expense of cool features.")
61aab372
MW
42(setq mdw-fast-startup
43 (mdw-check-command-line-switch "--mdw-fast-startup"))
c7a8da49 44
3a87e7ef
MW
45(defvar mdw-splashy-startup nil
46 "Whether to show a splash screen and related frippery.")
47(setq mdw-splashy-startup
48 (mdw-check-command-line-switch "--mdw-splashy-startup"))
49
6132bc01
MW
50;;;--------------------------------------------------------------------------
51;;; Some general utilities.
f617db13 52
417dcddd
MW
53(eval-when-compile
54 (unless (fboundp 'make-regexp)
55 (load "make-regexp"))
56 (require 'cl))
c7a8da49
MW
57
58(defmacro mdw-regexps (&rest list)
59 "Turn a LIST of strings into a single regular expression at compile-time."
9e789ed5
MW
60 (declare (indent nil)
61 (debug 0))
417dcddd 62 `',(make-regexp list))
c7a8da49 63
a1b01eb3
MW
64(defun mdw-wrong ()
65 "This is not the key sequence you're looking for."
66 (interactive)
67 (error "wrong button"))
68
e8ea88ba
MW
69(defun mdw-emacs-version-p (major &optional minor)
70 "Return non-nil if the running Emacs is at least version MAJOR.MINOR."
71 (or (> emacs-major-version major)
72 (and (= emacs-major-version major)
73 (>= emacs-minor-version (or minor 0)))))
74
6132bc01 75;; Some error trapping.
f617db13
MW
76;;
77;; If individual bits of this file go tits-up, we don't particularly want
78;; the whole lot to stop right there and then, because it's bloody annoying.
79
80(defmacro trap (&rest forms)
81 "Execute FORMS without allowing errors to propagate outside."
9e789ed5
MW
82 (declare (indent 0)
83 (debug t))
f617db13
MW
84 `(condition-case err
85 ,(if (cdr forms) (cons 'progn forms) (car forms))
8df912e4
MW
86 (error (message "Error (trapped): %s in %s"
87 (error-message-string err)
88 ',forms))))
f617db13 89
6132bc01 90;; Configuration reading.
f141fe0f
MW
91
92(defvar mdw-config nil)
93(defun mdw-config (sym)
94 "Read the configuration variable named SYM."
95 (unless mdw-config
daff679f
MW
96 (setq mdw-config
97 (flet ((replace (what with)
98 (goto-char (point-min))
99 (while (re-search-forward what nil t)
100 (replace-match with t))))
101 (with-temp-buffer
102 (insert-file-contents "~/.mdw.conf")
103 (replace "^[ \t]*\\(#.*\\|\\)\n" "")
104 (replace (concat "^[ \t]*"
105 "\\([-a-zA-Z0-9_.]*\\)"
106 "[ \t]*=[ \t]*"
107 "\\(.*[^ \t\n]\\|\\)"
108 "[ \t]**\\(\n\\|$\\)")
109 "(\\1 . \"\\2\")\n")
110 (car (read-from-string
111 (concat "(" (buffer-string) ")")))))))
f141fe0f
MW
112 (cdr (assq sym mdw-config)))
113
c7203018
MW
114;; Width configuration.
115
116(defvar mdw-column-width
117 (string-to-number (or (mdw-config 'emacs-width) "77"))
118 "Width of Emacs columns.")
119(defvar mdw-text-width mdw-column-width
120 "Expected width of text within columns.")
121(put 'mdw-text-width 'safe-local-variable 'integerp)
122
18bb0f77
MW
123;; Local variables hacking.
124
125(defun run-local-vars-mode-hook ()
126 "Run a hook for the major-mode after local variables have been processed."
127 (run-hooks (intern (concat (symbol-name major-mode)
128 "-local-variables-hook"))))
129(add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook)
130
6132bc01 131;; Set up the load path convincingly.
eac7b622
MW
132
133(dolist (dir (append (and (boundp 'debian-emacs-flavor)
134 (list (concat "/usr/share/"
135 (symbol-name debian-emacs-flavor)
136 "/site-lisp")))))
137 (dolist (sub (directory-files dir t))
138 (when (and (file-accessible-directory-p sub)
139 (not (member sub load-path)))
140 (setq load-path (nconc load-path (list sub))))))
141
6132bc01 142;; Is an Emacs library available?
cb6e2cd1
MW
143
144(defun library-exists-p (name)
6132bc01
MW
145 "Return non-nil if NAME is an available library.
146Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
147load path. The non-nil value is the filename we found for the
148library."
cb6e2cd1
MW
149 (let ((path load-path) elt (foundp nil))
150 (while (and path (not foundp))
151 (setq elt (car path))
152 (setq path (cdr path))
153 (setq foundp (or (let ((file (concat elt "/" name ".elc")))
154 (and (file-exists-p file) file))
155 (let ((file (concat elt "/" name ".el")))
156 (and (file-exists-p file) file)))))
157 foundp))
158
159(defun maybe-autoload (symbol file &optional docstring interactivep type)
160 "Set an autoload if the file actually exists."
161 (and (library-exists-p file)
162 (autoload symbol file docstring interactivep type)))
163
8183de08
MW
164(defun mdw-kick-menu-bar (&optional frame)
165 "Regenerate FRAME's menu bar so it doesn't have empty menus."
166 (interactive)
167 (unless frame (setq frame (selected-frame)))
168 (let ((old (frame-parameter frame 'menu-bar-lines)))
169 (set-frame-parameter frame 'menu-bar-lines 0)
170 (set-frame-parameter frame 'menu-bar-lines old)))
171
6132bc01 172;; Splitting windows.
f617db13 173
8c2b05d5
MW
174(unless (fboundp 'scroll-bar-columns)
175 (defun scroll-bar-columns (side)
176 (cond ((eq side 'left) 0)
177 (window-system 3)
178 (t 1))))
179(unless (fboundp 'fringe-columns)
180 (defun fringe-columns (side)
181 (cond ((not window-system) 0)
182 ((eq side 'left) 1)
183 (t 2))))
184
3ba0b777
MW
185(defun mdw-horizontal-window-overhead ()
186 "Computes the horizontal window overhead.
187This is the number of columns used by fringes, scroll bars and other such
188cruft."
189 (if (not window-system)
190 1
191 (let ((tot 0))
192 (dolist (what '(scroll-bar fringe))
193 (dolist (side '(left right))
194 (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
195 side))))
196 tot)))
197
198(defun mdw-split-window-horizontally (&optional width)
199 "Split a window horizontally.
200Without a numeric argument, split the window approximately in
201half. With a numeric argument WIDTH, allocate WIDTH columns to
202the left-hand window (if positive) or -WIDTH columns to the
203right-hand window (if negative). Space for scroll bars and
204fringes is not taken out of the allowance for WIDTH, unlike
205\\[split-window-horizontally]."
206 (interactive "P")
207 (split-window-horizontally
208 (cond ((null width) nil)
209 ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
210 ((< width 0) width))))
211
22e1b8c3
MW
212(defun mdw-preferred-column-width ()
213 "Return the preferred column width."
214 (if (and window-system (mdw-emacs-version-p 22)) mdw-column-width
215 (1+ mdw-column-width)))
216
8c2b05d5 217(defun mdw-divvy-window (&optional width)
f617db13 218 "Split a wide window into appropriate widths."
8c2b05d5 219 (interactive "P")
22e1b8c3
MW
220 (setq width (if width (prefix-numeric-value width)
221 (mdw-preferred-column-width)))
b5d724dd 222 (let* ((win (selected-window))
3ba0b777 223 (sb-width (mdw-horizontal-window-overhead))
b5d724dd 224 (c (/ (+ (window-width) sb-width)
8c2b05d5 225 (+ width sb-width))))
f617db13
MW
226 (while (> c 1)
227 (setq c (1- c))
8c2b05d5 228 (split-window-horizontally (+ width sb-width))
f617db13
MW
229 (other-window 1))
230 (select-window win)))
231
cc8708fc
MW
232(defun mdw-set-frame-width (columns &optional width)
233 (interactive "nColumns:
234P")
22e1b8c3
MW
235 (setq width (if width (prefix-numeric-value width)
236 (mdw-preferred-column-width)))
cc8708fc
MW
237 (let ((sb-width (mdw-horizontal-window-overhead)))
238 (set-frame-width (selected-frame)
239 (- (* columns (+ width sb-width))
240 sb-width))
241 (mdw-divvy-window width)))
242
cc2be23e
MW
243;; Don't raise windows unless I say so.
244
245(defvar mdw-inhibit-raise-frame nil
246 "*Whether `raise-frame' should do nothing when the frame is mapped.")
247
248(defadvice raise-frame
249 (around mdw-inhibit (&optional frame) activate compile)
250 "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
251frame is actually mapped on the screen."
252 (if mdw-inhibit-raise-frame
253 (make-frame-visible frame)
254 ad-do-it))
255
256(defmacro mdw-advise-to-inhibit-raise-frame (function)
257 "Advise the FUNCTION not to raise frames, even if it wants to."
258 `(defadvice ,function
259 (around mdw-inhibit-raise (&rest hunoz) activate compile)
260 "Don't raise the window unless you have to."
261 (let ((mdw-inhibit-raise-frame t))
262 ad-do-it)))
263
264(mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
b8e4b4a9 265(mdw-advise-to-inhibit-raise-frame appt-disp-window)
a3289165 266(mdw-advise-to-inhibit-raise-frame mouse-select-window)
cc2be23e 267
a1e4004c
MW
268;; Bug fix for markdown-mode, which breaks point positioning during
269;; `query-replace'.
270(defadvice markdown-check-change-for-wiki-link
271 (around mdw-save-match activate compile)
272 "Save match data around the `markdown-mode' `after-change-functions' hook."
273 (save-match-data ad-do-it))
274
d54a4cf3
MW
275;; Bug fix for `bbdb-canonicalize-address': on Emacs 24, `run-hook-with-args'
276;; always returns nil, with the result that all email addresses are lost.
277;; Replace the function entirely.
278(defadvice bbdb-canonicalize-address
279 (around mdw-bug-fix activate compile)
280 "Don't use `run-hook-with-args', because that doesn't work."
281 (let ((net (ad-get-arg 0)))
282
283 ;; Make sure this is a proper hook list.
284 (if (functionp bbdb-canonicalize-net-hook)
285 (setq bbdb-canonicalize-net-hook (list bbdb-canonicalize-net-hook)))
286
287 ;; Iterate over the hooks until things converge.
288 (let ((donep nil))
289 (while (not donep)
290 (let (next (changep nil)
291 hook (hooks bbdb-canonicalize-net-hook))
292 (while hooks
293 (setq hook (pop hooks))
294 (setq next (funcall hook net))
295 (if (not (equal next net))
296 (setq changep t
297 net next)))
298 (setq donep (not changep)))))
299 (setq ad-return-value net)))
300
c4b18360
MW
301;; Transient mark mode hacks.
302
303(defadvice exchange-point-and-mark
304 (around mdw-highlight (&optional arg) activate compile)
305 "Maybe don't actually exchange point and mark.
306If `transient-mark-mode' is on and the mark is inactive, then
307just activate it. A non-trivial prefix argument will force the
308usual behaviour. A trivial prefix argument (i.e., just C-u) will
309activate the mark and temporarily enable `transient-mark-mode' if
310it's currently off."
311 (cond ((or mark-active
312 (and (not transient-mark-mode) (not arg))
313 (and arg (or (not (consp arg))
314 (not (= (car arg) 4)))))
315 ad-do-it)
316 (t
317 (or transient-mark-mode (setq transient-mark-mode 'only))
318 (set-mark (mark t)))))
319
6132bc01 320;; Functions for sexp diary entries.
f617db13 321
aede9fd7
MW
322(defun mdw-not-org-mode (form)
323 "As FORM, but not in Org mode agenda."
324 (and (not mdw-diary-for-org-mode-p)
325 (eval form)))
326
f617db13
MW
327(defun mdw-weekday (l)
328 "Return non-nil if `date' falls on one of the days of the week in L.
6132bc01
MW
329L is a list of day numbers (from 0 to 6 for Sunday through to
330Saturday) or symbols `sunday', `monday', etc. (or a mixture). If
331the date stored in `date' falls on a listed day, then the
332function returns non-nil."
f617db13
MW
333 (let ((d (calendar-day-of-week date)))
334 (or (memq d l)
335 (memq (nth d '(sunday monday tuesday wednesday
336 thursday friday saturday)) l))))
337
d401f71b
MW
338(defun mdw-discordian-date (date)
339 "Return the Discordian calendar date corresponding to DATE.
340
341The return value is (YOLD . st-tibs-day) or (YOLD SEASON DAYNUM DOW).
342
343The original is by David Pearson. I modified it to produce date components
344as output rather than a string."
345 (let* ((days ["Sweetmorn" "Boomtime" "Pungenday"
346 "Prickle-Prickle" "Setting Orange"])
347 (months ["Chaos" "Discord" "Confusion"
348 "Bureaucracy" "Aftermath"])
349 (day-count [0 31 59 90 120 151 181 212 243 273 304 334])
350 (year (- (extract-calendar-year date) 1900))
351 (month (1- (extract-calendar-month date)))
352 (day (1- (extract-calendar-day date)))
353 (julian (+ (aref day-count month) day))
354 (dyear (+ year 3066)))
355 (if (and (= month 1) (= day 28))
356 (cons dyear 'st-tibs-day)
357 (list dyear
358 (aref months (floor (/ julian 73)))
359 (1+ (mod julian 73))
360 (aref days (mod julian 5))))))
361
362(defun mdw-diary-discordian-date ()
363 "Convert the date in `date' to a string giving the Discordian date."
364 (let* ((ddate (mdw-discordian-date date))
365 (tail (format "in the YOLD %d" (car ddate))))
366 (if (eq (cdr ddate) 'st-tibs-day)
367 (format "St Tib's Day %s" tail)
368 (let ((season (cadr ddate))
369 (daynum (caddr ddate))
370 (dayname (cadddr ddate)))
371 (format "%s, the %d%s day of %s %s"
372 dayname
373 daynum
374 (let ((ldig (mod daynum 10)))
375 (cond ((= ldig 1) "st")
376 ((= ldig 2) "nd")
377 ((= ldig 3) "rd")
378 (t "th")))
379 season
380 tail)))))
381
f617db13
MW
382(defun mdw-todo (&optional when)
383 "Return non-nil today, or on WHEN, whichever is later."
384 (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
385 (d (calendar-absolute-from-gregorian date)))
386 (if when
387 (setq w (max w (calendar-absolute-from-gregorian
388 (cond
389 ((not european-calendar-style)
390 when)
391 ((> (car when) 100)
392 (list (nth 1 when)
393 (nth 2 when)
394 (nth 0 when)))
395 (t
396 (list (nth 1 when)
397 (nth 0 when)
398 (nth 2 when))))))))
399 (eq w d)))
400
aede9fd7
MW
401(defvar mdw-diary-for-org-mode-p nil)
402
403(defadvice org-agenda-list (around mdw-preserve-links activate)
404 (let ((mdw-diary-for-org-mode-p t))
405 ad-do-it))
406
1d342abe 407(defadvice diary-add-to-list (before mdw-trim-leading-space compile activate)
9f58a8d2
MW
408 "Trim leading space from the diary entry string."
409 (save-match-data
2745469d
MW
410 (let ((str (ad-get-arg 1))
411 (done nil) old)
412 (while (not done)
413 (setq old str)
414 (setq str (cond ((null str) nil)
415 ((string-match "\\(^\\|\n\\)[ \t]+" str)
416 (replace-match "\\1" nil nil str))
aede9fd7
MW
417 ((and mdw-diary-for-org-mode-p
418 (string-match (concat
2745469d 419 "\\(^\\|\n\\)"
aede9fd7
MW
420 "\\(" diary-time-regexp
421 "\\(-" diary-time-regexp "\\)?"
2745469d
MW
422 "\\)"
423 "\\(\t[ \t]*\\| [ \t]+\\)")
aede9fd7 424 str))
2745469d 425 (replace-match "\\1\\2 " nil nil str))
aede9fd7
MW
426 ((and (not mdw-diary-for-org-mode-p)
427 (string-match "\\[\\[[^][]*]\\[\\([^][]*\\)]]"
428 str))
429 (replace-match "\\1" nil nil str))
2745469d
MW
430 (t str)))
431 (if (equal str old) (setq done t)))
432 (ad-set-arg 1 str))))
9f58a8d2 433
319736bd
MW
434(defadvice org-bbdb-anniversaries (after mdw-fixup-list compile activate)
435 "Return a string rather than a list."
436 (with-temp-buffer
437 (let ((anyp nil))
438 (dolist (e (let ((ee ad-return-value))
439 (if (atom ee) (list ee) ee)))
440 (when e
441 (when anyp (insert ?\n))
442 (insert e)
443 (setq anyp t)))
444 (setq ad-return-value
445 (and anyp (buffer-string))))))
446
6132bc01 447;; Fighting with Org-mode's evil key maps.
16fe7c41
MW
448
449(defvar mdw-evil-keymap-keys
450 '(([S-up] . [?\C-c up])
451 ([S-down] . [?\C-c down])
452 ([S-left] . [?\C-c left])
453 ([S-right] . [?\C-c right])
454 (([M-up] [?\e up]) . [C-up])
455 (([M-down] [?\e down]) . [C-down])
456 (([M-left] [?\e left]) . [C-left])
457 (([M-right] [?\e right]) . [C-right]))
458 "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
459The value is an alist mapping evil keys (as a list, or singleton)
460to good keys (in the same form).")
461
462(defun mdw-clobber-evil-keymap (keymap)
463 "Replace evil key bindings in the KEYMAP.
464Evil key bindings are defined in `mdw-evil-keymap-keys'."
465 (dolist (entry mdw-evil-keymap-keys)
466 (let ((binding nil)
467 (keys (if (listp (car entry))
468 (car entry)
469 (list (car entry))))
470 (replacements (if (listp (cdr entry))
471 (cdr entry)
472 (list (cdr entry)))))
473 (catch 'found
474 (dolist (key keys)
475 (setq binding (lookup-key keymap key))
476 (when binding
477 (throw 'found nil))))
478 (when binding
479 (dolist (key keys)
480 (define-key keymap key nil))
481 (dolist (key replacements)
482 (define-key keymap key binding))))))
483
1656a861
MW
484(defvar mdw-org-latex-defs
485 '(("strayman"
486 "\\documentclass{strayman}
f0dbee84
MW
487\\usepackage[utf8]{inputenc}
488\\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
f0dbee84 489\\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
1656a861
MW
490 ("\\section{%s}" . "\\section*{%s}")
491 ("\\subsection{%s}" . "\\subsection*{%s}")
492 ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
493 ("\\paragraph{%s}" . "\\paragraph*{%s}")
494 ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))))
495
496(eval-after-load "org-latex"
497 '(setq org-export-latex-classes
498 (append mdw-org-latex-defs org-export-latex-classes)))
f0dbee84 499
fbc946b7
MW
500(eval-after-load "ox-latex"
501 '(setq org-latex-classes (append mdw-org-latex-defs org-latex-classes)
502 org-latex-default-packages-alist '(("AUTO" "inputenc" t)
503 ("T1" "fontenc" t)
504 ("" "fixltx2e" nil)
505 ("" "graphicx" t)
506 ("" "longtable" nil)
507 ("" "float" nil)
508 ("" "wrapfig" nil)
509 ("" "rotating" nil)
510 ("normalem" "ulem" t)
511 ("" "textcomp" t)
512 ("" "marvosym" t)
513 ("" "wasysym" t)
514 ("" "amssymb" t)
515 ("" "hyperref" nil)
516 "\\tolerance=1000")))
517
518
8ba985cb
MW
519(setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
520 org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
521 org-export-docbook-xslt-stylesheet
522 "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
523
5a0925a4
MW
524;; Glasses.
525
526(setq glasses-separator "-"
527 glasses-separate-parentheses-p nil
528 glasses-uncapitalize-p t)
529
5dccbe61
MW
530;; Some hacks to do with window placement.
531
532(defun mdw-clobber-other-windows-showing-buffer (buffer-or-name)
533 "Arrange that no windows on other frames are showing BUFFER-OR-NAME."
534 (interactive "bBuffer: ")
535 (let ((home-frame (selected-frame))
536 (buffer (get-buffer buffer-or-name))
537 (safe-buffer (get-buffer "*scratch*")))
538 (mapc (lambda (frame)
539 (or (eq frame home-frame)
540 (mapc (lambda (window)
541 (and (eq (window-buffer window) buffer)
542 (set-window-buffer window safe-buffer)))
543 (window-list frame))))
544 (frame-list))))
545
546(defvar mdw-inhibit-walk-windows nil
547 "If non-nil, then `walk-windows' does nothing.
548This is used by advice on `switch-to-buffer-other-frame' to inhibit finding
549buffers in random frames.")
550
551(defadvice walk-windows (around mdw-inhibit activate)
552 "If `mdw-inhibit-walk-windows' is non-nil, then do nothing."
553 (and (not mdw-inhibit-walk-windows)
554 ad-do-it))
555
556(defadvice switch-to-buffer-other-frame
557 (around mdw-always-new-frame activate)
558 "Always make a new frame.
559Even if an existing window in some random frame looks tempting."
560 (let ((mdw-inhibit-walk-windows t)) ad-do-it))
561
562(defadvice display-buffer (before mdw-inhibit-other-frames activate)
563 "Don't try to do anything fancy with other frames.
564Pretend they don't exist. They might be on other display devices."
565 (ad-set-arg 2 nil))
566
6132bc01 567;;;--------------------------------------------------------------------------
b7fc31ec
MW
568;;; Improved compilation machinery.
569
570;; Uprated version of M-x compile.
571
572(setq compile-command
573 (let ((ncpu (with-temp-buffer
574 (insert-file-contents "/proc/cpuinfo")
575 (buffer-string)
576 (count-matches "^processor\\s-*:"))))
577 (format "make -j%d -k" (* 2 ncpu))))
578
579(defun mdw-compilation-buffer-name (mode)
580 (concat "*" (downcase mode) ": "
581 (abbreviate-file-name default-directory) "*"))
582(setq compilation-buffer-name-function 'mdw-compilation-buffer-name)
583
584(eval-after-load "compile"
585 '(progn
586 (define-key compilation-shell-minor-mode-map "\C-c\M-g" 'recompile)))
587
8845865d
MW
588(defadvice compile (around hack-environment compile activate)
589 "Hack the environment inherited by inferiors in the compilation."
f8592fee 590 (let ((process-environment (copy-tree process-environment)))
8845865d
MW
591 (setenv "LD_PRELOAD" nil)
592 ad-do-it))
593
b7fc31ec
MW
594(defun mdw-compile (command &optional directory comint)
595 "Initiate a compilation COMMAND, maybe in a different DIRECTORY.
596The DIRECTORY may be nil to not change. If COMINT is t, then
597start an interactive compilation.
598
599Interactively, prompt for the command if the variable
600`compilation-read-command' is non-nil, or if requested through
601the prefix argument. Prompt for the directory, and run
602interactively, if requested through the prefix.
603
604Use a prefix of 4, 6, 12, or 14, or type C-u between one and three times, to
605force prompting for a directory.
606
607Use a prefix of 2, 6, 10, or 14, or type C-u three times, to force
608prompting for the command.
609
610Use a prefix of 8, 10, 12, or 14, or type C-u twice or three times,
611to force interactive compilation."
612 (interactive
613 (let* ((prefix (prefix-numeric-value current-prefix-arg))
614 (command (eval compile-command))
615 (dir (and (plusp (logand prefix #x54))
616 (read-directory-name "Compile in directory: "))))
617 (list (if (or compilation-read-command
618 (plusp (logand prefix #x42)))
619 (compilation-read-command command)
620 command)
621 dir
622 (plusp (logand prefix #x58)))))
623 (let ((default-directory (or directory default-directory)))
624 (compile command comint)))
625
50d3dd03
MW
626;; Flymake support.
627
628(defun mdw-find-build-dir (build-file)
629 (catch 'found
630 (let* ((src-dir (file-name-as-directory (expand-file-name ".")))
631 (dir src-dir))
632 (loop
633 (when (file-exists-p (concat dir build-file))
634 (throw 'found dir))
635 (let ((sub (expand-file-name (file-relative-name src-dir dir)
636 (concat dir "build/"))))
637 (catch 'give-up
638 (loop
639 (when (file-exists-p (concat sub build-file))
640 (throw 'found sub))
641 (when (string= sub dir) (throw 'give-up nil))
642 (setq sub (file-name-directory (directory-file-name sub))))))
643 (when (string= dir
644 (setq dir (file-name-directory
645 (directory-file-name dir))))
646 (throw 'found nil))))))
647
648(defun mdw-flymake-make-init ()
649 (let ((build-dir (mdw-find-build-dir "Makefile")))
650 (and build-dir
651 (let ((tmp-src (flymake-init-create-temp-buffer-copy
652 #'flymake-create-temp-inplace)))
653 (flymake-get-syntax-check-program-args
654 tmp-src build-dir t t
655 #'flymake-get-make-cmdline)))))
656
657(setq flymake-allowed-file-name-masks
f1150017 658 '(("\\.\\(?:[cC]\\|cc\\|cpp\\|cxx\\|c\\+\\+\\)\\'"
50d3dd03 659 mdw-flymake-make-init)
f1150017 660 ("\\.\\(?:[hH]\\|hh\\|hpp\\|hxx\\|h\\+\\+\\)\\'"
50d3dd03
MW
661 mdw-flymake-master-make-init)
662 ("\\.p[lm]" flymake-perl-init)))
663
664(setq flymake-mode-map
665 (let ((map (if (boundp 'flymake-mode-map)
666 flymake-mode-map
667 (make-sparse-keymap))))
668 (define-key map [?\C-c ?\C-f ?\C-p] 'flymake-goto-prev-error)
669 (define-key map [?\C-c ?\C-f ?\C-n] 'flymake-goto-next-error)
670 (define-key map [?\C-c ?\C-f ?\C-c] 'flymake-compile)
671 (define-key map [?\C-c ?\C-f ?\C-k] 'flymake-stop-all-syntax-checks)
672 (define-key map [?\C-c ?\C-f ?\C-e] 'flymake-popup-current-error-menu)
673 map))
674
b7fc31ec 675;;;--------------------------------------------------------------------------
6132bc01 676;;; Mail and news hacking.
a3bdb4d9
MW
677
678(define-derived-mode mdwmail-mode mail-mode "[mdw] mail"
6132bc01 679 "Major mode for editing news and mail messages from external programs.
a3bdb4d9
MW
680Not much right now. Just support for doing MailCrypt stuff."
681 :syntax-table nil
682 :abbrev-table nil
683 (run-hooks 'mail-setup-hook))
684
685(define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
686
687(add-hook 'mdwail-mode-hook
688 (lambda ()
689 (set-buffer-file-coding-system 'utf-8)
690 (make-local-variable 'paragraph-separate)
691 (make-local-variable 'paragraph-start)
692 (setq paragraph-start
693 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
694 paragraph-start))
695 (setq paragraph-separate
696 (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
697 paragraph-separate))))
698
6132bc01 699;; How to encrypt in mdwmail.
a3bdb4d9
MW
700
701(defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
702 (or start
703 (setq start (save-excursion
704 (goto-char (point-min))
705 (or (search-forward "\n\n" nil t) (point-min)))))
706 (or end
707 (setq end (point-max)))
708 (mc-encrypt-generic recip scm start end from sign))
709
6132bc01 710;; How to sign in mdwmail.
a3bdb4d9
MW
711
712(defun mdwmail-mc-sign (key scm start end uclr)
713 (or start
714 (setq start (save-excursion
715 (goto-char (point-min))
716 (or (search-forward "\n\n" nil t) (point-min)))))
717 (or end
718 (setq end (point-max)))
719 (mc-sign-generic key scm start end uclr))
720
6132bc01 721;; Some signature mangling.
a3bdb4d9
MW
722
723(defun mdwmail-mangle-signature ()
724 (save-excursion
725 (goto-char (point-min))
726 (perform-replace "\n-- \n" "\n-- " nil nil nil)))
727(add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
728(add-hook 'message-setup-hook 'mdwmail-mangle-signature)
729
6132bc01 730;; Insert my login name into message-ids, so I can score replies.
a3bdb4d9
MW
731
732(defadvice message-unique-id (after mdw-user-name last activate compile)
733 "Ensure that the user's name appears at the end of the message-id string,
734so that it can be used for convenient filtering."
735 (setq ad-return-value (concat ad-return-value "." (user-login-name))))
736
6132bc01 737;; Tell my movemail hack where movemail is.
a3bdb4d9
MW
738;;
739;; This is needed to shup up warnings about LD_PRELOAD.
740
741(let ((path exec-path))
742 (while path
743 (let ((try (expand-file-name "movemail" (car path))))
744 (if (file-executable-p try)
745 (setenv "REAL_MOVEMAIL" try))
746 (setq path (cdr path)))))
747
4d5799eb
MW
748;; AUTHINFO GENERIC kludge.
749
750(defvar nntp-authinfo-generic nil
751 "Set to the `NNTPAUTH' string to pass on to `authinfo-kludge'.
752
753Use this to arrange for per-server settings.")
754
755(defun nntp-open-authinfo-kludge (buffer)
756 "Open a connection to SERVER using `authinfo-kludge'."
757 (let ((proc (start-process "nntpd" buffer
758 "env" (concat "NNTPAUTH="
759 (or nntp-authinfo-generic
760 (getenv "NNTPAUTH")
761 (error "NNTPAUTH unset")))
762 "authinfo-kludge" nntp-address)))
763 (set-buffer buffer)
764 (nntp-wait-for-string "^\r*200")
765 (beginning-of-line)
766 (delete-region (point-min) (point))
767 proc))
768
d17c6756 769(eval-after-load "erc"
3db66f7b 770 '(load "~/.ercrc.el"))
d17c6756 771
d2d1d5dc
MW
772;; Heavy-duty Gnus patching.
773
774(defun mdw-nnimap-transform-headers ()
775 (goto-char (point-min))
776 (let (article lines size string)
777 (block nil
778 (while (not (eobp))
779 (while (not (looking-at "\\* [0-9]+ FETCH"))
780 (delete-region (point) (progn (forward-line 1) (point)))
781 (when (eobp)
782 (return)))
783 (goto-char (match-end 0))
784 ;; Unfold quoted {number} strings.
785 (while (re-search-forward
786 "[^]][ (]{\\([0-9]+\\)}\r?\n"
787 (save-excursion
788 ;; Start of the header section.
789 (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
790 ;; Start of the next FETCH.
791 (re-search-forward "\\* [0-9]+ FETCH" nil t)
792 (point-max)))
793 t)
794 (setq size (string-to-number (match-string 1)))
795 (delete-region (+ (match-beginning 0) 2) (point))
796 (setq string (buffer-substring (point) (+ (point) size)))
797 (delete-region (point) (+ (point) size))
798 (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))
799 ;; [mdw] missing from upstream
800 (backward-char 1))
801 (beginning-of-line)
802 (setq article
803 (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
804 t)
805 (match-string 1)))
806 (setq lines nil)
807 (setq size
808 (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
809 (line-end-position)
810 t)
811 (match-string 1)))
812 (beginning-of-line)
813 (when (search-forward "BODYSTRUCTURE" (line-end-position) t)
814 (let ((structure (ignore-errors
815 (read (current-buffer)))))
816 (while (and (consp structure)
817 (not (atom (car structure))))
818 (setq structure (car structure)))
819 (setq lines (if (and
820 (stringp (car structure))
821 (equal (upcase (nth 0 structure)) "MESSAGE")
822 (equal (upcase (nth 1 structure)) "RFC822"))
823 (nth 9 structure)
824 (nth 7 structure)))))
825 (delete-region (line-beginning-position) (line-end-position))
826 (insert (format "211 %s Article retrieved." article))
827 (forward-line 1)
828 (when size
829 (insert (format "Chars: %s\n" size)))
830 (when lines
831 (insert (format "Lines: %s\n" lines)))
832 ;; Most servers have a blank line after the headers, but
833 ;; Davmail doesn't.
834 (unless (re-search-forward "^\r$\\|^)\r?$" nil t)
835 (goto-char (point-max)))
836 (delete-region (line-beginning-position) (line-end-position))
837 (insert ".")
838 (forward-line 1)))))
839
840(eval-after-load 'nnimap
841 '(defalias 'nnimap-transform-headers
842 (symbol-function 'mdw-nnimap-transform-headers)))
843
6132bc01
MW
844;;;--------------------------------------------------------------------------
845;;; Utility functions.
f617db13 846
b5d724dd
MW
847(or (fboundp 'line-number-at-pos)
848 (defun line-number-at-pos (&optional pos)
849 (let ((opoint (or pos (point))) start)
850 (save-excursion
851 (save-restriction
852 (goto-char (point-min))
853 (widen)
854 (forward-line 0)
855 (setq start (point))
856 (goto-char opoint)
857 (forward-line 0)
858 (1+ (count-lines 1 (point))))))))
459c9fb2 859
f617db13 860(defun mdw-uniquify-alist (&rest alists)
f617db13 861 "Return the concatenation of the ALISTS with duplicate elements removed.
6132bc01
MW
862The first association with a given key prevails; others are
863ignored. The input lists are not modified, although they'll
864probably become garbage."
f617db13
MW
865 (and alists
866 (let ((start-list (cons nil nil)))
867 (mdw-do-uniquify start-list
868 start-list
869 (car alists)
870 (cdr alists)))))
871
f617db13 872(defun mdw-do-uniquify (done end l rest)
6132bc01
MW
873 "A helper function for mdw-uniquify-alist.
874The DONE argument is a list whose first element is `nil'. It
875contains the uniquified alist built so far. The leading `nil' is
876stripped off at the end of the operation; it's only there so that
877DONE always references a cons cell. END refers to the final cons
878cell in the DONE list; it is modified in place each time to avoid
879the overheads of `append'ing all the time. The L argument is the
880alist we're currently processing; the remaining alists are given
881in REST."
882
883 ;; There are several different cases to deal with here.
f617db13
MW
884 (cond
885
6132bc01
MW
886 ;; Current list isn't empty. Add the first item to the DONE list if
887 ;; there's not an item with the same KEY already there.
f617db13
MW
888 (l (or (assoc (car (car l)) done)
889 (progn
890 (setcdr end (cons (car l) nil))
891 (setq end (cdr end))))
892 (mdw-do-uniquify done end (cdr l) rest))
893
6132bc01
MW
894 ;; The list we were working on is empty. Shunt the next list into the
895 ;; current list position and go round again.
f617db13
MW
896 (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
897
6132bc01
MW
898 ;; Everything's done. Remove the leading `nil' from the DONE list and
899 ;; return it. Finished!
f617db13
MW
900 (t (cdr done))))
901
f617db13
MW
902(defun date ()
903 "Insert the current date in a pleasing way."
904 (interactive)
905 (insert (save-excursion
906 (let ((buffer (get-buffer-create "*tmp*")))
907 (unwind-protect (progn (set-buffer buffer)
908 (erase-buffer)
909 (shell-command "date +%Y-%m-%d" t)
910 (goto-char (mark))
911 (delete-backward-char 1)
912 (buffer-string))
913 (kill-buffer buffer))))))
914
f617db13
MW
915(defun uuencode (file &optional name)
916 "UUencodes a file, maybe calling it NAME, into the current buffer."
917 (interactive "fInput file name: ")
918
6132bc01 919 ;; If NAME isn't specified, then guess from the filename.
f617db13
MW
920 (if (not name)
921 (setq name
922 (substring file
923 (or (string-match "[^/]*$" file) 0))))
f617db13
MW
924 (print (format "uuencode `%s' `%s'" file name))
925
6132bc01 926 ;; Now actually do the thing.
f617db13
MW
927 (call-process "uuencode" file t nil name))
928
929(defvar np-file "~/.np"
930 "*Where the `now-playing' file is.")
931
932(defun np (&optional arg)
933 "Grabs a `now-playing' string."
934 (interactive)
935 (save-excursion
936 (or arg (progn
852cd5fb 937 (goto-char (point-max))
f617db13 938 (insert "\nNP: ")
daff679f 939 (insert-file-contents np-file)))))
f617db13 940
ae7460d4
MW
941(defun mdw-version-< (ver-a ver-b)
942 "Answer whether VER-A is strictly earlier than VER-B.
943VER-A and VER-B are version numbers, which are strings containing digit
944sequences separated by `.'."
945 (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
946 (split-string ver-a "\\.")))
947 (lb (mapcar (lambda (x) (car (read-from-string x)))
948 (split-string ver-b "\\."))))
949 (catch 'done
950 (while t
951 (cond ((null la) (throw 'done lb))
952 ((null lb) (throw 'done nil))
953 ((< (car la) (car lb)) (throw 'done t))
f64c5a1a
MW
954 ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb)))
955 (t (throw 'done nil)))))))
ae7460d4 956
c7a8da49 957(defun mdw-check-autorevert ()
6132bc01
MW
958 "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
959This takes into consideration whether it's been found using
960tramp, which seems to get itself into a twist."
46e69f55
MW
961 (cond ((not (boundp 'global-auto-revert-ignore-buffer))
962 nil)
963 ((and (buffer-file-name)
964 (fboundp 'tramp-tramp-file-p)
c7a8da49
MW
965 (tramp-tramp-file-p (buffer-file-name)))
966 (unless global-auto-revert-ignore-buffer
967 (setq global-auto-revert-ignore-buffer 'tramp)))
968 ((eq global-auto-revert-ignore-buffer 'tramp)
969 (setq global-auto-revert-ignore-buffer nil))))
970
971(defadvice find-file (after mdw-autorevert activate)
972 (mdw-check-autorevert))
973(defadvice write-file (after mdw-autorevert activate)
4d9f2d65 974 (mdw-check-autorevert))
eae0aa6d 975
a58a4227
MW
976(defun mdw-auto-revert ()
977 "Recheck all of the autorevertable buffers, and update VC modelines."
978 (interactive)
979 (let ((auto-revert-check-vc-info t))
980 (auto-revert-buffers)))
981
6132bc01
MW
982;;;--------------------------------------------------------------------------
983;;; Dired hacking.
5195cbc3
MW
984
985(defadvice dired-maybe-insert-subdir
986 (around mdw-marked-insertion first activate)
6132bc01
MW
987 "The DIRNAME may be a list of directory names to insert.
988Interactively, if files are marked, then insert all of them.
989With a numeric prefix argument, select that many entries near
990point; with a non-numeric prefix argument, prompt for listing
991options."
5195cbc3
MW
992 (interactive
993 (list (dired-get-marked-files nil
994 (and (integerp current-prefix-arg)
995 current-prefix-arg)
996 #'file-directory-p)
997 (and current-prefix-arg
998 (not (integerp current-prefix-arg))
999 (read-string "Switches for listing: "
1000 (or dired-subdir-switches
1001 dired-actual-switches)))))
1002 (let ((dirs (ad-get-arg 0)))
1003 (dolist (dir (if (listp dirs) dirs (list dirs)))
1004 (ad-set-arg 0 dir)
1005 ad-do-it)))
1006
d40903f4
MW
1007(defun mdw-dired-run (args &optional syncp)
1008 (interactive (let ((file (dired-get-filename t)))
1009 (list (read-string (format "Arguments for %s: " file))
1010 current-prefix-arg)))
1011 (funcall (if syncp 'shell-command 'async-shell-command)
1012 (concat (shell-quote-argument (dired-get-filename nil))
1013 " " args)))
1014
2a67803a
MW
1015(defadvice dired-do-flagged-delete
1016 (around mdw-delete-if-prefix-argument activate compile)
1017 (let ((delete-by-moving-to-trash (and (null current-prefix-arg)
1018 delete-by-moving-to-trash)))
1019 ad-do-it))
1020
d40903f4
MW
1021(eval-after-load "dired"
1022 '(define-key dired-mode-map "X" 'mdw-dired-run))
1023
6132bc01
MW
1024;;;--------------------------------------------------------------------------
1025;;; URL viewing.
a203fba8
MW
1026
1027(defun mdw-w3m-browse-url (url &optional new-session-p)
1028 "Invoke w3m on the URL in its current window, or at least a different one.
1029If NEW-SESSION-P, start a new session."
1030 (interactive "sURL: \nP")
1031 (save-excursion
63fb20c1
MW
1032 (let ((window (selected-window)))
1033 (unwind-protect
1034 (progn
1035 (select-window (or (and (not new-session-p)
1036 (get-buffer-window "*w3m*"))
1037 (progn
1038 (if (one-window-p t) (split-window))
1039 (get-lru-window))))
1040 (w3m-browse-url url new-session-p))
1041 (select-window window)))))
a203fba8 1042
2ae8f8e3
MW
1043(eval-after-load 'w3m
1044 '(define-key w3m-mode-map [?\e ?\r] 'w3m-view-this-url-new-session))
1045
a203fba8 1046(defvar mdw-good-url-browsers
94526c3f 1047 '(browse-url-mozilla
a0d16e44 1048 browse-url-generic
ed5e20a5 1049 (w3m . mdw-w3m-browse-url)
a0d16e44 1050 browse-url-w3)
6132bc01
MW
1051 "List of good browsers for mdw-good-url-browsers.
1052Each item is a browser function name, or a cons (CHECK . FUNC).
1053A symbol FOO stands for (FOO . FOO).")
a203fba8
MW
1054
1055(defun mdw-good-url-browser ()
6132bc01
MW
1056 "Return a good URL browser.
1057Trundle the list of such things, finding the first item for which
1058CHECK is fboundp, and returning the correponding FUNC."
a203fba8
MW
1059 (let ((bs mdw-good-url-browsers) b check func answer)
1060 (while (and bs (not answer))
1061 (setq b (car bs)
1062 bs (cdr bs))
1063 (if (consp b)
1064 (setq check (car b) func (cdr b))
1065 (setq check b func b))
1066 (if (fboundp check)
1067 (setq answer func)))
1068 answer))
1069
f36cdb77
MW
1070(eval-after-load "w3m-search"
1071 '(progn
1072 (dolist
1073 (item
1074 '(("g" "Google" "http://www.google.co.uk/search?q=%s")
1075 ("gd" "Google Directory"
1076 "http://www.google.com/search?cat=gwd/Top&q=%s")
1077 ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
1078 ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
1079 ("gi" "Images" "http://images.google.com/images?q=%s")
1080 ("rfc" "RFC"
1081 "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
1082 ("wp" "Wikipedia"
1083 "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
1084 ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
1085 ("nc-wiki" "nCipher wiki"
1086 "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
1087 ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
1088 ("lp" "Launchpad bug by number"
1089 "https://bugs.launchpad.net/bugs/%s")
1090 ("lppkg" "Launchpad bugs by package"
1091 "https://bugs.launchpad.net/%s")
1092 ("msdn" "MSDN"
1093 "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
1094 ("debbug" "Debian bug by number"
1095 "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
1096 ("debbugpkg" "Debian bugs by package"
1097 "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
1098 ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
1099 (add-to-list 'w3m-search-engine-alist
1100 (list (cadr item) (caddr item) nil))
1101 (add-to-list 'w3m-uri-replace-alist
1102 (list (concat "\\`" (car item) ":")
1103 'w3m-search-uri-replace
1104 (cadr item))))))
1105
6132bc01
MW
1106;;;--------------------------------------------------------------------------
1107;;; Paragraph filling.
f617db13 1108
6132bc01 1109;; Useful variables.
f617db13
MW
1110
1111(defvar mdw-fill-prefix nil
6132bc01
MW
1112 "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
1113If there's no fill prefix currently set (by the `fill-prefix'
1114variable) and there's a match from one of the regexps here, it
1115gets used to set the fill-prefix for the current operation.
f617db13 1116
6132bc01
MW
1117The variable is a list of items of the form `REGEXP . PREFIX'; if
1118the REGEXP matches, the PREFIX is used to set the fill prefix.
1119It in turn is a list of things:
f617db13
MW
1120
1121 STRING -- insert a literal string
1122 (match . N) -- insert the thing matched by bracketed subexpression N
1123 (pad . N) -- a string of whitespace the same width as subexpression N
1124 (expr . FORM) -- the result of evaluating FORM")
1125
1126(make-variable-buffer-local 'mdw-fill-prefix)
1127
1128(defvar mdw-hanging-indents
10fa2414 1129 (concat "\\(\\("
f8bfe560 1130 "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
10fa2414
MW
1131 "[ \t]+"
1132 "\\)?\\)")
6132bc01
MW
1133 "*Standard regexp matching parts of a hanging indent.
1134This is mainly useful in `auto-fill-mode'.")
f617db13 1135
6132bc01 1136;; Utility functions.
f617db13 1137
cd07f97f
MW
1138(defun mdw-maybe-tabify (s)
1139 "Tabify or untabify the string S, according to `indent-tabs-mode'."
c736b08b
MW
1140 (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
1141 (with-temp-buffer
1142 (save-match-data
f617db13 1143 (insert s "\n")
cd07f97f 1144 (let ((start (point-min)) (end (point-max)))
c736b08b
MW
1145 (funcall tabfun (point-min) (point-max))
1146 (setq s (buffer-substring (point-min) (1- (point-max)))))))))
f617db13
MW
1147
1148(defun mdw-examine-fill-prefixes (l)
6132bc01
MW
1149 "Given a list of dynamic fill prefixes, pick one which matches
1150context and return the static fill prefix to use. Point must be
1151at the start of a line, and match data must be saved."
f617db13 1152 (cond ((not l) nil)
6ed1b26a
MW
1153 ((looking-at (car (car l)))
1154 (mdw-maybe-tabify (apply #'concat
1155 (mapcar #'mdw-do-prefix-match
1156 (cdr (car l))))))
1157 (t (mdw-examine-fill-prefixes (cdr l)))))
f617db13
MW
1158
1159(defun mdw-maybe-car (p)
1160 "If P is a pair, return (car P), otherwise just return P."
1161 (if (consp p) (car p) p))
1162
1163(defun mdw-padding (s)
1164 "Return a string the same width as S but made entirely from whitespace."
1165 (let* ((l (length s)) (i 0) (n (make-string l ? )))
1166 (while (< i l)
1167 (if (= 9 (aref s i))
1168 (aset n i 9))
1169 (setq i (1+ i)))
1170 n))
1171
1172(defun mdw-do-prefix-match (m)
6132bc01
MW
1173 "Expand a dynamic prefix match element.
1174See `mdw-fill-prefix' for details."
f617db13 1175 (cond ((not (consp m)) (format "%s" m))
6ed1b26a
MW
1176 ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
1177 ((eq (car m) 'pad) (mdw-padding (match-string
1178 (mdw-maybe-car (cdr m)))))
1179 ((eq (car m) 'eval) (eval (cdr m)))
1180 (t "")))
f617db13
MW
1181
1182(defun mdw-choose-dynamic-fill-prefix ()
1183 "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
1184 (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
6ed1b26a
MW
1185 ((not mdw-fill-prefix) fill-prefix)
1186 (t (save-excursion
1187 (beginning-of-line)
1188 (save-match-data
1189 (mdw-examine-fill-prefixes mdw-fill-prefix))))))
f617db13 1190
b8c659bb 1191(defadvice do-auto-fill (around mdw-dynamic-fill-prefix () activate compile)
6132bc01
MW
1192 "Handle auto-filling, working out a dynamic fill prefix in the
1193case where there isn't a sensible static one."
f617db13 1194 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
b8c659bb 1195 ad-do-it))
f617db13
MW
1196
1197(defun mdw-fill-paragraph ()
1198 "Fill paragraph, getting a dynamic fill prefix."
1199 (interactive)
1200 (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1201 (fill-paragraph nil)))
1202
1203(defun mdw-standard-fill-prefix (rx &optional mat)
1204 "Set the dynamic fill prefix, handling standard hanging indents and stuff.
6132bc01
MW
1205This is just a short-cut for setting the thing by hand, and by
1206design it doesn't cope with anything approximating a complicated
1207case."
f617db13 1208 (setq mdw-fill-prefix
6ed1b26a
MW
1209 `((,(concat rx mdw-hanging-indents)
1210 (match . 1)
1211 (pad . ,(or mat 2))))))
f617db13 1212
6132bc01
MW
1213;;;--------------------------------------------------------------------------
1214;;; Other common declarations.
f617db13 1215
6132bc01 1216;; Common mode settings.
f617db13
MW
1217
1218(defvar mdw-auto-indent t
1219 "Whether to indent automatically after a newline.")
1220
0e58a7c2
MW
1221(defun mdw-whitespace-mode (&optional arg)
1222 "Turn on/off whitespace mode, but don't highlight trailing space."
1223 (interactive "P")
1224 (when (and (boundp 'whitespace-style)
1225 (fboundp 'whitespace-mode))
1226 (let ((whitespace-style (remove 'trailing whitespace-style)))
558fc014
MW
1227 (whitespace-mode arg))
1228 (setq show-trailing-whitespace whitespace-mode)))
0e58a7c2 1229
21beda17
MW
1230(defvar mdw-do-misc-mode-hacking nil)
1231
f617db13
MW
1232(defun mdw-misc-mode-config ()
1233 (and mdw-auto-indent
1234 (cond ((eq major-mode 'lisp-mode)
1235 (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
4a7ce1ee 1236 ((derived-mode-p 'slime-repl-mode 'asm-mode 'comint-mode)
30c8a8fb 1237 nil)
f617db13
MW
1238 (t
1239 (local-set-key "\C-m" 'newline-and-indent))))
2e7c6a86 1240 (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
f617db13 1241 (local-set-key [C-return] 'newline)
8a425bd7 1242 (make-local-variable 'page-delimiter)
8cb7626b 1243 (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
f617db13
MW
1244 (setq comment-column 40)
1245 (auto-fill-mode 1)
c7203018 1246 (setq fill-column mdw-text-width)
253f61b4
MW
1247 (and (fboundp 'gtags-mode)
1248 (gtags-mode))
ddf6e116 1249 (if (fboundp 'hs-minor-mode)
612717ec 1250 (trap (hs-minor-mode t))
ddf6e116 1251 (outline-minor-mode t))
49b2646e 1252 (reveal-mode t)
1e7a9479 1253 (trap (turn-on-font-lock)))
f617db13 1254
2e7c6a86 1255(defun mdw-post-local-vars-misc-mode-config ()
c7203018 1256 (setq whitespace-line-column mdw-text-width)
2717a191
MW
1257 (when (and mdw-do-misc-mode-hacking
1258 (not buffer-read-only))
2e7c6a86
MW
1259 (setq show-trailing-whitespace t)
1260 (mdw-whitespace-mode 1)))
1261(add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
ed7b46b9 1262
2c1ccbb9
MW
1263(defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
1264 `(progn ,@(mapcar (lambda (func)
1265 `(defadvice ,func
1266 (after mdw-angry-fruit-salad activate)
1267 (when mdw-do-misc-mode-hacking
1268 (setq show-trailing-whitespace
1269 (not buffer-read-only))
1270 (mdw-whitespace-mode (if buffer-read-only 0 1)))))
1271 funcs)))
1272(mdw-advise-update-angry-fruit-salad toggle-read-only
1273 read-only-mode
1274 view-mode
1275 view-mode-enable
1276 view-mode-disable)
2717a191 1277
253f61b4 1278(eval-after-load 'gtags
506bada9
MW
1279 '(progn
1280 (dolist (key '([mouse-2] [mouse-3]))
1281 (define-key gtags-mode-map key nil))
1282 (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
1283 (define-key gtags-select-mode-map [C-S-mouse-2]
1284 'gtags-select-tag-by-event)
1285 (dolist (map (list gtags-mode-map gtags-select-mode-map))
1286 (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
253f61b4 1287
6132bc01 1288;; Backup file handling.
2ae647c4
MW
1289
1290(defvar mdw-backup-disable-regexps nil
6132bc01
MW
1291 "*List of regular expressions: if a file name matches any of
1292these then the file is not backed up.")
2ae647c4
MW
1293
1294(defun mdw-backup-enable-predicate (name)
6132bc01
MW
1295 "[mdw]'s default backup predicate.
1296Allows a backup if the standard predicate would allow it, and it
1297doesn't match any of the regular expressions in
1298`mdw-backup-disable-regexps'."
2ae647c4
MW
1299 (and (normal-backup-enable-predicate name)
1300 (let ((answer t) (list mdw-backup-disable-regexps))
1301 (save-match-data
1302 (while list
1303 (if (string-match (car list) name)
1304 (setq answer nil))
1305 (setq list (cdr list)))
1306 answer))))
1307(setq backup-enable-predicate 'mdw-backup-enable-predicate)
1308
7bb78c67
MW
1309;; Frame cleanup.
1310
1311(defun mdw-last-one-out-turn-off-the-lights (frame)
1312 "Disconnect from an X display if this was the last frame on that display."
1313 (let ((frame-display (frame-parameter frame 'display)))
1314 (when (and frame-display
1315 (eq window-system 'x)
1316 (not (some (lambda (fr)
7bb78c67 1317 (and (not (eq fr frame))
a04d8f3d 1318 (string= (frame-parameter fr 'display)
d70716b5 1319 frame-display)))
7bb78c67 1320 (frame-list))))
7bb78c67
MW
1321 (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
1322(add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
1323
6132bc01 1324;;;--------------------------------------------------------------------------
f3674a83
MW
1325;;; Fullscreen-ness.
1326
1327(defvar mdw-full-screen-parameters
1328 '((menu-bar-lines . 0)
1329 ;(vertical-scroll-bars . nil)
1330 )
1331 "Frame parameters to set when making a frame fullscreen.")
1332
1333(defvar mdw-full-screen-save
1334 '(width height)
1335 "Extra frame parameters to save when setting fullscreen.")
1336
1337(defun mdw-toggle-full-screen (&optional frame)
1338 "Show the FRAME fullscreen."
1339 (interactive)
1340 (when window-system
1341 (cond ((frame-parameter frame 'fullscreen)
1342 (set-frame-parameter frame 'fullscreen nil)
1343 (modify-frame-parameters
1344 nil
1345 (or (frame-parameter frame 'mdw-full-screen-saved)
1346 (mapcar (lambda (assoc)
1347 (assq (car assoc) default-frame-alist))
1348 mdw-full-screen-parameters))))
1349 (t
1350 (let ((saved (mapcar (lambda (param)
1351 (cons param (frame-parameter frame param)))
1352 (append (mapcar #'car
1353 mdw-full-screen-parameters)
1354 mdw-full-screen-save))))
1355 (set-frame-parameter frame 'mdw-full-screen-saved saved))
1356 (modify-frame-parameters frame mdw-full-screen-parameters)
1357 (set-frame-parameter frame 'fullscreen 'fullboth)))))
1358
1359;;;--------------------------------------------------------------------------
6132bc01 1360;;; General fontification.
f617db13 1361
bc149706
MW
1362(make-face 'mdw-virgin-face)
1363
1e7a9479
MW
1364(defmacro mdw-define-face (name &rest body)
1365 "Define a face, and make sure it's actually set as the definition."
1366 (declare (indent 1)
1367 (debug 0))
1368 `(progn
bc149706 1369 (copy-face 'mdw-virgin-face ',name)
1e7a9479
MW
1370 (defvar ,name ',name)
1371 (put ',name 'face-defface-spec ',body)
88cb9c2b 1372 (face-spec-set ',name ',body nil)))
1e7a9479
MW
1373
1374(mdw-define-face default
1375 (((type w32)) :family "courier new" :height 85)
caa63513 1376 (((type x)) :family "6x13" :foundry "trad" :height 130)
db10ce0a
MW
1377 (((type color)) :foreground "white" :background "black")
1378 (t nil))
1e7a9479
MW
1379(mdw-define-face fixed-pitch
1380 (((type w32)) :family "courier new" :height 85)
caa63513 1381 (((type x)) :family "6x13" :foundry "trad" :height 130)
1e7a9479 1382 (t :foreground "white" :background "black"))
e8ea88ba 1383(if (mdw-emacs-version-p 23)
c383eb8a
MW
1384 (mdw-define-face variable-pitch
1385 (((type x)) :family "sans" :height 100))
1386 (mdw-define-face variable-pitch
3f001ff6 1387 (((type x)) :family "helvetica" :height 90)))
1e7a9479 1388(mdw-define-face region
fefae026
MW
1389 (((min-colors 64)) :background "grey30")
1390 (((class color)) :background "blue")
4833e35c 1391 (t :inverse-video t))
fa156643 1392(mdw-define-face match
fefae026
MW
1393 (((class color)) :background "blue")
1394 (t :inverse-video t))
c6fe19d5 1395(mdw-define-face mc/cursor-face
fefae026
MW
1396 (((class color)) :background "red")
1397 (t :inverse-video t))
1e7a9479
MW
1398(mdw-define-face minibuffer-prompt
1399 (t :weight bold))
1400(mdw-define-face mode-line
db10ce0a
MW
1401 (((class color)) :foreground "blue" :background "yellow"
1402 :box (:line-width 1 :style released-button))
1403 (t :inverse-video t))
1e7a9479 1404(mdw-define-face mode-line-inactive
db10ce0a
MW
1405 (((class color)) :foreground "yellow" :background "blue"
1406 :box (:line-width 1 :style released-button))
1407 (t :inverse-video t))
ae0a853f
MW
1408(mdw-define-face nobreak-space
1409 (((type tty)))
1410 (t :inherit escape-glyph :underline t))
1e7a9479
MW
1411(mdw-define-face scroll-bar
1412 (t :foreground "black" :background "lightgrey"))
1413(mdw-define-face fringe
1414 (t :foreground "yellow"))
c383eb8a 1415(mdw-define-face show-paren-match
9cf75a93
MW
1416 (((min-colors 64)) :background "darkgreen")
1417 (((class color)) :background "green")
db10ce0a 1418 (t :underline t))
c383eb8a 1419(mdw-define-face show-paren-mismatch
db10ce0a
MW
1420 (((class color)) :background "red")
1421 (t :inverse-video t))
1e7a9479 1422(mdw-define-face highlight
fefae026
MW
1423 (((min-colors 64)) :background "DarkSeaGreen4")
1424 (((class color)) :background "cyan")
db10ce0a 1425 (t :inverse-video t))
1e7a9479
MW
1426
1427(mdw-define-face holiday-face
1428 (t :background "red"))
1429(mdw-define-face calendar-today-face
1430 (t :foreground "yellow" :weight bold))
1431
1432(mdw-define-face comint-highlight-prompt
1433 (t :weight bold))
5fd055c2
MW
1434(mdw-define-face comint-highlight-input
1435 (t nil))
1e7a9479 1436
2e97e639
MW
1437(mdw-define-face ido-subdir
1438 (t :foreground "cyan" :weight bold))
1439
e0e2aca3
MW
1440(mdw-define-face dired-directory
1441 (t :foreground "cyan" :weight bold))
1442(mdw-define-face dired-symlink
1443 (t :foreground "cyan"))
1444(mdw-define-face dired-perm-write
1445 (t nil))
1446
1e7a9479 1447(mdw-define-face trailing-whitespace
db10ce0a
MW
1448 (((class color)) :background "red")
1449 (t :inverse-video t))
33aa287b
MW
1450(mdw-define-face whitespace-line
1451 (((class color)) :background "darkred")
a52bc3ca 1452 (t :inverse-video t))
1e7a9479 1453(mdw-define-face mdw-punct-face
fefae026
MW
1454 (((min-colors 64)) :foreground "burlywood2")
1455 (((class color)) :foreground "yellow"))
1e7a9479
MW
1456(mdw-define-face mdw-number-face
1457 (t :foreground "yellow"))
52bcde59 1458(mdw-define-face mdw-trivial-face)
1e7a9479 1459(mdw-define-face font-lock-function-name-face
c383eb8a 1460 (t :slant italic))
1e7a9479
MW
1461(mdw-define-face font-lock-keyword-face
1462 (t :weight bold))
1463(mdw-define-face font-lock-constant-face
1464 (t :slant italic))
1465(mdw-define-face font-lock-builtin-face
1466 (t :weight bold))
07965a39
MW
1467(mdw-define-face font-lock-type-face
1468 (t :weight bold :slant italic))
1e7a9479
MW
1469(mdw-define-face font-lock-reference-face
1470 (t :weight bold))
1471(mdw-define-face font-lock-variable-name-face
1472 (t :slant italic))
1473(mdw-define-face font-lock-comment-delimiter-face
fefae026
MW
1474 (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1475 (((class color)) :foreground "green")
1476 (t :weight bold))
1e7a9479 1477(mdw-define-face font-lock-comment-face
fefae026
MW
1478 (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1479 (((class color)) :foreground "green")
1480 (t :weight bold))
1e7a9479 1481(mdw-define-face font-lock-string-face
fefae026
MW
1482 (((min-colors 64)) :foreground "SkyBlue1")
1483 (((class color)) :foreground "cyan")
1484 (t :weight bold))
898c7efb 1485
1e7a9479
MW
1486(mdw-define-face message-separator
1487 (t :background "red" :foreground "white" :weight bold))
1488(mdw-define-face message-cited-text
1489 (default :slant italic)
fefae026
MW
1490 (((min-colors 64)) :foreground "SkyBlue1")
1491 (((class color)) :foreground "cyan"))
1e7a9479 1492(mdw-define-face message-header-cc
4790fcb7 1493 (default :slant italic)
fefae026
MW
1494 (((min-colors 64)) :foreground "SeaGreen1")
1495 (((class color)) :foreground "green"))
1e7a9479 1496(mdw-define-face message-header-newsgroups
4790fcb7 1497 (default :slant italic)
fefae026
MW
1498 (((min-colors 64)) :foreground "SeaGreen1")
1499 (((class color)) :foreground "green"))
1e7a9479 1500(mdw-define-face message-header-subject
fefae026
MW
1501 (((min-colors 64)) :foreground "SeaGreen1")
1502 (((class color)) :foreground "green"))
1e7a9479 1503(mdw-define-face message-header-to
fefae026
MW
1504 (((min-colors 64)) :foreground "SeaGreen1")
1505 (((class color)) :foreground "green"))
1e7a9479 1506(mdw-define-face message-header-xheader
4790fcb7 1507 (default :slant italic)
fefae026
MW
1508 (((min-colors 64)) :foreground "SeaGreen1")
1509 (((class color)) :foreground "green"))
1e7a9479 1510(mdw-define-face message-header-other
4790fcb7 1511 (default :slant italic)
fefae026
MW
1512 (((min-colors 64)) :foreground "SeaGreen1")
1513 (((class color)) :foreground "green"))
1e7a9479 1514(mdw-define-face message-header-name
4790fcb7 1515 (default :weight bold)
fefae026
MW
1516 (((min-colors 64)) :foreground "SeaGreen1")
1517 (((class color)) :foreground "green"))
4790fcb7 1518
69498691
MW
1519(mdw-define-face which-func
1520 (t nil))
1e7a9479 1521
4790fcb7
MW
1522(mdw-define-face gnus-header-name
1523 (default :weight bold)
fefae026
MW
1524 (((min-colors 64)) :foreground "SeaGreen1")
1525 (((class color)) :foreground "green"))
4790fcb7 1526(mdw-define-face gnus-header-subject
fefae026
MW
1527 (((min-colors 64)) :foreground "SeaGreen1")
1528 (((class color)) :foreground "green"))
4790fcb7 1529(mdw-define-face gnus-header-from
fefae026
MW
1530 (((min-colors 64)) :foreground "SeaGreen1")
1531 (((class color)) :foreground "green"))
4790fcb7 1532(mdw-define-face gnus-header-to
fefae026
MW
1533 (((min-colors 64)) :foreground "SeaGreen1")
1534 (((class color)) :foreground "green"))
4790fcb7
MW
1535(mdw-define-face gnus-header-content
1536 (default :slant italic)
fefae026
MW
1537 (((min-colors 64)) :foreground "SeaGreen1")
1538 (((class color)) :foreground "green"))
4790fcb7
MW
1539
1540(mdw-define-face gnus-cite-1
fefae026
MW
1541 (((min-colors 64)) :foreground "SkyBlue1")
1542 (((class color)) :foreground "cyan"))
4790fcb7 1543(mdw-define-face gnus-cite-2
fefae026
MW
1544 (((min-colors 64)) :foreground "RoyalBlue2")
1545 (((class color)) :foreground "blue"))
4790fcb7 1546(mdw-define-face gnus-cite-3
fefae026
MW
1547 (((min-colors 64)) :foreground "MediumOrchid")
1548 (((class color)) :foreground "magenta"))
4790fcb7 1549(mdw-define-face gnus-cite-4
fefae026
MW
1550 (((min-colors 64)) :foreground "firebrick2")
1551 (((class color)) :foreground "red"))
4790fcb7 1552(mdw-define-face gnus-cite-5
fefae026
MW
1553 (((min-colors 64)) :foreground "burlywood2")
1554 (((class color)) :foreground "yellow"))
4790fcb7 1555(mdw-define-face gnus-cite-6
fefae026
MW
1556 (((min-colors 64)) :foreground "SeaGreen1")
1557 (((class color)) :foreground "green"))
4790fcb7 1558(mdw-define-face gnus-cite-7
fefae026
MW
1559 (((min-colors 64)) :foreground "SlateBlue1")
1560 (((class color)) :foreground "cyan"))
4790fcb7 1561(mdw-define-face gnus-cite-8
fefae026
MW
1562 (((min-colors 64)) :foreground "RoyalBlue2")
1563 (((class color)) :foreground "blue"))
4790fcb7 1564(mdw-define-face gnus-cite-9
fefae026
MW
1565 (((min-colors 64)) :foreground "purple2")
1566 (((class color)) :foreground "magenta"))
4790fcb7 1567(mdw-define-face gnus-cite-10
fefae026
MW
1568 (((min-colors 64)) :foreground "DarkOrange2")
1569 (((class color)) :foreground "red"))
4790fcb7
MW
1570(mdw-define-face gnus-cite-11
1571 (t :foreground "grey"))
1572
2f238de8
MW
1573(mdw-define-face diff-header
1574 (t nil))
1e7a9479
MW
1575(mdw-define-face diff-index
1576 (t :weight bold))
1577(mdw-define-face diff-file-header
1578 (t :weight bold))
1579(mdw-define-face diff-hunk-header
fefae026
MW
1580 (((min-colors 64)) :foreground "SkyBlue1")
1581 (((class color)) :foreground "cyan"))
1e7a9479 1582(mdw-define-face diff-function
fefae026
MW
1583 (default :weight bold)
1584 (((min-colors 64)) :foreground "SkyBlue1")
1585 (((class color)) :foreground "cyan"))
1e7a9479 1586(mdw-define-face diff-header
fefae026 1587 (((min-colors 64)) :background "grey10"))
1e7a9479 1588(mdw-define-face diff-added
fefae026 1589 (((class color)) :foreground "green"))
1e7a9479 1590(mdw-define-face diff-removed
fefae026 1591 (((class color)) :foreground "red"))
5fd055c2
MW
1592(mdw-define-face diff-context
1593 (t nil))
2f238de8 1594(mdw-define-face diff-refine-change
fefae026 1595 (((min-colors 64)) :background "RoyalBlue4")
b31f422b 1596 (t :underline t))
5f454d3e 1597(mdw-define-face diff-refine-removed
fefae026 1598 (((min-colors 64)) :background "#500")
5f454d3e
MW
1599 (t :underline t))
1600(mdw-define-face diff-refine-added
fefae026 1601 (((min-colors 64)) :background "#050")
5f454d3e 1602 (t :underline t))
1e7a9479 1603
a62d0541
MW
1604(setq ediff-force-faces t)
1605(mdw-define-face ediff-current-diff-A
fefae026
MW
1606 (((min-colors 64)) :background "darkred")
1607 (((class color)) :background "red")
a62d0541
MW
1608 (t :inverse-video t))
1609(mdw-define-face ediff-fine-diff-A
fefae026
MW
1610 (((min-colors 64)) :background "red3")
1611 (((class color)) :inverse-video t)
a62d0541
MW
1612 (t :inverse-video nil))
1613(mdw-define-face ediff-even-diff-A
fefae026 1614 (((min-colors 64)) :background "#300"))
a62d0541 1615(mdw-define-face ediff-odd-diff-A
fefae026 1616 (((min-colors 64)) :background "#300"))
a62d0541 1617(mdw-define-face ediff-current-diff-B
fefae026
MW
1618 (((min-colors 64)) :background "darkgreen")
1619 (((class color)) :background "magenta")
a62d0541
MW
1620 (t :inverse-video t))
1621(mdw-define-face ediff-fine-diff-B
fefae026
MW
1622 (((min-colors 64)) :background "green4")
1623 (((class color)) :inverse-video t)
a62d0541
MW
1624 (t :inverse-video nil))
1625(mdw-define-face ediff-even-diff-B
fefae026 1626 (((min-colors 64)) :background "#020"))
a62d0541 1627(mdw-define-face ediff-odd-diff-B
fefae026 1628 (((min-colors 64)) :background "#020"))
a62d0541 1629(mdw-define-face ediff-current-diff-C
fefae026
MW
1630 (((min-colors 64)) :background "darkblue")
1631 (((class color)) :background "blue")
a62d0541
MW
1632 (t :inverse-video t))
1633(mdw-define-face ediff-fine-diff-C
fefae026
MW
1634 (((min-colors 64)) :background "blue1")
1635 (((class color)) :inverse-video t)
a62d0541
MW
1636 (t :inverse-video nil))
1637(mdw-define-face ediff-even-diff-C
fefae026 1638 (((min-colors 64)) :background "#004"))
a62d0541 1639(mdw-define-face ediff-odd-diff-C
fefae026 1640 (((min-colors 64)) :background "#004"))
a62d0541 1641(mdw-define-face ediff-current-diff-Ancestor
fefae026
MW
1642 (((min-colors 64)) :background "#630")
1643 (((class color)) :background "blue")
a62d0541
MW
1644 (t :inverse-video t))
1645(mdw-define-face ediff-even-diff-Ancestor
fefae026 1646 (((min-colors 64)) :background "#320"))
a62d0541 1647(mdw-define-face ediff-odd-diff-Ancestor
fefae026 1648 (((min-colors 64)) :background "#320"))
a62d0541 1649
53f93f0d 1650(mdw-define-face magit-hash
fefae026
MW
1651 (((min-colors 64)) :foreground "grey40")
1652 (((class color)) :foreground "blue"))
53f93f0d 1653(mdw-define-face magit-diff-hunk-heading
fefae026
MW
1654 (((min-colors 64)) :foreground "grey70" :background "grey25")
1655 (((class color)) :foreground "yellow"))
53f93f0d 1656(mdw-define-face magit-diff-hunk-heading-highlight
fefae026
MW
1657 (((min-colors 64)) :foreground "grey70" :background "grey35")
1658 (((class color)) :foreground "yellow" :background "blue"))
53f93f0d 1659(mdw-define-face magit-diff-added
fefae026
MW
1660 (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
1661 (((class color)) :foreground "green"))
53f93f0d 1662(mdw-define-face magit-diff-added-highlight
fefae026
MW
1663 (((min-colors 64)) :foreground "#cceecc" :background "#336633")
1664 (((class color)) :foreground "green" :background "blue"))
53f93f0d 1665(mdw-define-face magit-diff-removed
fefae026
MW
1666 (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
1667 (((class color)) :foreground "red"))
53f93f0d 1668(mdw-define-face magit-diff-removed-highlight
fefae026
MW
1669 (((min-colors 64)) :foreground "#eecccc" :background "#663333")
1670 (((class color)) :foreground "red" :background "blue"))
857045c6
MW
1671(mdw-define-face magit-blame-heading
1672 (((min-colors 64)) :foreground "white" :background "grey25"
1673 :weight normal :slant normal)
1674 (((class color)) :foreground "white" :background "blue"
1675 :weight normal :slant normal))
1676(mdw-define-face magit-blame-name
1677 (t :inherit magit-blame-heading :slant italic))
1678(mdw-define-face magit-blame-date
1679 (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
1680 (((class color)) :inherit magit-blame-heading :foreground "cyan"))
1681(mdw-define-face magit-blame-summary
1682 (t :inherit magit-blame-heading :weight bold))
53f93f0d 1683
ad305d7e 1684(mdw-define-face dylan-header-background
fefae026
MW
1685 (((min-colors 64)) :background "NavyBlue")
1686 (((class color)) :background "blue"))
ad305d7e 1687
e1b8de18
MW
1688(mdw-define-face erc-input-face
1689 (t :foreground "red"))
1690
1e7a9479
MW
1691(mdw-define-face woman-bold
1692 (t :weight bold))
1693(mdw-define-face woman-italic
1694 (t :slant italic))
1695
5a83259f
MW
1696(eval-after-load "rst"
1697 '(progn
1698 (mdw-define-face rst-level-1-face
1699 (t :foreground "SkyBlue1" :weight bold))
1700 (mdw-define-face rst-level-2-face
1701 (t :foreground "SeaGreen1" :weight bold))
1702 (mdw-define-face rst-level-3-face
1703 (t :weight bold))
1704 (mdw-define-face rst-level-4-face
1705 (t :slant italic))
1706 (mdw-define-face rst-level-5-face
1707 (t :underline t))
1708 (mdw-define-face rst-level-6-face
1709 ())))
4f251391 1710
1e7a9479
MW
1711(mdw-define-face p4-depot-added-face
1712 (t :foreground "green"))
1713(mdw-define-face p4-depot-branch-op-face
1714 (t :foreground "yellow"))
1715(mdw-define-face p4-depot-deleted-face
1716 (t :foreground "red"))
1717(mdw-define-face p4-depot-unmapped-face
1718 (t :foreground "SkyBlue1"))
1719(mdw-define-face p4-diff-change-face
1720 (t :foreground "yellow"))
1721(mdw-define-face p4-diff-del-face
1722 (t :foreground "red"))
1723(mdw-define-face p4-diff-file-face
1724 (t :foreground "SkyBlue1"))
1725(mdw-define-face p4-diff-head-face
1726 (t :background "grey10"))
1727(mdw-define-face p4-diff-ins-face
1728 (t :foreground "green"))
1729
4c39e530
MW
1730(mdw-define-face w3m-anchor-face
1731 (t :foreground "SkyBlue1" :underline t))
1732(mdw-define-face w3m-arrived-anchor-face
1733 (t :foreground "SkyBlue1" :underline t))
1734
1e7a9479
MW
1735(mdw-define-face whizzy-slice-face
1736 (t :background "grey10"))
1737(mdw-define-face whizzy-error-face
1738 (t :background "darkred"))
f617db13 1739
5fedb342
MW
1740;; Ellipses used to indicate hidden text (and similar).
1741(mdw-define-face mdw-ellipsis-face
1742 (((type tty)) :foreground "blue") (t :foreground "grey60"))
c11ac343 1743(let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
a8a7976a 1744 (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
c11ac343
MW
1745 (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1746 (bar (make-glyph-code ?| mdw-ellipsis-face)))
1747 (set-display-table-slot standard-display-table 0 dollar)
1748 (set-display-table-slot standard-display-table 1 backslash)
5fedb342 1749 (set-display-table-slot standard-display-table 4
c11ac343
MW
1750 (vector dot dot dot))
1751 (set-display-table-slot standard-display-table 5 bar))
5fedb342 1752
6132bc01 1753;;;--------------------------------------------------------------------------
c70e3179
MW
1754;;; Where is point?
1755
6a2d05ae 1756(mdw-define-face mdw-point-overlay-face
3f32879e 1757 (((type graphic)))
c70e3179
MW
1758 (((min-colors 64)) :background "darkblue")
1759 (((class color)) :background "blue")
1760 (((type tty) (class mono)) :inverse-video t))
1761
1762(defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
1763
1764(defun mdw-configure-point-overlay ()
1765 (let ((ov (make-overlay 0 0)))
1766 (overlay-put ov 'priority 0)
1767 (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
1768 (left (car fringe)) (right (cdr fringe))
1769 (s ""))
1770 (when left
1771 (let ((ss "."))
1772 (put-text-property 0 1 'display `(left-fringe ,left) ss)
1773 (setq s (concat s ss))))
1774 (when right
1775 (let ((ss "."))
1776 (put-text-property 0 1 'display `(right-fringe ,right) ss)
1777 (setq s (concat s ss))))
1778 (when (or left right)
1779 (overlay-put ov 'before-string s)))
6a2d05ae 1780 (overlay-put ov 'face 'mdw-point-overlay-face)
c70e3179
MW
1781 (delete-overlay ov)
1782 ov))
1783
1784(defvar mdw-point-overlay (mdw-configure-point-overlay)
1785 "An overlay used for showing where point is in the selected window.")
1786(defun mdw-reconfigure-point-overlay ()
1787 (interactive)
1788 (setq mdw-point-overlay (mdw-configure-point-overlay)))
1789
1790(defun mdw-remove-point-overlay ()
1791 "Remove the current-point overlay."
1792 (delete-overlay mdw-point-overlay))
1793
1794(defun mdw-update-point-overlay ()
1795 "Mark the current point position with an overlay."
1796 (if (not mdw-point-overlay-mode)
1797 (mdw-remove-point-overlay)
1798 (overlay-put mdw-point-overlay 'window (selected-window))
1799 (move-overlay mdw-point-overlay
1800 (line-beginning-position)
1801 (+ (line-end-position) 1))))
1802
1803(defvar mdw-point-overlay-buffers nil
1804 "List of buffers using `mdw-point-overlay-mode'.")
1805
1806(define-minor-mode mdw-point-overlay-mode
1807 "Indicate current line with an overlay."
1808 :global nil
1809 (let ((buffer (current-buffer)))
1810 (setq mdw-point-overlay-buffers
1811 (mapcan (lambda (buf)
1812 (if (and (buffer-live-p buf)
1813 (not (eq buf buffer)))
1814 (list buf)))
1815 mdw-point-overlay-buffers))
1816 (if mdw-point-overlay-mode
1817 (setq mdw-point-overlay-buffers
1818 (cons buffer mdw-point-overlay-buffers))))
1819 (cond (mdw-point-overlay-buffers
1820 (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
1821 (add-hook 'post-command-hook 'mdw-update-point-overlay))
1822 (t
1823 (mdw-remove-point-overlay)
1824 (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
1825 (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
1826
1827(define-globalized-minor-mode mdw-global-point-overlay-mode
1828 mdw-point-overlay-mode
1829 (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
1830
1831;;;--------------------------------------------------------------------------
6132bc01 1832;;; C programming configuration.
f617db13 1833
6132bc01 1834;; Make C indentation nice.
f617db13 1835
f50c1bed
MW
1836(defun mdw-c-lineup-arglist (langelem)
1837 "Hack for DWIMmery in c-lineup-arglist."
1838 (if (save-excursion
1839 (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1840 0
1841 (c-lineup-arglist langelem)))
1842
1843(defun mdw-c-indent-extern-mumble (langelem)
1844 "Indent `extern \"...\" {' lines."
1845 (save-excursion
1846 (back-to-indentation)
1847 (if (looking-at
1848 "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1849 c-basic-offset
1850 nil)))
1851
b521d36a
MW
1852(defun mdw-c-indent-arglist-nested (langelem)
1853 "Indent continued argument lists.
1854If we've nested more than one argument list, then only introduce a single
1855indentation anyway."
1856 (let ((context c-syntactic-context)
1857 (pos (c-langelem-2nd-pos c-syntactic-element))
1858 (should-indent-p t))
1859 (while (and context
1860 (eq (caar context) 'arglist-cont-nonempty))
1861 (when (and (= (caddr (pop context)) pos)
1862 context
1863 (memq (caar context) '(arglist-intro
1864 arglist-cont-nonempty)))
1865 (setq should-indent-p nil)))
1866 (if should-indent-p '+ 0)))
1867
c56296d0
MW
1868(defvar mdw-define-c-styles-hook nil
1869 "Hook run when `cc-mode' starts up to define styles.")
1870
1871(defmacro mdw-define-c-style (name &rest assocs)
1872 "Define a C style, called NAME (a symbol), setting ASSOCs.
1873A function, named `mdw-define-c-style/NAME', is defined to actually install
1874the style using `c-add-style', and added to the hook
1875`mdw-define-c-styles-hook'. If CC Mode is already loaded, then the style is
1876set."
1877 (declare (indent defun))
1878 (let* ((name-string (symbol-name name))
1879 (func (intern (concat "mdw-define-c-style/" name-string))))
1880 `(progn
1881 (defun ,func () (c-add-style ,name-string ',assocs))
1882 (and (featurep 'cc-mode) (,func))
1883 (add-hook 'mdw-define-c-styles-hook ',func))))
1884
1885(eval-after-load "cc-mode"
1886 '(run-hooks 'mdw-define-c-styles-hook))
1887
b521d36a
MW
1888(mdw-define-c-style mdw-trustonic-c
1889 (c-basic-offset . 4)
1890 (comment-column . 0)
1891 (c-indent-comment-alist (anchored-comment . (column . 0))
1892 (end-block . (space . 1))
1893 (cpp-end-block . (space . 1))
1894 (other . (space . 1)))
1895 (c-class-key . "class")
1896 (c-backslash-column . 0)
1897 (c-auto-align-backslashes . nil)
1898 (c-label-minimum-indentation . 0)
1899 (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1900 (defun-open . (add 0 c-indent-one-line-block))
1901 (arglist-cont-nonempty . mdw-c-indent-arglist-nested)
1902 (topmost-intro . mdw-c-indent-extern-mumble)
1903 (cpp-define-intro . 0)
1904 (knr-argdecl . 0)
1905 (inextern-lang . [0])
1906 (label . 0)
1907 (case-label . +)
b07634df 1908 (access-label . -2)
b521d36a
MW
1909 (inclass . +)
1910 (inline-open . ++)
1911 (statement-cont . +)
1912 (statement-case-intro . +)))
1913
c56296d0
MW
1914(mdw-define-c-style mdw-c
1915 (c-basic-offset . 2)
1916 (comment-column . 40)
1917 (c-class-key . "class")
1918 (c-backslash-column . 72)
1919 (c-label-minimum-indentation . 0)
1920 (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1921 (defun-open . (add 0 c-indent-one-line-block))
1922 (arglist-cont-nonempty . mdw-c-lineup-arglist)
1923 (topmost-intro . mdw-c-indent-extern-mumble)
1924 (cpp-define-intro . 0)
1925 (knr-argdecl . 0)
1926 (inextern-lang . [0])
1927 (label . 0)
1928 (case-label . +)
1929 (access-label . -)
1930 (inclass . +)
1931 (inline-open . ++)
1932 (statement-cont . +)
1933 (statement-case-intro . +)))
1934
1935(defun mdw-set-default-c-style (modes style)
1936 "Update the default CC Mode style for MODES to be STYLE.
1937
1938MODES may be a list of major mode names or a singleton. STYLE is a style
1939name, as a symbol."
1940 (let ((modes (if (listp modes) modes (list modes)))
1941 (style (symbol-name style)))
1942 (setq c-default-style
1943 (append (mapcar (lambda (mode)
1944 (cons mode style))
1945 modes)
1946 (remove-if (lambda (assoc)
1947 (memq (car assoc) modes))
1948 (if (listp c-default-style)
1949 c-default-style
1950 (list (cons 'other c-default-style))))))))
1951(setq c-default-style "mdw-c")
1952
1953(mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
f617db13 1954
0e7d960b
MW
1955(defvar mdw-c-comment-fill-prefix
1956 `((,(concat "\\([ \t]*/?\\)"
a7474429 1957 "\\(\\*\\|//\\)"
0e7d960b
MW
1958 "\\([ \t]*\\)"
1959 "\\([A-Za-z]+:[ \t]*\\)?"
1960 mdw-hanging-indents)
1961 (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1962 "Fill prefix matching C comments (both kinds).")
1963
f617db13
MW
1964(defun mdw-fontify-c-and-c++ ()
1965
6132bc01 1966 ;; Fiddle with some syntax codes.
f617db13
MW
1967 (modify-syntax-entry ?* ". 23")
1968 (modify-syntax-entry ?/ ". 124b")
1969 (modify-syntax-entry ?\n "> b")
1970
6132bc01 1971 ;; Other stuff.
c56296d0 1972 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 1973
6132bc01 1974 ;; Now define things to be fontified.
02109a0d 1975 (make-local-variable 'font-lock-keywords)
f617db13 1976 (let ((c-keywords
fe307a8c
MW
1977 (mdw-regexps "alignas" ;C11 macro, C++11
1978 "alignof" ;C++11
1979 "and" ;C++, C95 macro
0681f29e 1980 "and_eq" ;C++, C95 macro
7b84c078 1981 "asm" ;K&R, C++, GCC
fe307a8c 1982 "atomic" ;C11 macro, C++11 template type
26f18bd1 1983 "auto" ;K&R, C89
0681f29e
MW
1984 "bitand" ;C++, C95 macro
1985 "bitor" ;C++, C95 macro
d4783d9c 1986 "bool" ;C++, C99 macro
26f18bd1
MW
1987 "break" ;K&R, C89
1988 "case" ;K&R, C89
1989 "catch" ;C++
1990 "char" ;K&R, C89
fe307a8c
MW
1991 "char16_t" ;C++11, C11 library type
1992 "char32_t" ;C++11, C11 library type
26f18bd1 1993 "class" ;C++
d4783d9c 1994 "complex" ;C99 macro, C++ template type
0681f29e 1995 "compl" ;C++, C95 macro
26f18bd1 1996 "const" ;C89
fe307a8c 1997 "constexpr" ;C++11
26f18bd1
MW
1998 "const_cast" ;C++
1999 "continue" ;K&R, C89
fe307a8c 2000 "decltype" ;C++11
26f18bd1
MW
2001 "defined" ;C89 preprocessor
2002 "default" ;K&R, C89
2003 "delete" ;C++
2004 "do" ;K&R, C89
2005 "double" ;K&R, C89
2006 "dynamic_cast" ;C++
2007 "else" ;K&R, C89
2008 ;; "entry" ;K&R -- never used
2009 "enum" ;C89
2010 "explicit" ;C++
2011 "export" ;C++
2012 "extern" ;K&R, C89
2013 "float" ;K&R, C89
2014 "for" ;K&R, C89
2015 ;; "fortran" ;K&R
2016 "friend" ;C++
2017 "goto" ;K&R, C89
2018 "if" ;K&R, C89
d4783d9c
MW
2019 "imaginary" ;C99 macro
2020 "inline" ;C++, C99, GCC
26f18bd1
MW
2021 "int" ;K&R, C89
2022 "long" ;K&R, C89
2023 "mutable" ;C++
2024 "namespace" ;C++
2025 "new" ;C++
fe307a8c
MW
2026 "noexcept" ;C++11
2027 "noreturn" ;C11 macro
0681f29e
MW
2028 "not" ;C++, C95 macro
2029 "not_eq" ;C++, C95 macro
fe307a8c 2030 "nullptr" ;C++11
26f18bd1 2031 "operator" ;C++
0681f29e
MW
2032 "or" ;C++, C95 macro
2033 "or_eq" ;C++, C95 macro
26f18bd1
MW
2034 "private" ;C++
2035 "protected" ;C++
2036 "public" ;C++
2037 "register" ;K&R, C89
8d6d55b9 2038 "reinterpret_cast" ;C++
d4783d9c 2039 "restrict" ;C99
8d6d55b9
MW
2040 "return" ;K&R, C89
2041 "short" ;K&R, C89
2042 "signed" ;C89
2043 "sizeof" ;K&R, C89
2044 "static" ;K&R, C89
fe307a8c 2045 "static_assert" ;C11 macro, C++11
8d6d55b9
MW
2046 "static_cast" ;C++
2047 "struct" ;K&R, C89
2048 "switch" ;K&R, C89
2049 "template" ;C++
8d6d55b9 2050 "throw" ;C++
8d6d55b9 2051 "try" ;C++
fe307a8c 2052 "thread_local" ;C11 macro, C++11
8d6d55b9
MW
2053 "typedef" ;C89
2054 "typeid" ;C++
2055 "typeof" ;GCC
2056 "typename" ;C++
2057 "union" ;K&R, C89
2058 "unsigned" ;K&R, C89
2059 "using" ;C++
2060 "virtual" ;C++
2061 "void" ;C89
2062 "volatile" ;C89
2063 "wchar_t" ;C++, C89 library type
2064 "while" ;K&R, C89
0681f29e
MW
2065 "xor" ;C++, C95 macro
2066 "xor_eq" ;C++, C95 macro
fe307a8c
MW
2067 "_Alignas" ;C11
2068 "_Alignof" ;C11
2069 "_Atomic" ;C11
d4783d9c
MW
2070 "_Bool" ;C99
2071 "_Complex" ;C99
fe307a8c 2072 "_Generic" ;C11
d4783d9c 2073 "_Imaginary" ;C99
fe307a8c 2074 "_Noreturn" ;C11
d4783d9c 2075 "_Pragma" ;C99 preprocessor
fe307a8c
MW
2076 "_Static_assert" ;C11
2077 "_Thread_local" ;C11
8d6d55b9
MW
2078 "__alignof__" ;GCC
2079 "__asm__" ;GCC
2080 "__attribute__" ;GCC
2081 "__complex__" ;GCC
2082 "__const__" ;GCC
2083 "__extension__" ;GCC
2084 "__imag__" ;GCC
2085 "__inline__" ;GCC
2086 "__label__" ;GCC
2087 "__real__" ;GCC
2088 "__signed__" ;GCC
2089 "__typeof__" ;GCC
2090 "__volatile__" ;GCC
2091 ))
300f8827 2092 (c-builtins
26f18bd1 2093 (mdw-regexps "false" ;C++, C99 macro
165cecf8 2094 "this" ;C++
26f18bd1 2095 "true" ;C++, C99 macro
165cecf8 2096 ))
f617db13 2097 (preprocessor-keywords
8d6d55b9
MW
2098 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2099 "ident" "if" "ifdef" "ifndef" "import" "include"
2100 "line" "pragma" "unassert" "undef" "warning"))
f617db13 2101 (objc-keywords
8d6d55b9
MW
2102 (mdw-regexps "class" "defs" "encode" "end" "implementation"
2103 "interface" "private" "protected" "protocol" "public"
2104 "selector")))
f617db13
MW
2105
2106 (setq font-lock-keywords
2107 (list
f617db13 2108
6132bc01 2109 ;; Fontify include files as strings.
f617db13
MW
2110 (list (concat "^[ \t]*\\#[ \t]*"
2111 "\\(include\\|import\\)"
2112 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2113 '(2 font-lock-string-face))
2114
6132bc01 2115 ;; Preprocessor directives are `references'?.
f617db13
MW
2116 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2117 preprocessor-keywords
2118 "\\)\\>\\|[0-9]+\\|$\\)\\)")
2119 '(1 font-lock-keyword-face))
2120
6132bc01 2121 ;; Handle the keywords defined above.
f617db13
MW
2122 (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2123 '(0 font-lock-keyword-face))
2124
2125 (list (concat "\\<\\(" c-keywords "\\)\\>")
2126 '(0 font-lock-keyword-face))
2127
300f8827 2128 (list (concat "\\<\\(" c-builtins "\\)\\>")
165cecf8
MW
2129 '(0 font-lock-variable-name-face))
2130
6132bc01 2131 ;; Handle numbers too.
f617db13
MW
2132 ;;
2133 ;; This looks strange, I know. It corresponds to the
2134 ;; preprocessor's idea of what a number looks like, rather than
2135 ;; anything sensible.
f617db13
MW
2136 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2137 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2138 '(0 mdw-number-face))
2139
6132bc01 2140 ;; And anything else is punctuation.
f617db13 2141 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2142 '(0 mdw-punct-face))))))
f617db13 2143
fb16ed85
MW
2144(define-derived-mode sod-mode c-mode "Sod"
2145 "Major mode for editing Sod code.")
2146(push '("\\.sod$" . sod-mode) auto-mode-alist)
2147
6132bc01
MW
2148;;;--------------------------------------------------------------------------
2149;;; AP calc mode.
f617db13 2150
e7186cbe
MW
2151(define-derived-mode apcalc-mode c-mode "AP Calc"
2152 "Major mode for editing Calc code.")
f617db13
MW
2153
2154(defun mdw-fontify-apcalc ()
2155
6132bc01 2156 ;; Fiddle with some syntax codes.
f617db13
MW
2157 (modify-syntax-entry ?* ". 23")
2158 (modify-syntax-entry ?/ ". 14")
2159
6132bc01 2160 ;; Other stuff.
f617db13
MW
2161 (setq comment-start "/* ")
2162 (setq comment-end " */")
0e7d960b 2163 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 2164
6132bc01 2165 ;; Now define things to be fontified.
02109a0d 2166 (make-local-variable 'font-lock-keywords)
f617db13 2167 (let ((c-keywords
8d6d55b9
MW
2168 (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2169 "do" "else" "exit" "for" "global" "goto" "help" "if"
2170 "local" "mat" "obj" "print" "quit" "read" "return"
2171 "show" "static" "switch" "while" "write")))
f617db13
MW
2172
2173 (setq font-lock-keywords
2174 (list
f617db13 2175
6132bc01 2176 ;; Handle the keywords defined above.
f617db13
MW
2177 (list (concat "\\<\\(" c-keywords "\\)\\>")
2178 '(0 font-lock-keyword-face))
2179
6132bc01 2180 ;; Handle numbers too.
f617db13
MW
2181 ;;
2182 ;; This looks strange, I know. It corresponds to the
2183 ;; preprocessor's idea of what a number looks like, rather than
2184 ;; anything sensible.
f617db13
MW
2185 (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2186 "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2187 '(0 mdw-number-face))
2188
6132bc01 2189 ;; And anything else is punctuation.
f617db13 2190 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2191 '(0 mdw-punct-face))))))
f617db13 2192
6132bc01
MW
2193;;;--------------------------------------------------------------------------
2194;;; Java programming configuration.
f617db13 2195
6132bc01 2196;; Make indentation nice.
f617db13 2197
c56296d0
MW
2198(mdw-define-c-style mdw-java
2199 (c-basic-offset . 2)
2200 (c-backslash-column . 72)
2201 (c-offsets-alist (substatement-open . 0)
2202 (label . +)
2203 (case-label . +)
2204 (access-label . 0)
2205 (inclass . +)
2206 (statement-case-intro . +)))
2207(mdw-set-default-c-style 'java-mode 'mdw-java)
f617db13 2208
6132bc01 2209;; Declare Java fontification style.
f617db13
MW
2210
2211(defun mdw-fontify-java ()
2212
36eabf61
MW
2213 ;; Fiddle with some syntax codes.
2214 (modify-syntax-entry ?@ ".")
2215 (modify-syntax-entry ?@ "." font-lock-syntax-table)
2216
6132bc01 2217 ;; Other stuff.
0e7d960b 2218 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
f617db13 2219
6132bc01 2220 ;; Now define things to be fontified.
02109a0d 2221 (make-local-variable 'font-lock-keywords)
f617db13 2222 (let ((java-keywords
853d8555
MW
2223 (mdw-regexps "abstract" "assert"
2224 "boolean" "break" "byte"
2225 "case" "catch" "char" "class" "const" "continue"
2226 "default" "do" "double"
2227 "else" "enum" "extends"
2228 "final" "finally" "float" "for"
2229 "goto"
2230 "if" "implements" "import" "instanceof" "int"
2231 "interface"
2232 "long"
2233 "native" "new"
2234 "package" "private" "protected" "public"
2235 "return"
2236 "short" "static" "strictfp" "switch" "synchronized"
2237 "throw" "throws" "transient" "try"
2238 "void" "volatile"
2239 "while"))
8d6d55b9 2240
300f8827 2241 (java-builtins
165cecf8 2242 (mdw-regexps "false" "null" "super" "this" "true")))
f617db13
MW
2243
2244 (setq font-lock-keywords
2245 (list
f617db13 2246
6132bc01 2247 ;; Handle the keywords defined above.
f617db13
MW
2248 (list (concat "\\<\\(" java-keywords "\\)\\>")
2249 '(0 font-lock-keyword-face))
2250
300f8827
MW
2251 ;; Handle the magic builtins defined above.
2252 (list (concat "\\<\\(" java-builtins "\\)\\>")
165cecf8
MW
2253 '(0 font-lock-variable-name-face))
2254
6132bc01 2255 ;; Handle numbers too.
f617db13
MW
2256 ;;
2257 ;; The following isn't quite right, but it's close enough.
f617db13
MW
2258 (list (concat "\\<\\("
2259 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2260 "[0-9]+\\(\\.[0-9]*\\|\\)"
2261 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2262 "[lLfFdD]?")
2263 '(0 mdw-number-face))
2264
6132bc01 2265 ;; And anything else is punctuation.
f617db13 2266 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2267 '(0 mdw-punct-face))))))
f617db13 2268
6132bc01 2269;;;--------------------------------------------------------------------------
61d63206
MW
2270;;; Javascript programming configuration.
2271
2272(defun mdw-javascript-style ()
2273 (setq js-indent-level 2)
2274 (setq js-expr-indent-offset 0))
2275
2276(defun mdw-fontify-javascript ()
2277
2278 ;; Other stuff.
2279 (mdw-javascript-style)
2280 (setq js-auto-indent-flag t)
2281
2282 ;; Now define things to be fontified.
2283 (make-local-variable 'font-lock-keywords)
2284 (let ((javascript-keywords
2285 (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2286 "char" "class" "const" "continue" "debugger" "default"
2287 "delete" "do" "double" "else" "enum" "export" "extends"
2288 "final" "finally" "float" "for" "function" "goto" "if"
2289 "implements" "import" "in" "instanceof" "int"
2290 "interface" "let" "long" "native" "new" "package"
2291 "private" "protected" "public" "return" "short"
2292 "static" "super" "switch" "synchronized" "throw"
2293 "throws" "transient" "try" "typeof" "var" "void"
4e23ea53 2294 "volatile" "while" "with" "yield"))
300f8827 2295 (javascript-builtins
61d63206
MW
2296 (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2297 "arguments" "this")))
2298
2299 (setq font-lock-keywords
2300 (list
2301
2302 ;; Handle the keywords defined above.
f7856acd 2303 (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
61d63206
MW
2304 '(0 font-lock-keyword-face))
2305
300f8827
MW
2306 ;; Handle the predefined builtins defined above.
2307 (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
61d63206
MW
2308 '(0 font-lock-variable-name-face))
2309
2310 ;; Handle numbers too.
2311 ;;
2312 ;; The following isn't quite right, but it's close enough.
f7856acd 2313 (list (concat "\\_<\\("
61d63206
MW
2314 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2315 "[0-9]+\\(\\.[0-9]*\\|\\)"
2316 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2317 "[lLfFdD]?")
2318 '(0 mdw-number-face))
2319
2320 ;; And anything else is punctuation.
2321 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2322 '(0 mdw-punct-face))))))
61d63206
MW
2323
2324;;;--------------------------------------------------------------------------
ee7c3dea
MW
2325;;; Scala programming configuration.
2326
2327(defun mdw-fontify-scala ()
2328
7b5903d8
MW
2329 ;; Comment filling.
2330 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2331
ee7c3dea
MW
2332 ;; Define things to be fontified.
2333 (make-local-variable 'font-lock-keywords)
2334 (let ((scala-keywords
2335 (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2336 "extends" "final" "finally" "for" "forSome" "if"
2337 "implicit" "import" "lazy" "match" "new" "object"
3f017188
MW
2338 "override" "package" "private" "protected" "return"
2339 "sealed" "throw" "trait" "try" "type" "val"
ee7c3dea
MW
2340 "var" "while" "with" "yield"))
2341 (scala-constants
3f017188 2342 (mdw-regexps "false" "null" "super" "this" "true"))
7b5903d8 2343 (punctuation "[-!%^&*=+:@#~/?\\|`]"))
ee7c3dea
MW
2344
2345 (setq font-lock-keywords
2346 (list
2347
2348 ;; Magical identifiers between backticks.
2349 (list (concat "`\\([^`]+\\)`")
2350 '(1 font-lock-variable-name-face))
2351
2352 ;; Handle the keywords defined above.
2353 (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2354 '(0 font-lock-keyword-face))
2355
2356 ;; Handle the constants defined above.
2357 (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2358 '(0 font-lock-variable-name-face))
2359
2360 ;; Magical identifiers between backticks.
2361 (list (concat "`\\([^`]+\\)`")
2362 '(1 font-lock-variable-name-face))
2363
2364 ;; Handle numbers too.
2365 ;;
2366 ;; As usual, not quite right.
2367 (list (concat "\\_<\\("
2368 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2369 "[0-9]+\\(\\.[0-9]*\\|\\)"
2370 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2371 "[lLfFdD]?")
2372 '(0 mdw-number-face))
2373
ee7c3dea
MW
2374 ;; And everything else is punctuation.
2375 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2376 '(0 mdw-punct-face)))
2377
2378 font-lock-syntactic-keywords
2379 (list
2380
2381 ;; Single quotes around characters. But not when used to quote
2382 ;; symbol names. Ugh.
2383 (list (concat "\\('\\)"
2384 "\\(" "."
2385 "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
2386 "u+" "[0-9a-fA-F]\\{4\\}"
2387 "\\|" "\\\\" "[0-7]\\{1,3\\}"
2388 "\\|" "\\\\" "." "\\)"
2389 "\\('\\)")
2390 '(1 "\"")
2e7c6a86 2391 '(4 "\""))))))
ee7c3dea
MW
2392
2393;;;--------------------------------------------------------------------------
6132bc01 2394;;; C# programming configuration.
e808c1e5 2395
6132bc01 2396;; Make indentation nice.
e808c1e5 2397
c56296d0
MW
2398(mdw-define-c-style mdw-csharp
2399 (c-basic-offset . 2)
2400 (c-backslash-column . 72)
2401 (c-offsets-alist (substatement-open . 0)
2402 (label . 0)
2403 (case-label . +)
2404 (access-label . 0)
2405 (inclass . +)
2406 (statement-case-intro . +)))
2407(mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
e808c1e5 2408
6132bc01 2409;; Declare C# fontification style.
e808c1e5
MW
2410
2411(defun mdw-fontify-csharp ()
2412
6132bc01 2413 ;; Other stuff.
0e7d960b 2414 (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
e808c1e5 2415
6132bc01 2416 ;; Now define things to be fontified.
e808c1e5
MW
2417 (make-local-variable 'font-lock-keywords)
2418 (let ((csharp-keywords
165cecf8
MW
2419 (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
2420 "char" "checked" "class" "const" "continue" "decimal"
2421 "default" "delegate" "do" "double" "else" "enum"
2422 "event" "explicit" "extern" "finally" "fixed" "float"
2423 "for" "foreach" "goto" "if" "implicit" "in" "int"
2424 "interface" "internal" "is" "lock" "long" "namespace"
2425 "new" "object" "operator" "out" "override" "params"
2426 "private" "protected" "public" "readonly" "ref"
2427 "return" "sbyte" "sealed" "short" "sizeof"
2428 "stackalloc" "static" "string" "struct" "switch"
2429 "throw" "try" "typeof" "uint" "ulong" "unchecked"
2430 "unsafe" "ushort" "using" "virtual" "void" "volatile"
2431 "while" "yield"))
2432
300f8827 2433 (csharp-builtins
165cecf8 2434 (mdw-regexps "base" "false" "null" "this" "true")))
e808c1e5
MW
2435
2436 (setq font-lock-keywords
2437 (list
e808c1e5 2438
6132bc01 2439 ;; Handle the keywords defined above.
e808c1e5
MW
2440 (list (concat "\\<\\(" csharp-keywords "\\)\\>")
2441 '(0 font-lock-keyword-face))
2442
300f8827
MW
2443 ;; Handle the magic builtins defined above.
2444 (list (concat "\\<\\(" csharp-builtins "\\)\\>")
165cecf8
MW
2445 '(0 font-lock-variable-name-face))
2446
6132bc01 2447 ;; Handle numbers too.
e808c1e5
MW
2448 ;;
2449 ;; The following isn't quite right, but it's close enough.
e808c1e5
MW
2450 (list (concat "\\<\\("
2451 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2452 "[0-9]+\\(\\.[0-9]*\\|\\)"
2453 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2454 "[lLfFdD]?")
2455 '(0 mdw-number-face))
2456
6132bc01 2457 ;; And anything else is punctuation.
e808c1e5 2458 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2459 '(0 mdw-punct-face))))))
e808c1e5 2460
103c5923
MW
2461(define-derived-mode csharp-mode java-mode "C#"
2462 "Major mode for editing C# code.")
e808c1e5 2463
6132bc01 2464;;;--------------------------------------------------------------------------
81fb08fc
MW
2465;;; F# programming configuration.
2466
2467(setq fsharp-indent-offset 2)
2468
2469(defun mdw-fontify-fsharp ()
2470
2471 (let ((punct "=<>+-*/|&%!@?"))
2472 (do ((i 0 (1+ i)))
2473 ((>= i (length punct)))
2474 (modify-syntax-entry (aref punct i) ".")))
2475
2476 (modify-syntax-entry ?_ "_")
2477 (modify-syntax-entry ?( "(")
2478 (modify-syntax-entry ?) ")")
2479
2480 (setq indent-tabs-mode nil)
2481
2482 (let ((fsharp-keywords
2483 (mdw-regexps "abstract" "and" "as" "assert" "atomic"
165cecf8 2484 "begin" "break"
81fb08fc
MW
2485 "checked" "class" "component" "const" "constraint"
2486 "constructor" "continue"
2487 "default" "delegate" "do" "done" "downcast" "downto"
2488 "eager" "elif" "else" "end" "exception" "extern"
165cecf8 2489 "finally" "fixed" "for" "fori" "fun" "function"
81fb08fc
MW
2490 "functor"
2491 "global"
2492 "if" "in" "include" "inherit" "inline" "interface"
2493 "internal"
2494 "lazy" "let"
2495 "match" "measure" "member" "method" "mixin" "module"
2496 "mutable"
165cecf8
MW
2497 "namespace" "new"
2498 "object" "of" "open" "or" "override"
81fb08fc
MW
2499 "parallel" "params" "private" "process" "protected"
2500 "public" "pure"
2501 "rec" "recursive" "return"
2502 "sealed" "sig" "static" "struct"
165cecf8 2503 "tailcall" "then" "to" "trait" "try" "type"
81fb08fc
MW
2504 "upcast" "use"
2505 "val" "virtual" "void" "volatile"
2506 "when" "while" "with"
2507 "yield"))
2508
2509 (fsharp-builtins
165cecf8
MW
2510 (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
2511 "base" "false" "null" "true"))
81fb08fc
MW
2512
2513 (bang-keywords
2514 (mdw-regexps "do" "let" "return" "use" "yield"))
2515
2516 (preprocessor-keywords
2517 (mdw-regexps "if" "indent" "else" "endif")))
2518
2519 (setq font-lock-keywords
2520 (list (list (concat "\\(^\\|[^\"]\\)"
2521 "\\(" "(\\*"
2522 "[^*]*\\*+"
2523 "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
2524 ")"
2525 "\\|"
2526 "//.*"
2527 "\\)")
2528 '(2 font-lock-comment-face))
2529
2530 (list (concat "'" "\\("
2531 "\\\\"
2532 "\\(" "[ntbr'\\]"
2533 "\\|" "[0-9][0-9][0-9]"
2534 "\\|" "u" "[0-9a-fA-F]\\{4\\}"
2535 "\\|" "U" "[0-9a-fA-F]\\{8\\}"
2536 "\\)"
2537 "\\|"
2538 "." "\\)" "'"
2539 "\\|"
2540 "\"" "[^\"\\]*"
2541 "\\(" "\\\\" "\\(.\\|\n\\)"
2542 "[^\"\\]*" "\\)*"
2543 "\\(\"\\|\\'\\)")
2544 '(0 font-lock-string-face))
2545
2546 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
2547 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
2548 "\\|"
2549 "\\_<\\(" fsharp-keywords "\\)\\_>")
2550 '(0 font-lock-keyword-face))
2551 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
2552 '(0 font-lock-variable-name-face))
2553
2554 (list (concat "\\_<"
2555 "\\(" "0[bB][01]+" "\\|"
2556 "0[oO][0-7]+" "\\|"
2557 "0[xX][0-9a-fA-F]+" "\\)"
2558 "\\(" "lf\\|LF" "\\|"
2559 "[uU]?[ysnlL]?" "\\)"
2560 "\\|"
2561 "\\_<"
2562 "[0-9]+" "\\("
2563 "[mMQRZING]"
2564 "\\|"
2565 "\\(\\.[0-9]*\\)?"
2566 "\\([eE][-+]?[0-9]+\\)?"
2567 "[fFmM]?"
2568 "\\|"
2569 "[uU]?[ysnlL]?"
2570 "\\)")
2571 '(0 mdw-number-face))
2572
2573 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2574 '(0 mdw-punct-face))))))
81fb08fc
MW
2575
2576(defun mdw-fontify-inferior-fsharp ()
2577 (mdw-fontify-fsharp)
2578 (setq font-lock-keywords
2579 (append (list (list "^[#-]" '(0 font-lock-comment-face))
2580 (list "^>" '(0 font-lock-keyword-face)))
2581 font-lock-keywords)))
2582
2583;;;--------------------------------------------------------------------------
07965a39
MW
2584;;; Go programming configuration.
2585
2586(defun mdw-fontify-go ()
2587
2588 (make-local-variable 'font-lock-keywords)
2589 (let ((go-keywords
2590 (mdw-regexps "break" "case" "chan" "const" "continue"
2591 "default" "defer" "else" "fallthrough" "for"
2592 "func" "go" "goto" "if" "import"
2593 "interface" "map" "package" "range" "return"
fc79ff88
MW
2594 "select" "struct" "switch" "type" "var"))
2595 (go-intrinsics
2596 (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2597 "float32" "float64" "int" "uint8" "int16" "int32"
2598 "int64" "rune" "string" "uint" "uint8" "uint16"
2599 "uint32" "uint64" "uintptr" "void"
2600 "false" "iota" "nil" "true"
2601 "init" "main"
2602 "append" "cap" "copy" "delete" "imag" "len" "make"
2603 "new" "panic" "real" "recover")))
07965a39
MW
2604
2605 (setq font-lock-keywords
2606 (list
2607
2608 ;; Handle the keywords defined above.
2609 (list (concat "\\<\\(" go-keywords "\\)\\>")
2610 '(0 font-lock-keyword-face))
fc79ff88
MW
2611 (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2612 '(0 font-lock-variable-name-face))
07965a39 2613
cbbea94e
MW
2614 ;; Strings and characters.
2615 (list (concat "'"
2616 "\\(" "[^\\']" "\\|"
2617 "\\\\"
2618 "\\(" "[abfnrtv\\'\"]" "\\|"
2619 "[0-7]\\{3\\}" "\\|"
2620 "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2621 "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2622 "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2623 "'"
2624 "\\|"
2625 "\""
2626 "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2627 "\\(\"\\|$\\)"
2628 "\\|"
2629 "`" "[^`]+" "`")
2630 '(0 font-lock-string-face))
2631
07965a39
MW
2632 ;; Handle numbers too.
2633 ;;
2634 ;; The following isn't quite right, but it's close enough.
2635 (list (concat "\\<\\("
2636 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2637 "[0-9]+\\(\\.[0-9]*\\|\\)"
2638 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
2639 '(0 mdw-number-face))
2640
2641 ;; And anything else is punctuation.
2642 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2643 '(0 mdw-punct-face))))))
07965a39
MW
2644
2645;;;--------------------------------------------------------------------------
36db1ea7
MW
2646;;; Rust programming configuration.
2647
2648(setq-default rust-indent-offset 2)
2649
2650(defun mdw-self-insert-and-indent (count)
2651 (interactive "p")
2652 (self-insert-command count)
2653 (indent-according-to-mode))
2654
2655(defun mdw-fontify-rust ()
2656
2657 ;; Hack syntax categories.
cbd69b16 2658 (modify-syntax-entry ?$ ".")
8e234929 2659 (modify-syntax-entry ?% ".")
36db1ea7
MW
2660 (modify-syntax-entry ?= ".")
2661
2662 ;; Fontify keywords and things.
2663 (make-local-variable 'font-lock-keywords)
2664 (let ((rust-keywords
87def30c 2665 (mdw-regexps "abstract" "alignof" "as" "async" "await"
36db1ea7 2666 "become" "box" "break"
260564a3 2667 "const" "continue" "crate"
87def30c 2668 "do" "dyn"
36db1ea7 2669 "else" "enum" "extern"
b6f44b18 2670 "final" "fn" "for"
36db1ea7
MW
2671 "if" "impl" "in"
2672 "let" "loop"
2673 "macro" "match" "mod" "move" "mut"
2674 "offsetof" "override"
b6f44b18 2675 "priv" "proc" "pub" "pure"
36db1ea7 2676 "ref" "return"
b6f44b18 2677 "sizeof" "static" "struct" "super"
87def30c
MW
2678 "trait" "try" "type" "typeof"
2679 "union" "unsafe" "unsized" "use"
36db1ea7
MW
2680 "virtual"
2681 "where" "while"
2682 "yield"))
2683 (rust-builtins
2684 (mdw-regexps "array" "pointer" "slice" "tuple"
2685 "bool" "true" "false"
2686 "f32" "f64"
2687 "i8" "i16" "i32" "i64" "isize"
2688 "u8" "u16" "u32" "u64" "usize"
b6f44b18
MW
2689 "char" "str"
2690 "self" "Self")))
36db1ea7
MW
2691 (setq font-lock-keywords
2692 (list
2693
2694 ;; Handle the keywords defined above.
d71a646d 2695 (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
36db1ea7 2696 '(0 font-lock-keyword-face))
d71a646d 2697 (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
36db1ea7
MW
2698 '(0 font-lock-variable-name-face))
2699
2700 ;; Handle numbers too.
d71a646d 2701 (list (concat "\\_<\\("
36db1ea7
MW
2702 "[0-9][0-9_]*"
2703 "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2704 "\\|" "\\.[0-9_]+"
2705 "\\)"
2706 "\\(f32\\|f64\\)?"
2707 "\\|" "\\(" "[0-9][0-9_]*"
2708 "\\|" "0x[0-9a-fA-F_]+"
2709 "\\|" "0o[0-7_]+"
2710 "\\|" "0b[01_]+"
2711 "\\)"
63b40831 2712 "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
d71a646d 2713 "\\)\\_>")
36db1ea7
MW
2714 '(0 mdw-number-face))
2715
2716 ;; And anything else is punctuation.
2717 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2718 '(0 mdw-punct-face)))))
2719
2720 ;; Hack key bindings.
d2f85967 2721 (local-set-key [?{] 'mdw-self-insert-and-indent)
2e7c6a86 2722 (local-set-key [?}] 'mdw-self-insert-and-indent))
36db1ea7
MW
2723
2724;;;--------------------------------------------------------------------------
6132bc01 2725;;; Awk programming configuration.
f617db13 2726
6132bc01 2727;; Make Awk indentation nice.
f617db13 2728
c56296d0
MW
2729(mdw-define-c-style mdw-awk
2730 (c-basic-offset . 2)
2731 (c-offsets-alist (substatement-open . 0)
2732 (c-backslash-column . 72)
2733 (statement-cont . 0)
2734 (statement-case-intro . +)))
2735(mdw-set-default-c-style 'awk-mode 'mdw-awk)
f617db13 2736
6132bc01 2737;; Declare Awk fontification style.
f617db13
MW
2738
2739(defun mdw-fontify-awk ()
2740
6132bc01 2741 ;; Miscellaneous fiddling.
f617db13
MW
2742 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2743
6132bc01 2744 ;; Now define things to be fontified.
02109a0d 2745 (make-local-variable 'font-lock-keywords)
f617db13 2746 (let ((c-keywords
8d6d55b9
MW
2747 (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2748 "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2749 "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2750 "RSTART" "RLENGTH" "RT" "SUBSEP"
2751 "atan2" "break" "close" "continue" "cos" "delete"
2752 "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2753 "function" "gensub" "getline" "gsub" "if" "in"
2754 "index" "int" "length" "log" "match" "next" "rand"
2755 "return" "print" "printf" "sin" "split" "sprintf"
2756 "sqrt" "srand" "strftime" "sub" "substr" "system"
2757 "systime" "tolower" "toupper" "while")))
f617db13
MW
2758
2759 (setq font-lock-keywords
2760 (list
f617db13 2761
6132bc01 2762 ;; Handle the keywords defined above.
f617db13
MW
2763 (list (concat "\\<\\(" c-keywords "\\)\\>")
2764 '(0 font-lock-keyword-face))
2765
6132bc01 2766 ;; Handle numbers too.
f617db13
MW
2767 ;;
2768 ;; The following isn't quite right, but it's close enough.
f617db13
MW
2769 (list (concat "\\<\\("
2770 "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2771 "[0-9]+\\(\\.[0-9]*\\|\\)"
2772 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2773 "[uUlL]*")
2774 '(0 mdw-number-face))
2775
6132bc01 2776 ;; And anything else is punctuation.
f617db13 2777 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2778 '(0 mdw-punct-face))))))
f617db13 2779
6132bc01
MW
2780;;;--------------------------------------------------------------------------
2781;;; Perl programming style.
f617db13 2782
6132bc01 2783;; Perl indentation style.
f617db13 2784
88158daf
MW
2785(setq perl-indent-level 2)
2786
f617db13
MW
2787(setq cperl-indent-level 2)
2788(setq cperl-continued-statement-offset 2)
2789(setq cperl-continued-brace-offset 0)
2790(setq cperl-brace-offset -2)
2791(setq cperl-brace-imaginary-offset 0)
2792(setq cperl-label-offset 0)
2793
6132bc01 2794;; Define perl fontification style.
f617db13
MW
2795
2796(defun mdw-fontify-perl ()
2797
6132bc01 2798 ;; Miscellaneous fiddling.
f617db13
MW
2799 (modify-syntax-entry ?$ "\\")
2800 (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
a3b8176f 2801 (modify-syntax-entry ?: "." font-lock-syntax-table)
f617db13
MW
2802 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2803
6132bc01 2804 ;; Now define fontification things.
02109a0d 2805 (make-local-variable 'font-lock-keywords)
f617db13 2806 (let ((perl-keywords
821c4945
MW
2807 (mdw-regexps "and"
2808 "break"
2809 "cmp" "continue"
2810 "default" "do"
2811 "else" "elsif" "eq"
2812 "for" "foreach"
2813 "ge" "given" "gt" "goto"
2814 "if"
2815 "last" "le" "local" "lt"
2816 "my"
2817 "ne" "next"
2818 "or" "our"
2819 "package"
2820 "redo" "require" "return"
2821 "sub"
2822 "undef" "unless" "until" "use"
2823 "when" "while")))
f617db13
MW
2824
2825 (setq font-lock-keywords
2826 (list
f617db13 2827
6132bc01 2828 ;; Set up the keywords defined above.
f617db13
MW
2829 (list (concat "\\<\\(" perl-keywords "\\)\\>")
2830 '(0 font-lock-keyword-face))
2831
6132bc01 2832 ;; At least numbers are simpler than C.
f617db13
MW
2833 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2834 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2835 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2836 '(0 mdw-number-face))
2837
6132bc01 2838 ;; And anything else is punctuation.
f617db13 2839 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2840 '(0 mdw-punct-face))))))
f617db13
MW
2841
2842(defun perl-number-tests (&optional arg)
2843 "Assign consecutive numbers to lines containing `#t'. With ARG,
2844strip numbers instead."
2845 (interactive "P")
2846 (save-excursion
2847 (goto-char (point-min))
2848 (let ((i 0) (fmt (if arg "" " %4d")))
2849 (while (search-forward "#t" nil t)
2850 (delete-region (point) (line-end-position))
2851 (setq i (1+ i))
2852 (insert (format fmt i)))
2853 (goto-char (point-min))
2854 (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2855 (replace-match (format "\\1%d" i))))))
2856
6132bc01
MW
2857;;;--------------------------------------------------------------------------
2858;;; Python programming style.
f617db13 2859
99fe6ef5 2860(defun mdw-fontify-pythonic (keywords)
f617db13 2861
6132bc01 2862 ;; Miscellaneous fiddling.
f617db13 2863 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
7c0fcfde 2864 (setq indent-tabs-mode nil)
f617db13 2865
6132bc01 2866 ;; Now define fontification things.
02109a0d 2867 (make-local-variable 'font-lock-keywords)
99fe6ef5
MW
2868 (setq font-lock-keywords
2869 (list
f617db13 2870
be2cc788 2871 ;; Set up the keywords defined above.
4b037109 2872 (list (concat "\\_<\\(" keywords "\\)\\_>")
99fe6ef5 2873 '(0 font-lock-keyword-face))
f617db13 2874
be2cc788 2875 ;; At least numbers are simpler than C.
b257436d 2876 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
b834ced3
MW
2877 "\\_<[0-9][0-9]*\\(\\.[0-9]*\\|\\)"
2878 "\\([eE]\\([-+]\\|\\)[0-9]+\\|[lL]\\|\\)")
99fe6ef5 2879 '(0 mdw-number-face))
f617db13 2880
be2cc788 2881 ;; And anything else is punctuation.
99fe6ef5 2882 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 2883 '(0 mdw-punct-face)))))
99fe6ef5 2884
be2cc788 2885;; Define Python fontification styles.
99fe6ef5
MW
2886
2887(defun mdw-fontify-python ()
2888 (mdw-fontify-pythonic
2889 (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2890 "del" "elif" "else" "except" "exec" "finally" "for"
2891 "from" "global" "if" "import" "in" "is" "lambda"
2892 "not" "or" "pass" "print" "raise" "return" "try"
2893 "while" "with" "yield")))
2894
2895(defun mdw-fontify-pyrex ()
2896 (mdw-fontify-pythonic
2897 (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
a63efb67 2898 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
99fe6ef5
MW
2899 "extern" "finally" "for" "from" "global" "if"
2900 "import" "in" "is" "lambda" "not" "or" "pass" "print"
a63efb67 2901 "property" "raise" "return" "struct" "try" "while" "with"
99fe6ef5 2902 "yield")))
f617db13 2903
b5263ae5
MW
2904(define-derived-mode pyrex-mode python-mode "Pyrex"
2905 "Major mode for editing Pyrex source code")
2906(setq auto-mode-alist
2907 (append '(("\\.pyx$" . pyrex-mode)
2908 ("\\.pxd$" . pyrex-mode)
2909 ("\\.pxi$" . pyrex-mode))
2910 auto-mode-alist))
2911
6132bc01 2912;;;--------------------------------------------------------------------------
772a7a3b
MW
2913;;; Lua programming style.
2914
2915(setq lua-indent-level 2)
2916
2917(defun mdw-fontify-lua ()
2918
2919 ;; Miscellaneous fiddling.
2920 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2921
2922 ;; Now define fontification things.
2923 (make-local-variable 'font-lock-keywords)
2924 (let ((lua-keywords
2925 (mdw-regexps "and" "break" "do" "else" "elseif" "end"
2926 "false" "for" "function" "goto" "if" "in" "local"
2927 "nil" "not" "or" "repeat" "return" "then" "true"
2928 "until" "while")))
2929 (setq font-lock-keywords
2930 (list
2931
2932 ;; Set up the keywords defined above.
2933 (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
2934 '(0 font-lock-keyword-face))
2935
2936 ;; At least numbers are simpler than C.
2937 (list (concat "\\_<\\(" "0[xX]"
2938 "\\(" "[0-9a-fA-F]+"
2939 "\\(\\.[0-9a-fA-F]*\\)?"
2940 "\\|" "\\.[0-9a-fA-F]+"
2941 "\\)"
2942 "\\([pP][-+]?[0-9]+\\)?"
2943 "\\|" "\\(" "[0-9]+"
2944 "\\(\\.[0-9]*\\)?"
2945 "\\|" "\\.[0-9]+"
2946 "\\)"
2947 "\\([eE][-+]?[0-9]+\\)?"
2948 "\\)")
2949 '(0 mdw-number-face))
2950
2951 ;; And anything else is punctuation.
2952 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2953 '(0 mdw-punct-face))))))
2954
2955;;;--------------------------------------------------------------------------
6132bc01 2956;;; Icon programming style.
cc1980e1 2957
6132bc01 2958;; Icon indentation style.
cc1980e1
MW
2959
2960(setq icon-brace-offset 0
2961 icon-continued-brace-offset 0
2962 icon-continued-statement-offset 2
2963 icon-indent-level 2)
2964
6132bc01 2965;; Define Icon fontification style.
cc1980e1
MW
2966
2967(defun mdw-fontify-icon ()
2968
6132bc01 2969 ;; Miscellaneous fiddling.
cc1980e1
MW
2970 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2971
6132bc01 2972 ;; Now define fontification things.
cc1980e1
MW
2973 (make-local-variable 'font-lock-keywords)
2974 (let ((icon-keywords
2975 (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2976 "end" "every" "fail" "global" "if" "initial"
2977 "invocable" "link" "local" "next" "not" "of"
2978 "procedure" "record" "repeat" "return" "static"
2979 "suspend" "then" "to" "until" "while"))
2980 (preprocessor-keywords
2981 (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2982 "include" "line" "undef")))
2983 (setq font-lock-keywords
2984 (list
2985
6132bc01 2986 ;; Set up the keywords defined above.
cc1980e1
MW
2987 (list (concat "\\<\\(" icon-keywords "\\)\\>")
2988 '(0 font-lock-keyword-face))
2989
6132bc01 2990 ;; The things that Icon calls keywords.
cc1980e1
MW
2991 (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2992
6132bc01 2993 ;; At least numbers are simpler than C.
cc1980e1
MW
2994 (list (concat "\\<[0-9]+"
2995 "\\([rR][0-9a-zA-Z]+\\|"
2996 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2997 "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2998 '(0 mdw-number-face))
2999
6132bc01 3000 ;; Preprocessor.
cc1980e1
MW
3001 (list (concat "^[ \t]*$[ \t]*\\<\\("
3002 preprocessor-keywords
3003 "\\)\\>")
3004 '(0 font-lock-keyword-face))
3005
6132bc01 3006 ;; And anything else is punctuation.
cc1980e1 3007 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3008 '(0 mdw-punct-face))))))
cc1980e1 3009
6132bc01 3010;;;--------------------------------------------------------------------------
6132bc01 3011;;; Assembler mode.
30c8a8fb
MW
3012
3013(defun mdw-fontify-asm ()
3014 (modify-syntax-entry ?' "\"")
3015 (modify-syntax-entry ?. "w")
9032280b 3016 (modify-syntax-entry ?\n ">")
30c8a8fb 3017 (setf fill-prefix nil)
5edd6d49
MW
3018 (modify-syntax-entry ?. "_")
3019 (modify-syntax-entry ?* ". 23")
3020 (modify-syntax-entry ?/ ". 124b")
3021 (modify-syntax-entry ?\n "> b")
b90c2a2c 3022 (local-set-key ";" 'self-insert-command)
30c8a8fb
MW
3023 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
3024
227b2b2b
MW
3025(defun mdw-asm-set-comment ()
3026 (modify-syntax-entry ?; "."
3027 )
5edd6d49 3028 (modify-syntax-entry asm-comment-char "< b")
227b2b2b
MW
3029 (setq comment-start (string asm-comment-char ? )))
3030(add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
3031(put 'asm-comment-char 'safe-local-variable 'characterp)
9032280b 3032
6132bc01
MW
3033;;;--------------------------------------------------------------------------
3034;;; TCL configuration.
f617db13
MW
3035
3036(defun mdw-fontify-tcl ()
3037 (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
3038 (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
02109a0d 3039 (make-local-variable 'font-lock-keywords)
f617db13
MW
3040 (setq font-lock-keywords
3041 (list
f617db13
MW
3042 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3043 "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3044 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3045 '(0 mdw-number-face))
3046 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3047 '(0 mdw-punct-face)))))
f617db13 3048
6132bc01 3049;;;--------------------------------------------------------------------------
ad305d7e
MW
3050;;; Dylan programming configuration.
3051
3052(defun mdw-fontify-dylan ()
3053
3054 (make-local-variable 'font-lock-keywords)
3055
3056 ;; Horrors. `dylan-mode' sets the `major-mode' name after calling this
3057 ;; hook, which undoes all of our configuration.
3058 (setq major-mode 'dylan-mode)
3059 (font-lock-set-defaults)
3060
3061 (let* ((word "[-_a-zA-Z!*@<>$%]+")
3062 (dylan-keywords (mdw-regexps
3063
3064 "C-address" "C-callable-wrapper" "C-function"
3065 "C-mapped-subtype" "C-pointer-type" "C-struct"
3066 "C-subtype" "C-union" "C-variable"
3067
3068 "above" "abstract" "afterwards" "all"
3069 "begin" "below" "block" "by"
3070 "case" "class" "cleanup" "constant" "create"
3071 "define" "domain"
3072 "else" "elseif" "end" "exception" "export"
3073 "finally" "for" "from" "function"
3074 "generic"
3075 "handler"
3076 "if" "in" "instance" "interface" "iterate"
3077 "keyed-by"
3078 "let" "library" "local"
3079 "macro" "method" "module"
3080 "otherwise"
3081 "profiling"
3082 "select" "slot" "subclass"
3083 "table" "then" "to"
3084 "unless" "until" "use"
3085 "variable" "virtual"
3086 "when" "while"))
3087 (sharp-keywords (mdw-regexps
3088 "all-keys" "key" "next" "rest" "include"
3089 "t" "f")))
3090 (setq font-lock-keywords
3091 (list (list (concat "\\<\\(" dylan-keywords
ce29694e 3092 "\\|" "with\\(out\\)?-" word
ad305d7e
MW
3093 "\\)\\>")
3094 '(0 font-lock-keyword-face))
ce29694e
MW
3095 (list (concat "\\<" word ":" "\\|"
3096 "#\\(" sharp-keywords "\\)\\>")
ad305d7e
MW
3097 '(0 font-lock-variable-name-face))
3098 (list (concat "\\("
3099 "\\([-+]\\|\\<\\)[0-9]+" "\\("
3100 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
3101 "\\|" "/[0-9]+"
3102 "\\)"
3103 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
3104 "\\|" "#b[01]+"
3105 "\\|" "#o[0-7]+"
3106 "\\|" "#x[0-9a-zA-Z]+"
3107 "\\)\\>")
3108 '(0 mdw-number-face))
3109 (list (concat "\\("
3110 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
3111 "\\_<[-+*/=<>:&|]+\\_>"
3112 "\\)")
2e7c6a86 3113 '(0 mdw-punct-face))))))
ad305d7e
MW
3114
3115;;;--------------------------------------------------------------------------
7fce54c3
MW
3116;;; Algol 68 configuration.
3117
3118(setq a68-indent-step 2)
3119
3120(defun mdw-fontify-algol-68 ()
3121
3122 ;; Fix up the syntax table.
3123 (modify-syntax-entry ?# "!" a68-mode-syntax-table)
3124 (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
3125 (modify-syntax-entry ch "." a68-mode-syntax-table))
3126
3127 (make-local-variable 'font-lock-keywords)
3128
3129 (let ((not-comment
3130 (let ((word "COMMENT"))
3131 (do ((regexp (concat "[^" (substring word 0 1) "]+")
3132 (concat regexp "\\|"
3133 (substring word 0 i)
3134 "[^" (substring word i (1+ i)) "]"))
3135 (i 1 (1+ i)))
3136 ((>= i (length word)) regexp)))))
3137 (setq font-lock-keywords
3138 (list (list (concat "\\<COMMENT\\>"
3139 "\\(" not-comment "\\)\\{0,5\\}"
3140 "\\(\\'\\|\\<COMMENT\\>\\)")
3141 '(0 font-lock-comment-face))
3142 (list (concat "\\<CO\\>"
3143 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
3144 "\\($\\|\\<CO\\>\\)")
3145 '(0 font-lock-comment-face))
3146 (list "\\<[A-Z_]+\\>"
3147 '(0 font-lock-keyword-face))
3148 (list (concat "\\<"
3149 "[0-9]+"
3150 "\\(\\.[0-9]+\\)?"
3151 "\\([eE][-+]?[0-9]+\\)?"
3152 "\\>")
3153 '(0 mdw-number-face))
3154 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2e7c6a86 3155 '(0 mdw-punct-face))))))
7fce54c3
MW
3156
3157;;;--------------------------------------------------------------------------
6132bc01 3158;;; REXX configuration.
f617db13
MW
3159
3160(defun mdw-rexx-electric-* ()
3161 (interactive)
3162 (insert ?*)
3163 (rexx-indent-line))
3164
3165(defun mdw-rexx-indent-newline-indent ()
3166 (interactive)
3167 (rexx-indent-line)
3168 (if abbrev-mode (expand-abbrev))
3169 (newline-and-indent))
3170
3171(defun mdw-fontify-rexx ()
3172
6132bc01 3173 ;; Various bits of fiddling.
f617db13
MW
3174 (setq mdw-auto-indent nil)
3175 (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
3176 (local-set-key [?*] 'mdw-rexx-electric-*)
3177 (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
e443a4cd 3178 '(?! ?? ?# ?@ ?$))
96f196d6
MW
3179 (mapcar #'(lambda (ch) (modify-syntax-entry ch "."))
3180 '(?¬))
f617db13
MW
3181 (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
3182
6132bc01 3183 ;; Set up keywords and things for fontification.
f617db13
MW
3184 (make-local-variable 'font-lock-keywords-case-fold-search)
3185 (setq font-lock-keywords-case-fold-search t)
3186
3187 (setq rexx-indent 2)
3188 (setq rexx-end-indent rexx-indent)
f617db13
MW
3189 (setq rexx-cont-indent rexx-indent)
3190
02109a0d 3191 (make-local-variable 'font-lock-keywords)
f617db13 3192 (let ((rexx-keywords
8d6d55b9
MW
3193 (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
3194 "else" "end" "engineering" "exit" "expose" "for"
3195 "forever" "form" "fuzz" "if" "interpret" "iterate"
3196 "leave" "linein" "name" "nop" "numeric" "off" "on"
3197 "options" "otherwise" "parse" "procedure" "pull"
3198 "push" "queue" "return" "say" "select" "signal"
3199 "scientific" "source" "then" "trace" "to" "until"
3200 "upper" "value" "var" "version" "when" "while"
3201 "with"
3202
3203 "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
3204 "center" "center" "charin" "charout" "chars"
3205 "compare" "condition" "copies" "c2d" "c2x"
3206 "datatype" "date" "delstr" "delword" "d2c" "d2x"
3207 "errortext" "format" "fuzz" "insert" "lastpos"
3208 "left" "length" "lineout" "lines" "max" "min"
3209 "overlay" "pos" "queued" "random" "reverse" "right"
3210 "sign" "sourceline" "space" "stream" "strip"
3211 "substr" "subword" "symbol" "time" "translate"
3212 "trunc" "value" "verify" "word" "wordindex"
3213 "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
3214 "x2d")))
f617db13
MW
3215
3216 (setq font-lock-keywords
3217 (list
f617db13 3218
6132bc01 3219 ;; Set up the keywords defined above.
f617db13
MW
3220 (list (concat "\\<\\(" rexx-keywords "\\)\\>")
3221 '(0 font-lock-keyword-face))
3222
6132bc01 3223 ;; Fontify all symbols the same way.
f617db13
MW
3224 (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
3225 "[A-Za-z0-9.!?_#@$]+\\)")
3226 '(0 font-lock-variable-name-face))
3227
6132bc01 3228 ;; And everything else is punctuation.
f617db13 3229 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3230 '(0 mdw-punct-face))))))
f617db13 3231
6132bc01
MW
3232;;;--------------------------------------------------------------------------
3233;;; Standard ML programming style.
f617db13
MW
3234
3235(defun mdw-fontify-sml ()
3236
6132bc01 3237 ;; Make underscore an honorary letter.
f617db13
MW
3238 (modify-syntax-entry ?' "w")
3239
6132bc01 3240 ;; Set fill prefix.
f617db13
MW
3241 (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
3242
6132bc01 3243 ;; Now define fontification things.
02109a0d 3244 (make-local-variable 'font-lock-keywords)
f617db13 3245 (let ((sml-keywords
8d6d55b9
MW
3246 (mdw-regexps "abstype" "and" "andalso" "as"
3247 "case"
3248 "datatype" "do"
3249 "else" "end" "eqtype" "exception"
3250 "fn" "fun" "functor"
3251 "handle"
3252 "if" "in" "include" "infix" "infixr"
3253 "let" "local"
3254 "nonfix"
3255 "of" "op" "open" "orelse"
3256 "raise" "rec"
3257 "sharing" "sig" "signature" "struct" "structure"
3258 "then" "type"
3259 "val"
3260 "where" "while" "with" "withtype")))
f617db13
MW
3261
3262 (setq font-lock-keywords
3263 (list
f617db13 3264
6132bc01 3265 ;; Set up the keywords defined above.
f617db13
MW
3266 (list (concat "\\<\\(" sml-keywords "\\)\\>")
3267 '(0 font-lock-keyword-face))
3268
6132bc01 3269 ;; At least numbers are simpler than C.
f617db13
MW
3270 (list (concat "\\<\\(\\~\\|\\)"
3271 "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
852cd5fb
MW
3272 "[wW][0-9]+\\)\\|"
3273 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
3274 "\\([eE]\\(\\~\\|\\)"
3275 "[0-9]+\\|\\)\\)\\)")
f617db13
MW
3276 '(0 mdw-number-face))
3277
6132bc01 3278 ;; And anything else is punctuation.
f617db13 3279 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3280 '(0 mdw-punct-face))))))
f617db13 3281
6132bc01
MW
3282;;;--------------------------------------------------------------------------
3283;;; Haskell configuration.
f617db13
MW
3284
3285(defun mdw-fontify-haskell ()
3286
6132bc01 3287 ;; Fiddle with syntax table to get comments right.
5952a020
MW
3288 (modify-syntax-entry ?' "_")
3289 (modify-syntax-entry ?- ". 12")
f617db13
MW
3290 (modify-syntax-entry ?\n ">")
3291
4d90cf3d
MW
3292 ;; Make punctuation be punctuation
3293 (let ((punct "=<>+-*/|&%!@?$.^:#`"))
3294 (do ((i 0 (1+ i)))
3295 ((>= i (length punct)))
3296 (modify-syntax-entry (aref punct i) ".")))
3297
6132bc01 3298 ;; Set fill prefix.
f617db13
MW
3299 (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
3300
6132bc01 3301 ;; Fiddle with fontification.
02109a0d 3302 (make-local-variable 'font-lock-keywords)
f617db13 3303 (let ((haskell-keywords
5952a020
MW
3304 (mdw-regexps "as"
3305 "case" "ccall" "class"
3306 "data" "default" "deriving" "do"
3307 "else" "exists"
3308 "forall" "foreign"
3309 "hiding"
3310 "if" "import" "in" "infix" "infixl" "infixr" "instance"
3311 "let"
3312 "mdo" "module"
3313 "newtype"
3314 "of"
3315 "proc"
3316 "qualified"
3317 "rec"
3318 "safe" "stdcall"
3319 "then" "type"
3320 "unsafe"
3321 "where"))
3322 (control-sequences
3323 (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
3324 "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
3325 "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
3326 "SP" "STX" "SUB" "SYN" "US" "VT")))
f617db13
MW
3327
3328 (setq font-lock-keywords
3329 (list
5952a020
MW
3330 (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
3331 "\\(-+}\\|-*\\'\\)"
3332 "\\|"
3333 "--.*$")
f617db13 3334 '(0 font-lock-comment-face))
5952a020 3335 (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
f617db13 3336 '(0 font-lock-keyword-face))
5952a020
MW
3337 (list (concat "'\\("
3338 "[^\\]"
3339 "\\|"
3340 "\\\\"
3341 "\\(" "[abfnrtv\\\"']" "\\|"
3342 "^" "\\(" control-sequences "\\|"
3343 "[]A-Z@[\\^_]" "\\)" "\\|"
3344 "\\|"
3345 "[0-9]+" "\\|"
3346 "[oO][0-7]+" "\\|"
3347 "[xX][0-9A-Fa-f]+"
3348 "\\)"
3349 "\\)'")
3350 '(0 font-lock-string-face))
3351 (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
3352 '(0 font-lock-variable-name-face))
3353 (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
3354 "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
f617db13
MW
3355 "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
3356 '(0 mdw-number-face))
3357 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3358 '(0 mdw-punct-face))))))
f617db13 3359
6132bc01
MW
3360;;;--------------------------------------------------------------------------
3361;;; Erlang configuration.
2ded9493 3362
52941dec 3363(setq erlang-electric-commands nil)
2ded9493
MW
3364
3365(defun mdw-fontify-erlang ()
3366
6132bc01 3367 ;; Set fill prefix.
2ded9493
MW
3368 (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
3369
6132bc01 3370 ;; Fiddle with fontification.
2ded9493
MW
3371 (make-local-variable 'font-lock-keywords)
3372 (let ((erlang-keywords
3373 (mdw-regexps "after" "and" "andalso"
3374 "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
3375 "case" "catch" "cond"
3376 "div" "end" "fun" "if" "let" "not"
3377 "of" "or" "orelse"
3378 "query" "receive" "rem" "try" "when" "xor")))
3379
3380 (setq font-lock-keywords
3381 (list
3382 (list "%.*$"
3383 '(0 font-lock-comment-face))
3384 (list (concat "\\<\\(" erlang-keywords "\\)\\>")
3385 '(0 font-lock-keyword-face))
3386 (list (concat "^-\\sw+\\>")
3387 '(0 font-lock-keyword-face))
3388 (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
3389 '(0 mdw-number-face))
3390 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3391 '(0 mdw-punct-face))))))
2ded9493 3392
6132bc01
MW
3393;;;--------------------------------------------------------------------------
3394;;; Texinfo configuration.
f617db13
MW
3395
3396(defun mdw-fontify-texinfo ()
3397
6132bc01 3398 ;; Set fill prefix.
f617db13
MW
3399 (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
3400
6132bc01 3401 ;; Real fontification things.
02109a0d 3402 (make-local-variable 'font-lock-keywords)
f617db13
MW
3403 (setq font-lock-keywords
3404 (list
f617db13 3405
6132bc01 3406 ;; Environment names are keywords.
f617db13
MW
3407 (list "@\\(end\\) *\\([a-zA-Z]*\\)?"
3408 '(2 font-lock-keyword-face))
3409
6132bc01 3410 ;; Unmark escaped magic characters.
f617db13
MW
3411 (list "\\(@\\)\\([@{}]\\)"
3412 '(1 font-lock-keyword-face)
3413 '(2 font-lock-variable-name-face))
3414
6132bc01 3415 ;; Make sure we get comments properly.
f617db13
MW
3416 (list "@c\\(\\|omment\\)\\( .*\\)?$"
3417 '(0 font-lock-comment-face))
3418
6132bc01 3419 ;; Command names are keywords.
f617db13
MW
3420 (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3421 '(0 font-lock-keyword-face))
3422
6132bc01 3423 ;; Fontify TeX special characters as punctuation.
f617db13 3424 (list "[{}]+"
2e7c6a86 3425 '(0 mdw-punct-face)))))
f617db13 3426
6132bc01
MW
3427;;;--------------------------------------------------------------------------
3428;;; TeX and LaTeX configuration.
f617db13
MW
3429
3430(defun mdw-fontify-tex ()
3431 (setq ispell-parser 'tex)
55f80fae 3432 (turn-on-reftex)
f617db13 3433
6132bc01 3434 ;; Don't make maths into a string.
f617db13
MW
3435 (modify-syntax-entry ?$ ".")
3436 (modify-syntax-entry ?$ "." font-lock-syntax-table)
3437 (local-set-key [?$] 'self-insert-command)
3438
df200ecd 3439 ;; Make `tab' be useful, given that tab stops in TeX don't work well.
060c23ce 3440 (local-set-key "\C-\M-i" 'indent-relative)
df200ecd
MW
3441 (setq indent-tabs-mode nil)
3442
6132bc01 3443 ;; Set fill prefix.
f617db13
MW
3444 (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
3445
6132bc01 3446 ;; Real fontification things.
02109a0d 3447 (make-local-variable 'font-lock-keywords)
f617db13
MW
3448 (setq font-lock-keywords
3449 (list
f617db13 3450
6132bc01 3451 ;; Environment names are keywords.
f617db13
MW
3452 (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
3453 "{\\([^}\n]*\\)}")
3454 '(2 font-lock-keyword-face))
3455
6132bc01 3456 ;; Suspended environment names are keywords too.
f617db13
MW
3457 (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
3458 "{\\([^}\n]*\\)}")
3459 '(3 font-lock-keyword-face))
3460
6132bc01 3461 ;; Command names are keywords.
f617db13
MW
3462 (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3463 '(0 font-lock-keyword-face))
3464
6132bc01 3465 ;; Handle @/.../ for italics.
f617db13 3466 ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
852cd5fb
MW
3467 ;; '(1 font-lock-keyword-face)
3468 ;; '(3 font-lock-keyword-face))
f617db13 3469
6132bc01 3470 ;; Handle @*...* for boldness.
f617db13 3471 ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
852cd5fb
MW
3472 ;; '(1 font-lock-keyword-face)
3473 ;; '(3 font-lock-keyword-face))
f617db13 3474
6132bc01 3475 ;; Handle @`...' for literal syntax things.
f617db13 3476 ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
852cd5fb
MW
3477 ;; '(1 font-lock-keyword-face)
3478 ;; '(3 font-lock-keyword-face))
f617db13 3479
6132bc01 3480 ;; Handle @<...> for nonterminals.
f617db13 3481 ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
852cd5fb
MW
3482 ;; '(1 font-lock-keyword-face)
3483 ;; '(3 font-lock-keyword-face))
f617db13 3484
6132bc01 3485 ;; Handle other @-commands.
f617db13 3486 ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
852cd5fb 3487 ;; '(0 font-lock-keyword-face))
f617db13 3488
6132bc01 3489 ;; Make sure we get comments properly.
f617db13
MW
3490 (list "%.*"
3491 '(0 font-lock-comment-face))
3492
6132bc01 3493 ;; Fontify TeX special characters as punctuation.
f617db13 3494 (list "[$^_{}#&]"
2e7c6a86 3495 '(0 mdw-punct-face)))))
f617db13 3496
d9bba20d
MW
3497(setq TeX-install-font-lock 'tex-font-setup)
3498
8638f2f3
MW
3499(eval-after-load 'font-latex
3500 '(defun font-latex-jit-lock-force-redisplay (buf start end)
3501 "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
3502 ;; The following block is an expansion of `jit-lock-force-redisplay'
3503 ;; and involved macros taken from CVS Emacs on 2007-04-28.
3504 (with-current-buffer buf
3505 (let ((modified (buffer-modified-p)))
3506 (unwind-protect
3507 (let ((buffer-undo-list t)
3508 (inhibit-read-only t)
3509 (inhibit-point-motion-hooks t)
3510 (inhibit-modification-hooks t)
3511 deactivate-mark
3512 buffer-file-name
3513 buffer-file-truename)
3514 (put-text-property start end 'fontified t))
3515 (unless modified
3516 (restore-buffer-modified-p nil)))))))
3517
9bbb1ba0
MW
3518(setq LaTeX-syntactic-comments nil
3519 LaTeX-fill-break-at-separators '(\\\[))
3520
ad14c2fe
MW
3521(add-hook 'bibtex-mode-hook (lambda () (setq fill-column 76)))
3522
6132bc01 3523;;;--------------------------------------------------------------------------
445ddb61
MW
3524;;; HTML, CSS, and other web foolishness.
3525
3526(setq css-indent-offset 2)
3527
3528;;;--------------------------------------------------------------------------
6132bc01 3529;;; SGML hacking.
f25cf300
MW
3530
3531(defun mdw-sgml-mode ()
3532 (interactive)
3533 (sgml-mode)
3534 (mdw-standard-fill-prefix "")
8a425bd7 3535 (make-local-variable 'sgml-delimiters)
f25cf300
MW
3536 (setq sgml-delimiters
3537 '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
3538 "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
3539 "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
3540 "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
3541 "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
3542 "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
3543 "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
3544 "NULL" ""))
3545 (setq major-mode 'mdw-sgml-mode)
3546 (setq mode-name "[mdw] SGML")
3547 (run-hooks 'mdw-sgml-mode-hook))
6cb52f8b
MW
3548
3549;;;--------------------------------------------------------------------------
3550;;; Configuration files.
3551
3552(defvar mdw-conf-quote-normal nil
3553 "*Control syntax category of quote characters `\"' and `''.
3554If this is `t', consider quote characters to be normal
3555punctuation, as for `conf-quote-normal'. If this is `nil' then
3556leave quote characters as quotes. If this is a list, then
3557consider the quote characters in the list to be normal
3558punctuation. If this is a single quote character, then consider
3559that character only to be normal punctuation.")
3560(defun mdw-conf-quote-normal-acceptable-value-p (value)
3561 "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
3562 (or (booleanp value)
3563 (every (lambda (v) (memq v '(?\" ?')))
3564 (if (listp value) value (list value)))))
18bb0f77
MW
3565(put 'mdw-conf-quote-normal 'safe-local-variable
3566 'mdw-conf-quote-normal-acceptable-value-p)
6cb52f8b
MW
3567
3568(defun mdw-fix-up-quote ()
3569 "Apply the setting of `mdw-conf-quote-normal'."
3570 (let ((flag mdw-conf-quote-normal))
3571 (cond ((eq flag t)
3572 (conf-quote-normal t))
3573 ((not flag)
3574 nil)
3575 (t
3576 (let ((table (copy-syntax-table (syntax-table))))
3577 (mapc (lambda (ch) (modify-syntax-entry ch "." table))
3578 (if (listp flag) flag (list flag)))
3579 (set-syntax-table table)
3580 (and font-lock-mode (font-lock-fontify-buffer)))))))
18bb0f77 3581(add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
f25cf300 3582
6132bc01
MW
3583;;;--------------------------------------------------------------------------
3584;;; Shell scripts.
f617db13
MW
3585
3586(defun mdw-setup-sh-script-mode ()
3587
6132bc01 3588 ;; Fetch the shell interpreter's name.
f617db13
MW
3589 (let ((shell-name sh-shell-file))
3590
6132bc01 3591 ;; Try reading the hash-bang line.
f617db13
MW
3592 (save-excursion
3593 (goto-char (point-min))
3594 (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
3595 (setq shell-name (match-string 1))))
3596
6132bc01 3597 ;; Now try to set the shell.
f617db13
MW
3598 ;;
3599 ;; Don't let `sh-set-shell' bugger up my script.
f617db13
MW
3600 (let ((executable-set-magic #'(lambda (s &rest r) s)))
3601 (sh-set-shell shell-name)))
3602
10c51541
MW
3603 ;; Don't insert here-document scaffolding automatically.
3604 (local-set-key "<" 'self-insert-command)
3605
6132bc01 3606 ;; Now enable my keys and the fontification.
f617db13
MW
3607 (mdw-misc-mode-config)
3608
6132bc01 3609 ;; Set the indentation level correctly.
f617db13
MW
3610 (setq sh-indentation 2)
3611 (setq sh-basic-offset 2))
3612
070c1dca
MW
3613(setq sh-shell-file "/bin/sh")
3614
6d6e095a
MW
3615;; Awful hacking to override the shell detection for particular scripts.
3616(defmacro define-custom-shell-mode (name shell)
3617 `(defun ,name ()
3618 (interactive)
3619 (set (make-local-variable 'sh-shell-file) ,shell)
3620 (sh-mode)))
3621(define-custom-shell-mode bash-mode "/bin/bash")
3622(define-custom-shell-mode rc-mode "/usr/bin/rc")
3623(put 'sh-shell-file 'permanent-local t)
3624
3625;; Hack the rc syntax table. Backquotes aren't paired in rc.
3626(eval-after-load "sh-script"
3627 '(or (assq 'rc sh-mode-syntax-table-input)
3628 (let ((frag '(nil
3629 ?# "<"
3630 ?\n ">#"
3631 ?\" "\"\""
3632 ?\' "\"\'"
3633 ?$ "'"
3634 ?\` "."
3635 ?! "_"
3636 ?% "_"
3637 ?. "_"
3638 ?^ "_"
3639 ?~ "_"
3640 ?, "_"
3641 ?= "."
3642 ?< "."
3643 ?> "."))
3644 (assoc (assq 'rc sh-mode-syntax-table-input)))
3645 (if assoc
3646 (rplacd assoc frag)
3647 (setq sh-mode-syntax-table-input
3648 (cons (cons 'rc frag)
3649 sh-mode-syntax-table-input))))))
3650
6132bc01 3651;;;--------------------------------------------------------------------------
092f0a38
MW
3652;;; Emacs shell mode.
3653
3654(defun mdw-eshell-prompt ()
3655 (let ((left "[") (right "]"))
3656 (when (= (user-uid) 0)
3657 (setq left "«" right "»"))
3658 (concat left
3659 (save-match-data
3660 (replace-regexp-in-string "\\..*$" "" (system-name)))
3661 " "
2d8b2924
MW
3662 (let* ((pwd (eshell/pwd)) (npwd (length pwd))
3663 (home (expand-file-name "~")) (nhome (length home)))
3664 (if (and (>= npwd nhome)
3665 (or (= nhome npwd)
5801e199
MW
3666 (= (elt pwd nhome) ?/))
3667 (string= (substring pwd 0 nhome) home))
2d8b2924
MW
3668 (concat "~" (substring pwd (length home)))
3669 pwd))
092f0a38
MW
3670 right)))
3671(setq eshell-prompt-function 'mdw-eshell-prompt)
ac4ae7cd 3672(setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
092f0a38 3673
2d8b2924
MW
3674(defun eshell/e (file) (find-file file) nil)
3675(defun eshell/ee (file) (find-file-other-window file) nil)
3676(defun eshell/w3m (url) (w3m-goto-url url) nil)
415a23dd 3677
092f0a38
MW
3678(mdw-define-face eshell-prompt (t :weight bold))
3679(mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
3680(mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
3681(mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
3682(mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
3683(mdw-define-face eshell-ls-executable (t :weight bold))
3684(mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
3685(mdw-define-face eshell-ls-readonly (t nil))
3686(mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
3687
b1a598dc 3688(defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
8845865d
MW
3689(add-hook 'eshell-mode-hook 'mdw-eshell-hack)
3690
092f0a38 3691;;;--------------------------------------------------------------------------
6132bc01 3692;;; Messages-file mode.
f617db13 3693
4bb22eea 3694(defun messages-mode-guts ()
f617db13
MW
3695 (setq messages-mode-syntax-table (make-syntax-table))
3696 (set-syntax-table messages-mode-syntax-table)
f617db13
MW
3697 (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
3698 (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
3699 (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
3700 (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
3701 (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
3702 (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
3703 (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
3704 (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
3705 (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
3706 (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
3707 (make-local-variable 'comment-start)
3708 (make-local-variable 'comment-end)
3709 (make-local-variable 'indent-line-function)
3710 (setq indent-line-function 'indent-relative)
3711 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3712 (make-local-variable 'font-lock-defaults)
4bb22eea 3713 (make-local-variable 'messages-mode-keywords)
f617db13 3714 (let ((keywords
8d6d55b9
MW
3715 (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
3716 "export" "enum" "fixed-octetstring" "flags"
3717 "harmless" "map" "nested" "optional"
3718 "optional-tagged" "package" "primitive"
3719 "primitive-nullfree" "relaxed[ \t]+enum"
3720 "set" "table" "tagged-optional" "union"
3721 "variadic" "vector" "version" "version-tag")))
4bb22eea 3722 (setq messages-mode-keywords
f617db13
MW
3723 (list
3724 (list (concat "\\<\\(" keywords "\\)\\>:")
3725 '(0 font-lock-keyword-face))
3726 '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
3727 '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
3728 (0 font-lock-variable-name-face))
3729 '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
3730 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3731 (0 mdw-punct-face)))))
3732 (setq font-lock-defaults
4bb22eea 3733 '(messages-mode-keywords nil nil nil nil))
f617db13
MW
3734 (run-hooks 'messages-file-hook))
3735
3736(defun messages-mode ()
3737 (interactive)
3738 (fundamental-mode)
3739 (setq major-mode 'messages-mode)
3740 (setq mode-name "Messages")
4bb22eea 3741 (messages-mode-guts)
f617db13
MW
3742 (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3743 (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3744 (setq comment-start "# ")
3745 (setq comment-end "")
f617db13
MW
3746 (run-hooks 'messages-mode-hook))
3747
3748(defun cpp-messages-mode ()
3749 (interactive)
3750 (fundamental-mode)
3751 (setq major-mode 'cpp-messages-mode)
3752 (setq mode-name "CPP Messages")
4bb22eea 3753 (messages-mode-guts)
f617db13
MW
3754 (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3755 (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3756 (setq comment-start "/* ")
3757 (setq comment-end " */")
3758 (let ((preprocessor-keywords
8d6d55b9
MW
3759 (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3760 "ident" "if" "ifdef" "ifndef" "import" "include"
3761 "line" "pragma" "unassert" "undef" "warning")))
4bb22eea 3762 (setq messages-mode-keywords
f617db13
MW
3763 (append (list (list (concat "^[ \t]*\\#[ \t]*"
3764 "\\(include\\|import\\)"
3765 "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3766 '(2 font-lock-string-face))
3767 (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3768 preprocessor-keywords
852cd5fb 3769 "\\)\\>\\|[0-9]+\\|$\\)\\)")
f617db13 3770 '(1 font-lock-keyword-face)))
4bb22eea 3771 messages-mode-keywords)))
297d60aa 3772 (run-hooks 'cpp-messages-mode-hook))
f617db13 3773
297d60aa
MW
3774(add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3775(add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
f617db13
MW
3776; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3777
6132bc01
MW
3778;;;--------------------------------------------------------------------------
3779;;; Messages-file mode.
f617db13
MW
3780
3781(defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3782 "Face to use for subsittution directives.")
3783(make-face 'mallow-driver-substitution-face)
3784(defvar mallow-driver-text-face 'mallow-driver-text-face
3785 "Face to use for body text.")
3786(make-face 'mallow-driver-text-face)
3787
3788(defun mallow-driver-mode ()
3789 (interactive)
3790 (fundamental-mode)
3791 (setq major-mode 'mallow-driver-mode)
3792 (setq mode-name "Mallow driver")
3793 (setq mallow-driver-mode-syntax-table (make-syntax-table))
3794 (set-syntax-table mallow-driver-mode-syntax-table)
3795 (make-local-variable 'comment-start)
3796 (make-local-variable 'comment-end)
3797 (make-local-variable 'indent-line-function)
3798 (setq indent-line-function 'indent-relative)
3799 (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3800 (make-local-variable 'font-lock-defaults)
3801 (make-local-variable 'mallow-driver-mode-keywords)
3802 (let ((keywords
8d6d55b9
MW
3803 (mdw-regexps "each" "divert" "file" "if"
3804 "perl" "set" "string" "type" "write")))
f617db13
MW
3805 (setq mallow-driver-mode-keywords
3806 (list
3807 (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3808 '(0 font-lock-keyword-face))
3809 (list "^%\\s *\\(#.*\\|\\)$"
3810 '(0 font-lock-comment-face))
3811 (list "^%"
3812 '(0 font-lock-keyword-face))
3813 (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3814 (list "\\${[^}]*}"
3815 '(0 mallow-driver-substitution-face t)))))
3816 (setq font-lock-defaults
3817 '(mallow-driver-mode-keywords nil nil nil nil))
3818 (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3819 (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3820 (setq comment-start "%# ")
3821 (setq comment-end "")
f617db13
MW
3822 (run-hooks 'mallow-driver-mode-hook))
3823
3824(add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3825
6132bc01
MW
3826;;;--------------------------------------------------------------------------
3827;;; NFast debugs.
f617db13
MW
3828
3829(defun nfast-debug-mode ()
3830 (interactive)
3831 (fundamental-mode)
3832 (setq major-mode 'nfast-debug-mode)
3833 (setq mode-name "NFast debug")
3834 (setq messages-mode-syntax-table (make-syntax-table))
3835 (set-syntax-table messages-mode-syntax-table)
3836 (make-local-variable 'font-lock-defaults)
3837 (make-local-variable 'nfast-debug-mode-keywords)
3838 (setq truncate-lines t)
3839 (setq nfast-debug-mode-keywords
3840 (list
3841 '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3842 (0 font-lock-keyword-face))
3843 (list (concat "^[ \t]+\\(\\("
3844 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3845 "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3846 "[ \t]+\\)*"
3847 "[0-9a-fA-F]+\\)[ \t]*$")
3848 '(0 mdw-number-face))
3849 '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3850 (1 font-lock-keyword-face))
3851 '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3852 (1 font-lock-warning-face))
3853 '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3854 (1 nil))
3855 (list (concat "^[ \t]+\\.cmd=[ \t]+"
3856 "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3857 '(1 font-lock-keyword-face))
3858 '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3859 '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3860 '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3861 '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3862 (setq font-lock-defaults
3863 '(nfast-debug-mode-keywords nil nil nil nil))
f617db13
MW
3864 (run-hooks 'nfast-debug-mode-hook))
3865
6132bc01
MW
3866;;;--------------------------------------------------------------------------
3867;;; Other languages.
f617db13 3868
6132bc01 3869;; Smalltalk.
f617db13
MW
3870
3871(defun mdw-setup-smalltalk ()
3872 (and mdw-auto-indent
3873 (local-set-key "\C-m" 'smalltalk-newline-and-indent))
8a425bd7 3874 (make-local-variable 'mdw-auto-indent)
f617db13
MW
3875 (setq mdw-auto-indent nil)
3876 (local-set-key "\C-i" 'smalltalk-reindent))
3877
3878(defun mdw-fontify-smalltalk ()
02109a0d 3879 (make-local-variable 'font-lock-keywords)
f617db13
MW
3880 (setq font-lock-keywords
3881 (list
f617db13
MW
3882 (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3883 '(0 font-lock-keyword-face))
3884 (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3885 "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3886 "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3887 '(0 mdw-number-face))
3888 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3889 '(0 mdw-punct-face)))))
f617db13 3890
6132bc01 3891;; Lispy languages.
f617db13 3892
873d87df
MW
3893;; Unpleasant bodge.
3894(unless (boundp 'slime-repl-mode-map)
3895 (setq slime-repl-mode-map (make-sparse-keymap)))
3896
f617db13
MW
3897(defun mdw-indent-newline-and-indent ()
3898 (interactive)
3899 (indent-for-tab-command)
3900 (newline-and-indent))
3901
3902(eval-after-load "cl-indent"
3903 '(progn
3904 (mapc #'(lambda (pair)
3905 (put (car pair)
3906 'common-lisp-indent-function
3907 (cdr pair)))
3908 '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3909 (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3910
3911(defun mdw-common-lisp-indent ()
8a425bd7 3912 (make-local-variable 'lisp-indent-function)
f617db13
MW
3913 (setq lisp-indent-function 'common-lisp-indent-function))
3914
037be6de 3915(setq lisp-simple-loop-indentation 2
95575d1f
MW
3916 lisp-loop-keyword-indentation 6
3917 lisp-loop-forms-indentation 6)
3918
36cd5c10
MW
3919(defmacro mdw-advise-hyperspec-lookup (func args)
3920 `(defadvice ,func (around mdw-browse-w3m ,args activate compile)
3921 (if (fboundp 'w3m)
3922 (let ((browse-url-browser-function #'mdw-w3m-browse-url))
3923 ad-do-it)
3924 ad-do-it)))
0c3e50d5
MW
3925(mdw-advise-hyperspec-lookup common-lisp-hyperspec (symbol))
3926(mdw-advise-hyperspec-lookup common-lisp-hyperspec-format (char))
3927(mdw-advise-hyperspec-lookup common-lisp-hyperspec-lookup-reader-macro (char))
36cd5c10 3928
f617db13
MW
3929(defun mdw-fontify-lispy ()
3930
6132bc01 3931 ;; Set fill prefix.
f617db13
MW
3932 (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3933
6132bc01 3934 ;; Not much fontification needed.
02109a0d 3935 (make-local-variable 'font-lock-keywords)
f617db13 3936 (setq font-lock-keywords
2287504f
MW
3937 (list (list (concat "\\("
3938 "\\_<[-+]?"
3939 "\\(" "[0-9]+/[0-9]+"
3940 "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3941 "\\.[0-9]+" "\\)"
3942 "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3943 "\\)"
3944 "\\|"
3945 "#"
3946 "\\(" "x" "[-+]?"
3947 "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3948 "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3949 "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3950 "\\|" "[0-9]+" "r" "[-+]?"
3951 "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3952 "\\)"
3953 "\\)\\_>")
3954 '(0 mdw-number-face))
3955 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2e7c6a86 3956 '(0 mdw-punct-face)))))
f617db13
MW
3957
3958(defun comint-send-and-indent ()
3959 (interactive)
3960 (comint-send-input)
3961 (and mdw-auto-indent
3962 (indent-for-tab-command)))
3963
29e4917e
MW
3964(defadvice comint-line-beginning-position
3965 (around mdw-calculate-it-properly () activate compile)
3966 "Calculate the actual line start for multi-line input."
3967 (if (or comint-use-prompt-regexp
3968 (eq (field-at-pos (point)) 'output))
3969 ad-do-it
3970 (setq ad-return-value
3971 (constrain-to-field (line-beginning-position) (point)))))
3972
ec007bea 3973(defun mdw-setup-m4 ()
ed5d93a4
MW
3974
3975 ;; Inexplicably, Emacs doesn't match braces in m4 mode. This is very
3976 ;; annoying: fix it.
3977 (modify-syntax-entry ?{ "(")
3978 (modify-syntax-entry ?} ")")
3979
3980 ;; Fill prefix.
ec007bea
MW
3981 (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3982
6132bc01
MW
3983;;;--------------------------------------------------------------------------
3984;;; Text mode.
f617db13
MW
3985
3986(defun mdw-text-mode ()
3987 (setq fill-column 72)
3988 (flyspell-mode t)
3989 (mdw-standard-fill-prefix
c7a8da49 3990 "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
f617db13
MW
3991 (auto-fill-mode 1))
3992
060c23ce
MW
3993(eval-after-load "flyspell"
3994 '(define-key flyspell-mode-map "\C-\M-i" nil))
3995
6132bc01 3996;;;--------------------------------------------------------------------------
faf2cef7 3997;;; Outline and hide/show modes.
5de5db48
MW
3998
3999(defun mdw-outline-collapse-all ()
4000 "Completely collapse everything in the entire buffer."
4001 (interactive)
4002 (save-excursion
4003 (goto-char (point-min))
4004 (while (< (point) (point-max))
4005 (hide-subtree)
4006 (forward-line))))
4007
faf2cef7
MW
4008(setq hs-hide-comments-when-hiding-all nil)
4009
b200af26 4010(defadvice hs-hide-all (after hide-first-comment activate)
941c29ba 4011 (save-excursion (hs-hide-initial-comment-block)))
b200af26 4012
6132bc01
MW
4013;;;--------------------------------------------------------------------------
4014;;; Shell mode.
f617db13
MW
4015
4016(defun mdw-sh-mode-setup ()
4017 (local-set-key [?\C-a] 'comint-bol)
4018 (add-hook 'comint-output-filter-functions
4019 'comint-watch-for-password-prompt))
4020
4021(defun mdw-term-mode-setup ()
3d9147ea 4022 (setq term-prompt-regexp shell-prompt-pattern)
f617db13
MW
4023 (make-local-variable 'mouse-yank-at-point)
4024 (make-local-variable 'transient-mark-mode)
4025 (setq mouse-yank-at-point t)
f617db13
MW
4026 (auto-fill-mode -1)
4027 (setq tab-width 8))
4028
3d9147ea
MW
4029(defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
4030(defun term-send-meta-left () (interactive) (term-send-raw-string "\e\e[D"))
4031(defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
4032(defun term-send-meta-meta-something ()
4033 (interactive)
4034 (term-send-raw-string "\e\e")
4035 (term-send-raw))
4036(eval-after-load 'term
4037 '(progn
4038 (define-key term-raw-map [?\e ?\e] nil)
4039 (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
4040 (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
4041 (define-key term-raw-map [M-right] 'term-send-meta-right)
4042 (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
4043 (define-key term-raw-map [M-left] 'term-send-meta-left)
4044 (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
4045
c4434c20
MW
4046(defadvice term-exec (before program-args-list compile activate)
4047 "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
4048This allows you to pass a list of arguments through `ansi-term'."
4049 (let ((program (ad-get-arg 2)))
4050 (if (listp program)
4051 (progn
4052 (ad-set-arg 2 (car program))
4053 (ad-set-arg 4 (cdr program))))))
4054
8845865d
MW
4055(defadvice term-exec-1 (around hack-environment compile activate)
4056 "Hack the environment inherited by inferiors in the terminal."
f8592fee 4057 (let ((process-environment (copy-tree process-environment)))
8845865d
MW
4058 (setenv "LD_PRELOAD" nil)
4059 ad-do-it))
4060
4061(defadvice shell (around hack-environment compile activate)
4062 "Hack the environment inherited by inferiors in the shell."
f8592fee 4063 (let ((process-environment (copy-tree process-environment)))
8845865d
MW
4064 (setenv "LD_PRELOAD" nil)
4065 ad-do-it))
4066
c4434c20
MW
4067(defun ssh (host)
4068 "Open a terminal containing an ssh session to the HOST."
4069 (interactive "sHost: ")
4070 (ansi-term (list "ssh" host) (format "ssh@%s" host)))
4071
5aa1b95f 4072(defvar git-grep-command
20b6cd68 4073 "env GIT_PAGER=cat git grep --no-color -nH -e "
5aa1b95f
MW
4074 "*The default command for \\[git-grep].")
4075
4076(defvar git-grep-history nil)
4077
4078(defun git-grep (command-args)
4079 "Run `git grep' with user-specified args and collect output in a buffer."
4080 (interactive
4081 (list (read-shell-command "Run git grep (like this): "
4082 git-grep-command 'git-grep-history)))
6a0a9a51
MW
4083 (let ((grep-use-null-device nil))
4084 (grep command-args)))
5aa1b95f 4085
c63bce81
MW
4086;;;--------------------------------------------------------------------------
4087;;; Magit configuration.
4088
c14a5ec3
MW
4089(setq magit-diff-refine-hunk 'all
4090 magit-view-git-manual-method 'man
83d2acdd 4091 magit-log-margin '(nil age magit-log-margin-width t 18)
c14a5ec3
MW
4092 magit-wip-after-save-local-mode-lighter ""
4093 magit-wip-after-apply-mode-lighter ""
4094 magit-wip-before-change-mode-lighter "")
4095(eval-after-load "magit"
4096 '(progn (global-magit-file-mode 1)
4097 (magit-wip-after-save-mode 1)
4098 (magit-wip-after-apply-mode 1)
4099 (magit-wip-before-change-mode 1)
60c22e1b 4100 (add-to-list 'magit-no-confirm 'safe-with-wip)
2a67803a 4101 (add-to-list 'magit-no-confirm 'trash)
87746eb7
MW
4102 (push '(:eval (if (or magit-wip-after-save-local-mode
4103 magit-wip-after-apply-mode
4104 magit-wip-before-change-mode)
4105 (format " wip:%s%s%s"
4106 (if magit-wip-after-apply-mode "A" "")
4107 (if magit-wip-before-change-mode "C" "")
4108 (if magit-wip-after-save-local-mode "S" ""))))
4109 minor-mode-alist)
60c22e1b
MW
4110 (dolist (popup '(magit-diff-popup
4111 magit-diff-refresh-popup
4112 magit-diff-mode-refresh-popup
4113 magit-revision-mode-refresh-popup))
4114 (magit-define-popup-switch popup ?R "Reverse diff" "-R"))))
c14a5ec3 4115
28509f06
MW
4116(defadvice magit-wip-commit-buffer-file
4117 (around mdw-just-this-buffer activate compile)
4118 (let ((magit-save-repository-buffers nil)) ad-do-it))
4119
2a67803a
MW
4120(defadvice magit-discard
4121 (around mdw-delete-if-prefix-argument activate compile)
4122 (let ((magit-delete-by-moving-to-trash
4123 (and (null current-prefix-arg)
4124 magit-delete-by-moving-to-trash)))
4125 ad-do-it))
4126
ff6a7bee
MW
4127(setq magit-repolist-columns
4128 '(("Name" 16 magit-repolist-column-ident nil)
4129 ("Version" 18 magit-repolist-column-version nil)
4130 ("St" 2 magit-repolist-column-dirty nil)
4131 ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
4132 ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
4133 ("Path" 32 magit-repolist-column-path nil)))
4134
4135(setq magit-repository-directories '(("~/etc/profile" . 0)
4136 ("~/src/" . 1)))
4137
4138(defadvice magit-list-repos (around mdw-dirname () activate compile)
4139 "Make sure the returned names are directory names.
4140Otherwise child processes get started in the wrong directory and
4141there is sadness."
4142 (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
4143
4144(defun mdw-repolist-column-unpulled-from-upstream (_id)
4145 "Insert number of upstream commits not in the current branch."
4146 (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4147 (and upstream
4148 (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
4149 (propertize (number-to-string n) 'face
4150 (if (> n 0) 'bold 'shadow))))))
4151
4152(defun mdw-repolist-column-unpushed-to-upstream (_id)
4153 "Insert number of commits in the current branch but not its upstream."
4154 (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4155 (and upstream
4156 (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
4157 (propertize (number-to-string n) 'face
4158 (if (> n 0) 'bold 'shadow))))))
4159
5d824e2f
MW
4160(defun mdw-try-smerge ()
4161 (save-excursion
4162 (goto-char (point-min))
4163 (when (re-search-forward "^<<<<<<< " nil t)
4164 (smerge-mode 1))))
4165(add-hook 'find-file-hook 'mdw-try-smerge t)
4166
e07e3320 4167;;;--------------------------------------------------------------------------
e48c2e5b
MW
4168;;; GUD, and especially GDB.
4169
4170;; Inhibit window dedication. I mean, seriously, wtf?
4171(defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
4172 "Don't make windows dedicated. Seriously."
4173 (set-window-dedicated-p ad-return-value nil))
4174(defadvice gdb-set-window-buffer
4175 (after mdw-undedicated (name &optional ignore-dedicated window)
4176 compile activate)
4177 "Don't make windows dedicated. Seriously."
4178 (set-window-dedicated-p (or window (selected-window)) nil))
4179
4180;;;--------------------------------------------------------------------------
0f81a131
MW
4181;;; MPC configuration.
4182
50a77b30
MW
4183(eval-when-compile (trap (require 'mpc)))
4184
0f81a131
MW
4185(setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
4186
4187(defun mdw-mpc-now-playing ()
4188 (interactive)
4189 (require 'mpc)
4190 (save-excursion
4191 (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
4192 (mpc--status-callback))
4193 (let ((state (cdr (assq 'state mpc-status))))
4194 (cond ((member state '("stop"))
4195 (message "mpd stopped."))
4196 ((member state '("play" "pause"))
4197 (let* ((artist (cdr (assq 'Artist mpc-status)))
4198 (album (cdr (assq 'Album mpc-status)))
4199 (title (cdr (assq 'Title mpc-status)))
4200 (file (cdr (assq 'file mpc-status)))
4201 (duration-string (cdr (assq 'Time mpc-status)))
4202 (time-string (cdr (assq 'time mpc-status)))
4203 (time (and time-string
355d1336 4204 (string-to-number
0f81a131
MW
4205 (if (string-match ":" time-string)
4206 (substring time-string
4207 0 (match-beginning 0))
4208 (time-string)))))
4209 (duration (and duration-string
355d1336 4210 (string-to-number duration-string)))
0f81a131
MW
4211 (pos (and time duration
4212 (format " [%d:%02d/%d:%02d]"
4213 (/ time 60) (mod time 60)
4214 (/ duration 60) (mod duration 60))))
4215 (fmt (cond ((and artist title)
4216 (format "`%s' by %s%s" title artist
4217 (if album (format ", from `%s'" album)
4218 "")))
4219 (file
4220 (format "`%s' (no tags)" file))
4221 (t
4222 "(no idea what's playing!)"))))
4223 (if (string= state "play")
4224 (message "mpd playing %s%s" fmt (or pos ""))
4225 (message "mpd paused in %s%s" fmt (or pos "")))))
4226 (t
4227 (message "mpd in unknown state `%s'" state)))))
4228
4aba12fa
MW
4229(defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
4230 `(defun ,func ,bvl
4231 (interactive ,@interactive)
4232 (require 'mpc)
4233 ,@body
4234 (mdw-mpc-now-playing)))
4235
4236(mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
4237 (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
4238 (mpc-pause)
4239 (mpc-play)))
4240
4241(mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
4242(mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
4243(mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
0f81a131 4244
5147578f
MW
4245(defun mdw-mpc-louder (step)
4246 (interactive (list (if current-prefix-arg
4247 (prefix-numeric-value current-prefix-arg)
4248 +10)))
4249 (mpc-proc-cmd (format "volume %+d" step)))
4250
4251(defun mdw-mpc-quieter (step)
4252 (interactive (list (if current-prefix-arg
4253 (prefix-numeric-value current-prefix-arg)
4254 +10)))
4255 (mpc-proc-cmd (format "volume %+d" (- step))))
4256
6dbdfe26
MW
4257(defun mdw-mpc-hack-lines (arg interactivep func)
4258 (if (and interactivep (use-region-p))
4259 (let ((from (region-beginning)) (to (region-end)))
4260 (goto-char from)
4261 (beginning-of-line)
4262 (funcall func)
4263 (forward-line)
4264 (while (< (point) to)
4265 (funcall func)
4266 (forward-line)))
4267 (let ((n (prefix-numeric-value arg)))
4268 (cond ((minusp n)
4269 (unless (bolp)
4270 (beginning-of-line)
4271 (funcall func)
4272 (incf n))
4273 (while (minusp n)
4274 (forward-line -1)
4275 (funcall func)
4276 (incf n)))
4277 (t
4278 (beginning-of-line)
4279 (while (plusp n)
4280 (funcall func)
4281 (forward-line)
4282 (decf n)))))))
4283
4284(defun mdw-mpc-select-one ()
4466dfac
MW
4285 (when (and (get-char-property (point) 'mpc-file)
4286 (not (get-char-property (point) 'mpc-select)))
6dbdfe26
MW
4287 (mpc-select-toggle)))
4288
4289(defun mdw-mpc-unselect-one ()
4290 (when (get-char-property (point) 'mpc-select)
4291 (mpc-select-toggle)))
4292
4293(defun mdw-mpc-select (&optional arg interactivep)
4294 (interactive (list current-prefix-arg t))
a30d0e33 4295 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
6dbdfe26
MW
4296
4297(defun mdw-mpc-unselect (&optional arg interactivep)
4298 (interactive (list current-prefix-arg t))
a30d0e33 4299 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
6dbdfe26
MW
4300
4301(defun mdw-mpc-unselect-backwards (arg)
4302 (interactive "p")
a30d0e33 4303 (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
6dbdfe26
MW
4304
4305(defun mdw-mpc-unselect-all ()
4306 (interactive)
4307 (setq mpc-select nil)
4308 (mpc-selection-refresh))
4309
4310(defun mdw-mpc-next-line (arg)
4311 (interactive "p")
4312 (beginning-of-line)
4313 (forward-line arg))
4314
4315(defun mdw-mpc-previous-line (arg)
4316 (interactive "p")
4317 (beginning-of-line)
4318 (forward-line (- arg)))
4319
6d6f2b51
MW
4320(defun mdw-mpc-playlist-add (&optional arg interactivep)
4321 (interactive (list current-prefix-arg t))
4322 (let ((mpc-select mpc-select))
4323 (when (or arg (and interactivep (use-region-p)))
4324 (setq mpc-select nil)
4325 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4326 (setq mpc-select (reverse mpc-select))
4327 (mpc-playlist-add)))
4328
4329(defun mdw-mpc-playlist-delete (&optional arg interactivep)
4330 (interactive (list current-prefix-arg t))
4331 (setq mpc-select (nreverse mpc-select))
4332 (mpc-select-save
4333 (when (or arg (and interactivep (use-region-p)))
4334 (setq mpc-select nil)
4335 (mpc-selection-refresh)
4336 (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4337 (mpc-playlist-delete)))
4338
75019c66
MW
4339(defun mdw-mpc-hack-tagbrowsers ()
4340 (setq-local mode-line-format
4341 '("%e"
4342 mode-line-frame-identification
4343 mode-line-buffer-identification)))
4344(add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
4345
65f6a37a
MW
4346(defun mdw-mpc-hack-songs ()
4347 (setq-local header-line-format
4348 ;; '("MPC " mpc-volume " " mpc-current-song)
4349 (list (propertize " " 'display '(space :align-to 0))
4350 ;; 'mpc-songs-format-description
4351 '(:eval
4352 (let ((deactivate-mark) (hscroll (window-hscroll)))
4353 (with-temp-buffer
4354 (mpc-format mpc-songs-format 'self hscroll)
4355 ;; That would be simpler than the hscroll handling in
4356 ;; mpc-format, but currently move-to-column does not
4357 ;; recognize :space display properties.
4358 ;; (move-to-column hscroll)
4359 ;; (delete-region (point-min) (point))
4360 (buffer-string)))))))
4361(add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
4362
6dbdfe26
MW
4363(eval-after-load "mpc"
4364 '(progn
4365 (define-key mpc-mode-map "m" 'mdw-mpc-select)
4366 (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
4367 (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
4368 (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
4369 (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
4370 (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
56ba17be 4371 (define-key mpc-mode-map "/" 'mpc-songs-search)
6dbdfe26
MW
4372 (setq mpc-songs-mode-map (make-sparse-keymap))
4373 (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
4374 (define-key mpc-songs-mode-map "l" 'mpc-playlist)
6d6f2b51
MW
4375 (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
4376 (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
56ba17be 4377 (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
6dbdfe26 4378
0f81a131 4379;;;--------------------------------------------------------------------------
e07e3320
MW
4380;;; Inferior Emacs Lisp.
4381
4382(setq comint-prompt-read-only t)
4383
4384(eval-after-load "comint"
4385 '(progn
4386 (define-key comint-mode-map "\C-w" 'comint-kill-region)
4387 (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
4388
4389(eval-after-load "ielm"
4390 '(progn
4391 (define-key ielm-map "\C-w" 'comint-kill-region)
4392 (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
4393
f617db13
MW
4394;;;----- That's all, folks --------------------------------------------------
4395
4396(provide 'dot-emacs)