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