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