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

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