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