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