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