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