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