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