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, C++, 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                       "typedef"          ;C89
1401                       "typeid"           ;C++
1402                       "typeof"           ;GCC
1403                       "typename"         ;C++
1404                       "union"            ;K&R, C89
1405                       "unsigned"         ;K&R, C89
1406                       "using"            ;C++
1407                       "virtual"          ;C++
1408                       "void"             ;C89
1409                       "volatile"         ;C89
1410                       "wchar_t"          ;C++, C89 library type
1411                       "while"            ;K&R, C89
1412                       "xor"              ;C++, C95 macro
1413                       "xor_eq"           ;C++, C95 macro
1414                       "_Bool"            ;C99
1415                       "_Complex"         ;C99
1416                       "_Imaginary"       ;C99
1417                       "_Pragma"          ;C99 preprocessor
1418                       "__alignof__"      ;GCC
1419                       "__asm__"          ;GCC
1420                       "__attribute__"    ;GCC
1421                       "__complex__"      ;GCC
1422                       "__const__"        ;GCC
1423                       "__extension__"    ;GCC
1424                       "__imag__"         ;GCC
1425                       "__inline__"       ;GCC
1426                       "__label__"        ;GCC
1427                       "__real__"         ;GCC
1428                       "__signed__"       ;GCC
1429                       "__typeof__"       ;GCC
1430                       "__volatile__"     ;GCC
1431                       ))
1432         (c-constants
1433          (mdw-regexps "false"            ;C++, C99 macro
1434                       "this"             ;C++
1435                       "true"             ;C++, C99 macro
1436                       ))
1437         (preprocessor-keywords
1438          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1439                       "ident" "if" "ifdef" "ifndef" "import" "include"
1440                       "line" "pragma" "unassert" "undef" "warning"))
1441         (objc-keywords
1442          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1443                       "interface" "private" "protected" "protocol" "public"
1444                       "selector")))
1445
1446     (setq font-lock-keywords
1447           (list
1448
1449            ;; Fontify include files as strings.
1450            (list (concat "^[ \t]*\\#[ \t]*"
1451                          "\\(include\\|import\\)"
1452                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1453                  '(2 font-lock-string-face))
1454
1455            ;; Preprocessor directives are `references'?.
1456            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1457                          preprocessor-keywords
1458                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1459                  '(1 font-lock-keyword-face))
1460
1461            ;; Handle the keywords defined above.
1462            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1463                  '(0 font-lock-keyword-face))
1464
1465            (list (concat "\\<\\(" c-keywords "\\)\\>")
1466                  '(0 font-lock-keyword-face))
1467
1468            (list (concat "\\<\\(" c-constants "\\)\\>")
1469                  '(0 font-lock-variable-name-face))
1470
1471            ;; Handle numbers too.
1472            ;;
1473            ;; This looks strange, I know.  It corresponds to the
1474            ;; preprocessor's idea of what a number looks like, rather than
1475            ;; anything sensible.
1476            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1477                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1478                  '(0 mdw-number-face))
1479
1480            ;; And anything else is punctuation.
1481            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1482                  '(0 mdw-punct-face))))))
1483
1484 ;;;--------------------------------------------------------------------------
1485 ;;; AP calc mode.
1486
1487 (defun apcalc-mode ()
1488   (interactive)
1489   (c-mode)
1490   (setq major-mode 'apcalc-mode)
1491   (setq mode-name "AP Calc")
1492   (run-hooks 'apcalc-mode-hook))
1493
1494 (defun mdw-fontify-apcalc ()
1495
1496   ;; Fiddle with some syntax codes.
1497   (modify-syntax-entry ?* ". 23")
1498   (modify-syntax-entry ?/ ". 14")
1499
1500   ;; Other stuff.
1501   (mdw-c-style)
1502   (setq c-hanging-comment-ender-p nil)
1503   (setq c-backslash-column 72)
1504   (setq comment-start "/* ")
1505   (setq comment-end " */")
1506   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1507
1508   ;; Now define things to be fontified.
1509   (make-local-variable 'font-lock-keywords)
1510   (let ((c-keywords
1511          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1512                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1513                       "local" "mat" "obj" "print" "quit" "read" "return"
1514                       "show" "static" "switch" "while" "write")))
1515
1516     (setq font-lock-keywords
1517           (list
1518
1519            ;; Handle the keywords defined above.
1520            (list (concat "\\<\\(" c-keywords "\\)\\>")
1521                  '(0 font-lock-keyword-face))
1522
1523            ;; Handle numbers too.
1524            ;;
1525            ;; This looks strange, I know.  It corresponds to the
1526            ;; preprocessor's idea of what a number looks like, rather than
1527            ;; anything sensible.
1528            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1529                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1530                  '(0 mdw-number-face))
1531
1532            ;; And anything else is punctuation.
1533            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1534                  '(0 mdw-punct-face))))))
1535
1536 ;;;--------------------------------------------------------------------------
1537 ;;; Java programming configuration.
1538
1539 ;; Make indentation nice.
1540
1541 (defun mdw-java-style ()
1542   (c-add-style "[mdw] Java style"
1543                '((c-basic-offset . 2)
1544                  (c-offsets-alist (substatement-open . 0)
1545                                   (label . +)
1546                                   (case-label . +)
1547                                   (access-label . 0)
1548                                   (inclass . +)
1549                                   (statement-case-intro . +)))
1550                t))
1551
1552 ;; Declare Java fontification style.
1553
1554 (defun mdw-fontify-java ()
1555
1556   ;; Other stuff.
1557   (mdw-java-style)
1558   (setq c-hanging-comment-ender-p nil)
1559   (setq c-backslash-column 72)
1560   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1561
1562   ;; Now define things to be fontified.
1563   (make-local-variable 'font-lock-keywords)
1564   (let ((java-keywords
1565          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1566                       "char" "class" "const" "continue" "default" "do"
1567                       "double" "else" "extends" "final" "finally" "float"
1568                       "for" "goto" "if" "implements" "import" "instanceof"
1569                       "int" "interface" "long" "native" "new" "package"
1570                       "private" "protected" "public" "return" "short"
1571                       "static" "switch" "synchronized" "throw" "throws"
1572                       "transient" "try" "void" "volatile" "while"))
1573
1574         (java-constants
1575          (mdw-regexps "false" "null" "super" "this" "true")))
1576
1577     (setq font-lock-keywords
1578           (list
1579
1580            ;; Handle the keywords defined above.
1581            (list (concat "\\<\\(" java-keywords "\\)\\>")
1582                  '(0 font-lock-keyword-face))
1583
1584            ;; Handle the magic constants defined above.
1585            (list (concat "\\<\\(" java-constants "\\)\\>")
1586                  '(0 font-lock-variable-name-face))
1587
1588            ;; Handle numbers too.
1589            ;;
1590            ;; The following isn't quite right, but it's close enough.
1591            (list (concat "\\<\\("
1592                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1593                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1594                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1595                          "[lLfFdD]?")
1596                  '(0 mdw-number-face))
1597
1598            ;; And anything else is punctuation.
1599            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1600                  '(0 mdw-punct-face))))))
1601
1602 ;;;--------------------------------------------------------------------------
1603 ;;; Javascript programming configuration.
1604
1605 (defun mdw-javascript-style ()
1606   (setq js-indent-level 2)
1607   (setq js-expr-indent-offset 0))
1608
1609 (defun mdw-fontify-javascript ()
1610
1611   ;; Other stuff.
1612   (mdw-javascript-style)
1613   (setq js-auto-indent-flag t)
1614
1615   ;; Now define things to be fontified.
1616   (make-local-variable 'font-lock-keywords)
1617   (let ((javascript-keywords
1618          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1619                       "char" "class" "const" "continue" "debugger" "default"
1620                       "delete" "do" "double" "else" "enum" "export" "extends"
1621                       "final" "finally" "float" "for" "function" "goto" "if"
1622                       "implements" "import" "in" "instanceof" "int"
1623                       "interface" "let" "long" "native" "new" "package"
1624                       "private" "protected" "public" "return" "short"
1625                       "static" "super" "switch" "synchronized" "throw"
1626                       "throws" "transient" "try" "typeof" "var" "void"
1627                       "volatile" "while" "with" "yield"
1628
1629                       "boolean" "byte" "char" "double" "float" "int" "long"
1630                       "short" "void"))
1631         (javascript-constants
1632          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1633                       "arguments" "this")))
1634
1635     (setq font-lock-keywords
1636           (list
1637
1638            ;; Handle the keywords defined above.
1639            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1640                  '(0 font-lock-keyword-face))
1641
1642            ;; Handle the predefined constants defined above.
1643            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1644                  '(0 font-lock-variable-name-face))
1645
1646            ;; Handle numbers too.
1647            ;;
1648            ;; The following isn't quite right, but it's close enough.
1649            (list (concat "\\_<\\("
1650                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1651                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1652                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1653                          "[lLfFdD]?")
1654                  '(0 mdw-number-face))
1655
1656            ;; And anything else is punctuation.
1657            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1658                  '(0 mdw-punct-face))))))
1659
1660 ;;;--------------------------------------------------------------------------
1661 ;;; Scala programming configuration.
1662
1663 (defun mdw-fontify-scala ()
1664
1665   ;; Comment filling.
1666   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1667
1668   ;; Define things to be fontified.
1669   (make-local-variable 'font-lock-keywords)
1670   (let ((scala-keywords
1671          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1672                       "extends" "final" "finally" "for" "forSome" "if"
1673                       "implicit" "import" "lazy" "match" "new" "object"
1674                       "override" "package" "private" "protected" "return"
1675                       "sealed" "throw" "trait" "try" "type" "val"
1676                       "var" "while" "with" "yield"))
1677         (scala-constants
1678          (mdw-regexps "false" "null" "super" "this" "true"))
1679         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1680
1681     (setq font-lock-keywords
1682           (list
1683
1684            ;; Magical identifiers between backticks.
1685            (list (concat "`\\([^`]+\\)`")
1686                  '(1 font-lock-variable-name-face))
1687
1688            ;; Handle the keywords defined above.
1689            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1690                  '(0 font-lock-keyword-face))
1691
1692            ;; Handle the constants defined above.
1693            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1694                  '(0 font-lock-variable-name-face))
1695
1696            ;; Magical identifiers between backticks.
1697            (list (concat "`\\([^`]+\\)`")
1698                  '(1 font-lock-variable-name-face))
1699
1700            ;; Handle numbers too.
1701            ;;
1702            ;; As usual, not quite right.
1703            (list (concat "\\_<\\("
1704                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1705                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1706                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1707                          "[lLfFdD]?")
1708                  '(0 mdw-number-face))
1709
1710            ;; Identifiers with trailing operators.
1711            (list (concat "_\\(" punctuation "\\)+")
1712                  '(0 mdw-trivial-face))
1713
1714            ;; And everything else is punctuation.
1715            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1716                  '(0 mdw-punct-face)))
1717
1718           font-lock-syntactic-keywords
1719           (list
1720
1721            ;; Single quotes around characters.  But not when used to quote
1722            ;; symbol names.  Ugh.
1723            (list (concat "\\('\\)"
1724                          "\\(" "."
1725                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1726                                "u+" "[0-9a-fA-F]\\{4\\}"
1727                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
1728                          "\\|" "\\\\" "." "\\)"
1729                          "\\('\\)")
1730                  '(1 "\"")
1731                  '(4 "\""))))))
1732
1733 ;;;--------------------------------------------------------------------------
1734 ;;; C# programming configuration.
1735
1736 ;; Make indentation nice.
1737
1738 (defun mdw-csharp-style ()
1739   (c-add-style "[mdw] C# style"
1740                '((c-basic-offset . 2)
1741                  (c-offsets-alist (substatement-open . 0)
1742                                   (label . 0)
1743                                   (case-label . +)
1744                                   (access-label . 0)
1745                                   (inclass . +)
1746                                   (statement-case-intro . +)))
1747                t))
1748
1749 ;; Declare C# fontification style.
1750
1751 (defun mdw-fontify-csharp ()
1752
1753   ;; Other stuff.
1754   (mdw-csharp-style)
1755   (setq c-hanging-comment-ender-p nil)
1756   (setq c-backslash-column 72)
1757   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1758
1759   ;; Now define things to be fontified.
1760   (make-local-variable 'font-lock-keywords)
1761   (let ((csharp-keywords
1762          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1763                       "char" "checked" "class" "const" "continue" "decimal"
1764                       "default" "delegate" "do" "double" "else" "enum"
1765                       "event" "explicit" "extern" "finally" "fixed" "float"
1766                       "for" "foreach" "goto" "if" "implicit" "in" "int"
1767                       "interface" "internal" "is" "lock" "long" "namespace"
1768                       "new" "object" "operator" "out" "override" "params"
1769                       "private" "protected" "public" "readonly" "ref"
1770                       "return" "sbyte" "sealed" "short" "sizeof"
1771                       "stackalloc" "static" "string" "struct" "switch"
1772                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
1773                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
1774                       "while" "yield"))
1775
1776         (csharp-constants
1777          (mdw-regexps "base" "false" "null" "this" "true")))
1778
1779     (setq font-lock-keywords
1780           (list
1781
1782            ;; Handle the keywords defined above.
1783            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1784                  '(0 font-lock-keyword-face))
1785
1786            ;; Handle the magic constants defined above.
1787            (list (concat "\\<\\(" csharp-constants "\\)\\>")
1788                  '(0 font-lock-variable-name-face))
1789
1790            ;; Handle numbers too.
1791            ;;
1792            ;; The following isn't quite right, but it's close enough.
1793            (list (concat "\\<\\("
1794                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1795                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1796                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1797                          "[lLfFdD]?")
1798                  '(0 mdw-number-face))
1799
1800            ;; And anything else is punctuation.
1801            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1802                  '(0 mdw-punct-face))))))
1803
1804 (define-derived-mode csharp-mode java-mode "C#"
1805   "Major mode for editing C# code.")
1806
1807 ;;;--------------------------------------------------------------------------
1808 ;;; F# programming configuration.
1809
1810 (setq fsharp-indent-offset 2)
1811
1812 (defun mdw-fontify-fsharp ()
1813
1814   (let ((punct "=<>+-*/|&%!@?"))
1815     (do ((i 0 (1+ i)))
1816         ((>= i (length punct)))
1817       (modify-syntax-entry (aref punct i) ".")))
1818
1819   (modify-syntax-entry ?_ "_")
1820   (modify-syntax-entry ?( "(")
1821   (modify-syntax-entry ?) ")")
1822
1823   (setq indent-tabs-mode nil)
1824
1825   (let ((fsharp-keywords
1826          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1827                       "begin" "break"
1828                       "checked" "class" "component" "const" "constraint"
1829                       "constructor" "continue"
1830                       "default" "delegate" "do" "done" "downcast" "downto"
1831                       "eager" "elif" "else" "end" "exception" "extern"
1832                       "finally" "fixed" "for" "fori" "fun" "function"
1833                       "functor"
1834                       "global"
1835                       "if" "in" "include" "inherit" "inline" "interface"
1836                       "internal"
1837                       "lazy" "let"
1838                       "match" "measure" "member" "method" "mixin" "module"
1839                       "mutable"
1840                       "namespace" "new"
1841                       "object" "of" "open" "or" "override"
1842                       "parallel" "params" "private" "process" "protected"
1843                       "public" "pure"
1844                       "rec" "recursive" "return"
1845                       "sealed" "sig" "static" "struct"
1846                       "tailcall" "then" "to" "trait" "try" "type"
1847                       "upcast" "use"
1848                       "val" "virtual" "void" "volatile"
1849                       "when" "while" "with"
1850                       "yield"))
1851
1852         (fsharp-builtins
1853          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1854                       "base" "false" "null" "true"))
1855
1856         (bang-keywords
1857          (mdw-regexps "do" "let" "return" "use" "yield"))
1858
1859         (preprocessor-keywords
1860          (mdw-regexps "if" "indent" "else" "endif")))
1861
1862     (setq font-lock-keywords
1863           (list (list (concat "\\(^\\|[^\"]\\)"
1864                               "\\(" "(\\*"
1865                                     "[^*]*\\*+"
1866                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1867                                     ")"
1868                               "\\|"
1869                                     "//.*"
1870                               "\\)")
1871                       '(2 font-lock-comment-face))
1872
1873                 (list (concat "'" "\\("
1874                                     "\\\\"
1875                                     "\\(" "[ntbr'\\]"
1876                                     "\\|" "[0-9][0-9][0-9]"
1877                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1878                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1879                                     "\\)"
1880                                   "\\|"
1881                                   "." "\\)" "'"
1882                               "\\|"
1883                               "\"" "[^\"\\]*"
1884                                     "\\(" "\\\\" "\\(.\\|\n\\)"
1885                                           "[^\"\\]*" "\\)*"
1886                               "\\(\"\\|\\'\\)")
1887                       '(0 font-lock-string-face))
1888
1889                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1890                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1891                               "\\|"
1892                               "\\_<\\(" fsharp-keywords "\\)\\_>")
1893                       '(0 font-lock-keyword-face))
1894                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1895                       '(0 font-lock-variable-name-face))
1896
1897                 (list (concat "\\_<"
1898                               "\\(" "0[bB][01]+" "\\|"
1899                                     "0[oO][0-7]+" "\\|"
1900                                     "0[xX][0-9a-fA-F]+" "\\)"
1901                               "\\(" "lf\\|LF" "\\|"
1902                                     "[uU]?[ysnlL]?" "\\)"
1903                               "\\|"
1904                               "\\_<"
1905                               "[0-9]+" "\\("
1906                                 "[mMQRZING]"
1907                                 "\\|"
1908                                 "\\(\\.[0-9]*\\)?"
1909                                 "\\([eE][-+]?[0-9]+\\)?"
1910                                 "[fFmM]?"
1911                                 "\\|"
1912                                 "[uU]?[ysnlL]?"
1913                               "\\)")
1914                       '(0 mdw-number-face))
1915
1916                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1917                       '(0 mdw-punct-face))))))
1918
1919 (defun mdw-fontify-inferior-fsharp ()
1920   (mdw-fontify-fsharp)
1921   (setq font-lock-keywords
1922         (append (list (list "^[#-]" '(0 font-lock-comment-face))
1923                       (list "^>" '(0 font-lock-keyword-face)))
1924                 font-lock-keywords)))
1925
1926 ;;;--------------------------------------------------------------------------
1927 ;;; Go programming configuration.
1928
1929 (defun mdw-fontify-go ()
1930
1931   (make-local-variable 'font-lock-keywords)
1932   (let ((go-keywords
1933          (mdw-regexps "break" "case" "chan" "const" "continue"
1934                       "default" "defer" "else" "fallthrough" "for"
1935                       "func" "go" "goto" "if" "import"
1936                       "interface" "map" "package" "range" "return"
1937                       "select" "struct" "switch" "type" "var"))
1938         (go-intrinsics
1939          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1940                       "float32" "float64" "int" "uint8" "int16" "int32"
1941                       "int64" "rune" "string" "uint" "uint8" "uint16"
1942                       "uint32" "uint64" "uintptr" "void"
1943                       "false" "iota" "nil" "true"
1944                       "init" "main"
1945                       "append" "cap" "copy" "delete" "imag" "len" "make"
1946                       "new" "panic" "real" "recover")))
1947
1948     (setq font-lock-keywords
1949           (list
1950
1951            ;; Handle the keywords defined above.
1952            (list (concat "\\<\\(" go-keywords "\\)\\>")
1953                  '(0 font-lock-keyword-face))
1954            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1955                  '(0 font-lock-variable-name-face))
1956
1957            ;; Strings and characters.
1958            (list (concat "'"
1959                          "\\(" "[^\\']" "\\|"
1960                                "\\\\"
1961                                "\\(" "[abfnrtv\\'\"]" "\\|"
1962                                      "[0-7]\\{3\\}" "\\|"
1963                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1964                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1965                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1966                          "'"
1967                          "\\|"
1968                          "\""
1969                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1970                          "\\(\"\\|$\\)"
1971                          "\\|"
1972                          "`" "[^`]+" "`")
1973                  '(0 font-lock-string-face))
1974
1975            ;; Handle numbers too.
1976            ;;
1977            ;; The following isn't quite right, but it's close enough.
1978            (list (concat "\\<\\("
1979                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1980                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1981                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1982                  '(0 mdw-number-face))
1983
1984            ;; And anything else is punctuation.
1985            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1986                  '(0 mdw-punct-face))))))
1987
1988 ;;;--------------------------------------------------------------------------
1989 ;;; Rust programming configuration.
1990
1991 (setq-default rust-indent-offset 2)
1992
1993 (defun mdw-self-insert-and-indent (count)
1994   (interactive "p")
1995   (self-insert-command count)
1996   (indent-according-to-mode))
1997
1998 (defun mdw-fontify-rust ()
1999
2000   ;; Hack syntax categories.
2001   (modify-syntax-entry ?= ".")
2002
2003   ;; Fontify keywords and things.
2004   (make-local-variable 'font-lock-keywords)
2005   (let ((rust-keywords
2006          (mdw-regexps "abstract" "alignof" "as"
2007                       "become" "box" "break"
2008                       "const" "continue" "create"
2009                       "do"
2010                       "else" "enum" "extern"
2011                       "false" "final" "fn" "for"
2012                       "if" "impl" "in"
2013                       "let" "loop"
2014                       "macro" "match" "mod" "move" "mut"
2015                       "offsetof" "override"
2016                       "priv" "pub" "pure"
2017                       "ref" "return"
2018                       "self" "sizeof" "static" "struct" "super"
2019                       "true" "trait" "type" "typeof"
2020                       "unsafe" "unsized" "use"
2021                       "virtual"
2022                       "where" "while"
2023                       "yield"))
2024         (rust-builtins
2025          (mdw-regexps "array" "pointer" "slice" "tuple"
2026                       "bool" "true" "false"
2027                       "f32" "f64"
2028                       "i8" "i16" "i32" "i64" "isize"
2029                       "u8" "u16" "u32" "u64" "usize"
2030                       "char" "str")))
2031     (setq font-lock-keywords
2032           (list
2033
2034            ;; Handle the keywords defined above.
2035            (list (concat "\\<\\(" rust-keywords "\\)\\>")
2036                  '(0 font-lock-keyword-face))
2037            (list (concat "\\<\\(" rust-builtins "\\)\\>")
2038                  '(0 font-lock-variable-name-face))
2039
2040            ;; Handle numbers too.
2041            (list (concat "\\<\\("
2042                                "[0-9][0-9_]*"
2043                                "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2044                                "\\|" "\\.[0-9_]+"
2045                                "\\)"
2046                                "\\(f32\\|f64\\)?"
2047                          "\\|" "\\(" "[0-9][0-9_]*"
2048                                "\\|" "0x[0-9a-fA-F_]+"
2049                                "\\|" "0o[0-7_]+"
2050                                "\\|" "0b[01_]+"
2051                                "\\)"
2052                                "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
2053                          "\\)\\>")
2054                  '(0 mdw-number-face))
2055
2056            ;; And anything else is punctuation.
2057            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2058                  '(0 mdw-punct-face)))))
2059
2060   ;; Hack key bindings.
2061   (local-set-key [?{] 'mdw-self-insert-and-indent)
2062   (local-set-key [?}] 'mdw-self-insert-and-indent))
2063
2064 ;;;--------------------------------------------------------------------------
2065 ;;; Awk programming configuration.
2066
2067 ;; Make Awk indentation nice.
2068
2069 (defun mdw-awk-style ()
2070   (c-add-style "[mdw] Awk style"
2071                '((c-basic-offset . 2)
2072                  (c-offsets-alist (substatement-open . 0)
2073                                   (statement-cont . 0)
2074                                   (statement-case-intro . +)))
2075                t))
2076
2077 ;; Declare Awk fontification style.
2078
2079 (defun mdw-fontify-awk ()
2080
2081   ;; Miscellaneous fiddling.
2082   (mdw-awk-style)
2083   (setq c-backslash-column 72)
2084   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2085
2086   ;; Now define things to be fontified.
2087   (make-local-variable 'font-lock-keywords)
2088   (let ((c-keywords
2089          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2090                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2091                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2092                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
2093                       "atan2" "break" "close" "continue" "cos" "delete"
2094                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2095                       "function" "gensub" "getline" "gsub" "if" "in"
2096                       "index" "int" "length" "log" "match" "next" "rand"
2097                       "return" "print" "printf" "sin" "split" "sprintf"
2098                       "sqrt" "srand" "strftime" "sub" "substr" "system"
2099                       "systime" "tolower" "toupper" "while")))
2100
2101     (setq font-lock-keywords
2102           (list
2103
2104            ;; Handle the keywords defined above.
2105            (list (concat "\\<\\(" c-keywords "\\)\\>")
2106                  '(0 font-lock-keyword-face))
2107
2108            ;; Handle numbers too.
2109            ;;
2110            ;; The following isn't quite right, but it's close enough.
2111            (list (concat "\\<\\("
2112                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2113                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2114                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2115                          "[uUlL]*")
2116                  '(0 mdw-number-face))
2117
2118            ;; And anything else is punctuation.
2119            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2120                  '(0 mdw-punct-face))))))
2121
2122 ;;;--------------------------------------------------------------------------
2123 ;;; Perl programming style.
2124
2125 ;; Perl indentation style.
2126
2127 (setq perl-indent-level 2)
2128
2129 (setq cperl-indent-level 2)
2130 (setq cperl-continued-statement-offset 2)
2131 (setq cperl-continued-brace-offset 0)
2132 (setq cperl-brace-offset -2)
2133 (setq cperl-brace-imaginary-offset 0)
2134 (setq cperl-label-offset 0)
2135
2136 ;; Define perl fontification style.
2137
2138 (defun mdw-fontify-perl ()
2139
2140   ;; Miscellaneous fiddling.
2141   (modify-syntax-entry ?$ "\\")
2142   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2143   (modify-syntax-entry ?: "." font-lock-syntax-table)
2144   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2145
2146   ;; Now define fontification things.
2147   (make-local-variable 'font-lock-keywords)
2148   (let ((perl-keywords
2149          (mdw-regexps "and"
2150                       "break"
2151                       "cmp" "continue"
2152                       "default" "do"
2153                       "else" "elsif" "eq"
2154                       "for" "foreach"
2155                       "ge" "given" "gt" "goto"
2156                       "if"
2157                       "last" "le" "local" "lt"
2158                       "my"
2159                       "ne" "next"
2160                       "or" "our"
2161                       "package"
2162                       "redo" "require" "return"
2163                       "sub"
2164                       "undef" "unless" "until" "use"
2165                       "when" "while")))
2166
2167     (setq font-lock-keywords
2168           (list
2169
2170            ;; Set up the keywords defined above.
2171            (list (concat "\\<\\(" perl-keywords "\\)\\>")
2172                  '(0 font-lock-keyword-face))
2173
2174            ;; At least numbers are simpler than C.
2175            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2176                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2177                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2178                  '(0 mdw-number-face))
2179
2180            ;; And anything else is punctuation.
2181            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2182                  '(0 mdw-punct-face))))))
2183
2184 (defun perl-number-tests (&optional arg)
2185   "Assign consecutive numbers to lines containing `#t'.  With ARG,
2186 strip numbers instead."
2187   (interactive "P")
2188   (save-excursion
2189     (goto-char (point-min))
2190     (let ((i 0) (fmt (if arg "" " %4d")))
2191       (while (search-forward "#t" nil t)
2192         (delete-region (point) (line-end-position))
2193         (setq i (1+ i))
2194         (insert (format fmt i)))
2195       (goto-char (point-min))
2196       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2197           (replace-match (format "\\1%d" i))))))
2198
2199 ;;;--------------------------------------------------------------------------
2200 ;;; Python programming style.
2201
2202 (defun mdw-fontify-pythonic (keywords)
2203
2204   ;; Miscellaneous fiddling.
2205   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2206   (setq indent-tabs-mode nil)
2207
2208   ;; Now define fontification things.
2209   (make-local-variable 'font-lock-keywords)
2210   (setq font-lock-keywords
2211         (list
2212
2213          ;; Set up the keywords defined above.
2214          (list (concat "\\_<\\(" keywords "\\)\\_>")
2215                '(0 font-lock-keyword-face))
2216
2217          ;; At least numbers are simpler than C.
2218          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2219                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2220                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2221                '(0 mdw-number-face))
2222
2223          ;; And anything else is punctuation.
2224          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2225                '(0 mdw-punct-face)))))
2226
2227 ;; Define Python fontification styles.
2228
2229 (defun mdw-fontify-python ()
2230   (mdw-fontify-pythonic
2231    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2232                 "del" "elif" "else" "except" "exec" "finally" "for"
2233                 "from" "global" "if" "import" "in" "is" "lambda"
2234                 "not" "or" "pass" "print" "raise" "return" "try"
2235                 "while" "with" "yield")))
2236
2237 (defun mdw-fontify-pyrex ()
2238   (mdw-fontify-pythonic
2239    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2240                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2241                 "extern" "finally" "for" "from" "global" "if"
2242                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2243                 "raise" "return" "struct" "try" "while" "with"
2244                 "yield")))
2245
2246 ;;;--------------------------------------------------------------------------
2247 ;;; Icon programming style.
2248
2249 ;; Icon indentation style.
2250
2251 (setq icon-brace-offset 0
2252       icon-continued-brace-offset 0
2253       icon-continued-statement-offset 2
2254       icon-indent-level 2)
2255
2256 ;; Define Icon fontification style.
2257
2258 (defun mdw-fontify-icon ()
2259
2260   ;; Miscellaneous fiddling.
2261   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2262
2263   ;; Now define fontification things.
2264   (make-local-variable 'font-lock-keywords)
2265   (let ((icon-keywords
2266          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2267                       "end" "every" "fail" "global" "if" "initial"
2268                       "invocable" "link" "local" "next" "not" "of"
2269                       "procedure" "record" "repeat" "return" "static"
2270                       "suspend" "then" "to" "until" "while"))
2271         (preprocessor-keywords
2272          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2273                       "include" "line" "undef")))
2274     (setq font-lock-keywords
2275           (list
2276
2277            ;; Set up the keywords defined above.
2278            (list (concat "\\<\\(" icon-keywords "\\)\\>")
2279                  '(0 font-lock-keyword-face))
2280
2281            ;; The things that Icon calls keywords.
2282            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2283
2284            ;; At least numbers are simpler than C.
2285            (list (concat "\\<[0-9]+"
2286                          "\\([rR][0-9a-zA-Z]+\\|"
2287                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2288                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2289                  '(0 mdw-number-face))
2290
2291            ;; Preprocessor.
2292            (list (concat "^[ \t]*$[ \t]*\\<\\("
2293                          preprocessor-keywords
2294                          "\\)\\>")
2295                  '(0 font-lock-keyword-face))
2296
2297            ;; And anything else is punctuation.
2298            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2299                  '(0 mdw-punct-face))))))
2300
2301 ;;;--------------------------------------------------------------------------
2302 ;;; Assembler mode.
2303
2304 (defun mdw-fontify-asm ()
2305   (modify-syntax-entry ?' "\"")
2306   (modify-syntax-entry ?. "w")
2307   (modify-syntax-entry ?\n ">")
2308   (setf fill-prefix nil)
2309   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2310
2311 (defun mdw-asm-set-comment ()
2312   (modify-syntax-entry ?; "."
2313                        )
2314   (modify-syntax-entry asm-comment-char "<b")
2315   (setq comment-start (string asm-comment-char ? )))
2316 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
2317 (put 'asm-comment-char 'safe-local-variable 'characterp)
2318
2319 ;;;--------------------------------------------------------------------------
2320 ;;; TCL configuration.
2321
2322 (defun mdw-fontify-tcl ()
2323   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2324   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2325   (make-local-variable 'font-lock-keywords)
2326   (setq font-lock-keywords
2327         (list
2328          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2329                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2330                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2331                '(0 mdw-number-face))
2332          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2333                '(0 mdw-punct-face)))))
2334
2335 ;;;--------------------------------------------------------------------------
2336 ;;; Dylan programming configuration.
2337
2338 (defun mdw-fontify-dylan ()
2339
2340   (make-local-variable 'font-lock-keywords)
2341
2342   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
2343   ;; hook, which undoes all of our configuration.
2344   (setq major-mode 'dylan-mode)
2345   (font-lock-set-defaults)
2346
2347   (let* ((word "[-_a-zA-Z!*@<>$%]+")
2348          (dylan-keywords (mdw-regexps
2349
2350                           "C-address" "C-callable-wrapper" "C-function"
2351                           "C-mapped-subtype" "C-pointer-type" "C-struct"
2352                           "C-subtype" "C-union" "C-variable"
2353
2354                           "above" "abstract" "afterwards" "all"
2355                           "begin" "below" "block" "by"
2356                           "case" "class" "cleanup" "constant" "create"
2357                           "define" "domain"
2358                           "else" "elseif" "end" "exception" "export"
2359                           "finally" "for" "from" "function"
2360                           "generic"
2361                           "handler"
2362                           "if" "in" "instance" "interface" "iterate"
2363                           "keyed-by"
2364                           "let" "library" "local"
2365                           "macro" "method" "module"
2366                           "otherwise"
2367                           "profiling"
2368                           "select" "slot" "subclass"
2369                           "table" "then" "to"
2370                           "unless" "until" "use"
2371                           "variable" "virtual"
2372                           "when" "while"))
2373          (sharp-keywords (mdw-regexps
2374                           "all-keys" "key" "next" "rest" "include"
2375                           "t" "f")))
2376     (setq font-lock-keywords
2377           (list (list (concat "\\<\\(" dylan-keywords
2378                               "\\|" "with\\(out\\)?-" word
2379                               "\\)\\>")
2380                       '(0 font-lock-keyword-face))
2381                 (list (concat "\\<" word ":" "\\|"
2382                               "#\\(" sharp-keywords "\\)\\>")
2383                       '(0 font-lock-variable-name-face))
2384                 (list (concat "\\("
2385                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
2386                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2387                                 "\\|" "/[0-9]+"
2388                               "\\)"
2389                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2390                               "\\|" "#b[01]+"
2391                               "\\|" "#o[0-7]+"
2392                               "\\|" "#x[0-9a-zA-Z]+"
2393                               "\\)\\>")
2394                       '(0 mdw-number-face))
2395                 (list (concat "\\("
2396                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2397                               "\\_<[-+*/=<>:&|]+\\_>"
2398                               "\\)")
2399                       '(0 mdw-punct-face))))))
2400
2401 ;;;--------------------------------------------------------------------------
2402 ;;; Algol 68 configuration.
2403
2404 (setq a68-indent-step 2)
2405
2406 (defun mdw-fontify-algol-68 ()
2407
2408   ;; Fix up the syntax table.
2409   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2410   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2411     (modify-syntax-entry ch "." a68-mode-syntax-table))
2412
2413   (make-local-variable 'font-lock-keywords)
2414
2415   (let ((not-comment
2416          (let ((word "COMMENT"))
2417            (do ((regexp (concat "[^" (substring word 0 1) "]+")
2418                         (concat regexp "\\|"
2419                                 (substring word 0 i)
2420                                 "[^" (substring word i (1+ i)) "]"))
2421                 (i 1 (1+ i)))
2422                ((>= i (length word)) regexp)))))
2423     (setq font-lock-keywords
2424           (list (list (concat "\\<COMMENT\\>"
2425                               "\\(" not-comment "\\)\\{0,5\\}"
2426                               "\\(\\'\\|\\<COMMENT\\>\\)")
2427                       '(0 font-lock-comment-face))
2428                 (list (concat "\\<CO\\>"
2429                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2430                               "\\($\\|\\<CO\\>\\)")
2431                       '(0 font-lock-comment-face))
2432                 (list "\\<[A-Z_]+\\>"
2433                       '(0 font-lock-keyword-face))
2434                 (list (concat "\\<"
2435                               "[0-9]+"
2436                               "\\(\\.[0-9]+\\)?"
2437                               "\\([eE][-+]?[0-9]+\\)?"
2438                               "\\>")
2439                       '(0 mdw-number-face))
2440                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2441                       '(0 mdw-punct-face))))))
2442
2443 ;;;--------------------------------------------------------------------------
2444 ;;; REXX configuration.
2445
2446 (defun mdw-rexx-electric-* ()
2447   (interactive)
2448   (insert ?*)
2449   (rexx-indent-line))
2450
2451 (defun mdw-rexx-indent-newline-indent ()
2452   (interactive)
2453   (rexx-indent-line)
2454   (if abbrev-mode (expand-abbrev))
2455   (newline-and-indent))
2456
2457 (defun mdw-fontify-rexx ()
2458
2459   ;; Various bits of fiddling.
2460   (setq mdw-auto-indent nil)
2461   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2462   (local-set-key [?*] 'mdw-rexx-electric-*)
2463   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2464           '(?! ?? ?# ?@ ?$))
2465   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2466
2467   ;; Set up keywords and things for fontification.
2468   (make-local-variable 'font-lock-keywords-case-fold-search)
2469   (setq font-lock-keywords-case-fold-search t)
2470
2471   (setq rexx-indent 2)
2472   (setq rexx-end-indent rexx-indent)
2473   (setq rexx-cont-indent rexx-indent)
2474
2475   (make-local-variable 'font-lock-keywords)
2476   (let ((rexx-keywords
2477          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2478                       "else" "end" "engineering" "exit" "expose" "for"
2479                       "forever" "form" "fuzz" "if" "interpret" "iterate"
2480                       "leave" "linein" "name" "nop" "numeric" "off" "on"
2481                       "options" "otherwise" "parse" "procedure" "pull"
2482                       "push" "queue" "return" "say" "select" "signal"
2483                       "scientific" "source" "then" "trace" "to" "until"
2484                       "upper" "value" "var" "version" "when" "while"
2485                       "with"
2486
2487                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2488                       "center" "center" "charin" "charout" "chars"
2489                       "compare" "condition" "copies" "c2d" "c2x"
2490                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
2491                       "errortext" "format" "fuzz" "insert" "lastpos"
2492                       "left" "length" "lineout" "lines" "max" "min"
2493                       "overlay" "pos" "queued" "random" "reverse" "right"
2494                       "sign" "sourceline" "space" "stream" "strip"
2495                       "substr" "subword" "symbol" "time" "translate"
2496                       "trunc" "value" "verify" "word" "wordindex"
2497                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2498                       "x2d")))
2499
2500     (setq font-lock-keywords
2501           (list
2502
2503            ;; Set up the keywords defined above.
2504            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2505                  '(0 font-lock-keyword-face))
2506
2507            ;; Fontify all symbols the same way.
2508            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2509                          "[A-Za-z0-9.!?_#@$]+\\)")
2510                  '(0 font-lock-variable-name-face))
2511
2512            ;; And everything else is punctuation.
2513            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2514                  '(0 mdw-punct-face))))))
2515
2516 ;;;--------------------------------------------------------------------------
2517 ;;; Standard ML programming style.
2518
2519 (defun mdw-fontify-sml ()
2520
2521   ;; Make underscore an honorary letter.
2522   (modify-syntax-entry ?' "w")
2523
2524   ;; Set fill prefix.
2525   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2526
2527   ;; Now define fontification things.
2528   (make-local-variable 'font-lock-keywords)
2529   (let ((sml-keywords
2530          (mdw-regexps "abstype" "and" "andalso" "as"
2531                       "case"
2532                       "datatype" "do"
2533                       "else" "end" "eqtype" "exception"
2534                       "fn" "fun" "functor"
2535                       "handle"
2536                       "if" "in" "include" "infix" "infixr"
2537                       "let" "local"
2538                       "nonfix"
2539                       "of" "op" "open" "orelse"
2540                       "raise" "rec"
2541                       "sharing" "sig" "signature" "struct" "structure"
2542                       "then" "type"
2543                       "val"
2544                       "where" "while" "with" "withtype")))
2545
2546     (setq font-lock-keywords
2547           (list
2548
2549            ;; Set up the keywords defined above.
2550            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2551                  '(0 font-lock-keyword-face))
2552
2553            ;; At least numbers are simpler than C.
2554            (list (concat "\\<\\(\\~\\|\\)"
2555                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2556                                    "[wW][0-9]+\\)\\|"
2557                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2558                                          "\\([eE]\\(\\~\\|\\)"
2559                                                 "[0-9]+\\|\\)\\)\\)")
2560                  '(0 mdw-number-face))
2561
2562            ;; And anything else is punctuation.
2563            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2564                  '(0 mdw-punct-face))))))
2565
2566 ;;;--------------------------------------------------------------------------
2567 ;;; Haskell configuration.
2568
2569 (defun mdw-fontify-haskell ()
2570
2571   ;; Fiddle with syntax table to get comments right.
2572   (modify-syntax-entry ?' "_")
2573   (modify-syntax-entry ?- ". 12")
2574   (modify-syntax-entry ?\n ">")
2575
2576   ;; Make punctuation be punctuation
2577   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2578     (do ((i 0 (1+ i)))
2579         ((>= i (length punct)))
2580       (modify-syntax-entry (aref punct i) ".")))
2581
2582   ;; Set fill prefix.
2583   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2584
2585   ;; Fiddle with fontification.
2586   (make-local-variable 'font-lock-keywords)
2587   (let ((haskell-keywords
2588          (mdw-regexps "as"
2589                       "case" "ccall" "class"
2590                       "data" "default" "deriving" "do"
2591                       "else" "exists"
2592                       "forall" "foreign"
2593                       "hiding"
2594                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
2595                       "let"
2596                       "mdo" "module"
2597                       "newtype"
2598                       "of"
2599                       "proc"
2600                       "qualified"
2601                       "rec"
2602                       "safe" "stdcall"
2603                       "then" "type"
2604                       "unsafe"
2605                       "where"))
2606         (control-sequences
2607          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2608                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2609                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2610                       "SP" "STX" "SUB" "SYN" "US" "VT")))
2611
2612     (setq font-lock-keywords
2613           (list
2614            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2615                               "\\(-+}\\|-*\\'\\)"
2616                          "\\|"
2617                          "--.*$")
2618                  '(0 font-lock-comment-face))
2619            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2620                  '(0 font-lock-keyword-face))
2621            (list (concat "'\\("
2622                          "[^\\]"
2623                          "\\|"
2624                          "\\\\"
2625                          "\\(" "[abfnrtv\\\"']" "\\|"
2626                                "^" "\\(" control-sequences "\\|"
2627                                          "[]A-Z@[\\^_]" "\\)" "\\|"
2628                                "\\|"
2629                                "[0-9]+" "\\|"
2630                                "[oO][0-7]+" "\\|"
2631                                "[xX][0-9A-Fa-f]+"
2632                          "\\)"
2633                          "\\)'")
2634                  '(0 font-lock-string-face))
2635            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2636                  '(0 font-lock-variable-name-face))
2637            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2638                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2639                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2640                  '(0 mdw-number-face))
2641            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2642                  '(0 mdw-punct-face))))))
2643
2644 ;;;--------------------------------------------------------------------------
2645 ;;; Erlang configuration.
2646
2647 (setq erlang-electric-commands nil)
2648
2649 (defun mdw-fontify-erlang ()
2650
2651   ;; Set fill prefix.
2652   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2653
2654   ;; Fiddle with fontification.
2655   (make-local-variable 'font-lock-keywords)
2656   (let ((erlang-keywords
2657          (mdw-regexps "after" "and" "andalso"
2658                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2659                       "case" "catch" "cond"
2660                       "div" "end" "fun" "if" "let" "not"
2661                       "of" "or" "orelse"
2662                       "query" "receive" "rem" "try" "when" "xor")))
2663
2664     (setq font-lock-keywords
2665           (list
2666            (list "%.*$"
2667                  '(0 font-lock-comment-face))
2668            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2669                  '(0 font-lock-keyword-face))
2670            (list (concat "^-\\sw+\\>")
2671                  '(0 font-lock-keyword-face))
2672            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2673                  '(0 mdw-number-face))
2674            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2675                  '(0 mdw-punct-face))))))
2676
2677 ;;;--------------------------------------------------------------------------
2678 ;;; Texinfo configuration.
2679
2680 (defun mdw-fontify-texinfo ()
2681
2682   ;; Set fill prefix.
2683   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2684
2685   ;; Real fontification things.
2686   (make-local-variable 'font-lock-keywords)
2687   (setq font-lock-keywords
2688         (list
2689
2690          ;; Environment names are keywords.
2691          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2692                '(2 font-lock-keyword-face))
2693
2694          ;; Unmark escaped magic characters.
2695          (list "\\(@\\)\\([@{}]\\)"
2696                '(1 font-lock-keyword-face)
2697                '(2 font-lock-variable-name-face))
2698
2699          ;; Make sure we get comments properly.
2700          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2701                '(0 font-lock-comment-face))
2702
2703          ;; Command names are keywords.
2704          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2705                '(0 font-lock-keyword-face))
2706
2707          ;; Fontify TeX special characters as punctuation.
2708          (list "[{}]+"
2709                '(0 mdw-punct-face)))))
2710
2711 ;;;--------------------------------------------------------------------------
2712 ;;; TeX and LaTeX configuration.
2713
2714 (defun mdw-fontify-tex ()
2715   (setq ispell-parser 'tex)
2716   (turn-on-reftex)
2717
2718   ;; Don't make maths into a string.
2719   (modify-syntax-entry ?$ ".")
2720   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2721   (local-set-key [?$] 'self-insert-command)
2722
2723   ;; Set fill prefix.
2724   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2725
2726   ;; Real fontification things.
2727   (make-local-variable 'font-lock-keywords)
2728   (setq font-lock-keywords
2729         (list
2730
2731          ;; Environment names are keywords.
2732          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2733                        "{\\([^}\n]*\\)}")
2734                '(2 font-lock-keyword-face))
2735
2736          ;; Suspended environment names are keywords too.
2737          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2738                        "{\\([^}\n]*\\)}")
2739                '(3 font-lock-keyword-face))
2740
2741          ;; Command names are keywords.
2742          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2743                '(0 font-lock-keyword-face))
2744
2745          ;; Handle @/.../ for italics.
2746          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2747          ;;       '(1 font-lock-keyword-face)
2748          ;;       '(3 font-lock-keyword-face))
2749
2750          ;; Handle @*...* for boldness.
2751          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2752          ;;       '(1 font-lock-keyword-face)
2753          ;;       '(3 font-lock-keyword-face))
2754
2755          ;; Handle @`...' for literal syntax things.
2756          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2757          ;;       '(1 font-lock-keyword-face)
2758          ;;       '(3 font-lock-keyword-face))
2759
2760          ;; Handle @<...> for nonterminals.
2761          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2762          ;;       '(1 font-lock-keyword-face)
2763          ;;       '(3 font-lock-keyword-face))
2764
2765          ;; Handle other @-commands.
2766          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2767          ;;       '(0 font-lock-keyword-face))
2768
2769          ;; Make sure we get comments properly.
2770          (list "%.*"
2771                '(0 font-lock-comment-face))
2772
2773          ;; Fontify TeX special characters as punctuation.
2774          (list "[$^_{}#&]"
2775                '(0 mdw-punct-face)))))
2776
2777 ;;;--------------------------------------------------------------------------
2778 ;;; SGML hacking.
2779
2780 (defun mdw-sgml-mode ()
2781   (interactive)
2782   (sgml-mode)
2783   (mdw-standard-fill-prefix "")
2784   (make-local-variable 'sgml-delimiters)
2785   (setq sgml-delimiters
2786         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2787           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2788           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2789           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2790           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2791           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2792           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2793           "NULL" ""))
2794   (setq major-mode 'mdw-sgml-mode)
2795   (setq mode-name "[mdw] SGML")
2796   (run-hooks 'mdw-sgml-mode-hook))
2797
2798 ;;;--------------------------------------------------------------------------
2799 ;;; Configuration files.
2800
2801 (defvar mdw-conf-quote-normal nil
2802   "*Control syntax category of quote characters `\"' and `''.
2803 If this is `t', consider quote characters to be normal
2804 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2805 leave quote characters as quotes.  If this is a list, then
2806 consider the quote characters in the list to be normal
2807 punctuation.  If this is a single quote character, then consider
2808 that character only to be normal punctuation.")
2809 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2810   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2811   (or (booleanp value)
2812       (every (lambda (v) (memq v '(?\" ?')))
2813              (if (listp value) value (list value)))))
2814 (put 'mdw-conf-quote-normal 'safe-local-variable
2815      'mdw-conf-quote-normal-acceptable-value-p)
2816
2817 (defun mdw-fix-up-quote ()
2818   "Apply the setting of `mdw-conf-quote-normal'."
2819   (let ((flag mdw-conf-quote-normal))
2820     (cond ((eq flag t)
2821            (conf-quote-normal t))
2822           ((not flag)
2823            nil)
2824           (t
2825            (let ((table (copy-syntax-table (syntax-table))))
2826              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2827                    (if (listp flag) flag (list flag)))
2828              (set-syntax-table table)
2829              (and font-lock-mode (font-lock-fontify-buffer)))))))
2830 (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
2831
2832 ;;;--------------------------------------------------------------------------
2833 ;;; Shell scripts.
2834
2835 (defun mdw-setup-sh-script-mode ()
2836
2837   ;; Fetch the shell interpreter's name.
2838   (let ((shell-name sh-shell-file))
2839
2840     ;; Try reading the hash-bang line.
2841     (save-excursion
2842       (goto-char (point-min))
2843       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2844           (setq shell-name (match-string 1))))
2845
2846     ;; Now try to set the shell.
2847     ;;
2848     ;; Don't let `sh-set-shell' bugger up my script.
2849     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2850       (sh-set-shell shell-name)))
2851
2852   ;; Don't insert here-document scaffolding automatically.
2853   (local-set-key "<" 'self-insert-command)
2854
2855   ;; Now enable my keys and the fontification.
2856   (mdw-misc-mode-config)
2857
2858   ;; Set the indentation level correctly.
2859   (setq sh-indentation 2)
2860   (setq sh-basic-offset 2))
2861
2862 (setq sh-shell-file "/bin/sh")
2863
2864 ;; Awful hacking to override the shell detection for particular scripts.
2865 (defmacro define-custom-shell-mode (name shell)
2866   `(defun ,name ()
2867      (interactive)
2868      (set (make-local-variable 'sh-shell-file) ,shell)
2869      (sh-mode)))
2870 (define-custom-shell-mode bash-mode "/bin/bash")
2871 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2872 (put 'sh-shell-file 'permanent-local t)
2873
2874 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2875 (eval-after-load "sh-script"
2876   '(or (assq 'rc sh-mode-syntax-table-input)
2877        (let ((frag '(nil
2878                      ?# "<"
2879                      ?\n ">#"
2880                      ?\" "\"\""
2881                      ?\' "\"\'"
2882                      ?$ "'"
2883                      ?\` "."
2884                      ?! "_"
2885                      ?% "_"
2886                      ?. "_"
2887                      ?^ "_"
2888                      ?~ "_"
2889                      ?, "_"
2890                      ?= "."
2891                      ?< "."
2892                      ?> "."))
2893              (assoc (assq 'rc sh-mode-syntax-table-input)))
2894          (if assoc
2895              (rplacd assoc frag)
2896            (setq sh-mode-syntax-table-input
2897                  (cons (cons 'rc frag)
2898                        sh-mode-syntax-table-input))))))
2899
2900 ;;;--------------------------------------------------------------------------
2901 ;;; Emacs shell mode.
2902
2903 (defun mdw-eshell-prompt ()
2904   (let ((left "[") (right "]"))
2905     (when (= (user-uid) 0)
2906       (setq left "«" right "»"))
2907     (concat left
2908             (save-match-data
2909               (replace-regexp-in-string "\\..*$" "" (system-name)))
2910             " "
2911             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2912                    (home (expand-file-name "~")) (nhome (length home)))
2913               (if (and (>= npwd nhome)
2914                        (or (= nhome npwd)
2915                            (= (elt pwd nhome) ?/))
2916                        (string= (substring pwd 0 nhome) home))
2917                   (concat "~" (substring pwd (length home)))
2918                 pwd))
2919             right)))
2920 (setq eshell-prompt-function 'mdw-eshell-prompt)
2921 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2922
2923 (defun eshell/e (file) (find-file file) nil)
2924 (defun eshell/ee (file) (find-file-other-window file) nil)
2925 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2926
2927 (mdw-define-face eshell-prompt (t :weight bold))
2928 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2929 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2930 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2931 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2932 (mdw-define-face eshell-ls-executable (t :weight bold))
2933 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2934 (mdw-define-face eshell-ls-readonly (t nil))
2935 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2936
2937 ;;;--------------------------------------------------------------------------
2938 ;;; Messages-file mode.
2939
2940 (defun messages-mode-guts ()
2941   (setq messages-mode-syntax-table (make-syntax-table))
2942   (set-syntax-table messages-mode-syntax-table)
2943   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2944   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2945   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2946   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2947   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2948   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2949   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2950   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2951   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2952   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2953   (make-local-variable 'comment-start)
2954   (make-local-variable 'comment-end)
2955   (make-local-variable 'indent-line-function)
2956   (setq indent-line-function 'indent-relative)
2957   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2958   (make-local-variable 'font-lock-defaults)
2959   (make-local-variable 'messages-mode-keywords)
2960   (let ((keywords
2961          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2962                       "export" "enum" "fixed-octetstring" "flags"
2963                       "harmless" "map" "nested" "optional"
2964                       "optional-tagged" "package" "primitive"
2965                       "primitive-nullfree" "relaxed[ \t]+enum"
2966                       "set" "table" "tagged-optional"   "union"
2967                       "variadic" "vector" "version" "version-tag")))
2968     (setq messages-mode-keywords
2969           (list
2970            (list (concat "\\<\\(" keywords "\\)\\>:")
2971                  '(0 font-lock-keyword-face))
2972            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2973            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2974              (0 font-lock-variable-name-face))
2975            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2976            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2977              (0 mdw-punct-face)))))
2978   (setq font-lock-defaults
2979         '(messages-mode-keywords nil nil nil nil))
2980   (run-hooks 'messages-file-hook))
2981
2982 (defun messages-mode ()
2983   (interactive)
2984   (fundamental-mode)
2985   (setq major-mode 'messages-mode)
2986   (setq mode-name "Messages")
2987   (messages-mode-guts)
2988   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2989   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2990   (setq comment-start "# ")
2991   (setq comment-end "")
2992   (run-hooks 'messages-mode-hook))
2993
2994 (defun cpp-messages-mode ()
2995   (interactive)
2996   (fundamental-mode)
2997   (setq major-mode 'cpp-messages-mode)
2998   (setq mode-name "CPP Messages")
2999   (messages-mode-guts)
3000   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3001   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3002   (setq comment-start "/* ")
3003   (setq comment-end " */")
3004   (let ((preprocessor-keywords
3005          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3006                       "ident" "if" "ifdef" "ifndef" "import" "include"
3007                       "line" "pragma" "unassert" "undef" "warning")))
3008     (setq messages-mode-keywords
3009           (append (list (list (concat "^[ \t]*\\#[ \t]*"
3010                                       "\\(include\\|import\\)"
3011                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3012                               '(2 font-lock-string-face))
3013                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3014                                       preprocessor-keywords
3015                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
3016                               '(1 font-lock-keyword-face)))
3017                   messages-mode-keywords)))
3018   (run-hooks 'cpp-messages-mode-hook))
3019
3020 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3021 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
3022 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3023
3024 ;;;--------------------------------------------------------------------------
3025 ;;; Messages-file mode.
3026
3027 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3028   "Face to use for subsittution directives.")
3029 (make-face 'mallow-driver-substitution-face)
3030 (defvar mallow-driver-text-face 'mallow-driver-text-face
3031   "Face to use for body text.")
3032 (make-face 'mallow-driver-text-face)
3033
3034 (defun mallow-driver-mode ()
3035   (interactive)
3036   (fundamental-mode)
3037   (setq major-mode 'mallow-driver-mode)
3038   (setq mode-name "Mallow driver")
3039   (setq mallow-driver-mode-syntax-table (make-syntax-table))
3040   (set-syntax-table mallow-driver-mode-syntax-table)
3041   (make-local-variable 'comment-start)
3042   (make-local-variable 'comment-end)
3043   (make-local-variable 'indent-line-function)
3044   (setq indent-line-function 'indent-relative)
3045   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3046   (make-local-variable 'font-lock-defaults)
3047   (make-local-variable 'mallow-driver-mode-keywords)
3048   (let ((keywords
3049          (mdw-regexps "each" "divert" "file" "if"
3050                       "perl" "set" "string" "type" "write")))
3051     (setq mallow-driver-mode-keywords
3052           (list
3053            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3054                  '(0 font-lock-keyword-face))
3055            (list "^%\\s *\\(#.*\\|\\)$"
3056                  '(0 font-lock-comment-face))
3057            (list "^%"
3058                  '(0 font-lock-keyword-face))
3059            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3060            (list "\\${[^}]*}"
3061                  '(0 mallow-driver-substitution-face t)))))
3062   (setq font-lock-defaults
3063         '(mallow-driver-mode-keywords nil nil nil nil))
3064   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3065   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3066   (setq comment-start "%# ")
3067   (setq comment-end "")
3068   (run-hooks 'mallow-driver-mode-hook))
3069
3070 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3071
3072 ;;;--------------------------------------------------------------------------
3073 ;;; NFast debugs.
3074
3075 (defun nfast-debug-mode ()
3076   (interactive)
3077   (fundamental-mode)
3078   (setq major-mode 'nfast-debug-mode)
3079   (setq mode-name "NFast debug")
3080   (setq messages-mode-syntax-table (make-syntax-table))
3081   (set-syntax-table messages-mode-syntax-table)
3082   (make-local-variable 'font-lock-defaults)
3083   (make-local-variable 'nfast-debug-mode-keywords)
3084   (setq truncate-lines t)
3085   (setq nfast-debug-mode-keywords
3086         (list
3087          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3088            (0 font-lock-keyword-face))
3089          (list (concat "^[ \t]+\\(\\("
3090                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3091                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3092                        "[ \t]+\\)*"
3093                        "[0-9a-fA-F]+\\)[ \t]*$")
3094            '(0 mdw-number-face))
3095          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3096            (1 font-lock-keyword-face))
3097          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3098            (1 font-lock-warning-face))
3099          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3100            (1 nil))
3101          (list (concat "^[ \t]+\\.cmd=[ \t]+"
3102                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3103            '(1 font-lock-keyword-face))
3104          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3105          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3106          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3107          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3108   (setq font-lock-defaults
3109         '(nfast-debug-mode-keywords nil nil nil nil))
3110   (run-hooks 'nfast-debug-mode-hook))
3111
3112 ;;;--------------------------------------------------------------------------
3113 ;;; Other languages.
3114
3115 ;; Smalltalk.
3116
3117 (defun mdw-setup-smalltalk ()
3118   (and mdw-auto-indent
3119        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3120   (make-local-variable 'mdw-auto-indent)
3121   (setq mdw-auto-indent nil)
3122   (local-set-key "\C-i" 'smalltalk-reindent))
3123
3124 (defun mdw-fontify-smalltalk ()
3125   (make-local-variable 'font-lock-keywords)
3126   (setq font-lock-keywords
3127         (list
3128          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3129                '(0 font-lock-keyword-face))
3130          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3131                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3132                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3133                '(0 mdw-number-face))
3134          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3135                '(0 mdw-punct-face)))))
3136
3137 ;; Lispy languages.
3138
3139 ;; Unpleasant bodge.
3140 (unless (boundp 'slime-repl-mode-map)
3141   (setq slime-repl-mode-map (make-sparse-keymap)))
3142
3143 (defun mdw-indent-newline-and-indent ()
3144   (interactive)
3145   (indent-for-tab-command)
3146   (newline-and-indent))
3147
3148 (eval-after-load "cl-indent"
3149   '(progn
3150      (mapc #'(lambda (pair)
3151                (put (car pair)
3152                     'common-lisp-indent-function
3153                     (cdr pair)))
3154       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3155         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3156
3157 (defun mdw-common-lisp-indent ()
3158   (make-local-variable 'lisp-indent-function)
3159   (setq lisp-indent-function 'common-lisp-indent-function))
3160
3161 (setq lisp-simple-loop-indentation 2
3162       lisp-loop-keyword-indentation 6
3163       lisp-loop-forms-indentation 6)
3164
3165 (defun mdw-fontify-lispy ()
3166
3167   ;; Set fill prefix.
3168   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3169
3170   ;; Not much fontification needed.
3171   (make-local-variable 'font-lock-keywords)
3172   (setq font-lock-keywords
3173         (list (list (concat "\\("
3174                             "\\_<[-+]?"
3175                             "\\(" "[0-9]+/[0-9]+"
3176                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3177                                         "\\.[0-9]+" "\\)"
3178                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3179                             "\\)"
3180                             "\\|"
3181                             "#"
3182                             "\\(" "x" "[-+]?"
3183                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3184                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3185                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3186                             "\\|" "[0-9]+" "r" "[-+]?"
3187                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3188                             "\\)"
3189                             "\\)\\_>")
3190                     '(0 mdw-number-face))
3191               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3192                     '(0 mdw-punct-face)))))
3193
3194 (defun comint-send-and-indent ()
3195   (interactive)
3196   (comint-send-input)
3197   (and mdw-auto-indent
3198        (indent-for-tab-command)))
3199
3200 (defun mdw-setup-m4 ()
3201
3202   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
3203   ;; annoying: fix it.
3204   (modify-syntax-entry ?{ "(")
3205   (modify-syntax-entry ?} ")")
3206
3207   ;; Fill prefix.
3208   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3209
3210 ;;;--------------------------------------------------------------------------
3211 ;;; Text mode.
3212
3213 (defun mdw-text-mode ()
3214   (setq fill-column 72)
3215   (flyspell-mode t)
3216   (mdw-standard-fill-prefix
3217    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3218   (auto-fill-mode 1))
3219
3220 ;;;--------------------------------------------------------------------------
3221 ;;; Outline and hide/show modes.
3222
3223 (defun mdw-outline-collapse-all ()
3224   "Completely collapse everything in the entire buffer."
3225   (interactive)
3226   (save-excursion
3227     (goto-char (point-min))
3228     (while (< (point) (point-max))
3229       (hide-subtree)
3230       (forward-line))))
3231
3232 (setq hs-hide-comments-when-hiding-all nil)
3233
3234 (defadvice hs-hide-all (after hide-first-comment activate)
3235   (save-excursion (hs-hide-initial-comment-block)))
3236
3237 ;;;--------------------------------------------------------------------------
3238 ;;; Shell mode.
3239
3240 (defun mdw-sh-mode-setup ()
3241   (local-set-key [?\C-a] 'comint-bol)
3242   (add-hook 'comint-output-filter-functions
3243             'comint-watch-for-password-prompt))
3244
3245 (defun mdw-term-mode-setup ()
3246   (setq term-prompt-regexp shell-prompt-pattern)
3247   (make-local-variable 'mouse-yank-at-point)
3248   (make-local-variable 'transient-mark-mode)
3249   (setq mouse-yank-at-point t)
3250   (auto-fill-mode -1)
3251   (setq tab-width 8))
3252
3253 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3254 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3255 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3256 (defun term-send-meta-meta-something ()
3257   (interactive)
3258   (term-send-raw-string "\e\e")
3259   (term-send-raw))
3260 (eval-after-load 'term
3261   '(progn
3262      (define-key term-raw-map [?\e ?\e] nil)
3263      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3264      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3265      (define-key term-raw-map [M-right] 'term-send-meta-right)
3266      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3267      (define-key term-raw-map [M-left] 'term-send-meta-left)
3268      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3269
3270 (defadvice term-exec (before program-args-list compile activate)
3271   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3272 This allows you to pass a list of arguments through `ansi-term'."
3273   (let ((program (ad-get-arg 2)))
3274     (if (listp program)
3275         (progn
3276           (ad-set-arg 2 (car program))
3277           (ad-set-arg 4 (cdr program))))))
3278
3279 (defun ssh (host)
3280   "Open a terminal containing an ssh session to the HOST."
3281   (interactive "sHost: ")
3282   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3283
3284 (defvar git-grep-command
3285   "env PAGER=cat git grep --no-color -nH -e "
3286   "*The default command for \\[git-grep].")
3287
3288 (defvar git-grep-history nil)
3289
3290 (defun git-grep (command-args)
3291   "Run `git grep' with user-specified args and collect output in a buffer."
3292   (interactive
3293    (list (read-shell-command "Run git grep (like this): "
3294                              git-grep-command 'git-grep-history)))
3295   (grep command-args))
3296
3297 ;;;--------------------------------------------------------------------------
3298 ;;; Inferior Emacs Lisp.
3299
3300 (setq comint-prompt-read-only t)
3301
3302 (eval-after-load "comint"
3303   '(progn
3304      (define-key comint-mode-map "\C-w" 'comint-kill-region)
3305      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3306
3307 (eval-after-load "ielm"
3308   '(progn
3309      (define-key ielm-map "\C-w" 'comint-kill-region)
3310      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3311
3312 ;;;----- That's all, folks --------------------------------------------------
3313
3314 (provide 'dot-emacs)