mdw@git.distorted.org.uk Git - 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 ;; Some error trapping.
  56 ;;
  57 ;; If individual bits of this file go tits-up, we don't particularly want
  58 ;; the whole lot to stop right there and then, because it's bloody annoying.
  59
  60 (defmacro trap (&rest forms)
  61   "Execute FORMS without allowing errors to propagate outside."
  62   (declare (indent 0)
  63            (debug t))
  64   `(condition-case err
  65        ,(if (cdr forms) (cons 'progn forms) (car forms))
  66      (error (message "Error (trapped): %s in %s"
  67                      (error-message-string err)
  68                      ',forms))))
  69
  70 ;; Configuration reading.
  71
  72 (defvar mdw-config nil)
  73 (defun mdw-config (sym)
  74   "Read the configuration variable named SYM."
  75   (unless mdw-config
  76     (setq mdw-config
  77           (flet ((replace (what with)
  78                    (goto-char (point-min))
  79                    (while (re-search-forward what nil t)
  80                      (replace-match with t))))
  81             (with-temp-buffer
  82               (insert-file-contents "~/.mdw.conf")
  83               (replace  "^[ \t]*\\(#.*\\|\\)\n" "")
  84               (replace (concat "^[ \t]*"
  85                                "\\([-a-zA-Z0-9_.]*\\)"
  86                                "[ \t]*=[ \t]*"
  87                                "\\(.*[^ \t\n]\\|\\)"
  88                                "[ \t]**\\(\n\\|$\\)")
  89                        "(\\1 . \"\\2\")\n")
  90               (car (read-from-string
  91                     (concat "(" (buffer-string) ")")))))))
  92   (cdr (assq sym mdw-config)))
  93
  94 ;; Set up the load path convincingly.
  95
  96 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
  97                           (list (concat "/usr/share/"
  98                                         (symbol-name debian-emacs-flavor)
  99                                         "/site-lisp")))))
 100   (dolist (sub (directory-files dir t))
 101     (when (and (file-accessible-directory-p sub)
 102                (not (member sub load-path)))
 103       (setq load-path (nconc load-path (list sub))))))
 104
 105 ;; Is an Emacs library available?
 106
 107 (defun library-exists-p (name)
 108   "Return non-nil if NAME is an available library.
 109 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 110 load path.  The non-nil value is the filename we found for the
 111 library."
 112   (let ((path load-path) elt (foundp nil))
 113     (while (and path (not foundp))
 114       (setq elt (car path))
 115       (setq path (cdr path))
 116       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 117                          (and (file-exists-p file) file))
 118                        (let ((file (concat elt "/" name ".el")))
 119                          (and (file-exists-p file) file)))))
 120     foundp))
 121
 122 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 123   "Set an autoload if the file actually exists."
 124   (and (library-exists-p file)
 125        (autoload symbol file docstring interactivep type)))
 126
 127 ;; Splitting windows.
 128
 129 (unless (fboundp 'scroll-bar-columns)
 130   (defun scroll-bar-columns (side)
 131     (cond ((eq side 'left) 0)
 132           (window-system 3)
 133           (t 1))))
 134 (unless (fboundp 'fringe-columns)
 135   (defun fringe-columns (side)
 136     (cond ((not window-system) 0)
 137           ((eq side 'left) 1)
 138           (t 2))))
 139
 140 (defun mdw-divvy-window (&optional width)
 141   "Split a wide window into appropriate widths."
 142   (interactive "P")
 143   (setq width (cond (width (prefix-numeric-value width))
 144                     ((and window-system
 145                           (>= emacs-major-version 22))
 146                      77)
 147                     (t 78)))
 148   (let* ((win (selected-window))
 149          (sb-width (if (not window-system)
 150                        1
 151                      (let ((tot 0))
 152                        (dolist (what '(scroll-bar fringe))
 153                          (dolist (side '(left right))
 154                            (incf tot
 155                                  (funcall (intern (concat (symbol-name what)
 156                                                           "-columns"))
 157                                           side))))
 158                        tot)))
 159          (c (/ (+ (window-width) sb-width)
 160                (+ width sb-width))))
 161     (while (> c 1)
 162       (setq c (1- c))
 163       (split-window-horizontally (+ width sb-width))
 164       (other-window 1))
 165     (select-window win)))
 166
 167 ;; Functions for sexp diary entries.
 168
 169 (defun mdw-weekday (l)
 170   "Return non-nil if `date' falls on one of the days of the week in L.
 171 L is a list of day numbers (from 0 to 6 for Sunday through to
 172 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 173 the date stored in `date' falls on a listed day, then the
 174 function returns non-nil."
 175   (let ((d (calendar-day-of-week date)))
 176     (or (memq d l)
 177         (memq (nth d '(sunday monday tuesday wednesday
 178                               thursday friday saturday)) l))))
 179
 180 (defun mdw-todo (&optional when)
 181   "Return non-nil today, or on WHEN, whichever is later."
 182   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 183         (d (calendar-absolute-from-gregorian date)))
 184     (if when
 185         (setq w (max w (calendar-absolute-from-gregorian
 186                         (cond
 187                          ((not european-calendar-style)
 188                           when)
 189                          ((> (car when) 100)
 190                           (list (nth 1 when)
 191                                 (nth 2 when)
 192                                 (nth 0 when)))
 193                          (t
 194                           (list (nth 1 when)
 195                                 (nth 0 when)
 196                                 (nth 2 when))))))))
 197     (eq w d)))
 198
 199 ;; Fighting with Org-mode's evil key maps.
 200
 201 (defvar mdw-evil-keymap-keys
 202   '(([S-up] . [?\C-c up])
 203     ([S-down] . [?\C-c down])
 204     ([S-left] . [?\C-c left])
 205     ([S-right] . [?\C-c right])
 206     (([M-up] [?\e up]) . [C-up])
 207     (([M-down] [?\e down]) . [C-down])
 208     (([M-left] [?\e left]) . [C-left])
 209     (([M-right] [?\e right]) . [C-right]))
 210   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 211 The value is an alist mapping evil keys (as a list, or singleton)
 212 to good keys (in the same form).")
 213
 214 (defun mdw-clobber-evil-keymap (keymap)
 215   "Replace evil key bindings in the KEYMAP.
 216 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 217   (dolist (entry mdw-evil-keymap-keys)
 218     (let ((binding nil)
 219           (keys (if (listp (car entry))
 220                     (car entry)
 221                   (list (car entry))))
 222           (replacements (if (listp (cdr entry))
 223                             (cdr entry)
 224                           (list (cdr entry)))))
 225       (catch 'found
 226         (dolist (key keys)
 227           (setq binding (lookup-key keymap key))
 228           (when binding
 229             (throw 'found nil))))
 230       (when binding
 231         (dolist (key keys)
 232           (define-key keymap key nil))
 233         (dolist (key replacements)
 234           (define-key keymap key binding))))))
 235
 236 (eval-after-load "org-latex"
 237   '(progn
 238      (push '("strayman"
 239              "\\documentclass{strayman}
 240 \\usepackage[utf8]{inputenc}
 241 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 242 \\usepackage[T1]{fontenc}
 243 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 244              ("\\section{%s}" . "\\section*{%s}")
 245              ("\\subsection{%s}" . "\\subsection*{%s}")
 246              ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 247              ("\\paragraph{%s}" . "\\paragraph*{%s}")
 248              ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
 249            org-export-latex-classes)))
 250
 251 ;;;--------------------------------------------------------------------------
 252 ;;; Mail and news hacking.
 253
 254 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
 255   "Major mode for editing news and mail messages from external programs.
 256 Not much right now.  Just support for doing MailCrypt stuff."
 257   :syntax-table nil
 258   :abbrev-table nil
 259   (run-hooks 'mail-setup-hook))
 260
 261 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
 262
 263 (add-hook 'mdwail-mode-hook
 264           (lambda ()
 265             (set-buffer-file-coding-system 'utf-8)
 266             (make-local-variable 'paragraph-separate)
 267             (make-local-variable 'paragraph-start)
 268             (setq paragraph-start
 269                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 270                           paragraph-start))
 271             (setq paragraph-separate
 272                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 273                           paragraph-separate))))
 274
 275 ;; How to encrypt in mdwmail.
 276
 277 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 278   (or start
 279       (setq start (save-excursion
 280                     (goto-char (point-min))
 281                     (or (search-forward "\n\n" nil t) (point-min)))))
 282   (or end
 283       (setq end (point-max)))
 284   (mc-encrypt-generic recip scm start end from sign))
 285
 286 ;; How to sign in mdwmail.
 287
 288 (defun mdwmail-mc-sign (key scm start end uclr)
 289   (or start
 290       (setq start (save-excursion
 291                     (goto-char (point-min))
 292                     (or (search-forward "\n\n" nil t) (point-min)))))
 293   (or end
 294       (setq end (point-max)))
 295   (mc-sign-generic key scm start end uclr))
 296
 297 ;; Some signature mangling.
 298
 299 (defun mdwmail-mangle-signature ()
 300   (save-excursion
 301     (goto-char (point-min))
 302     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 303 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 304 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
 305
 306 ;; Insert my login name into message-ids, so I can score replies.
 307
 308 (defadvice message-unique-id (after mdw-user-name last activate compile)
 309   "Ensure that the user's name appears at the end of the message-id string,
 310 so that it can be used for convenient filtering."
 311   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
 312
 313 ;; Tell my movemail hack where movemail is.
 314 ;;
 315 ;; This is needed to shup up warnings about LD_PRELOAD.
 316
 317 (let ((path exec-path))
 318   (while path
 319     (let ((try (expand-file-name "movemail" (car path))))
 320       (if (file-executable-p try)
 321           (setenv "REAL_MOVEMAIL" try))
 322       (setq path (cdr path)))))
 323
 324 ;;;--------------------------------------------------------------------------
 325 ;;; Utility functions.
 326
 327 (or (fboundp 'line-number-at-pos)
 328     (defun line-number-at-pos (&optional pos)
 329       (let ((opoint (or pos (point))) start)
 330         (save-excursion
 331           (save-restriction
 332             (goto-char (point-min))
 333             (widen)
 334             (forward-line 0)
 335             (setq start (point))
 336             (goto-char opoint)
 337             (forward-line 0)
 338             (1+ (count-lines 1 (point))))))))
 339
 340 (defun mdw-uniquify-alist (&rest alists)
 341   "Return the concatenation of the ALISTS with duplicate elements removed.
 342 The first association with a given key prevails; others are
 343 ignored.  The input lists are not modified, although they'll
 344 probably become garbage."
 345   (and alists
 346        (let ((start-list (cons nil nil)))
 347          (mdw-do-uniquify start-list
 348                           start-list
 349                           (car alists)
 350                           (cdr alists)))))
 351
 352
 353 (defun mdw-do-uniquify (done end l rest)
 354   "A helper function for mdw-uniquify-alist.
 355 The DONE argument is a list whose first element is `nil'.  It
 356 contains the uniquified alist built so far.  The leading `nil' is
 357 stripped off at the end of the operation; it's only there so that
 358 DONE always references a cons cell.  END refers to the final cons
 359 cell in the DONE list; it is modified in place each time to avoid
 360 the overheads of `append'ing all the time.  The L argument is the
 361 alist we're currently processing; the remaining alists are given
 362 in REST."
 363
 364   ;; There are several different cases to deal with here.
 365   (cond
 366
 367    ;; Current list isn't empty.  Add the first item to the DONE list if
 368    ;; there's not an item with the same KEY already there.
 369    (l (or (assoc (car (car l)) done)
 370           (progn
 371             (setcdr end (cons (car l) nil))
 372             (setq end (cdr end))))
 373       (mdw-do-uniquify done end (cdr l) rest))
 374
 375    ;; The list we were working on is empty.  Shunt the next list into the
 376    ;; current list position and go round again.
 377    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 378
 379    ;; Everything's done.  Remove the leading `nil' from the DONE list and
 380    ;; return it.  Finished!
 381    (t (cdr done))))
 382
 383 (defun date ()
 384   "Insert the current date in a pleasing way."
 385   (interactive)
 386   (insert (save-excursion
 387             (let ((buffer (get-buffer-create "*tmp*")))
 388               (unwind-protect (progn (set-buffer buffer)
 389                                      (erase-buffer)
 390                                      (shell-command "date +%Y-%m-%d" t)
 391                                      (goto-char (mark))
 392                                      (delete-backward-char 1)
 393                                      (buffer-string))
 394                 (kill-buffer buffer))))))
 395
 396 (defun uuencode (file &optional name)
 397   "UUencodes a file, maybe calling it NAME, into the current buffer."
 398   (interactive "fInput file name: ")
 399
 400   ;; If NAME isn't specified, then guess from the filename.
 401   (if (not name)
 402       (setq name
 403             (substring file
 404                        (or (string-match "[^/]*$" file) 0))))
 405   (print (format "uuencode `%s' `%s'" file name))
 406
 407   ;; Now actually do the thing.
 408   (call-process "uuencode" file t nil name))
 409
 410 (defvar np-file "~/.np"
 411   "*Where the `now-playing' file is.")
 412
 413 (defun np (&optional arg)
 414   "Grabs a `now-playing' string."
 415   (interactive)
 416   (save-excursion
 417     (or arg (progn
 418               (goto-char (point-max))
 419               (insert "\nNP: ")
 420               (insert-file-contents np-file)))))
 421
 422 (defun mdw-check-autorevert ()
 423   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
 424 This takes into consideration whether it's been found using
 425 tramp, which seems to get itself into a twist."
 426   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 427          nil)
 428         ((and (buffer-file-name)
 429               (fboundp 'tramp-tramp-file-p)
 430               (tramp-tramp-file-p (buffer-file-name)))
 431          (unless global-auto-revert-ignore-buffer
 432            (setq global-auto-revert-ignore-buffer 'tramp)))
 433         ((eq global-auto-revert-ignore-buffer 'tramp)
 434          (setq global-auto-revert-ignore-buffer nil))))
 435
 436 (defadvice find-file (after mdw-autorevert activate)
 437   (mdw-check-autorevert))
 438 (defadvice write-file (after mdw-autorevert activate)
 439   (mdw-check-autorevert))
 440
 441 ;;;--------------------------------------------------------------------------
 442 ;;; Dired hacking.
 443
 444 (defadvice dired-maybe-insert-subdir
 445     (around mdw-marked-insertion first activate)
 446   "The DIRNAME may be a list of directory names to insert.
 447 Interactively, if files are marked, then insert all of them.
 448 With a numeric prefix argument, select that many entries near
 449 point; with a non-numeric prefix argument, prompt for listing
 450 options."
 451   (interactive
 452    (list (dired-get-marked-files nil
 453                                  (and (integerp current-prefix-arg)
 454                                       current-prefix-arg)
 455                                  #'file-directory-p)
 456          (and current-prefix-arg
 457               (not (integerp current-prefix-arg))
 458               (read-string "Switches for listing: "
 459                            (or dired-subdir-switches
 460                                dired-actual-switches)))))
 461   (let ((dirs (ad-get-arg 0)))
 462     (dolist (dir (if (listp dirs) dirs (list dirs)))
 463       (ad-set-arg 0 dir)
 464       ad-do-it)))
 465
 466 ;;;--------------------------------------------------------------------------
 467 ;;; URL viewing.
 468
 469 (defun mdw-w3m-browse-url (url &optional new-session-p)
 470   "Invoke w3m on the URL in its current window, or at least a different one.
 471 If NEW-SESSION-P, start a new session."
 472   (interactive "sURL: \nP")
 473   (save-excursion
 474     (let ((window (selected-window)))
 475       (unwind-protect
 476           (progn
 477             (select-window (or (and (not new-session-p)
 478                                     (get-buffer-window "*w3m*"))
 479                                (progn
 480                                  (if (one-window-p t) (split-window))
 481                                  (get-lru-window))))
 482             (w3m-browse-url url new-session-p))
 483         (select-window window)))))
 484
 485 (defvar mdw-good-url-browsers
 486   '((w3m . mdw-w3m-browse-url)
 487     browse-url-w3
 488     browse-url-mozilla)
 489   "List of good browsers for mdw-good-url-browsers.
 490 Each item is a browser function name, or a cons (CHECK . FUNC).
 491 A symbol FOO stands for (FOO . FOO).")
 492
 493 (defun mdw-good-url-browser ()
 494   "Return a good URL browser.
 495 Trundle the list of such things, finding the first item for which
 496 CHECK is fboundp, and returning the correponding FUNC."
 497   (let ((bs mdw-good-url-browsers) b check func answer)
 498     (while (and bs (not answer))
 499       (setq b (car bs)
 500             bs (cdr bs))
 501       (if (consp b)
 502           (setq check (car b) func (cdr b))
 503         (setq check b func b))
 504       (if (fboundp check)
 505           (setq answer func)))
 506     answer))
 507
 508 ;;;--------------------------------------------------------------------------
 509 ;;; Paragraph filling.
 510
 511 ;; Useful variables.
 512
 513 (defvar mdw-fill-prefix nil
 514   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
 515 If there's no fill prefix currently set (by the `fill-prefix'
 516 variable) and there's a match from one of the regexps here, it
 517 gets used to set the fill-prefix for the current operation.
 518
 519 The variable is a list of items of the form `REGEXP . PREFIX'; if
 520 the REGEXP matches, the PREFIX is used to set the fill prefix.
 521 It in turn is a list of things:
 522
 523   STRING -- insert a literal string
 524   (match . N) -- insert the thing matched by bracketed subexpression N
 525   (pad . N) -- a string of whitespace the same width as subexpression N
 526   (expr . FORM) -- the result of evaluating FORM")
 527
 528 (make-variable-buffer-local 'mdw-fill-prefix)
 529
 530 (defvar mdw-hanging-indents
 531   (concat "\\(\\("
 532             "\\([*o]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
 533             "[ \t]+"
 534           "\\)?\\)")
 535   "*Standard regexp matching parts of a hanging indent.
 536 This is mainly useful in `auto-fill-mode'.")
 537
 538 ;; Setting things up.
 539
 540 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 541
 542 ;; Utility functions.
 543
 544 (defun mdw-tabify (s)
 545   "Tabify the string S.  This is a horrid hack."
 546   (save-excursion
 547     (save-match-data
 548       (let (start end)
 549         (beginning-of-line)
 550         (setq start (point-marker))
 551         (insert s "\n")
 552         (setq end (point-marker))
 553         (tabify start end)
 554         (setq s (buffer-substring start (1- end)))
 555         (delete-region start end)
 556         (set-marker start nil)
 557         (set-marker end nil)
 558         s))))
 559
 560 (defun mdw-examine-fill-prefixes (l)
 561   "Given a list of dynamic fill prefixes, pick one which matches
 562 context and return the static fill prefix to use.  Point must be
 563 at the start of a line, and match data must be saved."
 564   (cond ((not l) nil)
 565                ((looking-at (car (car l)))
 566                 (mdw-tabify (apply (function concat)
 567                                    (mapcar (function mdw-do-prefix-match)
 568                                            (cdr (car l))))))
 569                (t (mdw-examine-fill-prefixes (cdr l)))))
 570
 571 (defun mdw-maybe-car (p)
 572   "If P is a pair, return (car P), otherwise just return P."
 573   (if (consp p) (car p) p))
 574
 575 (defun mdw-padding (s)
 576   "Return a string the same width as S but made entirely from whitespace."
 577   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 578     (while (< i l)
 579       (if (= 9 (aref s i))
 580           (aset n i 9))
 581       (setq i (1+ i)))
 582     n))
 583
 584 (defun mdw-do-prefix-match (m)
 585   "Expand a dynamic prefix match element.
 586 See `mdw-fill-prefix' for details."
 587   (cond ((not (consp m)) (format "%s" m))
 588            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 589            ((eq (car m) 'pad) (mdw-padding (match-string
 590                                             (mdw-maybe-car (cdr m)))))
 591            ((eq (car m) 'eval) (eval (cdr m)))
 592            (t "")))
 593
 594 (defun mdw-choose-dynamic-fill-prefix ()
 595   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 596   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 597            ((not mdw-fill-prefix) fill-prefix)
 598            (t (save-excursion
 599                 (beginning-of-line)
 600                 (save-match-data
 601                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 602
 603 (defun do-auto-fill ()
 604   "Handle auto-filling, working out a dynamic fill prefix in the
 605 case where there isn't a sensible static one."
 606   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 607     (mdw-do-auto-fill)))
 608
 609 (defun mdw-fill-paragraph ()
 610   "Fill paragraph, getting a dynamic fill prefix."
 611   (interactive)
 612   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 613     (fill-paragraph nil)))
 614
 615 (defun mdw-standard-fill-prefix (rx &optional mat)
 616   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 617 This is just a short-cut for setting the thing by hand, and by
 618 design it doesn't cope with anything approximating a complicated
 619 case."
 620   (setq mdw-fill-prefix
 621            `((,(concat rx mdw-hanging-indents)
 622               (match . 1)
 623               (pad . ,(or mat 2))))))
 624
 625 ;;;--------------------------------------------------------------------------
 626 ;;; Other common declarations.
 627
 628 ;; Common mode settings.
 629
 630 (defvar mdw-auto-indent t
 631   "Whether to indent automatically after a newline.")
 632
 633 (defun mdw-misc-mode-config ()
 634   (and mdw-auto-indent
 635        (cond ((eq major-mode 'lisp-mode)
 636               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 637              ((or (eq major-mode 'slime-repl-mode)
 638                   (eq major-mode 'asm-mode))
 639               nil)
 640              (t
 641               (local-set-key "\C-m" 'newline-and-indent))))
 642   (local-set-key [C-return] 'newline)
 643   (make-variable-buffer-local 'page-delimiter)
 644   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 645   (setq comment-column 40)
 646   (auto-fill-mode 1)
 647   (setq fill-column 77)
 648   (setq show-trailing-whitespace t)
 649   (and (fboundp 'gtags-mode)
 650        (gtags-mode))
 651   (outline-minor-mode t)
 652   (hs-minor-mode t)
 653   (reveal-mode t)
 654   (trap (turn-on-font-lock)))
 655
 656 (eval-after-load 'gtags
 657   '(progn
 658      (dolist (key '([mouse-2] [mouse-3]))
 659        (define-key gtags-mode-map key nil))
 660      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 661      (define-key gtags-select-mode-map [C-S-mouse-2]
 662        'gtags-select-tag-by-event)
 663      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 664        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 665
 666 ;; Backup file handling.
 667
 668 (defvar mdw-backup-disable-regexps nil
 669   "*List of regular expressions: if a file name matches any of
 670 these then the file is not backed up.")
 671
 672 (defun mdw-backup-enable-predicate (name)
 673   "[mdw]'s default backup predicate.
 674 Allows a backup if the standard predicate would allow it, and it
 675 doesn't match any of the regular expressions in
 676 `mdw-backup-disable-regexps'."
 677   (and (normal-backup-enable-predicate name)
 678        (let ((answer t) (list mdw-backup-disable-regexps))
 679          (save-match-data
 680            (while list
 681              (if (string-match (car list) name)
 682                  (setq answer nil))
 683              (setq list (cdr list)))
 684            answer))))
 685 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 686
 687 ;;;--------------------------------------------------------------------------
 688 ;;; General fontification.
 689
 690 (defmacro mdw-define-face (name &rest body)
 691   "Define a face, and make sure it's actually set as the definition."
 692   (declare (indent 1)
 693            (debug 0))
 694   `(progn
 695      (make-face ',name)
 696      (defvar ,name ',name)
 697      (put ',name 'face-defface-spec ',body)
 698      (face-spec-set ',name ',body nil)))
 699
 700 (mdw-define-face default
 701   (((type w32)) :family "courier new" :height 85)
 702   (((type x)) :family "6x13" :height 130)
 703   (((type color)) :foreground "white" :background "black")
 704   (t nil))
 705 (mdw-define-face fixed-pitch
 706   (((type w32)) :family "courier new" :height 85)
 707   (((type x)) :family "6x13" :height 130)
 708   (t :foreground "white" :background "black"))
 709 (if (>= emacs-major-version 23)
 710     (mdw-define-face variable-pitch
 711       (((type x)) :family "sans" :height 100))
 712   (mdw-define-face variable-pitch
 713     (((type x)) :family "helvetica" :height 120)))
 714 (mdw-define-face region
 715   (((type tty) (class color)) :background "blue")
 716   (((type tty) (class mono)) :inverse-video t)
 717   (t :background "grey30"))
 718 (mdw-define-face minibuffer-prompt
 719   (t :weight bold))
 720 (mdw-define-face mode-line
 721   (((class color)) :foreground "blue" :background "yellow"
 722                    :box (:line-width 1 :style released-button))
 723   (t :inverse-video t))
 724 (mdw-define-face mode-line-inactive
 725   (((class color)) :foreground "yellow" :background "blue"
 726                    :box (:line-width 1 :style released-button))
 727   (t :inverse-video t))
 728 (mdw-define-face scroll-bar
 729   (t :foreground "black" :background "lightgrey"))
 730 (mdw-define-face fringe
 731   (t :foreground "yellow"))
 732 (mdw-define-face show-paren-match
 733   (((class color)) :background "darkgreen")
 734   (t :underline t))
 735 (mdw-define-face show-paren-mismatch
 736   (((class color)) :background "red")
 737   (t :inverse-video t))
 738 (mdw-define-face highlight
 739   (((class color)) :background "DarkSeaGreen4")
 740   (t :inverse-video t))
 741
 742 (mdw-define-face holiday-face
 743   (t :background "red"))
 744 (mdw-define-face calendar-today-face
 745   (t :foreground "yellow" :weight bold))
 746
 747 (mdw-define-face comint-highlight-prompt
 748   (t :weight bold))
 749 (mdw-define-face comint-highlight-input)
 750
 751 (mdw-define-face trailing-whitespace
 752   (((class color)) :background "red")
 753   (t :inverse-video t))
 754 (mdw-define-face mdw-punct-face
 755   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 756 (mdw-define-face mdw-number-face
 757   (t :foreground "yellow"))
 758 (mdw-define-face font-lock-function-name-face
 759   (t :slant italic))
 760 (mdw-define-face font-lock-keyword-face
 761   (t :weight bold))
 762 (mdw-define-face font-lock-constant-face
 763   (t :slant italic))
 764 (mdw-define-face font-lock-builtin-face
 765   (t :weight bold))
 766 (mdw-define-face font-lock-reference-face
 767   (t :weight bold))
 768 (mdw-define-face font-lock-variable-name-face
 769   (t :slant italic))
 770 (mdw-define-face font-lock-comment-delimiter-face
 771   (((class mono)) :weight bold)
 772   (((type tty) (class color)) :foreground "green")
 773   (t :slant italic :foreground "SeaGreen1"))
 774 (mdw-define-face font-lock-comment-face
 775   (((class mono)) :weight bold)
 776   (((type tty) (class color)) :foreground "green")
 777   (t :slant italic :foreground "SeaGreen1"))
 778 (mdw-define-face font-lock-string-face
 779   (((class mono)) :weight bold)
 780   (((class color)) :foreground "SkyBlue1"))
 781 (mdw-define-face message-separator
 782   (t :background "red" :foreground "white" :weight bold))
 783 (mdw-define-face message-cited-text
 784   (default :slant italic)
 785   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 786 (mdw-define-face message-header-cc
 787   (default :weight bold)
 788   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 789 (mdw-define-face message-header-newsgroups
 790   (default :weight bold)
 791   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 792 (mdw-define-face message-header-subject
 793   (default :weight bold)
 794   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 795 (mdw-define-face message-header-to
 796   (default :weight bold)
 797   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 798 (mdw-define-face message-header-xheader
 799   (default :weight bold)
 800   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 801 (mdw-define-face message-header-other
 802   (default :weight bold)
 803   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 804 (mdw-define-face message-header-name
 805   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 806
 807 (mdw-define-face diff-index
 808   (t :weight bold))
 809 (mdw-define-face diff-file-header
 810   (t :weight bold))
 811 (mdw-define-face diff-hunk-header
 812   (t :foreground "SkyBlue1"))
 813 (mdw-define-face diff-function
 814   (t :foreground "SkyBlue1" :weight bold))
 815 (mdw-define-face diff-header
 816   (t :background "grey10"))
 817 (mdw-define-face diff-added
 818   (t :foreground "green"))
 819 (mdw-define-face diff-removed
 820   (t :foreground "red"))
 821 (mdw-define-face diff-context)
 822
 823 (mdw-define-face erc-input-face
 824   (t :foreground "red"))
 825
 826 (mdw-define-face woman-bold
 827   (t :weight bold))
 828 (mdw-define-face woman-italic
 829   (t :slant italic))
 830
 831 (mdw-define-face p4-depot-added-face
 832   (t :foreground "green"))
 833 (mdw-define-face p4-depot-branch-op-face
 834   (t :foreground "yellow"))
 835 (mdw-define-face p4-depot-deleted-face
 836   (t :foreground "red"))
 837 (mdw-define-face p4-depot-unmapped-face
 838   (t :foreground "SkyBlue1"))
 839 (mdw-define-face p4-diff-change-face
 840   (t :foreground "yellow"))
 841 (mdw-define-face p4-diff-del-face
 842   (t :foreground "red"))
 843 (mdw-define-face p4-diff-file-face
 844   (t :foreground "SkyBlue1"))
 845 (mdw-define-face p4-diff-head-face
 846   (t :background "grey10"))
 847 (mdw-define-face p4-diff-ins-face
 848   (t :foreground "green"))
 849
 850 (mdw-define-face whizzy-slice-face
 851   (t :background "grey10"))
 852 (mdw-define-face whizzy-error-face
 853   (t :background "darkred"))
 854
 855 ;;;--------------------------------------------------------------------------
 856 ;;; C programming configuration.
 857
 858 ;; Linux kernel hacking.
 859
 860 (defvar linux-c-mode-hook)
 861
 862 (defun linux-c-mode ()
 863   (interactive)
 864   (c-mode)
 865   (setq major-mode 'linux-c-mode)
 866   (setq mode-name "Linux C")
 867   (run-hooks 'linux-c-mode-hook))
 868
 869 ;; Make C indentation nice.
 870
 871 (defun mdw-c-lineup-arglist (langelem)
 872   "Hack for DWIMmery in c-lineup-arglist."
 873   (if (save-excursion
 874         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
 875       0
 876     (c-lineup-arglist langelem)))
 877
 878 (defun mdw-c-indent-extern-mumble (langelem)
 879   "Indent `extern \"...\" {' lines."
 880   (save-excursion
 881     (back-to-indentation)
 882     (if (looking-at
 883          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
 884         c-basic-offset
 885       nil)))
 886
 887 (defun mdw-c-style ()
 888   (c-add-style "[mdw] C and C++ style"
 889                '((c-basic-offset . 2)
 890                  (comment-column . 40)
 891                  (c-class-key . "class")
 892                  (c-backslash-column . 72)
 893                  (c-offsets-alist
 894                   (substatement-open . (add 0 c-indent-one-line-block))
 895                   (defun-open . (add 0 c-indent-one-line-block))
 896                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
 897                   (topmost-intro . mdw-c-indent-extern-mumble)
 898                   (cpp-define-intro . 0)
 899                   (inextern-lang . [0])
 900                   (label . 0)
 901                   (case-label . +)
 902                   (access-label . -)
 903                   (inclass . +)
 904                   (inline-open . ++)
 905                   (statement-cont . 0)
 906                   (statement-case-intro . +)))
 907                t))
 908
 909 (defvar mdw-c-comment-fill-prefix
 910   `((,(concat "\\([ \t]*/?\\)"
 911               "\\(\*\\|//]\\)"
 912               "\\([ \t]*\\)"
 913               "\\([A-Za-z]+:[ \t]*\\)?"
 914               mdw-hanging-indents)
 915      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
 916   "Fill prefix matching C comments (both kinds).")
 917
 918 (defun mdw-fontify-c-and-c++ ()
 919
 920   ;; Fiddle with some syntax codes.
 921   (modify-syntax-entry ?* ". 23")
 922   (modify-syntax-entry ?/ ". 124b")
 923   (modify-syntax-entry ?\n "> b")
 924
 925   ;; Other stuff.
 926   (mdw-c-style)
 927   (setq c-hanging-comment-ender-p nil)
 928   (setq c-backslash-column 72)
 929   (setq c-label-minimum-indentation 0)
 930   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
 931
 932   ;; Now define things to be fontified.
 933   (make-local-variable 'font-lock-keywords)
 934   (let ((c-keywords
 935          (mdw-regexps "and"             ;C++
 936                       "and_eq"          ;C++
 937                       "asm"             ;K&R, GCC
 938                       "auto"            ;K&R, C89
 939                       "bitand"          ;C++
 940                       "bitor"           ;C++
 941                       "bool"            ;C++, C9X macro
 942                       "break"           ;K&R, C89
 943                       "case"            ;K&R, C89
 944                       "catch"           ;C++
 945                       "char"            ;K&R, C89
 946                       "class"           ;C++
 947                       "complex"         ;C9X macro, C++ template type
 948                       "compl"           ;C++
 949                       "const"           ;C89
 950                       "const_cast"      ;C++
 951                       "continue"        ;K&R, C89
 952                       "defined"         ;C89 preprocessor
 953                       "default"         ;K&R, C89
 954                       "delete"          ;C++
 955                       "do"              ;K&R, C89
 956                       "double"          ;K&R, C89
 957                       "dynamic_cast"    ;C++
 958                       "else"            ;K&R, C89
 959                       ;; "entry"        ;K&R -- never used
 960                       "enum"            ;C89
 961                       "explicit"        ;C++
 962                       "export"          ;C++
 963                       "extern"          ;K&R, C89
 964                       "false"           ;C++, C9X macro
 965                       "float"           ;K&R, C89
 966                       "for"             ;K&R, C89
 967                       ;; "fortran"      ;K&R
 968                       "friend"          ;C++
 969                       "goto"            ;K&R, C89
 970                       "if"              ;K&R, C89
 971                       "imaginary"       ;C9X macro
 972                       "inline"          ;C++, C9X, GCC
 973                       "int"             ;K&R, C89
 974                       "long"            ;K&R, C89
 975                       "mutable"         ;C++
 976                       "namespace"       ;C++
 977                       "new"             ;C++
 978                       "operator"        ;C++
 979                       "or"              ;C++
 980                       "or_eq"           ;C++
 981                       "private"         ;C++
 982                       "protected"       ;C++
 983                       "public"          ;C++
 984                       "register"        ;K&R, C89
 985                       "reinterpret_cast" ;C++
 986                       "restrict"         ;C9X
 987                       "return"           ;K&R, C89
 988                       "short"            ;K&R, C89
 989                       "signed"           ;C89
 990                       "sizeof"           ;K&R, C89
 991                       "static"           ;K&R, C89
 992                       "static_cast"      ;C++
 993                       "struct"           ;K&R, C89
 994                       "switch"           ;K&R, C89
 995                       "template"         ;C++
 996                       "this"             ;C++
 997                       "throw"            ;C++
 998                       "true"             ;C++, C9X macro
 999                       "try"              ;C++
1000                       "this"             ;C++
1001                       "typedef"          ;C89
1002                       "typeid"           ;C++
1003                       "typeof"           ;GCC
1004                       "typename"         ;C++
1005                       "union"            ;K&R, C89
1006                       "unsigned"         ;K&R, C89
1007                       "using"            ;C++
1008                       "virtual"          ;C++
1009                       "void"             ;C89
1010                       "volatile"         ;C89
1011                       "wchar_t"          ;C++, C89 library type
1012                       "while"            ;K&R, C89
1013                       "xor"              ;C++
1014                       "xor_eq"           ;C++
1015                       "_Bool"            ;C9X
1016                       "_Complex"         ;C9X
1017                       "_Imaginary"       ;C9X
1018                       "_Pragma"          ;C9X preprocessor
1019                       "__alignof__"      ;GCC
1020                       "__asm__"          ;GCC
1021                       "__attribute__"    ;GCC
1022                       "__complex__"      ;GCC
1023                       "__const__"        ;GCC
1024                       "__extension__"    ;GCC
1025                       "__imag__"         ;GCC
1026                       "__inline__"       ;GCC
1027                       "__label__"        ;GCC
1028                       "__real__"         ;GCC
1029                       "__signed__"       ;GCC
1030                       "__typeof__"       ;GCC
1031                       "__volatile__"     ;GCC
1032                       ))
1033         (preprocessor-keywords
1034          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1035                       "ident" "if" "ifdef" "ifndef" "import" "include"
1036                       "line" "pragma" "unassert" "undef" "warning"))
1037         (objc-keywords
1038          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1039                       "interface" "private" "protected" "protocol" "public"
1040                       "selector")))
1041
1042     (setq font-lock-keywords
1043           (list
1044
1045            ;; Fontify include files as strings.
1046            (list (concat "^[ \t]*\\#[ \t]*"
1047                          "\\(include\\|import\\)"
1048                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1049                  '(2 font-lock-string-face))
1050
1051            ;; Preprocessor directives are `references'?.
1052            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1053                          preprocessor-keywords
1054                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1055                  '(1 font-lock-keyword-face))
1056
1057            ;; Handle the keywords defined above.
1058            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1059                  '(0 font-lock-keyword-face))
1060
1061            (list (concat "\\<\\(" c-keywords "\\)\\>")
1062                  '(0 font-lock-keyword-face))
1063
1064            ;; Handle numbers too.
1065            ;;
1066            ;; This looks strange, I know.  It corresponds to the
1067            ;; preprocessor's idea of what a number looks like, rather than
1068            ;; anything sensible.
1069            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1070                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1071                  '(0 mdw-number-face))
1072
1073            ;; And anything else is punctuation.
1074            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1075                  '(0 mdw-punct-face))))))
1076
1077 ;;;--------------------------------------------------------------------------
1078 ;;; AP calc mode.
1079
1080 (defun apcalc-mode ()
1081   (interactive)
1082   (c-mode)
1083   (setq major-mode 'apcalc-mode)
1084   (setq mode-name "AP Calc")
1085   (run-hooks 'apcalc-mode-hook))
1086
1087 (defun mdw-fontify-apcalc ()
1088
1089   ;; Fiddle with some syntax codes.
1090   (modify-syntax-entry ?* ". 23")
1091   (modify-syntax-entry ?/ ". 14")
1092
1093   ;; Other stuff.
1094   (mdw-c-style)
1095   (setq c-hanging-comment-ender-p nil)
1096   (setq c-backslash-column 72)
1097   (setq comment-start "/* ")
1098   (setq comment-end " */")
1099   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1100
1101   ;; Now define things to be fontified.
1102   (make-local-variable 'font-lock-keywords)
1103   (let ((c-keywords
1104          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1105                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1106                       "local" "mat" "obj" "print" "quit" "read" "return"
1107                       "show" "static" "switch" "while" "write")))
1108
1109     (setq font-lock-keywords
1110           (list
1111
1112            ;; Handle the keywords defined above.
1113            (list (concat "\\<\\(" c-keywords "\\)\\>")
1114                  '(0 font-lock-keyword-face))
1115
1116            ;; Handle numbers too.
1117            ;;
1118            ;; This looks strange, I know.  It corresponds to the
1119            ;; preprocessor's idea of what a number looks like, rather than
1120            ;; anything sensible.
1121            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1122                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1123                  '(0 mdw-number-face))
1124
1125            ;; And anything else is punctuation.
1126            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1127                  '(0 mdw-punct-face))))))
1128
1129 ;;;--------------------------------------------------------------------------
1130 ;;; Java programming configuration.
1131
1132 ;; Make indentation nice.
1133
1134 (defun mdw-java-style ()
1135   (c-add-style "[mdw] Java style"
1136                '((c-basic-offset . 2)
1137                  (c-offsets-alist (substatement-open . 0)
1138                                   (label . +)
1139                                   (case-label . +)
1140                                   (access-label . 0)
1141                                   (inclass . +)
1142                                   (statement-case-intro . +)))
1143                t))
1144
1145 ;; Declare Java fontification style.
1146
1147 (defun mdw-fontify-java ()
1148
1149   ;; Other stuff.
1150   (mdw-java-style)
1151   (setq c-hanging-comment-ender-p nil)
1152   (setq c-backslash-column 72)
1153   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1154
1155   ;; Now define things to be fontified.
1156   (make-local-variable 'font-lock-keywords)
1157   (let ((java-keywords
1158          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1159                       "char" "class" "const" "continue" "default" "do"
1160                       "double" "else" "extends" "final" "finally" "float"
1161                       "for" "goto" "if" "implements" "import" "instanceof"
1162                       "int" "interface" "long" "native" "new" "package"
1163                       "private" "protected" "public" "return" "short"
1164                       "static" "super" "switch" "synchronized" "this"
1165                       "throw" "throws" "transient" "try" "void" "volatile"
1166                       "while"
1167
1168                       "false" "null" "true")))
1169
1170     (setq font-lock-keywords
1171           (list
1172
1173            ;; Handle the keywords defined above.
1174            (list (concat "\\<\\(" java-keywords "\\)\\>")
1175                  '(0 font-lock-keyword-face))
1176
1177            ;; Handle numbers too.
1178            ;;
1179            ;; The following isn't quite right, but it's close enough.
1180            (list (concat "\\<\\("
1181                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1182                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1183                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1184                          "[lLfFdD]?")
1185                  '(0 mdw-number-face))
1186
1187            ;; And anything else is punctuation.
1188            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1189                  '(0 mdw-punct-face))))))
1190
1191 ;;;--------------------------------------------------------------------------
1192 ;;; C# programming configuration.
1193
1194 ;; Make indentation nice.
1195
1196 (defun mdw-csharp-style ()
1197   (c-add-style "[mdw] C# style"
1198                '((c-basic-offset . 2)
1199                  (c-offsets-alist (substatement-open . 0)
1200                                   (label . 0)
1201                                   (case-label . +)
1202                                   (access-label . 0)
1203                                   (inclass . +)
1204                                   (statement-case-intro . +)))
1205                t))
1206
1207 ;; Declare C# fontification style.
1208
1209 (defun mdw-fontify-csharp ()
1210
1211   ;; Other stuff.
1212   (mdw-csharp-style)
1213   (setq c-hanging-comment-ender-p nil)
1214   (setq c-backslash-column 72)
1215   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1216
1217   ;; Now define things to be fontified.
1218   (make-local-variable 'font-lock-keywords)
1219   (let ((csharp-keywords
1220          (mdw-regexps "abstract" "as" "base" "bool" "break"
1221                       "byte" "case" "catch" "char" "checked"
1222                       "class" "const" "continue" "decimal" "default"
1223                       "delegate" "do" "double" "else" "enum"
1224                       "event" "explicit" "extern" "false" "finally"
1225                       "fixed" "float" "for" "foreach" "goto"
1226                       "if" "implicit" "in" "int" "interface"
1227                       "internal" "is" "lock" "long" "namespace"
1228                       "new" "null" "object" "operator" "out"
1229                       "override" "params" "private" "protected" "public"
1230                       "readonly" "ref" "return" "sbyte" "sealed"
1231                       "short" "sizeof" "stackalloc" "static" "string"
1232                       "struct" "switch" "this" "throw" "true"
1233                       "try" "typeof" "uint" "ulong" "unchecked"
1234                       "unsafe" "ushort" "using" "virtual" "void"
1235                       "volatile" "while" "yield")))
1236
1237     (setq font-lock-keywords
1238           (list
1239
1240            ;; Handle the keywords defined above.
1241            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1242                  '(0 font-lock-keyword-face))
1243
1244            ;; Handle numbers too.
1245            ;;
1246            ;; The following isn't quite right, but it's close enough.
1247            (list (concat "\\<\\("
1248                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1249                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1250                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1251                          "[lLfFdD]?")
1252                  '(0 mdw-number-face))
1253
1254            ;; And anything else is punctuation.
1255            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1256                  '(0 mdw-punct-face))))))
1257
1258 (define-derived-mode csharp-mode java-mode "C#"
1259   "Major mode for editing C# code.")
1260
1261 ;;;--------------------------------------------------------------------------
1262 ;;; Awk programming configuration.
1263
1264 ;; Make Awk indentation nice.
1265
1266 (defun mdw-awk-style ()
1267   (c-add-style "[mdw] Awk style"
1268                '((c-basic-offset . 2)
1269                  (c-offsets-alist (substatement-open . 0)
1270                                   (statement-cont . 0)
1271                                   (statement-case-intro . +)))
1272                t))
1273
1274 ;; Declare Awk fontification style.
1275
1276 (defun mdw-fontify-awk ()
1277
1278   ;; Miscellaneous fiddling.
1279   (mdw-awk-style)
1280   (setq c-backslash-column 72)
1281   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1282
1283   ;; Now define things to be fontified.
1284   (make-local-variable 'font-lock-keywords)
1285   (let ((c-keywords
1286          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1287                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1288                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1289                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1290                       "atan2" "break" "close" "continue" "cos" "delete"
1291                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1292                       "function" "gensub" "getline" "gsub" "if" "in"
1293                       "index" "int" "length" "log" "match" "next" "rand"
1294                       "return" "print" "printf" "sin" "split" "sprintf"
1295                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1296                       "systime" "tolower" "toupper" "while")))
1297
1298     (setq font-lock-keywords
1299           (list
1300
1301            ;; Handle the keywords defined above.
1302            (list (concat "\\<\\(" c-keywords "\\)\\>")
1303                  '(0 font-lock-keyword-face))
1304
1305            ;; Handle numbers too.
1306            ;;
1307            ;; The following isn't quite right, but it's close enough.
1308            (list (concat "\\<\\("
1309                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1310                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1311                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1312                          "[uUlL]*")
1313                  '(0 mdw-number-face))
1314
1315            ;; And anything else is punctuation.
1316            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1317                  '(0 mdw-punct-face))))))
1318
1319 ;;;--------------------------------------------------------------------------
1320 ;;; Perl programming style.
1321
1322 ;; Perl indentation style.
1323
1324 (setq cperl-indent-level 2)
1325 (setq cperl-continued-statement-offset 2)
1326 (setq cperl-continued-brace-offset 0)
1327 (setq cperl-brace-offset -2)
1328 (setq cperl-brace-imaginary-offset 0)
1329 (setq cperl-label-offset 0)
1330
1331 ;; Define perl fontification style.
1332
1333 (defun mdw-fontify-perl ()
1334
1335   ;; Miscellaneous fiddling.
1336   (modify-syntax-entry ?$ "\\")
1337   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1338   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1339
1340   ;; Now define fontification things.
1341   (make-local-variable 'font-lock-keywords)
1342   (let ((perl-keywords
1343          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1344                       "for" "foreach" "ge" "gt" "goto" "if"
1345                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1346                       "package" "redo" "require" "return" "sub"
1347                       "undef" "unless" "until" "use" "while")))
1348
1349     (setq font-lock-keywords
1350           (list
1351
1352            ;; Set up the keywords defined above.
1353            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1354                  '(0 font-lock-keyword-face))
1355
1356            ;; At least numbers are simpler than C.
1357            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1358                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1359                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1360                  '(0 mdw-number-face))
1361
1362            ;; And anything else is punctuation.
1363            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1364                  '(0 mdw-punct-face))))))
1365
1366 (defun perl-number-tests (&optional arg)
1367   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1368 strip numbers instead."
1369   (interactive "P")
1370   (save-excursion
1371     (goto-char (point-min))
1372     (let ((i 0) (fmt (if arg "" " %4d")))
1373       (while (search-forward "#t" nil t)
1374         (delete-region (point) (line-end-position))
1375         (setq i (1+ i))
1376         (insert (format fmt i)))
1377       (goto-char (point-min))
1378       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1379           (replace-match (format "\\1%d" i))))))
1380
1381 ;;;--------------------------------------------------------------------------
1382 ;;; Python programming style.
1383
1384 (defun mdw-fontify-pythonic (keywords)
1385
1386   ;; Miscellaneous fiddling.
1387   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1388
1389   ;; Now define fontification things.
1390   (make-local-variable 'font-lock-keywords)
1391   (setq font-lock-keywords
1392         (list
1393
1394          ;; Set up the keywords defined above.
1395          (list (concat "\\<\\(" keywords "\\)\\>")
1396                '(0 font-lock-keyword-face))
1397
1398          ;; At least numbers are simpler than C.
1399          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1400                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1401                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1402                '(0 mdw-number-face))
1403
1404          ;; And anything else is punctuation.
1405          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1406                '(0 mdw-punct-face)))))
1407
1408 ;; Define Python fontification styles.
1409
1410 (defun mdw-fontify-python ()
1411   (mdw-fontify-pythonic
1412    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1413                 "del" "elif" "else" "except" "exec" "finally" "for"
1414                 "from" "global" "if" "import" "in" "is" "lambda"
1415                 "not" "or" "pass" "print" "raise" "return" "try"
1416                 "while" "with" "yield")))
1417
1418 (defun mdw-fontify-pyrex ()
1419   (mdw-fontify-pythonic
1420    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1421                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1422                 "extern" "finally" "for" "from" "global" "if"
1423                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1424                 "raise" "return" "struct" "try" "while" "with"
1425                 "yield")))
1426
1427 ;;;--------------------------------------------------------------------------
1428 ;;; Icon programming style.
1429
1430 ;; Icon indentation style.
1431
1432 (setq icon-brace-offset 0
1433       icon-continued-brace-offset 0
1434       icon-continued-statement-offset 2
1435       icon-indent-level 2)
1436
1437 ;; Define Icon fontification style.
1438
1439 (defun mdw-fontify-icon ()
1440
1441   ;; Miscellaneous fiddling.
1442   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1443
1444   ;; Now define fontification things.
1445   (make-local-variable 'font-lock-keywords)
1446   (let ((icon-keywords
1447          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1448                       "end" "every" "fail" "global" "if" "initial"
1449                       "invocable" "link" "local" "next" "not" "of"
1450                       "procedure" "record" "repeat" "return" "static"
1451                       "suspend" "then" "to" "until" "while"))
1452         (preprocessor-keywords
1453          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1454                       "include" "line" "undef")))
1455     (setq font-lock-keywords
1456           (list
1457
1458            ;; Set up the keywords defined above.
1459            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1460                  '(0 font-lock-keyword-face))
1461
1462            ;; The things that Icon calls keywords.
1463            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1464
1465            ;; At least numbers are simpler than C.
1466            (list (concat "\\<[0-9]+"
1467                          "\\([rR][0-9a-zA-Z]+\\|"
1468                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1469                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1470                  '(0 mdw-number-face))
1471
1472            ;; Preprocessor.
1473            (list (concat "^[ \t]*$[ \t]*\\<\\("
1474                          preprocessor-keywords
1475                          "\\)\\>")
1476                  '(0 font-lock-keyword-face))
1477
1478            ;; And anything else is punctuation.
1479            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1480                  '(0 mdw-punct-face))))))
1481
1482 ;;;--------------------------------------------------------------------------
1483 ;;; ARM assembler programming configuration.
1484
1485 ;; There doesn't appear to be an Emacs mode for this yet.
1486 ;;
1487 ;; Better do something about that, I suppose.
1488
1489 (defvar arm-assembler-mode-map nil)
1490 (defvar arm-assembler-abbrev-table nil)
1491 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1492
1493 (or arm-assembler-mode-map
1494     (progn
1495       (setq arm-assembler-mode-map (make-sparse-keymap))
1496       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1497       (define-key arm-assembler-mode-map [C-return] 'newline)
1498       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1499
1500 (defun arm-assembler-mode ()
1501   "Major mode for ARM assembler programs"
1502   (interactive)
1503
1504   ;; Do standard major mode things.
1505   (kill-all-local-variables)
1506   (use-local-map arm-assembler-mode-map)
1507   (setq local-abbrev-table arm-assembler-abbrev-table)
1508   (setq major-mode 'arm-assembler-mode)
1509   (setq mode-name "ARM assembler")
1510
1511   ;; Set up syntax table.
1512   (set-syntax-table arm-assembler-mode-syntax-table)
1513   (modify-syntax-entry ?;   ; Nasty hack
1514                        "<" arm-assembler-mode-syntax-table)
1515   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1516   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1517
1518   (make-local-variable 'comment-start)
1519   (setq comment-start ";")
1520   (make-local-variable 'comment-end)
1521   (setq comment-end "")
1522   (make-local-variable 'comment-column)
1523   (setq comment-column 48)
1524   (make-local-variable 'comment-start-skip)
1525   (setq comment-start-skip ";+[ \t]*")
1526
1527   ;; Play with indentation.
1528   (make-local-variable 'indent-line-function)
1529   (setq indent-line-function 'indent-relative-maybe)
1530
1531   ;; Set fill prefix.
1532   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1533
1534   ;; Fiddle with fontification.
1535   (make-local-variable 'font-lock-keywords)
1536   (setq font-lock-keywords
1537         (list
1538
1539          ;; Handle numbers too.
1540          ;;
1541          ;; The following isn't quite right, but it's close enough.
1542          (list (concat "\\("
1543                        "&[0-9a-fA-F]+\\|"
1544                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1545                        "\\)")
1546                '(0 mdw-number-face))
1547
1548          ;; Do something about operators.
1549          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1550                '(1 font-lock-keyword-face)
1551                '(2 font-lock-string-face))
1552          (list ":[a-zA-Z]+:"
1553                '(0 font-lock-keyword-face))
1554
1555          ;; Do menemonics and directives.
1556          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1557                '(1 font-lock-keyword-face))
1558
1559          ;; And anything else is punctuation.
1560          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1561                '(0 mdw-punct-face))))
1562
1563   (run-hooks 'arm-assembler-mode-hook))
1564
1565 ;;;--------------------------------------------------------------------------
1566 ;;; Assembler mode.
1567
1568 (defun mdw-fontify-asm ()
1569   (modify-syntax-entry ?' "\"")
1570   (modify-syntax-entry ?. "w")
1571   (setf fill-prefix nil)
1572   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1573
1574 ;;;--------------------------------------------------------------------------
1575 ;;; TCL configuration.
1576
1577 (defun mdw-fontify-tcl ()
1578   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1579   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1580   (make-local-variable 'font-lock-keywords)
1581   (setq font-lock-keywords
1582         (list
1583          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1584                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1585                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1586                '(0 mdw-number-face))
1587          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1588                '(0 mdw-punct-face)))))
1589
1590 ;;;--------------------------------------------------------------------------
1591 ;;; REXX configuration.
1592
1593 (defun mdw-rexx-electric-* ()
1594   (interactive)
1595   (insert ?*)
1596   (rexx-indent-line))
1597
1598 (defun mdw-rexx-indent-newline-indent ()
1599   (interactive)
1600   (rexx-indent-line)
1601   (if abbrev-mode (expand-abbrev))
1602   (newline-and-indent))
1603
1604 (defun mdw-fontify-rexx ()
1605
1606   ;; Various bits of fiddling.
1607   (setq mdw-auto-indent nil)
1608   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1609   (local-set-key [?*] 'mdw-rexx-electric-*)
1610   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1611           '(?! ?? ?# ?@ ?$))
1612   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1613
1614   ;; Set up keywords and things for fontification.
1615   (make-local-variable 'font-lock-keywords-case-fold-search)
1616   (setq font-lock-keywords-case-fold-search t)
1617
1618   (setq rexx-indent 2)
1619   (setq rexx-end-indent rexx-indent)
1620   (setq rexx-cont-indent rexx-indent)
1621
1622   (make-local-variable 'font-lock-keywords)
1623   (let ((rexx-keywords
1624          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1625                       "else" "end" "engineering" "exit" "expose" "for"
1626                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1627                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1628                       "options" "otherwise" "parse" "procedure" "pull"
1629                       "push" "queue" "return" "say" "select" "signal"
1630                       "scientific" "source" "then" "trace" "to" "until"
1631                       "upper" "value" "var" "version" "when" "while"
1632                       "with"
1633
1634                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1635                       "center" "center" "charin" "charout" "chars"
1636                       "compare" "condition" "copies" "c2d" "c2x"
1637                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1638                       "errortext" "format" "fuzz" "insert" "lastpos"
1639                       "left" "length" "lineout" "lines" "max" "min"
1640                       "overlay" "pos" "queued" "random" "reverse" "right"
1641                       "sign" "sourceline" "space" "stream" "strip"
1642                       "substr" "subword" "symbol" "time" "translate"
1643                       "trunc" "value" "verify" "word" "wordindex"
1644                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1645                       "x2d")))
1646
1647     (setq font-lock-keywords
1648           (list
1649
1650            ;; Set up the keywords defined above.
1651            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1652                  '(0 font-lock-keyword-face))
1653
1654            ;; Fontify all symbols the same way.
1655            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1656                          "[A-Za-z0-9.!?_#@$]+\\)")
1657                  '(0 font-lock-variable-name-face))
1658
1659            ;; And everything else is punctuation.
1660            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1661                  '(0 mdw-punct-face))))))
1662
1663 ;;;--------------------------------------------------------------------------
1664 ;;; Standard ML programming style.
1665
1666 (defun mdw-fontify-sml ()
1667
1668   ;; Make underscore an honorary letter.
1669   (modify-syntax-entry ?' "w")
1670
1671   ;; Set fill prefix.
1672   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1673
1674   ;; Now define fontification things.
1675   (make-local-variable 'font-lock-keywords)
1676   (let ((sml-keywords
1677          (mdw-regexps "abstype" "and" "andalso" "as"
1678                       "case"
1679                       "datatype" "do"
1680                       "else" "end" "eqtype" "exception"
1681                       "fn" "fun" "functor"
1682                       "handle"
1683                       "if" "in" "include" "infix" "infixr"
1684                       "let" "local"
1685                       "nonfix"
1686                       "of" "op" "open" "orelse"
1687                       "raise" "rec"
1688                       "sharing" "sig" "signature" "struct" "structure"
1689                       "then" "type"
1690                       "val"
1691                       "where" "while" "with" "withtype")))
1692
1693     (setq font-lock-keywords
1694           (list
1695
1696            ;; Set up the keywords defined above.
1697            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1698                  '(0 font-lock-keyword-face))
1699
1700            ;; At least numbers are simpler than C.
1701            (list (concat "\\<\\(\\~\\|\\)"
1702                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1703                                    "[wW][0-9]+\\)\\|"
1704                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1705                                          "\\([eE]\\(\\~\\|\\)"
1706                                                 "[0-9]+\\|\\)\\)\\)")
1707                  '(0 mdw-number-face))
1708
1709            ;; And anything else is punctuation.
1710            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1711                  '(0 mdw-punct-face))))))
1712
1713 ;;;--------------------------------------------------------------------------
1714 ;;; Haskell configuration.
1715
1716 (defun mdw-fontify-haskell ()
1717
1718   ;; Fiddle with syntax table to get comments right.
1719   (modify-syntax-entry ?' "\"")
1720   (modify-syntax-entry ?- ". 123")
1721   (modify-syntax-entry ?{ ". 1b")
1722   (modify-syntax-entry ?} ". 4b")
1723   (modify-syntax-entry ?\n ">")
1724
1725   ;; Set fill prefix.
1726   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1727
1728   ;; Fiddle with fontification.
1729   (make-local-variable 'font-lock-keywords)
1730   (let ((haskell-keywords
1731          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1732                       "deriving" "do" "else" "foreign" "hiding" "if"
1733                       "import" "in" "infix" "infixl" "infixr" "instance"
1734                       "let" "module" "newtype" "of" "qualified" "safe"
1735                       "stdcall" "then" "type" "unsafe" "where")))
1736
1737     (setq font-lock-keywords
1738           (list
1739            (list "--.*$"
1740                  '(0 font-lock-comment-face))
1741            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1742                  '(0 font-lock-keyword-face))
1743            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1744                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1745                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1746                  '(0 mdw-number-face))
1747            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1748                  '(0 mdw-punct-face))))))
1749
1750 ;;;--------------------------------------------------------------------------
1751 ;;; Erlang configuration.
1752
1753 (setq erlang-electric-commannds
1754       '(erlang-electric-newline erlang-electric-semicolon))
1755
1756 (defun mdw-fontify-erlang ()
1757
1758   ;; Set fill prefix.
1759   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1760
1761   ;; Fiddle with fontification.
1762   (make-local-variable 'font-lock-keywords)
1763   (let ((erlang-keywords
1764          (mdw-regexps "after" "and" "andalso"
1765                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1766                       "case" "catch" "cond"
1767                       "div" "end" "fun" "if" "let" "not"
1768                       "of" "or" "orelse"
1769                       "query" "receive" "rem" "try" "when" "xor")))
1770
1771     (setq font-lock-keywords
1772           (list
1773            (list "%.*$"
1774                  '(0 font-lock-comment-face))
1775            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1776                  '(0 font-lock-keyword-face))
1777            (list (concat "^-\\sw+\\>")
1778                  '(0 font-lock-keyword-face))
1779            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1780                  '(0 mdw-number-face))
1781            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1782                  '(0 mdw-punct-face))))))
1783
1784 ;;;--------------------------------------------------------------------------
1785 ;;; Texinfo configuration.
1786
1787 (defun mdw-fontify-texinfo ()
1788
1789   ;; Set fill prefix.
1790   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1791
1792   ;; Real fontification things.
1793   (make-local-variable 'font-lock-keywords)
1794   (setq font-lock-keywords
1795         (list
1796
1797          ;; Environment names are keywords.
1798          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1799                '(2 font-lock-keyword-face))
1800
1801          ;; Unmark escaped magic characters.
1802          (list "\\(@\\)\\([@{}]\\)"
1803                '(1 font-lock-keyword-face)
1804                '(2 font-lock-variable-name-face))
1805
1806          ;; Make sure we get comments properly.
1807          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1808                '(0 font-lock-comment-face))
1809
1810          ;; Command names are keywords.
1811          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1812                '(0 font-lock-keyword-face))
1813
1814          ;; Fontify TeX special characters as punctuation.
1815          (list "[{}]+"
1816                '(0 mdw-punct-face)))))
1817
1818 ;;;--------------------------------------------------------------------------
1819 ;;; TeX and LaTeX configuration.
1820
1821 (defun mdw-fontify-tex ()
1822   (setq ispell-parser 'tex)
1823   (turn-on-reftex)
1824
1825   ;; Don't make maths into a string.
1826   (modify-syntax-entry ?$ ".")
1827   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1828   (local-set-key [?$] 'self-insert-command)
1829
1830   ;; Set fill prefix.
1831   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1832
1833   ;; Real fontification things.
1834   (make-local-variable 'font-lock-keywords)
1835   (setq font-lock-keywords
1836         (list
1837
1838          ;; Environment names are keywords.
1839          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1840                        "{\\([^}\n]*\\)}")
1841                '(2 font-lock-keyword-face))
1842
1843          ;; Suspended environment names are keywords too.
1844          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1845                        "{\\([^}\n]*\\)}")
1846                '(3 font-lock-keyword-face))
1847
1848          ;; Command names are keywords.
1849          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1850                '(0 font-lock-keyword-face))
1851
1852          ;; Handle @/.../ for italics.
1853          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1854          ;;       '(1 font-lock-keyword-face)
1855          ;;       '(3 font-lock-keyword-face))
1856
1857          ;; Handle @*...* for boldness.
1858          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1859          ;;       '(1 font-lock-keyword-face)
1860          ;;       '(3 font-lock-keyword-face))
1861
1862          ;; Handle @`...' for literal syntax things.
1863          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1864          ;;       '(1 font-lock-keyword-face)
1865          ;;       '(3 font-lock-keyword-face))
1866
1867          ;; Handle @<...> for nonterminals.
1868          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1869          ;;       '(1 font-lock-keyword-face)
1870          ;;       '(3 font-lock-keyword-face))
1871
1872          ;; Handle other @-commands.
1873          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1874          ;;       '(0 font-lock-keyword-face))
1875
1876          ;; Make sure we get comments properly.
1877          (list "%.*"
1878                '(0 font-lock-comment-face))
1879
1880          ;; Fontify TeX special characters as punctuation.
1881          (list "[$^_{}#&]"
1882                '(0 mdw-punct-face)))))
1883
1884 ;;;--------------------------------------------------------------------------
1885 ;;; SGML hacking.
1886
1887 (defun mdw-sgml-mode ()
1888   (interactive)
1889   (sgml-mode)
1890   (mdw-standard-fill-prefix "")
1891   (make-variable-buffer-local 'sgml-delimiters)
1892   (setq sgml-delimiters
1893         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1894           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1895           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1896           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1897           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1898           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1899           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1900           "NULL" ""))
1901   (setq major-mode 'mdw-sgml-mode)
1902   (setq mode-name "[mdw] SGML")
1903   (run-hooks 'mdw-sgml-mode-hook))
1904
1905 ;;;--------------------------------------------------------------------------
1906 ;;; Shell scripts.
1907
1908 (defun mdw-setup-sh-script-mode ()
1909
1910   ;; Fetch the shell interpreter's name.
1911   (let ((shell-name sh-shell-file))
1912
1913     ;; Try reading the hash-bang line.
1914     (save-excursion
1915       (goto-char (point-min))
1916       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1917           (setq shell-name (match-string 1))))
1918
1919     ;; Now try to set the shell.
1920     ;;
1921     ;; Don't let `sh-set-shell' bugger up my script.
1922     (let ((executable-set-magic #'(lambda (s &rest r) s)))
1923       (sh-set-shell shell-name)))
1924
1925   ;; Now enable my keys and the fontification.
1926   (mdw-misc-mode-config)
1927
1928   ;; Set the indentation level correctly.
1929   (setq sh-indentation 2)
1930   (setq sh-basic-offset 2))
1931
1932 ;;;--------------------------------------------------------------------------
1933 ;;; Messages-file mode.
1934
1935 (defun messages-mode-guts ()
1936   (setq messages-mode-syntax-table (make-syntax-table))
1937   (set-syntax-table messages-mode-syntax-table)
1938   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1939   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1940   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1941   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1942   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1943   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1944   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1945   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1946   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1947   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1948   (make-local-variable 'comment-start)
1949   (make-local-variable 'comment-end)
1950   (make-local-variable 'indent-line-function)
1951   (setq indent-line-function 'indent-relative)
1952   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1953   (make-local-variable 'font-lock-defaults)
1954   (make-local-variable 'messages-mode-keywords)
1955   (let ((keywords
1956          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1957                       "export" "enum" "fixed-octetstring" "flags"
1958                       "harmless" "map" "nested" "optional"
1959                       "optional-tagged" "package" "primitive"
1960                       "primitive-nullfree" "relaxed[ \t]+enum"
1961                       "set" "table" "tagged-optional"   "union"
1962                       "variadic" "vector" "version" "version-tag")))
1963     (setq messages-mode-keywords
1964           (list
1965            (list (concat "\\<\\(" keywords "\\)\\>:")
1966                  '(0 font-lock-keyword-face))
1967            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1968            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1969              (0 font-lock-variable-name-face))
1970            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1971            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1972              (0 mdw-punct-face)))))
1973   (setq font-lock-defaults
1974         '(messages-mode-keywords nil nil nil nil))
1975   (run-hooks 'messages-file-hook))
1976
1977 (defun messages-mode ()
1978   (interactive)
1979   (fundamental-mode)
1980   (setq major-mode 'messages-mode)
1981   (setq mode-name "Messages")
1982   (messages-mode-guts)
1983   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1984   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1985   (setq comment-start "# ")
1986   (setq comment-end "")
1987   (turn-on-font-lock-if-enabled)
1988   (run-hooks 'messages-mode-hook))
1989
1990 (defun cpp-messages-mode ()
1991   (interactive)
1992   (fundamental-mode)
1993   (setq major-mode 'cpp-messages-mode)
1994   (setq mode-name "CPP Messages")
1995   (messages-mode-guts)
1996   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1997   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1998   (setq comment-start "/* ")
1999   (setq comment-end " */")
2000   (let ((preprocessor-keywords
2001          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2002                       "ident" "if" "ifdef" "ifndef" "import" "include"
2003                       "line" "pragma" "unassert" "undef" "warning")))
2004     (setq messages-mode-keywords
2005           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2006                                       "\\(include\\|import\\)"
2007                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2008                               '(2 font-lock-string-face))
2009                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2010                                       preprocessor-keywords
2011                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2012                               '(1 font-lock-keyword-face)))
2013                   messages-mode-keywords)))
2014   (turn-on-font-lock-if-enabled)
2015   (run-hooks 'cpp-messages-mode-hook))
2016
2017 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2018 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2019 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2020
2021 ;;;--------------------------------------------------------------------------
2022 ;;; Messages-file mode.
2023
2024 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2025   "Face to use for subsittution directives.")
2026 (make-face 'mallow-driver-substitution-face)
2027 (defvar mallow-driver-text-face 'mallow-driver-text-face
2028   "Face to use for body text.")
2029 (make-face 'mallow-driver-text-face)
2030
2031 (defun mallow-driver-mode ()
2032   (interactive)
2033   (fundamental-mode)
2034   (setq major-mode 'mallow-driver-mode)
2035   (setq mode-name "Mallow driver")
2036   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2037   (set-syntax-table mallow-driver-mode-syntax-table)
2038   (make-local-variable 'comment-start)
2039   (make-local-variable 'comment-end)
2040   (make-local-variable 'indent-line-function)
2041   (setq indent-line-function 'indent-relative)
2042   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2043   (make-local-variable 'font-lock-defaults)
2044   (make-local-variable 'mallow-driver-mode-keywords)
2045   (let ((keywords
2046          (mdw-regexps "each" "divert" "file" "if"
2047                       "perl" "set" "string" "type" "write")))
2048     (setq mallow-driver-mode-keywords
2049           (list
2050            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2051                  '(0 font-lock-keyword-face))
2052            (list "^%\\s *\\(#.*\\|\\)$"
2053                  '(0 font-lock-comment-face))
2054            (list "^%"
2055                  '(0 font-lock-keyword-face))
2056            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2057            (list "\\${[^}]*}"
2058                  '(0 mallow-driver-substitution-face t)))))
2059   (setq font-lock-defaults
2060         '(mallow-driver-mode-keywords nil nil nil nil))
2061   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2062   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2063   (setq comment-start "%# ")
2064   (setq comment-end "")
2065   (turn-on-font-lock-if-enabled)
2066   (run-hooks 'mallow-driver-mode-hook))
2067
2068 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2069
2070 ;;;--------------------------------------------------------------------------
2071 ;;; NFast debugs.
2072
2073 (defun nfast-debug-mode ()
2074   (interactive)
2075   (fundamental-mode)
2076   (setq major-mode 'nfast-debug-mode)
2077   (setq mode-name "NFast debug")
2078   (setq messages-mode-syntax-table (make-syntax-table))
2079   (set-syntax-table messages-mode-syntax-table)
2080   (make-local-variable 'font-lock-defaults)
2081   (make-local-variable 'nfast-debug-mode-keywords)
2082   (setq truncate-lines t)
2083   (setq nfast-debug-mode-keywords
2084         (list
2085          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2086            (0 font-lock-keyword-face))
2087          (list (concat "^[ \t]+\\(\\("
2088                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2089                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2090                        "[ \t]+\\)*"
2091                        "[0-9a-fA-F]+\\)[ \t]*$")
2092            '(0 mdw-number-face))
2093          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2094            (1 font-lock-keyword-face))
2095          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2096            (1 font-lock-warning-face))
2097          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2098            (1 nil))
2099          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2100                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2101            '(1 font-lock-keyword-face))
2102          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2103          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2104          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2105          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2106   (setq font-lock-defaults
2107         '(nfast-debug-mode-keywords nil nil nil nil))
2108   (turn-on-font-lock-if-enabled)
2109   (run-hooks 'nfast-debug-mode-hook))
2110
2111 ;;;--------------------------------------------------------------------------
2112 ;;; Other languages.
2113
2114 ;; Smalltalk.
2115
2116 (defun mdw-setup-smalltalk ()
2117   (and mdw-auto-indent
2118        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2119   (make-variable-buffer-local 'mdw-auto-indent)
2120   (setq mdw-auto-indent nil)
2121   (local-set-key "\C-i" 'smalltalk-reindent))
2122
2123 (defun mdw-fontify-smalltalk ()
2124   (make-local-variable 'font-lock-keywords)
2125   (setq font-lock-keywords
2126         (list
2127          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2128                '(0 font-lock-keyword-face))
2129          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2130                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2131                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2132                '(0 mdw-number-face))
2133          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2134                '(0 mdw-punct-face)))))
2135
2136 ;; Lispy languages.
2137
2138 ;; Unpleasant bodge.
2139 (unless (boundp 'slime-repl-mode-map)
2140   (setq slime-repl-mode-map (make-sparse-keymap)))
2141
2142 (defun mdw-indent-newline-and-indent ()
2143   (interactive)
2144   (indent-for-tab-command)
2145   (newline-and-indent))
2146
2147 (eval-after-load "cl-indent"
2148   '(progn
2149      (mapc #'(lambda (pair)
2150                (put (car pair)
2151                     'common-lisp-indent-function
2152                     (cdr pair)))
2153       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2154         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2155
2156 (defun mdw-common-lisp-indent ()
2157   (make-variable-buffer-local 'lisp-indent-function)
2158   (setq lisp-indent-function 'common-lisp-indent-function))
2159
2160 (setq lisp-simple-loop-indentation 2
2161       lisp-loop-keyword-indentation 6
2162       lisp-loop-forms-indentation 6)
2163
2164 (defun mdw-fontify-lispy ()
2165
2166   ;; Set fill prefix.
2167   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2168
2169   ;; Not much fontification needed.
2170   (make-local-variable 'font-lock-keywords)
2171   (setq font-lock-keywords
2172         (list
2173          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2174                '(0 mdw-punct-face)))))
2175
2176 (defun comint-send-and-indent ()
2177   (interactive)
2178   (comint-send-input)
2179   (and mdw-auto-indent
2180        (indent-for-tab-command)))
2181
2182 (defun mdw-setup-m4 ()
2183   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2184
2185 ;;;--------------------------------------------------------------------------
2186 ;;; Text mode.
2187
2188 (defun mdw-text-mode ()
2189   (setq fill-column 72)
2190   (flyspell-mode t)
2191   (mdw-standard-fill-prefix
2192    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2193   (auto-fill-mode 1))
2194
2195 ;;;--------------------------------------------------------------------------
2196 ;;; Outline and hide/show modes.
2197
2198 (defun mdw-outline-collapse-all ()
2199   "Completely collapse everything in the entire buffer."
2200   (interactive)
2201   (save-excursion
2202     (goto-char (point-min))
2203     (while (< (point) (point-max))
2204       (hide-subtree)
2205       (forward-line))))
2206
2207 (setq hs-hide-comments-when-hiding-all nil)
2208
2209 ;;;--------------------------------------------------------------------------
2210 ;;; Shell mode.
2211
2212 (defun mdw-sh-mode-setup ()
2213   (local-set-key [?\C-a] 'comint-bol)
2214   (add-hook 'comint-output-filter-functions
2215             'comint-watch-for-password-prompt))
2216
2217 (defun mdw-term-mode-setup ()
2218   (setq term-prompt-regexp shell-prompt-pattern)
2219   (make-local-variable 'mouse-yank-at-point)
2220   (make-local-variable 'transient-mark-mode)
2221   (setq mouse-yank-at-point t)
2222   (auto-fill-mode -1)
2223   (setq tab-width 8))
2224
2225 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2226 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2227 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2228 (defun term-send-meta-meta-something ()
2229   (interactive)
2230   (term-send-raw-string "\e\e")
2231   (term-send-raw))
2232 (eval-after-load 'term
2233   '(progn
2234      (define-key term-raw-map [?\e ?\e] nil)
2235      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2236      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2237      (define-key term-raw-map [M-right] 'term-send-meta-right)
2238      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2239      (define-key term-raw-map [M-left] 'term-send-meta-left)
2240      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2241
2242 ;;;----- That's all, folks --------------------------------------------------
2243
2244 (provide 'dot-emacs)