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