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

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