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

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