chiark - git - mdw - profile/blob - el/dot-emacs.el

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