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