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