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

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