mdw@git.distorted.org.uk Git - profile/blob - dot-emacs.el

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