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 Man-underline
1456   (((type tty)) :underline t)
1457   (t :slant italic))
1458
1459 (mdw-define-face ido-subdir
1460   (t :foreground "cyan" :weight bold))
1461
1462 (mdw-define-face dired-directory
1463   (t :foreground "cyan" :weight bold))
1464 (mdw-define-face dired-symlink
1465   (t :foreground "cyan"))
1466 (mdw-define-face dired-perm-write
1467   (t nil))
1468
1469 (mdw-define-face trailing-whitespace
1470   (((class color)) :background "red")
1471   (t :inverse-video t))
1472 (mdw-define-face whitespace-line
1473   (((class color)) :background "darkred")
1474   (t :inverse-video t))
1475 (mdw-define-face mdw-punct-face
1476   (((min-colors 64)) :foreground "burlywood2")
1477   (((class color)) :foreground "yellow"))
1478 (mdw-define-face mdw-number-face
1479   (t :foreground "yellow"))
1480 (mdw-define-face mdw-trivial-face)
1481 (mdw-define-face font-lock-function-name-face
1482   (t :slant italic))
1483 (mdw-define-face font-lock-keyword-face
1484   (t :weight bold))
1485 (mdw-define-face font-lock-constant-face
1486   (t :slant italic))
1487 (mdw-define-face font-lock-builtin-face
1488   (t :weight bold))
1489 (mdw-define-face font-lock-type-face
1490   (t :weight bold :slant italic))
1491 (mdw-define-face font-lock-reference-face
1492   (t :weight bold))
1493 (mdw-define-face font-lock-variable-name-face
1494   (t :slant italic))
1495 (mdw-define-face font-lock-comment-delimiter-face
1496   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1497   (((class color)) :foreground "green")
1498   (t :weight bold))
1499 (mdw-define-face font-lock-comment-face
1500   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
1501   (((class color)) :foreground "green")
1502   (t :weight bold))
1503 (mdw-define-face font-lock-string-face
1504   (((min-colors 64)) :foreground "SkyBlue1")
1505   (((class color)) :foreground "cyan")
1506   (t :weight bold))
1507
1508 (mdw-define-face message-separator
1509   (t :background "red" :foreground "white" :weight bold))
1510 (mdw-define-face message-cited-text
1511   (default :slant italic)
1512   (((min-colors 64)) :foreground "SkyBlue1")
1513   (((class color)) :foreground "cyan"))
1514 (mdw-define-face message-header-cc
1515   (default :slant italic)
1516   (((min-colors 64)) :foreground "SeaGreen1")
1517   (((class color)) :foreground "green"))
1518 (mdw-define-face message-header-newsgroups
1519   (default :slant italic)
1520   (((min-colors 64)) :foreground "SeaGreen1")
1521   (((class color)) :foreground "green"))
1522 (mdw-define-face message-header-subject
1523   (((min-colors 64)) :foreground "SeaGreen1")
1524   (((class color)) :foreground "green"))
1525 (mdw-define-face message-header-to
1526   (((min-colors 64)) :foreground "SeaGreen1")
1527   (((class color)) :foreground "green"))
1528 (mdw-define-face message-header-xheader
1529   (default :slant italic)
1530   (((min-colors 64)) :foreground "SeaGreen1")
1531   (((class color)) :foreground "green"))
1532 (mdw-define-face message-header-other
1533   (default :slant italic)
1534   (((min-colors 64)) :foreground "SeaGreen1")
1535   (((class color)) :foreground "green"))
1536 (mdw-define-face message-header-name
1537   (default :weight bold)
1538   (((min-colors 64)) :foreground "SeaGreen1")
1539   (((class color)) :foreground "green"))
1540
1541 (mdw-define-face which-func
1542   (t nil))
1543
1544 (mdw-define-face gnus-header-name
1545   (default :weight bold)
1546   (((min-colors 64)) :foreground "SeaGreen1")
1547   (((class color)) :foreground "green"))
1548 (mdw-define-face gnus-header-subject
1549   (((min-colors 64)) :foreground "SeaGreen1")
1550   (((class color)) :foreground "green"))
1551 (mdw-define-face gnus-header-from
1552   (((min-colors 64)) :foreground "SeaGreen1")
1553   (((class color)) :foreground "green"))
1554 (mdw-define-face gnus-header-to
1555   (((min-colors 64)) :foreground "SeaGreen1")
1556   (((class color)) :foreground "green"))
1557 (mdw-define-face gnus-header-content
1558   (default :slant italic)
1559   (((min-colors 64)) :foreground "SeaGreen1")
1560   (((class color)) :foreground "green"))
1561
1562 (mdw-define-face gnus-cite-1
1563   (((min-colors 64)) :foreground "SkyBlue1")
1564   (((class color)) :foreground "cyan"))
1565 (mdw-define-face gnus-cite-2
1566   (((min-colors 64)) :foreground "RoyalBlue2")
1567   (((class color)) :foreground "blue"))
1568 (mdw-define-face gnus-cite-3
1569   (((min-colors 64)) :foreground "MediumOrchid")
1570   (((class color)) :foreground "magenta"))
1571 (mdw-define-face gnus-cite-4
1572   (((min-colors 64)) :foreground "firebrick2")
1573   (((class color)) :foreground "red"))
1574 (mdw-define-face gnus-cite-5
1575   (((min-colors 64)) :foreground "burlywood2")
1576   (((class color)) :foreground "yellow"))
1577 (mdw-define-face gnus-cite-6
1578   (((min-colors 64)) :foreground "SeaGreen1")
1579   (((class color)) :foreground "green"))
1580 (mdw-define-face gnus-cite-7
1581   (((min-colors 64)) :foreground "SlateBlue1")
1582   (((class color)) :foreground "cyan"))
1583 (mdw-define-face gnus-cite-8
1584   (((min-colors 64)) :foreground "RoyalBlue2")
1585   (((class color)) :foreground "blue"))
1586 (mdw-define-face gnus-cite-9
1587   (((min-colors 64)) :foreground "purple2")
1588   (((class color)) :foreground "magenta"))
1589 (mdw-define-face gnus-cite-10
1590   (((min-colors 64)) :foreground "DarkOrange2")
1591   (((class color)) :foreground "red"))
1592 (mdw-define-face gnus-cite-11
1593   (t :foreground "grey"))
1594
1595 (mdw-define-face diff-header
1596   (t nil))
1597 (mdw-define-face diff-index
1598   (t :weight bold))
1599 (mdw-define-face diff-file-header
1600   (t :weight bold))
1601 (mdw-define-face diff-hunk-header
1602   (((min-colors 64)) :foreground "SkyBlue1")
1603   (((class color)) :foreground "cyan"))
1604 (mdw-define-face diff-function
1605   (default :weight bold)
1606   (((min-colors 64)) :foreground "SkyBlue1")
1607   (((class color)) :foreground "cyan"))
1608 (mdw-define-face diff-header
1609   (((min-colors 64)) :background "grey10"))
1610 (mdw-define-face diff-added
1611   (((class color)) :foreground "green"))
1612 (mdw-define-face diff-removed
1613   (((class color)) :foreground "red"))
1614 (mdw-define-face diff-context
1615   (t nil))
1616 (mdw-define-face diff-refine-change
1617   (((min-colors 64)) :background "RoyalBlue4")
1618   (t :underline t))
1619 (mdw-define-face diff-refine-removed
1620   (((min-colors 64)) :background "#500")
1621   (t :underline t))
1622 (mdw-define-face diff-refine-added
1623   (((min-colors 64)) :background "#050")
1624   (t :underline t))
1625
1626 (setq ediff-force-faces t)
1627 (mdw-define-face ediff-current-diff-A
1628   (((min-colors 64)) :background "darkred")
1629   (((class color)) :background "red")
1630   (t :inverse-video t))
1631 (mdw-define-face ediff-fine-diff-A
1632   (((min-colors 64)) :background "red3")
1633   (((class color)) :inverse-video t)
1634   (t :inverse-video nil))
1635 (mdw-define-face ediff-even-diff-A
1636   (((min-colors 64)) :background "#300"))
1637 (mdw-define-face ediff-odd-diff-A
1638   (((min-colors 64)) :background "#300"))
1639 (mdw-define-face ediff-current-diff-B
1640   (((min-colors 64)) :background "darkgreen")
1641   (((class color)) :background "magenta")
1642   (t :inverse-video t))
1643 (mdw-define-face ediff-fine-diff-B
1644   (((min-colors 64)) :background "green4")
1645   (((class color)) :inverse-video t)
1646   (t :inverse-video nil))
1647 (mdw-define-face ediff-even-diff-B
1648   (((min-colors 64)) :background "#020"))
1649 (mdw-define-face ediff-odd-diff-B
1650   (((min-colors 64)) :background "#020"))
1651 (mdw-define-face ediff-current-diff-C
1652   (((min-colors 64)) :background "darkblue")
1653   (((class color)) :background "blue")
1654   (t :inverse-video t))
1655 (mdw-define-face ediff-fine-diff-C
1656   (((min-colors 64)) :background "blue1")
1657   (((class color)) :inverse-video t)
1658   (t :inverse-video nil))
1659 (mdw-define-face ediff-even-diff-C
1660   (((min-colors 64)) :background "#004"))
1661 (mdw-define-face ediff-odd-diff-C
1662   (((min-colors 64)) :background "#004"))
1663 (mdw-define-face ediff-current-diff-Ancestor
1664   (((min-colors 64)) :background "#630")
1665   (((class color)) :background "blue")
1666   (t :inverse-video t))
1667 (mdw-define-face ediff-even-diff-Ancestor
1668   (((min-colors 64)) :background "#320"))
1669 (mdw-define-face ediff-odd-diff-Ancestor
1670   (((min-colors 64)) :background "#320"))
1671
1672 (mdw-define-face magit-hash
1673   (((min-colors 64)) :foreground "grey40")
1674   (((class color)) :foreground "blue"))
1675 (mdw-define-face magit-diff-hunk-heading
1676   (((min-colors 64)) :foreground "grey70" :background "grey25")
1677   (((class color)) :foreground "yellow"))
1678 (mdw-define-face magit-diff-hunk-heading-highlight
1679   (((min-colors 64)) :foreground "grey70" :background "grey35")
1680   (((class color)) :foreground "yellow" :background "blue"))
1681 (mdw-define-face magit-diff-added
1682   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
1683   (((class color)) :foreground "green"))
1684 (mdw-define-face magit-diff-added-highlight
1685   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
1686   (((class color)) :foreground "green" :background "blue"))
1687 (mdw-define-face magit-diff-removed
1688   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
1689   (((class color)) :foreground "red"))
1690 (mdw-define-face magit-diff-removed-highlight
1691   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
1692   (((class color)) :foreground "red" :background "blue"))
1693 (mdw-define-face magit-blame-heading
1694   (((min-colors 64)) :foreground "white" :background "grey25"
1695                      :weight normal :slant normal)
1696   (((class color)) :foreground "white" :background "blue"
1697                    :weight normal :slant normal))
1698 (mdw-define-face magit-blame-name
1699   (t :inherit magit-blame-heading :slant italic))
1700 (mdw-define-face magit-blame-date
1701   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
1702   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
1703 (mdw-define-face magit-blame-summary
1704   (t :inherit magit-blame-heading :weight bold))
1705
1706 (mdw-define-face dylan-header-background
1707   (((min-colors 64)) :background "NavyBlue")
1708   (((class color)) :background "blue"))
1709
1710 (mdw-define-face erc-input-face
1711   (t :foreground "red"))
1712
1713 (mdw-define-face woman-bold
1714   (t :weight bold))
1715 (mdw-define-face woman-italic
1716   (t :slant italic))
1717
1718 (eval-after-load "rst"
1719   '(progn
1720      (mdw-define-face rst-level-1-face
1721        (t :foreground "SkyBlue1" :weight bold))
1722      (mdw-define-face rst-level-2-face
1723        (t :foreground "SeaGreen1" :weight bold))
1724      (mdw-define-face rst-level-3-face
1725        (t :weight bold))
1726      (mdw-define-face rst-level-4-face
1727        (t :slant italic))
1728      (mdw-define-face rst-level-5-face
1729        (t :underline t))
1730      (mdw-define-face rst-level-6-face
1731        ())))
1732
1733 (mdw-define-face p4-depot-added-face
1734   (t :foreground "green"))
1735 (mdw-define-face p4-depot-branch-op-face
1736   (t :foreground "yellow"))
1737 (mdw-define-face p4-depot-deleted-face
1738   (t :foreground "red"))
1739 (mdw-define-face p4-depot-unmapped-face
1740   (t :foreground "SkyBlue1"))
1741 (mdw-define-face p4-diff-change-face
1742   (t :foreground "yellow"))
1743 (mdw-define-face p4-diff-del-face
1744   (t :foreground "red"))
1745 (mdw-define-face p4-diff-file-face
1746   (t :foreground "SkyBlue1"))
1747 (mdw-define-face p4-diff-head-face
1748   (t :background "grey10"))
1749 (mdw-define-face p4-diff-ins-face
1750   (t :foreground "green"))
1751
1752 (mdw-define-face w3m-anchor-face
1753   (t :foreground "SkyBlue1" :underline t))
1754 (mdw-define-face w3m-arrived-anchor-face
1755   (t :foreground "SkyBlue1" :underline t))
1756
1757 (mdw-define-face whizzy-slice-face
1758   (t :background "grey10"))
1759 (mdw-define-face whizzy-error-face
1760   (t :background "darkred"))
1761
1762 ;; Ellipses used to indicate hidden text (and similar).
1763 (mdw-define-face mdw-ellipsis-face
1764   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1765 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1766       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
1767       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1768       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1769   (set-display-table-slot standard-display-table 0 dollar)
1770   (set-display-table-slot standard-display-table 1 backslash)
1771   (set-display-table-slot standard-display-table 4
1772                           (vector dot dot dot))
1773   (set-display-table-slot standard-display-table 5 bar))
1774
1775 ;;;--------------------------------------------------------------------------
1776 ;;; Where is point?
1777
1778 (mdw-define-face mdw-point-overlay-face
1779   (((type graphic)))
1780   (((min-colors 64)) :background "darkblue")
1781   (((class color)) :background "blue")
1782   (((type tty) (class mono)) :inverse-video t))
1783
1784 (defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
1785
1786 (defun mdw-configure-point-overlay ()
1787   (let ((ov (make-overlay 0 0)))
1788     (overlay-put ov 'priority 0)
1789     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
1790            (left (car fringe)) (right (cdr fringe))
1791            (s ""))
1792       (when left
1793         (let ((ss "."))
1794           (put-text-property 0 1 'display `(left-fringe ,left) ss)
1795           (setq s (concat s ss))))
1796       (when right
1797         (let ((ss "."))
1798           (put-text-property 0 1 'display `(right-fringe ,right) ss)
1799           (setq s (concat s ss))))
1800       (when (or left right)
1801         (overlay-put ov 'before-string s)))
1802     (overlay-put ov 'face 'mdw-point-overlay-face)
1803     (delete-overlay ov)
1804     ov))
1805
1806 (defvar mdw-point-overlay (mdw-configure-point-overlay)
1807   "An overlay used for showing where point is in the selected window.")
1808 (defun mdw-reconfigure-point-overlay ()
1809   (interactive)
1810   (setq mdw-point-overlay (mdw-configure-point-overlay)))
1811
1812 (defun mdw-remove-point-overlay ()
1813   "Remove the current-point overlay."
1814   (delete-overlay mdw-point-overlay))
1815
1816 (defun mdw-update-point-overlay ()
1817   "Mark the current point position with an overlay."
1818   (if (not mdw-point-overlay-mode)
1819       (mdw-remove-point-overlay)
1820     (overlay-put mdw-point-overlay 'window (selected-window))
1821     (move-overlay mdw-point-overlay
1822                   (line-beginning-position)
1823                   (+ (line-end-position) 1))))
1824
1825 (defvar mdw-point-overlay-buffers nil
1826   "List of buffers using `mdw-point-overlay-mode'.")
1827
1828 (define-minor-mode mdw-point-overlay-mode
1829   "Indicate current line with an overlay."
1830   :global nil
1831   (let ((buffer (current-buffer)))
1832     (setq mdw-point-overlay-buffers
1833           (mapcan (lambda (buf)
1834                     (if (and (buffer-live-p buf)
1835                              (not (eq buf buffer)))
1836                         (list buf)))
1837                   mdw-point-overlay-buffers))
1838     (if mdw-point-overlay-mode
1839         (setq mdw-point-overlay-buffers
1840               (cons buffer mdw-point-overlay-buffers))))
1841   (cond (mdw-point-overlay-buffers
1842          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
1843          (add-hook 'post-command-hook 'mdw-update-point-overlay))
1844         (t
1845          (mdw-remove-point-overlay)
1846          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
1847          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
1848
1849 (define-globalized-minor-mode mdw-global-point-overlay-mode
1850   mdw-point-overlay-mode
1851   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
1852
1853 ;;;--------------------------------------------------------------------------
1854 ;;; C programming configuration.
1855
1856 ;; Make C indentation nice.
1857
1858 (defun mdw-c-lineup-arglist (langelem)
1859   "Hack for DWIMmery in c-lineup-arglist."
1860   (if (save-excursion
1861         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1862       0
1863     (c-lineup-arglist langelem)))
1864
1865 (defun mdw-c-indent-extern-mumble (langelem)
1866   "Indent `extern \"...\" {' lines."
1867   (save-excursion
1868     (back-to-indentation)
1869     (if (looking-at
1870          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1871         c-basic-offset
1872       nil)))
1873
1874 (defun mdw-c-indent-arglist-nested (langelem)
1875   "Indent continued argument lists.
1876 If we've nested more than one argument list, then only introduce a single
1877 indentation anyway."
1878   (let ((context c-syntactic-context)
1879         (pos (c-langelem-2nd-pos c-syntactic-element))
1880         (should-indent-p t))
1881     (while (and context
1882                 (eq (caar context) 'arglist-cont-nonempty))
1883       (when (and (= (caddr (pop context)) pos)
1884                  context
1885                  (memq (caar context) '(arglist-intro
1886                                         arglist-cont-nonempty)))
1887         (setq should-indent-p nil)))
1888     (if should-indent-p '+ 0)))
1889
1890 (defvar mdw-define-c-styles-hook nil
1891   "Hook run when `cc-mode' starts up to define styles.")
1892
1893 (defmacro mdw-define-c-style (name &rest assocs)
1894   "Define a C style, called NAME (a symbol), setting ASSOCs.
1895 A function, named `mdw-define-c-style/NAME', is defined to actually install
1896 the style using `c-add-style', and added to the hook
1897 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
1898 set."
1899   (declare (indent defun))
1900   (let* ((name-string (symbol-name name))
1901          (func (intern (concat "mdw-define-c-style/" name-string))))
1902     `(progn
1903        (defun ,func () (c-add-style ,name-string ',assocs))
1904        (and (featurep 'cc-mode) (,func))
1905        (add-hook 'mdw-define-c-styles-hook ',func))))
1906
1907 (eval-after-load "cc-mode"
1908   '(run-hooks 'mdw-define-c-styles-hook))
1909
1910 (mdw-define-c-style mdw-trustonic-c
1911   (c-basic-offset . 4)
1912   (comment-column . 0)
1913   (c-indent-comment-alist (anchored-comment . (column . 0))
1914                           (end-block . (space . 1))
1915                           (cpp-end-block . (space . 1))
1916                           (other . (space . 1)))
1917   (c-class-key . "class")
1918   (c-backslash-column . 0)
1919   (c-auto-align-backslashes . nil)
1920   (c-label-minimum-indentation . 0)
1921   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1922                    (defun-open . (add 0 c-indent-one-line-block))
1923                    (arglist-cont-nonempty . mdw-c-indent-arglist-nested)
1924                    (topmost-intro . mdw-c-indent-extern-mumble)
1925                    (cpp-define-intro . 0)
1926                    (knr-argdecl . 0)
1927                    (inextern-lang . [0])
1928                    (label . 0)
1929                    (case-label . +)
1930                    (access-label . -2)
1931                    (inclass . +)
1932                    (inline-open . ++)
1933                    (statement-cont . +)
1934                    (statement-case-intro . +)))
1935
1936 (mdw-define-c-style mdw-c
1937   (c-basic-offset . 2)
1938   (comment-column . 40)
1939   (c-class-key . "class")
1940   (c-backslash-column . 72)
1941   (c-label-minimum-indentation . 0)
1942   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
1943                    (defun-open . (add 0 c-indent-one-line-block))
1944                    (arglist-cont-nonempty . mdw-c-lineup-arglist)
1945                    (topmost-intro . mdw-c-indent-extern-mumble)
1946                    (cpp-define-intro . 0)
1947                    (knr-argdecl . 0)
1948                    (inextern-lang . [0])
1949                    (label . 0)
1950                    (case-label . +)
1951                    (access-label . -)
1952                    (inclass . +)
1953                    (inline-open . ++)
1954                    (statement-cont . +)
1955                    (statement-case-intro . +)))
1956
1957 (defun mdw-set-default-c-style (modes style)
1958   "Update the default CC Mode style for MODES to be STYLE.
1959
1960 MODES may be a list of major mode names or a singleton.  STYLE is a style
1961 name, as a symbol."
1962   (let ((modes (if (listp modes) modes (list modes)))
1963         (style (symbol-name style)))
1964     (setq c-default-style
1965           (append (mapcar (lambda (mode)
1966                             (cons mode style))
1967                           modes)
1968                   (remove-if (lambda (assoc)
1969                                (memq (car assoc) modes))
1970                              (if (listp c-default-style)
1971                                  c-default-style
1972                                (list (cons 'other c-default-style))))))))
1973 (setq c-default-style "mdw-c")
1974
1975 (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
1976
1977 (defvar mdw-c-comment-fill-prefix
1978   `((,(concat "\\([ \t]*/?\\)"
1979               "\\(\\*\\|//\\)"
1980               "\\([ \t]*\\)"
1981               "\\([A-Za-z]+:[ \t]*\\)?"
1982               mdw-hanging-indents)
1983      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1984   "Fill prefix matching C comments (both kinds).")
1985
1986 (defun mdw-fontify-c-and-c++ ()
1987
1988   ;; Fiddle with some syntax codes.
1989   (modify-syntax-entry ?* ". 23")
1990   (modify-syntax-entry ?/ ". 124b")
1991   (modify-syntax-entry ?\n "> b")
1992
1993   ;; Other stuff.
1994   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1995
1996   ;; Now define things to be fontified.
1997   (make-local-variable 'font-lock-keywords)
1998   (let ((c-keywords
1999          (mdw-regexps "alignas"          ;C11 macro, C++11
2000                       "alignof"          ;C++11
2001                       "and"              ;C++, C95 macro
2002                       "and_eq"           ;C++, C95 macro
2003                       "asm"              ;K&R, C++, GCC
2004                       "atomic"           ;C11 macro, C++11 template type
2005                       "auto"             ;K&R, C89
2006                       "bitand"           ;C++, C95 macro
2007                       "bitor"            ;C++, C95 macro
2008                       "bool"             ;C++, C99 macro
2009                       "break"            ;K&R, C89
2010                       "case"             ;K&R, C89
2011                       "catch"            ;C++
2012                       "char"             ;K&R, C89
2013                       "char16_t"         ;C++11, C11 library type
2014                       "char32_t"         ;C++11, C11 library type
2015                       "class"            ;C++
2016                       "complex"          ;C99 macro, C++ template type
2017                       "compl"            ;C++, C95 macro
2018                       "const"            ;C89
2019                       "constexpr"        ;C++11
2020                       "const_cast"       ;C++
2021                       "continue"         ;K&R, C89
2022                       "decltype"         ;C++11
2023                       "defined"          ;C89 preprocessor
2024                       "default"          ;K&R, C89
2025                       "delete"           ;C++
2026                       "do"               ;K&R, C89
2027                       "double"           ;K&R, C89
2028                       "dynamic_cast"     ;C++
2029                       "else"             ;K&R, C89
2030                       ;; "entry"         ;K&R -- never used
2031                       "enum"             ;C89
2032                       "explicit"         ;C++
2033                       "export"           ;C++
2034                       "extern"           ;K&R, C89
2035                       "float"            ;K&R, C89
2036                       "for"              ;K&R, C89
2037                       ;; "fortran"       ;K&R
2038                       "friend"           ;C++
2039                       "goto"             ;K&R, C89
2040                       "if"               ;K&R, C89
2041                       "imaginary"        ;C99 macro
2042                       "inline"           ;C++, C99, GCC
2043                       "int"              ;K&R, C89
2044                       "long"             ;K&R, C89
2045                       "mutable"          ;C++
2046                       "namespace"        ;C++
2047                       "new"              ;C++
2048                       "noexcept"         ;C++11
2049                       "noreturn"         ;C11 macro
2050                       "not"              ;C++, C95 macro
2051                       "not_eq"           ;C++, C95 macro
2052                       "nullptr"          ;C++11
2053                       "operator"         ;C++
2054                       "or"               ;C++, C95 macro
2055                       "or_eq"            ;C++, C95 macro
2056                       "private"          ;C++
2057                       "protected"        ;C++
2058                       "public"           ;C++
2059                       "register"         ;K&R, C89
2060                       "reinterpret_cast" ;C++
2061                       "restrict"         ;C99
2062                       "return"           ;K&R, C89
2063                       "short"            ;K&R, C89
2064                       "signed"           ;C89
2065                       "sizeof"           ;K&R, C89
2066                       "static"           ;K&R, C89
2067                       "static_assert"    ;C11 macro, C++11
2068                       "static_cast"      ;C++
2069                       "struct"           ;K&R, C89
2070                       "switch"           ;K&R, C89
2071                       "template"         ;C++
2072                       "throw"            ;C++
2073                       "try"              ;C++
2074                       "thread_local"     ;C11 macro, C++11
2075                       "typedef"          ;C89
2076                       "typeid"           ;C++
2077                       "typeof"           ;GCC
2078                       "typename"         ;C++
2079                       "union"            ;K&R, C89
2080                       "unsigned"         ;K&R, C89
2081                       "using"            ;C++
2082                       "virtual"          ;C++
2083                       "void"             ;C89
2084                       "volatile"         ;C89
2085                       "wchar_t"          ;C++, C89 library type
2086                       "while"            ;K&R, C89
2087                       "xor"              ;C++, C95 macro
2088                       "xor_eq"           ;C++, C95 macro
2089                       "_Alignas"         ;C11
2090                       "_Alignof"         ;C11
2091                       "_Atomic"          ;C11
2092                       "_Bool"            ;C99
2093                       "_Complex"         ;C99
2094                       "_Generic"         ;C11
2095                       "_Imaginary"       ;C99
2096                       "_Noreturn"        ;C11
2097                       "_Pragma"          ;C99 preprocessor
2098                       "_Static_assert"   ;C11
2099                       "_Thread_local"    ;C11
2100                       "__alignof__"      ;GCC
2101                       "__asm__"          ;GCC
2102                       "__attribute__"    ;GCC
2103                       "__complex__"      ;GCC
2104                       "__const__"        ;GCC
2105                       "__extension__"    ;GCC
2106                       "__imag__"         ;GCC
2107                       "__inline__"       ;GCC
2108                       "__label__"        ;GCC
2109                       "__real__"         ;GCC
2110                       "__signed__"       ;GCC
2111                       "__typeof__"       ;GCC
2112                       "__volatile__"     ;GCC
2113                       ))
2114         (c-builtins
2115          (mdw-regexps "false"            ;C++, C99 macro
2116                       "this"             ;C++
2117                       "true"             ;C++, C99 macro
2118                       ))
2119         (preprocessor-keywords
2120          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2121                       "ident" "if" "ifdef" "ifndef" "import" "include"
2122                       "line" "pragma" "unassert" "undef" "warning"))
2123         (objc-keywords
2124          (mdw-regexps "class" "defs" "encode" "end" "implementation"
2125                       "interface" "private" "protected" "protocol" "public"
2126                       "selector")))
2127
2128     (setq font-lock-keywords
2129           (list
2130
2131            ;; Fontify include files as strings.
2132            (list (concat "^[ \t]*\\#[ \t]*"
2133                          "\\(include\\|import\\)"
2134                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2135                  '(2 font-lock-string-face))
2136
2137            ;; Preprocessor directives are `references'?.
2138            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2139                          preprocessor-keywords
2140                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
2141                  '(1 font-lock-keyword-face))
2142
2143            ;; Handle the keywords defined above.
2144            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2145                  '(0 font-lock-keyword-face))
2146
2147            (list (concat "\\<\\(" c-keywords "\\)\\>")
2148                  '(0 font-lock-keyword-face))
2149
2150            (list (concat "\\<\\(" c-builtins "\\)\\>")
2151                  '(0 font-lock-variable-name-face))
2152
2153            ;; Handle numbers too.
2154            ;;
2155            ;; This looks strange, I know.  It corresponds to the
2156            ;; preprocessor's idea of what a number looks like, rather than
2157            ;; anything sensible.
2158            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2159                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2160                  '(0 mdw-number-face))
2161
2162            ;; And anything else is punctuation.
2163            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2164                  '(0 mdw-punct-face))))))
2165
2166 (define-derived-mode sod-mode c-mode "Sod"
2167   "Major mode for editing Sod code.")
2168 (push '("\\.sod$" . sod-mode) auto-mode-alist)
2169
2170 (dolist (hook '(c-mode-hook objc-mode-hook c++-mode-hook))
2171   (add-hook hook 'mdw-misc-mode-config t)
2172   (add-hook hook 'mdw-fontify-c-and-c++ t))
2173
2174 ;;;--------------------------------------------------------------------------
2175 ;;; AP calc mode.
2176
2177 (define-derived-mode apcalc-mode c-mode "AP Calc"
2178   "Major mode for editing Calc code.")
2179
2180 (defun mdw-fontify-apcalc ()
2181
2182   ;; Fiddle with some syntax codes.
2183   (modify-syntax-entry ?* ". 23")
2184   (modify-syntax-entry ?/ ". 14")
2185
2186   ;; Other stuff.
2187   (setq comment-start "/* ")
2188   (setq comment-end " */")
2189   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2190
2191   ;; Now define things to be fontified.
2192   (make-local-variable 'font-lock-keywords)
2193   (let ((c-keywords
2194          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2195                       "do" "else" "exit" "for" "global" "goto" "help" "if"
2196                       "local" "mat" "obj" "print" "quit" "read" "return"
2197                       "show" "static" "switch" "while" "write")))
2198
2199     (setq font-lock-keywords
2200           (list
2201
2202            ;; Handle the keywords defined above.
2203            (list (concat "\\<\\(" c-keywords "\\)\\>")
2204                  '(0 font-lock-keyword-face))
2205
2206            ;; Handle numbers too.
2207            ;;
2208            ;; This looks strange, I know.  It corresponds to the
2209            ;; preprocessor's idea of what a number looks like, rather than
2210            ;; anything sensible.
2211            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2212                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2213                  '(0 mdw-number-face))
2214
2215            ;; And anything else is punctuation.
2216            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2217                  '(0 mdw-punct-face))))))
2218
2219 (progn
2220   (add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
2221   (add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t))
2222
2223 ;;;--------------------------------------------------------------------------
2224 ;;; Java programming configuration.
2225
2226 ;; Make indentation nice.
2227
2228 (mdw-define-c-style mdw-java
2229   (c-basic-offset . 2)
2230   (c-backslash-column . 72)
2231   (c-offsets-alist (substatement-open . 0)
2232                    (label . +)
2233                    (case-label . +)
2234                    (access-label . 0)
2235                    (inclass . +)
2236                    (statement-case-intro . +)))
2237 (mdw-set-default-c-style 'java-mode 'mdw-java)
2238
2239 ;; Declare Java fontification style.
2240
2241 (defun mdw-fontify-java ()
2242
2243   ;; Fiddle with some syntax codes.
2244   (modify-syntax-entry ?@ ".")
2245   (modify-syntax-entry ?@ "." font-lock-syntax-table)
2246
2247   ;; Other stuff.
2248   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2249
2250   ;; Now define things to be fontified.
2251   (make-local-variable 'font-lock-keywords)
2252   (let ((java-keywords
2253          (mdw-regexps "abstract" "assert"
2254                       "boolean" "break" "byte"
2255                       "case" "catch" "char" "class" "const" "continue"
2256                       "default" "do" "double"
2257                       "else" "enum" "extends"
2258                       "final" "finally" "float" "for"
2259                       "goto"
2260                       "if" "implements" "import" "instanceof" "int"
2261                       "interface"
2262                       "long"
2263                       "native" "new"
2264                       "package" "private" "protected" "public"
2265                       "return"
2266                       "short" "static" "strictfp" "switch" "synchronized"
2267                       "throw" "throws" "transient" "try"
2268                       "void" "volatile"
2269                       "while"))
2270
2271         (java-builtins
2272          (mdw-regexps "false" "null" "super" "this" "true")))
2273
2274     (setq font-lock-keywords
2275           (list
2276
2277            ;; Handle the keywords defined above.
2278            (list (concat "\\<\\(" java-keywords "\\)\\>")
2279                  '(0 font-lock-keyword-face))
2280
2281            ;; Handle the magic builtins defined above.
2282            (list (concat "\\<\\(" java-builtins "\\)\\>")
2283                  '(0 font-lock-variable-name-face))
2284
2285            ;; Handle numbers too.
2286            ;;
2287            ;; The following isn't quite right, but it's close enough.
2288            (list (concat "\\<\\("
2289                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2290                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2291                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2292                          "[lLfFdD]?")
2293                  '(0 mdw-number-face))
2294
2295            ;; And anything else is punctuation.
2296            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2297                  '(0 mdw-punct-face))))))
2298
2299 (progn
2300   (add-hook 'java-mode-hook 'mdw-misc-mode-config t)
2301   (add-hook 'java-mode-hook 'mdw-fontify-java t))
2302
2303 ;;;--------------------------------------------------------------------------
2304 ;;; Javascript programming configuration.
2305
2306 (defun mdw-javascript-style ()
2307   (setq js-indent-level 2)
2308   (setq js-expr-indent-offset 0))
2309
2310 (defun mdw-fontify-javascript ()
2311
2312   ;; Other stuff.
2313   (mdw-javascript-style)
2314   (setq js-auto-indent-flag t)
2315
2316   ;; Now define things to be fontified.
2317   (make-local-variable 'font-lock-keywords)
2318   (let ((javascript-keywords
2319          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2320                       "char" "class" "const" "continue" "debugger" "default"
2321                       "delete" "do" "double" "else" "enum" "export" "extends"
2322                       "final" "finally" "float" "for" "function" "goto" "if"
2323                       "implements" "import" "in" "instanceof" "int"
2324                       "interface" "let" "long" "native" "new" "package"
2325                       "private" "protected" "public" "return" "short"
2326                       "static" "super" "switch" "synchronized" "throw"
2327                       "throws" "transient" "try" "typeof" "var" "void"
2328                       "volatile" "while" "with" "yield"))
2329         (javascript-builtins
2330          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2331                       "arguments" "this")))
2332
2333     (setq font-lock-keywords
2334           (list
2335
2336            ;; Handle the keywords defined above.
2337            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2338                  '(0 font-lock-keyword-face))
2339
2340            ;; Handle the predefined builtins defined above.
2341            (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
2342                  '(0 font-lock-variable-name-face))
2343
2344            ;; Handle numbers too.
2345            ;;
2346            ;; The following isn't quite right, but it's close enough.
2347            (list (concat "\\_<\\("
2348                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2349                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2350                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2351                          "[lLfFdD]?")
2352                  '(0 mdw-number-face))
2353
2354            ;; And anything else is punctuation.
2355            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2356                  '(0 mdw-punct-face))))))
2357
2358 (progn
2359   (add-hook 'js-mode-hook 'mdw-misc-mode-config t)
2360   (add-hook 'js-mode-hook 'mdw-fontify-javascript t))
2361
2362 ;;;--------------------------------------------------------------------------
2363 ;;; Scala programming configuration.
2364
2365 (defun mdw-fontify-scala ()
2366
2367   ;; Comment filling.
2368   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2369
2370   ;; Define things to be fontified.
2371   (make-local-variable 'font-lock-keywords)
2372   (let ((scala-keywords
2373          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2374                       "extends" "final" "finally" "for" "forSome" "if"
2375                       "implicit" "import" "lazy" "match" "new" "object"
2376                       "override" "package" "private" "protected" "return"
2377                       "sealed" "throw" "trait" "try" "type" "val"
2378                       "var" "while" "with" "yield"))
2379         (scala-constants
2380          (mdw-regexps "false" "null" "super" "this" "true"))
2381         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
2382
2383     (setq font-lock-keywords
2384           (list
2385
2386            ;; Magical identifiers between backticks.
2387            (list (concat "`\\([^`]+\\)`")
2388                  '(1 font-lock-variable-name-face))
2389
2390            ;; Handle the keywords defined above.
2391            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2392                  '(0 font-lock-keyword-face))
2393
2394            ;; Handle the constants defined above.
2395            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2396                  '(0 font-lock-variable-name-face))
2397
2398            ;; Magical identifiers between backticks.
2399            (list (concat "`\\([^`]+\\)`")
2400                  '(1 font-lock-variable-name-face))
2401
2402            ;; Handle numbers too.
2403            ;;
2404            ;; As usual, not quite right.
2405            (list (concat "\\_<\\("
2406                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2407                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2408                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2409                          "[lLfFdD]?")
2410                  '(0 mdw-number-face))
2411
2412            ;; And everything else is punctuation.
2413            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2414                  '(0 mdw-punct-face)))
2415
2416           font-lock-syntactic-keywords
2417           (list
2418
2419            ;; Single quotes around characters.  But not when used to quote
2420            ;; symbol names.  Ugh.
2421            (list (concat "\\('\\)"
2422                          "\\(" "."
2423                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
2424                                "u+" "[0-9a-fA-F]\\{4\\}"
2425                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
2426                          "\\|" "\\\\" "." "\\)"
2427                          "\\('\\)")
2428                  '(1 "\"")
2429                  '(4 "\""))))))
2430
2431 (progn
2432   (add-hook 'scala-mode-hook 'mdw-misc-mode-config t)
2433   (add-hook 'scala-mode-hook 'mdw-fontify-scala t))
2434
2435 ;;;--------------------------------------------------------------------------
2436 ;;; C# programming configuration.
2437
2438 ;; Make indentation nice.
2439
2440 (mdw-define-c-style mdw-csharp
2441   (c-basic-offset . 2)
2442   (c-backslash-column . 72)
2443   (c-offsets-alist (substatement-open . 0)
2444                    (label . 0)
2445                    (case-label . +)
2446                    (access-label . 0)
2447                    (inclass . +)
2448                    (statement-case-intro . +)))
2449 (mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
2450
2451 ;; Declare C# fontification style.
2452
2453 (defun mdw-fontify-csharp ()
2454
2455   ;; Other stuff.
2456   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2457
2458   ;; Now define things to be fontified.
2459   (make-local-variable 'font-lock-keywords)
2460   (let ((csharp-keywords
2461          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
2462                       "char" "checked" "class" "const" "continue" "decimal"
2463                       "default" "delegate" "do" "double" "else" "enum"
2464                       "event" "explicit" "extern" "finally" "fixed" "float"
2465                       "for" "foreach" "goto" "if" "implicit" "in" "int"
2466                       "interface" "internal" "is" "lock" "long" "namespace"
2467                       "new" "object" "operator" "out" "override" "params"
2468                       "private" "protected" "public" "readonly" "ref"
2469                       "return" "sbyte" "sealed" "short" "sizeof"
2470                       "stackalloc" "static" "string" "struct" "switch"
2471                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
2472                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
2473                       "while" "yield"))
2474
2475         (csharp-builtins
2476          (mdw-regexps "base" "false" "null" "this" "true")))
2477
2478     (setq font-lock-keywords
2479           (list
2480
2481            ;; Handle the keywords defined above.
2482            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
2483                  '(0 font-lock-keyword-face))
2484
2485            ;; Handle the magic builtins defined above.
2486            (list (concat "\\<\\(" csharp-builtins "\\)\\>")
2487                  '(0 font-lock-variable-name-face))
2488
2489            ;; Handle numbers too.
2490            ;;
2491            ;; The following isn't quite right, but it's close enough.
2492            (list (concat "\\<\\("
2493                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2494                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2495                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2496                          "[lLfFdD]?")
2497                  '(0 mdw-number-face))
2498
2499            ;; And anything else is punctuation.
2500            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2501                  '(0 mdw-punct-face))))))
2502
2503 (define-derived-mode csharp-mode java-mode "C#"
2504   "Major mode for editing C# code.")
2505
2506 (add-hook 'csharp-mode-hook 'mdw-fontify-csharp t)
2507
2508 ;;;--------------------------------------------------------------------------
2509 ;;; F# programming configuration.
2510
2511 (setq fsharp-indent-offset 2)
2512
2513 (defun mdw-fontify-fsharp ()
2514
2515   (let ((punct "=<>+-*/|&%!@?"))
2516     (do ((i 0 (1+ i)))
2517         ((>= i (length punct)))
2518       (modify-syntax-entry (aref punct i) ".")))
2519
2520   (modify-syntax-entry ?_ "_")
2521   (modify-syntax-entry ?( "(")
2522   (modify-syntax-entry ?) ")")
2523
2524   (setq indent-tabs-mode nil)
2525
2526   (let ((fsharp-keywords
2527          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
2528                       "begin" "break"
2529                       "checked" "class" "component" "const" "constraint"
2530                       "constructor" "continue"
2531                       "default" "delegate" "do" "done" "downcast" "downto"
2532                       "eager" "elif" "else" "end" "exception" "extern"
2533                       "finally" "fixed" "for" "fori" "fun" "function"
2534                       "functor"
2535                       "global"
2536                       "if" "in" "include" "inherit" "inline" "interface"
2537                       "internal"
2538                       "lazy" "let"
2539                       "match" "measure" "member" "method" "mixin" "module"
2540                       "mutable"
2541                       "namespace" "new"
2542                       "object" "of" "open" "or" "override"
2543                       "parallel" "params" "private" "process" "protected"
2544                       "public" "pure"
2545                       "rec" "recursive" "return"
2546                       "sealed" "sig" "static" "struct"
2547                       "tailcall" "then" "to" "trait" "try" "type"
2548                       "upcast" "use"
2549                       "val" "virtual" "void" "volatile"
2550                       "when" "while" "with"
2551                       "yield"))
2552
2553         (fsharp-builtins
2554          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
2555                       "base" "false" "null" "true"))
2556
2557         (bang-keywords
2558          (mdw-regexps "do" "let" "return" "use" "yield"))
2559
2560         (preprocessor-keywords
2561          (mdw-regexps "if" "indent" "else" "endif")))
2562
2563     (setq font-lock-keywords
2564           (list (list (concat "\\(^\\|[^\"]\\)"
2565                               "\\(" "(\\*"
2566                                     "[^*]*\\*+"
2567                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
2568                                     ")"
2569                               "\\|"
2570                                     "//.*"
2571                               "\\)")
2572                       '(2 font-lock-comment-face))
2573
2574                 (list (concat "'" "\\("
2575                                     "\\\\"
2576                                     "\\(" "[ntbr'\\]"
2577                                     "\\|" "[0-9][0-9][0-9]"
2578                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
2579                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
2580                                     "\\)"
2581                                   "\\|"
2582                                   "." "\\)" "'"
2583                               "\\|"
2584                               "\"" "[^\"\\]*"
2585                                     "\\(" "\\\\" "\\(.\\|\n\\)"
2586                                           "[^\"\\]*" "\\)*"
2587                               "\\(\"\\|\\'\\)")
2588                       '(0 font-lock-string-face))
2589
2590                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
2591                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
2592                               "\\|"
2593                               "\\_<\\(" fsharp-keywords "\\)\\_>")
2594                       '(0 font-lock-keyword-face))
2595                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
2596                       '(0 font-lock-variable-name-face))
2597
2598                 (list (concat "\\_<"
2599                               "\\(" "0[bB][01]+" "\\|"
2600                                     "0[oO][0-7]+" "\\|"
2601                                     "0[xX][0-9a-fA-F]+" "\\)"
2602                               "\\(" "lf\\|LF" "\\|"
2603                                     "[uU]?[ysnlL]?" "\\)"
2604                               "\\|"
2605                               "\\_<"
2606                               "[0-9]+" "\\("
2607                                 "[mMQRZING]"
2608                                 "\\|"
2609                                 "\\(\\.[0-9]*\\)?"
2610                                 "\\([eE][-+]?[0-9]+\\)?"
2611                                 "[fFmM]?"
2612                                 "\\|"
2613                                 "[uU]?[ysnlL]?"
2614                               "\\)")
2615                       '(0 mdw-number-face))
2616
2617                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2618                       '(0 mdw-punct-face))))))
2619
2620 (defun mdw-fontify-inferior-fsharp ()
2621   (mdw-fontify-fsharp)
2622   (setq font-lock-keywords
2623         (append (list (list "^[#-]" '(0 font-lock-comment-face))
2624                       (list "^>" '(0 font-lock-keyword-face)))
2625                 font-lock-keywords)))
2626
2627 (progn
2628   (add-hook 'fsharp-mode-hook 'mdw-misc-mode-config t)
2629   (add-hook 'fsharp-mode-hook 'mdw-fontify-fsharp t)
2630   (add-hook 'inferior-fsharp-mode-hooks 'mdw-fontify-inferior-fsharp t))
2631
2632 ;;;--------------------------------------------------------------------------
2633 ;;; Go programming configuration.
2634
2635 (defun mdw-fontify-go ()
2636
2637   (make-local-variable 'font-lock-keywords)
2638   (let ((go-keywords
2639          (mdw-regexps "break" "case" "chan" "const" "continue"
2640                       "default" "defer" "else" "fallthrough" "for"
2641                       "func" "go" "goto" "if" "import"
2642                       "interface" "map" "package" "range" "return"
2643                       "select" "struct" "switch" "type" "var"))
2644         (go-intrinsics
2645          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2646                       "float32" "float64" "int" "uint8" "int16" "int32"
2647                       "int64" "rune" "string" "uint" "uint8" "uint16"
2648                       "uint32" "uint64" "uintptr" "void"
2649                       "false" "iota" "nil" "true"
2650                       "init" "main"
2651                       "append" "cap" "copy" "delete" "imag" "len" "make"
2652                       "new" "panic" "real" "recover")))
2653
2654     (setq font-lock-keywords
2655           (list
2656
2657            ;; Handle the keywords defined above.
2658            (list (concat "\\<\\(" go-keywords "\\)\\>")
2659                  '(0 font-lock-keyword-face))
2660            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2661                  '(0 font-lock-variable-name-face))
2662
2663            ;; Strings and characters.
2664            (list (concat "'"
2665                          "\\(" "[^\\']" "\\|"
2666                                "\\\\"
2667                                "\\(" "[abfnrtv\\'\"]" "\\|"
2668                                      "[0-7]\\{3\\}" "\\|"
2669                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2670                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2671                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2672                          "'"
2673                          "\\|"
2674                          "\""
2675                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2676                          "\\(\"\\|$\\)"
2677                          "\\|"
2678                          "`" "[^`]+" "`")
2679                  '(0 font-lock-string-face))
2680
2681            ;; Handle numbers too.
2682            ;;
2683            ;; The following isn't quite right, but it's close enough.
2684            (list (concat "\\<\\("
2685                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2686                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2687                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
2688                  '(0 mdw-number-face))
2689
2690            ;; And anything else is punctuation.
2691            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2692                  '(0 mdw-punct-face))))))
2693 (progn
2694   (add-hook 'go-mode-hook 'mdw-misc-mode-config t)
2695   (add-hook 'go-mode-hook 'mdw-fontify-go t))
2696
2697 ;;;--------------------------------------------------------------------------
2698 ;;; Rust programming configuration.
2699
2700 (setq-default rust-indent-offset 2)
2701
2702 (defun mdw-self-insert-and-indent (count)
2703   (interactive "p")
2704   (self-insert-command count)
2705   (indent-according-to-mode))
2706
2707 (defun mdw-fontify-rust ()
2708
2709   ;; Hack syntax categories.
2710   (modify-syntax-entry ?$ ".")
2711   (modify-syntax-entry ?% ".")
2712   (modify-syntax-entry ?= ".")
2713
2714   ;; Fontify keywords and things.
2715   (make-local-variable 'font-lock-keywords)
2716   (let ((rust-keywords
2717          (mdw-regexps "abstract" "alignof" "as" "async" "await"
2718                       "become" "box" "break"
2719                       "const" "continue" "crate"
2720                       "do" "dyn"
2721                       "else" "enum" "extern"
2722                       "final" "fn" "for"
2723                       "if" "impl" "in"
2724                       "let" "loop"
2725                       "macro" "match" "mod" "move" "mut"
2726                       "offsetof" "override"
2727                       "priv" "proc" "pub" "pure"
2728                       "ref" "return"
2729                       "sizeof" "static" "struct" "super"
2730                       "trait" "try" "type" "typeof"
2731                       "union" "unsafe" "unsized" "use"
2732                       "virtual"
2733                       "where" "while"
2734                       "yield"))
2735         (rust-builtins
2736          (mdw-regexps "array" "pointer" "slice" "tuple"
2737                       "bool" "true" "false"
2738                       "f32" "f64"
2739                       "i8" "i16" "i32" "i64" "isize"
2740                       "u8" "u16" "u32" "u64" "usize"
2741                       "char" "str"
2742                       "self" "Self")))
2743     (setq font-lock-keywords
2744           (list
2745
2746            ;; Handle the keywords defined above.
2747            (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
2748                  '(0 font-lock-keyword-face))
2749            (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
2750                  '(0 font-lock-variable-name-face))
2751
2752            ;; Handle numbers too.
2753            (list (concat "\\_<\\("
2754                                "[0-9][0-9_]*"
2755                                "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2756                                "\\|" "\\.[0-9_]+"
2757                                "\\)"
2758                                "\\(f32\\|f64\\)?"
2759                          "\\|" "\\(" "[0-9][0-9_]*"
2760                                "\\|" "0x[0-9a-fA-F_]+"
2761                                "\\|" "0o[0-7_]+"
2762                                "\\|" "0b[01_]+"
2763                                "\\)"
2764                                "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
2765                          "\\)\\_>")
2766                  '(0 mdw-number-face))
2767
2768            ;; And anything else is punctuation.
2769            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2770                  '(0 mdw-punct-face)))))
2771
2772   ;; Hack key bindings.
2773   (local-set-key [?{] 'mdw-self-insert-and-indent)
2774   (local-set-key [?}] 'mdw-self-insert-and-indent))
2775
2776 (progn
2777   (add-hook 'rust-mode-hook 'mdw-misc-mode-config t)
2778   (add-hook 'rust-mode-hook 'mdw-fontify-rust t))
2779
2780 ;;;--------------------------------------------------------------------------
2781 ;;; Awk programming configuration.
2782
2783 ;; Make Awk indentation nice.
2784
2785 (mdw-define-c-style mdw-awk
2786   (c-basic-offset . 2)
2787   (c-offsets-alist (substatement-open . 0)
2788                    (c-backslash-column . 72)
2789                    (statement-cont . 0)
2790                    (statement-case-intro . +)))
2791 (mdw-set-default-c-style 'awk-mode 'mdw-awk)
2792
2793 ;; Declare Awk fontification style.
2794
2795 (defun mdw-fontify-awk ()
2796
2797   ;; Miscellaneous fiddling.
2798   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2799
2800   ;; Now define things to be fontified.
2801   (make-local-variable 'font-lock-keywords)
2802   (let ((c-keywords
2803          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2804                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2805                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2806                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
2807                       "atan2" "break" "close" "continue" "cos" "delete"
2808                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2809                       "function" "gensub" "getline" "gsub" "if" "in"
2810                       "index" "int" "length" "log" "match" "next" "rand"
2811                       "return" "print" "printf" "sin" "split" "sprintf"
2812                       "sqrt" "srand" "strftime" "sub" "substr" "system"
2813                       "systime" "tolower" "toupper" "while")))
2814
2815     (setq font-lock-keywords
2816           (list
2817
2818            ;; Handle the keywords defined above.
2819            (list (concat "\\<\\(" c-keywords "\\)\\>")
2820                  '(0 font-lock-keyword-face))
2821
2822            ;; Handle numbers too.
2823            ;;
2824            ;; The following isn't quite right, but it's close enough.
2825            (list (concat "\\<\\("
2826                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2827                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2828                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2829                          "[uUlL]*")
2830                  '(0 mdw-number-face))
2831
2832            ;; And anything else is punctuation.
2833            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2834                  '(0 mdw-punct-face))))))
2835
2836 (progn
2837   (add-hook 'awk-mode-hook 'mdw-misc-mode-config t)
2838   (add-hook 'awk-mode-hook 'mdw-fontify-awk t))
2839
2840 ;;;--------------------------------------------------------------------------
2841 ;;; Perl programming style.
2842
2843 ;; Perl indentation style.
2844
2845 (setq-default perl-indent-level 2)
2846
2847 (setq-default cperl-indent-level 2
2848               cperl-continued-statement-offset 2
2849               cperl-continued-brace-offset 0
2850               cperl-brace-offset -2
2851               cperl-brace-imaginary-offset 0
2852               cperl-label-offset 0)
2853
2854 ;; Define perl fontification style.
2855
2856 (defun mdw-fontify-perl ()
2857
2858   ;; Miscellaneous fiddling.
2859   (modify-syntax-entry ?$ "\\")
2860   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2861   (modify-syntax-entry ?: "." font-lock-syntax-table)
2862   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2863
2864   ;; Now define fontification things.
2865   (make-local-variable 'font-lock-keywords)
2866   (let ((perl-keywords
2867          (mdw-regexps "and"
2868                       "break"
2869                       "cmp" "continue"
2870                       "default" "do"
2871                       "else" "elsif" "eq"
2872                       "for" "foreach"
2873                       "ge" "given" "gt" "goto"
2874                       "if"
2875                       "last" "le" "local" "lt"
2876                       "my"
2877                       "ne" "next"
2878                       "or" "our"
2879                       "package"
2880                       "redo" "require" "return"
2881                       "sub"
2882                       "undef" "unless" "until" "use"
2883                       "when" "while")))
2884
2885     (setq font-lock-keywords
2886           (list
2887
2888            ;; Set up the keywords defined above.
2889            (list (concat "\\<\\(" perl-keywords "\\)\\>")
2890                  '(0 font-lock-keyword-face))
2891
2892            ;; At least numbers are simpler than C.
2893            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2894                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2895                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2896                  '(0 mdw-number-face))
2897
2898            ;; And anything else is punctuation.
2899            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2900                  '(0 mdw-punct-face))))))
2901
2902 (defun perl-number-tests (&optional arg)
2903   "Assign consecutive numbers to lines containing `#t'.  With ARG,
2904 strip numbers instead."
2905   (interactive "P")
2906   (save-excursion
2907     (goto-char (point-min))
2908     (let ((i 0) (fmt (if arg "" " %4d")))
2909       (while (search-forward "#t" nil t)
2910         (delete-region (point) (line-end-position))
2911         (setq i (1+ i))
2912         (insert (format fmt i)))
2913       (goto-char (point-min))
2914       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2915           (replace-match (format "\\1%d" i))))))
2916
2917 (dolist (hook '(perl-mode-hook cperl-mode-hook))
2918   (add-hook hook 'mdw-misc-mode-config t)
2919   (add-hook hook 'mdw-fontify-perl t))
2920
2921 ;;;--------------------------------------------------------------------------
2922 ;;; Python programming style.
2923
2924 (setq-default py-indent-offset 2
2925               python-indent 2
2926               python-indent-offset 2
2927               python-fill-docstring-style 'symmetric)
2928
2929 (defun mdw-fontify-pythonic (keywords)
2930
2931   ;; Miscellaneous fiddling.
2932   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2933   (setq indent-tabs-mode nil)
2934
2935   ;; Now define fontification things.
2936   (make-local-variable 'font-lock-keywords)
2937   (setq font-lock-keywords
2938         (list
2939
2940          ;; Set up the keywords defined above.
2941          (list (concat "\\_<\\(" keywords "\\)\\_>")
2942                '(0 font-lock-keyword-face))
2943
2944          ;; At least numbers are simpler than C.
2945          (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
2946                        "\\_<[0-9][0-9]*\\(\\.[0-9]*\\|\\)"
2947                        "\\([eE]\\([-+]\\|\\)[0-9]+\\|[lL]\\|\\)")
2948                '(0 mdw-number-face))
2949
2950          ;; And anything else is punctuation.
2951          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2952                '(0 mdw-punct-face)))))
2953
2954 ;; Define Python fontification styles.
2955
2956 (defun mdw-fontify-python ()
2957   (mdw-fontify-pythonic
2958    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2959                 "del" "elif" "else" "except" "exec" "finally" "for"
2960                 "from" "global" "if" "import" "in" "is" "lambda"
2961                 "not" "or" "pass" "print" "raise" "return" "try"
2962                 "while" "with" "yield")))
2963
2964 (defun mdw-fontify-pyrex ()
2965   (mdw-fontify-pythonic
2966    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2967                 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
2968                 "extern" "finally" "for" "from" "global" "if"
2969                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2970                 "property" "raise" "return" "struct" "try" "while" "with"
2971                 "yield")))
2972
2973 (define-derived-mode pyrex-mode python-mode "Pyrex"
2974   "Major mode for editing Pyrex source code")
2975 (setq auto-mode-alist
2976       (append '(("\\.pyx$" . pyrex-mode)
2977                 ("\\.pxd$" . pyrex-mode)
2978                 ("\\.pxi$" . pyrex-mode))
2979               auto-mode-alist))
2980
2981 (progn
2982   (add-hook 'python-mode-hook 'mdw-misc-mode-config t)
2983   (add-hook 'python-mode-hook 'mdw-fontify-python t)
2984   (add-hook 'pyrex-mode-hook 'mdw-fontify-pyrex t))
2985
2986 ;;;--------------------------------------------------------------------------
2987 ;;; Lua programming style.
2988
2989 (setq-default lua-indent-level 2)
2990
2991 (defun mdw-fontify-lua ()
2992
2993   ;; Miscellaneous fiddling.
2994   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2995
2996   ;; Now define fontification things.
2997   (make-local-variable 'font-lock-keywords)
2998   (let ((lua-keywords
2999          (mdw-regexps "and" "break" "do" "else" "elseif" "end"
3000                       "false" "for" "function" "goto" "if" "in" "local"
3001                       "nil" "not" "or" "repeat" "return" "then" "true"
3002                       "until" "while")))
3003     (setq font-lock-keywords
3004           (list
3005
3006            ;; Set up the keywords defined above.
3007            (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
3008                  '(0 font-lock-keyword-face))
3009
3010            ;; At least numbers are simpler than C.
3011            (list (concat "\\_<\\(" "0[xX]"
3012                                    "\\(" "[0-9a-fA-F]+"
3013                                          "\\(\\.[0-9a-fA-F]*\\)?"
3014                                    "\\|" "\\.[0-9a-fA-F]+"
3015                                    "\\)"
3016                                    "\\([pP][-+]?[0-9]+\\)?"
3017                              "\\|" "\\(" "[0-9]+"
3018                                          "\\(\\.[0-9]*\\)?"
3019                                    "\\|" "\\.[0-9]+"
3020                                    "\\)"
3021                                    "\\([eE][-+]?[0-9]+\\)?"
3022                              "\\)")
3023                  '(0 mdw-number-face))
3024
3025            ;; And anything else is punctuation.
3026            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3027                  '(0 mdw-punct-face))))))
3028
3029 (progn
3030   (add-hook 'lua-mode-hook 'mdw-misc-mode-config t)
3031   (add-hook 'lua-mode-hook 'mdw-fontify-lua t))
3032
3033 ;;;--------------------------------------------------------------------------
3034 ;;; Icon programming style.
3035
3036 ;; Icon indentation style.
3037
3038 (setq-default icon-brace-offset 0
3039               icon-continued-brace-offset 0
3040               icon-continued-statement-offset 2
3041               icon-indent-level 2)
3042
3043 ;; Define Icon fontification style.
3044
3045 (defun mdw-fontify-icon ()
3046
3047   ;; Miscellaneous fiddling.
3048   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3049
3050   ;; Now define fontification things.
3051   (make-local-variable 'font-lock-keywords)
3052   (let ((icon-keywords
3053          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
3054                       "end" "every" "fail" "global" "if" "initial"
3055                       "invocable" "link" "local" "next" "not" "of"
3056                       "procedure" "record" "repeat" "return" "static"
3057                       "suspend" "then" "to" "until" "while"))
3058         (preprocessor-keywords
3059          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
3060                       "include" "line" "undef")))
3061     (setq font-lock-keywords
3062           (list
3063
3064            ;; Set up the keywords defined above.
3065            (list (concat "\\<\\(" icon-keywords "\\)\\>")
3066                  '(0 font-lock-keyword-face))
3067
3068            ;; The things that Icon calls keywords.
3069            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
3070
3071            ;; At least numbers are simpler than C.
3072            (list (concat "\\<[0-9]+"
3073                          "\\([rR][0-9a-zA-Z]+\\|"
3074                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
3075                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
3076                  '(0 mdw-number-face))
3077
3078            ;; Preprocessor.
3079            (list (concat "^[ \t]*$[ \t]*\\<\\("
3080                          preprocessor-keywords
3081                          "\\)\\>")
3082                  '(0 font-lock-keyword-face))
3083
3084            ;; And anything else is punctuation.
3085            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3086                  '(0 mdw-punct-face))))))
3087
3088 (progn
3089   (add-hook 'icon-mode-hook 'mdw-misc-mode-config t)
3090   (add-hook 'icon-mode-hook 'mdw-fontify-icon t))
3091
3092 ;;;--------------------------------------------------------------------------
3093 ;;; Assembler mode.
3094
3095 (defun mdw-fontify-asm ()
3096   (modify-syntax-entry ?' "\"")
3097   (modify-syntax-entry ?. "w")
3098   (modify-syntax-entry ?\n ">")
3099   (setf fill-prefix nil)
3100   (modify-syntax-entry ?. "_")
3101   (modify-syntax-entry ?* ". 23")
3102   (modify-syntax-entry ?/ ". 124b")
3103   (modify-syntax-entry ?\n "> b")
3104   (local-set-key ";" 'self-insert-command)
3105   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
3106
3107 (defun mdw-asm-set-comment ()
3108   (modify-syntax-entry ?; "."
3109                        )
3110   (modify-syntax-entry asm-comment-char "< b")
3111   (setq comment-start (string asm-comment-char ? )))
3112 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
3113 (put 'asm-comment-char 'safe-local-variable 'characterp)
3114
3115 (progn
3116   (add-hook 'asm-mode-hook 'mdw-misc-mode-config t)
3117   (add-hook 'asm-mode-hook 'mdw-fontify-asm t))
3118
3119 ;;;--------------------------------------------------------------------------
3120 ;;; TCL configuration.
3121
3122 (setq-default tcl-indent-level 2)
3123
3124 (defun mdw-fontify-tcl ()
3125   (dolist (ch '(?$))
3126     (modify-syntax-entry ch "."))
3127   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3128   (make-local-variable 'font-lock-keywords)
3129   (setq font-lock-keywords
3130         (list
3131          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3132                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3133                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3134                '(0 mdw-number-face))
3135          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3136                '(0 mdw-punct-face)))))
3137
3138 (progn
3139   (add-hook 'tcl-mode-hook 'mdw-misc-mode-config t)
3140   (add-hook 'tcl-mode-hook 'mdw-fontify-tcl t))
3141
3142 ;;;--------------------------------------------------------------------------
3143 ;;; Dylan programming configuration.
3144
3145 (defun mdw-fontify-dylan ()
3146
3147   (make-local-variable 'font-lock-keywords)
3148
3149   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
3150   ;; hook, which undoes all of our configuration.
3151   (setq major-mode 'dylan-mode)
3152   (font-lock-set-defaults)
3153
3154   (let* ((word "[-_a-zA-Z!*@<>$%]+")
3155          (dylan-keywords (mdw-regexps
3156
3157                           "C-address" "C-callable-wrapper" "C-function"
3158                           "C-mapped-subtype" "C-pointer-type" "C-struct"
3159                           "C-subtype" "C-union" "C-variable"
3160
3161                           "above" "abstract" "afterwards" "all"
3162                           "begin" "below" "block" "by"
3163                           "case" "class" "cleanup" "constant" "create"
3164                           "define" "domain"
3165                           "else" "elseif" "end" "exception" "export"
3166                           "finally" "for" "from" "function"
3167                           "generic"
3168                           "handler"
3169                           "if" "in" "instance" "interface" "iterate"
3170                           "keyed-by"
3171                           "let" "library" "local"
3172                           "macro" "method" "module"
3173                           "otherwise"
3174                           "profiling"
3175                           "select" "slot" "subclass"
3176                           "table" "then" "to"
3177                           "unless" "until" "use"
3178                           "variable" "virtual"
3179                           "when" "while"))
3180          (sharp-keywords (mdw-regexps
3181                           "all-keys" "key" "next" "rest" "include"
3182                           "t" "f")))
3183     (setq font-lock-keywords
3184           (list (list (concat "\\<\\(" dylan-keywords
3185                               "\\|" "with\\(out\\)?-" word
3186                               "\\)\\>")
3187                       '(0 font-lock-keyword-face))
3188                 (list (concat "\\<" word ":" "\\|"
3189                               "#\\(" sharp-keywords "\\)\\>")
3190                       '(0 font-lock-variable-name-face))
3191                 (list (concat "\\("
3192                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
3193                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
3194                                 "\\|" "/[0-9]+"
3195                               "\\)"
3196                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
3197                               "\\|" "#b[01]+"
3198                               "\\|" "#o[0-7]+"
3199                               "\\|" "#x[0-9a-zA-Z]+"
3200                               "\\)\\>")
3201                       '(0 mdw-number-face))
3202                 (list (concat "\\("
3203                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
3204                               "\\_<[-+*/=<>:&|]+\\_>"
3205                               "\\)")
3206                       '(0 mdw-punct-face))))))
3207
3208 (progn
3209   (add-hook 'dylan-mode-hook 'mdw-misc-mode-config t)
3210   (add-hook 'dylan-mode-hook 'mdw-fontify-dylan t))
3211
3212 ;;;--------------------------------------------------------------------------
3213 ;;; Algol 68 configuration.
3214
3215 (setq-default a68-indent-step 2)
3216
3217 (defun mdw-fontify-algol-68 ()
3218
3219   ;; Fix up the syntax table.
3220   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
3221   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
3222     (modify-syntax-entry ch "." a68-mode-syntax-table))
3223
3224   (make-local-variable 'font-lock-keywords)
3225
3226   (let ((not-comment
3227          (let ((word "COMMENT"))
3228            (do ((regexp (concat "[^" (substring word 0 1) "]+")
3229                         (concat regexp "\\|"
3230                                 (substring word 0 i)
3231                                 "[^" (substring word i (1+ i)) "]"))
3232                 (i 1 (1+ i)))
3233                ((>= i (length word)) regexp)))))
3234     (setq font-lock-keywords
3235           (list (list (concat "\\<COMMENT\\>"
3236                               "\\(" not-comment "\\)\\{0,5\\}"
3237                               "\\(\\'\\|\\<COMMENT\\>\\)")
3238                       '(0 font-lock-comment-face))
3239                 (list (concat "\\<CO\\>"
3240                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
3241                               "\\($\\|\\<CO\\>\\)")
3242                       '(0 font-lock-comment-face))
3243                 (list "\\<[A-Z_]+\\>"
3244                       '(0 font-lock-keyword-face))
3245                 (list (concat "\\<"
3246                               "[0-9]+"
3247                               "\\(\\.[0-9]+\\)?"
3248                               "\\([eE][-+]?[0-9]+\\)?"
3249                               "\\>")
3250                       '(0 mdw-number-face))
3251                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
3252                       '(0 mdw-punct-face))))))
3253
3254 (dolist (hook '(a68-mode-hook a68-mode-hooks))
3255   (add-hook hook 'mdw-misc-mode-config t)
3256   (add-hook hook 'mdw-fontify-algol-68 t))
3257
3258 ;;;--------------------------------------------------------------------------
3259 ;;; REXX configuration.
3260
3261 (defun mdw-rexx-electric-* ()
3262   (interactive)
3263   (insert ?*)
3264   (rexx-indent-line))
3265
3266 (defun mdw-rexx-indent-newline-indent ()
3267   (interactive)
3268   (rexx-indent-line)
3269   (if abbrev-mode (expand-abbrev))
3270   (newline-and-indent))
3271
3272 (defun mdw-fontify-rexx ()
3273
3274   ;; Various bits of fiddling.
3275   (setq mdw-auto-indent nil)
3276   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
3277   (local-set-key [?*] 'mdw-rexx-electric-*)
3278   (dolist (ch '(?! ?? ?# ?@ ?$)) (modify-syntax-entry ch "w"))
3279   (dolist (ch '(?¬)) (modify-syntax-entry ch "."))
3280   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
3281
3282   ;; Set up keywords and things for fontification.
3283   (make-local-variable 'font-lock-keywords-case-fold-search)
3284   (setq font-lock-keywords-case-fold-search t)
3285
3286   (setq rexx-indent 2)
3287   (setq rexx-end-indent rexx-indent)
3288   (setq rexx-cont-indent rexx-indent)
3289
3290   (make-local-variable 'font-lock-keywords)
3291   (let ((rexx-keywords
3292          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
3293                       "else" "end" "engineering" "exit" "expose" "for"
3294                       "forever" "form" "fuzz" "if" "interpret" "iterate"
3295                       "leave" "linein" "name" "nop" "numeric" "off" "on"
3296                       "options" "otherwise" "parse" "procedure" "pull"
3297                       "push" "queue" "return" "say" "select" "signal"
3298                       "scientific" "source" "then" "trace" "to" "until"
3299                       "upper" "value" "var" "version" "when" "while"
3300                       "with"
3301
3302                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
3303                       "center" "center" "charin" "charout" "chars"
3304                       "compare" "condition" "copies" "c2d" "c2x"
3305                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
3306                       "errortext" "format" "fuzz" "insert" "lastpos"
3307                       "left" "length" "lineout" "lines" "max" "min"
3308                       "overlay" "pos" "queued" "random" "reverse" "right"
3309                       "sign" "sourceline" "space" "stream" "strip"
3310                       "substr" "subword" "symbol" "time" "translate"
3311                       "trunc" "value" "verify" "word" "wordindex"
3312                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
3313                       "x2d")))
3314
3315     (setq font-lock-keywords
3316           (list
3317
3318            ;; Set up the keywords defined above.
3319            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
3320                  '(0 font-lock-keyword-face))
3321
3322            ;; Fontify all symbols the same way.
3323            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
3324                          "[A-Za-z0-9.!?_#@$]+\\)")
3325                  '(0 font-lock-variable-name-face))
3326
3327            ;; And everything else is punctuation.
3328            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3329                  '(0 mdw-punct-face))))))
3330
3331 (progn
3332   (add-hook 'rexx-mode-hook 'mdw-misc-mode-config t)
3333   (add-hook 'rexx-mode-hook 'mdw-fontify-rexx t))
3334
3335 ;;;--------------------------------------------------------------------------
3336 ;;; Standard ML programming style.
3337
3338 (setq-default sml-nested-if-indent t
3339               sml-case-indent nil
3340               sml-indent-level 4
3341               sml-type-of-indent nil)
3342
3343 (defun mdw-fontify-sml ()
3344
3345   ;; Make underscore an honorary letter.
3346   (modify-syntax-entry ?' "w")
3347
3348   ;; Set fill prefix.
3349   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
3350
3351   ;; Now define fontification things.
3352   (make-local-variable 'font-lock-keywords)
3353   (let ((sml-keywords
3354          (mdw-regexps "abstype" "and" "andalso" "as"
3355                       "case"
3356                       "datatype" "do"
3357                       "else" "end" "eqtype" "exception"
3358                       "fn" "fun" "functor"
3359                       "handle"
3360                       "if" "in" "include" "infix" "infixr"
3361                       "let" "local"
3362                       "nonfix"
3363                       "of" "op" "open" "orelse"
3364                       "raise" "rec"
3365                       "sharing" "sig" "signature" "struct" "structure"
3366                       "then" "type"
3367                       "val"
3368                       "where" "while" "with" "withtype")))
3369
3370     (setq font-lock-keywords
3371           (list
3372
3373            ;; Set up the keywords defined above.
3374            (list (concat "\\<\\(" sml-keywords "\\)\\>")
3375                  '(0 font-lock-keyword-face))
3376
3377            ;; At least numbers are simpler than C.
3378            (list (concat "\\<\\(\\~\\|\\)"
3379                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
3380                                    "[wW][0-9]+\\)\\|"
3381                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
3382                                          "\\([eE]\\(\\~\\|\\)"
3383                                                 "[0-9]+\\|\\)\\)\\)")
3384                  '(0 mdw-number-face))
3385
3386            ;; And anything else is punctuation.
3387            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3388                  '(0 mdw-punct-face))))))
3389
3390 (progn
3391   (add-hook 'sml-mode-hook 'mdw-misc-mode-config t)
3392   (add-hook 'sml-mode-hook 'mdw-fontify-sml t))
3393
3394 ;;;--------------------------------------------------------------------------
3395 ;;; Haskell configuration.
3396
3397 (setq-default haskell-indent-offset 2)
3398
3399 (defun mdw-fontify-haskell ()
3400
3401   ;; Fiddle with syntax table to get comments right.
3402   (modify-syntax-entry ?' "_")
3403   (modify-syntax-entry ?- ". 12")
3404   (modify-syntax-entry ?\n ">")
3405
3406   ;; Make punctuation be punctuation
3407   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
3408     (do ((i 0 (1+ i)))
3409         ((>= i (length punct)))
3410       (modify-syntax-entry (aref punct i) ".")))
3411
3412   ;; Set fill prefix.
3413   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
3414
3415   ;; Fiddle with fontification.
3416   (make-local-variable 'font-lock-keywords)
3417   (let ((haskell-keywords
3418          (mdw-regexps "as"
3419                       "case" "ccall" "class"
3420                       "data" "default" "deriving" "do"
3421                       "else" "exists"
3422                       "forall" "foreign"
3423                       "hiding"
3424                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
3425                       "let"
3426                       "mdo" "module"
3427                       "newtype"
3428                       "of"
3429                       "proc"
3430                       "qualified"
3431                       "rec"
3432                       "safe" "stdcall"
3433                       "then" "type"
3434                       "unsafe"
3435                       "where"))
3436         (control-sequences
3437          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
3438                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
3439                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
3440                       "SP" "STX" "SUB" "SYN" "US" "VT")))
3441
3442     (setq font-lock-keywords
3443           (list
3444            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
3445                               "\\(-+}\\|-*\\'\\)"
3446                          "\\|"
3447                          "--.*$")
3448                  '(0 font-lock-comment-face))
3449            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
3450                  '(0 font-lock-keyword-face))
3451            (list (concat "'\\("
3452                          "[^\\]"
3453                          "\\|"
3454                          "\\\\"
3455                          "\\(" "[abfnrtv\\\"']" "\\|"
3456                                "^" "\\(" control-sequences "\\|"
3457                                          "[]A-Z@[\\^_]" "\\)" "\\|"
3458                                "\\|"
3459                                "[0-9]+" "\\|"
3460                                "[oO][0-7]+" "\\|"
3461                                "[xX][0-9A-Fa-f]+"
3462                          "\\)"
3463                          "\\)'")
3464                  '(0 font-lock-string-face))
3465            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
3466                  '(0 font-lock-variable-name-face))
3467            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
3468                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
3469                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
3470                  '(0 mdw-number-face))
3471            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3472                  '(0 mdw-punct-face))))))
3473
3474 (progn
3475   (add-hook 'haskell-mode-hook 'mdw-misc-mode-config t)
3476   (add-hook 'haskell-mode-hook 'mdw-fontify-haskell t))
3477
3478 ;;;--------------------------------------------------------------------------
3479 ;;; Erlang configuration.
3480
3481 (setq-default erlang-electric-commands nil)
3482
3483 (defun mdw-fontify-erlang ()
3484
3485   ;; Set fill prefix.
3486   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
3487
3488   ;; Fiddle with fontification.
3489   (make-local-variable 'font-lock-keywords)
3490   (let ((erlang-keywords
3491          (mdw-regexps "after" "and" "andalso"
3492                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
3493                       "case" "catch" "cond"
3494                       "div" "end" "fun" "if" "let" "not"
3495                       "of" "or" "orelse"
3496                       "query" "receive" "rem" "try" "when" "xor")))
3497
3498     (setq font-lock-keywords
3499           (list
3500            (list "%.*$"
3501                  '(0 font-lock-comment-face))
3502            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
3503                  '(0 font-lock-keyword-face))
3504            (list (concat "^-\\sw+\\>")
3505                  '(0 font-lock-keyword-face))
3506            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
3507                  '(0 mdw-number-face))
3508            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3509                  '(0 mdw-punct-face))))))
3510
3511 (progn
3512   (add-hook 'erlang-mode-hook 'mdw-misc-mode-config t)
3513   (add-hook 'erlang-mode-hook 'mdw-fontify-erlang t))
3514
3515 ;;;--------------------------------------------------------------------------
3516 ;;; Texinfo configuration.
3517
3518 (defun mdw-fontify-texinfo ()
3519
3520   ;; Set fill prefix.
3521   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
3522
3523   ;; Real fontification things.
3524   (make-local-variable 'font-lock-keywords)
3525   (setq font-lock-keywords
3526         (list
3527
3528          ;; Environment names are keywords.
3529          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
3530                '(2 font-lock-keyword-face))
3531
3532          ;; Unmark escaped magic characters.
3533          (list "\\(@\\)\\([@{}]\\)"
3534                '(1 font-lock-keyword-face)
3535                '(2 font-lock-variable-name-face))
3536
3537          ;; Make sure we get comments properly.
3538          (list "@c\\(\\|omment\\)\\( .*\\)?$"
3539                '(0 font-lock-comment-face))
3540
3541          ;; Command names are keywords.
3542          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3543                '(0 font-lock-keyword-face))
3544
3545          ;; Fontify TeX special characters as punctuation.
3546          (list "[{}]+"
3547                '(0 mdw-punct-face)))))
3548
3549 (dolist (hook '(texinfo-mode-hook TeXinfo-mode-hook))
3550   (add-hook hook 'mdw-misc-mode-config t)
3551   (add-hook hook 'mdw-fontify-texinfo t))
3552
3553 ;;;--------------------------------------------------------------------------
3554 ;;; TeX and LaTeX configuration.
3555
3556 (setq-default LaTeX-table-label "tbl:"
3557               TeX-auto-untabify nil
3558               LaTeX-syntactic-comments nil
3559               LaTeX-fill-break-at-separators '(\\\[))
3560
3561 (defun mdw-fontify-tex ()
3562   (setq ispell-parser 'tex)
3563   (turn-on-reftex)
3564
3565   ;; Don't make maths into a string.
3566   (modify-syntax-entry ?$ ".")
3567   (modify-syntax-entry ?$ "." font-lock-syntax-table)
3568   (local-set-key [?$] 'self-insert-command)
3569
3570   ;; Make `tab' be useful, given that tab stops in TeX don't work well.
3571   (local-set-key "\C-\M-i" 'indent-relative)
3572   (setq indent-tabs-mode nil)
3573
3574   ;; Set fill prefix.
3575   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
3576
3577   ;; Real fontification things.
3578   (make-local-variable 'font-lock-keywords)
3579   (setq font-lock-keywords
3580         (list
3581
3582          ;; Environment names are keywords.
3583          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
3584                        "{\\([^}\n]*\\)}")
3585                '(2 font-lock-keyword-face))
3586
3587          ;; Suspended environment names are keywords too.
3588          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
3589                        "{\\([^}\n]*\\)}")
3590                '(3 font-lock-keyword-face))
3591
3592          ;; Command names are keywords.
3593          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
3594                '(0 font-lock-keyword-face))
3595
3596          ;; Handle @/.../ for italics.
3597          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
3598          ;;       '(1 font-lock-keyword-face)
3599          ;;       '(3 font-lock-keyword-face))
3600
3601          ;; Handle @*...* for boldness.
3602          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
3603          ;;       '(1 font-lock-keyword-face)
3604          ;;       '(3 font-lock-keyword-face))
3605
3606          ;; Handle @`...' for literal syntax things.
3607          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
3608          ;;       '(1 font-lock-keyword-face)
3609          ;;       '(3 font-lock-keyword-face))
3610
3611          ;; Handle @<...> for nonterminals.
3612          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
3613          ;;       '(1 font-lock-keyword-face)
3614          ;;       '(3 font-lock-keyword-face))
3615
3616          ;; Handle other @-commands.
3617          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
3618          ;;       '(0 font-lock-keyword-face))
3619
3620          ;; Make sure we get comments properly.
3621          (list "%.*"
3622                '(0 font-lock-comment-face))
3623
3624          ;; Fontify TeX special characters as punctuation.
3625          (list "[$^_{}#&]"
3626                '(0 mdw-punct-face)))))
3627
3628 (setq TeX-install-font-lock 'tex-font-setup)
3629
3630 (eval-after-load 'font-latex
3631   '(defun font-latex-jit-lock-force-redisplay (buf start end)
3632      "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
3633      ;; The following block is an expansion of `jit-lock-force-redisplay'
3634      ;; and involved macros taken from CVS Emacs on 2007-04-28.
3635      (with-current-buffer buf
3636        (let ((modified (buffer-modified-p)))
3637          (unwind-protect
3638              (let ((buffer-undo-list t)
3639                    (inhibit-read-only t)
3640                    (inhibit-point-motion-hooks t)
3641                    (inhibit-modification-hooks t)
3642                    deactivate-mark
3643                    buffer-file-name
3644                    buffer-file-truename)
3645                (put-text-property start end 'fontified t))
3646            (unless modified
3647              (restore-buffer-modified-p nil)))))))
3648
3649 (setq TeX-output-view-style
3650       '(("^dvi$"
3651          ("^landscape$" "^pstricks$\\|^pst-\\|^psfrag$")
3652          "%(o?)dvips -t landscape %d -o && xdg-open %f")
3653         ("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$"
3654          "%(o?)dvips %d -o && xdg-open %f")
3655         ("^dvi$"
3656          ("^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$" "^landscape$")
3657          "%(o?)xdvi %dS -paper a4r -s 0 %d")
3658         ("^dvi$" "^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$"
3659          "%(o?)xdvi %dS -paper a4 %d")
3660         ("^dvi$"
3661          ("^a5\\(?:comb\\|paper\\)$" "^landscape$")
3662          "%(o?)xdvi %dS -paper a5r -s 0 %d")
3663         ("^dvi$" "^a5\\(?:comb\\|paper\\)$" "%(o?)xdvi %dS -paper a5 %d")
3664         ("^dvi$" "^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
3665         ("^dvi$" "^letterpaper$" "%(o?)xdvi %dS -paper us %d")
3666         ("^dvi$" "^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
3667         ("^dvi$" "^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
3668         ("^dvi$" "." "%(o?)xdvi %dS %d")
3669         ("^pdf$" "." "xdg-open %o")
3670         ("^html?$" "." "sensible-browser %o")))
3671
3672 (setq TeX-view-program-list
3673       '(("mupdf" ("mupdf %o" (mode-io-correlate " %(outpage)")))))
3674
3675 (setq TeX-view-program-selection
3676       '(((output-dvi style-pstricks) "dvips and gv")
3677         (output-dvi "xdvi")
3678         (output-pdf "mupdf")
3679         (output-html "sensible-browser")))
3680
3681 (setq TeX-open-quote "\""
3682       TeX-close-quote "\"")
3683
3684 (setq reftex-use-external-file-finders t
3685       reftex-auto-recenter-toc t)
3686
3687 (setq reftex-label-alist
3688       '(("theorem" ?T "th:" "~\\ref{%s}" t ("theorems?" "th\\.") -2)
3689         ("axiom" ?A "ax:" "~\\ref{%s}" t ("axioms?" "ax\\.") -2)
3690         ("definition" ?D "def:" "~\\ref{%s}" t ("definitions?" "def\\.") -2)
3691         ("proposition" ?P "prop:" "~\\ref{%s}" t
3692          ("propositions?" "prop\\.") -2)
3693         ("lemma" ?L "lem:" "~\\ref{%s}" t ("lemmas?" "lem\\.") -2)
3694         ("example" ?X "eg:" "~\\ref{%s}" t ("examples?") -2)
3695         ("exercise" ?E "ex:" "~\\ref{%s}" t ("exercises?" "ex\\.") -2)
3696         ("enumerate" ?i "i:" "~\\ref{%s}" item ("items?"))))
3697 (setq reftex-section-prefixes
3698       '((0 . "part:")
3699         (1 . "ch:")
3700         (t . "sec:")))
3701
3702 (setq bibtex-field-delimiters 'double-quotes
3703       bibtex-align-at-equal-sign t
3704       bibtex-entry-format '(realign opts-or-alts required-fields
3705                             numerical-fields last-comma delimiters
3706                             unify-case sort-fields braces)
3707       bibtex-sort-ignore-string-entries nil
3708       bibtex-maintain-sorted-entries 'entry-class
3709       bibtex-include-OPTkey t
3710       bibtex-autokey-names-stretch 1
3711       bibtex-autokey-expand-strings t
3712       bibtex-autokey-name-separator "-"
3713       bibtex-autokey-year-length 4
3714       bibtex-autokey-titleword-separator "-"
3715       bibtex-autokey-name-year-separator "-"
3716       bibtex-autokey-year-title-separator ":")
3717
3718 (progn
3719   (dolist (hook '(tex-mode-hook latex-mode-hook
3720                                 TeX-mode-hook LaTeX-mode-hook))
3721     (add-hook hook 'mdw-misc-mode-config t)
3722     (add-hook hook 'mdw-fontify-tex t))
3723   (add-hook 'bibtex-mode-hook (lambda () (setq fill-column 76))))
3724
3725 ;;;--------------------------------------------------------------------------
3726 ;;; HTML, CSS, and other web foolishness.
3727
3728 (setq-default css-indent-offset 2)
3729
3730 ;;;--------------------------------------------------------------------------
3731 ;;; SGML hacking.
3732
3733 (setq-default psgml-html-build-new-buffer nil)
3734
3735 (defun mdw-sgml-mode ()
3736   (interactive)
3737   (sgml-mode)
3738   (mdw-standard-fill-prefix "")
3739   (make-local-variable 'sgml-delimiters)
3740   (setq sgml-delimiters
3741         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
3742           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
3743           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
3744           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
3745           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
3746           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
3747           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
3748           "NULL" ""))
3749   (setq major-mode 'mdw-sgml-mode)
3750   (setq mode-name "[mdw] SGML")
3751   (run-hooks 'mdw-sgml-mode-hook))
3752
3753 ;;;--------------------------------------------------------------------------
3754 ;;; Configuration files.
3755
3756 (defvar mdw-conf-quote-normal nil
3757   "*Control syntax category of quote characters `\"' and `''.
3758 If this is `t', consider quote characters to be normal
3759 punctuation, as for `conf-quote-normal'.  If this is `nil' then
3760 leave quote characters as quotes.  If this is a list, then
3761 consider the quote characters in the list to be normal
3762 punctuation.  If this is a single quote character, then consider
3763 that character only to be normal punctuation.")
3764 (defun mdw-conf-quote-normal-acceptable-value-p (value)
3765   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
3766   (or (booleanp value)
3767       (every (lambda (v) (memq v '(?\" ?')))
3768              (if (listp value) value (list value)))))
3769 (put 'mdw-conf-quote-normal 'safe-local-variable
3770      'mdw-conf-quote-normal-acceptable-value-p)
3771
3772 (defun mdw-fix-up-quote ()
3773   "Apply the setting of `mdw-conf-quote-normal'."
3774   (let ((flag mdw-conf-quote-normal))
3775     (cond ((eq flag t)
3776            (conf-quote-normal t))
3777           ((not flag)
3778            nil)
3779           (t
3780            (let ((table (copy-syntax-table (syntax-table))))
3781              (dolist (ch (if (listp flag) flag (list flag)))
3782                (modify-syntax-entry ch "." table))
3783              (set-syntax-table table)
3784              (and font-lock-mode (font-lock-fontify-buffer)))))))
3785
3786 (progn
3787   (add-hook 'conf-mode-hook 'mdw-misc-mode-config t)
3788   (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t))
3789
3790 ;;;--------------------------------------------------------------------------
3791 ;;; Shell scripts.
3792
3793 (defun mdw-setup-sh-script-mode ()
3794
3795   ;; Fetch the shell interpreter's name.
3796   (let ((shell-name sh-shell-file))
3797
3798     ;; Try reading the hash-bang line.
3799     (save-excursion
3800       (goto-char (point-min))
3801       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
3802           (setq shell-name (match-string 1))))
3803
3804     ;; Now try to set the shell.
3805     ;;
3806     ;; Don't let `sh-set-shell' bugger up my script.
3807     (let ((executable-set-magic #'(lambda (s &rest r) s)))
3808       (sh-set-shell shell-name)))
3809
3810   ;; Don't insert here-document scaffolding automatically.
3811   (local-set-key "<" 'self-insert-command)
3812
3813   ;; Now enable my keys and the fontification.
3814   (mdw-misc-mode-config)
3815
3816   ;; Set the indentation level correctly.
3817   (setq sh-indentation 2)
3818   (setq sh-basic-offset 2))
3819
3820 (setq sh-shell-file "/bin/sh")
3821
3822 ;; Awful hacking to override the shell detection for particular scripts.
3823 (defmacro define-custom-shell-mode (name shell)
3824   `(defun ,name ()
3825      (interactive)
3826      (set (make-local-variable 'sh-shell-file) ,shell)
3827      (sh-mode)))
3828 (define-custom-shell-mode bash-mode "/bin/bash")
3829 (define-custom-shell-mode rc-mode "/usr/bin/rc")
3830 (put 'sh-shell-file 'permanent-local t)
3831
3832 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
3833 (eval-after-load "sh-script"
3834   '(or (assq 'rc sh-mode-syntax-table-input)
3835        (let ((frag '(nil
3836                      ?# "<"
3837                      ?\n ">#"
3838                      ?\" "\"\""
3839                      ?\' "\"\'"
3840                      ?$ "'"
3841                      ?\` "."
3842                      ?! "_"
3843                      ?% "_"
3844                      ?. "_"
3845                      ?^ "_"
3846                      ?~ "_"
3847                      ?, "_"
3848                      ?= "."
3849                      ?< "."
3850                      ?> "."))
3851              (assoc (assq 'rc sh-mode-syntax-table-input)))
3852          (if assoc
3853              (rplacd assoc frag)
3854            (setq sh-mode-syntax-table-input
3855                  (cons (cons 'rc frag)
3856                        sh-mode-syntax-table-input))))))
3857
3858 (progn
3859   (add-hook 'sh-mode-hook 'mdw-misc-mode-config t)
3860   (add-hook 'sh-mode-hook 'mdw-setup-sh-script-mode t))
3861
3862 ;;;--------------------------------------------------------------------------
3863 ;;; Emacs shell mode.
3864
3865 (defun mdw-eshell-prompt ()
3866   (let ((left "[") (right "]"))
3867     (when (= (user-uid) 0)
3868       (setq left "«" right "»"))
3869     (concat left
3870             (save-match-data
3871               (replace-regexp-in-string "\\..*$" "" (system-name)))
3872             " "
3873             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
3874                    (home (expand-file-name "~")) (nhome (length home)))
3875               (if (and (>= npwd nhome)
3876                        (or (= nhome npwd)
3877                            (= (elt pwd nhome) ?/))
3878                        (string= (substring pwd 0 nhome) home))
3879                   (concat "~" (substring pwd (length home)))
3880                 pwd))
3881             right)))
3882 (setq-default eshell-prompt-function 'mdw-eshell-prompt)
3883 (setq-default eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
3884
3885 (defun eshell/e (file) (find-file file) nil)
3886 (defun eshell/ee (file) (find-file-other-window file) nil)
3887 (defun eshell/w3m (url) (w3m-goto-url url) nil)
3888
3889 (mdw-define-face eshell-prompt (t :weight bold))
3890 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
3891 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
3892 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
3893 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
3894 (mdw-define-face eshell-ls-executable (t :weight bold))
3895 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
3896 (mdw-define-face eshell-ls-readonly (t nil))
3897 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
3898
3899 (defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
3900 (add-hook 'eshell-mode-hook 'mdw-eshell-hack)
3901
3902 ;;;--------------------------------------------------------------------------
3903 ;;; Messages-file mode.
3904
3905 (defun messages-mode-guts ()
3906   (setq messages-mode-syntax-table (make-syntax-table))
3907   (set-syntax-table messages-mode-syntax-table)
3908   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
3909   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
3910   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
3911   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
3912   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
3913   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
3914   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
3915   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
3916   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
3917   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
3918   (make-local-variable 'comment-start)
3919   (make-local-variable 'comment-end)
3920   (make-local-variable 'indent-line-function)
3921   (setq indent-line-function 'indent-relative)
3922   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3923   (make-local-variable 'font-lock-defaults)
3924   (make-local-variable 'messages-mode-keywords)
3925   (let ((keywords
3926          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
3927                       "export" "enum" "fixed-octetstring" "flags"
3928                       "harmless" "map" "nested" "optional"
3929                       "optional-tagged" "package" "primitive"
3930                       "primitive-nullfree" "relaxed[ \t]+enum"
3931                       "set" "table" "tagged-optional"   "union"
3932                       "variadic" "vector" "version" "version-tag")))
3933     (setq messages-mode-keywords
3934           (list
3935            (list (concat "\\<\\(" keywords "\\)\\>:")
3936                  '(0 font-lock-keyword-face))
3937            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
3938            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
3939              (0 font-lock-variable-name-face))
3940            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
3941            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3942              (0 mdw-punct-face)))))
3943   (setq font-lock-defaults
3944         '(messages-mode-keywords nil nil nil nil))
3945   (run-hooks 'messages-file-hook))
3946
3947 (defun messages-mode ()
3948   (interactive)
3949   (fundamental-mode)
3950   (setq major-mode 'messages-mode)
3951   (setq mode-name "Messages")
3952   (messages-mode-guts)
3953   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3954   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3955   (setq comment-start "# ")
3956   (setq comment-end "")
3957   (run-hooks 'messages-mode-hook))
3958
3959 (defun cpp-messages-mode ()
3960   (interactive)
3961   (fundamental-mode)
3962   (setq major-mode 'cpp-messages-mode)
3963   (setq mode-name "CPP Messages")
3964   (messages-mode-guts)
3965   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3966   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3967   (setq comment-start "/* ")
3968   (setq comment-end " */")
3969   (let ((preprocessor-keywords
3970          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3971                       "ident" "if" "ifdef" "ifndef" "import" "include"
3972                       "line" "pragma" "unassert" "undef" "warning")))
3973     (setq messages-mode-keywords
3974           (append (list (list (concat "^[ \t]*\\#[ \t]*"
3975                                       "\\(include\\|import\\)"
3976                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3977                               '(2 font-lock-string-face))
3978                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3979                                       preprocessor-keywords
3980                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
3981                               '(1 font-lock-keyword-face)))
3982                   messages-mode-keywords)))
3983   (run-hooks 'cpp-messages-mode-hook))
3984
3985 (progn
3986   (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3987   (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
3988   ;; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3989   )
3990
3991 ;;;--------------------------------------------------------------------------
3992 ;;; Messages-file mode.
3993
3994 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3995   "Face to use for subsittution directives.")
3996 (make-face 'mallow-driver-substitution-face)
3997 (defvar mallow-driver-text-face 'mallow-driver-text-face
3998   "Face to use for body text.")
3999 (make-face 'mallow-driver-text-face)
4000
4001 (defun mallow-driver-mode ()
4002   (interactive)
4003   (fundamental-mode)
4004   (setq major-mode 'mallow-driver-mode)
4005   (setq mode-name "Mallow driver")
4006   (setq mallow-driver-mode-syntax-table (make-syntax-table))
4007   (set-syntax-table mallow-driver-mode-syntax-table)
4008   (make-local-variable 'comment-start)
4009   (make-local-variable 'comment-end)
4010   (make-local-variable 'indent-line-function)
4011   (setq indent-line-function 'indent-relative)
4012   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4013   (make-local-variable 'font-lock-defaults)
4014   (make-local-variable 'mallow-driver-mode-keywords)
4015   (let ((keywords
4016          (mdw-regexps "each" "divert" "file" "if"
4017                       "perl" "set" "string" "type" "write")))
4018     (setq mallow-driver-mode-keywords
4019           (list
4020            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
4021                  '(0 font-lock-keyword-face))
4022            (list "^%\\s *\\(#.*\\|\\)$"
4023                  '(0 font-lock-comment-face))
4024            (list "^%"
4025                  '(0 font-lock-keyword-face))
4026            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
4027            (list "\\${[^}]*}"
4028                  '(0 mallow-driver-substitution-face t)))))
4029   (setq font-lock-defaults
4030         '(mallow-driver-mode-keywords nil nil nil nil))
4031   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
4032   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
4033   (setq comment-start "%# ")
4034   (setq comment-end "")
4035   (run-hooks 'mallow-driver-mode-hook))
4036
4037 (progn
4038   (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t))
4039
4040 ;;;--------------------------------------------------------------------------
4041 ;;; NFast debugs.
4042
4043 (defun nfast-debug-mode ()
4044   (interactive)
4045   (fundamental-mode)
4046   (setq major-mode 'nfast-debug-mode)
4047   (setq mode-name "NFast debug")
4048   (setq messages-mode-syntax-table (make-syntax-table))
4049   (set-syntax-table messages-mode-syntax-table)
4050   (make-local-variable 'font-lock-defaults)
4051   (make-local-variable 'nfast-debug-mode-keywords)
4052   (setq truncate-lines t)
4053   (setq nfast-debug-mode-keywords
4054         (list
4055          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
4056            (0 font-lock-keyword-face))
4057          (list (concat "^[ \t]+\\(\\("
4058                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
4059                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
4060                        "[ \t]+\\)*"
4061                        "[0-9a-fA-F]+\\)[ \t]*$")
4062            '(0 mdw-number-face))
4063          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
4064            (1 font-lock-keyword-face))
4065          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
4066            (1 font-lock-warning-face))
4067          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
4068            (1 nil))
4069          (list (concat "^[ \t]+\\.cmd=[ \t]+"
4070                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
4071            '(1 font-lock-keyword-face))
4072          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
4073          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
4074          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
4075          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
4076   (setq font-lock-defaults
4077         '(nfast-debug-mode-keywords nil nil nil nil))
4078   (run-hooks 'nfast-debug-mode-hook))
4079
4080 ;;;--------------------------------------------------------------------------
4081 ;;; Lispy languages.
4082
4083 ;; Unpleasant bodge.
4084 (unless (boundp 'slime-repl-mode-map)
4085   (setq slime-repl-mode-map (make-sparse-keymap)))
4086
4087 (defun mdw-indent-newline-and-indent ()
4088   (interactive)
4089   (indent-for-tab-command)
4090   (newline-and-indent))
4091
4092 (eval-after-load "cl-indent"
4093   '(progn
4094      (mapc #'(lambda (pair)
4095                (put (car pair)
4096                     'common-lisp-indent-function
4097                     (cdr pair)))
4098       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
4099         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
4100
4101 (defun mdw-common-lisp-indent ()
4102   (make-local-variable 'lisp-indent-function)
4103   (setq lisp-indent-function 'common-lisp-indent-function))
4104
4105 (setq-default lisp-simple-loop-indentation 2
4106               lisp-loop-keyword-indentation 6
4107               lisp-loop-forms-indentation 6)
4108
4109 (defmacro mdw-advise-hyperspec-lookup (func args)
4110   `(defadvice ,func (around mdw-browse-w3m ,args activate compile)
4111      (if (fboundp 'w3m)
4112          (let ((browse-url-browser-function #'mdw-w3m-browse-url))
4113            ad-do-it)
4114        ad-do-it)))
4115 (mdw-advise-hyperspec-lookup common-lisp-hyperspec (symbol))
4116 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-format (char))
4117 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-lookup-reader-macro (char))
4118
4119 (defun mdw-fontify-lispy ()
4120
4121   ;; Set fill prefix.
4122   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
4123
4124   ;; Not much fontification needed.
4125   (make-local-variable 'font-lock-keywords)
4126   (setq font-lock-keywords
4127         (list (list (concat "\\("
4128                             "\\_<[-+]?"
4129                             "\\(" "[0-9]+/[0-9]+"
4130                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
4131                                         "\\.[0-9]+" "\\)"
4132                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
4133                             "\\)"
4134                             "\\|"
4135                             "#"
4136                             "\\(" "x" "[-+]?"
4137                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
4138                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
4139                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
4140                             "\\|" "[0-9]+" "r" "[-+]?"
4141                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
4142                             "\\)"
4143                             "\\)\\_>")
4144                     '(0 mdw-number-face))
4145               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4146                     '(0 mdw-punct-face)))))
4147
4148 ;; SLIME setup.
4149
4150 (trap
4151  (if (not mdw-fast-startup)
4152      (progn
4153        (require 'slime-autoloads)
4154        (slime-setup '(slime-autodoc slime-c-p-c)))))
4155
4156 (let ((stuff '((cmucl ("cmucl"))
4157                (sbcl ("sbcl") :coding-system utf-8-unix)
4158                (clisp ("clisp") :coding-system utf-8-unix))))
4159   (or (boundp 'slime-lisp-implementations)
4160       (setq slime-lisp-implementations nil))
4161   (while stuff
4162     (let* ((head (car stuff))
4163            (found (assq (car head) slime-lisp-implementations)))
4164       (setq stuff (cdr stuff))
4165       (if found
4166           (rplacd found (cdr head))
4167         (setq slime-lisp-implementations
4168               (cons head slime-lisp-implementations))))))
4169 (setq slime-default-lisp 'sbcl)
4170
4171 ;; Hooks.
4172
4173 (progn
4174   (dolist (hook '(emacs-lisp-mode-hook
4175                   scheme-mode-hook
4176                   lisp-mode-hook
4177                   inferior-lisp-mode-hook
4178                   lisp-interaction-mode-hook
4179                   ielm-mode-hook
4180                   slime-repl-mode-hook))
4181     (add-hook hook 'mdw-misc-mode-config t)
4182     (add-hook hook 'mdw-fontify-lispy t))
4183   (add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
4184   (add-hook 'inferior-lisp-mode-hook
4185             #'(lambda () (local-set-key "\C-m" 'comint-send-and-indent)) t))
4186
4187 ;;;--------------------------------------------------------------------------
4188 ;;; Other languages.
4189
4190 ;; Smalltalk.
4191
4192 (defun mdw-setup-smalltalk ()
4193   (and mdw-auto-indent
4194        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
4195   (make-local-variable 'mdw-auto-indent)
4196   (setq mdw-auto-indent nil)
4197   (local-set-key "\C-i" 'smalltalk-reindent))
4198
4199 (defun mdw-fontify-smalltalk ()
4200   (make-local-variable 'font-lock-keywords)
4201   (setq font-lock-keywords
4202         (list
4203          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
4204                '(0 font-lock-keyword-face))
4205          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
4206                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
4207                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
4208                '(0 mdw-number-face))
4209          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4210                '(0 mdw-punct-face)))))
4211
4212 (progn
4213   (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
4214   (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
4215
4216 ;; m4.
4217
4218 (defun mdw-setup-m4 ()
4219
4220   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
4221   ;; annoying: fix it.
4222   (modify-syntax-entry ?{ "(")
4223   (modify-syntax-entry ?} ")")
4224
4225   ;; Fill prefix.
4226   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
4227
4228 (dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
4229   (add-hook hook #'mdw-misc-mode-config t)
4230   (add-hook hook #'mdw-setup-m4 t))
4231
4232 ;; Make.
4233
4234 (progn
4235   (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
4236
4237 ;;;--------------------------------------------------------------------------
4238 ;;; Text mode.
4239
4240 (defun mdw-text-mode ()
4241   (setq fill-column 72)
4242   (flyspell-mode t)
4243   (mdw-standard-fill-prefix
4244    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
4245   (auto-fill-mode 1))
4246
4247 (eval-after-load "flyspell"
4248   '(define-key flyspell-mode-map "\C-\M-i" nil))
4249
4250 (progn
4251   (add-hook 'text-mode-hook 'mdw-text-mode t))
4252
4253 ;;;--------------------------------------------------------------------------
4254 ;;; Outline and hide/show modes.
4255
4256 (defun mdw-outline-collapse-all ()
4257   "Completely collapse everything in the entire buffer."
4258   (interactive)
4259   (save-excursion
4260     (goto-char (point-min))
4261     (while (< (point) (point-max))
4262       (hide-subtree)
4263       (forward-line))))
4264
4265 (setq hs-hide-comments-when-hiding-all nil)
4266
4267 (defadvice hs-hide-all (after hide-first-comment activate)
4268   (save-excursion (hs-hide-initial-comment-block)))
4269
4270 ;;;--------------------------------------------------------------------------
4271 ;;; Shell mode.
4272
4273 (defun mdw-sh-mode-setup ()
4274   (local-set-key [?\C-a] 'comint-bol)
4275   (add-hook 'comint-output-filter-functions
4276             'comint-watch-for-password-prompt))
4277
4278 (defun mdw-term-mode-setup ()
4279   (setq term-prompt-regexp shell-prompt-pattern)
4280   (make-local-variable 'mouse-yank-at-point)
4281   (make-local-variable 'transient-mark-mode)
4282   (setq mouse-yank-at-point t)
4283   (auto-fill-mode -1)
4284   (setq tab-width 8))
4285
4286 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
4287 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
4288 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
4289 (defun term-send-meta-meta-something ()
4290   (interactive)
4291   (term-send-raw-string "\e\e")
4292   (term-send-raw))
4293 (eval-after-load 'term
4294   '(progn
4295      (define-key term-raw-map [?\e ?\e] nil)
4296      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
4297      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
4298      (define-key term-raw-map [M-right] 'term-send-meta-right)
4299      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
4300      (define-key term-raw-map [M-left] 'term-send-meta-left)
4301      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
4302
4303 (defadvice term-exec (before program-args-list compile activate)
4304   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
4305 This allows you to pass a list of arguments through `ansi-term'."
4306   (let ((program (ad-get-arg 2)))
4307     (if (listp program)
4308         (progn
4309           (ad-set-arg 2 (car program))
4310           (ad-set-arg 4 (cdr program))))))
4311
4312 (defadvice term-exec-1 (around hack-environment compile activate)
4313   "Hack the environment inherited by inferiors in the terminal."
4314   (let ((process-environment (copy-tree process-environment)))
4315     (setenv "LD_PRELOAD" nil)
4316     ad-do-it))
4317
4318 (defadvice shell (around hack-environment compile activate)
4319   "Hack the environment inherited by inferiors in the shell."
4320   (let ((process-environment (copy-tree process-environment)))
4321     (setenv "LD_PRELOAD" nil)
4322     ad-do-it))
4323
4324 (defun ssh (host)
4325   "Open a terminal containing an ssh session to the HOST."
4326   (interactive "sHost: ")
4327   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
4328
4329 (defvar git-grep-command
4330   "env GIT_PAGER=cat git grep --no-color -nH -e "
4331   "*The default command for \\[git-grep].")
4332
4333 (defvar git-grep-history nil)
4334
4335 (defun git-grep (command-args)
4336   "Run `git grep' with user-specified args and collect output in a buffer."
4337   (interactive
4338    (list (read-shell-command "Run git grep (like this): "
4339                              git-grep-command 'git-grep-history)))
4340   (let ((grep-use-null-device nil))
4341     (grep command-args)))
4342
4343 ;;;--------------------------------------------------------------------------
4344 ;;; Magit configuration.
4345
4346 (setq magit-diff-refine-hunk 't
4347       magit-view-git-manual-method 'man
4348       magit-log-margin '(nil age magit-log-margin-width t 18)
4349       magit-wip-after-save-local-mode-lighter ""
4350       magit-wip-after-apply-mode-lighter ""
4351       magit-wip-before-change-mode-lighter "")
4352 (eval-after-load "magit"
4353   '(progn (global-magit-file-mode 1)
4354           (magit-wip-after-save-mode 1)
4355           (magit-wip-after-apply-mode 1)
4356           (magit-wip-before-change-mode 1)
4357           (add-to-list 'magit-no-confirm 'safe-with-wip)
4358           (add-to-list 'magit-no-confirm 'trash)
4359           (push '(:eval (if (or magit-wip-after-save-local-mode
4360                                 magit-wip-after-apply-mode
4361                                 magit-wip-before-change-mode)
4362                             (format " wip:%s%s%s"
4363                                     (if magit-wip-after-apply-mode "A" "")
4364                                     (if magit-wip-before-change-mode "C" "")
4365                                     (if magit-wip-after-save-local-mode "S" ""))))
4366                 minor-mode-alist)
4367           (dolist (popup '(magit-diff-popup
4368                            magit-diff-refresh-popup
4369                            magit-diff-mode-refresh-popup
4370                            magit-revision-mode-refresh-popup))
4371             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))))
4372
4373 (defadvice magit-wip-commit-buffer-file
4374     (around mdw-just-this-buffer activate compile)
4375   (let ((magit-save-repository-buffers nil)) ad-do-it))
4376
4377 (defadvice magit-discard
4378     (around mdw-delete-if-prefix-argument activate compile)
4379   (let ((magit-delete-by-moving-to-trash
4380          (and (null current-prefix-arg)
4381               magit-delete-by-moving-to-trash)))
4382     ad-do-it))
4383
4384 (setq magit-repolist-columns
4385       '(("Name" 16 magit-repolist-column-ident nil)
4386         ("Version" 18 magit-repolist-column-version nil)
4387         ("St" 2 magit-repolist-column-dirty nil)
4388         ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
4389         ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
4390         ("Path" 32 magit-repolist-column-path nil)))
4391
4392 (setq magit-repository-directories '(("~/etc/profile" . 0)
4393                                      ("~/src/" . 1)))
4394
4395 (defadvice magit-list-repos (around mdw-dirname () activate compile)
4396   "Make sure the returned names are directory names.
4397 Otherwise child processes get started in the wrong directory and
4398 there is sadness."
4399   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
4400
4401 (defun mdw-repolist-column-unpulled-from-upstream (_id)
4402   "Insert number of upstream commits not in the current branch."
4403   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4404     (and upstream
4405          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
4406            (propertize (number-to-string n) 'face
4407                        (if (> n 0) 'bold 'shadow))))))
4408
4409 (defun mdw-repolist-column-unpushed-to-upstream (_id)
4410   "Insert number of commits in the current branch but not its upstream."
4411   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
4412     (and upstream
4413          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
4414            (propertize (number-to-string n) 'face
4415                        (if (> n 0) 'bold 'shadow))))))
4416
4417 (defun mdw-try-smerge ()
4418   (save-excursion
4419     (goto-char (point-min))
4420     (when (re-search-forward "^<<<<<<< " nil t)
4421       (smerge-mode 1))))
4422 (add-hook 'find-file-hook 'mdw-try-smerge t)
4423
4424 ;;;--------------------------------------------------------------------------
4425 ;;; GUD, and especially GDB.
4426
4427 ;; Inhibit window dedication.  I mean, seriously, wtf?
4428 (defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
4429   "Don't make windows dedicated.  Seriously."
4430   (set-window-dedicated-p ad-return-value nil))
4431 (defadvice gdb-set-window-buffer
4432     (after mdw-undedicated (name &optional ignore-dedicated window)
4433      compile activate)
4434   "Don't make windows dedicated.  Seriously."
4435   (set-window-dedicated-p (or window (selected-window)) nil))
4436
4437 ;;;--------------------------------------------------------------------------
4438 ;;; MPC configuration.
4439
4440 (eval-when-compile (trap (require 'mpc)))
4441
4442 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
4443
4444 (defun mdw-mpc-now-playing ()
4445   (interactive)
4446   (require 'mpc)
4447   (save-excursion
4448     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
4449     (mpc--status-callback))
4450   (let ((state (cdr (assq 'state mpc-status))))
4451     (cond ((member state '("stop"))
4452            (message "mpd stopped."))
4453           ((member state '("play" "pause"))
4454            (let* ((artist (cdr (assq 'Artist mpc-status)))
4455                   (album (cdr (assq 'Album mpc-status)))
4456                   (title (cdr (assq 'Title mpc-status)))
4457                   (file (cdr (assq 'file mpc-status)))
4458                   (duration-string (cdr (assq 'Time mpc-status)))
4459                   (time-string (cdr (assq 'time mpc-status)))
4460                   (time (and time-string
4461                              (string-to-number
4462                               (if (string-match ":" time-string)
4463                                   (substring time-string
4464                                              0 (match-beginning 0))
4465                                 (time-string)))))
4466                   (duration (and duration-string
4467                                  (string-to-number duration-string)))
4468                   (pos (and time duration
4469                             (format " [%d:%02d/%d:%02d]"
4470                                     (/ time 60) (mod time 60)
4471                                     (/ duration 60) (mod duration 60))))
4472                   (fmt (cond ((and artist title)
4473                               (format "`%s' by %s%s" title artist
4474                                       (if album (format ", from `%s'" album)
4475                                         "")))
4476                              (file
4477                               (format "`%s' (no tags)" file))
4478                              (t
4479                               "(no idea what's playing!)"))))
4480              (if (string= state "play")
4481                  (message "mpd playing %s%s" fmt (or pos ""))
4482                (message "mpd paused in %s%s" fmt (or pos "")))))
4483           (t
4484            (message "mpd in unknown state `%s'" state)))))
4485
4486 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
4487   `(defun ,func ,bvl
4488      (interactive ,@interactive)
4489      (require 'mpc)
4490      ,@body
4491      (mdw-mpc-now-playing)))
4492
4493 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
4494   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
4495       (mpc-pause)
4496     (mpc-play)))
4497
4498 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
4499 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
4500 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
4501
4502 (defun mdw-mpc-louder (step)
4503   (interactive (list (if current-prefix-arg
4504                          (prefix-numeric-value current-prefix-arg)
4505                        +10)))
4506   (mpc-proc-cmd (format "volume %+d" step)))
4507
4508 (defun mdw-mpc-quieter (step)
4509   (interactive (list (if current-prefix-arg
4510                          (prefix-numeric-value current-prefix-arg)
4511                        +10)))
4512   (mpc-proc-cmd (format "volume %+d" (- step))))
4513
4514 (defun mdw-mpc-hack-lines (arg interactivep func)
4515   (if (and interactivep (use-region-p))
4516       (let ((from (region-beginning)) (to (region-end)))
4517         (goto-char from)
4518         (beginning-of-line)
4519         (funcall func)
4520         (forward-line)
4521         (while (< (point) to)
4522           (funcall func)
4523           (forward-line)))
4524     (let ((n (prefix-numeric-value arg)))
4525       (cond ((minusp n)
4526              (unless (bolp)
4527                (beginning-of-line)
4528                (funcall func)
4529                (incf n))
4530              (while (minusp n)
4531                (forward-line -1)
4532                (funcall func)
4533                (incf n)))
4534             (t
4535              (beginning-of-line)
4536              (while (plusp n)
4537                (funcall func)
4538                (forward-line)
4539                (decf n)))))))
4540
4541 (defun mdw-mpc-select-one ()
4542   (when (and (get-char-property (point) 'mpc-file)
4543              (not (get-char-property (point) 'mpc-select)))
4544     (mpc-select-toggle)))
4545
4546 (defun mdw-mpc-unselect-one ()
4547   (when (get-char-property (point) 'mpc-select)
4548     (mpc-select-toggle)))
4549
4550 (defun mdw-mpc-select (&optional arg interactivep)
4551   (interactive (list current-prefix-arg t))
4552   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4553
4554 (defun mdw-mpc-unselect (&optional arg interactivep)
4555   (interactive (list current-prefix-arg t))
4556   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
4557
4558 (defun mdw-mpc-unselect-backwards (arg)
4559   (interactive "p")
4560   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
4561
4562 (defun mdw-mpc-unselect-all ()
4563   (interactive)
4564   (setq mpc-select nil)
4565   (mpc-selection-refresh))
4566
4567 (defun mdw-mpc-next-line (arg)
4568   (interactive "p")
4569   (beginning-of-line)
4570   (forward-line arg))
4571
4572 (defun mdw-mpc-previous-line (arg)
4573   (interactive "p")
4574   (beginning-of-line)
4575   (forward-line (- arg)))
4576
4577 (defun mdw-mpc-playlist-add (&optional arg interactivep)
4578   (interactive (list current-prefix-arg t))
4579   (let ((mpc-select mpc-select))
4580     (when (or arg (and interactivep (use-region-p)))
4581       (setq mpc-select nil)
4582       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4583     (setq mpc-select (reverse mpc-select))
4584     (mpc-playlist-add)))
4585
4586 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
4587   (interactive (list current-prefix-arg t))
4588   (setq mpc-select (nreverse mpc-select))
4589   (mpc-select-save
4590     (when (or arg (and interactivep (use-region-p)))
4591       (setq mpc-select nil)
4592       (mpc-selection-refresh)
4593       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
4594       (mpc-playlist-delete)))
4595
4596 (defun mdw-mpc-hack-tagbrowsers ()
4597   (setq-local mode-line-format
4598               '("%e"
4599                 mode-line-frame-identification
4600                 mode-line-buffer-identification)))
4601 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
4602
4603 (defun mdw-mpc-hack-songs ()
4604   (setq-local header-line-format
4605               ;; '("MPC " mpc-volume " " mpc-current-song)
4606               (list (propertize " " 'display '(space :align-to 0))
4607                     ;; 'mpc-songs-format-description
4608                     '(:eval
4609                       (let ((deactivate-mark) (hscroll (window-hscroll)))
4610                         (with-temp-buffer
4611                           (mpc-format mpc-songs-format 'self hscroll)
4612                           ;; That would be simpler than the hscroll handling in
4613                           ;; mpc-format, but currently move-to-column does not
4614                           ;; recognize :space display properties.
4615                           ;; (move-to-column hscroll)
4616                           ;; (delete-region (point-min) (point))
4617                           (buffer-string)))))))
4618 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
4619
4620 (eval-after-load "mpc"
4621   '(progn
4622      (define-key mpc-mode-map "m" 'mdw-mpc-select)
4623      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
4624      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
4625      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
4626      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
4627      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
4628      (define-key mpc-mode-map "/" 'mpc-songs-search)
4629      (setq mpc-songs-mode-map (make-sparse-keymap))
4630      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
4631      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
4632      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
4633      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
4634      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
4635
4636 ;;;--------------------------------------------------------------------------
4637 ;;; Inferior Emacs Lisp.
4638
4639 (setq comint-prompt-read-only t)
4640
4641 (eval-after-load "comint"
4642   '(progn
4643      (define-key comint-mode-map "\C-w" 'comint-kill-region)
4644      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
4645
4646 (eval-after-load "ielm"
4647   '(progn
4648      (define-key ielm-map "\C-w" 'comint-kill-region)
4649      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
4650
4651 ;;;----- That's all, folks --------------------------------------------------
4652
4653 (provide 'dot-emacs)