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