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