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