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