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

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