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