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

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