chiark - git - mdw - profile/blob - el/dot-emacs.el

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