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

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