chiark - git - mdw - profile/blob - el/dot-emacs.el

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; Functions and macros for .emacs
   4 ;;;
   5 ;;; (c) 2004 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defvar mdw-fast-startup nil
  28   "Whether .emacs should optimize for rapid startup.
  29 This may be at the expense of cool features.")
  30 (let ((probe nil) (next command-line-args))
  31   (while next
  32     (cond ((string= (car next) "--mdw-fast-startup")
  33            (setq mdw-fast-startup t)
  34            (if probe
  35                (rplacd probe (cdr next))
  36              (setq command-line-args (cdr next))))
  37           (t
  38            (setq probe next)))
  39     (setq next (cdr next))))
  40
  41 ;;;--------------------------------------------------------------------------
  42 ;;; Some general utilities.
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   (declare (indent nil)
  52            (debug 0))
  53   `',(make-regexp list))
  54
  55 ;; 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 (defun mdw-do-uniquify (done end l rest)
 353   "A helper function for mdw-uniquify-alist.
 354 The DONE argument is a list whose first element is `nil'.  It
 355 contains the uniquified alist built so far.  The leading `nil' is
 356 stripped off at the end of the operation; it's only there so that
 357 DONE always references a cons cell.  END refers to the final cons
 358 cell in the DONE list; it is modified in place each time to avoid
 359 the overheads of `append'ing all the time.  The L argument is the
 360 alist we're currently processing; the remaining alists are given
 361 in REST."
 362
 363   ;; There are several different cases to deal with here.
 364   (cond
 365
 366    ;; Current list isn't empty.  Add the first item to the DONE list if
 367    ;; there's not an item with the same KEY already there.
 368    (l (or (assoc (car (car l)) done)
 369           (progn
 370             (setcdr end (cons (car l) nil))
 371             (setq end (cdr end))))
 372       (mdw-do-uniquify done end (cdr l) rest))
 373
 374    ;; The list we were working on is empty.  Shunt the next list into the
 375    ;; current list position and go round again.
 376    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 377
 378    ;; Everything's done.  Remove the leading `nil' from the DONE list and
 379    ;; return it.  Finished!
 380    (t (cdr done))))
 381
 382 (defun date ()
 383   "Insert the current date in a pleasing way."
 384   (interactive)
 385   (insert (save-excursion
 386             (let ((buffer (get-buffer-create "*tmp*")))
 387               (unwind-protect (progn (set-buffer buffer)
 388                                      (erase-buffer)
 389                                      (shell-command "date +%Y-%m-%d" t)
 390                                      (goto-char (mark))
 391                                      (delete-backward-char 1)
 392                                      (buffer-string))
 393                 (kill-buffer buffer))))))
 394
 395 (defun uuencode (file &optional name)
 396   "UUencodes a file, maybe calling it NAME, into the current buffer."
 397   (interactive "fInput file name: ")
 398
 399   ;; If NAME isn't specified, then guess from the filename.
 400   (if (not name)
 401       (setq name
 402             (substring file
 403                        (or (string-match "[^/]*$" file) 0))))
 404   (print (format "uuencode `%s' `%s'" file name))
 405
 406   ;; Now actually do the thing.
 407   (call-process "uuencode" file t nil name))
 408
 409 (defvar np-file "~/.np"
 410   "*Where the `now-playing' file is.")
 411
 412 (defun np (&optional arg)
 413   "Grabs a `now-playing' string."
 414   (interactive)
 415   (save-excursion
 416     (or arg (progn
 417               (goto-char (point-max))
 418               (insert "\nNP: ")
 419               (insert-file-contents np-file)))))
 420
 421 (defun mdw-check-autorevert ()
 422   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
 423 This takes into consideration whether it's been found using
 424 tramp, which seems to get itself into a twist."
 425   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 426          nil)
 427         ((and (buffer-file-name)
 428               (fboundp 'tramp-tramp-file-p)
 429               (tramp-tramp-file-p (buffer-file-name)))
 430          (unless global-auto-revert-ignore-buffer
 431            (setq global-auto-revert-ignore-buffer 'tramp)))
 432         ((eq global-auto-revert-ignore-buffer 'tramp)
 433          (setq global-auto-revert-ignore-buffer nil))))
 434
 435 (defadvice find-file (after mdw-autorevert activate)
 436   (mdw-check-autorevert))
 437 (defadvice write-file (after mdw-autorevert activate)
 438   (mdw-check-autorevert))
 439
 440 ;;;--------------------------------------------------------------------------
 441 ;;; Dired hacking.
 442
 443 (defadvice dired-maybe-insert-subdir
 444     (around mdw-marked-insertion first activate)
 445   "The DIRNAME may be a list of directory names to insert.
 446 Interactively, if files are marked, then insert all of them.
 447 With a numeric prefix argument, select that many entries near
 448 point; with a non-numeric prefix argument, prompt for listing
 449 options."
 450   (interactive
 451    (list (dired-get-marked-files nil
 452                                  (and (integerp current-prefix-arg)
 453                                       current-prefix-arg)
 454                                  #'file-directory-p)
 455          (and current-prefix-arg
 456               (not (integerp current-prefix-arg))
 457               (read-string "Switches for listing: "
 458                            (or dired-subdir-switches
 459                                dired-actual-switches)))))
 460   (let ((dirs (ad-get-arg 0)))
 461     (dolist (dir (if (listp dirs) dirs (list dirs)))
 462       (ad-set-arg 0 dir)
 463       ad-do-it)))
 464
 465 ;;;--------------------------------------------------------------------------
 466 ;;; URL viewing.
 467
 468 (defun mdw-w3m-browse-url (url &optional new-session-p)
 469   "Invoke w3m on the URL in its current window, or at least a different one.
 470 If NEW-SESSION-P, start a new session."
 471   (interactive "sURL: \nP")
 472   (save-excursion
 473     (let ((window (selected-window)))
 474       (unwind-protect
 475           (progn
 476             (select-window (or (and (not new-session-p)
 477                                     (get-buffer-window "*w3m*"))
 478                                (progn
 479                                  (if (one-window-p t) (split-window))
 480                                  (get-lru-window))))
 481             (w3m-browse-url url new-session-p))
 482         (select-window window)))))
 483
 484 (defvar mdw-good-url-browsers
 485   '((w3m . mdw-w3m-browse-url)
 486     browse-url-w3
 487     browse-url-mozilla)
 488   "List of good browsers for mdw-good-url-browsers.
 489 Each item is a browser function name, or a cons (CHECK . FUNC).
 490 A symbol FOO stands for (FOO . FOO).")
 491
 492 (defun mdw-good-url-browser ()
 493   "Return a good URL browser.
 494 Trundle the list of such things, finding the first item for which
 495 CHECK is fboundp, and returning the correponding FUNC."
 496   (let ((bs mdw-good-url-browsers) b check func answer)
 497     (while (and bs (not answer))
 498       (setq b (car bs)
 499             bs (cdr bs))
 500       (if (consp b)
 501           (setq check (car b) func (cdr b))
 502         (setq check b func b))
 503       (if (fboundp check)
 504           (setq answer func)))
 505     answer))
 506
 507 (eval-after-load "w3m-search"
 508   '(progn
 509      (dolist
 510          (item
 511           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
 512             ("gd" "Google Directory"
 513              "http://www.google.com/search?cat=gwd/Top&q=%s")
 514             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
 515             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
 516             ("gi" "Images" "http://images.google.com/images?q=%s")
 517             ("rfc" "RFC"
 518              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
 519             ("wp" "Wikipedia"
 520              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
 521             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
 522             ("nc-wiki" "nCipher wiki"
 523              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
 524             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
 525             ("lp" "Launchpad bug by number"
 526              "https://bugs.launchpad.net/bugs/%s")
 527             ("lppkg" "Launchpad bugs by package"
 528              "https://bugs.launchpad.net/%s")
 529             ("msdn" "MSDN"
 530              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
 531             ("debbug" "Debian bug by number"
 532              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
 533             ("debbugpkg" "Debian bugs by package"
 534              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
 535             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
 536        (add-to-list 'w3m-search-engine-alist
 537                     (list (cadr item) (caddr item) nil))
 538        (add-to-list 'w3m-uri-replace-alist
 539                     (list (concat "\\`" (car item) ":")
 540                           'w3m-search-uri-replace
 541                           (cadr item))))))
 542
 543 ;;;--------------------------------------------------------------------------
 544 ;;; Paragraph filling.
 545
 546 ;; Useful variables.
 547
 548 (defvar mdw-fill-prefix nil
 549   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
 550 If there's no fill prefix currently set (by the `fill-prefix'
 551 variable) and there's a match from one of the regexps here, it
 552 gets used to set the fill-prefix for the current operation.
 553
 554 The variable is a list of items of the form `REGEXP . PREFIX'; if
 555 the REGEXP matches, the PREFIX is used to set the fill prefix.
 556 It in turn is a list of things:
 557
 558   STRING -- insert a literal string
 559   (match . N) -- insert the thing matched by bracketed subexpression N
 560   (pad . N) -- a string of whitespace the same width as subexpression N
 561   (expr . FORM) -- the result of evaluating FORM")
 562
 563 (make-variable-buffer-local 'mdw-fill-prefix)
 564
 565 (defvar mdw-hanging-indents
 566   (concat "\\(\\("
 567             "\\([*o]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
 568             "[ \t]+"
 569           "\\)?\\)")
 570   "*Standard regexp matching parts of a hanging indent.
 571 This is mainly useful in `auto-fill-mode'.")
 572
 573 ;; Setting things up.
 574
 575 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 576
 577 ;; Utility functions.
 578
 579 (defun mdw-tabify (s)
 580   "Tabify the string S.  This is a horrid hack."
 581   (save-excursion
 582     (save-match-data
 583       (let (start end)
 584         (beginning-of-line)
 585         (setq start (point-marker))
 586         (insert s "\n")
 587         (setq end (point-marker))
 588         (tabify start end)
 589         (setq s (buffer-substring start (1- end)))
 590         (delete-region start end)
 591         (set-marker start nil)
 592         (set-marker end nil)
 593         s))))
 594
 595 (defun mdw-examine-fill-prefixes (l)
 596   "Given a list of dynamic fill prefixes, pick one which matches
 597 context and return the static fill prefix to use.  Point must be
 598 at the start of a line, and match data must be saved."
 599   (cond ((not l) nil)
 600                ((looking-at (car (car l)))
 601                 (mdw-tabify (apply (function concat)
 602                                    (mapcar (function mdw-do-prefix-match)
 603                                            (cdr (car l))))))
 604                (t (mdw-examine-fill-prefixes (cdr l)))))
 605
 606 (defun mdw-maybe-car (p)
 607   "If P is a pair, return (car P), otherwise just return P."
 608   (if (consp p) (car p) p))
 609
 610 (defun mdw-padding (s)
 611   "Return a string the same width as S but made entirely from whitespace."
 612   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 613     (while (< i l)
 614       (if (= 9 (aref s i))
 615           (aset n i 9))
 616       (setq i (1+ i)))
 617     n))
 618
 619 (defun mdw-do-prefix-match (m)
 620   "Expand a dynamic prefix match element.
 621 See `mdw-fill-prefix' for details."
 622   (cond ((not (consp m)) (format "%s" m))
 623            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 624            ((eq (car m) 'pad) (mdw-padding (match-string
 625                                             (mdw-maybe-car (cdr m)))))
 626            ((eq (car m) 'eval) (eval (cdr m)))
 627            (t "")))
 628
 629 (defun mdw-choose-dynamic-fill-prefix ()
 630   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 631   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 632            ((not mdw-fill-prefix) fill-prefix)
 633            (t (save-excursion
 634                 (beginning-of-line)
 635                 (save-match-data
 636                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 637
 638 (defun do-auto-fill ()
 639   "Handle auto-filling, working out a dynamic fill prefix in the
 640 case where there isn't a sensible static one."
 641   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 642     (mdw-do-auto-fill)))
 643
 644 (defun mdw-fill-paragraph ()
 645   "Fill paragraph, getting a dynamic fill prefix."
 646   (interactive)
 647   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 648     (fill-paragraph nil)))
 649
 650 (defun mdw-standard-fill-prefix (rx &optional mat)
 651   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 652 This is just a short-cut for setting the thing by hand, and by
 653 design it doesn't cope with anything approximating a complicated
 654 case."
 655   (setq mdw-fill-prefix
 656            `((,(concat rx mdw-hanging-indents)
 657               (match . 1)
 658               (pad . ,(or mat 2))))))
 659
 660 ;;;--------------------------------------------------------------------------
 661 ;;; Other common declarations.
 662
 663 ;; Common mode settings.
 664
 665 (defvar mdw-auto-indent t
 666   "Whether to indent automatically after a newline.")
 667
 668 (defun mdw-misc-mode-config ()
 669   (and mdw-auto-indent
 670        (cond ((eq major-mode 'lisp-mode)
 671               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 672              ((or (eq major-mode 'slime-repl-mode)
 673                   (eq major-mode 'asm-mode))
 674               nil)
 675              (t
 676               (local-set-key "\C-m" 'newline-and-indent))))
 677   (local-set-key [C-return] 'newline)
 678   (make-variable-buffer-local 'page-delimiter)
 679   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 680   (setq comment-column 40)
 681   (auto-fill-mode 1)
 682   (setq fill-column 77)
 683   (setq show-trailing-whitespace t)
 684   (let ((whitespace-style (remove 'trailing whitespace-style)))
 685     (trap (whitespace-mode t)))
 686   (and (fboundp 'gtags-mode)
 687        (gtags-mode))
 688   (outline-minor-mode t)
 689   (hs-minor-mode t)
 690   (reveal-mode t)
 691   (trap (turn-on-font-lock)))
 692
 693 (defun mdw-post-config-mode-hack ()
 694   (let ((whitespace-style (remove 'trailing whitespace-style)))
 695     (trap (whitespace-mode t))))
 696
 697 (eval-after-load 'gtags
 698   '(progn
 699      (dolist (key '([mouse-2] [mouse-3]))
 700        (define-key gtags-mode-map key nil))
 701      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 702      (define-key gtags-select-mode-map [C-S-mouse-2]
 703        'gtags-select-tag-by-event)
 704      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 705        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 706
 707 ;; Backup file handling.
 708
 709 (defvar mdw-backup-disable-regexps nil
 710   "*List of regular expressions: if a file name matches any of
 711 these then the file is not backed up.")
 712
 713 (defun mdw-backup-enable-predicate (name)
 714   "[mdw]'s default backup predicate.
 715 Allows a backup if the standard predicate would allow it, and it
 716 doesn't match any of the regular expressions in
 717 `mdw-backup-disable-regexps'."
 718   (and (normal-backup-enable-predicate name)
 719        (let ((answer t) (list mdw-backup-disable-regexps))
 720          (save-match-data
 721            (while list
 722              (if (string-match (car list) name)
 723                  (setq answer nil))
 724              (setq list (cdr list)))
 725            answer))))
 726 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 727
 728 ;; Frame cleanup.
 729
 730 (defun mdw-last-one-out-turn-off-the-lights (frame)
 731   "Disconnect from an X display if this was the last frame on that display."
 732   (let ((frame-display (frame-parameter frame 'display)))
 733     (when (and frame-display
 734                (eq window-system 'x)
 735                (not (some (lambda (fr)
 736                             (message "checking frame %s" frame)
 737                             (and (not (eq fr frame))
 738                                  (string= (frame-parameter fr 'display)
 739                                           frame-display)
 740                                  (progn "frame %s still uses us" nil)))
 741                           (frame-list))))
 742       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 743 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 744
 745 (defvar mdw-frame-parameters-alist
 746   '((nil (menu-bar-lines . 0))))
 747 (defun mdw-set-frame-parameters (frame)
 748   (let ((params (assq (if (fboundp 'window-system)
 749                           (window-system frame)
 750                         window-system)
 751                       mdw-frame-parameters-alist)))
 752     (when params
 753       (modify-frame-parameters frame (cdr params)))))
 754 (add-hook 'after-make-frame-functions 'mdw-set-frame-parameters)
 755
 756 ;;;--------------------------------------------------------------------------
 757 ;;; General fontification.
 758
 759 (defmacro mdw-define-face (name &rest body)
 760   "Define a face, and make sure it's actually set as the definition."
 761   (declare (indent 1)
 762            (debug 0))
 763   `(progn
 764      (make-face ',name)
 765      (defvar ,name ',name)
 766      (put ',name 'face-defface-spec ',body)
 767      (face-spec-set ',name ',body nil)))
 768
 769 (mdw-define-face default
 770   (((type w32)) :family "courier new" :height 85)
 771   (((type x)) :family "6x13" :height 130)
 772   (((type color)) :foreground "white" :background "black")
 773   (t nil))
 774 (mdw-define-face fixed-pitch
 775   (((type w32)) :family "courier new" :height 85)
 776   (((type x)) :family "6x13" :height 130)
 777   (t :foreground "white" :background "black"))
 778 (if (>= emacs-major-version 23)
 779     (mdw-define-face variable-pitch
 780       (((type x)) :family "sans" :height 100))
 781   (mdw-define-face variable-pitch
 782     (((type x)) :family "helvetica" :height 120)))
 783 (mdw-define-face region
 784   (((type tty) (class color)) :background "blue")
 785   (((type tty) (class mono)) :inverse-video t)
 786   (t :background "grey30"))
 787 (mdw-define-face minibuffer-prompt
 788   (t :weight bold))
 789 (mdw-define-face mode-line
 790   (((class color)) :foreground "blue" :background "yellow"
 791                    :box (:line-width 1 :style released-button))
 792   (t :inverse-video t))
 793 (mdw-define-face mode-line-inactive
 794   (((class color)) :foreground "yellow" :background "blue"
 795                    :box (:line-width 1 :style released-button))
 796   (t :inverse-video t))
 797 (mdw-define-face scroll-bar
 798   (t :foreground "black" :background "lightgrey"))
 799 (mdw-define-face fringe
 800   (t :foreground "yellow"))
 801 (mdw-define-face show-paren-match
 802   (((class color)) :background "darkgreen")
 803   (t :underline t))
 804 (mdw-define-face show-paren-mismatch
 805   (((class color)) :background "red")
 806   (t :inverse-video t))
 807 (mdw-define-face highlight
 808   (((class color)) :background "DarkSeaGreen4")
 809   (t :inverse-video t))
 810
 811 (mdw-define-face holiday-face
 812   (t :background "red"))
 813 (mdw-define-face calendar-today-face
 814   (t :foreground "yellow" :weight bold))
 815
 816 (mdw-define-face comint-highlight-prompt
 817   (t :weight bold))
 818 (mdw-define-face comint-highlight-input)
 819
 820 (mdw-define-face trailing-whitespace
 821   (((class color)) :background "red")
 822   (t :inverse-video t))
 823 (mdw-define-face mdw-punct-face
 824   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 825 (mdw-define-face mdw-number-face
 826   (t :foreground "yellow"))
 827 (mdw-define-face font-lock-function-name-face
 828   (t :slant italic))
 829 (mdw-define-face font-lock-keyword-face
 830   (t :weight bold))
 831 (mdw-define-face font-lock-constant-face
 832   (t :slant italic))
 833 (mdw-define-face font-lock-builtin-face
 834   (t :weight bold))
 835 (mdw-define-face font-lock-type-face
 836   (t :weight bold :slant italic))
 837 (mdw-define-face font-lock-reference-face
 838   (t :weight bold))
 839 (mdw-define-face font-lock-variable-name-face
 840   (t :slant italic))
 841 (mdw-define-face font-lock-comment-delimiter-face
 842   (((class mono)) :weight bold)
 843   (((type tty) (class color)) :foreground "green")
 844   (t :slant italic :foreground "SeaGreen1"))
 845 (mdw-define-face font-lock-comment-face
 846   (((class mono)) :weight bold)
 847   (((type tty) (class color)) :foreground "green")
 848   (t :slant italic :foreground "SeaGreen1"))
 849 (mdw-define-face font-lock-string-face
 850   (((class mono)) :weight bold)
 851   (((class color)) :foreground "SkyBlue1"))
 852 (mdw-define-face message-separator
 853   (t :background "red" :foreground "white" :weight bold))
 854 (mdw-define-face message-cited-text
 855   (default :slant italic)
 856   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 857 (mdw-define-face message-header-cc
 858   (default :weight bold)
 859   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 860 (mdw-define-face message-header-newsgroups
 861   (default :weight bold)
 862   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 863 (mdw-define-face message-header-subject
 864   (default :weight bold)
 865   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 866 (mdw-define-face message-header-to
 867   (default :weight bold)
 868   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 869 (mdw-define-face message-header-xheader
 870   (default :weight bold)
 871   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 872 (mdw-define-face message-header-other
 873   (default :weight bold)
 874   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 875 (mdw-define-face message-header-name
 876   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 877
 878 (mdw-define-face diff-index
 879   (t :weight bold))
 880 (mdw-define-face diff-file-header
 881   (t :weight bold))
 882 (mdw-define-face diff-hunk-header
 883   (t :foreground "SkyBlue1"))
 884 (mdw-define-face diff-function
 885   (t :foreground "SkyBlue1" :weight bold))
 886 (mdw-define-face diff-header
 887   (t :background "grey10"))
 888 (mdw-define-face diff-added
 889   (t :foreground "green"))
 890 (mdw-define-face diff-removed
 891   (t :foreground "red"))
 892 (mdw-define-face diff-context)
 893
 894 (mdw-define-face erc-input-face
 895   (t :foreground "red"))
 896
 897 (mdw-define-face woman-bold
 898   (t :weight bold))
 899 (mdw-define-face woman-italic
 900   (t :slant italic))
 901
 902 (mdw-define-face p4-depot-added-face
 903   (t :foreground "green"))
 904 (mdw-define-face p4-depot-branch-op-face
 905   (t :foreground "yellow"))
 906 (mdw-define-face p4-depot-deleted-face
 907   (t :foreground "red"))
 908 (mdw-define-face p4-depot-unmapped-face
 909   (t :foreground "SkyBlue1"))
 910 (mdw-define-face p4-diff-change-face
 911   (t :foreground "yellow"))
 912 (mdw-define-face p4-diff-del-face
 913   (t :foreground "red"))
 914 (mdw-define-face p4-diff-file-face
 915   (t :foreground "SkyBlue1"))
 916 (mdw-define-face p4-diff-head-face
 917   (t :background "grey10"))
 918 (mdw-define-face p4-diff-ins-face
 919   (t :foreground "green"))
 920
 921 (mdw-define-face whizzy-slice-face
 922   (t :background "grey10"))
 923 (mdw-define-face whizzy-error-face
 924   (t :background "darkred"))
 925
 926 ;;;--------------------------------------------------------------------------
 927 ;;; C programming configuration.
 928
 929 ;; Linux kernel hacking.
 930
 931 (defvar linux-c-mode-hook)
 932
 933 (defun linux-c-mode ()
 934   (interactive)
 935   (c-mode)
 936   (setq major-mode 'linux-c-mode)
 937   (setq mode-name "Linux C")
 938   (run-hooks 'linux-c-mode-hook))
 939
 940 ;; Make C indentation nice.
 941
 942 (defun mdw-c-lineup-arglist (langelem)
 943   "Hack for DWIMmery in c-lineup-arglist."
 944   (if (save-excursion
 945         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
 946       0
 947     (c-lineup-arglist langelem)))
 948
 949 (defun mdw-c-indent-extern-mumble (langelem)
 950   "Indent `extern \"...\" {' lines."
 951   (save-excursion
 952     (back-to-indentation)
 953     (if (looking-at
 954          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
 955         c-basic-offset
 956       nil)))
 957
 958 (defun mdw-c-style ()
 959   (c-add-style "[mdw] C and C++ style"
 960                '((c-basic-offset . 2)
 961                  (comment-column . 40)
 962                  (c-class-key . "class")
 963                  (c-backslash-column . 72)
 964                  (c-offsets-alist
 965                   (substatement-open . (add 0 c-indent-one-line-block))
 966                   (defun-open . (add 0 c-indent-one-line-block))
 967                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
 968                   (topmost-intro . mdw-c-indent-extern-mumble)
 969                   (cpp-define-intro . 0)
 970                   (inextern-lang . [0])
 971                   (label . 0)
 972                   (case-label . +)
 973                   (access-label . -)
 974                   (inclass . +)
 975                   (inline-open . ++)
 976                   (statement-cont . 0)
 977                   (statement-case-intro . +)))
 978                t))
 979
 980 (defvar mdw-c-comment-fill-prefix
 981   `((,(concat "\\([ \t]*/?\\)"
 982               "\\(\*\\|//]\\)"
 983               "\\([ \t]*\\)"
 984               "\\([A-Za-z]+:[ \t]*\\)?"
 985               mdw-hanging-indents)
 986      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
 987   "Fill prefix matching C comments (both kinds).")
 988
 989 (defun mdw-fontify-c-and-c++ ()
 990
 991   ;; Fiddle with some syntax codes.
 992   (modify-syntax-entry ?* ". 23")
 993   (modify-syntax-entry ?/ ". 124b")
 994   (modify-syntax-entry ?\n "> b")
 995
 996   ;; Other stuff.
 997   (mdw-c-style)
 998   (setq c-hanging-comment-ender-p nil)
 999   (setq c-backslash-column 72)
1000   (setq c-label-minimum-indentation 0)
1001   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1002
1003   ;; Now define things to be fontified.
1004   (make-local-variable 'font-lock-keywords)
1005   (let ((c-keywords
1006          (mdw-regexps "and"             ;C++
1007                       "and_eq"          ;C++
1008                       "asm"             ;K&R, GCC
1009                       "auto"            ;K&R, C89
1010                       "bitand"          ;C++
1011                       "bitor"           ;C++
1012                       "bool"            ;C++, C9X macro
1013                       "break"           ;K&R, C89
1014                       "case"            ;K&R, C89
1015                       "catch"           ;C++
1016                       "char"            ;K&R, C89
1017                       "class"           ;C++
1018                       "complex"         ;C9X macro, C++ template type
1019                       "compl"           ;C++
1020                       "const"           ;C89
1021                       "const_cast"      ;C++
1022                       "continue"        ;K&R, C89
1023                       "defined"         ;C89 preprocessor
1024                       "default"         ;K&R, C89
1025                       "delete"          ;C++
1026                       "do"              ;K&R, C89
1027                       "double"          ;K&R, C89
1028                       "dynamic_cast"    ;C++
1029                       "else"            ;K&R, C89
1030                       ;; "entry"        ;K&R -- never used
1031                       "enum"            ;C89
1032                       "explicit"        ;C++
1033                       "export"          ;C++
1034                       "extern"          ;K&R, C89
1035                       "false"           ;C++, C9X macro
1036                       "float"           ;K&R, C89
1037                       "for"             ;K&R, C89
1038                       ;; "fortran"      ;K&R
1039                       "friend"          ;C++
1040                       "goto"            ;K&R, C89
1041                       "if"              ;K&R, C89
1042                       "imaginary"       ;C9X macro
1043                       "inline"          ;C++, C9X, GCC
1044                       "int"             ;K&R, C89
1045                       "long"            ;K&R, C89
1046                       "mutable"         ;C++
1047                       "namespace"       ;C++
1048                       "new"             ;C++
1049                       "operator"        ;C++
1050                       "or"              ;C++
1051                       "or_eq"           ;C++
1052                       "private"         ;C++
1053                       "protected"       ;C++
1054                       "public"          ;C++
1055                       "register"        ;K&R, C89
1056                       "reinterpret_cast" ;C++
1057                       "restrict"         ;C9X
1058                       "return"           ;K&R, C89
1059                       "short"            ;K&R, C89
1060                       "signed"           ;C89
1061                       "sizeof"           ;K&R, C89
1062                       "static"           ;K&R, C89
1063                       "static_cast"      ;C++
1064                       "struct"           ;K&R, C89
1065                       "switch"           ;K&R, C89
1066                       "template"         ;C++
1067                       "this"             ;C++
1068                       "throw"            ;C++
1069                       "true"             ;C++, C9X macro
1070                       "try"              ;C++
1071                       "this"             ;C++
1072                       "typedef"          ;C89
1073                       "typeid"           ;C++
1074                       "typeof"           ;GCC
1075                       "typename"         ;C++
1076                       "union"            ;K&R, C89
1077                       "unsigned"         ;K&R, C89
1078                       "using"            ;C++
1079                       "virtual"          ;C++
1080                       "void"             ;C89
1081                       "volatile"         ;C89
1082                       "wchar_t"          ;C++, C89 library type
1083                       "while"            ;K&R, C89
1084                       "xor"              ;C++
1085                       "xor_eq"           ;C++
1086                       "_Bool"            ;C9X
1087                       "_Complex"         ;C9X
1088                       "_Imaginary"       ;C9X
1089                       "_Pragma"          ;C9X preprocessor
1090                       "__alignof__"      ;GCC
1091                       "__asm__"          ;GCC
1092                       "__attribute__"    ;GCC
1093                       "__complex__"      ;GCC
1094                       "__const__"        ;GCC
1095                       "__extension__"    ;GCC
1096                       "__imag__"         ;GCC
1097                       "__inline__"       ;GCC
1098                       "__label__"        ;GCC
1099                       "__real__"         ;GCC
1100                       "__signed__"       ;GCC
1101                       "__typeof__"       ;GCC
1102                       "__volatile__"     ;GCC
1103                       ))
1104         (preprocessor-keywords
1105          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1106                       "ident" "if" "ifdef" "ifndef" "import" "include"
1107                       "line" "pragma" "unassert" "undef" "warning"))
1108         (objc-keywords
1109          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1110                       "interface" "private" "protected" "protocol" "public"
1111                       "selector")))
1112
1113     (setq font-lock-keywords
1114           (list
1115
1116            ;; Fontify include files as strings.
1117            (list (concat "^[ \t]*\\#[ \t]*"
1118                          "\\(include\\|import\\)"
1119                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1120                  '(2 font-lock-string-face))
1121
1122            ;; Preprocessor directives are `references'?.
1123            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1124                          preprocessor-keywords
1125                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1126                  '(1 font-lock-keyword-face))
1127
1128            ;; Handle the keywords defined above.
1129            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1130                  '(0 font-lock-keyword-face))
1131
1132            (list (concat "\\<\\(" c-keywords "\\)\\>")
1133                  '(0 font-lock-keyword-face))
1134
1135            ;; Handle numbers too.
1136            ;;
1137            ;; This looks strange, I know.  It corresponds to the
1138            ;; preprocessor's idea of what a number looks like, rather than
1139            ;; anything sensible.
1140            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1141                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1142                  '(0 mdw-number-face))
1143
1144            ;; And anything else is punctuation.
1145            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1146                  '(0 mdw-punct-face))))
1147
1148     (mdw-post-config-mode-hack)))
1149
1150 ;;;--------------------------------------------------------------------------
1151 ;;; AP calc mode.
1152
1153 (defun apcalc-mode ()
1154   (interactive)
1155   (c-mode)
1156   (setq major-mode 'apcalc-mode)
1157   (setq mode-name "AP Calc")
1158   (run-hooks 'apcalc-mode-hook))
1159
1160 (defun mdw-fontify-apcalc ()
1161
1162   ;; Fiddle with some syntax codes.
1163   (modify-syntax-entry ?* ". 23")
1164   (modify-syntax-entry ?/ ". 14")
1165
1166   ;; Other stuff.
1167   (mdw-c-style)
1168   (setq c-hanging-comment-ender-p nil)
1169   (setq c-backslash-column 72)
1170   (setq comment-start "/* ")
1171   (setq comment-end " */")
1172   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1173
1174   ;; Now define things to be fontified.
1175   (make-local-variable 'font-lock-keywords)
1176   (let ((c-keywords
1177          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1178                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1179                       "local" "mat" "obj" "print" "quit" "read" "return"
1180                       "show" "static" "switch" "while" "write")))
1181
1182     (setq font-lock-keywords
1183           (list
1184
1185            ;; Handle the keywords defined above.
1186            (list (concat "\\<\\(" c-keywords "\\)\\>")
1187                  '(0 font-lock-keyword-face))
1188
1189            ;; Handle numbers too.
1190            ;;
1191            ;; This looks strange, I know.  It corresponds to the
1192            ;; preprocessor's idea of what a number looks like, rather than
1193            ;; anything sensible.
1194            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1195                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1196                  '(0 mdw-number-face))
1197
1198            ;; And anything else is punctuation.
1199            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1200                  '(0 mdw-punct-face)))))
1201
1202   (mdw-post-config-mode-hack))
1203
1204 ;;;--------------------------------------------------------------------------
1205 ;;; Java programming configuration.
1206
1207 ;; Make indentation nice.
1208
1209 (defun mdw-java-style ()
1210   (c-add-style "[mdw] Java style"
1211                '((c-basic-offset . 2)
1212                  (c-offsets-alist (substatement-open . 0)
1213                                   (label . +)
1214                                   (case-label . +)
1215                                   (access-label . 0)
1216                                   (inclass . +)
1217                                   (statement-case-intro . +)))
1218                t))
1219
1220 ;; Declare Java fontification style.
1221
1222 (defun mdw-fontify-java ()
1223
1224   ;; Other stuff.
1225   (mdw-java-style)
1226   (setq c-hanging-comment-ender-p nil)
1227   (setq c-backslash-column 72)
1228   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1229
1230   ;; Now define things to be fontified.
1231   (make-local-variable 'font-lock-keywords)
1232   (let ((java-keywords
1233          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1234                       "char" "class" "const" "continue" "default" "do"
1235                       "double" "else" "extends" "final" "finally" "float"
1236                       "for" "goto" "if" "implements" "import" "instanceof"
1237                       "int" "interface" "long" "native" "new" "package"
1238                       "private" "protected" "public" "return" "short"
1239                       "static" "super" "switch" "synchronized" "this"
1240                       "throw" "throws" "transient" "try" "void" "volatile"
1241                       "while"
1242
1243                       "false" "null" "true")))
1244
1245     (setq font-lock-keywords
1246           (list
1247
1248            ;; Handle the keywords defined above.
1249            (list (concat "\\<\\(" java-keywords "\\)\\>")
1250                  '(0 font-lock-keyword-face))
1251
1252            ;; Handle numbers too.
1253            ;;
1254            ;; The following isn't quite right, but it's close enough.
1255            (list (concat "\\<\\("
1256                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1257                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1258                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1259                          "[lLfFdD]?")
1260                  '(0 mdw-number-face))
1261
1262            ;; And anything else is punctuation.
1263            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1264                  '(0 mdw-punct-face)))))
1265
1266   (mdw-post-config-mode-hack))
1267
1268 ;;;--------------------------------------------------------------------------
1269 ;;; C# programming configuration.
1270
1271 ;; Make indentation nice.
1272
1273 (defun mdw-csharp-style ()
1274   (c-add-style "[mdw] C# style"
1275                '((c-basic-offset . 2)
1276                  (c-offsets-alist (substatement-open . 0)
1277                                   (label . 0)
1278                                   (case-label . +)
1279                                   (access-label . 0)
1280                                   (inclass . +)
1281                                   (statement-case-intro . +)))
1282                t))
1283
1284 ;; Declare C# fontification style.
1285
1286 (defun mdw-fontify-csharp ()
1287
1288   ;; Other stuff.
1289   (mdw-csharp-style)
1290   (setq c-hanging-comment-ender-p nil)
1291   (setq c-backslash-column 72)
1292   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1293
1294   ;; Now define things to be fontified.
1295   (make-local-variable 'font-lock-keywords)
1296   (let ((csharp-keywords
1297          (mdw-regexps "abstract" "as" "base" "bool" "break"
1298                       "byte" "case" "catch" "char" "checked"
1299                       "class" "const" "continue" "decimal" "default"
1300                       "delegate" "do" "double" "else" "enum"
1301                       "event" "explicit" "extern" "false" "finally"
1302                       "fixed" "float" "for" "foreach" "goto"
1303                       "if" "implicit" "in" "int" "interface"
1304                       "internal" "is" "lock" "long" "namespace"
1305                       "new" "null" "object" "operator" "out"
1306                       "override" "params" "private" "protected" "public"
1307                       "readonly" "ref" "return" "sbyte" "sealed"
1308                       "short" "sizeof" "stackalloc" "static" "string"
1309                       "struct" "switch" "this" "throw" "true"
1310                       "try" "typeof" "uint" "ulong" "unchecked"
1311                       "unsafe" "ushort" "using" "virtual" "void"
1312                       "volatile" "while" "yield")))
1313
1314     (setq font-lock-keywords
1315           (list
1316
1317            ;; Handle the keywords defined above.
1318            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1319                  '(0 font-lock-keyword-face))
1320
1321            ;; Handle numbers too.
1322            ;;
1323            ;; The following isn't quite right, but it's close enough.
1324            (list (concat "\\<\\("
1325                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1326                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1327                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1328                          "[lLfFdD]?")
1329                  '(0 mdw-number-face))
1330
1331            ;; And anything else is punctuation.
1332            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1333                  '(0 mdw-punct-face)))))
1334
1335   (mdw-post-config-mode-hack))
1336
1337 (define-derived-mode csharp-mode java-mode "C#"
1338   "Major mode for editing C# code.")
1339
1340 ;;;--------------------------------------------------------------------------
1341 ;;; Go programming configuration.
1342
1343 (defun mdw-fontify-go ()
1344
1345   (make-local-variable 'font-lock-keywords)
1346   (let ((go-keywords
1347          (mdw-regexps "break" "case" "chan" "const" "continue"
1348                       "default" "defer" "else" "fallthrough" "for"
1349                       "func" "go" "goto" "if" "import"
1350                       "interface" "map" "package" "range" "return"
1351                       "select" "struct" "switch" "type" "var")))
1352
1353     (setq font-lock-keywords
1354           (list
1355
1356            ;; Handle the keywords defined above.
1357            (list (concat "\\<\\(" go-keywords "\\)\\>")
1358                  '(0 font-lock-keyword-face))
1359
1360            ;; Handle numbers too.
1361            ;;
1362            ;; The following isn't quite right, but it's close enough.
1363            (list (concat "\\<\\("
1364                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1365                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1366                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1367                  '(0 mdw-number-face))
1368
1369            ;; And anything else is punctuation.
1370            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1371                  '(0 mdw-punct-face)))))
1372
1373   (mdw-post-config-mode-hack))
1374
1375 ;;;--------------------------------------------------------------------------
1376 ;;; Awk programming configuration.
1377
1378 ;; Make Awk indentation nice.
1379
1380 (defun mdw-awk-style ()
1381   (c-add-style "[mdw] Awk style"
1382                '((c-basic-offset . 2)
1383                  (c-offsets-alist (substatement-open . 0)
1384                                   (statement-cont . 0)
1385                                   (statement-case-intro . +)))
1386                t))
1387
1388 ;; Declare Awk fontification style.
1389
1390 (defun mdw-fontify-awk ()
1391
1392   ;; Miscellaneous fiddling.
1393   (mdw-awk-style)
1394   (setq c-backslash-column 72)
1395   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1396
1397   ;; Now define things to be fontified.
1398   (make-local-variable 'font-lock-keywords)
1399   (let ((c-keywords
1400          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1401                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1402                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1403                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1404                       "atan2" "break" "close" "continue" "cos" "delete"
1405                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1406                       "function" "gensub" "getline" "gsub" "if" "in"
1407                       "index" "int" "length" "log" "match" "next" "rand"
1408                       "return" "print" "printf" "sin" "split" "sprintf"
1409                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1410                       "systime" "tolower" "toupper" "while")))
1411
1412     (setq font-lock-keywords
1413           (list
1414
1415            ;; Handle the keywords defined above.
1416            (list (concat "\\<\\(" c-keywords "\\)\\>")
1417                  '(0 font-lock-keyword-face))
1418
1419            ;; Handle numbers too.
1420            ;;
1421            ;; The following isn't quite right, but it's close enough.
1422            (list (concat "\\<\\("
1423                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1424                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1425                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1426                          "[uUlL]*")
1427                  '(0 mdw-number-face))
1428
1429            ;; And anything else is punctuation.
1430            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1431                  '(0 mdw-punct-face)))))
1432
1433   (mdw-post-config-mode-hack))
1434
1435 ;;;--------------------------------------------------------------------------
1436 ;;; Perl programming style.
1437
1438 ;; Perl indentation style.
1439
1440 (setq cperl-indent-level 2)
1441 (setq cperl-continued-statement-offset 2)
1442 (setq cperl-continued-brace-offset 0)
1443 (setq cperl-brace-offset -2)
1444 (setq cperl-brace-imaginary-offset 0)
1445 (setq cperl-label-offset 0)
1446
1447 ;; Define perl fontification style.
1448
1449 (defun mdw-fontify-perl ()
1450
1451   ;; Miscellaneous fiddling.
1452   (modify-syntax-entry ?$ "\\")
1453   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1454   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1455
1456   ;; Now define fontification things.
1457   (make-local-variable 'font-lock-keywords)
1458   (let ((perl-keywords
1459          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1460                       "for" "foreach" "ge" "gt" "goto" "if"
1461                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1462                       "package" "redo" "require" "return" "sub"
1463                       "undef" "unless" "until" "use" "while")))
1464
1465     (setq font-lock-keywords
1466           (list
1467
1468            ;; Set up the keywords defined above.
1469            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1470                  '(0 font-lock-keyword-face))
1471
1472            ;; At least numbers are simpler than C.
1473            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1474                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1475                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1476                  '(0 mdw-number-face))
1477
1478            ;; And anything else is punctuation.
1479            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1480                  '(0 mdw-punct-face)))))
1481
1482   (mdw-post-config-mode-hack))
1483
1484 (defun perl-number-tests (&optional arg)
1485   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1486 strip numbers instead."
1487   (interactive "P")
1488   (save-excursion
1489     (goto-char (point-min))
1490     (let ((i 0) (fmt (if arg "" " %4d")))
1491       (while (search-forward "#t" nil t)
1492         (delete-region (point) (line-end-position))
1493         (setq i (1+ i))
1494         (insert (format fmt i)))
1495       (goto-char (point-min))
1496       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1497           (replace-match (format "\\1%d" i))))))
1498
1499 ;;;--------------------------------------------------------------------------
1500 ;;; Python programming style.
1501
1502 (defun mdw-fontify-pythonic (keywords)
1503
1504   ;; Miscellaneous fiddling.
1505   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1506
1507   ;; Now define fontification things.
1508   (make-local-variable 'font-lock-keywords)
1509   (setq font-lock-keywords
1510         (list
1511
1512          ;; Set up the keywords defined above.
1513          (list (concat "\\<\\(" keywords "\\)\\>")
1514                '(0 font-lock-keyword-face))
1515
1516          ;; At least numbers are simpler than C.
1517          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1518                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1519                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1520                '(0 mdw-number-face))
1521
1522          ;; And anything else is punctuation.
1523          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1524                '(0 mdw-punct-face))))
1525
1526   (mdw-post-config-mode-hack))
1527
1528 ;; Define Python fontification styles.
1529
1530 (defun mdw-fontify-python ()
1531   (mdw-fontify-pythonic
1532    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1533                 "del" "elif" "else" "except" "exec" "finally" "for"
1534                 "from" "global" "if" "import" "in" "is" "lambda"
1535                 "not" "or" "pass" "print" "raise" "return" "try"
1536                 "while" "with" "yield")))
1537
1538 (defun mdw-fontify-pyrex ()
1539   (mdw-fontify-pythonic
1540    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1541                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1542                 "extern" "finally" "for" "from" "global" "if"
1543                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1544                 "raise" "return" "struct" "try" "while" "with"
1545                 "yield")))
1546
1547 ;;;--------------------------------------------------------------------------
1548 ;;; Icon programming style.
1549
1550 ;; Icon indentation style.
1551
1552 (setq icon-brace-offset 0
1553       icon-continued-brace-offset 0
1554       icon-continued-statement-offset 2
1555       icon-indent-level 2)
1556
1557 ;; Define Icon fontification style.
1558
1559 (defun mdw-fontify-icon ()
1560
1561   ;; Miscellaneous fiddling.
1562   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1563
1564   ;; Now define fontification things.
1565   (make-local-variable 'font-lock-keywords)
1566   (let ((icon-keywords
1567          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1568                       "end" "every" "fail" "global" "if" "initial"
1569                       "invocable" "link" "local" "next" "not" "of"
1570                       "procedure" "record" "repeat" "return" "static"
1571                       "suspend" "then" "to" "until" "while"))
1572         (preprocessor-keywords
1573          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1574                       "include" "line" "undef")))
1575     (setq font-lock-keywords
1576           (list
1577
1578            ;; Set up the keywords defined above.
1579            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1580                  '(0 font-lock-keyword-face))
1581
1582            ;; The things that Icon calls keywords.
1583            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1584
1585            ;; At least numbers are simpler than C.
1586            (list (concat "\\<[0-9]+"
1587                          "\\([rR][0-9a-zA-Z]+\\|"
1588                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1589                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1590                  '(0 mdw-number-face))
1591
1592            ;; Preprocessor.
1593            (list (concat "^[ \t]*$[ \t]*\\<\\("
1594                          preprocessor-keywords
1595                          "\\)\\>")
1596                  '(0 font-lock-keyword-face))
1597
1598            ;; And anything else is punctuation.
1599            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1600                  '(0 mdw-punct-face)))))
1601
1602   (mdw-post-config-mode-hack))
1603
1604 ;;;--------------------------------------------------------------------------
1605 ;;; ARM assembler programming configuration.
1606
1607 ;; There doesn't appear to be an Emacs mode for this yet.
1608 ;;
1609 ;; Better do something about that, I suppose.
1610
1611 (defvar arm-assembler-mode-map nil)
1612 (defvar arm-assembler-abbrev-table nil)
1613 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1614
1615 (or arm-assembler-mode-map
1616     (progn
1617       (setq arm-assembler-mode-map (make-sparse-keymap))
1618       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1619       (define-key arm-assembler-mode-map [C-return] 'newline)
1620       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1621
1622 (defun arm-assembler-mode ()
1623   "Major mode for ARM assembler programs"
1624   (interactive)
1625
1626   ;; Do standard major mode things.
1627   (kill-all-local-variables)
1628   (use-local-map arm-assembler-mode-map)
1629   (setq local-abbrev-table arm-assembler-abbrev-table)
1630   (setq major-mode 'arm-assembler-mode)
1631   (setq mode-name "ARM assembler")
1632
1633   ;; Set up syntax table.
1634   (set-syntax-table arm-assembler-mode-syntax-table)
1635   (modify-syntax-entry ?;   ; Nasty hack
1636                        "<" arm-assembler-mode-syntax-table)
1637   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1638   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1639
1640   (make-local-variable 'comment-start)
1641   (setq comment-start ";")
1642   (make-local-variable 'comment-end)
1643   (setq comment-end "")
1644   (make-local-variable 'comment-column)
1645   (setq comment-column 48)
1646   (make-local-variable 'comment-start-skip)
1647   (setq comment-start-skip ";+[ \t]*")
1648
1649   ;; Play with indentation.
1650   (make-local-variable 'indent-line-function)
1651   (setq indent-line-function 'indent-relative-maybe)
1652
1653   ;; Set fill prefix.
1654   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1655
1656   ;; Fiddle with fontification.
1657   (make-local-variable 'font-lock-keywords)
1658   (setq font-lock-keywords
1659         (list
1660
1661          ;; Handle numbers too.
1662          ;;
1663          ;; The following isn't quite right, but it's close enough.
1664          (list (concat "\\("
1665                        "&[0-9a-fA-F]+\\|"
1666                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1667                        "\\)")
1668                '(0 mdw-number-face))
1669
1670          ;; Do something about operators.
1671          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1672                '(1 font-lock-keyword-face)
1673                '(2 font-lock-string-face))
1674          (list ":[a-zA-Z]+:"
1675                '(0 font-lock-keyword-face))
1676
1677          ;; Do menemonics and directives.
1678          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1679                '(1 font-lock-keyword-face))
1680
1681          ;; And anything else is punctuation.
1682          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1683                '(0 mdw-punct-face)))
1684
1685   (mdw-post-config-mode-hack))
1686   (run-hooks 'arm-assembler-mode-hook))
1687
1688 ;;;--------------------------------------------------------------------------
1689 ;;; Assembler mode.
1690
1691 (defun mdw-fontify-asm ()
1692   (modify-syntax-entry ?' "\"")
1693   (modify-syntax-entry ?. "w")
1694   (setf fill-prefix nil)
1695   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1696
1697 ;;;--------------------------------------------------------------------------
1698 ;;; TCL configuration.
1699
1700 (defun mdw-fontify-tcl ()
1701   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1702   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1703   (make-local-variable 'font-lock-keywords)
1704   (setq font-lock-keywords
1705         (list
1706          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1707                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1708                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1709                '(0 mdw-number-face))
1710          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1711                '(0 mdw-punct-face))))
1712   (mdw-post-config-mode-hack))
1713
1714 ;;;--------------------------------------------------------------------------
1715 ;;; REXX configuration.
1716
1717 (defun mdw-rexx-electric-* ()
1718   (interactive)
1719   (insert ?*)
1720   (rexx-indent-line))
1721
1722 (defun mdw-rexx-indent-newline-indent ()
1723   (interactive)
1724   (rexx-indent-line)
1725   (if abbrev-mode (expand-abbrev))
1726   (newline-and-indent))
1727
1728 (defun mdw-fontify-rexx ()
1729
1730   ;; Various bits of fiddling.
1731   (setq mdw-auto-indent nil)
1732   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1733   (local-set-key [?*] 'mdw-rexx-electric-*)
1734   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1735           '(?! ?? ?# ?@ ?$))
1736   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1737
1738   ;; Set up keywords and things for fontification.
1739   (make-local-variable 'font-lock-keywords-case-fold-search)
1740   (setq font-lock-keywords-case-fold-search t)
1741
1742   (setq rexx-indent 2)
1743   (setq rexx-end-indent rexx-indent)
1744   (setq rexx-cont-indent rexx-indent)
1745
1746   (make-local-variable 'font-lock-keywords)
1747   (let ((rexx-keywords
1748          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1749                       "else" "end" "engineering" "exit" "expose" "for"
1750                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1751                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1752                       "options" "otherwise" "parse" "procedure" "pull"
1753                       "push" "queue" "return" "say" "select" "signal"
1754                       "scientific" "source" "then" "trace" "to" "until"
1755                       "upper" "value" "var" "version" "when" "while"
1756                       "with"
1757
1758                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1759                       "center" "center" "charin" "charout" "chars"
1760                       "compare" "condition" "copies" "c2d" "c2x"
1761                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1762                       "errortext" "format" "fuzz" "insert" "lastpos"
1763                       "left" "length" "lineout" "lines" "max" "min"
1764                       "overlay" "pos" "queued" "random" "reverse" "right"
1765                       "sign" "sourceline" "space" "stream" "strip"
1766                       "substr" "subword" "symbol" "time" "translate"
1767                       "trunc" "value" "verify" "word" "wordindex"
1768                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1769                       "x2d")))
1770
1771     (setq font-lock-keywords
1772           (list
1773
1774            ;; Set up the keywords defined above.
1775            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1776                  '(0 font-lock-keyword-face))
1777
1778            ;; Fontify all symbols the same way.
1779            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1780                          "[A-Za-z0-9.!?_#@$]+\\)")
1781                  '(0 font-lock-variable-name-face))
1782
1783            ;; And everything else is punctuation.
1784            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1785                  '(0 mdw-punct-face)))))
1786
1787   (mdw-post-config-mode-hack))
1788
1789 ;;;--------------------------------------------------------------------------
1790 ;;; Standard ML programming style.
1791
1792 (defun mdw-fontify-sml ()
1793
1794   ;; Make underscore an honorary letter.
1795   (modify-syntax-entry ?' "w")
1796
1797   ;; Set fill prefix.
1798   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1799
1800   ;; Now define fontification things.
1801   (make-local-variable 'font-lock-keywords)
1802   (let ((sml-keywords
1803          (mdw-regexps "abstype" "and" "andalso" "as"
1804                       "case"
1805                       "datatype" "do"
1806                       "else" "end" "eqtype" "exception"
1807                       "fn" "fun" "functor"
1808                       "handle"
1809                       "if" "in" "include" "infix" "infixr"
1810                       "let" "local"
1811                       "nonfix"
1812                       "of" "op" "open" "orelse"
1813                       "raise" "rec"
1814                       "sharing" "sig" "signature" "struct" "structure"
1815                       "then" "type"
1816                       "val"
1817                       "where" "while" "with" "withtype")))
1818
1819     (setq font-lock-keywords
1820           (list
1821
1822            ;; Set up the keywords defined above.
1823            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1824                  '(0 font-lock-keyword-face))
1825
1826            ;; At least numbers are simpler than C.
1827            (list (concat "\\<\\(\\~\\|\\)"
1828                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1829                                    "[wW][0-9]+\\)\\|"
1830                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1831                                          "\\([eE]\\(\\~\\|\\)"
1832                                                 "[0-9]+\\|\\)\\)\\)")
1833                  '(0 mdw-number-face))
1834
1835            ;; And anything else is punctuation.
1836            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1837                  '(0 mdw-punct-face)))))
1838
1839   (mdw-post-config-mode-hack))
1840
1841 ;;;--------------------------------------------------------------------------
1842 ;;; Haskell configuration.
1843
1844 (defun mdw-fontify-haskell ()
1845
1846   ;; Fiddle with syntax table to get comments right.
1847   (modify-syntax-entry ?' "\"")
1848   (modify-syntax-entry ?- ". 123")
1849   (modify-syntax-entry ?{ ". 1b")
1850   (modify-syntax-entry ?} ". 4b")
1851   (modify-syntax-entry ?\n ">")
1852
1853   ;; Set fill prefix.
1854   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1855
1856   ;; Fiddle with fontification.
1857   (make-local-variable 'font-lock-keywords)
1858   (let ((haskell-keywords
1859          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1860                       "deriving" "do" "else" "foreign" "hiding" "if"
1861                       "import" "in" "infix" "infixl" "infixr" "instance"
1862                       "let" "module" "newtype" "of" "qualified" "safe"
1863                       "stdcall" "then" "type" "unsafe" "where")))
1864
1865     (setq font-lock-keywords
1866           (list
1867            (list "--.*$"
1868                  '(0 font-lock-comment-face))
1869            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1870                  '(0 font-lock-keyword-face))
1871            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1872                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1873                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1874                  '(0 mdw-number-face))
1875            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1876                  '(0 mdw-punct-face)))))
1877
1878   (mdw-post-config-mode-hack))
1879
1880 ;;;--------------------------------------------------------------------------
1881 ;;; Erlang configuration.
1882
1883 (setq erlang-electric-commannds
1884       '(erlang-electric-newline erlang-electric-semicolon))
1885
1886 (defun mdw-fontify-erlang ()
1887
1888   ;; Set fill prefix.
1889   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1890
1891   ;; Fiddle with fontification.
1892   (make-local-variable 'font-lock-keywords)
1893   (let ((erlang-keywords
1894          (mdw-regexps "after" "and" "andalso"
1895                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1896                       "case" "catch" "cond"
1897                       "div" "end" "fun" "if" "let" "not"
1898                       "of" "or" "orelse"
1899                       "query" "receive" "rem" "try" "when" "xor")))
1900
1901     (setq font-lock-keywords
1902           (list
1903            (list "%.*$"
1904                  '(0 font-lock-comment-face))
1905            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1906                  '(0 font-lock-keyword-face))
1907            (list (concat "^-\\sw+\\>")
1908                  '(0 font-lock-keyword-face))
1909            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1910                  '(0 mdw-number-face))
1911            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1912                  '(0 mdw-punct-face)))))
1913
1914   (mdw-post-config-mode-hack))
1915
1916 ;;;--------------------------------------------------------------------------
1917 ;;; Texinfo configuration.
1918
1919 (defun mdw-fontify-texinfo ()
1920
1921   ;; Set fill prefix.
1922   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1923
1924   ;; Real fontification things.
1925   (make-local-variable 'font-lock-keywords)
1926   (setq font-lock-keywords
1927         (list
1928
1929          ;; Environment names are keywords.
1930          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1931                '(2 font-lock-keyword-face))
1932
1933          ;; Unmark escaped magic characters.
1934          (list "\\(@\\)\\([@{}]\\)"
1935                '(1 font-lock-keyword-face)
1936                '(2 font-lock-variable-name-face))
1937
1938          ;; Make sure we get comments properly.
1939          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1940                '(0 font-lock-comment-face))
1941
1942          ;; Command names are keywords.
1943          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1944                '(0 font-lock-keyword-face))
1945
1946          ;; Fontify TeX special characters as punctuation.
1947          (list "[{}]+"
1948                '(0 mdw-punct-face))))
1949
1950   (mdw-post-config-mode-hack))
1951
1952 ;;;--------------------------------------------------------------------------
1953 ;;; TeX and LaTeX configuration.
1954
1955 (defun mdw-fontify-tex ()
1956   (setq ispell-parser 'tex)
1957   (turn-on-reftex)
1958
1959   ;; Don't make maths into a string.
1960   (modify-syntax-entry ?$ ".")
1961   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1962   (local-set-key [?$] 'self-insert-command)
1963
1964   ;; Set fill prefix.
1965   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1966
1967   ;; Real fontification things.
1968   (make-local-variable 'font-lock-keywords)
1969   (setq font-lock-keywords
1970         (list
1971
1972          ;; Environment names are keywords.
1973          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1974                        "{\\([^}\n]*\\)}")
1975                '(2 font-lock-keyword-face))
1976
1977          ;; Suspended environment names are keywords too.
1978          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1979                        "{\\([^}\n]*\\)}")
1980                '(3 font-lock-keyword-face))
1981
1982          ;; Command names are keywords.
1983          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1984                '(0 font-lock-keyword-face))
1985
1986          ;; Handle @/.../ for italics.
1987          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1988          ;;       '(1 font-lock-keyword-face)
1989          ;;       '(3 font-lock-keyword-face))
1990
1991          ;; Handle @*...* for boldness.
1992          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1993          ;;       '(1 font-lock-keyword-face)
1994          ;;       '(3 font-lock-keyword-face))
1995
1996          ;; Handle @`...' for literal syntax things.
1997          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1998          ;;       '(1 font-lock-keyword-face)
1999          ;;       '(3 font-lock-keyword-face))
2000
2001          ;; Handle @<...> for nonterminals.
2002          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2003          ;;       '(1 font-lock-keyword-face)
2004          ;;       '(3 font-lock-keyword-face))
2005
2006          ;; Handle other @-commands.
2007          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2008          ;;       '(0 font-lock-keyword-face))
2009
2010          ;; Make sure we get comments properly.
2011          (list "%.*"
2012                '(0 font-lock-comment-face))
2013
2014          ;; Fontify TeX special characters as punctuation.
2015          (list "[$^_{}#&]"
2016                '(0 mdw-punct-face))))
2017
2018   (mdw-post-config-mode-hack))
2019
2020 ;;;--------------------------------------------------------------------------
2021 ;;; SGML hacking.
2022
2023 (defun mdw-sgml-mode ()
2024   (interactive)
2025   (sgml-mode)
2026   (mdw-standard-fill-prefix "")
2027   (make-variable-buffer-local 'sgml-delimiters)
2028   (setq sgml-delimiters
2029         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2030           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2031           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2032           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2033           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2034           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2035           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2036           "NULL" ""))
2037   (setq major-mode 'mdw-sgml-mode)
2038   (setq mode-name "[mdw] SGML")
2039   (run-hooks 'mdw-sgml-mode-hook))
2040
2041 ;;;--------------------------------------------------------------------------
2042 ;;; Shell scripts.
2043
2044 (defun mdw-setup-sh-script-mode ()
2045
2046   ;; Fetch the shell interpreter's name.
2047   (let ((shell-name sh-shell-file))
2048
2049     ;; Try reading the hash-bang line.
2050     (save-excursion
2051       (goto-char (point-min))
2052       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2053           (setq shell-name (match-string 1))))
2054
2055     ;; Now try to set the shell.
2056     ;;
2057     ;; Don't let `sh-set-shell' bugger up my script.
2058     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2059       (sh-set-shell shell-name)))
2060
2061   ;; Now enable my keys and the fontification.
2062   (mdw-misc-mode-config)
2063
2064   ;; Set the indentation level correctly.
2065   (setq sh-indentation 2)
2066   (setq sh-basic-offset 2))
2067
2068 ;;;--------------------------------------------------------------------------
2069 ;;; Emacs shell mode.
2070
2071 (defun mdw-eshell-prompt ()
2072   (let ((left "[") (right "]"))
2073     (when (= (user-uid) 0)
2074       (setq left "«" right "»"))
2075     (concat left
2076             (save-match-data
2077               (replace-regexp-in-string "\\..*$" "" (system-name)))
2078             " "
2079             (eshell/pwd)
2080             right)))
2081 (setq eshell-prompt-function 'mdw-eshell-prompt)
2082 (setq eshell-prompt-regexp "^\\[[^]]+\\]")
2083
2084 (mdw-define-face eshell-prompt (t :weight bold))
2085 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2086 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2087 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2088 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2089 (mdw-define-face eshell-ls-executable (t :weight bold))
2090 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2091 (mdw-define-face eshell-ls-readonly (t nil))
2092 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2093
2094 ;;;--------------------------------------------------------------------------
2095 ;;; Messages-file mode.
2096
2097 (defun messages-mode-guts ()
2098   (setq messages-mode-syntax-table (make-syntax-table))
2099   (set-syntax-table messages-mode-syntax-table)
2100   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2101   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2102   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2103   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2104   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2105   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2106   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2107   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2108   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2109   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2110   (make-local-variable 'comment-start)
2111   (make-local-variable 'comment-end)
2112   (make-local-variable 'indent-line-function)
2113   (setq indent-line-function 'indent-relative)
2114   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2115   (make-local-variable 'font-lock-defaults)
2116   (make-local-variable 'messages-mode-keywords)
2117   (let ((keywords
2118          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2119                       "export" "enum" "fixed-octetstring" "flags"
2120                       "harmless" "map" "nested" "optional"
2121                       "optional-tagged" "package" "primitive"
2122                       "primitive-nullfree" "relaxed[ \t]+enum"
2123                       "set" "table" "tagged-optional"   "union"
2124                       "variadic" "vector" "version" "version-tag")))
2125     (setq messages-mode-keywords
2126           (list
2127            (list (concat "\\<\\(" keywords "\\)\\>:")
2128                  '(0 font-lock-keyword-face))
2129            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2130            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2131              (0 font-lock-variable-name-face))
2132            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2133            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2134              (0 mdw-punct-face)))))
2135   (setq font-lock-defaults
2136         '(messages-mode-keywords nil nil nil nil))
2137   (run-hooks 'messages-file-hook))
2138
2139 (defun messages-mode ()
2140   (interactive)
2141   (fundamental-mode)
2142   (setq major-mode 'messages-mode)
2143   (setq mode-name "Messages")
2144   (messages-mode-guts)
2145   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2146   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2147   (setq comment-start "# ")
2148   (setq comment-end "")
2149   (turn-on-font-lock-if-enabled)
2150   (run-hooks 'messages-mode-hook))
2151
2152 (defun cpp-messages-mode ()
2153   (interactive)
2154   (fundamental-mode)
2155   (setq major-mode 'cpp-messages-mode)
2156   (setq mode-name "CPP Messages")
2157   (messages-mode-guts)
2158   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2159   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2160   (setq comment-start "/* ")
2161   (setq comment-end " */")
2162   (let ((preprocessor-keywords
2163          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2164                       "ident" "if" "ifdef" "ifndef" "import" "include"
2165                       "line" "pragma" "unassert" "undef" "warning")))
2166     (setq messages-mode-keywords
2167           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2168                                       "\\(include\\|import\\)"
2169                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2170                               '(2 font-lock-string-face))
2171                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2172                                       preprocessor-keywords
2173                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2174                               '(1 font-lock-keyword-face)))
2175                   messages-mode-keywords)))
2176   (turn-on-font-lock-if-enabled)
2177   (run-hooks 'cpp-messages-mode-hook))
2178
2179 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2180 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2181 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2182
2183 ;;;--------------------------------------------------------------------------
2184 ;;; Messages-file mode.
2185
2186 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2187   "Face to use for subsittution directives.")
2188 (make-face 'mallow-driver-substitution-face)
2189 (defvar mallow-driver-text-face 'mallow-driver-text-face
2190   "Face to use for body text.")
2191 (make-face 'mallow-driver-text-face)
2192
2193 (defun mallow-driver-mode ()
2194   (interactive)
2195   (fundamental-mode)
2196   (setq major-mode 'mallow-driver-mode)
2197   (setq mode-name "Mallow driver")
2198   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2199   (set-syntax-table mallow-driver-mode-syntax-table)
2200   (make-local-variable 'comment-start)
2201   (make-local-variable 'comment-end)
2202   (make-local-variable 'indent-line-function)
2203   (setq indent-line-function 'indent-relative)
2204   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2205   (make-local-variable 'font-lock-defaults)
2206   (make-local-variable 'mallow-driver-mode-keywords)
2207   (let ((keywords
2208          (mdw-regexps "each" "divert" "file" "if"
2209                       "perl" "set" "string" "type" "write")))
2210     (setq mallow-driver-mode-keywords
2211           (list
2212            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2213                  '(0 font-lock-keyword-face))
2214            (list "^%\\s *\\(#.*\\|\\)$"
2215                  '(0 font-lock-comment-face))
2216            (list "^%"
2217                  '(0 font-lock-keyword-face))
2218            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2219            (list "\\${[^}]*}"
2220                  '(0 mallow-driver-substitution-face t)))))
2221   (setq font-lock-defaults
2222         '(mallow-driver-mode-keywords nil nil nil nil))
2223   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2224   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2225   (setq comment-start "%# ")
2226   (setq comment-end "")
2227   (turn-on-font-lock-if-enabled)
2228   (run-hooks 'mallow-driver-mode-hook))
2229
2230 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2231
2232 ;;;--------------------------------------------------------------------------
2233 ;;; NFast debugs.
2234
2235 (defun nfast-debug-mode ()
2236   (interactive)
2237   (fundamental-mode)
2238   (setq major-mode 'nfast-debug-mode)
2239   (setq mode-name "NFast debug")
2240   (setq messages-mode-syntax-table (make-syntax-table))
2241   (set-syntax-table messages-mode-syntax-table)
2242   (make-local-variable 'font-lock-defaults)
2243   (make-local-variable 'nfast-debug-mode-keywords)
2244   (setq truncate-lines t)
2245   (setq nfast-debug-mode-keywords
2246         (list
2247          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2248            (0 font-lock-keyword-face))
2249          (list (concat "^[ \t]+\\(\\("
2250                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2251                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2252                        "[ \t]+\\)*"
2253                        "[0-9a-fA-F]+\\)[ \t]*$")
2254            '(0 mdw-number-face))
2255          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2256            (1 font-lock-keyword-face))
2257          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2258            (1 font-lock-warning-face))
2259          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2260            (1 nil))
2261          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2262                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2263            '(1 font-lock-keyword-face))
2264          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2265          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2266          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2267          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2268   (setq font-lock-defaults
2269         '(nfast-debug-mode-keywords nil nil nil nil))
2270   (turn-on-font-lock-if-enabled)
2271   (run-hooks 'nfast-debug-mode-hook))
2272
2273 ;;;--------------------------------------------------------------------------
2274 ;;; Other languages.
2275
2276 ;; Smalltalk.
2277
2278 (defun mdw-setup-smalltalk ()
2279   (and mdw-auto-indent
2280        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2281   (make-variable-buffer-local 'mdw-auto-indent)
2282   (setq mdw-auto-indent nil)
2283   (local-set-key "\C-i" 'smalltalk-reindent))
2284
2285 (defun mdw-fontify-smalltalk ()
2286   (make-local-variable 'font-lock-keywords)
2287   (setq font-lock-keywords
2288         (list
2289          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2290                '(0 font-lock-keyword-face))
2291          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2292                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2293                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2294                '(0 mdw-number-face))
2295          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2296                '(0 mdw-punct-face))))
2297   (mdw-post-config-mode-hack))
2298
2299 ;; Lispy languages.
2300
2301 ;; Unpleasant bodge.
2302 (unless (boundp 'slime-repl-mode-map)
2303   (setq slime-repl-mode-map (make-sparse-keymap)))
2304
2305 (defun mdw-indent-newline-and-indent ()
2306   (interactive)
2307   (indent-for-tab-command)
2308   (newline-and-indent))
2309
2310 (eval-after-load "cl-indent"
2311   '(progn
2312      (mapc #'(lambda (pair)
2313                (put (car pair)
2314                     'common-lisp-indent-function
2315                     (cdr pair)))
2316       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2317         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2318
2319 (defun mdw-common-lisp-indent ()
2320   (make-variable-buffer-local 'lisp-indent-function)
2321   (setq lisp-indent-function 'common-lisp-indent-function))
2322
2323 (setq lisp-simple-loop-indentation 2
2324       lisp-loop-keyword-indentation 6
2325       lisp-loop-forms-indentation 6)
2326
2327 (defun mdw-fontify-lispy ()
2328
2329   ;; Set fill prefix.
2330   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2331
2332   ;; Not much fontification needed.
2333   (make-local-variable 'font-lock-keywords)
2334   (setq font-lock-keywords
2335         (list
2336          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2337                '(0 mdw-punct-face))))
2338
2339   (mdw-post-config-mode-hack))
2340
2341 (defun comint-send-and-indent ()
2342   (interactive)
2343   (comint-send-input)
2344   (and mdw-auto-indent
2345        (indent-for-tab-command)))
2346
2347 (defun mdw-setup-m4 ()
2348   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2349
2350 ;;;--------------------------------------------------------------------------
2351 ;;; Text mode.
2352
2353 (defun mdw-text-mode ()
2354   (setq fill-column 72)
2355   (flyspell-mode t)
2356   (mdw-standard-fill-prefix
2357    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2358   (auto-fill-mode 1))
2359
2360 ;;;--------------------------------------------------------------------------
2361 ;;; Outline and hide/show modes.
2362
2363 (defun mdw-outline-collapse-all ()
2364   "Completely collapse everything in the entire buffer."
2365   (interactive)
2366   (save-excursion
2367     (goto-char (point-min))
2368     (while (< (point) (point-max))
2369       (hide-subtree)
2370       (forward-line))))
2371
2372 (setq hs-hide-comments-when-hiding-all nil)
2373
2374 (defadvice hs-hide-all (after hide-first-comment activate)
2375   (save-excursion (hs-hide-initial-comment-block)))
2376
2377 ;;;--------------------------------------------------------------------------
2378 ;;; Shell mode.
2379
2380 (defun mdw-sh-mode-setup ()
2381   (local-set-key [?\C-a] 'comint-bol)
2382   (add-hook 'comint-output-filter-functions
2383             'comint-watch-for-password-prompt))
2384
2385 (defun mdw-term-mode-setup ()
2386   (setq term-prompt-regexp shell-prompt-pattern)
2387   (make-local-variable 'mouse-yank-at-point)
2388   (make-local-variable 'transient-mark-mode)
2389   (setq mouse-yank-at-point t)
2390   (auto-fill-mode -1)
2391   (setq tab-width 8))
2392
2393 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2394 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2395 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2396 (defun term-send-meta-meta-something ()
2397   (interactive)
2398   (term-send-raw-string "\e\e")
2399   (term-send-raw))
2400 (eval-after-load 'term
2401   '(progn
2402      (define-key term-raw-map [?\e ?\e] nil)
2403      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2404      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2405      (define-key term-raw-map [M-right] 'term-send-meta-right)
2406      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2407      (define-key term-raw-map [M-left] 'term-send-meta-left)
2408      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2409
2410 ;;;--------------------------------------------------------------------------
2411 ;;; Inferior Emacs Lisp.
2412
2413 (setq comint-prompt-read-only t)
2414
2415 (eval-after-load "comint"
2416   '(progn
2417      (define-key comint-mode-map "\C-w" 'comint-kill-region)
2418      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
2419
2420 (eval-after-load "ielm"
2421   '(progn
2422      (define-key ielm-map "\C-w" 'comint-kill-region)
2423      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
2424
2425 ;;;----- That's all, folks --------------------------------------------------
2426
2427 (provide 'dot-emacs)