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

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