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