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

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