chiark - git - mdw - 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   (hs-minor-mode t)
 649   (trap (turn-on-font-lock)))
 650
 651 (eval-after-load 'gtags
 652   '(dolist (key '([mouse-2] [mouse-3]))
 653      (define-key gtags-mode-map key nil)))
 654
 655 ;; Backup file handling.
 656
 657 (defvar mdw-backup-disable-regexps nil
 658   "*List of regular expressions: if a file name matches any of
 659 these then the file is not backed up.")
 660
 661 (defun mdw-backup-enable-predicate (name)
 662   "[mdw]'s default backup predicate.
 663 Allows a backup if the standard predicate would allow it, and it
 664 doesn't match any of the regular expressions in
 665 `mdw-backup-disable-regexps'."
 666   (and (normal-backup-enable-predicate name)
 667        (let ((answer t) (list mdw-backup-disable-regexps))
 668          (save-match-data
 669            (while list
 670              (if (string-match (car list) name)
 671                  (setq answer nil))
 672              (setq list (cdr list)))
 673            answer))))
 674 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 675
 676 ;;;--------------------------------------------------------------------------
 677 ;;; General fontification.
 678
 679 (defmacro mdw-define-face (name &rest body)
 680   "Define a face, and make sure it's actually set as the definition."
 681   (declare (indent 1)
 682            (debug 0))
 683   `(progn
 684      (make-face ',name)
 685      (defvar ,name ',name)
 686      (put ',name 'face-defface-spec ',body)
 687      ))
 688
 689 (mdw-define-face default
 690   (((type w32)) :family "courier new" :height 85)
 691   (((type x)) :family "6x13" :height 130)
 692   (t :foreground "white" :background "black"))
 693 (mdw-define-face fixed-pitch
 694   (((type w32)) :family "courier new" :height 85)
 695   (((type x)) :family "6x13" :height 130)
 696   (t :foreground "white" :background "black"))
 697 (mdw-define-face region
 698   (((type tty)) :background "blue") (t :background "grey30"))
 699 (mdw-define-face minibuffer-prompt
 700   (t :weight bold))
 701 (mdw-define-face mode-line
 702   (t :foreground "blue" :background "yellow"
 703      :box (:line-width 1 :style released-button)))
 704 (mdw-define-face mode-line-inactive
 705   (t :foreground "yellow" :background "blue"
 706      :box (:line-width 1 :style released-button)))
 707 (mdw-define-face scroll-bar
 708   (t :foreground "black" :background "lightgrey"))
 709 (mdw-define-face fringe
 710   (t :foreground "yellow"))
 711 (mdw-define-face show-paren-match-face
 712   (t :background "darkgreen"))
 713 (mdw-define-face show-paren-mismatch-face
 714   (t :background "red"))
 715 (mdw-define-face highlight
 716   (t :background "DarkSeaGreen4"))
 717
 718 (mdw-define-face holiday-face
 719   (t :background "red"))
 720 (mdw-define-face calendar-today-face
 721   (t :foreground "yellow" :weight bold))
 722
 723 (mdw-define-face comint-highlight-prompt
 724   (t :weight bold))
 725 (mdw-define-face comint-highlight-input
 726   (t :slant italic))
 727
 728 (mdw-define-face trailing-whitespace
 729   (t :background "red"))
 730 (mdw-define-face mdw-punct-face
 731   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 732 (mdw-define-face mdw-number-face
 733   (t :foreground "yellow"))
 734 (mdw-define-face font-lock-function-name-face
 735   (t :weight bold))
 736 (mdw-define-face font-lock-keyword-face
 737   (t :weight bold))
 738 (mdw-define-face font-lock-constant-face
 739   (t :slant italic))
 740 (mdw-define-face font-lock-builtin-face
 741   (t :weight bold))
 742 (mdw-define-face font-lock-reference-face
 743   (t :weight bold))
 744 (mdw-define-face font-lock-variable-name-face
 745   (t :slant italic))
 746 (mdw-define-face font-lock-comment-delimiter-face
 747   (default :slant italic)
 748   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 749 (mdw-define-face font-lock-comment-face
 750   (default :slant italic)
 751   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 752 (mdw-define-face font-lock-string-face
 753   (t :foreground "SkyBlue1"))
 754
 755 (mdw-define-face message-separator
 756   (t :background "red" :foreground "white" :weight bold))
 757 (mdw-define-face message-cited-text
 758   (default :slant italic)
 759   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 760 (mdw-define-face message-header-cc
 761   (default :weight bold)
 762   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 763 (mdw-define-face message-header-newsgroups
 764   (default :weight bold)
 765   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 766 (mdw-define-face message-header-subject
 767   (default :weight bold)
 768   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 769 (mdw-define-face message-header-to
 770   (default :weight bold)
 771   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 772 (mdw-define-face message-header-xheader
 773   (default :weight bold)
 774   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 775 (mdw-define-face message-header-other
 776   (default :weight bold)
 777   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 778 (mdw-define-face message-header-name
 779   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 780
 781 (mdw-define-face diff-index
 782   (t :weight bold))
 783 (mdw-define-face diff-file-header
 784   (t :weight bold))
 785 (mdw-define-face diff-hunk-header
 786   (t :foreground "SkyBlue1"))
 787 (mdw-define-face diff-function
 788   (t :foreground "SkyBlue1" :weight bold))
 789 (mdw-define-face diff-header
 790   (t :background "grey10"))
 791 (mdw-define-face diff-added
 792   (t :foreground "green"))
 793 (mdw-define-face diff-removed
 794   (t :foreground "red"))
 795 (mdw-define-face diff-context)
 796
 797 (mdw-define-face woman-bold
 798   (t :weight bold))
 799 (mdw-define-face woman-italic
 800   (t :slant italic))
 801
 802 (mdw-define-face p4-depot-added-face
 803   (t :foreground "green"))
 804 (mdw-define-face p4-depot-branch-op-face
 805   (t :foreground "yellow"))
 806 (mdw-define-face p4-depot-deleted-face
 807   (t :foreground "red"))
 808 (mdw-define-face p4-depot-unmapped-face
 809   (t :foreground "SkyBlue1"))
 810 (mdw-define-face p4-diff-change-face
 811   (t :foreground "yellow"))
 812 (mdw-define-face p4-diff-del-face
 813   (t :foreground "red"))
 814 (mdw-define-face p4-diff-file-face
 815   (t :foreground "SkyBlue1"))
 816 (mdw-define-face p4-diff-head-face
 817   (t :background "grey10"))
 818 (mdw-define-face p4-diff-ins-face
 819   (t :foreground "green"))
 820
 821 (mdw-define-face whizzy-slice-face
 822   (t :background "grey10"))
 823 (mdw-define-face whizzy-error-face
 824   (t :background "darkred"))
 825
 826 ;;;--------------------------------------------------------------------------
 827 ;;; C programming configuration.
 828
 829 ;; Linux kernel hacking.
 830
 831 (defvar linux-c-mode-hook)
 832
 833 (defun linux-c-mode ()
 834   (interactive)
 835   (c-mode)
 836   (setq major-mode 'linux-c-mode)
 837   (setq mode-name "Linux C")
 838   (run-hooks 'linux-c-mode-hook))
 839
 840 ;; Make C indentation nice.
 841
 842 (defun mdw-c-lineup-arglist (langelem)
 843   "Hack for DWIMmery in c-lineup-arglist."
 844   (if (save-excursion
 845         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
 846       0
 847     (c-lineup-arglist langelem)))
 848
 849 (defun mdw-c-indent-extern-mumble (langelem)
 850   "Indent `extern \"...\" {' lines."
 851   (save-excursion
 852     (back-to-indentation)
 853     (if (looking-at
 854          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
 855         c-basic-offset
 856       nil)))
 857
 858 (defun mdw-c-style ()
 859   (c-add-style "[mdw] C and C++ style"
 860                '((c-basic-offset . 2)
 861                  (comment-column . 40)
 862                  (c-class-key . "class")
 863                  (c-backslash-column . 72)
 864                  (c-offsets-alist
 865                   (substatement-open . (add 0 c-indent-one-line-block))
 866                   (defun-open . (add 0 c-indent-one-line-block))
 867                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
 868                   (topmost-intro . mdw-c-indent-extern-mumble)
 869                   (cpp-define-intro . 0)
 870                   (inextern-lang . [0])
 871                   (label . 0)
 872                   (case-label . +)
 873                   (access-label . -)
 874                   (inclass . +)
 875                   (inline-open . ++)
 876                   (statement-cont . 0)
 877                   (statement-case-intro . +)))
 878                t))
 879
 880 (defvar mdw-c-comment-fill-prefix
 881   `((,(concat "\\([ \t]*/?\\)"
 882               "\\(\*\\|//]\\)"
 883               "\\([ \t]*\\)"
 884               "\\([A-Za-z]+:[ \t]*\\)?"
 885               mdw-hanging-indents)
 886      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
 887   "Fill prefix matching C comments (both kinds).")
 888
 889 (defun mdw-fontify-c-and-c++ ()
 890
 891   ;; Fiddle with some syntax codes.
 892   (modify-syntax-entry ?* ". 23")
 893   (modify-syntax-entry ?/ ". 124b")
 894   (modify-syntax-entry ?\n "> b")
 895
 896   ;; Other stuff.
 897   (mdw-c-style)
 898   (setq c-hanging-comment-ender-p nil)
 899   (setq c-backslash-column 72)
 900   (setq c-label-minimum-indentation 0)
 901   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
 902
 903   ;; Now define things to be fontified.
 904   (make-local-variable 'font-lock-keywords)
 905   (let ((c-keywords
 906          (mdw-regexps "and"             ;C++
 907                       "and_eq"          ;C++
 908                       "asm"             ;K&R, GCC
 909                       "auto"            ;K&R, C89
 910                       "bitand"          ;C++
 911                       "bitor"           ;C++
 912                       "bool"            ;C++, C9X macro
 913                       "break"           ;K&R, C89
 914                       "case"            ;K&R, C89
 915                       "catch"           ;C++
 916                       "char"            ;K&R, C89
 917                       "class"           ;C++
 918                       "complex"         ;C9X macro, C++ template type
 919                       "compl"           ;C++
 920                       "const"           ;C89
 921                       "const_cast"      ;C++
 922                       "continue"        ;K&R, C89
 923                       "defined"         ;C89 preprocessor
 924                       "default"         ;K&R, C89
 925                       "delete"          ;C++
 926                       "do"              ;K&R, C89
 927                       "double"          ;K&R, C89
 928                       "dynamic_cast"    ;C++
 929                       "else"            ;K&R, C89
 930                       ;; "entry"        ;K&R -- never used
 931                       "enum"            ;C89
 932                       "explicit"        ;C++
 933                       "export"          ;C++
 934                       "extern"          ;K&R, C89
 935                       "false"           ;C++, C9X macro
 936                       "float"           ;K&R, C89
 937                       "for"             ;K&R, C89
 938                       ;; "fortran"      ;K&R
 939                       "friend"          ;C++
 940                       "goto"            ;K&R, C89
 941                       "if"              ;K&R, C89
 942                       "imaginary"       ;C9X macro
 943                       "inline"          ;C++, C9X, GCC
 944                       "int"             ;K&R, C89
 945                       "long"            ;K&R, C89
 946                       "mutable"         ;C++
 947                       "namespace"       ;C++
 948                       "new"             ;C++
 949                       "operator"        ;C++
 950                       "or"              ;C++
 951                       "or_eq"           ;C++
 952                       "private"         ;C++
 953                       "protected"       ;C++
 954                       "public"          ;C++
 955                       "register"        ;K&R, C89
 956                       "reinterpret_cast" ;C++
 957                       "restrict"         ;C9X
 958                       "return"           ;K&R, C89
 959                       "short"            ;K&R, C89
 960                       "signed"           ;C89
 961                       "sizeof"           ;K&R, C89
 962                       "static"           ;K&R, C89
 963                       "static_cast"      ;C++
 964                       "struct"           ;K&R, C89
 965                       "switch"           ;K&R, C89
 966                       "template"         ;C++
 967                       "this"             ;C++
 968                       "throw"            ;C++
 969                       "true"             ;C++, C9X macro
 970                       "try"              ;C++
 971                       "this"             ;C++
 972                       "typedef"          ;C89
 973                       "typeid"           ;C++
 974                       "typeof"           ;GCC
 975                       "typename"         ;C++
 976                       "union"            ;K&R, C89
 977                       "unsigned"         ;K&R, C89
 978                       "using"            ;C++
 979                       "virtual"          ;C++
 980                       "void"             ;C89
 981                       "volatile"         ;C89
 982                       "wchar_t"          ;C++, C89 library type
 983                       "while"            ;K&R, C89
 984                       "xor"              ;C++
 985                       "xor_eq"           ;C++
 986                       "_Bool"            ;C9X
 987                       "_Complex"         ;C9X
 988                       "_Imaginary"       ;C9X
 989                       "_Pragma"          ;C9X preprocessor
 990                       "__alignof__"      ;GCC
 991                       "__asm__"          ;GCC
 992                       "__attribute__"    ;GCC
 993                       "__complex__"      ;GCC
 994                       "__const__"        ;GCC
 995                       "__extension__"    ;GCC
 996                       "__imag__"         ;GCC
 997                       "__inline__"       ;GCC
 998                       "__label__"        ;GCC
 999                       "__real__"         ;GCC
1000                       "__signed__"       ;GCC
1001                       "__typeof__"       ;GCC
1002                       "__volatile__"     ;GCC
1003                       ))
1004         (preprocessor-keywords
1005          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1006                       "ident" "if" "ifdef" "ifndef" "import" "include"
1007                       "line" "pragma" "unassert" "undef" "warning"))
1008         (objc-keywords
1009          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1010                       "interface" "private" "protected" "protocol" "public"
1011                       "selector")))
1012
1013     (setq font-lock-keywords
1014           (list
1015
1016            ;; Fontify include files as strings.
1017            (list (concat "^[ \t]*\\#[ \t]*"
1018                          "\\(include\\|import\\)"
1019                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1020                  '(2 font-lock-string-face))
1021
1022            ;; Preprocessor directives are `references'?.
1023            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1024                          preprocessor-keywords
1025                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1026                  '(1 font-lock-keyword-face))
1027
1028            ;; Handle the keywords defined above.
1029            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1030                  '(0 font-lock-keyword-face))
1031
1032            (list (concat "\\<\\(" c-keywords "\\)\\>")
1033                  '(0 font-lock-keyword-face))
1034
1035            ;; Handle numbers too.
1036            ;;
1037            ;; This looks strange, I know.  It corresponds to the
1038            ;; preprocessor's idea of what a number looks like, rather than
1039            ;; anything sensible.
1040            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1041                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1042                  '(0 mdw-number-face))
1043
1044            ;; And anything else is punctuation.
1045            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1046                  '(0 mdw-punct-face))))))
1047
1048 ;;;--------------------------------------------------------------------------
1049 ;;; AP calc mode.
1050
1051 (defun apcalc-mode ()
1052   (interactive)
1053   (c-mode)
1054   (setq major-mode 'apcalc-mode)
1055   (setq mode-name "AP Calc")
1056   (run-hooks 'apcalc-mode-hook))
1057
1058 (defun mdw-fontify-apcalc ()
1059
1060   ;; Fiddle with some syntax codes.
1061   (modify-syntax-entry ?* ". 23")
1062   (modify-syntax-entry ?/ ". 14")
1063
1064   ;; Other stuff.
1065   (mdw-c-style)
1066   (setq c-hanging-comment-ender-p nil)
1067   (setq c-backslash-column 72)
1068   (setq comment-start "/* ")
1069   (setq comment-end " */")
1070   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1071
1072   ;; Now define things to be fontified.
1073   (make-local-variable 'font-lock-keywords)
1074   (let ((c-keywords
1075          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1076                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1077                       "local" "mat" "obj" "print" "quit" "read" "return"
1078                       "show" "static" "switch" "while" "write")))
1079
1080     (setq font-lock-keywords
1081           (list
1082
1083            ;; Handle the keywords defined above.
1084            (list (concat "\\<\\(" c-keywords "\\)\\>")
1085                  '(0 font-lock-keyword-face))
1086
1087            ;; Handle numbers too.
1088            ;;
1089            ;; This looks strange, I know.  It corresponds to the
1090            ;; preprocessor's idea of what a number looks like, rather than
1091            ;; anything sensible.
1092            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1093                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1094                  '(0 mdw-number-face))
1095
1096            ;; And anything else is punctuation.
1097            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1098                  '(0 mdw-punct-face))))))
1099
1100 ;;;--------------------------------------------------------------------------
1101 ;;; Java programming configuration.
1102
1103 ;; Make indentation nice.
1104
1105 (defun mdw-java-style ()
1106   (c-add-style "[mdw] Java style"
1107                '((c-basic-offset . 2)
1108                  (c-offsets-alist (substatement-open . 0)
1109                                   (label . +)
1110                                   (case-label . +)
1111                                   (access-label . 0)
1112                                   (inclass . +)
1113                                   (statement-case-intro . +)))
1114                t))
1115
1116 ;; Declare Java fontification style.
1117
1118 (defun mdw-fontify-java ()
1119
1120   ;; Other stuff.
1121   (mdw-java-style)
1122   (setq c-hanging-comment-ender-p nil)
1123   (setq c-backslash-column 72)
1124   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1125
1126   ;; Now define things to be fontified.
1127   (make-local-variable 'font-lock-keywords)
1128   (let ((java-keywords
1129          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1130                       "char" "class" "const" "continue" "default" "do"
1131                       "double" "else" "extends" "final" "finally" "float"
1132                       "for" "goto" "if" "implements" "import" "instanceof"
1133                       "int" "interface" "long" "native" "new" "package"
1134                       "private" "protected" "public" "return" "short"
1135                       "static" "super" "switch" "synchronized" "this"
1136                       "throw" "throws" "transient" "try" "void" "volatile"
1137                       "while"
1138
1139                       "false" "null" "true")))
1140
1141     (setq font-lock-keywords
1142           (list
1143
1144            ;; Handle the keywords defined above.
1145            (list (concat "\\<\\(" java-keywords "\\)\\>")
1146                  '(0 font-lock-keyword-face))
1147
1148            ;; Handle numbers too.
1149            ;;
1150            ;; The following isn't quite right, but it's close enough.
1151            (list (concat "\\<\\("
1152                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1153                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1154                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1155                          "[lLfFdD]?")
1156                  '(0 mdw-number-face))
1157
1158            ;; And anything else is punctuation.
1159            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1160                  '(0 mdw-punct-face))))))
1161
1162 ;;;--------------------------------------------------------------------------
1163 ;;; C# programming configuration.
1164
1165 ;; Make indentation nice.
1166
1167 (defun mdw-csharp-style ()
1168   (c-add-style "[mdw] C# style"
1169                '((c-basic-offset . 2)
1170                  (c-offsets-alist (substatement-open . 0)
1171                                   (label . 0)
1172                                   (case-label . +)
1173                                   (access-label . 0)
1174                                   (inclass . +)
1175                                   (statement-case-intro . +)))
1176                t))
1177
1178 ;; Declare C# fontification style.
1179
1180 (defun mdw-fontify-csharp ()
1181
1182   ;; Other stuff.
1183   (mdw-csharp-style)
1184   (setq c-hanging-comment-ender-p nil)
1185   (setq c-backslash-column 72)
1186   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1187
1188   ;; Now define things to be fontified.
1189   (make-local-variable 'font-lock-keywords)
1190   (let ((csharp-keywords
1191          (mdw-regexps "abstract" "as" "base" "bool" "break"
1192                       "byte" "case" "catch" "char" "checked"
1193                       "class" "const" "continue" "decimal" "default"
1194                       "delegate" "do" "double" "else" "enum"
1195                       "event" "explicit" "extern" "false" "finally"
1196                       "fixed" "float" "for" "foreach" "goto"
1197                       "if" "implicit" "in" "int" "interface"
1198                       "internal" "is" "lock" "long" "namespace"
1199                       "new" "null" "object" "operator" "out"
1200                       "override" "params" "private" "protected" "public"
1201                       "readonly" "ref" "return" "sbyte" "sealed"
1202                       "short" "sizeof" "stackalloc" "static" "string"
1203                       "struct" "switch" "this" "throw" "true"
1204                       "try" "typeof" "uint" "ulong" "unchecked"
1205                       "unsafe" "ushort" "using" "virtual" "void"
1206                       "volatile" "while" "yield")))
1207
1208     (setq font-lock-keywords
1209           (list
1210
1211            ;; Handle the keywords defined above.
1212            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1213                  '(0 font-lock-keyword-face))
1214
1215            ;; Handle numbers too.
1216            ;;
1217            ;; The following isn't quite right, but it's close enough.
1218            (list (concat "\\<\\("
1219                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1220                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1221                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1222                          "[lLfFdD]?")
1223                  '(0 mdw-number-face))
1224
1225            ;; And anything else is punctuation.
1226            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1227                  '(0 mdw-punct-face))))))
1228
1229 (define-derived-mode csharp-mode java-mode "C#"
1230   "Major mode for editing C# code.")
1231
1232 ;;;--------------------------------------------------------------------------
1233 ;;; Awk programming configuration.
1234
1235 ;; Make Awk indentation nice.
1236
1237 (defun mdw-awk-style ()
1238   (c-add-style "[mdw] Awk style"
1239                '((c-basic-offset . 2)
1240                  (c-offsets-alist (substatement-open . 0)
1241                                   (statement-cont . 0)
1242                                   (statement-case-intro . +)))
1243                t))
1244
1245 ;; Declare Awk fontification style.
1246
1247 (defun mdw-fontify-awk ()
1248
1249   ;; Miscellaneous fiddling.
1250   (mdw-awk-style)
1251   (setq c-backslash-column 72)
1252   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1253
1254   ;; Now define things to be fontified.
1255   (make-local-variable 'font-lock-keywords)
1256   (let ((c-keywords
1257          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1258                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1259                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1260                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1261                       "atan2" "break" "close" "continue" "cos" "delete"
1262                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1263                       "function" "gensub" "getline" "gsub" "if" "in"
1264                       "index" "int" "length" "log" "match" "next" "rand"
1265                       "return" "print" "printf" "sin" "split" "sprintf"
1266                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1267                       "systime" "tolower" "toupper" "while")))
1268
1269     (setq font-lock-keywords
1270           (list
1271
1272            ;; Handle the keywords defined above.
1273            (list (concat "\\<\\(" c-keywords "\\)\\>")
1274                  '(0 font-lock-keyword-face))
1275
1276            ;; Handle numbers too.
1277            ;;
1278            ;; The following isn't quite right, but it's close enough.
1279            (list (concat "\\<\\("
1280                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1281                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1282                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1283                          "[uUlL]*")
1284                  '(0 mdw-number-face))
1285
1286            ;; And anything else is punctuation.
1287            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1288                  '(0 mdw-punct-face))))))
1289
1290 ;;;--------------------------------------------------------------------------
1291 ;;; Perl programming style.
1292
1293 ;; Perl indentation style.
1294
1295 (setq cperl-indent-level 2)
1296 (setq cperl-continued-statement-offset 2)
1297 (setq cperl-continued-brace-offset 0)
1298 (setq cperl-brace-offset -2)
1299 (setq cperl-brace-imaginary-offset 0)
1300 (setq cperl-label-offset 0)
1301
1302 ;; Define perl fontification style.
1303
1304 (defun mdw-fontify-perl ()
1305
1306   ;; Miscellaneous fiddling.
1307   (modify-syntax-entry ?$ "\\")
1308   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1309   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1310
1311   ;; Now define fontification things.
1312   (make-local-variable 'font-lock-keywords)
1313   (let ((perl-keywords
1314          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1315                       "for" "foreach" "ge" "gt" "goto" "if"
1316                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1317                       "package" "redo" "require" "return" "sub"
1318                       "undef" "unless" "until" "use" "while")))
1319
1320     (setq font-lock-keywords
1321           (list
1322
1323            ;; Set up the keywords defined above.
1324            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1325                  '(0 font-lock-keyword-face))
1326
1327            ;; At least numbers are simpler than C.
1328            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1329                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1330                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1331                  '(0 mdw-number-face))
1332
1333            ;; And anything else is punctuation.
1334            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1335                  '(0 mdw-punct-face))))))
1336
1337 (defun perl-number-tests (&optional arg)
1338   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1339 strip numbers instead."
1340   (interactive "P")
1341   (save-excursion
1342     (goto-char (point-min))
1343     (let ((i 0) (fmt (if arg "" " %4d")))
1344       (while (search-forward "#t" nil t)
1345         (delete-region (point) (line-end-position))
1346         (setq i (1+ i))
1347         (insert (format fmt i)))
1348       (goto-char (point-min))
1349       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1350           (replace-match (format "\\1%d" i))))))
1351
1352 ;;;--------------------------------------------------------------------------
1353 ;;; Python programming style.
1354
1355 (defun mdw-fontify-pythonic (keywords)
1356
1357   ;; Miscellaneous fiddling.
1358   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1359
1360   ;; Now define fontification things.
1361   (make-local-variable 'font-lock-keywords)
1362   (setq font-lock-keywords
1363         (list
1364
1365          ;; Set up the keywords defined above.
1366          (list (concat "\\<\\(" keywords "\\)\\>")
1367                '(0 font-lock-keyword-face))
1368
1369          ;; At least numbers are simpler than C.
1370          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1371                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1372                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1373                '(0 mdw-number-face))
1374
1375          ;; And anything else is punctuation.
1376          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1377                '(0 mdw-punct-face)))))
1378
1379 ;; Define Python fontification styles.
1380
1381 (defun mdw-fontify-python ()
1382   (mdw-fontify-pythonic
1383    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1384                 "del" "elif" "else" "except" "exec" "finally" "for"
1385                 "from" "global" "if" "import" "in" "is" "lambda"
1386                 "not" "or" "pass" "print" "raise" "return" "try"
1387                 "while" "with" "yield")))
1388
1389 (defun mdw-fontify-pyrex ()
1390   (mdw-fontify-pythonic
1391    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1392                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1393                 "extern" "finally" "for" "from" "global" "if"
1394                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1395                 "raise" "return" "struct" "try" "while" "with"
1396                 "yield")))
1397
1398 ;;;--------------------------------------------------------------------------
1399 ;;; Icon programming style.
1400
1401 ;; Icon indentation style.
1402
1403 (setq icon-brace-offset 0
1404       icon-continued-brace-offset 0
1405       icon-continued-statement-offset 2
1406       icon-indent-level 2)
1407
1408 ;; Define Icon fontification style.
1409
1410 (defun mdw-fontify-icon ()
1411
1412   ;; Miscellaneous fiddling.
1413   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1414
1415   ;; Now define fontification things.
1416   (make-local-variable 'font-lock-keywords)
1417   (let ((icon-keywords
1418          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1419                       "end" "every" "fail" "global" "if" "initial"
1420                       "invocable" "link" "local" "next" "not" "of"
1421                       "procedure" "record" "repeat" "return" "static"
1422                       "suspend" "then" "to" "until" "while"))
1423         (preprocessor-keywords
1424          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1425                       "include" "line" "undef")))
1426     (setq font-lock-keywords
1427           (list
1428
1429            ;; Set up the keywords defined above.
1430            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1431                  '(0 font-lock-keyword-face))
1432
1433            ;; The things that Icon calls keywords.
1434            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1435
1436            ;; At least numbers are simpler than C.
1437            (list (concat "\\<[0-9]+"
1438                          "\\([rR][0-9a-zA-Z]+\\|"
1439                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1440                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1441                  '(0 mdw-number-face))
1442
1443            ;; Preprocessor.
1444            (list (concat "^[ \t]*$[ \t]*\\<\\("
1445                          preprocessor-keywords
1446                          "\\)\\>")
1447                  '(0 font-lock-keyword-face))
1448
1449            ;; And anything else is punctuation.
1450            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1451                  '(0 mdw-punct-face))))))
1452
1453 ;;;--------------------------------------------------------------------------
1454 ;;; ARM assembler programming configuration.
1455
1456 ;; There doesn't appear to be an Emacs mode for this yet.
1457 ;;
1458 ;; Better do something about that, I suppose.
1459
1460 (defvar arm-assembler-mode-map nil)
1461 (defvar arm-assembler-abbrev-table nil)
1462 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1463
1464 (or arm-assembler-mode-map
1465     (progn
1466       (setq arm-assembler-mode-map (make-sparse-keymap))
1467       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1468       (define-key arm-assembler-mode-map [C-return] 'newline)
1469       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1470
1471 (defun arm-assembler-mode ()
1472   "Major mode for ARM assembler programs"
1473   (interactive)
1474
1475   ;; Do standard major mode things.
1476   (kill-all-local-variables)
1477   (use-local-map arm-assembler-mode-map)
1478   (setq local-abbrev-table arm-assembler-abbrev-table)
1479   (setq major-mode 'arm-assembler-mode)
1480   (setq mode-name "ARM assembler")
1481
1482   ;; Set up syntax table.
1483   (set-syntax-table arm-assembler-mode-syntax-table)
1484   (modify-syntax-entry ?;   ; Nasty hack
1485                        "<" arm-assembler-mode-syntax-table)
1486   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1487   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1488
1489   (make-local-variable 'comment-start)
1490   (setq comment-start ";")
1491   (make-local-variable 'comment-end)
1492   (setq comment-end "")
1493   (make-local-variable 'comment-column)
1494   (setq comment-column 48)
1495   (make-local-variable 'comment-start-skip)
1496   (setq comment-start-skip ";+[ \t]*")
1497
1498   ;; Play with indentation.
1499   (make-local-variable 'indent-line-function)
1500   (setq indent-line-function 'indent-relative-maybe)
1501
1502   ;; Set fill prefix.
1503   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1504
1505   ;; Fiddle with fontification.
1506   (make-local-variable 'font-lock-keywords)
1507   (setq font-lock-keywords
1508         (list
1509
1510          ;; Handle numbers too.
1511          ;;
1512          ;; The following isn't quite right, but it's close enough.
1513          (list (concat "\\("
1514                        "&[0-9a-fA-F]+\\|"
1515                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1516                        "\\)")
1517                '(0 mdw-number-face))
1518
1519          ;; Do something about operators.
1520          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1521                '(1 font-lock-keyword-face)
1522                '(2 font-lock-string-face))
1523          (list ":[a-zA-Z]+:"
1524                '(0 font-lock-keyword-face))
1525
1526          ;; Do menemonics and directives.
1527          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1528                '(1 font-lock-keyword-face))
1529
1530          ;; And anything else is punctuation.
1531          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1532                '(0 mdw-punct-face))))
1533
1534   (run-hooks 'arm-assembler-mode-hook))
1535
1536 ;;;--------------------------------------------------------------------------
1537 ;;; Assembler mode.
1538
1539 (defun mdw-fontify-asm ()
1540   (modify-syntax-entry ?' "\"")
1541   (modify-syntax-entry ?. "w")
1542   (setf fill-prefix nil)
1543   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1544
1545 ;;;--------------------------------------------------------------------------
1546 ;;; TCL configuration.
1547
1548 (defun mdw-fontify-tcl ()
1549   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1550   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1551   (make-local-variable 'font-lock-keywords)
1552   (setq font-lock-keywords
1553         (list
1554          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1555                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1556                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1557                '(0 mdw-number-face))
1558          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1559                '(0 mdw-punct-face)))))
1560
1561 ;;;--------------------------------------------------------------------------
1562 ;;; REXX configuration.
1563
1564 (defun mdw-rexx-electric-* ()
1565   (interactive)
1566   (insert ?*)
1567   (rexx-indent-line))
1568
1569 (defun mdw-rexx-indent-newline-indent ()
1570   (interactive)
1571   (rexx-indent-line)
1572   (if abbrev-mode (expand-abbrev))
1573   (newline-and-indent))
1574
1575 (defun mdw-fontify-rexx ()
1576
1577   ;; Various bits of fiddling.
1578   (setq mdw-auto-indent nil)
1579   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1580   (local-set-key [?*] 'mdw-rexx-electric-*)
1581   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1582           '(?! ?? ?# ?@ ?$))
1583   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1584
1585   ;; Set up keywords and things for fontification.
1586   (make-local-variable 'font-lock-keywords-case-fold-search)
1587   (setq font-lock-keywords-case-fold-search t)
1588
1589   (setq rexx-indent 2)
1590   (setq rexx-end-indent rexx-indent)
1591   (setq rexx-cont-indent rexx-indent)
1592
1593   (make-local-variable 'font-lock-keywords)
1594   (let ((rexx-keywords
1595          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1596                       "else" "end" "engineering" "exit" "expose" "for"
1597                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1598                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1599                       "options" "otherwise" "parse" "procedure" "pull"
1600                       "push" "queue" "return" "say" "select" "signal"
1601                       "scientific" "source" "then" "trace" "to" "until"
1602                       "upper" "value" "var" "version" "when" "while"
1603                       "with"
1604
1605                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1606                       "center" "center" "charin" "charout" "chars"
1607                       "compare" "condition" "copies" "c2d" "c2x"
1608                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1609                       "errortext" "format" "fuzz" "insert" "lastpos"
1610                       "left" "length" "lineout" "lines" "max" "min"
1611                       "overlay" "pos" "queued" "random" "reverse" "right"
1612                       "sign" "sourceline" "space" "stream" "strip"
1613                       "substr" "subword" "symbol" "time" "translate"
1614                       "trunc" "value" "verify" "word" "wordindex"
1615                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1616                       "x2d")))
1617
1618     (setq font-lock-keywords
1619           (list
1620
1621            ;; Set up the keywords defined above.
1622            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1623                  '(0 font-lock-keyword-face))
1624
1625            ;; Fontify all symbols the same way.
1626            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1627                          "[A-Za-z0-9.!?_#@$]+\\)")
1628                  '(0 font-lock-variable-name-face))
1629
1630            ;; And everything else is punctuation.
1631            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1632                  '(0 mdw-punct-face))))))
1633
1634 ;;;--------------------------------------------------------------------------
1635 ;;; Standard ML programming style.
1636
1637 (defun mdw-fontify-sml ()
1638
1639   ;; Make underscore an honorary letter.
1640   (modify-syntax-entry ?' "w")
1641
1642   ;; Set fill prefix.
1643   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1644
1645   ;; Now define fontification things.
1646   (make-local-variable 'font-lock-keywords)
1647   (let ((sml-keywords
1648          (mdw-regexps "abstype" "and" "andalso" "as"
1649                       "case"
1650                       "datatype" "do"
1651                       "else" "end" "eqtype" "exception"
1652                       "fn" "fun" "functor"
1653                       "handle"
1654                       "if" "in" "include" "infix" "infixr"
1655                       "let" "local"
1656                       "nonfix"
1657                       "of" "op" "open" "orelse"
1658                       "raise" "rec"
1659                       "sharing" "sig" "signature" "struct" "structure"
1660                       "then" "type"
1661                       "val"
1662                       "where" "while" "with" "withtype")))
1663
1664     (setq font-lock-keywords
1665           (list
1666
1667            ;; Set up the keywords defined above.
1668            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1669                  '(0 font-lock-keyword-face))
1670
1671            ;; At least numbers are simpler than C.
1672            (list (concat "\\<\\(\\~\\|\\)"
1673                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1674                                    "[wW][0-9]+\\)\\|"
1675                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1676                                          "\\([eE]\\(\\~\\|\\)"
1677                                                 "[0-9]+\\|\\)\\)\\)")
1678                  '(0 mdw-number-face))
1679
1680            ;; And anything else is punctuation.
1681            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1682                  '(0 mdw-punct-face))))))
1683
1684 ;;;--------------------------------------------------------------------------
1685 ;;; Haskell configuration.
1686
1687 (defun mdw-fontify-haskell ()
1688
1689   ;; Fiddle with syntax table to get comments right.
1690   (modify-syntax-entry ?' "\"")
1691   (modify-syntax-entry ?- ". 123")
1692   (modify-syntax-entry ?{ ". 1b")
1693   (modify-syntax-entry ?} ". 4b")
1694   (modify-syntax-entry ?\n ">")
1695
1696   ;; Set fill prefix.
1697   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1698
1699   ;; Fiddle with fontification.
1700   (make-local-variable 'font-lock-keywords)
1701   (let ((haskell-keywords
1702          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1703                       "deriving" "do" "else" "foreign" "hiding" "if"
1704                       "import" "in" "infix" "infixl" "infixr" "instance"
1705                       "let" "module" "newtype" "of" "qualified" "safe"
1706                       "stdcall" "then" "type" "unsafe" "where")))
1707
1708     (setq font-lock-keywords
1709           (list
1710            (list "--.*$"
1711                  '(0 font-lock-comment-face))
1712            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1713                  '(0 font-lock-keyword-face))
1714            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1715                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1716                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1717                  '(0 mdw-number-face))
1718            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1719                  '(0 mdw-punct-face))))))
1720
1721 ;;;--------------------------------------------------------------------------
1722 ;;; Erlang configuration.
1723
1724 (setq erlang-electric-commannds
1725       '(erlang-electric-newline erlang-electric-semicolon))
1726
1727 (defun mdw-fontify-erlang ()
1728
1729   ;; Set fill prefix.
1730   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1731
1732   ;; Fiddle with fontification.
1733   (make-local-variable 'font-lock-keywords)
1734   (let ((erlang-keywords
1735          (mdw-regexps "after" "and" "andalso"
1736                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1737                       "case" "catch" "cond"
1738                       "div" "end" "fun" "if" "let" "not"
1739                       "of" "or" "orelse"
1740                       "query" "receive" "rem" "try" "when" "xor")))
1741
1742     (setq font-lock-keywords
1743           (list
1744            (list "%.*$"
1745                  '(0 font-lock-comment-face))
1746            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1747                  '(0 font-lock-keyword-face))
1748            (list (concat "^-\\sw+\\>")
1749                  '(0 font-lock-keyword-face))
1750            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1751                  '(0 mdw-number-face))
1752            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1753                  '(0 mdw-punct-face))))))
1754
1755 ;;;--------------------------------------------------------------------------
1756 ;;; Texinfo configuration.
1757
1758 (defun mdw-fontify-texinfo ()
1759
1760   ;; Set fill prefix.
1761   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1762
1763   ;; Real fontification things.
1764   (make-local-variable 'font-lock-keywords)
1765   (setq font-lock-keywords
1766         (list
1767
1768          ;; Environment names are keywords.
1769          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1770                '(2 font-lock-keyword-face))
1771
1772          ;; Unmark escaped magic characters.
1773          (list "\\(@\\)\\([@{}]\\)"
1774                '(1 font-lock-keyword-face)
1775                '(2 font-lock-variable-name-face))
1776
1777          ;; Make sure we get comments properly.
1778          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1779                '(0 font-lock-comment-face))
1780
1781          ;; Command names are keywords.
1782          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1783                '(0 font-lock-keyword-face))
1784
1785          ;; Fontify TeX special characters as punctuation.
1786          (list "[{}]+"
1787                '(0 mdw-punct-face)))))
1788
1789 ;;;--------------------------------------------------------------------------
1790 ;;; TeX and LaTeX configuration.
1791
1792 (defun mdw-fontify-tex ()
1793   (setq ispell-parser 'tex)
1794   (turn-on-reftex)
1795
1796   ;; Don't make maths into a string.
1797   (modify-syntax-entry ?$ ".")
1798   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1799   (local-set-key [?$] 'self-insert-command)
1800
1801   ;; Set fill prefix.
1802   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1803
1804   ;; Real fontification things.
1805   (make-local-variable 'font-lock-keywords)
1806   (setq font-lock-keywords
1807         (list
1808
1809          ;; Environment names are keywords.
1810          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1811                        "{\\([^}\n]*\\)}")
1812                '(2 font-lock-keyword-face))
1813
1814          ;; Suspended environment names are keywords too.
1815          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1816                        "{\\([^}\n]*\\)}")
1817                '(3 font-lock-keyword-face))
1818
1819          ;; Command names are keywords.
1820          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1821                '(0 font-lock-keyword-face))
1822
1823          ;; Handle @/.../ for italics.
1824          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1825          ;;       '(1 font-lock-keyword-face)
1826          ;;       '(3 font-lock-keyword-face))
1827
1828          ;; Handle @*...* for boldness.
1829          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1830          ;;       '(1 font-lock-keyword-face)
1831          ;;       '(3 font-lock-keyword-face))
1832
1833          ;; Handle @`...' for literal syntax things.
1834          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1835          ;;       '(1 font-lock-keyword-face)
1836          ;;       '(3 font-lock-keyword-face))
1837
1838          ;; Handle @<...> for nonterminals.
1839          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1840          ;;       '(1 font-lock-keyword-face)
1841          ;;       '(3 font-lock-keyword-face))
1842
1843          ;; Handle other @-commands.
1844          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1845          ;;       '(0 font-lock-keyword-face))
1846
1847          ;; Make sure we get comments properly.
1848          (list "%.*"
1849                '(0 font-lock-comment-face))
1850
1851          ;; Fontify TeX special characters as punctuation.
1852          (list "[$^_{}#&]"
1853                '(0 mdw-punct-face)))))
1854
1855 ;;;--------------------------------------------------------------------------
1856 ;;; SGML hacking.
1857
1858 (defun mdw-sgml-mode ()
1859   (interactive)
1860   (sgml-mode)
1861   (mdw-standard-fill-prefix "")
1862   (make-variable-buffer-local 'sgml-delimiters)
1863   (setq sgml-delimiters
1864         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1865           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1866           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1867           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1868           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1869           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1870           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1871           "NULL" ""))
1872   (setq major-mode 'mdw-sgml-mode)
1873   (setq mode-name "[mdw] SGML")
1874   (run-hooks 'mdw-sgml-mode-hook))
1875
1876 ;;;--------------------------------------------------------------------------
1877 ;;; Shell scripts.
1878
1879 (defun mdw-setup-sh-script-mode ()
1880
1881   ;; Fetch the shell interpreter's name.
1882   (let ((shell-name sh-shell-file))
1883
1884     ;; Try reading the hash-bang line.
1885     (save-excursion
1886       (goto-char (point-min))
1887       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1888           (setq shell-name (match-string 1))))
1889
1890     ;; Now try to set the shell.
1891     ;;
1892     ;; Don't let `sh-set-shell' bugger up my script.
1893     (let ((executable-set-magic #'(lambda (s &rest r) s)))
1894       (sh-set-shell shell-name)))
1895
1896   ;; Now enable my keys and the fontification.
1897   (mdw-misc-mode-config)
1898
1899   ;; Set the indentation level correctly.
1900   (setq sh-indentation 2)
1901   (setq sh-basic-offset 2))
1902
1903 ;;;--------------------------------------------------------------------------
1904 ;;; Messages-file mode.
1905
1906 (defun messages-mode-guts ()
1907   (setq messages-mode-syntax-table (make-syntax-table))
1908   (set-syntax-table messages-mode-syntax-table)
1909   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1910   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1911   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1912   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1913   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1914   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1915   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1916   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1917   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1918   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1919   (make-local-variable 'comment-start)
1920   (make-local-variable 'comment-end)
1921   (make-local-variable 'indent-line-function)
1922   (setq indent-line-function 'indent-relative)
1923   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1924   (make-local-variable 'font-lock-defaults)
1925   (make-local-variable 'messages-mode-keywords)
1926   (let ((keywords
1927          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1928                       "export" "enum" "fixed-octetstring" "flags"
1929                       "harmless" "map" "nested" "optional"
1930                       "optional-tagged" "package" "primitive"
1931                       "primitive-nullfree" "relaxed[ \t]+enum"
1932                       "set" "table" "tagged-optional"   "union"
1933                       "variadic" "vector" "version" "version-tag")))
1934     (setq messages-mode-keywords
1935           (list
1936            (list (concat "\\<\\(" keywords "\\)\\>:")
1937                  '(0 font-lock-keyword-face))
1938            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1939            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1940              (0 font-lock-variable-name-face))
1941            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1942            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1943              (0 mdw-punct-face)))))
1944   (setq font-lock-defaults
1945         '(messages-mode-keywords nil nil nil nil))
1946   (run-hooks 'messages-file-hook))
1947
1948 (defun messages-mode ()
1949   (interactive)
1950   (fundamental-mode)
1951   (setq major-mode 'messages-mode)
1952   (setq mode-name "Messages")
1953   (messages-mode-guts)
1954   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1955   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1956   (setq comment-start "# ")
1957   (setq comment-end "")
1958   (turn-on-font-lock-if-enabled)
1959   (run-hooks 'messages-mode-hook))
1960
1961 (defun cpp-messages-mode ()
1962   (interactive)
1963   (fundamental-mode)
1964   (setq major-mode 'cpp-messages-mode)
1965   (setq mode-name "CPP Messages")
1966   (messages-mode-guts)
1967   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1968   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1969   (setq comment-start "/* ")
1970   (setq comment-end " */")
1971   (let ((preprocessor-keywords
1972          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1973                       "ident" "if" "ifdef" "ifndef" "import" "include"
1974                       "line" "pragma" "unassert" "undef" "warning")))
1975     (setq messages-mode-keywords
1976           (append (list (list (concat "^[ \t]*\\#[ \t]*"
1977                                       "\\(include\\|import\\)"
1978                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1979                               '(2 font-lock-string-face))
1980                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1981                                       preprocessor-keywords
1982                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
1983                               '(1 font-lock-keyword-face)))
1984                   messages-mode-keywords)))
1985   (turn-on-font-lock-if-enabled)
1986   (run-hooks 'cpp-messages-mode-hook))
1987
1988 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
1989 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
1990 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
1991
1992 ;;;--------------------------------------------------------------------------
1993 ;;; Messages-file mode.
1994
1995 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
1996   "Face to use for subsittution directives.")
1997 (make-face 'mallow-driver-substitution-face)
1998 (defvar mallow-driver-text-face 'mallow-driver-text-face
1999   "Face to use for body text.")
2000 (make-face 'mallow-driver-text-face)
2001
2002 (defun mallow-driver-mode ()
2003   (interactive)
2004   (fundamental-mode)
2005   (setq major-mode 'mallow-driver-mode)
2006   (setq mode-name "Mallow driver")
2007   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2008   (set-syntax-table mallow-driver-mode-syntax-table)
2009   (make-local-variable 'comment-start)
2010   (make-local-variable 'comment-end)
2011   (make-local-variable 'indent-line-function)
2012   (setq indent-line-function 'indent-relative)
2013   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2014   (make-local-variable 'font-lock-defaults)
2015   (make-local-variable 'mallow-driver-mode-keywords)
2016   (let ((keywords
2017          (mdw-regexps "each" "divert" "file" "if"
2018                       "perl" "set" "string" "type" "write")))
2019     (setq mallow-driver-mode-keywords
2020           (list
2021            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2022                  '(0 font-lock-keyword-face))
2023            (list "^%\\s *\\(#.*\\|\\)$"
2024                  '(0 font-lock-comment-face))
2025            (list "^%"
2026                  '(0 font-lock-keyword-face))
2027            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2028            (list "\\${[^}]*}"
2029                  '(0 mallow-driver-substitution-face t)))))
2030   (setq font-lock-defaults
2031         '(mallow-driver-mode-keywords nil nil nil nil))
2032   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2033   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2034   (setq comment-start "%# ")
2035   (setq comment-end "")
2036   (turn-on-font-lock-if-enabled)
2037   (run-hooks 'mallow-driver-mode-hook))
2038
2039 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2040
2041 ;;;--------------------------------------------------------------------------
2042 ;;; NFast debugs.
2043
2044 (defun nfast-debug-mode ()
2045   (interactive)
2046   (fundamental-mode)
2047   (setq major-mode 'nfast-debug-mode)
2048   (setq mode-name "NFast debug")
2049   (setq messages-mode-syntax-table (make-syntax-table))
2050   (set-syntax-table messages-mode-syntax-table)
2051   (make-local-variable 'font-lock-defaults)
2052   (make-local-variable 'nfast-debug-mode-keywords)
2053   (setq truncate-lines t)
2054   (setq nfast-debug-mode-keywords
2055         (list
2056          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2057            (0 font-lock-keyword-face))
2058          (list (concat "^[ \t]+\\(\\("
2059                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2060                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2061                        "[ \t]+\\)*"
2062                        "[0-9a-fA-F]+\\)[ \t]*$")
2063            '(0 mdw-number-face))
2064          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2065            (1 font-lock-keyword-face))
2066          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2067            (1 font-lock-warning-face))
2068          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2069            (1 nil))
2070          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2071                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2072            '(1 font-lock-keyword-face))
2073          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2074          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2075          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2076          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2077   (setq font-lock-defaults
2078         '(nfast-debug-mode-keywords nil nil nil nil))
2079   (turn-on-font-lock-if-enabled)
2080   (run-hooks 'nfast-debug-mode-hook))
2081
2082 ;;;--------------------------------------------------------------------------
2083 ;;; Other languages.
2084
2085 ;; Smalltalk.
2086
2087 (defun mdw-setup-smalltalk ()
2088   (and mdw-auto-indent
2089        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2090   (make-variable-buffer-local 'mdw-auto-indent)
2091   (setq mdw-auto-indent nil)
2092   (local-set-key "\C-i" 'smalltalk-reindent))
2093
2094 (defun mdw-fontify-smalltalk ()
2095   (make-local-variable 'font-lock-keywords)
2096   (setq font-lock-keywords
2097         (list
2098          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2099                '(0 font-lock-keyword-face))
2100          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2101                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2102                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2103                '(0 mdw-number-face))
2104          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2105                '(0 mdw-punct-face)))))
2106
2107 ;; Lispy languages.
2108
2109 ;; Unpleasant bodge.
2110 (unless (boundp 'slime-repl-mode-map)
2111   (setq slime-repl-mode-map (make-sparse-keymap)))
2112
2113 (defun mdw-indent-newline-and-indent ()
2114   (interactive)
2115   (indent-for-tab-command)
2116   (newline-and-indent))
2117
2118 (eval-after-load "cl-indent"
2119   '(progn
2120      (mapc #'(lambda (pair)
2121                (put (car pair)
2122                     'common-lisp-indent-function
2123                     (cdr pair)))
2124       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2125         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2126
2127 (defun mdw-common-lisp-indent ()
2128   (make-variable-buffer-local 'lisp-indent-function)
2129   (setq lisp-indent-function 'common-lisp-indent-function))
2130
2131 (setq lisp-simple-loop-indentation 2
2132       lisp-loop-keyword-indentation 6
2133       lisp-loop-forms-indentation 6)
2134
2135 (defun mdw-fontify-lispy ()
2136
2137   ;; Set fill prefix.
2138   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2139
2140   ;; Not much fontification needed.
2141   (make-local-variable 'font-lock-keywords)
2142   (setq font-lock-keywords
2143         (list
2144          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2145                '(0 mdw-punct-face)))))
2146
2147 (defun comint-send-and-indent ()
2148   (interactive)
2149   (comint-send-input)
2150   (and mdw-auto-indent
2151        (indent-for-tab-command)))
2152
2153 (defun mdw-setup-m4 ()
2154   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2155
2156 ;;;--------------------------------------------------------------------------
2157 ;;; Text mode.
2158
2159 (defun mdw-text-mode ()
2160   (setq fill-column 72)
2161   (flyspell-mode t)
2162   (mdw-standard-fill-prefix
2163    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2164   (auto-fill-mode 1))
2165
2166 ;;;--------------------------------------------------------------------------
2167 ;;; Outline and hide/show modes.
2168
2169 (defun mdw-outline-collapse-all ()
2170   "Completely collapse everything in the entire buffer."
2171   (interactive)
2172   (save-excursion
2173     (goto-char (point-min))
2174     (while (< (point) (point-max))
2175       (hide-subtree)
2176       (forward-line))))
2177
2178 (setq hs-hide-comments-when-hiding-all nil)
2179
2180 ;;;--------------------------------------------------------------------------
2181 ;;; Shell mode.
2182
2183 (defun mdw-sh-mode-setup ()
2184   (local-set-key [?\C-a] 'comint-bol)
2185   (add-hook 'comint-output-filter-functions
2186             'comint-watch-for-password-prompt))
2187
2188 (defun mdw-term-mode-setup ()
2189   (setq term-prompt-regexp shell-prompt-pattern)
2190   (make-local-variable 'mouse-yank-at-point)
2191   (make-local-variable 'transient-mark-mode)
2192   (setq mouse-yank-at-point t)
2193   (auto-fill-mode -1)
2194   (setq tab-width 8))
2195
2196 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2197 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2198 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2199 (defun term-send-meta-meta-something ()
2200   (interactive)
2201   (term-send-raw-string "\e\e")
2202   (term-send-raw))
2203 (eval-after-load 'term
2204   '(progn
2205      (define-key term-raw-map [?\e ?\e] nil)
2206      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2207      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2208      (define-key term-raw-map [M-right] 'term-send-meta-right)
2209      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2210      (define-key term-raw-map [M-left] 'term-send-meta-left)
2211      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2212
2213 ;;;----- That's all, folks --------------------------------------------------
2214
2215 (provide 'dot-emacs)