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   (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 (eval-after-load "cc-mode"
 811   '(progn
 812      (define-key c-mode-map "*" nil)
 813      (define-key c-mode-map "/" nil)))
 814
 815 (defun mdw-c-lineup-arglist (langelem)
 816   "Hack for DWIMmery in c-lineup-arglist."
 817   (if (save-excursion
 818         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
 819       0
 820     (c-lineup-arglist langelem)))
 821
 822 (defun mdw-c-indent-extern-mumble (langelem)
 823   "Indent `extern \"...\" {' lines."
 824   (save-excursion
 825     (back-to-indentation)
 826     (if (looking-at
 827          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
 828         c-basic-offset
 829       nil)))
 830
 831 (defun mdw-c-style ()
 832   (c-add-style "[mdw] C and C++ style"
 833                '((c-basic-offset . 2)
 834                  (comment-column . 40)
 835                  (c-class-key . "class")
 836                  (c-backslash-column . 72)
 837                  (c-offsets-alist
 838                   (substatement-open . (add 0 c-indent-one-line-block))
 839                   (defun-open . (add 0 c-indent-one-line-block))
 840                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
 841                   (topmost-intro . mdw-c-indent-extern-mumble)
 842                   (cpp-define-intro . 0)
 843                   (inextern-lang . [0])
 844                   (label . 0)
 845                   (case-label . +)
 846                   (access-label . -)
 847                   (inclass . +)
 848                   (inline-open . ++)
 849                   (statement-cont . 0)
 850                   (statement-case-intro . +)))
 851                t))
 852
 853 (defun mdw-fontify-c-and-c++ ()
 854
 855   ;; Fiddle with some syntax codes.
 856   (modify-syntax-entry ?* ". 23")
 857   (modify-syntax-entry ?/ ". 124b")
 858   (modify-syntax-entry ?\n "> b")
 859
 860   ;; Other stuff.
 861   (mdw-c-style)
 862   (setq c-hanging-comment-ender-p nil)
 863   (setq c-backslash-column 72)
 864   (setq c-label-minimum-indentation 0)
 865   (setq mdw-fill-prefix
 866         `((,(concat "\\([ \t]*/?\\)"
 867                     "\\([\*/][ \t]*\\)"
 868                     "\\([A-Za-z]+:[ \t]*\\)?"
 869                     mdw-hanging-indents)
 870            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
 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
1040         `((,(concat "\\([ \t]*/?\\)"
1041                     "\\([\*/][ \t]*\\)"
1042                     "\\([A-Za-z]+:[ \t]*\\)?"
1043                     mdw-hanging-indents)
1044            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1045
1046   ;; Now define things to be fontified.
1047   (make-local-variable 'font-lock-keywords)
1048   (let ((c-keywords
1049          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1050                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1051                       "local" "mat" "obj" "print" "quit" "read" "return"
1052                       "show" "static" "switch" "while" "write")))
1053
1054     (setq font-lock-keywords
1055           (list
1056
1057            ;; Handle the keywords defined above.
1058            (list (concat "\\<\\(" c-keywords "\\)\\>")
1059                  '(0 font-lock-keyword-face))
1060
1061            ;; Handle numbers too.
1062            ;;
1063            ;; This looks strange, I know.  It corresponds to the
1064            ;; preprocessor's idea of what a number looks like, rather than
1065            ;; anything sensible.
1066            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1067                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1068                  '(0 mdw-number-face))
1069
1070            ;; And anything else is punctuation.
1071            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1072                  '(0 mdw-punct-face))))))
1073
1074 ;;;--------------------------------------------------------------------------
1075 ;;; Java programming configuration.
1076
1077 ;; Make indentation nice.
1078
1079 (defun mdw-java-style ()
1080   (c-add-style "[mdw] Java style"
1081                '((c-basic-offset . 2)
1082                  (c-offsets-alist (substatement-open . 0)
1083                                   (label . +)
1084                                   (case-label . +)
1085                                   (access-label . 0)
1086                                   (inclass . +)
1087                                   (statement-case-intro . +)))
1088                t))
1089
1090 ;; Declare Java fontification style.
1091
1092 (defun mdw-fontify-java ()
1093
1094   ;; Other stuff.
1095   (mdw-java-style)
1096   (setq c-hanging-comment-ender-p nil)
1097   (setq c-backslash-column 72)
1098   (setq comment-start "/* ")
1099   (setq comment-end " */")
1100   (setq mdw-fill-prefix
1101         `((,(concat "\\([ \t]*/?\\)"
1102                     "\\([\*/][ \t]*\\)"
1103                     "\\([A-Za-z]+:[ \t]*\\)?"
1104                     mdw-hanging-indents)
1105            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1106
1107   ;; Now define things to be fontified.
1108   (make-local-variable 'font-lock-keywords)
1109   (let ((java-keywords
1110          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1111                       "char" "class" "const" "continue" "default" "do"
1112                       "double" "else" "extends" "final" "finally" "float"
1113                       "for" "goto" "if" "implements" "import" "instanceof"
1114                       "int" "interface" "long" "native" "new" "package"
1115                       "private" "protected" "public" "return" "short"
1116                       "static" "super" "switch" "synchronized" "this"
1117                       "throw" "throws" "transient" "try" "void" "volatile"
1118                       "while"
1119
1120                       "false" "null" "true")))
1121
1122     (setq font-lock-keywords
1123           (list
1124
1125            ;; Handle the keywords defined above.
1126            (list (concat "\\<\\(" java-keywords "\\)\\>")
1127                  '(0 font-lock-keyword-face))
1128
1129            ;; Handle numbers too.
1130            ;;
1131            ;; The following isn't quite right, but it's close enough.
1132            (list (concat "\\<\\("
1133                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1134                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1135                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1136                          "[lLfFdD]?")
1137                  '(0 mdw-number-face))
1138
1139            ;; And anything else is punctuation.
1140            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1141                  '(0 mdw-punct-face))))))
1142
1143 ;;;--------------------------------------------------------------------------
1144 ;;; C# programming configuration.
1145
1146 ;; Make indentation nice.
1147
1148 (defun mdw-csharp-style ()
1149   (c-add-style "[mdw] C# style"
1150                '((c-basic-offset . 2)
1151                  (c-offsets-alist (substatement-open . 0)
1152                                   (label . 0)
1153                                   (case-label . +)
1154                                   (access-label . 0)
1155                                   (inclass . +)
1156                                   (statement-case-intro . +)))
1157                t))
1158
1159 ;; Declare C# fontification style.
1160
1161 (defun mdw-fontify-csharp ()
1162
1163   ;; Other stuff.
1164   (mdw-csharp-style)
1165   (setq c-hanging-comment-ender-p nil)
1166   (setq c-backslash-column 72)
1167   (setq comment-start "/* ")
1168   (setq comment-end " */")
1169   (setq mdw-fill-prefix
1170         `((,(concat "\\([ \t]*/?\\)"
1171                     "\\([\*/][ \t]*\\)"
1172                     "\\([A-Za-z]+:[ \t]*\\)?"
1173                     mdw-hanging-indents)
1174            (pad . 1) (match . 2) (pad . 3) (pad . 4))))
1175
1176   ;; Now define things to be fontified.
1177   (make-local-variable 'font-lock-keywords)
1178   (let ((csharp-keywords
1179          (mdw-regexps "abstract" "as" "base" "bool" "break"
1180                       "byte" "case" "catch" "char" "checked"
1181                       "class" "const" "continue" "decimal" "default"
1182                       "delegate" "do" "double" "else" "enum"
1183                       "event" "explicit" "extern" "false" "finally"
1184                       "fixed" "float" "for" "foreach" "goto"
1185                       "if" "implicit" "in" "int" "interface"
1186                       "internal" "is" "lock" "long" "namespace"
1187                       "new" "null" "object" "operator" "out"
1188                       "override" "params" "private" "protected" "public"
1189                       "readonly" "ref" "return" "sbyte" "sealed"
1190                       "short" "sizeof" "stackalloc" "static" "string"
1191                       "struct" "switch" "this" "throw" "true"
1192                       "try" "typeof" "uint" "ulong" "unchecked"
1193                       "unsafe" "ushort" "using" "virtual" "void"
1194                       "volatile" "while" "yield")))
1195
1196     (setq font-lock-keywords
1197           (list
1198
1199            ;; Handle the keywords defined above.
1200            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1201                  '(0 font-lock-keyword-face))
1202
1203            ;; Handle numbers too.
1204            ;;
1205            ;; The following isn't quite right, but it's close enough.
1206            (list (concat "\\<\\("
1207                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1208                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1209                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1210                          "[lLfFdD]?")
1211                  '(0 mdw-number-face))
1212
1213            ;; And anything else is punctuation.
1214            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1215                  '(0 mdw-punct-face))))))
1216
1217 (defun csharp-mode ()
1218   (interactive)
1219   (java-mode)
1220   (setq major-mode 'csharp-mode)
1221   (setq mode-name "C#")
1222   (mdw-fontify-csharp)
1223   (run-hooks 'csharp-mode-hook))
1224
1225 ;;;--------------------------------------------------------------------------
1226 ;;; Awk programming configuration.
1227
1228 ;; Make Awk indentation nice.
1229
1230 (defun mdw-awk-style ()
1231   (c-add-style "[mdw] Awk style"
1232                '((c-basic-offset . 2)
1233                  (c-offsets-alist (substatement-open . 0)
1234                                   (statement-cont . 0)
1235                                   (statement-case-intro . +)))
1236                t))
1237
1238 ;; Declare Awk fontification style.
1239
1240 (defun mdw-fontify-awk ()
1241
1242   ;; Miscellaneous fiddling.
1243   (mdw-awk-style)
1244   (setq c-backslash-column 72)
1245   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1246
1247   ;; Now define things to be fontified.
1248   (make-local-variable 'font-lock-keywords)
1249   (let ((c-keywords
1250          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1251                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1252                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1253                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1254                       "atan2" "break" "close" "continue" "cos" "delete"
1255                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1256                       "function" "gensub" "getline" "gsub" "if" "in"
1257                       "index" "int" "length" "log" "match" "next" "rand"
1258                       "return" "print" "printf" "sin" "split" "sprintf"
1259                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1260                       "systime" "tolower" "toupper" "while")))
1261
1262     (setq font-lock-keywords
1263           (list
1264
1265            ;; Handle the keywords defined above.
1266            (list (concat "\\<\\(" c-keywords "\\)\\>")
1267                  '(0 font-lock-keyword-face))
1268
1269            ;; Handle numbers too.
1270            ;;
1271            ;; The following isn't quite right, but it's close enough.
1272            (list (concat "\\<\\("
1273                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1274                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1275                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1276                          "[uUlL]*")
1277                  '(0 mdw-number-face))
1278
1279            ;; And anything else is punctuation.
1280            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1281                  '(0 mdw-punct-face))))))
1282
1283 ;;;--------------------------------------------------------------------------
1284 ;;; Perl programming style.
1285
1286 ;; Perl indentation style.
1287
1288 (setq cperl-indent-level 2)
1289 (setq cperl-continued-statement-offset 2)
1290 (setq cperl-continued-brace-offset 0)
1291 (setq cperl-brace-offset -2)
1292 (setq cperl-brace-imaginary-offset 0)
1293 (setq cperl-label-offset 0)
1294
1295 ;; Define perl fontification style.
1296
1297 (defun mdw-fontify-perl ()
1298
1299   ;; Miscellaneous fiddling.
1300   (modify-syntax-entry ?$ "\\")
1301   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1302   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1303
1304   ;; Now define fontification things.
1305   (make-local-variable 'font-lock-keywords)
1306   (let ((perl-keywords
1307          (mdw-regexps "and" "cmp" "continue" "do" "else" "elsif" "eq"
1308                       "for" "foreach" "ge" "gt" "goto" "if"
1309                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1310                       "package" "redo" "require" "return" "sub"
1311                       "undef" "unless" "until" "use" "while")))
1312
1313     (setq font-lock-keywords
1314           (list
1315
1316            ;; Set up the keywords defined above.
1317            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1318                  '(0 font-lock-keyword-face))
1319
1320            ;; At least numbers are simpler than C.
1321            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1322                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1323                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1324                  '(0 mdw-number-face))
1325
1326            ;; And anything else is punctuation.
1327            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1328                  '(0 mdw-punct-face))))))
1329
1330 (defun perl-number-tests (&optional arg)
1331   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1332 strip numbers instead."
1333   (interactive "P")
1334   (save-excursion
1335     (goto-char (point-min))
1336     (let ((i 0) (fmt (if arg "" " %4d")))
1337       (while (search-forward "#t" nil t)
1338         (delete-region (point) (line-end-position))
1339         (setq i (1+ i))
1340         (insert (format fmt i)))
1341       (goto-char (point-min))
1342       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1343           (replace-match (format "\\1%d" i))))))
1344
1345 ;;;--------------------------------------------------------------------------
1346 ;;; Python programming style.
1347
1348 ;; Define Python fontification style.
1349
1350 (defun mdw-fontify-python ()
1351
1352   ;; Miscellaneous fiddling.
1353   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1354
1355   ;; Now define fontification things.
1356   (make-local-variable 'font-lock-keywords)
1357   (let ((python-keywords
1358          (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1359                       "del" "elif" "else" "except" "exec" "finally" "for"
1360                       "from" "global" "if" "import" "in" "is" "lambda"
1361                       "not" "or" "pass" "print" "raise" "return" "try"
1362                       "while" "with" "yield")))
1363     (setq font-lock-keywords
1364           (list
1365
1366            ;; Set up the keywords defined above.
1367            (list (concat "\\<\\(" python-keywords "\\)\\>")
1368                  '(0 font-lock-keyword-face))
1369
1370            ;; At least numbers are simpler than C.
1371            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1372                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1373                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1374                  '(0 mdw-number-face))
1375
1376            ;; And anything else is punctuation.
1377            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1378                  '(0 mdw-punct-face))))))
1379
1380 ;;;--------------------------------------------------------------------------
1381 ;;; Icon programming style.
1382
1383 ;; Icon indentation style.
1384
1385 (setq icon-brace-offset 0
1386       icon-continued-brace-offset 0
1387       icon-continued-statement-offset 2
1388       icon-indent-level 2)
1389
1390 ;; Define Icon fontification style.
1391
1392 (defun mdw-fontify-icon ()
1393
1394   ;; Miscellaneous fiddling.
1395   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1396
1397   ;; Now define fontification things.
1398   (make-local-variable 'font-lock-keywords)
1399   (let ((icon-keywords
1400          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1401                       "end" "every" "fail" "global" "if" "initial"
1402                       "invocable" "link" "local" "next" "not" "of"
1403                       "procedure" "record" "repeat" "return" "static"
1404                       "suspend" "then" "to" "until" "while"))
1405         (preprocessor-keywords
1406          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1407                       "include" "line" "undef")))
1408     (setq font-lock-keywords
1409           (list
1410
1411            ;; Set up the keywords defined above.
1412            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1413                  '(0 font-lock-keyword-face))
1414
1415            ;; The things that Icon calls keywords.
1416            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1417
1418            ;; At least numbers are simpler than C.
1419            (list (concat "\\<[0-9]+"
1420                          "\\([rR][0-9a-zA-Z]+\\|"
1421                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1422                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1423                  '(0 mdw-number-face))
1424
1425            ;; Preprocessor.
1426            (list (concat "^[ \t]*$[ \t]*\\<\\("
1427                          preprocessor-keywords
1428                          "\\)\\>")
1429                  '(0 font-lock-keyword-face))
1430
1431            ;; And anything else is punctuation.
1432            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1433                  '(0 mdw-punct-face))))))
1434
1435 ;;;--------------------------------------------------------------------------
1436 ;;; ARM assembler programming configuration.
1437
1438 ;; There doesn't appear to be an Emacs mode for this yet.
1439 ;;
1440 ;; Better do something about that, I suppose.
1441
1442 (defvar arm-assembler-mode-map nil)
1443 (defvar arm-assembler-abbrev-table nil)
1444 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1445
1446 (or arm-assembler-mode-map
1447     (progn
1448       (setq arm-assembler-mode-map (make-sparse-keymap))
1449       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1450       (define-key arm-assembler-mode-map [C-return] 'newline)
1451       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1452
1453 (defun arm-assembler-mode ()
1454   "Major mode for ARM assembler programs"
1455   (interactive)
1456
1457   ;; Do standard major mode things.
1458   (kill-all-local-variables)
1459   (use-local-map arm-assembler-mode-map)
1460   (setq local-abbrev-table arm-assembler-abbrev-table)
1461   (setq major-mode 'arm-assembler-mode)
1462   (setq mode-name "ARM assembler")
1463
1464   ;; Set up syntax table.
1465   (set-syntax-table arm-assembler-mode-syntax-table)
1466   (modify-syntax-entry ?;   ; Nasty hack
1467                        "<" arm-assembler-mode-syntax-table)
1468   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
1469   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
1470
1471   (make-local-variable 'comment-start)
1472   (setq comment-start ";")
1473   (make-local-variable 'comment-end)
1474   (setq comment-end "")
1475   (make-local-variable 'comment-column)
1476   (setq comment-column 48)
1477   (make-local-variable 'comment-start-skip)
1478   (setq comment-start-skip ";+[ \t]*")
1479
1480   ;; Play with indentation.
1481   (make-local-variable 'indent-line-function)
1482   (setq indent-line-function 'indent-relative-maybe)
1483
1484   ;; Set fill prefix.
1485   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
1486
1487   ;; Fiddle with fontification.
1488   (make-local-variable 'font-lock-keywords)
1489   (setq font-lock-keywords
1490         (list
1491
1492          ;; Handle numbers too.
1493          ;;
1494          ;; The following isn't quite right, but it's close enough.
1495          (list (concat "\\("
1496                        "&[0-9a-fA-F]+\\|"
1497                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
1498                        "\\)")
1499                '(0 mdw-number-face))
1500
1501          ;; Do something about operators.
1502          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
1503                '(1 font-lock-keyword-face)
1504                '(2 font-lock-string-face))
1505          (list ":[a-zA-Z]+:"
1506                '(0 font-lock-keyword-face))
1507
1508          ;; Do menemonics and directives.
1509          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
1510                '(1 font-lock-keyword-face))
1511
1512          ;; And anything else is punctuation.
1513          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1514                '(0 mdw-punct-face))))
1515
1516   (run-hooks 'arm-assembler-mode-hook))
1517
1518 ;;;--------------------------------------------------------------------------
1519 ;;; Assembler mode.
1520
1521 (defun mdw-fontify-asm ()
1522   (modify-syntax-entry ?' "\"")
1523   (modify-syntax-entry ?. "w")
1524   (setf fill-prefix nil)
1525   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
1526
1527 ;;;--------------------------------------------------------------------------
1528 ;;; TCL configuration.
1529
1530 (defun mdw-fontify-tcl ()
1531   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
1532   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1533   (make-local-variable 'font-lock-keywords)
1534   (setq font-lock-keywords
1535         (list
1536          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1537                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1538                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1539                '(0 mdw-number-face))
1540          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1541                '(0 mdw-punct-face)))))
1542
1543 ;;;--------------------------------------------------------------------------
1544 ;;; REXX configuration.
1545
1546 (defun mdw-rexx-electric-* ()
1547   (interactive)
1548   (insert ?*)
1549   (rexx-indent-line))
1550
1551 (defun mdw-rexx-indent-newline-indent ()
1552   (interactive)
1553   (rexx-indent-line)
1554   (if abbrev-mode (expand-abbrev))
1555   (newline-and-indent))
1556
1557 (defun mdw-fontify-rexx ()
1558
1559   ;; Various bits of fiddling.
1560   (setq mdw-auto-indent nil)
1561   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
1562   (local-set-key [?*] 'mdw-rexx-electric-*)
1563   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
1564           '(?! ?? ?# ?@ ?$))
1565   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
1566
1567   ;; Set up keywords and things for fontification.
1568   (make-local-variable 'font-lock-keywords-case-fold-search)
1569   (setq font-lock-keywords-case-fold-search t)
1570
1571   (setq rexx-indent 2)
1572   (setq rexx-end-indent rexx-indent)
1573   (setq rexx-cont-indent rexx-indent)
1574
1575   (make-local-variable 'font-lock-keywords)
1576   (let ((rexx-keywords
1577          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
1578                       "else" "end" "engineering" "exit" "expose" "for"
1579                       "forever" "form" "fuzz" "if" "interpret" "iterate"
1580                       "leave" "linein" "name" "nop" "numeric" "off" "on"
1581                       "options" "otherwise" "parse" "procedure" "pull"
1582                       "push" "queue" "return" "say" "select" "signal"
1583                       "scientific" "source" "then" "trace" "to" "until"
1584                       "upper" "value" "var" "version" "when" "while"
1585                       "with"
1586
1587                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
1588                       "center" "center" "charin" "charout" "chars"
1589                       "compare" "condition" "copies" "c2d" "c2x"
1590                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
1591                       "errortext" "format" "fuzz" "insert" "lastpos"
1592                       "left" "length" "lineout" "lines" "max" "min"
1593                       "overlay" "pos" "queued" "random" "reverse" "right"
1594                       "sign" "sourceline" "space" "stream" "strip"
1595                       "substr" "subword" "symbol" "time" "translate"
1596                       "trunc" "value" "verify" "word" "wordindex"
1597                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
1598                       "x2d")))
1599
1600     (setq font-lock-keywords
1601           (list
1602
1603            ;; Set up the keywords defined above.
1604            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
1605                  '(0 font-lock-keyword-face))
1606
1607            ;; Fontify all symbols the same way.
1608            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
1609                          "[A-Za-z0-9.!?_#@$]+\\)")
1610                  '(0 font-lock-variable-name-face))
1611
1612            ;; And everything else is punctuation.
1613            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1614                  '(0 mdw-punct-face))))))
1615
1616 ;;;--------------------------------------------------------------------------
1617 ;;; Standard ML programming style.
1618
1619 (defun mdw-fontify-sml ()
1620
1621   ;; Make underscore an honorary letter.
1622   (modify-syntax-entry ?' "w")
1623
1624   ;; Set fill prefix.
1625   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
1626
1627   ;; Now define fontification things.
1628   (make-local-variable 'font-lock-keywords)
1629   (let ((sml-keywords
1630          (mdw-regexps "abstype" "and" "andalso" "as"
1631                       "case"
1632                       "datatype" "do"
1633                       "else" "end" "eqtype" "exception"
1634                       "fn" "fun" "functor"
1635                       "handle"
1636                       "if" "in" "include" "infix" "infixr"
1637                       "let" "local"
1638                       "nonfix"
1639                       "of" "op" "open" "orelse"
1640                       "raise" "rec"
1641                       "sharing" "sig" "signature" "struct" "structure"
1642                       "then" "type"
1643                       "val"
1644                       "where" "while" "with" "withtype")))
1645
1646     (setq font-lock-keywords
1647           (list
1648
1649            ;; Set up the keywords defined above.
1650            (list (concat "\\<\\(" sml-keywords "\\)\\>")
1651                  '(0 font-lock-keyword-face))
1652
1653            ;; At least numbers are simpler than C.
1654            (list (concat "\\<\\(\\~\\|\\)"
1655                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
1656                                    "[wW][0-9]+\\)\\|"
1657                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
1658                                          "\\([eE]\\(\\~\\|\\)"
1659                                                 "[0-9]+\\|\\)\\)\\)")
1660                  '(0 mdw-number-face))
1661
1662            ;; And anything else is punctuation.
1663            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1664                  '(0 mdw-punct-face))))))
1665
1666 ;;;--------------------------------------------------------------------------
1667 ;;; Haskell configuration.
1668
1669 (defun mdw-fontify-haskell ()
1670
1671   ;; Fiddle with syntax table to get comments right.
1672   (modify-syntax-entry ?' "\"")
1673   (modify-syntax-entry ?- ". 123")
1674   (modify-syntax-entry ?{ ". 1b")
1675   (modify-syntax-entry ?} ". 4b")
1676   (modify-syntax-entry ?\n ">")
1677
1678   ;; Set fill prefix.
1679   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
1680
1681   ;; Fiddle with fontification.
1682   (make-local-variable 'font-lock-keywords)
1683   (let ((haskell-keywords
1684          (mdw-regexps "as" "case" "ccall" "class" "data" "default"
1685                       "deriving" "do" "else" "foreign" "hiding" "if"
1686                       "import" "in" "infix" "infixl" "infixr" "instance"
1687                       "let" "module" "newtype" "of" "qualified" "safe"
1688                       "stdcall" "then" "type" "unsafe" "where")))
1689
1690     (setq font-lock-keywords
1691           (list
1692            (list "--.*$"
1693                  '(0 font-lock-comment-face))
1694            (list (concat "\\<\\(" haskell-keywords "\\)\\>")
1695                  '(0 font-lock-keyword-face))
1696            (list (concat "\\<0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1697                          "\\<[0-9][0-9_]*\\(\\.[0-9]*\\|\\)"
1698                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
1699                  '(0 mdw-number-face))
1700            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1701                  '(0 mdw-punct-face))))))
1702
1703 ;;;--------------------------------------------------------------------------
1704 ;;; Erlang configuration.
1705
1706 (setq erlang-electric-commannds
1707       '(erlang-electric-newline erlang-electric-semicolon))
1708
1709 (defun mdw-fontify-erlang ()
1710
1711   ;; Set fill prefix.
1712   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
1713
1714   ;; Fiddle with fontification.
1715   (make-local-variable 'font-lock-keywords)
1716   (let ((erlang-keywords
1717          (mdw-regexps "after" "and" "andalso"
1718                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
1719                       "case" "catch" "cond"
1720                       "div" "end" "fun" "if" "let" "not"
1721                       "of" "or" "orelse"
1722                       "query" "receive" "rem" "try" "when" "xor")))
1723
1724     (setq font-lock-keywords
1725           (list
1726            (list "%.*$"
1727                  '(0 font-lock-comment-face))
1728            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
1729                  '(0 font-lock-keyword-face))
1730            (list (concat "^-\\sw+\\>")
1731                  '(0 font-lock-keyword-face))
1732            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
1733                  '(0 mdw-number-face))
1734            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1735                  '(0 mdw-punct-face))))))
1736
1737 ;;;--------------------------------------------------------------------------
1738 ;;; Texinfo configuration.
1739
1740 (defun mdw-fontify-texinfo ()
1741
1742   ;; Set fill prefix.
1743   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
1744
1745   ;; Real fontification things.
1746   (make-local-variable 'font-lock-keywords)
1747   (setq font-lock-keywords
1748         (list
1749
1750          ;; Environment names are keywords.
1751          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
1752                '(2 font-lock-keyword-face))
1753
1754          ;; Unmark escaped magic characters.
1755          (list "\\(@\\)\\([@{}]\\)"
1756                '(1 font-lock-keyword-face)
1757                '(2 font-lock-variable-name-face))
1758
1759          ;; Make sure we get comments properly.
1760          (list "@c\\(\\|omment\\)\\( .*\\)?$"
1761                '(0 font-lock-comment-face))
1762
1763          ;; Command names are keywords.
1764          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1765                '(0 font-lock-keyword-face))
1766
1767          ;; Fontify TeX special characters as punctuation.
1768          (list "[{}]+"
1769                '(0 mdw-punct-face)))))
1770
1771 ;;;--------------------------------------------------------------------------
1772 ;;; TeX and LaTeX configuration.
1773
1774 (defun mdw-fontify-tex ()
1775   (setq ispell-parser 'tex)
1776   (turn-on-reftex)
1777
1778   ;; Don't make maths into a string.
1779   (modify-syntax-entry ?$ ".")
1780   (modify-syntax-entry ?$ "." font-lock-syntax-table)
1781   (local-set-key [?$] 'self-insert-command)
1782
1783   ;; Set fill prefix.
1784   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
1785
1786   ;; Real fontification things.
1787   (make-local-variable 'font-lock-keywords)
1788   (setq font-lock-keywords
1789         (list
1790
1791          ;; Environment names are keywords.
1792          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
1793                        "{\\([^}\n]*\\)}")
1794                '(2 font-lock-keyword-face))
1795
1796          ;; Suspended environment names are keywords too.
1797          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
1798                        "{\\([^}\n]*\\)}")
1799                '(3 font-lock-keyword-face))
1800
1801          ;; Command names are keywords.
1802          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
1803                '(0 font-lock-keyword-face))
1804
1805          ;; Handle @/.../ for italics.
1806          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
1807          ;;       '(1 font-lock-keyword-face)
1808          ;;       '(3 font-lock-keyword-face))
1809
1810          ;; Handle @*...* for boldness.
1811          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
1812          ;;       '(1 font-lock-keyword-face)
1813          ;;       '(3 font-lock-keyword-face))
1814
1815          ;; Handle @`...' for literal syntax things.
1816          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
1817          ;;       '(1 font-lock-keyword-face)
1818          ;;       '(3 font-lock-keyword-face))
1819
1820          ;; Handle @<...> for nonterminals.
1821          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
1822          ;;       '(1 font-lock-keyword-face)
1823          ;;       '(3 font-lock-keyword-face))
1824
1825          ;; Handle other @-commands.
1826          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
1827          ;;       '(0 font-lock-keyword-face))
1828
1829          ;; Make sure we get comments properly.
1830          (list "%.*"
1831                '(0 font-lock-comment-face))
1832
1833          ;; Fontify TeX special characters as punctuation.
1834          (list "[$^_{}#&]"
1835                '(0 mdw-punct-face)))))
1836
1837 ;;;--------------------------------------------------------------------------
1838 ;;; SGML hacking.
1839
1840 (defun mdw-sgml-mode ()
1841   (interactive)
1842   (sgml-mode)
1843   (mdw-standard-fill-prefix "")
1844   (make-variable-buffer-local 'sgml-delimiters)
1845   (setq sgml-delimiters
1846         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
1847           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
1848           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
1849           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
1850           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
1851           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
1852           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
1853           "NULL" ""))
1854   (setq major-mode 'mdw-sgml-mode)
1855   (setq mode-name "[mdw] SGML")
1856   (run-hooks 'mdw-sgml-mode-hook))
1857
1858 ;;;--------------------------------------------------------------------------
1859 ;;; Shell scripts.
1860
1861 (defun mdw-setup-sh-script-mode ()
1862
1863   ;; Fetch the shell interpreter's name.
1864   (let ((shell-name sh-shell-file))
1865
1866     ;; Try reading the hash-bang line.
1867     (save-excursion
1868       (goto-char (point-min))
1869       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
1870           (setq shell-name (match-string 1))))
1871
1872     ;; Now try to set the shell.
1873     ;;
1874     ;; Don't let `sh-set-shell' bugger up my script.
1875     (let ((executable-set-magic #'(lambda (s &rest r) s)))
1876       (sh-set-shell shell-name)))
1877
1878   ;; Now enable my keys and the fontification.
1879   (mdw-misc-mode-config)
1880
1881   ;; Set the indentation level correctly.
1882   (setq sh-indentation 2)
1883   (setq sh-basic-offset 2))
1884
1885 ;;;--------------------------------------------------------------------------
1886 ;;; Messages-file mode.
1887
1888 (defun messages-mode-guts ()
1889   (setq messages-mode-syntax-table (make-syntax-table))
1890   (set-syntax-table messages-mode-syntax-table)
1891   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
1892   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
1893   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
1894   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
1895   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
1896   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
1897   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
1898   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
1899   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
1900   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
1901   (make-local-variable 'comment-start)
1902   (make-local-variable 'comment-end)
1903   (make-local-variable 'indent-line-function)
1904   (setq indent-line-function 'indent-relative)
1905   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1906   (make-local-variable 'font-lock-defaults)
1907   (make-local-variable 'messages-mode-keywords)
1908   (let ((keywords
1909          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
1910                       "export" "enum" "fixed-octetstring" "flags"
1911                       "harmless" "map" "nested" "optional"
1912                       "optional-tagged" "package" "primitive"
1913                       "primitive-nullfree" "relaxed[ \t]+enum"
1914                       "set" "table" "tagged-optional"   "union"
1915                       "variadic" "vector" "version" "version-tag")))
1916     (setq messages-mode-keywords
1917           (list
1918            (list (concat "\\<\\(" keywords "\\)\\>:")
1919                  '(0 font-lock-keyword-face))
1920            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
1921            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
1922              (0 font-lock-variable-name-face))
1923            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
1924            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1925              (0 mdw-punct-face)))))
1926   (setq font-lock-defaults
1927         '(messages-mode-keywords nil nil nil nil))
1928   (run-hooks 'messages-file-hook))
1929
1930 (defun messages-mode ()
1931   (interactive)
1932   (fundamental-mode)
1933   (setq major-mode 'messages-mode)
1934   (setq mode-name "Messages")
1935   (messages-mode-guts)
1936   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
1937   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
1938   (setq comment-start "# ")
1939   (setq comment-end "")
1940   (turn-on-font-lock-if-enabled)
1941   (run-hooks 'messages-mode-hook))
1942
1943 (defun cpp-messages-mode ()
1944   (interactive)
1945   (fundamental-mode)
1946   (setq major-mode 'cpp-messages-mode)
1947   (setq mode-name "CPP Messages")
1948   (messages-mode-guts)
1949   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
1950   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
1951   (setq comment-start "/* ")
1952   (setq comment-end " */")
1953   (let ((preprocessor-keywords
1954          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1955                       "ident" "if" "ifdef" "ifndef" "import" "include"
1956                       "line" "pragma" "unassert" "undef" "warning")))
1957     (setq messages-mode-keywords
1958           (append (list (list (concat "^[ \t]*\\#[ \t]*"
1959                                       "\\(include\\|import\\)"
1960                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1961                               '(2 font-lock-string-face))
1962                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1963                                       preprocessor-keywords
1964                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
1965                               '(1 font-lock-keyword-face)))
1966                   messages-mode-keywords)))
1967   (turn-on-font-lock-if-enabled)
1968   (run-hooks 'cpp-messages-mode-hook))
1969
1970 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
1971 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
1972 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
1973
1974 ;;;--------------------------------------------------------------------------
1975 ;;; Messages-file mode.
1976
1977 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
1978   "Face to use for subsittution directives.")
1979 (make-face 'mallow-driver-substitution-face)
1980 (defvar mallow-driver-text-face 'mallow-driver-text-face
1981   "Face to use for body text.")
1982 (make-face 'mallow-driver-text-face)
1983
1984 (defun mallow-driver-mode ()
1985   (interactive)
1986   (fundamental-mode)
1987   (setq major-mode 'mallow-driver-mode)
1988   (setq mode-name "Mallow driver")
1989   (setq mallow-driver-mode-syntax-table (make-syntax-table))
1990   (set-syntax-table mallow-driver-mode-syntax-table)
1991   (make-local-variable 'comment-start)
1992   (make-local-variable 'comment-end)
1993   (make-local-variable 'indent-line-function)
1994   (setq indent-line-function 'indent-relative)
1995   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
1996   (make-local-variable 'font-lock-defaults)
1997   (make-local-variable 'mallow-driver-mode-keywords)
1998   (let ((keywords
1999          (mdw-regexps "each" "divert" "file" "if"
2000                       "perl" "set" "string" "type" "write")))
2001     (setq mallow-driver-mode-keywords
2002           (list
2003            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2004                  '(0 font-lock-keyword-face))
2005            (list "^%\\s *\\(#.*\\|\\)$"
2006                  '(0 font-lock-comment-face))
2007            (list "^%"
2008                  '(0 font-lock-keyword-face))
2009            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2010            (list "\\${[^}]*}"
2011                  '(0 mallow-driver-substitution-face t)))))
2012   (setq font-lock-defaults
2013         '(mallow-driver-mode-keywords nil nil nil nil))
2014   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2015   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2016   (setq comment-start "%# ")
2017   (setq comment-end "")
2018   (turn-on-font-lock-if-enabled)
2019   (run-hooks 'mallow-driver-mode-hook))
2020
2021 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2022
2023 ;;;--------------------------------------------------------------------------
2024 ;;; NFast debugs.
2025
2026 (defun nfast-debug-mode ()
2027   (interactive)
2028   (fundamental-mode)
2029   (setq major-mode 'nfast-debug-mode)
2030   (setq mode-name "NFast debug")
2031   (setq messages-mode-syntax-table (make-syntax-table))
2032   (set-syntax-table messages-mode-syntax-table)
2033   (make-local-variable 'font-lock-defaults)
2034   (make-local-variable 'nfast-debug-mode-keywords)
2035   (setq truncate-lines t)
2036   (setq nfast-debug-mode-keywords
2037         (list
2038          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2039            (0 font-lock-keyword-face))
2040          (list (concat "^[ \t]+\\(\\("
2041                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2042                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2043                        "[ \t]+\\)*"
2044                        "[0-9a-fA-F]+\\)[ \t]*$")
2045            '(0 mdw-number-face))
2046          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2047            (1 font-lock-keyword-face))
2048          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2049            (1 font-lock-warning-face))
2050          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2051            (1 nil))
2052          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2053                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2054            '(1 font-lock-keyword-face))
2055          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2056          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2057          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2058          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2059   (setq font-lock-defaults
2060         '(nfast-debug-mode-keywords nil nil nil nil))
2061   (turn-on-font-lock-if-enabled)
2062   (run-hooks 'nfast-debug-mode-hook))
2063
2064 ;;;--------------------------------------------------------------------------
2065 ;;; Other languages.
2066
2067 ;; Smalltalk.
2068
2069 (defun mdw-setup-smalltalk ()
2070   (and mdw-auto-indent
2071        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2072   (make-variable-buffer-local 'mdw-auto-indent)
2073   (setq mdw-auto-indent nil)
2074   (local-set-key "\C-i" 'smalltalk-reindent))
2075
2076 (defun mdw-fontify-smalltalk ()
2077   (make-local-variable 'font-lock-keywords)
2078   (setq font-lock-keywords
2079         (list
2080          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2081                '(0 font-lock-keyword-face))
2082          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2083                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2084                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2085                '(0 mdw-number-face))
2086          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2087                '(0 mdw-punct-face)))))
2088
2089 ;; Lispy languages.
2090
2091 ;; Unpleasant bodge.
2092 (unless (boundp 'slime-repl-mode-map)
2093   (setq slime-repl-mode-map (make-sparse-keymap)))
2094
2095 (defun mdw-indent-newline-and-indent ()
2096   (interactive)
2097   (indent-for-tab-command)
2098   (newline-and-indent))
2099
2100 (eval-after-load "cl-indent"
2101   '(progn
2102      (mapc #'(lambda (pair)
2103                (put (car pair)
2104                     'common-lisp-indent-function
2105                     (cdr pair)))
2106       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2107         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2108
2109 (defun mdw-common-lisp-indent ()
2110   (make-variable-buffer-local 'lisp-indent-function)
2111   (setq lisp-indent-function 'common-lisp-indent-function))
2112
2113 (setq lisp-simple-loop-indentation 2
2114       lisp-loop-keyword-indentation 6
2115       lisp-loop-forms-indentation 6)
2116
2117 (defun mdw-fontify-lispy ()
2118
2119   ;; Set fill prefix.
2120   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2121
2122   ;; Not much fontification needed.
2123   (make-local-variable 'font-lock-keywords)
2124   (setq font-lock-keywords
2125         (list
2126          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2127                '(0 mdw-punct-face)))))
2128
2129 (defun comint-send-and-indent ()
2130   (interactive)
2131   (comint-send-input)
2132   (and mdw-auto-indent
2133        (indent-for-tab-command)))
2134
2135 (defun mdw-setup-m4 ()
2136   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2137
2138 ;;;--------------------------------------------------------------------------
2139 ;;; Text mode.
2140
2141 (defun mdw-text-mode ()
2142   (setq fill-column 72)
2143   (flyspell-mode t)
2144   (mdw-standard-fill-prefix
2145    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2146   (auto-fill-mode 1))
2147
2148 ;;;--------------------------------------------------------------------------
2149 ;;; Outline mode.
2150
2151 (defun mdw-outline-collapse-all ()
2152   "Completely collapse everything in the entire buffer."
2153   (interactive)
2154   (save-excursion
2155     (goto-char (point-min))
2156     (while (< (point) (point-max))
2157       (hide-subtree)
2158       (forward-line))))
2159
2160 ;;;--------------------------------------------------------------------------
2161 ;;; Shell mode.
2162
2163 (defun mdw-sh-mode-setup ()
2164   (local-set-key [?\C-a] 'comint-bol)
2165   (add-hook 'comint-output-filter-functions
2166             'comint-watch-for-password-prompt))
2167
2168 (defun mdw-term-mode-setup ()
2169   (setq term-prompt-regexp shell-prompt-pattern)
2170   (make-local-variable 'mouse-yank-at-point)
2171   (make-local-variable 'transient-mark-mode)
2172   (setq mouse-yank-at-point t)
2173   (auto-fill-mode -1)
2174   (setq tab-width 8))
2175
2176 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
2177 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
2178 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
2179 (defun term-send-meta-meta-something ()
2180   (interactive)
2181   (term-send-raw-string "\e\e")
2182   (term-send-raw))
2183 (eval-after-load 'term
2184   '(progn
2185      (define-key term-raw-map [?\e ?\e] nil)
2186      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
2187      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
2188      (define-key term-raw-map [M-right] 'term-send-meta-right)
2189      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
2190      (define-key term-raw-map [M-left] 'term-send-meta-left)
2191      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
2192
2193 ;;;----- That's all, folks --------------------------------------------------
2194
2195 (provide 'dot-emacs)