mdw@git.distorted.org.uk Git - profile/blob - el/dot-emacs.el

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