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 (eval-after-load "dired"
 994   '(define-key dired-mode-map "X" 'mdw-dired-run))
 995
 996 ;;;--------------------------------------------------------------------------
 997 ;;; URL viewing.
 998
 999 (defun mdw-w3m-browse-url (url &optional new-session-p)
1000   "Invoke w3m on the URL in its current window, or at least a different one.
1001 If NEW-SESSION-P, start a new session."
1002   (interactive "sURL: \nP")
1003   (save-excursion
1004     (let ((window (selected-window)))
1005       (unwind-protect
1006           (progn
1007             (select-window (or (and (not new-session-p)
1008                                     (get-buffer-window "*w3m*"))
1009                                (progn
1010                                  (if (one-window-p t) (split-window))
1011                                  (get-lru-window))))
1012             (w3m-browse-url url new-session-p))
1013         (select-window window)))))
1014
1015 (defvar mdw-good-url-browsers
1016   '(browse-url-chromium
1017     browse-url-mozilla
1018     browse-url-generic
1019     (w3m . mdw-w3m-browse-url)
1020     browse-url-w3)
1021   "List of good browsers for mdw-good-url-browsers.
1022 Each item is a browser function name, or a cons (CHECK . FUNC).
1023 A symbol FOO stands for (FOO . FOO).")
1024
1025 (defun mdw-good-url-browser ()
1026   "Return a good URL browser.
1027 Trundle the list of such things, finding the first item for which
1028 CHECK is fboundp, and returning the correponding FUNC."
1029   (let ((bs mdw-good-url-browsers) b check func answer)
1030     (while (and bs (not answer))
1031       (setq b (car bs)
1032             bs (cdr bs))
1033       (if (consp b)
1034           (setq check (car b) func (cdr b))
1035         (setq check b func b))
1036       (if (fboundp check)
1037           (setq answer func)))
1038     answer))
1039
1040 (eval-after-load "w3m-search"
1041   '(progn
1042      (dolist
1043          (item
1044           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
1045             ("gd" "Google Directory"
1046              "http://www.google.com/search?cat=gwd/Top&q=%s")
1047             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
1048             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
1049             ("gi" "Images" "http://images.google.com/images?q=%s")
1050             ("rfc" "RFC"
1051              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
1052             ("wp" "Wikipedia"
1053              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
1054             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
1055             ("nc-wiki" "nCipher wiki"
1056              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
1057             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
1058             ("lp" "Launchpad bug by number"
1059              "https://bugs.launchpad.net/bugs/%s")
1060             ("lppkg" "Launchpad bugs by package"
1061              "https://bugs.launchpad.net/%s")
1062             ("msdn" "MSDN"
1063              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
1064             ("debbug" "Debian bug by number"
1065              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
1066             ("debbugpkg" "Debian bugs by package"
1067              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
1068             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
1069        (add-to-list 'w3m-search-engine-alist
1070                     (list (cadr item) (caddr item) nil))
1071        (add-to-list 'w3m-uri-replace-alist
1072                     (list (concat "\\`" (car item) ":")
1073                           'w3m-search-uri-replace
1074                           (cadr item))))))
1075
1076 ;;;--------------------------------------------------------------------------
1077 ;;; Paragraph filling.
1078
1079 ;; Useful variables.
1080
1081 (defvar mdw-fill-prefix nil
1082   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
1083 If there's no fill prefix currently set (by the `fill-prefix'
1084 variable) and there's a match from one of the regexps here, it
1085 gets used to set the fill-prefix for the current operation.
1086
1087 The variable is a list of items of the form `REGEXP . PREFIX'; if
1088 the REGEXP matches, the PREFIX is used to set the fill prefix.
1089 It in turn is a list of things:
1090
1091   STRING -- insert a literal string
1092   (match . N) -- insert the thing matched by bracketed subexpression N
1093   (pad . N) -- a string of whitespace the same width as subexpression N
1094   (expr . FORM) -- the result of evaluating FORM")
1095
1096 (make-variable-buffer-local 'mdw-fill-prefix)
1097
1098 (defvar mdw-hanging-indents
1099   (concat "\\(\\("
1100             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
1101             "[ \t]+"
1102           "\\)?\\)")
1103   "*Standard regexp matching parts of a hanging indent.
1104 This is mainly useful in `auto-fill-mode'.")
1105
1106 ;; Utility functions.
1107
1108 (defun mdw-maybe-tabify (s)
1109   "Tabify or untabify the string S, according to `indent-tabs-mode'."
1110   (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
1111     (with-temp-buffer
1112       (save-match-data
1113         (insert s "\n")
1114         (let ((start (point-min)) (end (point-max)))
1115           (funcall tabfun (point-min) (point-max))
1116           (setq s (buffer-substring (point-min) (1- (point-max)))))))))
1117
1118 (defun mdw-examine-fill-prefixes (l)
1119   "Given a list of dynamic fill prefixes, pick one which matches
1120 context and return the static fill prefix to use.  Point must be
1121 at the start of a line, and match data must be saved."
1122   (cond ((not l) nil)
1123         ((looking-at (car (car l)))
1124          (mdw-maybe-tabify (apply #'concat
1125                                   (mapcar #'mdw-do-prefix-match
1126                                           (cdr (car l))))))
1127         (t (mdw-examine-fill-prefixes (cdr l)))))
1128
1129 (defun mdw-maybe-car (p)
1130   "If P is a pair, return (car P), otherwise just return P."
1131   (if (consp p) (car p) p))
1132
1133 (defun mdw-padding (s)
1134   "Return a string the same width as S but made entirely from whitespace."
1135   (let* ((l (length s)) (i 0) (n (make-string l ? )))
1136     (while (< i l)
1137       (if (= 9 (aref s i))
1138           (aset n i 9))
1139       (setq i (1+ i)))
1140     n))
1141
1142 (defun mdw-do-prefix-match (m)
1143   "Expand a dynamic prefix match element.
1144 See `mdw-fill-prefix' for details."
1145   (cond ((not (consp m)) (format "%s" m))
1146         ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
1147         ((eq (car m) 'pad) (mdw-padding (match-string
1148                                          (mdw-maybe-car (cdr m)))))
1149         ((eq (car m) 'eval) (eval (cdr m)))
1150         (t "")))
1151
1152 (defun mdw-choose-dynamic-fill-prefix ()
1153   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
1154   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
1155         ((not mdw-fill-prefix) fill-prefix)
1156         (t (save-excursion
1157              (beginning-of-line)
1158              (save-match-data
1159                (mdw-examine-fill-prefixes mdw-fill-prefix))))))
1160
1161 (defadvice do-auto-fill (around mdw-dynamic-fill-prefix () activate compile)
1162   "Handle auto-filling, working out a dynamic fill prefix in the
1163 case where there isn't a sensible static one."
1164   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1165     ad-do-it))
1166
1167 (defun mdw-fill-paragraph ()
1168   "Fill paragraph, getting a dynamic fill prefix."
1169   (interactive)
1170   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
1171     (fill-paragraph nil)))
1172
1173 (defun mdw-standard-fill-prefix (rx &optional mat)
1174   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
1175 This is just a short-cut for setting the thing by hand, and by
1176 design it doesn't cope with anything approximating a complicated
1177 case."
1178   (setq mdw-fill-prefix
1179         `((,(concat rx mdw-hanging-indents)
1180            (match . 1)
1181            (pad . ,(or mat 2))))))
1182
1183 ;;;--------------------------------------------------------------------------
1184 ;;; Other common declarations.
1185
1186 ;; Common mode settings.
1187
1188 (defvar mdw-auto-indent t
1189   "Whether to indent automatically after a newline.")
1190
1191 (defun mdw-whitespace-mode (&optional arg)
1192   "Turn on/off whitespace mode, but don't highlight trailing space."
1193   (interactive "P")
1194   (when (and (boundp 'whitespace-style)
1195              (fboundp 'whitespace-mode))
1196     (let ((whitespace-style (remove 'trailing whitespace-style)))
1197       (whitespace-mode arg))
1198     (setq show-trailing-whitespace whitespace-mode)))
1199
1200 (defvar mdw-do-misc-mode-hacking nil)
1201
1202 (defun mdw-misc-mode-config ()
1203   (and mdw-auto-indent
1204        (cond ((eq major-mode 'lisp-mode)
1205               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
1206              ((derived-mode-p 'slime-repl-mode 'asm-mode 'comint-mode)
1207               nil)
1208              (t
1209               (local-set-key "\C-m" 'newline-and-indent))))
1210   (set (make-local-variable 'mdw-do-misc-mode-hacking) t)
1211   (local-set-key [C-return] 'newline)
1212   (make-local-variable 'page-delimiter)
1213   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
1214   (setq comment-column 40)
1215   (auto-fill-mode 1)
1216   (setq fill-column mdw-text-width)
1217   (and (fboundp 'gtags-mode)
1218        (gtags-mode))
1219   (if (fboundp 'hs-minor-mode)
1220       (trap (hs-minor-mode t))
1221     (outline-minor-mode t))
1222   (reveal-mode t)
1223   (trap (turn-on-font-lock)))
1224
1225 (defun mdw-post-local-vars-misc-mode-config ()
1226   (setq whitespace-line-column mdw-text-width)
1227   (when (and mdw-do-misc-mode-hacking
1228              (not buffer-read-only))
1229     (setq show-trailing-whitespace t)
1230     (mdw-whitespace-mode 1)))
1231 (add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
1232
1233 (defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
1234   `(progn ,@(mapcar (lambda (func)
1235                       `(defadvice ,func
1236                            (after mdw-angry-fruit-salad activate)
1237                          (when mdw-do-misc-mode-hacking
1238                            (setq show-trailing-whitespace
1239                                  (not buffer-read-only))
1240                            (mdw-whitespace-mode (if buffer-read-only 0 1)))))
1241                     funcs)))
1242 (mdw-advise-update-angry-fruit-salad toggle-read-only
1243                                      read-only-mode
1244                                      view-mode
1245                                      view-mode-enable
1246                                      view-mode-disable)
1247
1248 (eval-after-load 'gtags
1249   '(progn
1250      (dolist (key '([mouse-2] [mouse-3]))
1251        (define-key gtags-mode-map key nil))
1252      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
1253      (define-key gtags-select-mode-map [C-S-mouse-2]
1254        'gtags-select-tag-by-event)
1255      (dolist (map (list gtags-mode-map gtags-select-mode-map))
1256        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
1257
1258 ;; Backup file handling.
1259
1260 (defvar mdw-backup-disable-regexps nil
1261   "*List of regular expressions: if a file name matches any of
1262 these then the file is not backed up.")
1263
1264 (defun mdw-backup-enable-predicate (name)
1265   "[mdw]'s default backup predicate.
1266 Allows a backup if the standard predicate would allow it, and it
1267 doesn't match any of the regular expressions in
1268 `mdw-backup-disable-regexps'."
1269   (and (normal-backup-enable-predicate name)
1270        (let ((answer t) (list mdw-backup-disable-regexps))
1271          (save-match-data
1272            (while list
1273              (if (string-match (car list) name)
1274                  (setq answer nil))
1275              (setq list (cdr list)))
1276            answer))))
1277 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
1278
1279 ;; Frame cleanup.
1280
1281 (defun mdw-last-one-out-turn-off-the-lights (frame)
1282   "Disconnect from an X display if this was the last frame on that display."
1283   (let ((frame-display (frame-parameter frame 'display)))
1284     (when (and frame-display
1285                (eq window-system 'x)
1286                (not (some (lambda (fr)
1287                             (and (not (eq fr frame))
1288                                  (string= (frame-parameter fr 'display)
1289                                           frame-display)))
1290                           (frame-list))))
1291       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
1292 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
1293
1294 ;;;--------------------------------------------------------------------------
1295 ;;; Fullscreen-ness.
1296
1297 (defvar mdw-full-screen-parameters
1298   '((menu-bar-lines . 0)
1299     ;(vertical-scroll-bars . nil)
1300     )
1301   "Frame parameters to set when making a frame fullscreen.")
1302
1303 (defvar mdw-full-screen-save
1304   '(width height)
1305   "Extra frame parameters to save when setting fullscreen.")
1306
1307 (defun mdw-toggle-full-screen (&optional frame)
1308   "Show the FRAME fullscreen."
1309   (interactive)
1310   (when window-system
1311     (cond ((frame-parameter frame 'fullscreen)
1312            (set-frame-parameter frame 'fullscreen nil)
1313            (modify-frame-parameters
1314             nil
1315             (or (frame-parameter frame 'mdw-full-screen-saved)
1316                 (mapcar (lambda (assoc)
1317                           (assq (car assoc) default-frame-alist))
1318                         mdw-full-screen-parameters))))
1319           (t
1320            (let ((saved (mapcar (lambda (param)
1321                                   (cons param (frame-parameter frame param)))
1322                                 (append (mapcar #'car
1323                                                 mdw-full-screen-parameters)
1324                                         mdw-full-screen-save))))
1325              (set-frame-parameter frame 'mdw-full-screen-saved saved))
1326            (modify-frame-parameters frame mdw-full-screen-parameters)
1327            (set-frame-parameter frame 'fullscreen 'fullboth)))))
1328
1329 ;;;--------------------------------------------------------------------------
1330 ;;; General fontification.
1331
1332 (make-face 'mdw-virgin-face)
1333
1334 (defmacro mdw-define-face (name &rest body)
1335   "Define a face, and make sure it's actually set as the definition."
1336   (declare (indent 1)
1337            (debug 0))
1338   `(progn
1339      (copy-face 'mdw-virgin-face ',name)
1340      (defvar ,name ',name)
1341      (put ',name 'face-defface-spec ',body)
1342      (face-spec-set ',name ',body nil)))
1343
1344 (mdw-define-face default
1345   (((type w32)) :family "courier new" :height 85)
1346   (((type x)) :family "6x13" :foundry "trad" :height 130)
1347   (((type color)) :foreground "white" :background "black")
1348   (t nil))
1349 (mdw-define-face fixed-pitch
1350   (((type w32)) :family "courier new" :height 85)
1351   (((type x)) :family "6x13" :foundry "trad" :height 130)
1352   (t :foreground "white" :background "black"))
1353 (if (mdw-emacs-version-p 23)
1354     (mdw-define-face variable-pitch
1355       (((type x)) :family "sans" :height 100))
1356   (mdw-define-face variable-pitch
1357     (((type x)) :family "helvetica" :height 90)))
1358 (mdw-define-face region
1359   (((min-colors 64)) :background "grey30")
1360   (((class color)) :background "blue")
1361   (t :inverse-video t))
1362 (mdw-define-face match
1363   (((class color)) :background "blue")
1364   (t :inverse-video t))
1365 (mdw-define-face mc/cursor-face
1366   (((class color)) :background "red")
1367   (t :inverse-video t))
1368 (mdw-define-face minibuffer-prompt
1369   (t :weight bold))
1370 (mdw-define-face mode-line
1371   (((class color)) :foreground "blue" :background "yellow"
1372                    :box (:line-width 1 :style released-button))
1373   (t :inverse-video t))
1374 (mdw-define-face mode-line-inactive
1375   (((class color)) :foreground "yellow" :background "blue"
1376                    :box (:line-width 1 :style released-button))
1377   (t :inverse-video t))
1378 (mdw-define-face nobreak-space
1379   (((type tty)))
1380   (t :inherit escape-glyph :underline t))
1381 (mdw-define-face scroll-bar
1382   (t :foreground "black" :background "lightgrey"))
1383 (mdw-define-face fringe
1384   (t :foreground "yellow"))
1385 (mdw-define-face show-paren-match
1386   (((min-colors 64)) :background "darkgreen")
1387   (((class color)) :background "green")
1388   (t :underline t))
1389 (mdw-define-face show-paren-mismatch
1390   (((class color)) :background "red")
1391   (t :inverse-video t))
1392 (mdw-define-face highlight
1393   (((min-colors 64)) :background "DarkSeaGreen4")
1394   (((class color)) :background "cyan")
1395   (t :inverse-video t))
1396
1397 (mdw-define-face holiday-face
1398   (t :background "red"))
1399 (mdw-define-face calendar-today-face
1400   (t :foreground "yellow" :weight bold))
1401
1402 (mdw-define-face comint-highlight-prompt
1403   (t :weight bold))
1404 (mdw-define-face comint-highlight-input
1405   (t nil))
1406
1407 (mdw-define-face ido-subdir
1408   (t :foreground "cyan" :weight bold))
1409
1410 (mdw-define-face dired-directory
1411   (t :foreground "cyan" :weight bold))
1412 (mdw-define-face dired-symlink
1413   (t :foreground "cyan"))
1414 (mdw-define-face dired-perm-write
1415   (t nil))
1416
1417 (mdw-define-face trailing-whitespace
1418   (((class color)) :background "red")
1419   (t :inverse-video t))
1420 (mdw-define-face whitespace-line
1421   (((class color)) :background "darkred")
1422   (t :inverse-video t))
1423 (mdw-define-face mdw-punct-face
1424   (((min-colors 64)) :foreground "burlywood2")
1425   (((class color)) :foreground "yellow"))
1426 (mdw-define-face mdw-number-face
1427   (t :foreground "yellow"))
1428 (mdw-define-face mdw-trivial-face)
1429 (mdw-define-face font-lock-function-name-face
1430   (t :slant italic))
1431 (mdw-define-face font-lock-keyword-face
1432   (t :weight bold))
1433 (mdw-define-face font-lock-constant-face
1434   (t :slant italic))
1435 (mdw-define-face font-lock-builtin-face
1436   (t :weight bold))
1437 (mdw-define-face font-lock-type-face
1438   (t :weight bold :slant italic))
1439 (mdw-define-face font-lock-reference-face
1440   (t :weight bold))
1441 (mdw-define-face font-lock-variable-name-face
1442   (t :slant italic))
1443 (mdw-define-face font-lock-comment-delimiter-face
1444   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1445   (((class color)) :foreground "green")
1446   (t :weight bold))
1447 (mdw-define-face font-lock-comment-face
1448   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1449   (((class color)) :foreground "green")
1450   (t :weight bold))
1451 (mdw-define-face font-lock-string-face
1452   (((min-colors 64)) :foreground "SkyBlue1")
1453   (((class color)) :foreground "cyan")
1454   (t :weight bold))
1455
1456 (mdw-define-face message-separator
1457   (t :background "red" :foreground "white" :weight bold))
1458 (mdw-define-face message-cited-text
1459   (default :slant italic)
1460   (((min-colors 64)) :foreground "SkyBlue1")
1461   (((class color)) :foreground "cyan"))
1462 (mdw-define-face message-header-cc
1463   (default :slant italic)
1464   (((min-colors 64)) :foreground "SeaGreen1")
1465   (((class color)) :foreground "green"))
1466 (mdw-define-face message-header-newsgroups
1467   (default :slant italic)
1468   (((min-colors 64)) :foreground "SeaGreen1")
1469   (((class color)) :foreground "green"))
1470 (mdw-define-face message-header-subject
1471   (((min-colors 64)) :foreground "SeaGreen1")
1472   (((class color)) :foreground "green"))
1473 (mdw-define-face message-header-to
1474   (((min-colors 64)) :foreground "SeaGreen1")
1475   (((class color)) :foreground "green"))
1476 (mdw-define-face message-header-xheader
1477   (default :slant italic)
1478   (((min-colors 64)) :foreground "SeaGreen1")
1479   (((class color)) :foreground "green"))
1480 (mdw-define-face message-header-other
1481   (default :slant italic)
1482   (((min-colors 64)) :foreground "SeaGreen1")
1483   (((class color)) :foreground "green"))
1484 (mdw-define-face message-header-name
1485   (default :weight bold)
1486   (((min-colors 64)) :foreground "SeaGreen1")
1487   (((class color)) :foreground "green"))
1488
1489 (mdw-define-face which-func
1490   (t nil))
1491
1492 (mdw-define-face gnus-header-name
1493   (default :weight bold)
1494   (((min-colors 64)) :foreground "SeaGreen1")
1495   (((class color)) :foreground "green"))
1496 (mdw-define-face gnus-header-subject
1497   (((min-colors 64)) :foreground "SeaGreen1")
1498   (((class color)) :foreground "green"))
1499 (mdw-define-face gnus-header-from
1500   (((min-colors 64)) :foreground "SeaGreen1")
1501   (((class color)) :foreground "green"))
1502 (mdw-define-face gnus-header-to
1503   (((min-colors 64)) :foreground "SeaGreen1")
1504   (((class color)) :foreground "green"))
1505 (mdw-define-face gnus-header-content
1506   (default :slant italic)
1507   (((min-colors 64)) :foreground "SeaGreen1")
1508   (((class color)) :foreground "green"))
1509
1510 (mdw-define-face gnus-cite-1
1511   (((min-colors 64)) :foreground "SkyBlue1")
1512   (((class color)) :foreground "cyan"))
1513 (mdw-define-face gnus-cite-2
1514   (((min-colors 64)) :foreground "RoyalBlue2")
1515   (((class color)) :foreground "blue"))
1516 (mdw-define-face gnus-cite-3
1517   (((min-colors 64)) :foreground "MediumOrchid")
1518   (((class color)) :foreground "magenta"))
1519 (mdw-define-face gnus-cite-4
1520   (((min-colors 64)) :foreground "firebrick2")
1521   (((class color)) :foreground "red"))
1522 (mdw-define-face gnus-cite-5
1523   (((min-colors 64)) :foreground "burlywood2")
1524   (((class color)) :foreground "yellow"))
1525 (mdw-define-face gnus-cite-6
1526   (((min-colors 64)) :foreground "SeaGreen1")
1527   (((class color)) :foreground "green"))
1528 (mdw-define-face gnus-cite-7
1529   (((min-colors 64)) :foreground "SlateBlue1")
1530   (((class color)) :foreground "cyan"))
1531 (mdw-define-face gnus-cite-8
1532   (((min-colors 64)) :foreground "RoyalBlue2")
1533   (((class color)) :foreground "blue"))
1534 (mdw-define-face gnus-cite-9
1535   (((min-colors 64)) :foreground "purple2")
1536   (((class color)) :foreground "magenta"))
1537 (mdw-define-face gnus-cite-10
1538   (((min-colors 64)) :foreground "DarkOrange2")
1539   (((class color)) :foreground "red"))
1540 (mdw-define-face gnus-cite-11
1541   (t :foreground "grey"))
1542
1543 (mdw-define-face diff-header
1544   (t nil))
1545 (mdw-define-face diff-index
1546   (t :weight bold))
1547 (mdw-define-face diff-file-header
1548   (t :weight bold))
1549 (mdw-define-face diff-hunk-header
1550   (((min-colors 64)) :foreground "SkyBlue1")
1551   (((class color)) :foreground "cyan"))
1552 (mdw-define-face diff-function
1553   (default :weight bold)
1554   (((min-colors 64)) :foreground "SkyBlue1")
1555   (((class color)) :foreground "cyan"))
1556 (mdw-define-face diff-header
1557   (((min-colors 64)) :background "grey10"))
1558 (mdw-define-face diff-added
1559   (((class color)) :foreground "green"))
1560 (mdw-define-face diff-removed
1561   (((class color)) :foreground "red"))
1562 (mdw-define-face diff-context
1563   (t nil))
1564 (mdw-define-face diff-refine-change
1565   (((min-colors 64)) :background "RoyalBlue4")
1566   (t :underline t))
1567 (mdw-define-face diff-refine-removed
1568   (((min-colors 64)) :background "#500")
1569   (t :underline t))
1570 (mdw-define-face diff-refine-added
1571   (((min-colors 64)) :background "#050")
1572   (t :underline t))
1573
1574 (setq ediff-force-faces t)
1575 (mdw-define-face ediff-current-diff-A
1576   (((min-colors 64)) :background "darkred")
1577   (((class color)) :background "red")
1578   (t :inverse-video t))
1579 (mdw-define-face ediff-fine-diff-A
1580   (((min-colors 64)) :background "red3")
1581   (((class color)) :inverse-video t)
1582   (t :inverse-video nil))
1583 (mdw-define-face ediff-even-diff-A
1584   (((min-colors 64)) :background "#300"))
1585 (mdw-define-face ediff-odd-diff-A
1586   (((min-colors 64)) :background "#300"))
1587 (mdw-define-face ediff-current-diff-B
1588   (((min-colors 64)) :background "darkgreen")
1589   (((class color)) :background "magenta")
1590   (t :inverse-video t))
1591 (mdw-define-face ediff-fine-diff-B
1592   (((min-colors 64)) :background "green4")
1593   (((class color)) :inverse-video t)
1594   (t :inverse-video nil))
1595 (mdw-define-face ediff-even-diff-B
1596   (((min-colors 64)) :background "#020"))
1597 (mdw-define-face ediff-odd-diff-B
1598   (((min-colors 64)) :background "#020"))
1599 (mdw-define-face ediff-current-diff-C
1600   (((min-colors 64)) :background "darkblue")
1601   (((class color)) :background "blue")
1602   (t :inverse-video t))
1603 (mdw-define-face ediff-fine-diff-C
1604   (((min-colors 64)) :background "blue1")
1605   (((class color)) :inverse-video t)
1606   (t :inverse-video nil))
1607 (mdw-define-face ediff-even-diff-C
1608   (((min-colors 64)) :background "#004"))
1609 (mdw-define-face ediff-odd-diff-C
1610   (((min-colors 64)) :background "#004"))
1611 (mdw-define-face ediff-current-diff-Ancestor
1612   (((min-colors 64)) :background "#630")
1613   (((class color)) :background "blue")
1614   (t :inverse-video t))
1615 (mdw-define-face ediff-even-diff-Ancestor
1616   (((min-colors 64)) :background "#320"))
1617 (mdw-define-face ediff-odd-diff-Ancestor
1618   (((min-colors 64)) :background "#320"))
1619
1620 (mdw-define-face magit-hash
1621   (((min-colors 64)) :foreground "grey40")
1622   (((class color)) :foreground "blue"))
1623 (mdw-define-face magit-diff-hunk-heading
1624   (((min-colors 64)) :foreground "grey70" :background "grey25")
1625   (((class color)) :foreground "yellow"))
1626 (mdw-define-face magit-diff-hunk-heading-highlight
1627   (((min-colors 64)) :foreground "grey70" :background "grey35")
1628   (((class color)) :foreground "yellow" :background "blue"))
1629 (mdw-define-face magit-diff-added
1630   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
1631   (((class color)) :foreground "green"))
1632 (mdw-define-face magit-diff-added-highlight
1633   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
1634   (((class color)) :foreground "green" :background "blue"))
1635 (mdw-define-face magit-diff-removed
1636   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
1637   (((class color)) :foreground "red"))
1638 (mdw-define-face magit-diff-removed-highlight
1639   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
1640   (((class color)) :foreground "red" :background "blue"))
1641 (mdw-define-face magit-blame-heading
1642   (((min-colors 64)) :foreground "white" :background "grey25"
1643                      :weight normal :slant normal)
1644   (((class color)) :foreground "white" :background "blue"
1645                    :weight normal :slant normal))
1646 (mdw-define-face magit-blame-name
1647   (t :inherit magit-blame-heading :slant italic))
1648 (mdw-define-face magit-blame-date
1649   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
1650   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
1651 (mdw-define-face magit-blame-summary
1652   (t :inherit magit-blame-heading :weight bold))
1653
1654 (mdw-define-face dylan-header-background
1655   (((min-colors 64)) :background "NavyBlue")
1656   (((class color)) :background "blue"))
1657
1658 (mdw-define-face erc-input-face
1659   (t :foreground "red"))
1660
1661 (mdw-define-face woman-bold
1662   (t :weight bold))
1663 (mdw-define-face woman-italic
1664   (t :slant italic))
1665
1666 (eval-after-load "rst"
1667   '(progn
1668      (mdw-define-face rst-level-1-face
1669        (t :foreground "SkyBlue1" :weight bold))
1670      (mdw-define-face rst-level-2-face
1671        (t :foreground "SeaGreen1" :weight bold))
1672      (mdw-define-face rst-level-3-face
1673        (t :weight bold))
1674      (mdw-define-face rst-level-4-face
1675        (t :slant italic))
1676      (mdw-define-face rst-level-5-face
1677        (t :underline t))
1678      (mdw-define-face rst-level-6-face
1679        ())))
1680
1681 (mdw-define-face p4-depot-added-face
1682   (t :foreground "green"))
1683 (mdw-define-face p4-depot-branch-op-face
1684   (t :foreground "yellow"))
1685 (mdw-define-face p4-depot-deleted-face
1686   (t :foreground "red"))
1687 (mdw-define-face p4-depot-unmapped-face
1688   (t :foreground "SkyBlue1"))
1689 (mdw-define-face p4-diff-change-face
1690   (t :foreground "yellow"))
1691 (mdw-define-face p4-diff-del-face
1692   (t :foreground "red"))
1693 (mdw-define-face p4-diff-file-face
1694   (t :foreground "SkyBlue1"))
1695 (mdw-define-face p4-diff-head-face
1696   (t :background "grey10"))
1697 (mdw-define-face p4-diff-ins-face
1698   (t :foreground "green"))
1699
1700 (mdw-define-face w3m-anchor-face
1701   (t :foreground "SkyBlue1" :underline t))
1702 (mdw-define-face w3m-arrived-anchor-face
1703   (t :foreground "SkyBlue1" :underline t))
1704
1705 (mdw-define-face whizzy-slice-face
1706   (t :background "grey10"))
1707 (mdw-define-face whizzy-error-face
1708   (t :background "darkred"))
1709
1710 ;; Ellipses used to indicate hidden text (and similar).
1711 (mdw-define-face mdw-ellipsis-face
1712   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1713 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1714       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
1715       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1716       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1717   (set-display-table-slot standard-display-table 0 dollar)
1718   (set-display-table-slot standard-display-table 1 backslash)
1719   (set-display-table-slot standard-display-table 4
1720                           (vector dot dot dot))
1721   (set-display-table-slot standard-display-table 5 bar))
1722
1723 ;;;--------------------------------------------------------------------------
1724 ;;; Where is point?
1725
1726 (mdw-define-face mdw-point-overlay-face
1727   (((type graphic)))
1728   (((min-colors 64)) :background "darkblue")
1729   (((class color)) :background "blue")
1730   (((type tty) (class mono)) :inverse-video t))
1731
1732 (defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
1733
1734 (defun mdw-configure-point-overlay ()
1735   (let ((ov (make-overlay 0 0)))
1736     (overlay-put ov 'priority 0)
1737     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
1738            (left (car fringe)) (right (cdr fringe))
1739            (s ""))
1740       (when left
1741         (let ((ss "."))
1742           (put-text-property 0 1 'display `(left-fringe ,left) ss)
1743           (setq s (concat s ss))))
1744       (when right
1745         (let ((ss "."))
1746           (put-text-property 0 1 'display `(right-fringe ,right) ss)
1747           (setq s (concat s ss))))
1748       (when (or left right)
1749         (overlay-put ov 'before-string s)))
1750     (overlay-put ov 'face 'mdw-point-overlay-face)
1751     (delete-overlay ov)
1752     ov))
1753
1754 (defvar mdw-point-overlay (mdw-configure-point-overlay)
1755   "An overlay used for showing where point is in the selected window.")
1756 (defun mdw-reconfigure-point-overlay ()
1757   (interactive)
1758   (setq mdw-point-overlay (mdw-configure-point-overlay)))
1759
1760 (defun mdw-remove-point-overlay ()
1761   "Remove the current-point overlay."
1762   (delete-overlay mdw-point-overlay))
1763
1764 (defun mdw-update-point-overlay ()
1765   "Mark the current point position with an overlay."
1766   (if (not mdw-point-overlay-mode)
1767       (mdw-remove-point-overlay)
1768     (overlay-put mdw-point-overlay 'window (selected-window))
1769     (move-overlay mdw-point-overlay
1770                   (line-beginning-position)
1771                   (+ (line-end-position) 1))))
1772
1773 (defvar mdw-point-overlay-buffers nil
1774   "List of buffers using `mdw-point-overlay-mode'.")
1775
1776 (define-minor-mode mdw-point-overlay-mode
1777   "Indicate current line with an overlay."
1778   :global nil
1779   (let ((buffer (current-buffer)))
1780     (setq mdw-point-overlay-buffers
1781           (mapcan (lambda (buf)
1782                     (if (and (buffer-live-p buf)
1783                              (not (eq buf buffer)))
1784                         (list buf)))
1785                   mdw-point-overlay-buffers))
1786     (if mdw-point-overlay-mode
1787         (setq mdw-point-overlay-buffers
1788               (cons buffer mdw-point-overlay-buffers))))
1789   (cond (mdw-point-overlay-buffers
1790          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
1791          (add-hook 'post-command-hook 'mdw-update-point-overlay))
1792         (t
1793          (mdw-remove-point-overlay)
1794          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
1795          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
1796
1797 (define-globalized-minor-mode mdw-global-point-overlay-mode
1798   mdw-point-overlay-mode
1799   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
1800
1801 ;;;--------------------------------------------------------------------------
1802 ;;; C programming configuration.
1803
1804 ;; Make C indentation nice.
1805
1806 (defun mdw-c-lineup-arglist (langelem)
1807   "Hack for DWIMmery in c-lineup-arglist."
1808   (if (save-excursion
1809         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1810       0
1811     (c-lineup-arglist langelem)))
1812
1813 (defun mdw-c-indent-extern-mumble (langelem)
1814   "Indent `extern \"...\" {' lines."
1815   (save-excursion
1816     (back-to-indentation)
1817     (if (looking-at
1818          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1819         c-basic-offset
1820       nil)))
1821
1822 (defun mdw-c-indent-arglist-nested (langelem)
1823   "Indent continued argument lists.
1824 If we've nested more than one argument list, then only introduce a single
1825 indentation anyway."
1826   (let ((context c-syntactic-context)
1827         (pos (c-langelem-2nd-pos c-syntactic-element))
1828         (should-indent-p t))
1829     (while (and context
1830                 (eq (caar context) 'arglist-cont-nonempty))
1831       (when (and (= (caddr (pop context)) pos)
1832                  context
1833                  (memq (caar context) '(arglist-intro
1834                                         arglist-cont-nonempty)))
1835         (setq should-indent-p nil)))
1836     (if should-indent-p '+ 0)))
1837
1838 (defvar mdw-define-c-styles-hook nil
1839   "Hook run when `cc-mode' starts up to define styles.")
1840
1841 (defmacro mdw-define-c-style (name &rest assocs)
1842   "Define a C style, called NAME (a symbol), setting ASSOCs.
1843 A function, named `mdw-define-c-style/NAME', is defined to actually install
1844 the style using `c-add-style', and added to the hook
1845 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
1846 set."
1847   (declare (indent defun))
1848   (let* ((name-string (symbol-name name))
1849          (func (intern (concat "mdw-define-c-style/" name-string))))
1850     `(progn
1851        (defun ,func () (c-add-style ,name-string ',assocs))
1852        (and (featurep 'cc-mode) (,func))
1853        (add-hook 'mdw-define-c-styles-hook ',func))))
1854
1855 (eval-after-load "cc-mode"
1856   '(run-hooks 'mdw-define-c-styles-hook))
1857
1858 (mdw-define-c-style mdw-trustonic-c
1859   (c-basic-offset . 4)
1860   (comment-column . 0)
1861   (c-indent-comment-alist (anchored-comment . (column . 0))
1862                           (end-block . (space . 1))
1863                           (cpp-end-block . (space . 1))
1864                           (other . (space . 1)))
1865   (c-class-key . "class")
1866   (c-backslash-column . 0)
1867   (c-auto-align-backslashes . nil)
1868   (c-label-minimum-indentation . 0)
1869   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1870                    (defun-open . (add 0 c-indent-one-line-block))
1871                    (arglist-cont-nonempty . mdw-c-indent-arglist-nested)
1872                    (topmost-intro . mdw-c-indent-extern-mumble)
1873                    (cpp-define-intro . 0)
1874                    (knr-argdecl . 0)
1875                    (inextern-lang . [0])
1876                    (label . 0)
1877                    (case-label . +)
1878                    (access-label . -2)
1879                    (inclass . +)
1880                    (inline-open . ++)
1881                    (statement-cont . +)
1882                    (statement-case-intro . +)))
1883
1884 (mdw-define-c-style mdw-c
1885   (c-basic-offset . 2)
1886   (comment-column . 40)
1887   (c-class-key . "class")
1888   (c-backslash-column . 72)
1889   (c-label-minimum-indentation . 0)
1890   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1891                    (defun-open . (add 0 c-indent-one-line-block))
1892                    (arglist-cont-nonempty . mdw-c-lineup-arglist)
1893                    (topmost-intro . mdw-c-indent-extern-mumble)
1894                    (cpp-define-intro . 0)
1895                    (knr-argdecl . 0)
1896                    (inextern-lang . [0])
1897                    (label . 0)
1898                    (case-label . +)
1899                    (access-label . -)
1900                    (inclass . +)
1901                    (inline-open . ++)
1902                    (statement-cont . +)
1903                    (statement-case-intro . +)))
1904
1905 (defun mdw-set-default-c-style (modes style)
1906   "Update the default CC Mode style for MODES to be STYLE.
1907
1908 MODES may be a list of major mode names or a singleton.  STYLE is a style
1909 name, as a symbol."
1910   (let ((modes (if (listp modes) modes (list modes)))
1911         (style (symbol-name style)))
1912     (setq c-default-style
1913           (append (mapcar (lambda (mode)
1914                             (cons mode style))
1915                           modes)
1916                   (remove-if (lambda (assoc)
1917                                (memq (car assoc) modes))
1918                              (if (listp c-default-style)
1919                                  c-default-style
1920                                (list (cons 'other c-default-style))))))))
1921 (setq c-default-style "mdw-c")
1922
1923 (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
1924
1925 (defvar mdw-c-comment-fill-prefix
1926   `((,(concat "\\([ \t]*/?\\)"
1927               "\\(\*\\|//]\\)"
1928               "\\([ \t]*\\)"
1929               "\\([A-Za-z]+:[ \t]*\\)?"
1930               mdw-hanging-indents)
1931      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1932   "Fill prefix matching C comments (both kinds).")
1933
1934 (defun mdw-fontify-c-and-c++ ()
1935
1936   ;; Fiddle with some syntax codes.
1937   (modify-syntax-entry ?* ". 23")
1938   (modify-syntax-entry ?/ ". 124b")
1939   (modify-syntax-entry ?\n "> b")
1940
1941   ;; Other stuff.
1942   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1943
1944   ;; Now define things to be fontified.
1945   (make-local-variable 'font-lock-keywords)
1946   (let ((c-keywords
1947          (mdw-regexps "alignas"          ;C11 macro, C++11
1948                       "alignof"          ;C++11
1949                       "and"              ;C++, C95 macro
1950                       "and_eq"           ;C++, C95 macro
1951                       "asm"              ;K&R, C++, GCC
1952                       "atomic"           ;C11 macro, C++11 template type
1953                       "auto"             ;K&R, C89
1954                       "bitand"           ;C++, C95 macro
1955                       "bitor"            ;C++, C95 macro
1956                       "bool"             ;C++, C99 macro
1957                       "break"            ;K&R, C89
1958                       "case"             ;K&R, C89
1959                       "catch"            ;C++
1960                       "char"             ;K&R, C89
1961                       "char16_t"         ;C++11, C11 library type
1962                       "char32_t"         ;C++11, C11 library type
1963                       "class"            ;C++
1964                       "complex"          ;C99 macro, C++ template type
1965                       "compl"            ;C++, C95 macro
1966                       "const"            ;C89
1967                       "constexpr"        ;C++11
1968                       "const_cast"       ;C++
1969                       "continue"         ;K&R, C89
1970                       "decltype"         ;C++11
1971                       "defined"          ;C89 preprocessor
1972                       "default"          ;K&R, C89
1973                       "delete"           ;C++
1974                       "do"               ;K&R, C89
1975                       "double"           ;K&R, C89
1976                       "dynamic_cast"     ;C++
1977                       "else"             ;K&R, C89
1978                       ;; "entry"         ;K&R -- never used
1979                       "enum"             ;C89
1980                       "explicit"         ;C++
1981                       "export"           ;C++
1982                       "extern"           ;K&R, C89
1983                       "float"            ;K&R, C89
1984                       "for"              ;K&R, C89
1985                       ;; "fortran"       ;K&R
1986                       "friend"           ;C++
1987                       "goto"             ;K&R, C89
1988                       "if"               ;K&R, C89
1989                       "imaginary"        ;C99 macro
1990                       "inline"           ;C++, C99, GCC
1991                       "int"              ;K&R, C89
1992                       "long"             ;K&R, C89
1993                       "mutable"          ;C++
1994                       "namespace"        ;C++
1995                       "new"              ;C++
1996                       "noexcept"         ;C++11
1997                       "noreturn"         ;C11 macro
1998                       "not"              ;C++, C95 macro
1999                       "not_eq"           ;C++, C95 macro
2000                       "nullptr"          ;C++11
2001                       "operator"         ;C++
2002                       "or"               ;C++, C95 macro
2003                       "or_eq"            ;C++, C95 macro
2004                       "private"          ;C++
2005                       "protected"        ;C++
2006                       "public"           ;C++
2007                       "register"         ;K&R, C89
2008                       "reinterpret_cast" ;C++
2009                       "restrict"         ;C99
2010                       "return"           ;K&R, C89
2011                       "short"            ;K&R, C89
2012                       "signed"           ;C89
2013                       "sizeof"           ;K&R, C89
2014                       "static"           ;K&R, C89
2015                       "static_assert"    ;C11 macro, C++11
2016                       "static_cast"      ;C++
2017                       "struct"           ;K&R, C89
2018                       "switch"           ;K&R, C89
2019                       "template"         ;C++
2020                       "throw"            ;C++
2021                       "try"              ;C++
2022                       "thread_local"     ;C11 macro, C++11
2023                       "typedef"          ;C89
2024                       "typeid"           ;C++
2025                       "typeof"           ;GCC
2026                       "typename"         ;C++
2027                       "union"            ;K&R, C89
2028                       "unsigned"         ;K&R, C89
2029                       "using"            ;C++
2030                       "virtual"          ;C++
2031                       "void"             ;C89
2032                       "volatile"         ;C89
2033                       "wchar_t"          ;C++, C89 library type
2034                       "while"            ;K&R, C89
2035                       "xor"              ;C++, C95 macro
2036                       "xor_eq"           ;C++, C95 macro
2037                       "_Alignas"         ;C11
2038                       "_Alignof"         ;C11
2039                       "_Atomic"          ;C11
2040                       "_Bool"            ;C99
2041                       "_Complex"         ;C99
2042                       "_Generic"         ;C11
2043                       "_Imaginary"       ;C99
2044                       "_Noreturn"        ;C11
2045                       "_Pragma"          ;C99 preprocessor
2046                       "_Static_assert"   ;C11
2047                       "_Thread_local"    ;C11
2048                       "__alignof__"      ;GCC
2049                       "__asm__"          ;GCC
2050                       "__attribute__"    ;GCC
2051                       "__complex__"      ;GCC
2052                       "__const__"        ;GCC
2053                       "__extension__"    ;GCC
2054                       "__imag__"         ;GCC
2055                       "__inline__"       ;GCC
2056                       "__label__"        ;GCC
2057                       "__real__"         ;GCC
2058                       "__signed__"       ;GCC
2059                       "__typeof__"       ;GCC
2060                       "__volatile__"     ;GCC
2061                       ))
2062         (c-constants
2063          (mdw-regexps "false"            ;C++, C99 macro
2064                       "this"             ;C++
2065                       "true"             ;C++, C99 macro
2066                       ))
2067         (preprocessor-keywords
2068          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2069                       "ident" "if" "ifdef" "ifndef" "import" "include"
2070                       "line" "pragma" "unassert" "undef" "warning"))
2071         (objc-keywords
2072          (mdw-regexps "class" "defs" "encode" "end" "implementation"
2073                       "interface" "private" "protected" "protocol" "public"
2074                       "selector")))
2075
2076     (setq font-lock-keywords
2077           (list
2078
2079            ;; Fontify include files as strings.
2080            (list (concat "^[ \t]*\\#[ \t]*"
2081                          "\\(include\\|import\\)"
2082                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2083                  '(2 font-lock-string-face))
2084
2085            ;; Preprocessor directives are `references'?.
2086            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2087                          preprocessor-keywords
2088                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
2089                  '(1 font-lock-keyword-face))
2090
2091            ;; Handle the keywords defined above.
2092            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2093                  '(0 font-lock-keyword-face))
2094
2095            (list (concat "\\<\\(" c-keywords "\\)\\>")
2096                  '(0 font-lock-keyword-face))
2097
2098            (list (concat "\\<\\(" c-constants "\\)\\>")
2099                  '(0 font-lock-variable-name-face))
2100
2101            ;; Handle numbers too.
2102            ;;
2103            ;; This looks strange, I know.  It corresponds to the
2104            ;; preprocessor's idea of what a number looks like, rather than
2105            ;; anything sensible.
2106            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2107                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2108                  '(0 mdw-number-face))
2109
2110            ;; And anything else is punctuation.
2111            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2112                  '(0 mdw-punct-face))))))
2113
2114 (define-derived-mode sod-mode c-mode "Sod"
2115   "Major mode for editing Sod code.")
2116 (push '("\\.sod$" . sod-mode) auto-mode-alist)
2117
2118 ;;;--------------------------------------------------------------------------
2119 ;;; AP calc mode.
2120
2121 (define-derived-mode apcalc-mode c-mode "AP Calc"
2122   "Major mode for editing Calc code.")
2123
2124 (defun mdw-fontify-apcalc ()
2125
2126   ;; Fiddle with some syntax codes.
2127   (modify-syntax-entry ?* ". 23")
2128   (modify-syntax-entry ?/ ". 14")
2129
2130   ;; Other stuff.
2131   (setq comment-start "/* ")
2132   (setq comment-end " */")
2133   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2134
2135   ;; Now define things to be fontified.
2136   (make-local-variable 'font-lock-keywords)
2137   (let ((c-keywords
2138          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2139                       "do" "else" "exit" "for" "global" "goto" "help" "if"
2140                       "local" "mat" "obj" "print" "quit" "read" "return"
2141                       "show" "static" "switch" "while" "write")))
2142
2143     (setq font-lock-keywords
2144           (list
2145
2146            ;; Handle the keywords defined above.
2147            (list (concat "\\<\\(" c-keywords "\\)\\>")
2148                  '(0 font-lock-keyword-face))
2149
2150            ;; Handle numbers too.
2151            ;;
2152            ;; This looks strange, I know.  It corresponds to the
2153            ;; preprocessor's idea of what a number looks like, rather than
2154            ;; anything sensible.
2155            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2156                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2157                  '(0 mdw-number-face))
2158
2159            ;; And anything else is punctuation.
2160            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2161                  '(0 mdw-punct-face))))))
2162
2163 ;;;--------------------------------------------------------------------------
2164 ;;; Java programming configuration.
2165
2166 ;; Make indentation nice.
2167
2168 (mdw-define-c-style mdw-java
2169   (c-basic-offset . 2)
2170   (c-backslash-column . 72)
2171   (c-offsets-alist (substatement-open . 0)
2172                    (label . +)
2173                    (case-label . +)
2174                    (access-label . 0)
2175                    (inclass . +)
2176                    (statement-case-intro . +)))
2177 (mdw-set-default-c-style 'java-mode 'mdw-java)
2178
2179 ;; Declare Java fontification style.
2180
2181 (defun mdw-fontify-java ()
2182
2183   ;; Other stuff.
2184   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2185
2186   ;; Now define things to be fontified.
2187   (make-local-variable 'font-lock-keywords)
2188   (let ((java-keywords
2189          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2190                       "char" "class" "const" "continue" "default" "do"
2191                       "double" "else" "extends" "final" "finally" "float"
2192                       "for" "goto" "if" "implements" "import" "instanceof"
2193                       "int" "interface" "long" "native" "new" "package"
2194                       "private" "protected" "public" "return" "short"
2195                       "static" "switch" "synchronized" "throw" "throws"
2196                       "transient" "try" "void" "volatile" "while"))
2197
2198         (java-constants
2199          (mdw-regexps "false" "null" "super" "this" "true")))
2200
2201     (setq font-lock-keywords
2202           (list
2203
2204            ;; Handle the keywords defined above.
2205            (list (concat "\\<\\(" java-keywords "\\)\\>")
2206                  '(0 font-lock-keyword-face))
2207
2208            ;; Handle the magic constants defined above.
2209            (list (concat "\\<\\(" java-constants "\\)\\>")
2210                  '(0 font-lock-variable-name-face))
2211
2212            ;; Handle numbers too.
2213            ;;
2214            ;; The following isn't quite right, but it's close enough.
2215            (list (concat "\\<\\("
2216                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2217                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2218                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2219                          "[lLfFdD]?")
2220                  '(0 mdw-number-face))
2221
2222            ;; And anything else is punctuation.
2223            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2224                  '(0 mdw-punct-face))))))
2225
2226 ;;;--------------------------------------------------------------------------
2227 ;;; Javascript programming configuration.
2228
2229 (defun mdw-javascript-style ()
2230   (setq js-indent-level 2)
2231   (setq js-expr-indent-offset 0))
2232
2233 (defun mdw-fontify-javascript ()
2234
2235   ;; Other stuff.
2236   (mdw-javascript-style)
2237   (setq js-auto-indent-flag t)
2238
2239   ;; Now define things to be fontified.
2240   (make-local-variable 'font-lock-keywords)
2241   (let ((javascript-keywords
2242          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2243                       "char" "class" "const" "continue" "debugger" "default"
2244                       "delete" "do" "double" "else" "enum" "export" "extends"
2245                       "final" "finally" "float" "for" "function" "goto" "if"
2246                       "implements" "import" "in" "instanceof" "int"
2247                       "interface" "let" "long" "native" "new" "package"
2248                       "private" "protected" "public" "return" "short"
2249                       "static" "super" "switch" "synchronized" "throw"
2250                       "throws" "transient" "try" "typeof" "var" "void"
2251                       "volatile" "while" "with" "yield"
2252
2253                       "boolean" "byte" "char" "double" "float" "int" "long"
2254                       "short" "void"))
2255         (javascript-constants
2256          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2257                       "arguments" "this")))
2258
2259     (setq font-lock-keywords
2260           (list
2261
2262            ;; Handle the keywords defined above.
2263            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2264                  '(0 font-lock-keyword-face))
2265
2266            ;; Handle the predefined constants defined above.
2267            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
2268                  '(0 font-lock-variable-name-face))
2269
2270            ;; Handle numbers too.
2271            ;;
2272            ;; The following isn't quite right, but it's close enough.
2273            (list (concat "\\_<\\("
2274                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2275                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2276                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2277                          "[lLfFdD]?")
2278                  '(0 mdw-number-face))
2279
2280            ;; And anything else is punctuation.
2281            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2282                  '(0 mdw-punct-face))))))
2283
2284 ;;;--------------------------------------------------------------------------
2285 ;;; Scala programming configuration.
2286
2287 (defun mdw-fontify-scala ()
2288
2289   ;; Comment filling.
2290   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2291
2292   ;; Define things to be fontified.
2293   (make-local-variable 'font-lock-keywords)
2294   (let ((scala-keywords
2295          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2296                       "extends" "final" "finally" "for" "forSome" "if"
2297                       "implicit" "import" "lazy" "match" "new" "object"
2298                       "override" "package" "private" "protected" "return"
2299                       "sealed" "throw" "trait" "try" "type" "val"
2300                       "var" "while" "with" "yield"))
2301         (scala-constants
2302          (mdw-regexps "false" "null" "super" "this" "true"))
2303         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
2304
2305     (setq font-lock-keywords
2306           (list
2307
2308            ;; Magical identifiers between backticks.
2309            (list (concat "`\\([^`]+\\)`")
2310                  '(1 font-lock-variable-name-face))
2311
2312            ;; Handle the keywords defined above.
2313            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2314                  '(0 font-lock-keyword-face))
2315
2316            ;; Handle the constants defined above.
2317            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2318                  '(0 font-lock-variable-name-face))
2319
2320            ;; Magical identifiers between backticks.
2321            (list (concat "`\\([^`]+\\)`")
2322                  '(1 font-lock-variable-name-face))
2323
2324            ;; Handle numbers too.
2325            ;;
2326            ;; As usual, not quite right.
2327            (list (concat "\\_<\\("
2328                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2329                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2330                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2331                          "[lLfFdD]?")
2332                  '(0 mdw-number-face))
2333
2334            ;; Identifiers with trailing operators.
2335            (list (concat "_\\(" punctuation "\\)+")
2336                  '(0 mdw-trivial-face))
2337
2338            ;; And everything else is punctuation.
2339            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2340                  '(0 mdw-punct-face)))
2341
2342           font-lock-syntactic-keywords
2343           (list
2344
2345            ;; Single quotes around characters.  But not when used to quote
2346            ;; symbol names.  Ugh.
2347            (list (concat "\\('\\)"
2348                          "\\(" "."
2349                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
2350                                "u+" "[0-9a-fA-F]\\{4\\}"
2351                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
2352                          "\\|" "\\\\" "." "\\)"
2353                          "\\('\\)")
2354                  '(1 "\"")
2355                  '(4 "\""))))))
2356
2357 ;;;--------------------------------------------------------------------------
2358 ;;; C# programming configuration.
2359
2360 ;; Make indentation nice.
2361
2362 (mdw-define-c-style mdw-csharp
2363   (c-basic-offset . 2)
2364   (c-backslash-column . 72)
2365   (c-offsets-alist (substatement-open . 0)
2366                    (label . 0)
2367                    (case-label . +)
2368                    (access-label . 0)
2369                    (inclass . +)
2370                    (statement-case-intro . +)))
2371 (mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
2372
2373 ;; Declare C# fontification style.
2374
2375 (defun mdw-fontify-csharp ()
2376
2377   ;; Other stuff.
2378   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2379
2380   ;; Now define things to be fontified.
2381   (make-local-variable 'font-lock-keywords)
2382   (let ((csharp-keywords
2383          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
2384                       "char" "checked" "class" "const" "continue" "decimal"
2385                       "default" "delegate" "do" "double" "else" "enum"
2386                       "event" "explicit" "extern" "finally" "fixed" "float"
2387                       "for" "foreach" "goto" "if" "implicit" "in" "int"
2388                       "interface" "internal" "is" "lock" "long" "namespace"
2389                       "new" "object" "operator" "out" "override" "params"
2390                       "private" "protected" "public" "readonly" "ref"
2391                       "return" "sbyte" "sealed" "short" "sizeof"
2392                       "stackalloc" "static" "string" "struct" "switch"
2393                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
2394                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
2395                       "while" "yield"))
2396
2397         (csharp-constants
2398          (mdw-regexps "base" "false" "null" "this" "true")))
2399
2400     (setq font-lock-keywords
2401           (list
2402
2403            ;; Handle the keywords defined above.
2404            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
2405                  '(0 font-lock-keyword-face))
2406
2407            ;; Handle the magic constants defined above.
2408            (list (concat "\\<\\(" csharp-constants "\\)\\>")
2409                  '(0 font-lock-variable-name-face))
2410
2411            ;; Handle numbers too.
2412            ;;
2413            ;; The following isn't quite right, but it's close enough.
2414            (list (concat "\\<\\("
2415                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2416                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2417                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2418                          "[lLfFdD]?")
2419                  '(0 mdw-number-face))
2420
2421            ;; And anything else is punctuation.
2422            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2423                  '(0 mdw-punct-face))))))
2424
2425 (define-derived-mode csharp-mode java-mode "C#"
2426   "Major mode for editing C# code.")
2427
2428 ;;;--------------------------------------------------------------------------
2429 ;;; F# programming configuration.
2430
2431 (setq fsharp-indent-offset 2)
2432
2433 (defun mdw-fontify-fsharp ()
2434
2435   (let ((punct "=<>+-*/|&%!@?"))
2436     (do ((i 0 (1+ i)))
2437         ((>= i (length punct)))
2438       (modify-syntax-entry (aref punct i) ".")))
2439
2440   (modify-syntax-entry ?_ "_")
2441   (modify-syntax-entry ?( "(")
2442   (modify-syntax-entry ?) ")")
2443
2444   (setq indent-tabs-mode nil)
2445
2446   (let ((fsharp-keywords
2447          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
2448                       "begin" "break"
2449                       "checked" "class" "component" "const" "constraint"
2450                       "constructor" "continue"
2451                       "default" "delegate" "do" "done" "downcast" "downto"
2452                       "eager" "elif" "else" "end" "exception" "extern"
2453                       "finally" "fixed" "for" "fori" "fun" "function"
2454                       "functor"
2455                       "global"
2456                       "if" "in" "include" "inherit" "inline" "interface"
2457                       "internal"
2458                       "lazy" "let"
2459                       "match" "measure" "member" "method" "mixin" "module"
2460                       "mutable"
2461                       "namespace" "new"
2462                       "object" "of" "open" "or" "override"
2463                       "parallel" "params" "private" "process" "protected"
2464                       "public" "pure"
2465                       "rec" "recursive" "return"
2466                       "sealed" "sig" "static" "struct"
2467                       "tailcall" "then" "to" "trait" "try" "type"
2468                       "upcast" "use"
2469                       "val" "virtual" "void" "volatile"
2470                       "when" "while" "with"
2471                       "yield"))
2472
2473         (fsharp-builtins
2474          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
2475                       "base" "false" "null" "true"))
2476
2477         (bang-keywords
2478          (mdw-regexps "do" "let" "return" "use" "yield"))
2479
2480         (preprocessor-keywords
2481          (mdw-regexps "if" "indent" "else" "endif")))
2482
2483     (setq font-lock-keywords
2484           (list (list (concat "\\(^\\|[^\"]\\)"
2485                               "\\(" "(\\*"
2486                                     "[^*]*\\*+"
2487                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
2488                                     ")"
2489                               "\\|"
2490                                     "//.*"
2491                               "\\)")
2492                       '(2 font-lock-comment-face))
2493
2494                 (list (concat "'" "\\("
2495                                     "\\\\"
2496                                     "\\(" "[ntbr'\\]"
2497                                     "\\|" "[0-9][0-9][0-9]"
2498                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
2499                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
2500                                     "\\)"
2501                                   "\\|"
2502                                   "." "\\)" "'"
2503                               "\\|"
2504                               "\"" "[^\"\\]*"
2505                                     "\\(" "\\\\" "\\(.\\|\n\\)"
2506                                           "[^\"\\]*" "\\)*"
2507                               "\\(\"\\|\\'\\)")
2508                       '(0 font-lock-string-face))
2509
2510                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
2511                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
2512                               "\\|"
2513                               "\\_<\\(" fsharp-keywords "\\)\\_>")
2514                       '(0 font-lock-keyword-face))
2515                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
2516                       '(0 font-lock-variable-name-face))
2517
2518                 (list (concat "\\_<"
2519                               "\\(" "0[bB][01]+" "\\|"
2520                                     "0[oO][0-7]+" "\\|"
2521                                     "0[xX][0-9a-fA-F]+" "\\)"
2522                               "\\(" "lf\\|LF" "\\|"
2523                                     "[uU]?[ysnlL]?" "\\)"
2524                               "\\|"
2525                               "\\_<"
2526                               "[0-9]+" "\\("
2527                                 "[mMQRZING]"
2528                                 "\\|"
2529                                 "\\(\\.[0-9]*\\)?"
2530                                 "\\([eE][-+]?[0-9]+\\)?"
2531                                 "[fFmM]?"
2532                                 "\\|"
2533                                 "[uU]?[ysnlL]?"
2534                               "\\)")
2535                       '(0 mdw-number-face))
2536
2537                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2538                       '(0 mdw-punct-face))))))
2539
2540 (defun mdw-fontify-inferior-fsharp ()
2541   (mdw-fontify-fsharp)
2542   (setq font-lock-keywords
2543         (append (list (list "^[#-]" '(0 font-lock-comment-face))
2544                       (list "^>" '(0 font-lock-keyword-face)))
2545                 font-lock-keywords)))
2546
2547 ;;;--------------------------------------------------------------------------
2548 ;;; Go programming configuration.
2549
2550 (defun mdw-fontify-go ()
2551
2552   (make-local-variable 'font-lock-keywords)
2553   (let ((go-keywords
2554          (mdw-regexps "break" "case" "chan" "const" "continue"
2555                       "default" "defer" "else" "fallthrough" "for"
2556                       "func" "go" "goto" "if" "import"
2557                       "interface" "map" "package" "range" "return"
2558                       "select" "struct" "switch" "type" "var"))
2559         (go-intrinsics
2560          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2561                       "float32" "float64" "int" "uint8" "int16" "int32"
2562                       "int64" "rune" "string" "uint" "uint8" "uint16"
2563                       "uint32" "uint64" "uintptr" "void"
2564                       "false" "iota" "nil" "true"
2565                       "init" "main"
2566                       "append" "cap" "copy" "delete" "imag" "len" "make"
2567                       "new" "panic" "real" "recover")))
2568
2569     (setq font-lock-keywords
2570           (list
2571
2572            ;; Handle the keywords defined above.
2573            (list (concat "\\<\\(" go-keywords "\\)\\>")
2574                  '(0 font-lock-keyword-face))
2575            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2576                  '(0 font-lock-variable-name-face))
2577
2578            ;; Strings and characters.
2579            (list (concat "'"
2580                          "\\(" "[^\\']" "\\|"
2581                                "\\\\"
2582                                "\\(" "[abfnrtv\\'\"]" "\\|"
2583                                      "[0-7]\\{3\\}" "\\|"
2584                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2585                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2586                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2587                          "'"
2588                          "\\|"
2589                          "\""
2590                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2591                          "\\(\"\\|$\\)"
2592                          "\\|"
2593                          "`" "[^`]+" "`")
2594                  '(0 font-lock-string-face))
2595
2596            ;; Handle numbers too.
2597            ;;
2598            ;; The following isn't quite right, but it's close enough.
2599            (list (concat "\\<\\("
2600                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2601                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2602                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
2603                  '(0 mdw-number-face))
2604
2605            ;; And anything else is punctuation.
2606            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2607                  '(0 mdw-punct-face))))))
2608
2609 ;;;--------------------------------------------------------------------------
2610 ;;; Rust programming configuration.
2611
2612 (setq-default rust-indent-offset 2)
2613
2614 (defun mdw-self-insert-and-indent (count)
2615   (interactive "p")
2616   (self-insert-command count)
2617   (indent-according-to-mode))
2618
2619 (defun mdw-fontify-rust ()
2620
2621   ;; Hack syntax categories.
2622   (modify-syntax-entry ?= ".")
2623
2624   ;; Fontify keywords and things.
2625   (make-local-variable 'font-lock-keywords)
2626   (let ((rust-keywords
2627          (mdw-regexps "abstract" "alignof" "as"
2628                       "become" "box" "break"
2629                       "const" "continue" "create"
2630                       "do"
2631                       "else" "enum" "extern"
2632                       "false" "final" "fn" "for"
2633                       "if" "impl" "in"
2634                       "let" "loop"
2635                       "macro" "match" "mod" "move" "mut"
2636                       "offsetof" "override"
2637                       "priv" "pub" "pure"
2638                       "ref" "return"
2639                       "self" "sizeof" "static" "struct" "super"
2640                       "true" "trait" "type" "typeof"
2641                       "unsafe" "unsized" "use"
2642                       "virtual"
2643                       "where" "while"
2644                       "yield"))
2645         (rust-builtins
2646          (mdw-regexps "array" "pointer" "slice" "tuple"
2647                       "bool" "true" "false"
2648                       "f32" "f64"
2649                       "i8" "i16" "i32" "i64" "isize"
2650                       "u8" "u16" "u32" "u64" "usize"
2651                       "char" "str")))
2652     (setq font-lock-keywords
2653           (list
2654
2655            ;; Handle the keywords defined above.
2656            (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
2657                  '(0 font-lock-keyword-face))
2658            (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
2659                  '(0 font-lock-variable-name-face))
2660
2661            ;; Handle numbers too.
2662            (list (concat "\\_<\\("
2663                                "[0-9][0-9_]*"
2664                                "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2665                                "\\|" "\\.[0-9_]+"
2666                                "\\)"
2667                                "\\(f32\\|f64\\)?"
2668                          "\\|" "\\(" "[0-9][0-9_]*"
2669                                "\\|" "0x[0-9a-fA-F_]+"
2670                                "\\|" "0o[0-7_]+"
2671                                "\\|" "0b[01_]+"
2672                                "\\)"
2673                                "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
2674                          "\\)\\_>")
2675                  '(0 mdw-number-face))
2676
2677            ;; And anything else is punctuation.
2678            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2679                  '(0 mdw-punct-face)))))
2680
2681   ;; Hack key bindings.
2682   (local-set-key [?{] 'mdw-self-insert-and-indent)
2683   (local-set-key [?}] 'mdw-self-insert-and-indent))
2684
2685 ;;;--------------------------------------------------------------------------
2686 ;;; Awk programming configuration.
2687
2688 ;; Make Awk indentation nice.
2689
2690 (mdw-define-c-style mdw-awk
2691   (c-basic-offset . 2)
2692   (c-offsets-alist (substatement-open . 0)
2693                    (c-backslash-column . 72)
2694                    (statement-cont . 0)
2695                    (statement-case-intro . +)))
2696 (mdw-set-default-c-style 'awk-mode 'mdw-awk)
2697
2698 ;; Declare Awk fontification style.
2699
2700 (defun mdw-fontify-awk ()
2701
2702   ;; Miscellaneous fiddling.
2703   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2704
2705   ;; Now define things to be fontified.
2706   (make-local-variable 'font-lock-keywords)
2707   (let ((c-keywords
2708          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2709                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2710                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2711                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
2712                       "atan2" "break" "close" "continue" "cos" "delete"
2713                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2714                       "function" "gensub" "getline" "gsub" "if" "in"
2715                       "index" "int" "length" "log" "match" "next" "rand"
2716                       "return" "print" "printf" "sin" "split" "sprintf"
2717                       "sqrt" "srand" "strftime" "sub" "substr" "system"
2718                       "systime" "tolower" "toupper" "while")))
2719
2720     (setq font-lock-keywords
2721           (list
2722
2723            ;; Handle the keywords defined above.
2724            (list (concat "\\<\\(" c-keywords "\\)\\>")
2725                  '(0 font-lock-keyword-face))
2726
2727            ;; Handle numbers too.
2728            ;;
2729            ;; The following isn't quite right, but it's close enough.
2730            (list (concat "\\<\\("
2731                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2732                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2733                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2734                          "[uUlL]*")
2735                  '(0 mdw-number-face))
2736
2737            ;; And anything else is punctuation.
2738            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2739                  '(0 mdw-punct-face))))))
2740
2741 ;;;--------------------------------------------------------------------------
2742 ;;; Perl programming style.
2743
2744 ;; Perl indentation style.
2745
2746 (setq perl-indent-level 2)
2747
2748 (setq cperl-indent-level 2)
2749 (setq cperl-continued-statement-offset 2)
2750 (setq cperl-continued-brace-offset 0)
2751 (setq cperl-brace-offset -2)
2752 (setq cperl-brace-imaginary-offset 0)
2753 (setq cperl-label-offset 0)
2754
2755 ;; Define perl fontification style.
2756
2757 (defun mdw-fontify-perl ()
2758
2759   ;; Miscellaneous fiddling.
2760   (modify-syntax-entry ?$ "\\")
2761   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2762   (modify-syntax-entry ?: "." font-lock-syntax-table)
2763   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2764
2765   ;; Now define fontification things.
2766   (make-local-variable 'font-lock-keywords)
2767   (let ((perl-keywords
2768          (mdw-regexps "and"
2769                       "break"
2770                       "cmp" "continue"
2771                       "default" "do"
2772                       "else" "elsif" "eq"
2773                       "for" "foreach"
2774                       "ge" "given" "gt" "goto"
2775                       "if"
2776                       "last" "le" "local" "lt"
2777                       "my"
2778                       "ne" "next"
2779                       "or" "our"
2780                       "package"
2781                       "redo" "require" "return"
2782                       "sub"
2783                       "undef" "unless" "until" "use"
2784                       "when" "while")))
2785
2786     (setq font-lock-keywords
2787           (list
2788
2789            ;; Set up the keywords defined above.
2790            (list (concat "\\<\\(" perl-keywords "\\)\\>")
2791                  '(0 font-lock-keyword-face))
2792
2793            ;; At least numbers are simpler than C.
2794            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2795                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2796                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2797                  '(0 mdw-number-face))
2798
2799            ;; And anything else is punctuation.
2800            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2801                  '(0 mdw-punct-face))))))
2802
2803 (defun perl-number-tests (&optional arg)
2804   "Assign consecutive numbers to lines containing `#t'.  With ARG,
2805 strip numbers instead."
2806   (interactive "P")
2807   (save-excursion
2808     (goto-char (point-min))
2809     (let ((i 0) (fmt (if arg "" " %4d")))
2810       (while (search-forward "#t" nil t)
2811         (delete-region (point) (line-end-position))
2812         (setq i (1+ i))
2813         (insert (format fmt i)))
2814       (goto-char (point-min))
2815       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2816           (replace-match (format "\\1%d" i))))))
2817
2818 ;;;--------------------------------------------------------------------------
2819 ;;; Python programming style.
2820
2821 (defun mdw-fontify-pythonic (keywords)
2822
2823   ;; Miscellaneous fiddling.
2824   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2825   (setq indent-tabs-mode nil)
2826
2827   ;; Now define fontification things.
2828   (make-local-variable 'font-lock-keywords)
2829   (setq font-lock-keywords
2830         (list
2831
2832          ;; Set up the keywords defined above.
2833          (list (concat "\\_<\\(" keywords "\\)\\_>")
2834                '(0 font-lock-keyword-face))
2835
2836          ;; At least numbers are simpler than C.
2837          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2838                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2839                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2840                '(0 mdw-number-face))
2841
2842          ;; And anything else is punctuation.
2843          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2844                '(0 mdw-punct-face)))))
2845
2846 ;; Define Python fontification styles.
2847
2848 (defun mdw-fontify-python ()
2849   (mdw-fontify-pythonic
2850    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2851                 "del" "elif" "else" "except" "exec" "finally" "for"
2852                 "from" "global" "if" "import" "in" "is" "lambda"
2853                 "not" "or" "pass" "print" "raise" "return" "try"
2854                 "while" "with" "yield")))
2855
2856 (defun mdw-fontify-pyrex ()
2857   (mdw-fontify-pythonic
2858    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2859                 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
2860                 "extern" "finally" "for" "from" "global" "if"
2861                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2862                 "property" "raise" "return" "struct" "try" "while" "with"
2863                 "yield")))
2864
2865 (define-derived-mode pyrex-mode python-mode "Pyrex"
2866   "Major mode for editing Pyrex source code")
2867 (setq auto-mode-alist
2868       (append '(("\\.pyx$" . pyrex-mode)
2869                 ("\\.pxd$" . pyrex-mode)
2870                 ("\\.pxi$" . pyrex-mode))
2871               auto-mode-alist))
2872
2873 ;;;--------------------------------------------------------------------------
2874 ;;; Lua programming style.
2875
2876 (setq lua-indent-level 2)
2877
2878 (defun mdw-fontify-lua ()
2879
2880   ;; Miscellaneous fiddling.
2881   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2882
2883   ;; Now define fontification things.
2884   (make-local-variable 'font-lock-keywords)
2885   (let ((lua-keywords
2886          (mdw-regexps "and" "break" "do" "else" "elseif" "end"
2887                       "false" "for" "function" "goto" "if" "in" "local"
2888                       "nil" "not" "or" "repeat" "return" "then" "true"
2889                       "until" "while")))
2890     (setq font-lock-keywords
2891           (list
2892
2893            ;; Set up the keywords defined above.
2894            (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
2895                  '(0 font-lock-keyword-face))
2896
2897            ;; At least numbers are simpler than C.
2898            (list (concat "\\_<\\(" "0[xX]"
2899                                    "\\(" "[0-9a-fA-F]+"
2900                                          "\\(\\.[0-9a-fA-F]*\\)?"
2901                                    "\\|" "\\.[0-9a-fA-F]+"
2902                                    "\\)"
2903                                    "\\([pP][-+]?[0-9]+\\)?"
2904                              "\\|" "\\(" "[0-9]+"
2905                                          "\\(\\.[0-9]*\\)?"
2906                                    "\\|" "\\.[0-9]+"
2907                                    "\\)"
2908                                    "\\([eE][-+]?[0-9]+\\)?"
2909                              "\\)")
2910                  '(0 mdw-number-face))
2911
2912            ;; And anything else is punctuation.
2913            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2914                  '(0 mdw-punct-face))))))
2915
2916 ;;;--------------------------------------------------------------------------
2917 ;;; Icon programming style.
2918
2919 ;; Icon indentation style.
2920
2921 (setq icon-brace-offset 0
2922       icon-continued-brace-offset 0
2923       icon-continued-statement-offset 2
2924       icon-indent-level 2)
2925
2926 ;; Define Icon fontification style.
2927
2928 (defun mdw-fontify-icon ()
2929
2930   ;; Miscellaneous fiddling.
2931   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2932
2933   ;; Now define fontification things.
2934   (make-local-variable 'font-lock-keywords)
2935   (let ((icon-keywords
2936          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2937                       "end" "every" "fail" "global" "if" "initial"
2938                       "invocable" "link" "local" "next" "not" "of"
2939                       "procedure" "record" "repeat" "return" "static"
2940                       "suspend" "then" "to" "until" "while"))
2941         (preprocessor-keywords
2942          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2943                       "include" "line" "undef")))
2944     (setq font-lock-keywords
2945           (list
2946
2947            ;; Set up the keywords defined above.
2948            (list (concat "\\<\\(" icon-keywords "\\)\\>")
2949                  '(0 font-lock-keyword-face))
2950
2951            ;; The things that Icon calls keywords.
2952            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2953
2954            ;; At least numbers are simpler than C.
2955            (list (concat "\\<[0-9]+"
2956                          "\\([rR][0-9a-zA-Z]+\\|"
2957                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2958                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2959                  '(0 mdw-number-face))
2960
2961            ;; Preprocessor.
2962            (list (concat "^[ \t]*$[ \t]*\\<\\("
2963                          preprocessor-keywords
2964                          "\\)\\>")
2965                  '(0 font-lock-keyword-face))
2966
2967            ;; And anything else is punctuation.
2968            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2969                  '(0 mdw-punct-face))))))
2970
2971 ;;;--------------------------------------------------------------------------
2972 ;;; Assembler mode.
2973
2974 (defun mdw-fontify-asm ()
2975   (modify-syntax-entry ?' "\"")
2976   (modify-syntax-entry ?. "w")
2977   (modify-syntax-entry ?\n ">")
2978   (setf fill-prefix nil)
2979   (local-set-key ";" 'self-insert-command)
2980   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2981
2982 (defun mdw-asm-set-comment ()
2983   (modify-syntax-entry ?; "."
2984                        )
2985   (modify-syntax-entry asm-comment-char "<b")
2986   (setq comment-start (string asm-comment-char ? )))
2987 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
2988 (put 'asm-comment-char 'safe-local-variable 'characterp)
2989
2990 ;;;--------------------------------------------------------------------------
2991 ;;; TCL configuration.
2992
2993 (defun mdw-fontify-tcl ()
2994   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2995   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2996   (make-local-variable 'font-lock-keywords)
2997   (setq font-lock-keywords
2998         (list
2999          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3000                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3001                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3002                '(0 mdw-number-face))
3003          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3004                '(0 mdw-punct-face)))))
3005
3006 ;;;--------------------------------------------------------------------------
3007 ;;; Dylan programming configuration.
3008
3009 (defun mdw-fontify-dylan ()
3010
3011   (make-local-variable 'font-lock-keywords)
3012
3013   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
3014   ;; hook, which undoes all of our configuration.
3015   (setq major-mode 'dylan-mode)
3016   (font-lock-set-defaults)
3017
3018   (let* ((word "[-_a-zA-Z!*@<>$%]+")
3019          (dylan-keywords (mdw-regexps
3020
3021                           "C-address" "C-callable-wrapper" "C-function"
3022                           "C-mapped-subtype" "C-pointer-type" "C-struct"
3023                           "C-subtype" "C-union" "C-variable"
3024
3025                           "above" "abstract" "afterwards" "all"
3026                           "begin" "below" "block" "by"
3027                           "case" "class" "cleanup" "constant" "create"
3028                           "define" "domain"
3029                           "else" "elseif" "end" "exception" "export"
3030                           "finally" "for" "from" "function"
3031                           "generic"
3032                           "handler"
3033                           "if" "in" "instance" "interface" "iterate"
3034                           "keyed-by"
3035                           "let" "library" "local"
3036                           "macro" "method" "module"
3037                           "otherwise"
3038                           "profiling"
3039                           "select" "slot" "subclass"
3040                           "table" "then" "to"
3041                           "unless" "until" "use"
3042                           "variable" "virtual"
3043                           "when" "while"))
3044          (sharp-keywords (mdw-regexps
3045                           "all-keys" "key" "next" "rest" "include"
3046                           "t" "f")))
3047     (setq font-lock-keywords
3048           (list (list (concat "\\<\\(" dylan-keywords
3049                               "\\|" "with\\(out\\)?-" word
3050                               "\\)\\>")
3051                       '(0 font-lock-keyword-face))
3052                 (list (concat "\\<" word ":" "\\|"
3053                               "#\\(" sharp-keywords "\\)\\>")
3054                       '(0 font-lock-variable-name-face))
3055                 (list (concat "\\("
3056                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
3057                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
3058                                 "\\|" "/[0-9]+"
3059                               "\\)"
3060                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
3061                               "\\|" "#b[01]+"
3062                               "\\|" "#o[0-7]+"
3063                               "\\|" "#x[0-9a-zA-Z]+"
3064                               "\\)\\>")
3065                       '(0 mdw-number-face))
3066                 (list (concat "\\("
3067                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
3068                               "\\_<[-+*/=<>:&|]+\\_>"
3069                               "\\)")
3070                       '(0 mdw-punct-face))))))
3071
3072 ;;;--------------------------------------------------------------------------
3073 ;;; Algol 68 configuration.
3074
3075 (setq a68-indent-step 2)
3076
3077 (defun mdw-fontify-algol-68 ()
3078
3079   ;; Fix up the syntax table.
3080   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
3081   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
3082     (modify-syntax-entry ch "." a68-mode-syntax-table))
3083
3084   (make-local-variable 'font-lock-keywords)
3085
3086   (let ((not-comment
3087          (let ((word "COMMENT"))
3088            (do ((regexp (concat "[^" (substring word 0 1) "]+")
3089                         (concat regexp "\\|"
3090                                 (substring word 0 i)
3091                                 "[^" (substring word i (1+ i)) "]"))
3092                 (i 1 (1+ i)))
3093                ((>= i (length word)) regexp)))))
3094     (setq font-lock-keywords
3095           (list (list (concat "\\<COMMENT\\>"
3096                               "\\(" not-comment "\\)\\{0,5\\}"
3097                               "\\(\\'\\|\\<COMMENT\\>\\)")
3098                       '(0 font-lock-comment-face))
3099                 (list (concat "\\<CO\\>"
3100                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
3101                               "\\($\\|\\<CO\\>\\)")
3102                       '(0 font-lock-comment-face))
3103                 (list "\\<[A-Z_]+\\>"
3104                       '(0 font-lock-keyword-face))
3105                 (list (concat "\\<"
3106                               "[0-9]+"
3107                               "\\(\\.[0-9]+\\)?"
3108                               "\\([eE][-+]?[0-9]+\\)?"
3109                               "\\>")
3110                       '(0 mdw-number-face))
3111                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
3112                       '(0 mdw-punct-face))))))
3113
3114 ;;;--------------------------------------------------------------------------
3115 ;;; REXX configuration.
3116
3117 (defun mdw-rexx-electric-* ()
3118   (interactive)
3119   (insert ?*)
3120   (rexx-indent-line))
3121
3122 (defun mdw-rexx-indent-newline-indent ()
3123   (interactive)
3124   (rexx-indent-line)
3125   (if abbrev-mode (expand-abbrev))
3126   (newline-and-indent))
3127
3128 (defun mdw-fontify-rexx ()
3129
3130   ;; Various bits of fiddling.
3131   (setq mdw-auto-indent nil)
3132   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
3133   (local-set-key [?*] 'mdw-rexx-electric-*)
3134   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
3135           '(?! ?? ?# ?@ ?$))
3136   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
3137
3138   ;; Set up keywords and things for fontification.
3139   (make-local-variable 'font-lock-keywords-case-fold-search)
3140   (setq font-lock-keywords-case-fold-search t)
3141
3142   (setq rexx-indent 2)
3143   (setq rexx-end-indent rexx-indent)
3144   (setq rexx-cont-indent rexx-indent)
3145
3146   (make-local-variable 'font-lock-keywords)
3147   (let ((rexx-keywords
3148          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
3149                       "else" "end" "engineering" "exit" "expose" "for"
3150                       "forever" "form" "fuzz" "if" "interpret" "iterate"
3151                       "leave" "linein" "name" "nop" "numeric" "off" "on"
3152                       "options" "otherwise" "parse" "procedure" "pull"
3153                       "push" "queue" "return" "say" "select" "signal"
3154                       "scientific" "source" "then" "trace" "to" "until"
3155                       "upper" "value" "var" "version" "when" "while"
3156                       "with"
3157
3158                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
3159                       "center" "center" "charin" "charout" "chars"
3160                       "compare" "condition" "copies" "c2d" "c2x"
3161                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
3162                       "errortext" "format" "fuzz" "insert" "lastpos"
3163                       "left" "length" "lineout" "lines" "max" "min"
3164                       "overlay" "pos" "queued" "random" "reverse" "right"
3165                       "sign" "sourceline" "space" "stream" "strip"
3166                       "substr" "subword" "symbol" "time" "translate"
3167                       "trunc" "value" "verify" "word" "wordindex"
3168                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
3169                       "x2d")))
3170
3171     (setq font-lock-keywords
3172           (list
3173
3174            ;; Set up the keywords defined above.
3175            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
3176                  '(0 font-lock-keyword-face))
3177
3178            ;; Fontify all symbols the same way.
3179            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
3180                          "[A-Za-z0-9.!?_#@$]+\\)")
3181                  '(0 font-lock-variable-name-face))
3182
3183            ;; And everything else is punctuation.
3184            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3185                  '(0 mdw-punct-face))))))
3186
3187 ;;;--------------------------------------------------------------------------
3188 ;;; Standard ML programming style.
3189
3190 (defun mdw-fontify-sml ()
3191
3192   ;; Make underscore an honorary letter.
3193   (modify-syntax-entry ?' "w")
3194
3195   ;; Set fill prefix.
3196   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
3197
3198   ;; Now define fontification things.
3199   (make-local-variable 'font-lock-keywords)
3200   (let ((sml-keywords
3201          (mdw-regexps "abstype" "and" "andalso" "as"
3202                       "case"
3203                       "datatype" "do"
3204                       "else" "end" "eqtype" "exception"
3205                       "fn" "fun" "functor"
3206                       "handle"
3207                       "if" "in" "include" "infix" "infixr"
3208                       "let" "local"
3209                       "nonfix"
3210                       "of" "op" "open" "orelse"
3211                       "raise" "rec"
3212                       "sharing" "sig" "signature" "struct" "structure"
3213                       "then" "type"
3214                       "val"
3215                       "where" "while" "with" "withtype")))
3216
3217     (setq font-lock-keywords
3218           (list
3219
3220            ;; Set up the keywords defined above.
3221            (list (concat "\\<\\(" sml-keywords "\\)\\>")
3222                  '(0 font-lock-keyword-face))
3223
3224            ;; At least numbers are simpler than C.
3225            (list (concat "\\<\\(\\~\\|\\)"
3226                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
3227                                    "[wW][0-9]+\\)\\|"
3228                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
3229                                          "\\([eE]\\(\\~\\|\\)"
3230                                                 "[0-9]+\\|\\)\\)\\)")
3231                  '(0 mdw-number-face))
3232
3233            ;; And anything else is punctuation.
3234            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3235                  '(0 mdw-punct-face))))))
3236
3237 ;;;--------------------------------------------------------------------------
3238 ;;; Haskell configuration.
3239
3240 (defun mdw-fontify-haskell ()
3241
3242   ;; Fiddle with syntax table to get comments right.
3243   (modify-syntax-entry ?' "_")
3244   (modify-syntax-entry ?- ". 12")
3245   (modify-syntax-entry ?\n ">")
3246
3247   ;; Make punctuation be punctuation
3248   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
3249     (do ((i 0 (1+ i)))
3250         ((>= i (length punct)))
3251       (modify-syntax-entry (aref punct i) ".")))
3252
3253   ;; Set fill prefix.
3254   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
3255
3256   ;; Fiddle with fontification.
3257   (make-local-variable 'font-lock-keywords)
3258   (let ((haskell-keywords
3259          (mdw-regexps "as"
3260                       "case" "ccall" "class"
3261                       "data" "default" "deriving" "do"
3262                       "else" "exists"
3263                       "forall" "foreign"
3264                       "hiding"
3265                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
3266                       "let"
3267                       "mdo" "module"
3268                       "newtype"
3269                       "of"
3270                       "proc"
3271                       "qualified"
3272                       "rec"
3273                       "safe" "stdcall"
3274                       "then" "type"
3275                       "unsafe"
3276                       "where"))
3277         (control-sequences
3278          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
3279                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
3280                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
3281                       "SP" "STX" "SUB" "SYN" "US" "VT")))
3282
3283     (setq font-lock-keywords
3284           (list
3285            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
3286                               "\\(-+}\\|-*\\'\\)"
3287                          "\\|"
3288                          "--.*$")
3289                  '(0 font-lock-comment-face))
3290            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
3291                  '(0 font-lock-keyword-face))
3292            (list (concat "'\\("
3293                          "[^\\]"
3294                          "\\|"
3295                          "\\\\"
3296                          "\\(" "[abfnrtv\\\"']" "\\|"
3297                                "^" "\\(" control-sequences "\\|"
3298                                          "[]A-Z@[\\^_]" "\\)" "\\|"
3299                                "\\|"
3300                                "[0-9]+" "\\|"
3301                                "[oO][0-7]+" "\\|"
3302                                "[xX][0-9A-Fa-f]+"
3303                          "\\)"
3304                          "\\)'")
3305                  '(0 font-lock-string-face))
3306            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
3307                  '(0 font-lock-variable-name-face))
3308            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
3309                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
3310                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
3311                  '(0 mdw-number-face))
3312            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3313                  '(0 mdw-punct-face))))))
3314
3315 ;;;--------------------------------------------------------------------------
3316 ;;; Erlang configuration.
3317
3318 (setq erlang-electric-commands nil)
3319
3320 (defun mdw-fontify-erlang ()
3321
3322   ;; Set fill prefix.
3323   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
3324
3325   ;; Fiddle with fontification.
3326   (make-local-variable 'font-lock-keywords)
3327   (let ((erlang-keywords
3328          (mdw-regexps "after" "and" "andalso"
3329                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
3330                       "case" "catch" "cond"
3331                       "div" "end" "fun" "if" "let" "not"
3332                       "of" "or" "orelse"
3333                       "query" "receive" "rem" "try" "when" "xor")))
3334
3335     (setq font-lock-keywords
3336           (list
3337            (list "%.*$"
3338                  '(0 font-lock-comment-face))
3339            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
3340                  '(0 font-lock-keyword-face))
3341            (list (concat "^-\\sw+\\>")
3342                  '(0 font-lock-keyword-face))
3343            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
3344                  '(0 mdw-number-face))
3345            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3346                  '(0 mdw-punct-face))))))
3347
3348 ;;;--------------------------------------------------------------------------
3349 ;;; Texinfo configuration.
3350
3351 (defun mdw-fontify-texinfo ()
3352
3353   ;; Set fill prefix.
3354   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
3355
3356   ;; Real fontification things.
3357   (make-local-variable 'font-lock-keywords)
3358   (setq font-lock-keywords
3359         (list
3360
3361          ;; Environment names are keywords.
3362          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
3363                '(2 font-lock-keyword-face))
3364
3365          ;; Unmark escaped magic characters.
3366          (list "\\(@\\)\\([@{}]\\)"
3367                '(1 font-lock-keyword-face)
3368                '(2 font-lock-variable-name-face))
3369
3370          ;; Make sure we get comments properly.
3371          (list "@c\\(\\|omment\\)\\( .*\\)?$"
3372                '(0 font-lock-comment-face))
3373
3374          ;; Command names are keywords.
3375          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3376                '(0 font-lock-keyword-face))
3377
3378          ;; Fontify TeX special characters as punctuation.
3379          (list "[{}]+"
3380                '(0 mdw-punct-face)))))
3381
3382 ;;;--------------------------------------------------------------------------
3383 ;;; TeX and LaTeX configuration.
3384
3385 (defun mdw-fontify-tex ()
3386   (setq ispell-parser 'tex)
3387   (turn-on-reftex)
3388
3389   ;; Don't make maths into a string.
3390   (modify-syntax-entry ?$ ".")
3391   (modify-syntax-entry ?$ "." font-lock-syntax-table)
3392   (local-set-key [?$] 'self-insert-command)
3393
3394   ;; Make `tab' be useful, given that tab stops in TeX don't work well.
3395   (local-set-key "\C-\M-i" 'indent-relative)
3396   (setq indent-tabs-mode nil)
3397
3398   ;; Set fill prefix.
3399   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
3400
3401   ;; Real fontification things.
3402   (make-local-variable 'font-lock-keywords)
3403   (setq font-lock-keywords
3404         (list
3405
3406          ;; Environment names are keywords.
3407          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
3408                        "{\\([^}\n]*\\)}")
3409                '(2 font-lock-keyword-face))
3410
3411          ;; Suspended environment names are keywords too.
3412          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
3413                        "{\\([^}\n]*\\)}")
3414                '(3 font-lock-keyword-face))
3415
3416          ;; Command names are keywords.
3417          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3418                '(0 font-lock-keyword-face))
3419
3420          ;; Handle @/.../ for italics.
3421          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
3422          ;;       '(1 font-lock-keyword-face)
3423          ;;       '(3 font-lock-keyword-face))
3424
3425          ;; Handle @*...* for boldness.
3426          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
3427          ;;       '(1 font-lock-keyword-face)
3428          ;;       '(3 font-lock-keyword-face))
3429
3430          ;; Handle @`...' for literal syntax things.
3431          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
3432          ;;       '(1 font-lock-keyword-face)
3433          ;;       '(3 font-lock-keyword-face))
3434
3435          ;; Handle @<...> for nonterminals.
3436          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
3437          ;;       '(1 font-lock-keyword-face)
3438          ;;       '(3 font-lock-keyword-face))
3439
3440          ;; Handle other @-commands.
3441          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
3442          ;;       '(0 font-lock-keyword-face))
3443
3444          ;; Make sure we get comments properly.
3445          (list "%.*"
3446                '(0 font-lock-comment-face))
3447
3448          ;; Fontify TeX special characters as punctuation.
3449          (list "[$^_{}#&]"
3450                '(0 mdw-punct-face)))))
3451
3452 (eval-after-load 'font-latex
3453   '(defun font-latex-jit-lock-force-redisplay (buf start end)
3454      "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
3455      ;; The following block is an expansion of `jit-lock-force-redisplay'
3456      ;; and involved macros taken from CVS Emacs on 2007-04-28.
3457      (with-current-buffer buf
3458        (let ((modified (buffer-modified-p)))
3459          (unwind-protect
3460              (let ((buffer-undo-list t)
3461                    (inhibit-read-only t)
3462                    (inhibit-point-motion-hooks t)
3463                    (inhibit-modification-hooks t)
3464                    deactivate-mark
3465                    buffer-file-name
3466                    buffer-file-truename)
3467                (put-text-property start end 'fontified t))
3468            (unless modified
3469              (restore-buffer-modified-p nil)))))))
3470
3471 (setq LaTeX-syntactic-comments nil
3472       LaTeX-fill-break-at-separators '(\\\[))
3473
3474 ;;;--------------------------------------------------------------------------
3475 ;;; SGML hacking.
3476
3477 (defun mdw-sgml-mode ()
3478   (interactive)
3479   (sgml-mode)
3480   (mdw-standard-fill-prefix "")
3481   (make-local-variable 'sgml-delimiters)
3482   (setq sgml-delimiters
3483         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
3484           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
3485           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
3486           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
3487           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
3488           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
3489           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
3490           "NULL" ""))
3491   (setq major-mode 'mdw-sgml-mode)
3492   (setq mode-name "[mdw] SGML")
3493   (run-hooks 'mdw-sgml-mode-hook))
3494
3495 ;;;--------------------------------------------------------------------------
3496 ;;; Configuration files.
3497
3498 (defvar mdw-conf-quote-normal nil
3499   "*Control syntax category of quote characters `\"' and `''.
3500 If this is `t', consider quote characters to be normal
3501 punctuation, as for `conf-quote-normal'.  If this is `nil' then
3502 leave quote characters as quotes.  If this is a list, then
3503 consider the quote characters in the list to be normal
3504 punctuation.  If this is a single quote character, then consider
3505 that character only to be normal punctuation.")
3506 (defun mdw-conf-quote-normal-acceptable-value-p (value)
3507   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
3508   (or (booleanp value)
3509       (every (lambda (v) (memq v '(?\" ?')))
3510              (if (listp value) value (list value)))))
3511 (put 'mdw-conf-quote-normal 'safe-local-variable
3512      'mdw-conf-quote-normal-acceptable-value-p)
3513
3514 (defun mdw-fix-up-quote ()
3515   "Apply the setting of `mdw-conf-quote-normal'."
3516   (let ((flag mdw-conf-quote-normal))
3517     (cond ((eq flag t)
3518            (conf-quote-normal t))
3519           ((not flag)
3520            nil)
3521           (t
3522            (let ((table (copy-syntax-table (syntax-table))))
3523              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
3524                    (if (listp flag) flag (list flag)))
3525              (set-syntax-table table)
3526              (and font-lock-mode (font-lock-fontify-buffer)))))))
3527 (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
3528
3529 ;;;--------------------------------------------------------------------------
3530 ;;; Shell scripts.
3531
3532 (defun mdw-setup-sh-script-mode ()
3533
3534   ;; Fetch the shell interpreter's name.
3535   (let ((shell-name sh-shell-file))
3536
3537     ;; Try reading the hash-bang line.
3538     (save-excursion
3539       (goto-char (point-min))
3540       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
3541           (setq shell-name (match-string 1))))
3542
3543     ;; Now try to set the shell.
3544     ;;
3545     ;; Don't let `sh-set-shell' bugger up my script.
3546     (let ((executable-set-magic #'(lambda (s &rest r) s)))
3547       (sh-set-shell shell-name)))
3548
3549   ;; Don't insert here-document scaffolding automatically.
3550   (local-set-key "<" 'self-insert-command)
3551
3552   ;; Now enable my keys and the fontification.
3553   (mdw-misc-mode-config)
3554
3555   ;; Set the indentation level correctly.
3556   (setq sh-indentation 2)
3557   (setq sh-basic-offset 2))
3558
3559 (setq sh-shell-file "/bin/sh")
3560
3561 ;; Awful hacking to override the shell detection for particular scripts.
3562 (defmacro define-custom-shell-mode (name shell)
3563   `(defun ,name ()
3564      (interactive)
3565      (set (make-local-variable 'sh-shell-file) ,shell)
3566      (sh-mode)))
3567 (define-custom-shell-mode bash-mode "/bin/bash")
3568 (define-custom-shell-mode rc-mode "/usr/bin/rc")
3569 (put 'sh-shell-file 'permanent-local t)
3570
3571 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
3572 (eval-after-load "sh-script"
3573   '(or (assq 'rc sh-mode-syntax-table-input)
3574        (let ((frag '(nil
3575                      ?# "<"
3576                      ?\n ">#"
3577                      ?\" "\"\""
3578                      ?\' "\"\'"
3579                      ?$ "'"
3580                      ?\` "."
3581                      ?! "_"
3582                      ?% "_"
3583                      ?. "_"
3584                      ?^ "_"
3585                      ?~ "_"
3586                      ?, "_"
3587                      ?= "."
3588                      ?< "."
3589                      ?> "."))
3590              (assoc (assq 'rc sh-mode-syntax-table-input)))
3591          (if assoc
3592              (rplacd assoc frag)
3593            (setq sh-mode-syntax-table-input
3594                  (cons (cons 'rc frag)
3595                        sh-mode-syntax-table-input))))))
3596
3597 ;;;--------------------------------------------------------------------------
3598 ;;; Emacs shell mode.
3599
3600 (defun mdw-eshell-prompt ()
3601   (let ((left "[") (right "]"))
3602     (when (= (user-uid) 0)
3603       (setq left "«" right "»"))
3604     (concat left
3605             (save-match-data
3606               (replace-regexp-in-string "\\..*$" "" (system-name)))
3607             " "
3608             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
3609                    (home (expand-file-name "~")) (nhome (length home)))
3610               (if (and (>= npwd nhome)
3611                        (or (= nhome npwd)
3612                            (= (elt pwd nhome) ?/))
3613                        (string= (substring pwd 0 nhome) home))
3614                   (concat "~" (substring pwd (length home)))
3615                 pwd))
3616             right)))
3617 (setq eshell-prompt-function 'mdw-eshell-prompt)
3618 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
3619
3620 (defun eshell/e (file) (find-file file) nil)
3621 (defun eshell/ee (file) (find-file-other-window file) nil)
3622 (defun eshell/w3m (url) (w3m-goto-url url) nil)
3623
3624 (mdw-define-face eshell-prompt (t :weight bold))
3625 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
3626 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
3627 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
3628 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
3629 (mdw-define-face eshell-ls-executable (t :weight bold))
3630 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
3631 (mdw-define-face eshell-ls-readonly (t nil))
3632 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
3633
3634 (defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
3635 (add-hook 'eshell-mode-hook 'mdw-eshell-hack)
3636
3637 ;;;--------------------------------------------------------------------------
3638 ;;; Messages-file mode.
3639
3640 (defun messages-mode-guts ()
3641   (setq messages-mode-syntax-table (make-syntax-table))
3642   (set-syntax-table messages-mode-syntax-table)
3643   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
3644   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
3645   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
3646   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
3647   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
3648   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
3649   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
3650   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
3651   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
3652   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
3653   (make-local-variable 'comment-start)
3654   (make-local-variable 'comment-end)
3655   (make-local-variable 'indent-line-function)
3656   (setq indent-line-function 'indent-relative)
3657   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3658   (make-local-variable 'font-lock-defaults)
3659   (make-local-variable 'messages-mode-keywords)
3660   (let ((keywords
3661          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
3662                       "export" "enum" "fixed-octetstring" "flags"
3663                       "harmless" "map" "nested" "optional"
3664                       "optional-tagged" "package" "primitive"
3665                       "primitive-nullfree" "relaxed[ \t]+enum"
3666                       "set" "table" "tagged-optional"   "union"
3667                       "variadic" "vector" "version" "version-tag")))
3668     (setq messages-mode-keywords
3669           (list
3670            (list (concat "\\<\\(" keywords "\\)\\>:")
3671                  '(0 font-lock-keyword-face))
3672            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
3673            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
3674              (0 font-lock-variable-name-face))
3675            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
3676            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3677              (0 mdw-punct-face)))))
3678   (setq font-lock-defaults
3679         '(messages-mode-keywords nil nil nil nil))
3680   (run-hooks 'messages-file-hook))
3681
3682 (defun messages-mode ()
3683   (interactive)
3684   (fundamental-mode)
3685   (setq major-mode 'messages-mode)
3686   (setq mode-name "Messages")
3687   (messages-mode-guts)
3688   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3689   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3690   (setq comment-start "# ")
3691   (setq comment-end "")
3692   (run-hooks 'messages-mode-hook))
3693
3694 (defun cpp-messages-mode ()
3695   (interactive)
3696   (fundamental-mode)
3697   (setq major-mode 'cpp-messages-mode)
3698   (setq mode-name "CPP Messages")
3699   (messages-mode-guts)
3700   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3701   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3702   (setq comment-start "/* ")
3703   (setq comment-end " */")
3704   (let ((preprocessor-keywords
3705          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3706                       "ident" "if" "ifdef" "ifndef" "import" "include"
3707                       "line" "pragma" "unassert" "undef" "warning")))
3708     (setq messages-mode-keywords
3709           (append (list (list (concat "^[ \t]*\\#[ \t]*"
3710                                       "\\(include\\|import\\)"
3711                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3712                               '(2 font-lock-string-face))
3713                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3714                                       preprocessor-keywords
3715                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
3716                               '(1 font-lock-keyword-face)))
3717                   messages-mode-keywords)))
3718   (run-hooks 'cpp-messages-mode-hook))
3719
3720 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3721 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
3722 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3723
3724 ;;;--------------------------------------------------------------------------
3725 ;;; Messages-file mode.
3726
3727 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3728   "Face to use for subsittution directives.")
3729 (make-face 'mallow-driver-substitution-face)
3730 (defvar mallow-driver-text-face 'mallow-driver-text-face
3731   "Face to use for body text.")
3732 (make-face 'mallow-driver-text-face)
3733
3734 (defun mallow-driver-mode ()
3735   (interactive)
3736   (fundamental-mode)
3737   (setq major-mode 'mallow-driver-mode)
3738   (setq mode-name "Mallow driver")
3739   (setq mallow-driver-mode-syntax-table (make-syntax-table))
3740   (set-syntax-table mallow-driver-mode-syntax-table)
3741   (make-local-variable 'comment-start)
3742   (make-local-variable 'comment-end)
3743   (make-local-variable 'indent-line-function)
3744   (setq indent-line-function 'indent-relative)
3745   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3746   (make-local-variable 'font-lock-defaults)
3747   (make-local-variable 'mallow-driver-mode-keywords)
3748   (let ((keywords
3749          (mdw-regexps "each" "divert" "file" "if"
3750                       "perl" "set" "string" "type" "write")))
3751     (setq mallow-driver-mode-keywords
3752           (list
3753            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3754                  '(0 font-lock-keyword-face))
3755            (list "^%\\s *\\(#.*\\|\\)$"
3756                  '(0 font-lock-comment-face))
3757            (list "^%"
3758                  '(0 font-lock-keyword-face))
3759            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3760            (list "\\${[^}]*}"
3761                  '(0 mallow-driver-substitution-face t)))))
3762   (setq font-lock-defaults
3763         '(mallow-driver-mode-keywords nil nil nil nil))
3764   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3765   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3766   (setq comment-start "%# ")
3767   (setq comment-end "")
3768   (run-hooks 'mallow-driver-mode-hook))
3769
3770 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3771
3772 ;;;--------------------------------------------------------------------------
3773 ;;; NFast debugs.
3774
3775 (defun nfast-debug-mode ()
3776   (interactive)
3777   (fundamental-mode)
3778   (setq major-mode 'nfast-debug-mode)
3779   (setq mode-name "NFast debug")
3780   (setq messages-mode-syntax-table (make-syntax-table))
3781   (set-syntax-table messages-mode-syntax-table)
3782   (make-local-variable 'font-lock-defaults)
3783   (make-local-variable 'nfast-debug-mode-keywords)
3784   (setq truncate-lines t)
3785   (setq nfast-debug-mode-keywords
3786         (list
3787          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3788            (0 font-lock-keyword-face))
3789          (list (concat "^[ \t]+\\(\\("
3790                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3791                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3792                        "[ \t]+\\)*"
3793                        "[0-9a-fA-F]+\\)[ \t]*$")
3794            '(0 mdw-number-face))
3795          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3796            (1 font-lock-keyword-face))
3797          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3798            (1 font-lock-warning-face))
3799          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3800            (1 nil))
3801          (list (concat "^[ \t]+\\.cmd=[ \t]+"
3802                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3803            '(1 font-lock-keyword-face))
3804          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3805          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3806          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3807          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3808   (setq font-lock-defaults
3809         '(nfast-debug-mode-keywords nil nil nil nil))
3810   (run-hooks 'nfast-debug-mode-hook))
3811
3812 ;;;--------------------------------------------------------------------------
3813 ;;; Other languages.
3814
3815 ;; Smalltalk.
3816
3817 (defun mdw-setup-smalltalk ()
3818   (and mdw-auto-indent
3819        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3820   (make-local-variable 'mdw-auto-indent)
3821   (setq mdw-auto-indent nil)
3822   (local-set-key "\C-i" 'smalltalk-reindent))
3823
3824 (defun mdw-fontify-smalltalk ()
3825   (make-local-variable 'font-lock-keywords)
3826   (setq font-lock-keywords
3827         (list
3828          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3829                '(0 font-lock-keyword-face))
3830          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3831                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3832                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3833                '(0 mdw-number-face))
3834          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3835                '(0 mdw-punct-face)))))
3836
3837 ;; Lispy languages.
3838
3839 ;; Unpleasant bodge.
3840 (unless (boundp 'slime-repl-mode-map)
3841   (setq slime-repl-mode-map (make-sparse-keymap)))
3842
3843 (defun mdw-indent-newline-and-indent ()
3844   (interactive)
3845   (indent-for-tab-command)
3846   (newline-and-indent))
3847
3848 (eval-after-load "cl-indent"
3849   '(progn
3850      (mapc #'(lambda (pair)
3851                (put (car pair)
3852                     'common-lisp-indent-function
3853                     (cdr pair)))
3854       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3855         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3856
3857 (defun mdw-common-lisp-indent ()
3858   (make-local-variable 'lisp-indent-function)
3859   (setq lisp-indent-function 'common-lisp-indent-function))
3860
3861 (setq lisp-simple-loop-indentation 2
3862       lisp-loop-keyword-indentation 6
3863       lisp-loop-forms-indentation 6)
3864
3865 (defun mdw-fontify-lispy ()
3866
3867   ;; Set fill prefix.
3868   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3869
3870   ;; Not much fontification needed.
3871   (make-local-variable 'font-lock-keywords)
3872   (setq font-lock-keywords
3873         (list (list (concat "\\("
3874                             "\\_<[-+]?"
3875                             "\\(" "[0-9]+/[0-9]+"
3876                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3877                                         "\\.[0-9]+" "\\)"
3878                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3879                             "\\)"
3880                             "\\|"
3881                             "#"
3882                             "\\(" "x" "[-+]?"
3883                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3884                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3885                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3886                             "\\|" "[0-9]+" "r" "[-+]?"
3887                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3888                             "\\)"
3889                             "\\)\\_>")
3890                     '(0 mdw-number-face))
3891               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3892                     '(0 mdw-punct-face)))))
3893
3894 (defun comint-send-and-indent ()
3895   (interactive)
3896   (comint-send-input)
3897   (and mdw-auto-indent
3898        (indent-for-tab-command)))
3899
3900 (defadvice comint-line-beginning-position
3901     (around mdw-calculate-it-properly () activate compile)
3902   "Calculate the actual line start for multi-line input."
3903   (if (or comint-use-prompt-regexp
3904           (eq (field-at-pos (point)) 'output))
3905       ad-do-it
3906     (setq ad-return-value
3907           (constrain-to-field (line-beginning-position) (point)))))
3908
3909 (defun mdw-setup-m4 ()
3910
3911   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
3912   ;; annoying: fix it.
3913   (modify-syntax-entry ?{ "(")
3914   (modify-syntax-entry ?} ")")
3915
3916   ;; Fill prefix.
3917   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3918
3919 ;;;--------------------------------------------------------------------------
3920 ;;; Text mode.
3921
3922 (defun mdw-text-mode ()
3923   (setq fill-column 72)
3924   (flyspell-mode t)
3925   (mdw-standard-fill-prefix
3926    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3927   (auto-fill-mode 1))
3928
3929 (eval-after-load "flyspell"
3930   '(define-key flyspell-mode-map "\C-\M-i" nil))
3931
3932 ;;;--------------------------------------------------------------------------
3933 ;;; Outline and hide/show modes.
3934
3935 (defun mdw-outline-collapse-all ()
3936   "Completely collapse everything in the entire buffer."
3937   (interactive)
3938   (save-excursion
3939     (goto-char (point-min))
3940     (while (< (point) (point-max))
3941       (hide-subtree)
3942       (forward-line))))
3943
3944 (setq hs-hide-comments-when-hiding-all nil)
3945
3946 (defadvice hs-hide-all (after hide-first-comment activate)
3947   (save-excursion (hs-hide-initial-comment-block)))
3948
3949 ;;;--------------------------------------------------------------------------
3950 ;;; Shell mode.
3951
3952 (defun mdw-sh-mode-setup ()
3953   (local-set-key [?\C-a] 'comint-bol)
3954   (add-hook 'comint-output-filter-functions
3955             'comint-watch-for-password-prompt))
3956
3957 (defun mdw-term-mode-setup ()
3958   (setq term-prompt-regexp shell-prompt-pattern)
3959   (make-local-variable 'mouse-yank-at-point)
3960   (make-local-variable 'transient-mark-mode)
3961   (setq mouse-yank-at-point t)
3962   (auto-fill-mode -1)
3963   (setq tab-width 8))
3964
3965 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3966 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3967 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3968 (defun term-send-meta-meta-something ()
3969   (interactive)
3970   (term-send-raw-string "\e\e")
3971   (term-send-raw))
3972 (eval-after-load 'term
3973   '(progn
3974      (define-key term-raw-map [?\e ?\e] nil)
3975      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3976      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3977      (define-key term-raw-map [M-right] 'term-send-meta-right)
3978      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3979      (define-key term-raw-map [M-left] 'term-send-meta-left)
3980      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3981
3982 (defadvice term-exec (before program-args-list compile activate)
3983   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3984 This allows you to pass a list of arguments through `ansi-term'."
3985   (let ((program (ad-get-arg 2)))
3986     (if (listp program)
3987         (progn
3988           (ad-set-arg 2 (car program))
3989           (ad-set-arg 4 (cdr program))))))
3990
3991 (defadvice term-exec-1 (around hack-environment compile activate)
3992   "Hack the environment inherited by inferiors in the terminal."
3993   (let ((process-environment process-environment))
3994     (setenv "LD_PRELOAD" nil)
3995     ad-do-it))
3996
3997 (defadvice shell (around hack-environment compile activate)
3998   "Hack the environment inherited by inferiors in the shell."
3999   (let ((process-environment process-environment))
4000     (setenv "LD_PRELOAD" nil)
4001     ad-do-it))
4002
4003 (defun ssh (host)
4004   "Open a terminal containing an ssh session to the HOST."
4005   (interactive "sHost: ")
4006   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
4007
4008 (defvar git-grep-command
4009   "env PAGER=cat git grep --no-color -nH -e "
4010   "*The default command for \\[git-grep].")
4011
4012 (defvar git-grep-history nil)
4013
4014 (defun git-grep (command-args)
4015   "Run `git grep' with user-specified args and collect output in a buffer."
4016   (interactive
4017    (list (read-shell-command "Run git grep (like this): "
4018                              git-grep-command 'git-grep-history)))
4019   (grep command-args))
4020
4021 ;;;--------------------------------------------------------------------------
4022 ;;; Magit configuration.
4023
4024 (setq magit-diff-refine-hunk 'all
4025       magit-view-git-manual-method 'man
4026       magit-log-margin '(nil age magit-log-margin-width t 18)
4027       magit-wip-after-save-local-mode-lighter ""
4028       magit-wip-after-apply-mode-lighter ""
4029       magit-wip-before-change-mode-lighter "")
4030 (eval-after-load "magit"
4031   '(progn (global-magit-file-mode 1)
4032           (magit-wip-after-save-mode 1)
4033           (magit-wip-after-apply-mode 1)
4034           (magit-wip-before-change-mode 1)
4035           (add-to-list 'magit-no-confirm 'safe-with-wip)
4036           (push '(:eval (if (or magit-wip-after-save-local-mode
4037                                 magit-wip-after-apply-mode
4038                                 magit-wip-before-change-mode)
4039                             (format " wip:%s%s%s"
4040                                     (if magit-wip-after-apply-mode "A" "")
4041                                     (if magit-wip-before-change-mode "C" "")
4042                                     (if magit-wip-after-save-local-mode "S" ""))))
4043                 minor-mode-alist)
4044           (dolist (popup '(magit-diff-popup
4045                            magit-diff-refresh-popup
4046                            magit-diff-mode-refresh-popup
4047                            magit-revision-mode-refresh-popup))
4048             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))))
4049
4050 (defadvice magit-wip-commit-buffer-file
4051     (around mdw-just-this-buffer activate compile)
4052   (let ((magit-save-repository-buffers nil)) ad-do-it))
4053
4054 (setq magit-repolist-columns
4055       '(("Name" 16 magit-repolist-column-ident nil)
4056         ("Version" 18 magit-repolist-column-version nil)
4057         ("St" 2 magit-repolist-column-dirty nil)
4058         ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
4059         ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
4060         ("Path" 32 magit-repolist-column-path nil)))
4061
4062 (setq magit-repository-directories '(("~/etc/profile" . 0)
4063                                      ("~/src/" . 1)))
4064
4065 (defadvice magit-list-repos (around mdw-dirname () activate compile)
4066   "Make sure the returned names are directory names.
4067 Otherwise child processes get started in the wrong directory and
4068 there is sadness."
4069   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
4070
4071 (defun mdw-repolist-column-unpulled-from-upstream (_id)
4072   "Insert number of upstream commits not in the current branch."
4073   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4074     (and upstream
4075          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
4076            (propertize (number-to-string n) 'face
4077                        (if (> n 0) 'bold 'shadow))))))
4078
4079 (defun mdw-repolist-column-unpushed-to-upstream (_id)
4080   "Insert number of commits in the current branch but not its upstream."
4081   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4082     (and upstream
4083          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
4084            (propertize (number-to-string n) 'face
4085                        (if (> n 0) 'bold 'shadow))))))
4086
4087 (defun mdw-try-smerge ()
4088   (save-excursion
4089     (goto-char (point-min))
4090     (when (re-search-forward "^<<<<<<< " nil t)
4091       (smerge-mode 1))))
4092 (add-hook 'find-file-hook 'mdw-try-smerge t)
4093
4094 ;;;--------------------------------------------------------------------------
4095 ;;; MPC configuration.
4096
4097 (eval-when-compile (trap (require 'mpc)))
4098
4099 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
4100
4101 (defun mdw-mpc-now-playing ()
4102   (interactive)
4103   (require 'mpc)
4104   (save-excursion
4105     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
4106     (mpc--status-callback))
4107   (let ((state (cdr (assq 'state mpc-status))))
4108     (cond ((member state '("stop"))
4109            (message "mpd stopped."))
4110           ((member state '("play" "pause"))
4111            (let* ((artist (cdr (assq 'Artist mpc-status)))
4112                   (album (cdr (assq 'Album mpc-status)))
4113                   (title (cdr (assq 'Title mpc-status)))
4114                   (file (cdr (assq 'file mpc-status)))
4115                   (duration-string (cdr (assq 'Time mpc-status)))
4116                   (time-string (cdr (assq 'time mpc-status)))
4117                   (time (and time-string
4118                              (string-to-number
4119                               (if (string-match ":" time-string)
4120                                   (substring time-string
4121                                              0 (match-beginning 0))
4122                                 (time-string)))))
4123                   (duration (and duration-string
4124                                  (string-to-number duration-string)))
4125                   (pos (and time duration
4126                             (format " [%d:%02d/%d:%02d]"
4127                                     (/ time 60) (mod time 60)
4128                                     (/ duration 60) (mod duration 60))))
4129                   (fmt (cond ((and artist title)
4130                               (format "`%s' by %s%s" title artist
4131                                       (if album (format ", from `%s'" album)
4132                                         "")))
4133                              (file
4134                               (format "`%s' (no tags)" file))
4135                              (t
4136                               "(no idea what's playing!)"))))
4137              (if (string= state "play")
4138                  (message "mpd playing %s%s" fmt (or pos ""))
4139                (message "mpd paused in %s%s" fmt (or pos "")))))
4140           (t
4141            (message "mpd in unknown state `%s'" state)))))
4142
4143 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
4144   `(defun ,func ,bvl
4145      (interactive ,@interactive)
4146      (require 'mpc)
4147      ,@body
4148      (mdw-mpc-now-playing)))
4149
4150 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
4151   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
4152       (mpc-pause)
4153     (mpc-play)))
4154
4155 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
4156 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
4157 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
4158
4159 (defun mdw-mpc-louder (step)
4160   (interactive (list (if current-prefix-arg
4161                          (prefix-numeric-value current-prefix-arg)
4162                        +10)))
4163   (mpc-proc-cmd (format "volume %+d" step)))
4164
4165 (defun mdw-mpc-quieter (step)
4166   (interactive (list (if current-prefix-arg
4167                          (prefix-numeric-value current-prefix-arg)
4168                        +10)))
4169   (mpc-proc-cmd (format "volume %+d" (- step))))
4170
4171 (defun mdw-mpc-hack-lines (arg interactivep func)
4172   (if (and interactivep (use-region-p))
4173       (let ((from (region-beginning)) (to (region-end)))
4174         (goto-char from)
4175         (beginning-of-line)
4176         (funcall func)
4177         (forward-line)
4178         (while (< (point) to)
4179           (funcall func)
4180           (forward-line)))
4181     (let ((n (prefix-numeric-value arg)))
4182       (cond ((minusp n)
4183              (unless (bolp)
4184                (beginning-of-line)
4185                (funcall func)
4186                (incf n))
4187              (while (minusp n)
4188                (forward-line -1)
4189                (funcall func)
4190                (incf n)))
4191             (t
4192              (beginning-of-line)
4193              (while (plusp n)
4194                (funcall func)
4195                (forward-line)
4196                (decf n)))))))
4197
4198 (defun mdw-mpc-select-one ()
4199   (when (and (get-char-property (point) 'mpc-file)
4200              (not (get-char-property (point) 'mpc-select)))
4201     (mpc-select-toggle)))
4202
4203 (defun mdw-mpc-unselect-one ()
4204   (when (get-char-property (point) 'mpc-select)
4205     (mpc-select-toggle)))
4206
4207 (defun mdw-mpc-select (&optional arg interactivep)
4208   (interactive (list current-prefix-arg t))
4209   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4210
4211 (defun mdw-mpc-unselect (&optional arg interactivep)
4212   (interactive (list current-prefix-arg t))
4213   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
4214
4215 (defun mdw-mpc-unselect-backwards (arg)
4216   (interactive "p")
4217   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
4218
4219 (defun mdw-mpc-unselect-all ()
4220   (interactive)
4221   (setq mpc-select nil)
4222   (mpc-selection-refresh))
4223
4224 (defun mdw-mpc-next-line (arg)
4225   (interactive "p")
4226   (beginning-of-line)
4227   (forward-line arg))
4228
4229 (defun mdw-mpc-previous-line (arg)
4230   (interactive "p")
4231   (beginning-of-line)
4232   (forward-line (- arg)))
4233
4234 (defun mdw-mpc-playlist-add (&optional arg interactivep)
4235   (interactive (list current-prefix-arg t))
4236   (let ((mpc-select mpc-select))
4237     (when (or arg (and interactivep (use-region-p)))
4238       (setq mpc-select nil)
4239       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4240     (setq mpc-select (reverse mpc-select))
4241     (mpc-playlist-add)))
4242
4243 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
4244   (interactive (list current-prefix-arg t))
4245   (setq mpc-select (nreverse mpc-select))
4246   (mpc-select-save
4247     (when (or arg (and interactivep (use-region-p)))
4248       (setq mpc-select nil)
4249       (mpc-selection-refresh)
4250       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4251       (mpc-playlist-delete)))
4252
4253 (defun mdw-mpc-hack-tagbrowsers ()
4254   (setq-local mode-line-format
4255               '("%e"
4256                 mode-line-frame-identification
4257                 mode-line-buffer-identification)))
4258 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
4259
4260 (defun mdw-mpc-hack-songs ()
4261   (setq-local header-line-format
4262               ;; '("MPC " mpc-volume " " mpc-current-song)
4263               (list (propertize " " 'display '(space :align-to 0))
4264                     ;; 'mpc-songs-format-description
4265                     '(:eval
4266                       (let ((deactivate-mark) (hscroll (window-hscroll)))
4267                         (with-temp-buffer
4268                           (mpc-format mpc-songs-format 'self hscroll)
4269                           ;; That would be simpler than the hscroll handling in
4270                           ;; mpc-format, but currently move-to-column does not
4271                           ;; recognize :space display properties.
4272                           ;; (move-to-column hscroll)
4273                           ;; (delete-region (point-min) (point))
4274                           (buffer-string)))))))
4275 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
4276
4277 (eval-after-load "mpc"
4278   '(progn
4279      (define-key mpc-mode-map "m" 'mdw-mpc-select)
4280      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
4281      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
4282      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
4283      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
4284      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
4285      (define-key mpc-mode-map "/" 'mpc-songs-search)
4286      (setq mpc-songs-mode-map (make-sparse-keymap))
4287      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
4288      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
4289      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
4290      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
4291      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
4292
4293 ;;;--------------------------------------------------------------------------
4294 ;;; Inferior Emacs Lisp.
4295
4296 (setq comint-prompt-read-only t)
4297
4298 (eval-after-load "comint"
4299   '(progn
4300      (define-key comint-mode-map "\C-w" 'comint-kill-region)
4301      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
4302
4303 (eval-after-load "ielm"
4304   '(progn
4305      (define-key ielm-map "\C-w" 'comint-kill-region)
4306      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
4307
4308 ;;;----- That's all, folks --------------------------------------------------
4309
4310 (provide 'dot-emacs)