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