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 mc/cursor-face
 869   (((type tty) (class mono)) :inverse-video t)
 870   (t :background "red"))
 871 (mdw-define-face minibuffer-prompt
 872   (t :weight bold))
 873 (mdw-define-face mode-line
 874   (((class color)) :foreground "blue" :background "yellow"
 875                    :box (:line-width 1 :style released-button))
 876   (t :inverse-video t))
 877 (mdw-define-face mode-line-inactive
 878   (((class color)) :foreground "yellow" :background "blue"
 879                    :box (:line-width 1 :style released-button))
 880   (t :inverse-video t))
 881 (mdw-define-face nobreak-space
 882   (((type tty)))
 883   (t :inherit escape-glyph :underline t))
 884 (mdw-define-face scroll-bar
 885   (t :foreground "black" :background "lightgrey"))
 886 (mdw-define-face fringe
 887   (t :foreground "yellow"))
 888 (mdw-define-face show-paren-match
 889   (((class color)) :background "darkgreen")
 890   (t :underline t))
 891 (mdw-define-face show-paren-mismatch
 892   (((class color)) :background "red")
 893   (t :inverse-video t))
 894 (mdw-define-face highlight
 895   (((type x) (class color)) :background "DarkSeaGreen4")
 896   (((type tty) (class color)) :background "cyan")
 897   (t :inverse-video t))
 898
 899 (mdw-define-face holiday-face
 900   (t :background "red"))
 901 (mdw-define-face calendar-today-face
 902   (t :foreground "yellow" :weight bold))
 903
 904 (mdw-define-face comint-highlight-prompt
 905   (t :weight bold))
 906 (mdw-define-face comint-highlight-input
 907   (t nil))
 908
 909 (mdw-define-face dired-directory
 910   (t :foreground "cyan" :weight bold))
 911 (mdw-define-face dired-symlink
 912   (t :foreground "cyan"))
 913 (mdw-define-face dired-perm-write
 914   (t nil))
 915
 916 (mdw-define-face trailing-whitespace
 917   (((class color)) :background "red")
 918   (t :inverse-video t))
 919 (mdw-define-face mdw-punct-face
 920   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 921 (mdw-define-face mdw-number-face
 922   (t :foreground "yellow"))
 923 (mdw-define-face mdw-trivial-face)
 924 (mdw-define-face font-lock-function-name-face
 925   (t :slant italic))
 926 (mdw-define-face font-lock-keyword-face
 927   (t :weight bold))
 928 (mdw-define-face font-lock-constant-face
 929   (t :slant italic))
 930 (mdw-define-face font-lock-builtin-face
 931   (t :weight bold))
 932 (mdw-define-face font-lock-type-face
 933   (t :weight bold :slant italic))
 934 (mdw-define-face font-lock-reference-face
 935   (t :weight bold))
 936 (mdw-define-face font-lock-variable-name-face
 937   (t :slant italic))
 938 (mdw-define-face font-lock-comment-delimiter-face
 939   (((class mono)) :weight bold)
 940   (((type tty) (class color)) :foreground "green")
 941   (t :slant italic :foreground "SeaGreen1"))
 942 (mdw-define-face font-lock-comment-face
 943   (((class mono)) :weight bold)
 944   (((type tty) (class color)) :foreground "green")
 945   (t :slant italic :foreground "SeaGreen1"))
 946 (mdw-define-face font-lock-string-face
 947   (((class mono)) :weight bold)
 948   (((class color)) :foreground "SkyBlue1"))
 949
 950 (mdw-define-face message-separator
 951   (t :background "red" :foreground "white" :weight bold))
 952 (mdw-define-face message-cited-text
 953   (default :slant italic)
 954   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 955 (mdw-define-face message-header-cc
 956   (default :weight bold)
 957   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 958 (mdw-define-face message-header-newsgroups
 959   (default :weight bold)
 960   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 961 (mdw-define-face message-header-subject
 962   (default :weight bold)
 963   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 964 (mdw-define-face message-header-to
 965   (default :weight bold)
 966   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 967 (mdw-define-face message-header-xheader
 968   (default :weight bold)
 969   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 970 (mdw-define-face message-header-other
 971   (default :weight bold)
 972   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 973 (mdw-define-face message-header-name
 974   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 975 (mdw-define-face which-func
 976   (t nil))
 977
 978 (mdw-define-face diff-header
 979   (t nil))
 980 (mdw-define-face diff-index
 981   (t :weight bold))
 982 (mdw-define-face diff-file-header
 983   (t :weight bold))
 984 (mdw-define-face diff-hunk-header
 985   (t :foreground "SkyBlue1"))
 986 (mdw-define-face diff-function
 987   (t :foreground "SkyBlue1" :weight bold))
 988 (mdw-define-face diff-header
 989   (t :background "grey10"))
 990 (mdw-define-face diff-added
 991   (t :foreground "green"))
 992 (mdw-define-face diff-removed
 993   (t :foreground "red"))
 994 (mdw-define-face diff-context
 995   (t nil))
 996 (mdw-define-face diff-refine-change
 997   (((class color) (type x)) :background "RoyalBlue4")
 998   (t :underline t))
 999
1000 (mdw-define-face dylan-header-background
1001   (((class color) (type x)) :background "NavyBlue")
1002   (t :background "blue"))
1003
1004 (mdw-define-face magit-diff-add
1005   (t :foreground "green"))
1006 (mdw-define-face magit-diff-del
1007   (t :foreground "red"))
1008 (mdw-define-face magit-diff-file-header
1009   (t :weight bold))
1010 (mdw-define-face magit-diff-hunk-header
1011   (t :foreground "SkyBlue1"))
1012 (mdw-define-face magit-item-highlight
1013   (((type tty)) :background "blue")
1014   (t :background "DarkSeaGreen4"))
1015 (mdw-define-face magit-log-head-label-remote
1016   (((type tty)) :background "cyan" :foreground "green")
1017   (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1018 (mdw-define-face magit-log-head-label-local
1019   (((type tty)) :background "cyan" :foreground "yellow")
1020   (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1021 (mdw-define-face magit-log-head-label-tags
1022   (((type tty)) :background "red" :foreground "yellow")
1023   (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1024 (mdw-define-face magit-log-graph
1025   (((type tty)) :foreground "magenta")
1026   (t :foreground "grey80"))
1027
1028 (mdw-define-face erc-input-face
1029   (t :foreground "red"))
1030
1031 (mdw-define-face woman-bold
1032   (t :weight bold))
1033 (mdw-define-face woman-italic
1034   (t :slant italic))
1035
1036 (eval-after-load "rst"
1037   '(progn
1038      (mdw-define-face rst-level-1-face
1039        (t :foreground "SkyBlue1" :weight bold))
1040      (mdw-define-face rst-level-2-face
1041        (t :foreground "SeaGreen1" :weight bold))
1042      (mdw-define-face rst-level-3-face
1043        (t :weight bold))
1044      (mdw-define-face rst-level-4-face
1045        (t :slant italic))
1046      (mdw-define-face rst-level-5-face
1047        (t :underline t))
1048      (mdw-define-face rst-level-6-face
1049        ())))
1050
1051 (mdw-define-face p4-depot-added-face
1052   (t :foreground "green"))
1053 (mdw-define-face p4-depot-branch-op-face
1054   (t :foreground "yellow"))
1055 (mdw-define-face p4-depot-deleted-face
1056   (t :foreground "red"))
1057 (mdw-define-face p4-depot-unmapped-face
1058   (t :foreground "SkyBlue1"))
1059 (mdw-define-face p4-diff-change-face
1060   (t :foreground "yellow"))
1061 (mdw-define-face p4-diff-del-face
1062   (t :foreground "red"))
1063 (mdw-define-face p4-diff-file-face
1064   (t :foreground "SkyBlue1"))
1065 (mdw-define-face p4-diff-head-face
1066   (t :background "grey10"))
1067 (mdw-define-face p4-diff-ins-face
1068   (t :foreground "green"))
1069
1070 (mdw-define-face w3m-anchor-face
1071   (t :foreground "SkyBlue1" :underline t))
1072 (mdw-define-face w3m-arrived-anchor-face
1073   (t :foreground "SkyBlue1" :underline t))
1074
1075 (mdw-define-face whizzy-slice-face
1076   (t :background "grey10"))
1077 (mdw-define-face whizzy-error-face
1078   (t :background "darkred"))
1079
1080 ;; Ellipses used to indicate hidden text (and similar).
1081 (mdw-define-face mdw-ellipsis-face
1082   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1083 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1084       (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1085       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1086       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1087   (set-display-table-slot standard-display-table 0 dollar)
1088   (set-display-table-slot standard-display-table 1 backslash)
1089   (set-display-table-slot standard-display-table 4
1090                           (vector dot dot dot))
1091   (set-display-table-slot standard-display-table 5 bar))
1092
1093 ;;;--------------------------------------------------------------------------
1094 ;;; C programming configuration.
1095
1096 ;; Linux kernel hacking.
1097
1098 (defvar linux-c-mode-hook)
1099
1100 (defun linux-c-mode ()
1101   (interactive)
1102   (c-mode)
1103   (setq major-mode 'linux-c-mode)
1104   (setq mode-name "Linux C")
1105   (run-hooks 'linux-c-mode-hook))
1106
1107 ;; Make C indentation nice.
1108
1109 (defun mdw-c-lineup-arglist (langelem)
1110   "Hack for DWIMmery in c-lineup-arglist."
1111   (if (save-excursion
1112         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1113       0
1114     (c-lineup-arglist langelem)))
1115
1116 (defun mdw-c-indent-extern-mumble (langelem)
1117   "Indent `extern \"...\" {' lines."
1118   (save-excursion
1119     (back-to-indentation)
1120     (if (looking-at
1121          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1122         c-basic-offset
1123       nil)))
1124
1125 (defun mdw-c-style ()
1126   (c-add-style "[mdw] C and C++ style"
1127                '((c-basic-offset . 2)
1128                  (comment-column . 40)
1129                  (c-class-key . "class")
1130                  (c-backslash-column . 72)
1131                  (c-offsets-alist
1132                   (substatement-open . (add 0 c-indent-one-line-block))
1133                   (defun-open . (add 0 c-indent-one-line-block))
1134                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1135                   (topmost-intro . mdw-c-indent-extern-mumble)
1136                   (cpp-define-intro . 0)
1137                   (knr-argdecl . 0)
1138                   (inextern-lang . [0])
1139                   (label . 0)
1140                   (case-label . +)
1141                   (access-label . -)
1142                   (inclass . +)
1143                   (inline-open . ++)
1144                   (statement-cont . +)
1145                   (statement-case-intro . +)))
1146                t))
1147
1148 (defvar mdw-c-comment-fill-prefix
1149   `((,(concat "\\([ \t]*/?\\)"
1150               "\\(\*\\|//]\\)"
1151               "\\([ \t]*\\)"
1152               "\\([A-Za-z]+:[ \t]*\\)?"
1153               mdw-hanging-indents)
1154      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1155   "Fill prefix matching C comments (both kinds).")
1156
1157 (defun mdw-fontify-c-and-c++ ()
1158
1159   ;; Fiddle with some syntax codes.
1160   (modify-syntax-entry ?* ". 23")
1161   (modify-syntax-entry ?/ ". 124b")
1162   (modify-syntax-entry ?\n "> b")
1163
1164   ;; Other stuff.
1165   (mdw-c-style)
1166   (setq c-hanging-comment-ender-p nil)
1167   (setq c-backslash-column 72)
1168   (setq c-label-minimum-indentation 0)
1169   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1170
1171   ;; Now define things to be fontified.
1172   (make-local-variable 'font-lock-keywords)
1173   (let ((c-keywords
1174          (mdw-regexps "and"             ;C++
1175                       "and_eq"          ;C++
1176                       "asm"             ;K&R, GCC
1177                       "auto"            ;K&R, C89
1178                       "bitand"          ;C++
1179                       "bitor"           ;C++
1180                       "bool"            ;C++, C9X macro
1181                       "break"           ;K&R, C89
1182                       "case"            ;K&R, C89
1183                       "catch"           ;C++
1184                       "char"            ;K&R, C89
1185                       "class"           ;C++
1186                       "complex"         ;C9X macro, C++ template type
1187                       "compl"           ;C++
1188                       "const"           ;C89
1189                       "const_cast"      ;C++
1190                       "continue"        ;K&R, C89
1191                       "defined"         ;C89 preprocessor
1192                       "default"         ;K&R, C89
1193                       "delete"          ;C++
1194                       "do"              ;K&R, C89
1195                       "double"          ;K&R, C89
1196                       "dynamic_cast"    ;C++
1197                       "else"            ;K&R, C89
1198                       ;; "entry"        ;K&R -- never used
1199                       "enum"            ;C89
1200                       "explicit"        ;C++
1201                       "export"          ;C++
1202                       "extern"          ;K&R, C89
1203                       "float"           ;K&R, C89
1204                       "for"             ;K&R, C89
1205                       ;; "fortran"      ;K&R
1206                       "friend"          ;C++
1207                       "goto"            ;K&R, C89
1208                       "if"              ;K&R, C89
1209                       "imaginary"       ;C9X macro
1210                       "inline"          ;C++, C9X, GCC
1211                       "int"             ;K&R, C89
1212                       "long"            ;K&R, C89
1213                       "mutable"         ;C++
1214                       "namespace"       ;C++
1215                       "new"             ;C++
1216                       "operator"        ;C++
1217                       "or"              ;C++
1218                       "or_eq"           ;C++
1219                       "private"         ;C++
1220                       "protected"       ;C++
1221                       "public"          ;C++
1222                       "register"        ;K&R, C89
1223                       "reinterpret_cast" ;C++
1224                       "restrict"         ;C9X
1225                       "return"           ;K&R, C89
1226                       "short"            ;K&R, C89
1227                       "signed"           ;C89
1228                       "sizeof"           ;K&R, C89
1229                       "static"           ;K&R, C89
1230                       "static_cast"      ;C++
1231                       "struct"           ;K&R, C89
1232                       "switch"           ;K&R, C89
1233                       "template"         ;C++
1234                       "throw"            ;C++
1235                       "try"              ;C++
1236                       "this"             ;C++
1237                       "typedef"          ;C89
1238                       "typeid"           ;C++
1239                       "typeof"           ;GCC
1240                       "typename"         ;C++
1241                       "union"            ;K&R, C89
1242                       "unsigned"         ;K&R, C89
1243                       "using"            ;C++
1244                       "virtual"          ;C++
1245                       "void"             ;C89
1246                       "volatile"         ;C89
1247                       "wchar_t"          ;C++, C89 library type
1248                       "while"            ;K&R, C89
1249                       "xor"              ;C++
1250                       "xor_eq"           ;C++
1251                       "_Bool"            ;C9X
1252                       "_Complex"         ;C9X
1253                       "_Imaginary"       ;C9X
1254                       "_Pragma"          ;C9X preprocessor
1255                       "__alignof__"      ;GCC
1256                       "__asm__"          ;GCC
1257                       "__attribute__"    ;GCC
1258                       "__complex__"      ;GCC
1259                       "__const__"        ;GCC
1260                       "__extension__"    ;GCC
1261                       "__imag__"         ;GCC
1262                       "__inline__"       ;GCC
1263                       "__label__"        ;GCC
1264                       "__real__"         ;GCC
1265                       "__signed__"       ;GCC
1266                       "__typeof__"       ;GCC
1267                       "__volatile__"     ;GCC
1268                       ))
1269         (c-constants
1270          (mdw-regexps "false"           ;C++, C9X macro
1271                       "this"             ;C++
1272                       "true"             ;C++, C9X macro
1273                       ))
1274         (preprocessor-keywords
1275          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1276                       "ident" "if" "ifdef" "ifndef" "import" "include"
1277                       "line" "pragma" "unassert" "undef" "warning"))
1278         (objc-keywords
1279          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1280                       "interface" "private" "protected" "protocol" "public"
1281                       "selector")))
1282
1283     (setq font-lock-keywords
1284           (list
1285
1286            ;; Fontify include files as strings.
1287            (list (concat "^[ \t]*\\#[ \t]*"
1288                          "\\(include\\|import\\)"
1289                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1290                  '(2 font-lock-string-face))
1291
1292            ;; Preprocessor directives are `references'?.
1293            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1294                          preprocessor-keywords
1295                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1296                  '(1 font-lock-keyword-face))
1297
1298            ;; Handle the keywords defined above.
1299            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1300                  '(0 font-lock-keyword-face))
1301
1302            (list (concat "\\<\\(" c-keywords "\\)\\>")
1303                  '(0 font-lock-keyword-face))
1304
1305            (list (concat "\\<\\(" c-constants "\\)\\>")
1306                  '(0 font-lock-variable-name-face))
1307
1308            ;; Handle numbers too.
1309            ;;
1310            ;; This looks strange, I know.  It corresponds to the
1311            ;; preprocessor's idea of what a number looks like, rather than
1312            ;; anything sensible.
1313            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1314                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1315                  '(0 mdw-number-face))
1316
1317            ;; And anything else is punctuation.
1318            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1319                  '(0 mdw-punct-face))))
1320
1321     (mdw-post-config-mode-hack)))
1322
1323 ;;;--------------------------------------------------------------------------
1324 ;;; AP calc mode.
1325
1326 (defun apcalc-mode ()
1327   (interactive)
1328   (c-mode)
1329   (setq major-mode 'apcalc-mode)
1330   (setq mode-name "AP Calc")
1331   (run-hooks 'apcalc-mode-hook))
1332
1333 (defun mdw-fontify-apcalc ()
1334
1335   ;; Fiddle with some syntax codes.
1336   (modify-syntax-entry ?* ". 23")
1337   (modify-syntax-entry ?/ ". 14")
1338
1339   ;; Other stuff.
1340   (mdw-c-style)
1341   (setq c-hanging-comment-ender-p nil)
1342   (setq c-backslash-column 72)
1343   (setq comment-start "/* ")
1344   (setq comment-end " */")
1345   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1346
1347   ;; Now define things to be fontified.
1348   (make-local-variable 'font-lock-keywords)
1349   (let ((c-keywords
1350          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1351                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1352                       "local" "mat" "obj" "print" "quit" "read" "return"
1353                       "show" "static" "switch" "while" "write")))
1354
1355     (setq font-lock-keywords
1356           (list
1357
1358            ;; Handle the keywords defined above.
1359            (list (concat "\\<\\(" c-keywords "\\)\\>")
1360                  '(0 font-lock-keyword-face))
1361
1362            ;; Handle numbers too.
1363            ;;
1364            ;; This looks strange, I know.  It corresponds to the
1365            ;; preprocessor's idea of what a number looks like, rather than
1366            ;; anything sensible.
1367            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1368                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1369                  '(0 mdw-number-face))
1370
1371            ;; And anything else is punctuation.
1372            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1373                  '(0 mdw-punct-face)))))
1374
1375   (mdw-post-config-mode-hack))
1376
1377 ;;;--------------------------------------------------------------------------
1378 ;;; Java programming configuration.
1379
1380 ;; Make indentation nice.
1381
1382 (defun mdw-java-style ()
1383   (c-add-style "[mdw] Java style"
1384                '((c-basic-offset . 2)
1385                  (c-offsets-alist (substatement-open . 0)
1386                                   (label . +)
1387                                   (case-label . +)
1388                                   (access-label . 0)
1389                                   (inclass . +)
1390                                   (statement-case-intro . +)))
1391                t))
1392
1393 ;; Declare Java fontification style.
1394
1395 (defun mdw-fontify-java ()
1396
1397   ;; Other stuff.
1398   (mdw-java-style)
1399   (setq c-hanging-comment-ender-p nil)
1400   (setq c-backslash-column 72)
1401   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1402
1403   ;; Now define things to be fontified.
1404   (make-local-variable 'font-lock-keywords)
1405   (let ((java-keywords
1406          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1407                       "char" "class" "const" "continue" "default" "do"
1408                       "double" "else" "extends" "final" "finally" "float"
1409                       "for" "goto" "if" "implements" "import" "instanceof"
1410                       "int" "interface" "long" "native" "new" "package"
1411                       "private" "protected" "public" "return" "short"
1412                       "static" "switch" "synchronized" "throw" "throws"
1413                       "transient" "try" "void" "volatile" "while"))
1414
1415         (java-constants
1416          (mdw-regexps "false" "null" "super" "this" "true")))
1417
1418     (setq font-lock-keywords
1419           (list
1420
1421            ;; Handle the keywords defined above.
1422            (list (concat "\\<\\(" java-keywords "\\)\\>")
1423                  '(0 font-lock-keyword-face))
1424
1425            ;; Handle the magic constants defined above.
1426            (list (concat "\\<\\(" java-constants "\\)\\>")
1427                  '(0 font-lock-variable-name-face))
1428
1429            ;; Handle numbers too.
1430            ;;
1431            ;; The following isn't quite right, but it's close enough.
1432            (list (concat "\\<\\("
1433                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1434                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1435                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1436                          "[lLfFdD]?")
1437                  '(0 mdw-number-face))
1438
1439            ;; And anything else is punctuation.
1440            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1441                  '(0 mdw-punct-face)))))
1442
1443   (mdw-post-config-mode-hack))
1444
1445 ;;;--------------------------------------------------------------------------
1446 ;;; Javascript programming configuration.
1447
1448 (defun mdw-javascript-style ()
1449   (setq js-indent-level 2)
1450   (setq js-expr-indent-offset 0))
1451
1452 (defun mdw-fontify-javascript ()
1453
1454   ;; Other stuff.
1455   (mdw-javascript-style)
1456   (setq js-auto-indent-flag t)
1457
1458   ;; Now define things to be fontified.
1459   (make-local-variable 'font-lock-keywords)
1460   (let ((javascript-keywords
1461          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1462                       "char" "class" "const" "continue" "debugger" "default"
1463                       "delete" "do" "double" "else" "enum" "export" "extends"
1464                       "final" "finally" "float" "for" "function" "goto" "if"
1465                       "implements" "import" "in" "instanceof" "int"
1466                       "interface" "let" "long" "native" "new" "package"
1467                       "private" "protected" "public" "return" "short"
1468                       "static" "super" "switch" "synchronized" "throw"
1469                       "throws" "transient" "try" "typeof" "var" "void"
1470                       "volatile" "while" "with" "yield"
1471
1472                       "boolean" "byte" "char" "double" "float" "int" "long"
1473                       "short" "void"))
1474         (javascript-constants
1475          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1476                       "arguments" "this")))
1477
1478     (setq font-lock-keywords
1479           (list
1480
1481            ;; Handle the keywords defined above.
1482            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1483                  '(0 font-lock-keyword-face))
1484
1485            ;; Handle the predefined constants defined above.
1486            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1487                  '(0 font-lock-variable-name-face))
1488
1489            ;; Handle numbers too.
1490            ;;
1491            ;; The following isn't quite right, but it's close enough.
1492            (list (concat "\\_<\\("
1493                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1494                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1495                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1496                          "[lLfFdD]?")
1497                  '(0 mdw-number-face))
1498
1499            ;; And anything else is punctuation.
1500            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1501                  '(0 mdw-punct-face)))))
1502
1503   (mdw-post-config-mode-hack))
1504
1505 ;;;--------------------------------------------------------------------------
1506 ;;; Scala programming configuration.
1507
1508 (defun mdw-fontify-scala ()
1509
1510   ;; Comment filling.
1511   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1512
1513   ;; Define things to be fontified.
1514   (make-local-variable 'font-lock-keywords)
1515   (let ((scala-keywords
1516          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1517                       "extends" "final" "finally" "for" "forSome" "if"
1518                       "implicit" "import" "lazy" "match" "new" "object"
1519                       "override" "package" "private" "protected" "return"
1520                       "sealed" "throw" "trait" "try" "type" "val"
1521                       "var" "while" "with" "yield"))
1522         (scala-constants
1523          (mdw-regexps "false" "null" "super" "this" "true"))
1524         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1525
1526     (setq font-lock-keywords
1527           (list
1528
1529            ;; Magical identifiers between backticks.
1530            (list (concat "`\\([^`]+\\)`")
1531                  '(1 font-lock-variable-name-face))
1532
1533            ;; Handle the keywords defined above.
1534            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1535                  '(0 font-lock-keyword-face))
1536
1537            ;; Handle the constants defined above.
1538            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1539                  '(0 font-lock-variable-name-face))
1540
1541            ;; Magical identifiers between backticks.
1542            (list (concat "`\\([^`]+\\)`")
1543                  '(1 font-lock-variable-name-face))
1544
1545            ;; Handle numbers too.
1546            ;;
1547            ;; As usual, not quite right.
1548            (list (concat "\\_<\\("
1549                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1550                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1551                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1552                          "[lLfFdD]?")
1553                  '(0 mdw-number-face))
1554
1555            ;; Identifiers with trailing operators.
1556            (list (concat "_\\(" punctuation "\\)+")
1557                  '(0 mdw-trivial-face))
1558
1559            ;; And everything else is punctuation.
1560            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1561                  '(0 mdw-punct-face)))
1562
1563           font-lock-syntactic-keywords
1564           (list
1565
1566            ;; Single quotes around characters.  But not when used to quote
1567            ;; symbol names.  Ugh.
1568            (list (concat "\\('\\)"
1569                          "\\(" "."
1570                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1571                                "u+" "[0-9a-fA-F]\\{4\\}"
1572                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
1573                          "\\|" "\\\\" "." "\\)"
1574                          "\\('\\)")
1575                  '(1 "\"")
1576                  '(4 "\"")))))
1577
1578   (mdw-post-config-mode-hack))
1579
1580 ;;;--------------------------------------------------------------------------
1581 ;;; C# programming configuration.
1582
1583 ;; Make indentation nice.
1584
1585 (defun mdw-csharp-style ()
1586   (c-add-style "[mdw] C# style"
1587                '((c-basic-offset . 2)
1588                  (c-offsets-alist (substatement-open . 0)
1589                                   (label . 0)
1590                                   (case-label . +)
1591                                   (access-label . 0)
1592                                   (inclass . +)
1593                                   (statement-case-intro . +)))
1594                t))
1595
1596 ;; Declare C# fontification style.
1597
1598 (defun mdw-fontify-csharp ()
1599
1600   ;; Other stuff.
1601   (mdw-csharp-style)
1602   (setq c-hanging-comment-ender-p nil)
1603   (setq c-backslash-column 72)
1604   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1605
1606   ;; Now define things to be fontified.
1607   (make-local-variable 'font-lock-keywords)
1608   (let ((csharp-keywords
1609          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1610                       "char" "checked" "class" "const" "continue" "decimal"
1611                       "default" "delegate" "do" "double" "else" "enum"
1612                       "event" "explicit" "extern" "finally" "fixed" "float"
1613                       "for" "foreach" "goto" "if" "implicit" "in" "int"
1614                       "interface" "internal" "is" "lock" "long" "namespace"
1615                       "new" "object" "operator" "out" "override" "params"
1616                       "private" "protected" "public" "readonly" "ref"
1617                       "return" "sbyte" "sealed" "short" "sizeof"
1618                       "stackalloc" "static" "string" "struct" "switch"
1619                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
1620                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
1621                       "while" "yield"))
1622
1623         (csharp-constants
1624          (mdw-regexps "base" "false" "null" "this" "true")))
1625
1626     (setq font-lock-keywords
1627           (list
1628
1629            ;; Handle the keywords defined above.
1630            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1631                  '(0 font-lock-keyword-face))
1632
1633            ;; Handle the magic constants defined above.
1634            (list (concat "\\<\\(" csharp-constants "\\)\\>")
1635                  '(0 font-lock-variable-name-face))
1636
1637            ;; Handle numbers too.
1638            ;;
1639            ;; The following isn't quite right, but it's close enough.
1640            (list (concat "\\<\\("
1641                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1642                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1643                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1644                          "[lLfFdD]?")
1645                  '(0 mdw-number-face))
1646
1647            ;; And anything else is punctuation.
1648            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1649                  '(0 mdw-punct-face)))))
1650
1651   (mdw-post-config-mode-hack))
1652
1653 (define-derived-mode csharp-mode java-mode "C#"
1654   "Major mode for editing C# code.")
1655
1656 ;;;--------------------------------------------------------------------------
1657 ;;; F# programming configuration.
1658
1659 (setq fsharp-indent-offset 2)
1660
1661 (defun mdw-fontify-fsharp ()
1662
1663   (let ((punct "=<>+-*/|&%!@?"))
1664     (do ((i 0 (1+ i)))
1665         ((>= i (length punct)))
1666       (modify-syntax-entry (aref punct i) ".")))
1667
1668   (modify-syntax-entry ?_ "_")
1669   (modify-syntax-entry ?( "(")
1670   (modify-syntax-entry ?) ")")
1671
1672   (setq indent-tabs-mode nil)
1673
1674   (let ((fsharp-keywords
1675          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1676                       "begin" "break"
1677                       "checked" "class" "component" "const" "constraint"
1678                       "constructor" "continue"
1679                       "default" "delegate" "do" "done" "downcast" "downto"
1680                       "eager" "elif" "else" "end" "exception" "extern"
1681                       "finally" "fixed" "for" "fori" "fun" "function"
1682                       "functor"
1683                       "global"
1684                       "if" "in" "include" "inherit" "inline" "interface"
1685                       "internal"
1686                       "lazy" "let"
1687                       "match" "measure" "member" "method" "mixin" "module"
1688                       "mutable"
1689                       "namespace" "new"
1690                       "object" "of" "open" "or" "override"
1691                       "parallel" "params" "private" "process" "protected"
1692                       "public" "pure"
1693                       "rec" "recursive" "return"
1694                       "sealed" "sig" "static" "struct"
1695                       "tailcall" "then" "to" "trait" "try" "type"
1696                       "upcast" "use"
1697                       "val" "virtual" "void" "volatile"
1698                       "when" "while" "with"
1699                       "yield"))
1700
1701         (fsharp-builtins
1702          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1703                       "base" "false" "null" "true"))
1704
1705         (bang-keywords
1706          (mdw-regexps "do" "let" "return" "use" "yield"))
1707
1708         (preprocessor-keywords
1709          (mdw-regexps "if" "indent" "else" "endif")))
1710
1711     (setq font-lock-keywords
1712           (list (list (concat "\\(^\\|[^\"]\\)"
1713                               "\\(" "(\\*"
1714                                     "[^*]*\\*+"
1715                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1716                                     ")"
1717                               "\\|"
1718                                     "//.*"
1719                               "\\)")
1720                       '(2 font-lock-comment-face))
1721
1722                 (list (concat "'" "\\("
1723                                     "\\\\"
1724                                     "\\(" "[ntbr'\\]"
1725                                     "\\|" "[0-9][0-9][0-9]"
1726                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1727                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1728                                     "\\)"
1729                                   "\\|"
1730                                   "." "\\)" "'"
1731                               "\\|"
1732                               "\"" "[^\"\\]*"
1733                                     "\\(" "\\\\" "\\(.\\|\n\\)"
1734                                           "[^\"\\]*" "\\)*"
1735                               "\\(\"\\|\\'\\)")
1736                       '(0 font-lock-string-face))
1737
1738                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1739                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1740                               "\\|"
1741                               "\\_<\\(" fsharp-keywords "\\)\\_>")
1742                       '(0 font-lock-keyword-face))
1743                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1744                       '(0 font-lock-variable-name-face))
1745
1746                 (list (concat "\\_<"
1747                               "\\(" "0[bB][01]+" "\\|"
1748                                     "0[oO][0-7]+" "\\|"
1749                                     "0[xX][0-9a-fA-F]+" "\\)"
1750                               "\\(" "lf\\|LF" "\\|"
1751                                     "[uU]?[ysnlL]?" "\\)"
1752                               "\\|"
1753                               "\\_<"
1754                               "[0-9]+" "\\("
1755                                 "[mMQRZING]"
1756                                 "\\|"
1757                                 "\\(\\.[0-9]*\\)?"
1758                                 "\\([eE][-+]?[0-9]+\\)?"
1759                                 "[fFmM]?"
1760                                 "\\|"
1761                                 "[uU]?[ysnlL]?"
1762                               "\\)")
1763                       '(0 mdw-number-face))
1764
1765                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1766                       '(0 mdw-punct-face)))))
1767
1768   (mdw-post-config-mode-hack))
1769
1770 (defun mdw-fontify-inferior-fsharp ()
1771   (mdw-fontify-fsharp)
1772   (setq font-lock-keywords
1773         (append (list (list "^[#-]" '(0 font-lock-comment-face))
1774                       (list "^>" '(0 font-lock-keyword-face)))
1775                 font-lock-keywords)))
1776
1777 ;;;--------------------------------------------------------------------------
1778 ;;; Go programming configuration.
1779
1780 (defun mdw-fontify-go ()
1781
1782   (make-local-variable 'font-lock-keywords)
1783   (let ((go-keywords
1784          (mdw-regexps "break" "case" "chan" "const" "continue"
1785                       "default" "defer" "else" "fallthrough" "for"
1786                       "func" "go" "goto" "if" "import"
1787                       "interface" "map" "package" "range" "return"
1788                       "select" "struct" "switch" "type" "var"))
1789         (go-intrinsics
1790          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1791                       "float32" "float64" "int" "uint8" "int16" "int32"
1792                       "int64" "rune" "string" "uint" "uint8" "uint16"
1793                       "uint32" "uint64" "uintptr" "void"
1794                       "false" "iota" "nil" "true"
1795                       "init" "main"
1796                       "append" "cap" "copy" "delete" "imag" "len" "make"
1797                       "new" "panic" "real" "recover")))
1798
1799     (setq font-lock-keywords
1800           (list
1801
1802            ;; Handle the keywords defined above.
1803            (list (concat "\\<\\(" go-keywords "\\)\\>")
1804                  '(0 font-lock-keyword-face))
1805            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1806                  '(0 font-lock-variable-name-face))
1807
1808            ;; Strings and characters.
1809            (list (concat "'"
1810                          "\\(" "[^\\']" "\\|"
1811                                "\\\\"
1812                                "\\(" "[abfnrtv\\'\"]" "\\|"
1813                                      "[0-7]\\{3\\}" "\\|"
1814                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1815                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1816                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1817                          "'"
1818                          "\\|"
1819                          "\""
1820                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1821                          "\\(\"\\|$\\)"
1822                          "\\|"
1823                          "`" "[^`]+" "`")
1824                  '(0 font-lock-string-face))
1825
1826            ;; Handle numbers too.
1827            ;;
1828            ;; The following isn't quite right, but it's close enough.
1829            (list (concat "\\<\\("
1830                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1831                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1832                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1833                  '(0 mdw-number-face))
1834
1835            ;; And anything else is punctuation.
1836            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1837                  '(0 mdw-punct-face)))))
1838
1839   (mdw-post-config-mode-hack))
1840
1841 ;;;--------------------------------------------------------------------------
1842 ;;; Awk programming configuration.
1843
1844 ;; Make Awk indentation nice.
1845
1846 (defun mdw-awk-style ()
1847   (c-add-style "[mdw] Awk style"
1848                '((c-basic-offset . 2)
1849                  (c-offsets-alist (substatement-open . 0)
1850                                   (statement-cont . 0)
1851                                   (statement-case-intro . +)))
1852                t))
1853
1854 ;; Declare Awk fontification style.
1855
1856 (defun mdw-fontify-awk ()
1857
1858   ;; Miscellaneous fiddling.
1859   (mdw-awk-style)
1860   (setq c-backslash-column 72)
1861   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1862
1863   ;; Now define things to be fontified.
1864   (make-local-variable 'font-lock-keywords)
1865   (let ((c-keywords
1866          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1867                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1868                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1869                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1870                       "atan2" "break" "close" "continue" "cos" "delete"
1871                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1872                       "function" "gensub" "getline" "gsub" "if" "in"
1873                       "index" "int" "length" "log" "match" "next" "rand"
1874                       "return" "print" "printf" "sin" "split" "sprintf"
1875                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1876                       "systime" "tolower" "toupper" "while")))
1877
1878     (setq font-lock-keywords
1879           (list
1880
1881            ;; Handle the keywords defined above.
1882            (list (concat "\\<\\(" c-keywords "\\)\\>")
1883                  '(0 font-lock-keyword-face))
1884
1885            ;; Handle numbers too.
1886            ;;
1887            ;; The following isn't quite right, but it's close enough.
1888            (list (concat "\\<\\("
1889                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1890                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1891                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1892                          "[uUlL]*")
1893                  '(0 mdw-number-face))
1894
1895            ;; And anything else is punctuation.
1896            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1897                  '(0 mdw-punct-face)))))
1898
1899   (mdw-post-config-mode-hack))
1900
1901 ;;;--------------------------------------------------------------------------
1902 ;;; Perl programming style.
1903
1904 ;; Perl indentation style.
1905
1906 (fset 'perl-mode 'cperl-mode)
1907 (setq cperl-indent-level 2)
1908 (setq cperl-continued-statement-offset 2)
1909 (setq cperl-continued-brace-offset 0)
1910 (setq cperl-brace-offset -2)
1911 (setq cperl-brace-imaginary-offset 0)
1912 (setq cperl-label-offset 0)
1913
1914 ;; Define perl fontification style.
1915
1916 (defun mdw-fontify-perl ()
1917
1918   ;; Miscellaneous fiddling.
1919   (modify-syntax-entry ?$ "\\")
1920   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1921   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1922
1923   ;; Now define fontification things.
1924   (make-local-variable 'font-lock-keywords)
1925   (let ((perl-keywords
1926          (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
1927                       "for" "foreach" "ge" "given" "gt" "goto" "if"
1928                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1929                       "our" "package" "redo" "require" "return" "sub"
1930                       "undef" "unless" "until" "use" "when" "while")))
1931
1932     (setq font-lock-keywords
1933           (list
1934
1935            ;; Set up the keywords defined above.
1936            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1937                  '(0 font-lock-keyword-face))
1938
1939            ;; At least numbers are simpler than C.
1940            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1941                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1942                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1943                  '(0 mdw-number-face))
1944
1945            ;; And anything else is punctuation.
1946            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1947                  '(0 mdw-punct-face)))))
1948
1949   (mdw-post-config-mode-hack))
1950
1951 (defun perl-number-tests (&optional arg)
1952   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1953 strip numbers instead."
1954   (interactive "P")
1955   (save-excursion
1956     (goto-char (point-min))
1957     (let ((i 0) (fmt (if arg "" " %4d")))
1958       (while (search-forward "#t" nil t)
1959         (delete-region (point) (line-end-position))
1960         (setq i (1+ i))
1961         (insert (format fmt i)))
1962       (goto-char (point-min))
1963       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1964           (replace-match (format "\\1%d" i))))))
1965
1966 ;;;--------------------------------------------------------------------------
1967 ;;; Python programming style.
1968
1969 (defun mdw-fontify-pythonic (keywords)
1970
1971   ;; Miscellaneous fiddling.
1972   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1973   (setq indent-tabs-mode nil)
1974
1975   ;; Now define fontification things.
1976   (make-local-variable 'font-lock-keywords)
1977   (setq font-lock-keywords
1978         (list
1979
1980          ;; Set up the keywords defined above.
1981          (list (concat "\\_<\\(" keywords "\\)\\_>")
1982                '(0 font-lock-keyword-face))
1983
1984          ;; At least numbers are simpler than C.
1985          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1986                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1987                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1988                '(0 mdw-number-face))
1989
1990          ;; And anything else is punctuation.
1991          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1992                '(0 mdw-punct-face))))
1993
1994   (mdw-post-config-mode-hack))
1995
1996 ;; Define Python fontification styles.
1997
1998 (defun mdw-fontify-python ()
1999   (mdw-fontify-pythonic
2000    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2001                 "del" "elif" "else" "except" "exec" "finally" "for"
2002                 "from" "global" "if" "import" "in" "is" "lambda"
2003                 "not" "or" "pass" "print" "raise" "return" "try"
2004                 "while" "with" "yield")))
2005
2006 (defun mdw-fontify-pyrex ()
2007   (mdw-fontify-pythonic
2008    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2009                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2010                 "extern" "finally" "for" "from" "global" "if"
2011                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2012                 "raise" "return" "struct" "try" "while" "with"
2013                 "yield")))
2014
2015 ;;;--------------------------------------------------------------------------
2016 ;;; Icon programming style.
2017
2018 ;; Icon indentation style.
2019
2020 (setq icon-brace-offset 0
2021       icon-continued-brace-offset 0
2022       icon-continued-statement-offset 2
2023       icon-indent-level 2)
2024
2025 ;; Define Icon fontification style.
2026
2027 (defun mdw-fontify-icon ()
2028
2029   ;; Miscellaneous fiddling.
2030   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2031
2032   ;; Now define fontification things.
2033   (make-local-variable 'font-lock-keywords)
2034   (let ((icon-keywords
2035          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2036                       "end" "every" "fail" "global" "if" "initial"
2037                       "invocable" "link" "local" "next" "not" "of"
2038                       "procedure" "record" "repeat" "return" "static"
2039                       "suspend" "then" "to" "until" "while"))
2040         (preprocessor-keywords
2041          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2042                       "include" "line" "undef")))
2043     (setq font-lock-keywords
2044           (list
2045
2046            ;; Set up the keywords defined above.
2047            (list (concat "\\<\\(" icon-keywords "\\)\\>")
2048                  '(0 font-lock-keyword-face))
2049
2050            ;; The things that Icon calls keywords.
2051            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2052
2053            ;; At least numbers are simpler than C.
2054            (list (concat "\\<[0-9]+"
2055                          "\\([rR][0-9a-zA-Z]+\\|"
2056                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2057                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2058                  '(0 mdw-number-face))
2059
2060            ;; Preprocessor.
2061            (list (concat "^[ \t]*$[ \t]*\\<\\("
2062                          preprocessor-keywords
2063                          "\\)\\>")
2064                  '(0 font-lock-keyword-face))
2065
2066            ;; And anything else is punctuation.
2067            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2068                  '(0 mdw-punct-face)))))
2069
2070   (mdw-post-config-mode-hack))
2071
2072 ;;;--------------------------------------------------------------------------
2073 ;;; ARM assembler programming configuration.
2074
2075 ;; There doesn't appear to be an Emacs mode for this yet.
2076 ;;
2077 ;; Better do something about that, I suppose.
2078
2079 (defvar arm-assembler-mode-map nil)
2080 (defvar arm-assembler-abbrev-table nil)
2081 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
2082
2083 (or arm-assembler-mode-map
2084     (progn
2085       (setq arm-assembler-mode-map (make-sparse-keymap))
2086       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
2087       (define-key arm-assembler-mode-map [C-return] 'newline)
2088       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
2089
2090 (defun arm-assembler-mode ()
2091   "Major mode for ARM assembler programs"
2092   (interactive)
2093
2094   ;; Do standard major mode things.
2095   (kill-all-local-variables)
2096   (use-local-map arm-assembler-mode-map)
2097   (setq local-abbrev-table arm-assembler-abbrev-table)
2098   (setq major-mode 'arm-assembler-mode)
2099   (setq mode-name "ARM assembler")
2100
2101   ;; Set up syntax table.
2102   (set-syntax-table arm-assembler-mode-syntax-table)
2103   (modify-syntax-entry ?;   ; Nasty hack
2104                        "<" arm-assembler-mode-syntax-table)
2105   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
2106   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
2107   (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
2108
2109   (make-local-variable 'comment-start)
2110   (setq comment-start ";")
2111   (make-local-variable 'comment-end)
2112   (setq comment-end "")
2113   (make-local-variable 'comment-column)
2114   (setq comment-column 48)
2115   (make-local-variable 'comment-start-skip)
2116   (setq comment-start-skip ";+[ \t]*")
2117
2118   ;; Play with indentation.
2119   (make-local-variable 'indent-line-function)
2120   (setq indent-line-function 'indent-relative-maybe)
2121
2122   ;; Set fill prefix.
2123   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2124
2125   ;; Fiddle with fontification.
2126   (make-local-variable 'font-lock-keywords)
2127   (setq font-lock-keywords
2128         (list
2129
2130          ;; Handle numbers too.
2131          ;;
2132          ;; The following isn't quite right, but it's close enough.
2133          (list (concat "\\("
2134                        "&[0-9a-fA-F]+\\|"
2135                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
2136                        "\\)")
2137                '(0 mdw-number-face))
2138
2139          ;; Do something about operators.
2140          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
2141                '(1 font-lock-keyword-face)
2142                '(2 font-lock-string-face))
2143          (list ":[a-zA-Z]+:"
2144                '(0 font-lock-keyword-face))
2145
2146          ;; Do menemonics and directives.
2147          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
2148                '(1 font-lock-keyword-face))
2149
2150          ;; And anything else is punctuation.
2151          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2152                '(0 mdw-punct-face))))
2153
2154   (mdw-post-config-mode-hack)
2155   (run-hooks 'arm-assembler-mode-hook))
2156
2157 ;;;--------------------------------------------------------------------------
2158 ;;; Assembler mode.
2159
2160 (defun mdw-fontify-asm ()
2161   (modify-syntax-entry ?' "\"")
2162   (modify-syntax-entry ?. "w")
2163   (setf fill-prefix nil)
2164   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2165
2166 ;;;--------------------------------------------------------------------------
2167 ;;; TCL configuration.
2168
2169 (defun mdw-fontify-tcl ()
2170   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2171   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2172   (make-local-variable 'font-lock-keywords)
2173   (setq font-lock-keywords
2174         (list
2175          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2176                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2177                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2178                '(0 mdw-number-face))
2179          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2180                '(0 mdw-punct-face))))
2181   (mdw-post-config-mode-hack))
2182
2183 ;;;--------------------------------------------------------------------------
2184 ;;; Dylan programming configuration.
2185
2186 (defun mdw-fontify-dylan ()
2187
2188   (make-local-variable 'font-lock-keywords)
2189
2190   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
2191   ;; hook, which undoes all of our configuration.
2192   (setq major-mode 'dylan-mode)
2193   (font-lock-set-defaults)
2194
2195   (let* ((word "[-_a-zA-Z!*@<>$%]+")
2196          (dylan-keywords (mdw-regexps
2197
2198                           "C-address" "C-callable-wrapper" "C-function"
2199                           "C-mapped-subtype" "C-pointer-type" "C-struct"
2200                           "C-subtype" "C-union" "C-variable"
2201
2202                           "above" "abstract" "afterwards" "all"
2203                           "begin" "below" "block" "by"
2204                           "case" "class" "cleanup" "constant" "create"
2205                           "define" "domain"
2206                           "else" "elseif" "end" "exception" "export"
2207                           "finally" "for" "from" "function"
2208                           "generic"
2209                           "handler"
2210                           "if" "in" "instance" "interface" "iterate"
2211                           "keyed-by"
2212                           "let" "library" "local"
2213                           "macro" "method" "module"
2214                           "otherwise"
2215                           "profiling"
2216                           "select" "slot" "subclass"
2217                           "table" "then" "to"
2218                           "unless" "until" "use"
2219                           "variable" "virtual"
2220                           "when" "while"))
2221          (sharp-keywords (mdw-regexps
2222                           "all-keys" "key" "next" "rest" "include"
2223                           "t" "f")))
2224     (setq font-lock-keywords
2225           (list (list (concat "\\<\\(" dylan-keywords
2226                               "\\|" "with\\(out\\)?-" word
2227                               "\\)\\>")
2228                       '(0 font-lock-keyword-face))
2229                 (list (concat "\\<" word ":" "\\|"
2230                               "#\\(" sharp-keywords "\\)\\>")
2231                       '(0 font-lock-variable-name-face))
2232                 (list (concat "\\("
2233                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
2234                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2235                                 "\\|" "/[0-9]+"
2236                               "\\)"
2237                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2238                               "\\|" "#b[01]+"
2239                               "\\|" "#o[0-7]+"
2240                               "\\|" "#x[0-9a-zA-Z]+"
2241                               "\\)\\>")
2242                       '(0 mdw-number-face))
2243                 (list (concat "\\("
2244                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2245                               "\\_<[-+*/=<>:&|]+\\_>"
2246                               "\\)")
2247                       '(0 mdw-punct-face)))))
2248
2249   (mdw-post-config-mode-hack))
2250
2251 ;;;--------------------------------------------------------------------------
2252 ;;; Algol 68 configuration.
2253
2254 (setq a68-indent-step 2)
2255
2256 (defun mdw-fontify-algol-68 ()
2257
2258   ;; Fix up the syntax table.
2259   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2260   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2261     (modify-syntax-entry ch "." a68-mode-syntax-table))
2262
2263   (make-local-variable 'font-lock-keywords)
2264
2265   (let ((not-comment
2266          (let ((word "COMMENT"))
2267            (do ((regexp (concat "[^" (substring word 0 1) "]+")
2268                         (concat regexp "\\|"
2269                                 (substring word 0 i)
2270                                 "[^" (substring word i (1+ i)) "]"))
2271                 (i 1 (1+ i)))
2272                ((>= i (length word)) regexp)))))
2273     (setq font-lock-keywords
2274           (list (list (concat "\\<COMMENT\\>"
2275                               "\\(" not-comment "\\)\\{0,5\\}"
2276                               "\\(\\'\\|\\<COMMENT\\>\\)")
2277                       '(0 font-lock-comment-face))
2278                 (list (concat "\\<CO\\>"
2279                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2280                               "\\($\\|\\<CO\\>\\)")
2281                       '(0 font-lock-comment-face))
2282                 (list "\\<[A-Z_]+\\>"
2283                       '(0 font-lock-keyword-face))
2284                 (list (concat "\\<"
2285                               "[0-9]+"
2286                               "\\(\\.[0-9]+\\)?"
2287                               "\\([eE][-+]?[0-9]+\\)?"
2288                               "\\>")
2289                       '(0 mdw-number-face))
2290                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2291                       '(0 mdw-punct-face)))))
2292
2293   (mdw-post-config-mode-hack))
2294
2295 ;;;--------------------------------------------------------------------------
2296 ;;; REXX configuration.
2297
2298 (defun mdw-rexx-electric-* ()
2299   (interactive)
2300   (insert ?*)
2301   (rexx-indent-line))
2302
2303 (defun mdw-rexx-indent-newline-indent ()
2304   (interactive)
2305   (rexx-indent-line)
2306   (if abbrev-mode (expand-abbrev))
2307   (newline-and-indent))
2308
2309 (defun mdw-fontify-rexx ()
2310
2311   ;; Various bits of fiddling.
2312   (setq mdw-auto-indent nil)
2313   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2314   (local-set-key [?*] 'mdw-rexx-electric-*)
2315   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2316           '(?! ?? ?# ?@ ?$))
2317   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2318
2319   ;; Set up keywords and things for fontification.
2320   (make-local-variable 'font-lock-keywords-case-fold-search)
2321   (setq font-lock-keywords-case-fold-search t)
2322
2323   (setq rexx-indent 2)
2324   (setq rexx-end-indent rexx-indent)
2325   (setq rexx-cont-indent rexx-indent)
2326
2327   (make-local-variable 'font-lock-keywords)
2328   (let ((rexx-keywords
2329          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2330                       "else" "end" "engineering" "exit" "expose" "for"
2331                       "forever" "form" "fuzz" "if" "interpret" "iterate"
2332                       "leave" "linein" "name" "nop" "numeric" "off" "on"
2333                       "options" "otherwise" "parse" "procedure" "pull"
2334                       "push" "queue" "return" "say" "select" "signal"
2335                       "scientific" "source" "then" "trace" "to" "until"
2336                       "upper" "value" "var" "version" "when" "while"
2337                       "with"
2338
2339                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2340                       "center" "center" "charin" "charout" "chars"
2341                       "compare" "condition" "copies" "c2d" "c2x"
2342                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
2343                       "errortext" "format" "fuzz" "insert" "lastpos"
2344                       "left" "length" "lineout" "lines" "max" "min"
2345                       "overlay" "pos" "queued" "random" "reverse" "right"
2346                       "sign" "sourceline" "space" "stream" "strip"
2347                       "substr" "subword" "symbol" "time" "translate"
2348                       "trunc" "value" "verify" "word" "wordindex"
2349                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2350                       "x2d")))
2351
2352     (setq font-lock-keywords
2353           (list
2354
2355            ;; Set up the keywords defined above.
2356            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2357                  '(0 font-lock-keyword-face))
2358
2359            ;; Fontify all symbols the same way.
2360            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2361                          "[A-Za-z0-9.!?_#@$]+\\)")
2362                  '(0 font-lock-variable-name-face))
2363
2364            ;; And everything else is punctuation.
2365            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2366                  '(0 mdw-punct-face)))))
2367
2368   (mdw-post-config-mode-hack))
2369
2370 ;;;--------------------------------------------------------------------------
2371 ;;; Standard ML programming style.
2372
2373 (defun mdw-fontify-sml ()
2374
2375   ;; Make underscore an honorary letter.
2376   (modify-syntax-entry ?' "w")
2377
2378   ;; Set fill prefix.
2379   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2380
2381   ;; Now define fontification things.
2382   (make-local-variable 'font-lock-keywords)
2383   (let ((sml-keywords
2384          (mdw-regexps "abstype" "and" "andalso" "as"
2385                       "case"
2386                       "datatype" "do"
2387                       "else" "end" "eqtype" "exception"
2388                       "fn" "fun" "functor"
2389                       "handle"
2390                       "if" "in" "include" "infix" "infixr"
2391                       "let" "local"
2392                       "nonfix"
2393                       "of" "op" "open" "orelse"
2394                       "raise" "rec"
2395                       "sharing" "sig" "signature" "struct" "structure"
2396                       "then" "type"
2397                       "val"
2398                       "where" "while" "with" "withtype")))
2399
2400     (setq font-lock-keywords
2401           (list
2402
2403            ;; Set up the keywords defined above.
2404            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2405                  '(0 font-lock-keyword-face))
2406
2407            ;; At least numbers are simpler than C.
2408            (list (concat "\\<\\(\\~\\|\\)"
2409                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2410                                    "[wW][0-9]+\\)\\|"
2411                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2412                                          "\\([eE]\\(\\~\\|\\)"
2413                                                 "[0-9]+\\|\\)\\)\\)")
2414                  '(0 mdw-number-face))
2415
2416            ;; And anything else is punctuation.
2417            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2418                  '(0 mdw-punct-face)))))
2419
2420   (mdw-post-config-mode-hack))
2421
2422 ;;;--------------------------------------------------------------------------
2423 ;;; Haskell configuration.
2424
2425 (defun mdw-fontify-haskell ()
2426
2427   ;; Fiddle with syntax table to get comments right.
2428   (modify-syntax-entry ?' "_")
2429   (modify-syntax-entry ?- ". 12")
2430   (modify-syntax-entry ?\n ">")
2431
2432   ;; Make punctuation be punctuation
2433   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2434     (do ((i 0 (1+ i)))
2435         ((>= i (length punct)))
2436       (modify-syntax-entry (aref punct i) ".")))
2437
2438   ;; Set fill prefix.
2439   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2440
2441   ;; Fiddle with fontification.
2442   (make-local-variable 'font-lock-keywords)
2443   (let ((haskell-keywords
2444          (mdw-regexps "as"
2445                       "case" "ccall" "class"
2446                       "data" "default" "deriving" "do"
2447                       "else" "exists"
2448                       "forall" "foreign"
2449                       "hiding"
2450                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
2451                       "let"
2452                       "mdo" "module"
2453                       "newtype"
2454                       "of"
2455                       "proc"
2456                       "qualified"
2457                       "rec"
2458                       "safe" "stdcall"
2459                       "then" "type"
2460                       "unsafe"
2461                       "where"))
2462         (control-sequences
2463          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2464                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2465                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2466                       "SP" "STX" "SUB" "SYN" "US" "VT")))
2467
2468     (setq font-lock-keywords
2469           (list
2470            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2471                               "\\(-+}\\|-*\\'\\)"
2472                          "\\|"
2473                          "--.*$")
2474                  '(0 font-lock-comment-face))
2475            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2476                  '(0 font-lock-keyword-face))
2477            (list (concat "'\\("
2478                          "[^\\]"
2479                          "\\|"
2480                          "\\\\"
2481                          "\\(" "[abfnrtv\\\"']" "\\|"
2482                                "^" "\\(" control-sequences "\\|"
2483                                          "[]A-Z@[\\^_]" "\\)" "\\|"
2484                                "\\|"
2485                                "[0-9]+" "\\|"
2486                                "[oO][0-7]+" "\\|"
2487                                "[xX][0-9A-Fa-f]+"
2488                          "\\)"
2489                          "\\)'")
2490                  '(0 font-lock-string-face))
2491            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2492                  '(0 font-lock-variable-name-face))
2493            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2494                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2495                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2496                  '(0 mdw-number-face))
2497            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2498                  '(0 mdw-punct-face)))))
2499
2500   (mdw-post-config-mode-hack))
2501
2502 ;;;--------------------------------------------------------------------------
2503 ;;; Erlang configuration.
2504
2505 (setq erlang-electric-commands nil)
2506
2507 (defun mdw-fontify-erlang ()
2508
2509   ;; Set fill prefix.
2510   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2511
2512   ;; Fiddle with fontification.
2513   (make-local-variable 'font-lock-keywords)
2514   (let ((erlang-keywords
2515          (mdw-regexps "after" "and" "andalso"
2516                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2517                       "case" "catch" "cond"
2518                       "div" "end" "fun" "if" "let" "not"
2519                       "of" "or" "orelse"
2520                       "query" "receive" "rem" "try" "when" "xor")))
2521
2522     (setq font-lock-keywords
2523           (list
2524            (list "%.*$"
2525                  '(0 font-lock-comment-face))
2526            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2527                  '(0 font-lock-keyword-face))
2528            (list (concat "^-\\sw+\\>")
2529                  '(0 font-lock-keyword-face))
2530            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2531                  '(0 mdw-number-face))
2532            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2533                  '(0 mdw-punct-face)))))
2534
2535   (mdw-post-config-mode-hack))
2536
2537 ;;;--------------------------------------------------------------------------
2538 ;;; Texinfo configuration.
2539
2540 (defun mdw-fontify-texinfo ()
2541
2542   ;; Set fill prefix.
2543   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2544
2545   ;; Real fontification things.
2546   (make-local-variable 'font-lock-keywords)
2547   (setq font-lock-keywords
2548         (list
2549
2550          ;; Environment names are keywords.
2551          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2552                '(2 font-lock-keyword-face))
2553
2554          ;; Unmark escaped magic characters.
2555          (list "\\(@\\)\\([@{}]\\)"
2556                '(1 font-lock-keyword-face)
2557                '(2 font-lock-variable-name-face))
2558
2559          ;; Make sure we get comments properly.
2560          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2561                '(0 font-lock-comment-face))
2562
2563          ;; Command names are keywords.
2564          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2565                '(0 font-lock-keyword-face))
2566
2567          ;; Fontify TeX special characters as punctuation.
2568          (list "[{}]+"
2569                '(0 mdw-punct-face))))
2570
2571   (mdw-post-config-mode-hack))
2572
2573 ;;;--------------------------------------------------------------------------
2574 ;;; TeX and LaTeX configuration.
2575
2576 (defun mdw-fontify-tex ()
2577   (setq ispell-parser 'tex)
2578   (turn-on-reftex)
2579
2580   ;; Don't make maths into a string.
2581   (modify-syntax-entry ?$ ".")
2582   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2583   (local-set-key [?$] 'self-insert-command)
2584
2585   ;; Set fill prefix.
2586   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2587
2588   ;; Real fontification things.
2589   (make-local-variable 'font-lock-keywords)
2590   (setq font-lock-keywords
2591         (list
2592
2593          ;; Environment names are keywords.
2594          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2595                        "{\\([^}\n]*\\)}")
2596                '(2 font-lock-keyword-face))
2597
2598          ;; Suspended environment names are keywords too.
2599          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2600                        "{\\([^}\n]*\\)}")
2601                '(3 font-lock-keyword-face))
2602
2603          ;; Command names are keywords.
2604          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2605                '(0 font-lock-keyword-face))
2606
2607          ;; Handle @/.../ for italics.
2608          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2609          ;;       '(1 font-lock-keyword-face)
2610          ;;       '(3 font-lock-keyword-face))
2611
2612          ;; Handle @*...* for boldness.
2613          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2614          ;;       '(1 font-lock-keyword-face)
2615          ;;       '(3 font-lock-keyword-face))
2616
2617          ;; Handle @`...' for literal syntax things.
2618          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2619          ;;       '(1 font-lock-keyword-face)
2620          ;;       '(3 font-lock-keyword-face))
2621
2622          ;; Handle @<...> for nonterminals.
2623          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2624          ;;       '(1 font-lock-keyword-face)
2625          ;;       '(3 font-lock-keyword-face))
2626
2627          ;; Handle other @-commands.
2628          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2629          ;;       '(0 font-lock-keyword-face))
2630
2631          ;; Make sure we get comments properly.
2632          (list "%.*"
2633                '(0 font-lock-comment-face))
2634
2635          ;; Fontify TeX special characters as punctuation.
2636          (list "[$^_{}#&]"
2637                '(0 mdw-punct-face))))
2638
2639   (mdw-post-config-mode-hack))
2640
2641 ;;;--------------------------------------------------------------------------
2642 ;;; SGML hacking.
2643
2644 (defun mdw-sgml-mode ()
2645   (interactive)
2646   (sgml-mode)
2647   (mdw-standard-fill-prefix "")
2648   (make-local-variable 'sgml-delimiters)
2649   (setq sgml-delimiters
2650         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2651           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2652           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2653           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2654           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2655           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2656           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2657           "NULL" ""))
2658   (setq major-mode 'mdw-sgml-mode)
2659   (setq mode-name "[mdw] SGML")
2660   (run-hooks 'mdw-sgml-mode-hook))
2661
2662 ;;;--------------------------------------------------------------------------
2663 ;;; Configuration files.
2664
2665 (defvar mdw-conf-quote-normal nil
2666   "*Control syntax category of quote characters `\"' and `''.
2667 If this is `t', consider quote characters to be normal
2668 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2669 leave quote characters as quotes.  If this is a list, then
2670 consider the quote characters in the list to be normal
2671 punctuation.  If this is a single quote character, then consider
2672 that character only to be normal punctuation.")
2673 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2674   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2675   (or (booleanp value)
2676       (every (lambda (v) (memq v '(?\" ?')))
2677              (if (listp value) value (list value)))))
2678 (put 'mdw-conf-quote-normal 'safe-local-variable '
2679      mdw-conf-quote-normal-acceptable-value-p)
2680
2681 (defun mdw-fix-up-quote ()
2682   "Apply the setting of `mdw-conf-quote-normal'."
2683   (let ((flag mdw-conf-quote-normal))
2684     (cond ((eq flag t)
2685            (conf-quote-normal t))
2686           ((not flag)
2687            nil)
2688           (t
2689            (let ((table (copy-syntax-table (syntax-table))))
2690              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2691                    (if (listp flag) flag (list flag)))
2692              (set-syntax-table table)
2693              (and font-lock-mode (font-lock-fontify-buffer)))))))
2694 (defun mdw-fix-up-quote-hack ()
2695   "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2696 Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2697 so we wouldn't see a local-variable setting of
2698 `mdw-conf-quote-normal' in `conf-mode-hook'.  Instead, wire
2699 ourselves onto `hack-local-variables-hook' here, and check the
2700 setting once it's actually been made."
2701   (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2702 (add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2703
2704 ;;;--------------------------------------------------------------------------
2705 ;;; Shell scripts.
2706
2707 (defun mdw-setup-sh-script-mode ()
2708
2709   ;; Fetch the shell interpreter's name.
2710   (let ((shell-name sh-shell-file))
2711
2712     ;; Try reading the hash-bang line.
2713     (save-excursion
2714       (goto-char (point-min))
2715       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2716           (setq shell-name (match-string 1))))
2717
2718     ;; Now try to set the shell.
2719     ;;
2720     ;; Don't let `sh-set-shell' bugger up my script.
2721     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2722       (sh-set-shell shell-name)))
2723
2724   ;; Now enable my keys and the fontification.
2725   (mdw-misc-mode-config)
2726
2727   ;; Set the indentation level correctly.
2728   (setq sh-indentation 2)
2729   (setq sh-basic-offset 2))
2730
2731 (setq sh-shell-file "/bin/sh")
2732
2733 ;; Awful hacking to override the shell detection for particular scripts.
2734 (defmacro define-custom-shell-mode (name shell)
2735   `(defun ,name ()
2736      (interactive)
2737      (set (make-local-variable 'sh-shell-file) ,shell)
2738      (sh-mode)))
2739 (define-custom-shell-mode bash-mode "/bin/bash")
2740 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2741 (put 'sh-shell-file 'permanent-local t)
2742
2743 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2744 (eval-after-load "sh-script"
2745   '(or (assq 'rc sh-mode-syntax-table-input)
2746        (let ((frag '(nil
2747                      ?# "<"
2748                      ?\n ">#"
2749                      ?\" "\"\""
2750                      ?\' "\"\'"
2751                      ?$ "'"
2752                      ?\` "."
2753                      ?! "_"
2754                      ?% "_"
2755                      ?. "_"
2756                      ?^ "_"
2757                      ?~ "_"
2758                      ?, "_"
2759                      ?= "."
2760                      ?< "."
2761                      ?> "."))
2762              (assoc (assq 'rc sh-mode-syntax-table-input)))
2763          (if assoc
2764              (rplacd assoc frag)
2765            (setq sh-mode-syntax-table-input
2766                  (cons (cons 'rc frag)
2767                        sh-mode-syntax-table-input))))))
2768
2769 ;;;--------------------------------------------------------------------------
2770 ;;; Emacs shell mode.
2771
2772 (defun mdw-eshell-prompt ()
2773   (let ((left "[") (right "]"))
2774     (when (= (user-uid) 0)
2775       (setq left "«" right "»"))
2776     (concat left
2777             (save-match-data
2778               (replace-regexp-in-string "\\..*$" "" (system-name)))
2779             " "
2780             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2781                    (home (expand-file-name "~")) (nhome (length home)))
2782               (if (and (>= npwd nhome)
2783                        (or (= nhome npwd)
2784                            (= (elt pwd nhome) ?/))
2785                        (string= (substring pwd 0 nhome) home))
2786                   (concat "~" (substring pwd (length home)))
2787                 pwd))
2788             right)))
2789 (setq eshell-prompt-function 'mdw-eshell-prompt)
2790 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2791
2792 (defun eshell/e (file) (find-file file) nil)
2793 (defun eshell/ee (file) (find-file-other-window file) nil)
2794 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2795
2796 (mdw-define-face eshell-prompt (t :weight bold))
2797 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2798 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2799 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2800 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2801 (mdw-define-face eshell-ls-executable (t :weight bold))
2802 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2803 (mdw-define-face eshell-ls-readonly (t nil))
2804 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2805
2806 ;;;--------------------------------------------------------------------------
2807 ;;; Messages-file mode.
2808
2809 (defun messages-mode-guts ()
2810   (setq messages-mode-syntax-table (make-syntax-table))
2811   (set-syntax-table messages-mode-syntax-table)
2812   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2813   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2814   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2815   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2816   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2817   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2818   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2819   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2820   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2821   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2822   (make-local-variable 'comment-start)
2823   (make-local-variable 'comment-end)
2824   (make-local-variable 'indent-line-function)
2825   (setq indent-line-function 'indent-relative)
2826   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2827   (make-local-variable 'font-lock-defaults)
2828   (make-local-variable 'messages-mode-keywords)
2829   (let ((keywords
2830          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2831                       "export" "enum" "fixed-octetstring" "flags"
2832                       "harmless" "map" "nested" "optional"
2833                       "optional-tagged" "package" "primitive"
2834                       "primitive-nullfree" "relaxed[ \t]+enum"
2835                       "set" "table" "tagged-optional"   "union"
2836                       "variadic" "vector" "version" "version-tag")))
2837     (setq messages-mode-keywords
2838           (list
2839            (list (concat "\\<\\(" keywords "\\)\\>:")
2840                  '(0 font-lock-keyword-face))
2841            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2842            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2843              (0 font-lock-variable-name-face))
2844            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2845            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2846              (0 mdw-punct-face)))))
2847   (setq font-lock-defaults
2848         '(messages-mode-keywords nil nil nil nil))
2849   (run-hooks 'messages-file-hook))
2850
2851 (defun messages-mode ()
2852   (interactive)
2853   (fundamental-mode)
2854   (setq major-mode 'messages-mode)
2855   (setq mode-name "Messages")
2856   (messages-mode-guts)
2857   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2858   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2859   (setq comment-start "# ")
2860   (setq comment-end "")
2861   (run-hooks 'messages-mode-hook))
2862
2863 (defun cpp-messages-mode ()
2864   (interactive)
2865   (fundamental-mode)
2866   (setq major-mode 'cpp-messages-mode)
2867   (setq mode-name "CPP Messages")
2868   (messages-mode-guts)
2869   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2870   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2871   (setq comment-start "/* ")
2872   (setq comment-end " */")
2873   (let ((preprocessor-keywords
2874          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2875                       "ident" "if" "ifdef" "ifndef" "import" "include"
2876                       "line" "pragma" "unassert" "undef" "warning")))
2877     (setq messages-mode-keywords
2878           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2879                                       "\\(include\\|import\\)"
2880                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2881                               '(2 font-lock-string-face))
2882                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2883                                       preprocessor-keywords
2884                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2885                               '(1 font-lock-keyword-face)))
2886                   messages-mode-keywords)))
2887   (run-hooks 'cpp-messages-mode-hook))
2888
2889 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2890 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2891 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2892
2893 ;;;--------------------------------------------------------------------------
2894 ;;; Messages-file mode.
2895
2896 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2897   "Face to use for subsittution directives.")
2898 (make-face 'mallow-driver-substitution-face)
2899 (defvar mallow-driver-text-face 'mallow-driver-text-face
2900   "Face to use for body text.")
2901 (make-face 'mallow-driver-text-face)
2902
2903 (defun mallow-driver-mode ()
2904   (interactive)
2905   (fundamental-mode)
2906   (setq major-mode 'mallow-driver-mode)
2907   (setq mode-name "Mallow driver")
2908   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2909   (set-syntax-table mallow-driver-mode-syntax-table)
2910   (make-local-variable 'comment-start)
2911   (make-local-variable 'comment-end)
2912   (make-local-variable 'indent-line-function)
2913   (setq indent-line-function 'indent-relative)
2914   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2915   (make-local-variable 'font-lock-defaults)
2916   (make-local-variable 'mallow-driver-mode-keywords)
2917   (let ((keywords
2918          (mdw-regexps "each" "divert" "file" "if"
2919                       "perl" "set" "string" "type" "write")))
2920     (setq mallow-driver-mode-keywords
2921           (list
2922            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2923                  '(0 font-lock-keyword-face))
2924            (list "^%\\s *\\(#.*\\|\\)$"
2925                  '(0 font-lock-comment-face))
2926            (list "^%"
2927                  '(0 font-lock-keyword-face))
2928            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2929            (list "\\${[^}]*}"
2930                  '(0 mallow-driver-substitution-face t)))))
2931   (setq font-lock-defaults
2932         '(mallow-driver-mode-keywords nil nil nil nil))
2933   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2934   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2935   (setq comment-start "%# ")
2936   (setq comment-end "")
2937   (run-hooks 'mallow-driver-mode-hook))
2938
2939 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2940
2941 ;;;--------------------------------------------------------------------------
2942 ;;; NFast debugs.
2943
2944 (defun nfast-debug-mode ()
2945   (interactive)
2946   (fundamental-mode)
2947   (setq major-mode 'nfast-debug-mode)
2948   (setq mode-name "NFast debug")
2949   (setq messages-mode-syntax-table (make-syntax-table))
2950   (set-syntax-table messages-mode-syntax-table)
2951   (make-local-variable 'font-lock-defaults)
2952   (make-local-variable 'nfast-debug-mode-keywords)
2953   (setq truncate-lines t)
2954   (setq nfast-debug-mode-keywords
2955         (list
2956          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2957            (0 font-lock-keyword-face))
2958          (list (concat "^[ \t]+\\(\\("
2959                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2960                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2961                        "[ \t]+\\)*"
2962                        "[0-9a-fA-F]+\\)[ \t]*$")
2963            '(0 mdw-number-face))
2964          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2965            (1 font-lock-keyword-face))
2966          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2967            (1 font-lock-warning-face))
2968          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2969            (1 nil))
2970          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2971                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2972            '(1 font-lock-keyword-face))
2973          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2974          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2975          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2976          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2977   (setq font-lock-defaults
2978         '(nfast-debug-mode-keywords nil nil nil nil))
2979   (run-hooks 'nfast-debug-mode-hook))
2980
2981 ;;;--------------------------------------------------------------------------
2982 ;;; Other languages.
2983
2984 ;; Smalltalk.
2985
2986 (defun mdw-setup-smalltalk ()
2987   (and mdw-auto-indent
2988        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2989   (make-local-variable 'mdw-auto-indent)
2990   (setq mdw-auto-indent nil)
2991   (local-set-key "\C-i" 'smalltalk-reindent))
2992
2993 (defun mdw-fontify-smalltalk ()
2994   (make-local-variable 'font-lock-keywords)
2995   (setq font-lock-keywords
2996         (list
2997          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2998                '(0 font-lock-keyword-face))
2999          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3000                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3001                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3002                '(0 mdw-number-face))
3003          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3004                '(0 mdw-punct-face))))
3005   (mdw-post-config-mode-hack))
3006
3007 ;; Lispy languages.
3008
3009 ;; Unpleasant bodge.
3010 (unless (boundp 'slime-repl-mode-map)
3011   (setq slime-repl-mode-map (make-sparse-keymap)))
3012
3013 (defun mdw-indent-newline-and-indent ()
3014   (interactive)
3015   (indent-for-tab-command)
3016   (newline-and-indent))
3017
3018 (eval-after-load "cl-indent"
3019   '(progn
3020      (mapc #'(lambda (pair)
3021                (put (car pair)
3022                     'common-lisp-indent-function
3023                     (cdr pair)))
3024       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3025         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3026
3027 (defun mdw-common-lisp-indent ()
3028   (make-local-variable 'lisp-indent-function)
3029   (setq lisp-indent-function 'common-lisp-indent-function))
3030
3031 (setq lisp-simple-loop-indentation 2
3032       lisp-loop-keyword-indentation 6
3033       lisp-loop-forms-indentation 6)
3034
3035 (defun mdw-fontify-lispy ()
3036
3037   ;; Set fill prefix.
3038   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3039
3040   ;; Not much fontification needed.
3041   (make-local-variable 'font-lock-keywords)
3042   (setq font-lock-keywords
3043         (list (list (concat "\\("
3044                             "\\_<[-+]?"
3045                             "\\(" "[0-9]+/[0-9]+"
3046                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3047                                         "\\.[0-9]+" "\\)"
3048                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3049                             "\\)"
3050                             "\\|"
3051                             "#"
3052                             "\\(" "x" "[-+]?"
3053                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3054                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3055                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3056                             "\\|" "[0-9]+" "r" "[-+]?"
3057                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3058                             "\\)"
3059                             "\\)\\_>")
3060                     '(0 mdw-number-face))
3061               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3062                     '(0 mdw-punct-face))))
3063
3064   (mdw-post-config-mode-hack))
3065
3066 (defun comint-send-and-indent ()
3067   (interactive)
3068   (comint-send-input)
3069   (and mdw-auto-indent
3070        (indent-for-tab-command)))
3071
3072 (defun mdw-setup-m4 ()
3073
3074   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
3075   ;; annoying: fix it.
3076   (modify-syntax-entry ?{ "(")
3077   (modify-syntax-entry ?} ")")
3078
3079   ;; Fill prefix.
3080   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3081
3082 ;;;--------------------------------------------------------------------------
3083 ;;; Text mode.
3084
3085 (defun mdw-text-mode ()
3086   (setq fill-column 72)
3087   (flyspell-mode t)
3088   (mdw-standard-fill-prefix
3089    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3090   (auto-fill-mode 1))
3091
3092 ;;;--------------------------------------------------------------------------
3093 ;;; Outline and hide/show modes.
3094
3095 (defun mdw-outline-collapse-all ()
3096   "Completely collapse everything in the entire buffer."
3097   (interactive)
3098   (save-excursion
3099     (goto-char (point-min))
3100     (while (< (point) (point-max))
3101       (hide-subtree)
3102       (forward-line))))
3103
3104 (setq hs-hide-comments-when-hiding-all nil)
3105
3106 (defadvice hs-hide-all (after hide-first-comment activate)
3107   (save-excursion (hs-hide-initial-comment-block)))
3108
3109 ;;;--------------------------------------------------------------------------
3110 ;;; Shell mode.
3111
3112 (defun mdw-sh-mode-setup ()
3113   (local-set-key [?\C-a] 'comint-bol)
3114   (add-hook 'comint-output-filter-functions
3115             'comint-watch-for-password-prompt))
3116
3117 (defun mdw-term-mode-setup ()
3118   (setq term-prompt-regexp shell-prompt-pattern)
3119   (make-local-variable 'mouse-yank-at-point)
3120   (make-local-variable 'transient-mark-mode)
3121   (setq mouse-yank-at-point t)
3122   (auto-fill-mode -1)
3123   (setq tab-width 8))
3124
3125 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3126 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3127 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3128 (defun term-send-meta-meta-something ()
3129   (interactive)
3130   (term-send-raw-string "\e\e")
3131   (term-send-raw))
3132 (eval-after-load 'term
3133   '(progn
3134      (define-key term-raw-map [?\e ?\e] nil)
3135      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3136      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3137      (define-key term-raw-map [M-right] 'term-send-meta-right)
3138      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3139      (define-key term-raw-map [M-left] 'term-send-meta-left)
3140      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3141
3142 (defadvice term-exec (before program-args-list compile activate)
3143   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3144 This allows you to pass a list of arguments through `ansi-term'."
3145   (let ((program (ad-get-arg 2)))
3146     (if (listp program)
3147         (progn
3148           (ad-set-arg 2 (car program))
3149           (ad-set-arg 4 (cdr program))))))
3150
3151 (defun ssh (host)
3152   "Open a terminal containing an ssh session to the HOST."
3153   (interactive "sHost: ")
3154   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3155
3156 ;;;--------------------------------------------------------------------------
3157 ;;; Inferior Emacs Lisp.
3158
3159 (setq comint-prompt-read-only t)
3160
3161 (eval-after-load "comint"
3162   '(progn
3163      (define-key comint-mode-map "\C-w" 'comint-kill-region)
3164      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3165
3166 (eval-after-load "ielm"
3167   '(progn
3168      (define-key ielm-map "\C-w" 'comint-kill-region)
3169      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3170
3171 ;;;----- That's all, folks --------------------------------------------------
3172
3173 (provide 'dot-emacs)