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