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

   1 ;;; -*- mode: emacs-lisp; coding: utf-8 -*-
   2 ;;;
   3 ;;; Functions and macros for .emacs
   4 ;;;
   5 ;;; (c) 2004 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 ;;;--------------------------------------------------------------------------
  25 ;;; Check command-line.
  26
  27 (defvar mdw-fast-startup nil
  28   "Whether .emacs should optimize for rapid startup.
  29 This may be at the expense of cool features.")
  30 (let ((probe nil) (next command-line-args))
  31   (while next
  32     (cond ((string= (car next) "--mdw-fast-startup")
  33            (setq mdw-fast-startup t)
  34            (if probe
  35                (rplacd probe (cdr next))
  36              (setq command-line-args (cdr next))))
  37           (t
  38            (setq probe next)))
  39     (setq next (cdr next))))
  40
  41 ;;;--------------------------------------------------------------------------
  42 ;;; Some general utilities.
  43
  44 (eval-when-compile
  45   (unless (fboundp 'make-regexp)
  46     (load "make-regexp"))
  47   (require 'cl))
  48
  49 (defmacro mdw-regexps (&rest list)
  50   "Turn a LIST of strings into a single regular expression at compile-time."
  51   (declare (indent nil)
  52            (debug 0))
  53   `',(make-regexp list))
  54
  55 ;; Some error trapping.
  56 ;;
  57 ;; If individual bits of this file go tits-up, we don't particularly want
  58 ;; the whole lot to stop right there and then, because it's bloody annoying.
  59
  60 (defmacro trap (&rest forms)
  61   "Execute FORMS without allowing errors to propagate outside."
  62   (declare (indent 0)
  63            (debug t))
  64   `(condition-case err
  65        ,(if (cdr forms) (cons 'progn forms) (car forms))
  66      (error (message "Error (trapped): %s in %s"
  67                      (error-message-string err)
  68                      ',forms))))
  69
  70 ;; Configuration reading.
  71
  72 (defvar mdw-config nil)
  73 (defun mdw-config (sym)
  74   "Read the configuration variable named SYM."
  75   (unless mdw-config
  76     (setq mdw-config
  77           (flet ((replace (what with)
  78                    (goto-char (point-min))
  79                    (while (re-search-forward what nil t)
  80                      (replace-match with t))))
  81             (with-temp-buffer
  82               (insert-file-contents "~/.mdw.conf")
  83               (replace  "^[ \t]*\\(#.*\\|\\)\n" "")
  84               (replace (concat "^[ \t]*"
  85                                "\\([-a-zA-Z0-9_.]*\\)"
  86                                "[ \t]*=[ \t]*"
  87                                "\\(.*[^ \t\n]\\|\\)"
  88                                "[ \t]**\\(\n\\|$\\)")
  89                        "(\\1 . \"\\2\")\n")
  90               (car (read-from-string
  91                     (concat "(" (buffer-string) ")")))))))
  92   (cdr (assq sym mdw-config)))
  93
  94 ;; Set up the load path convincingly.
  95
  96 (dolist (dir (append (and (boundp 'debian-emacs-flavor)
  97                           (list (concat "/usr/share/"
  98                                         (symbol-name debian-emacs-flavor)
  99                                         "/site-lisp")))))
 100   (dolist (sub (directory-files dir t))
 101     (when (and (file-accessible-directory-p sub)
 102                (not (member sub load-path)))
 103       (setq load-path (nconc load-path (list sub))))))
 104
 105 ;; Is an Emacs library available?
 106
 107 (defun library-exists-p (name)
 108   "Return non-nil if NAME is an available library.
 109 Return non-nil if NAME.el (or NAME.elc) somewhere on the Emacs
 110 load path.  The non-nil value is the filename we found for the
 111 library."
 112   (let ((path load-path) elt (foundp nil))
 113     (while (and path (not foundp))
 114       (setq elt (car path))
 115       (setq path (cdr path))
 116       (setq foundp (or (let ((file (concat elt "/" name ".elc")))
 117                          (and (file-exists-p file) file))
 118                        (let ((file (concat elt "/" name ".el")))
 119                          (and (file-exists-p file) file)))))
 120     foundp))
 121
 122 (defun maybe-autoload (symbol file &optional docstring interactivep type)
 123   "Set an autoload if the file actually exists."
 124   (and (library-exists-p file)
 125        (autoload symbol file docstring interactivep type)))
 126
 127 (defun mdw-kick-menu-bar (&optional frame)
 128   "Regenerate FRAME's menu bar so it doesn't have empty menus."
 129   (interactive)
 130   (unless frame (setq frame (selected-frame)))
 131   (let ((old (frame-parameter frame 'menu-bar-lines)))
 132     (set-frame-parameter frame 'menu-bar-lines 0)
 133     (set-frame-parameter frame 'menu-bar-lines old)))
 134
 135 ;; Splitting windows.
 136
 137 (unless (fboundp 'scroll-bar-columns)
 138   (defun scroll-bar-columns (side)
 139     (cond ((eq side 'left) 0)
 140           (window-system 3)
 141           (t 1))))
 142 (unless (fboundp 'fringe-columns)
 143   (defun fringe-columns (side)
 144     (cond ((not window-system) 0)
 145           ((eq side 'left) 1)
 146           (t 2))))
 147
 148 (defun mdw-horizontal-window-overhead ()
 149   "Computes the horizontal window overhead.
 150 This is the number of columns used by fringes, scroll bars and other such
 151 cruft."
 152   (if (not window-system)
 153       1
 154     (let ((tot 0))
 155       (dolist (what '(scroll-bar fringe))
 156         (dolist (side '(left right))
 157           (incf tot (funcall (intern (concat (symbol-name what) "-columns"))
 158                              side))))
 159       tot)))
 160
 161 (defun mdw-split-window-horizontally (&optional width)
 162   "Split a window horizontally.
 163 Without a numeric argument, split the window approximately in
 164 half.  With a numeric argument WIDTH, allocate WIDTH columns to
 165 the left-hand window (if positive) or -WIDTH columns to the
 166 right-hand window (if negative).  Space for scroll bars and
 167 fringes is not taken out of the allowance for WIDTH, unlike
 168 \\[split-window-horizontally]."
 169   (interactive "P")
 170   (split-window-horizontally
 171    (cond ((null width) nil)
 172          ((>= width 0) (+ width (mdw-horizontal-window-overhead)))
 173          ((< width 0) width))))
 174
 175 (defun mdw-divvy-window (&optional width)
 176   "Split a wide window into appropriate widths."
 177   (interactive "P")
 178   (setq width (cond (width (prefix-numeric-value width))
 179                     ((and window-system
 180                           (>= emacs-major-version 22))
 181                      77)
 182                     (t 78)))
 183   (let* ((win (selected-window))
 184          (sb-width (mdw-horizontal-window-overhead))
 185          (c (/ (+ (window-width) sb-width)
 186                (+ width sb-width))))
 187     (while (> c 1)
 188       (setq c (1- c))
 189       (split-window-horizontally (+ width sb-width))
 190       (other-window 1))
 191     (select-window win)))
 192
 193 ;; Don't raise windows unless I say so.
 194
 195 (defvar mdw-inhibit-raise-frame nil
 196   "*Whether `raise-frame' should do nothing when the frame is mapped.")
 197
 198 (defadvice raise-frame
 199     (around mdw-inhibit (&optional frame) activate compile)
 200   "Don't actually do anything if `mdw-inhibit-raise-frame' is true, and the
 201 frame is actually mapped on the screen."
 202   (if mdw-inhibit-raise-frame
 203       (make-frame-visible frame)
 204     ad-do-it))
 205
 206 (defmacro mdw-advise-to-inhibit-raise-frame (function)
 207   "Advise the FUNCTION not to raise frames, even if it wants to."
 208   `(defadvice ,function
 209        (around mdw-inhibit-raise (&rest hunoz) activate compile)
 210      "Don't raise the window unless you have to."
 211      (let ((mdw-inhibit-raise-frame t))
 212        ad-do-it)))
 213
 214 (mdw-advise-to-inhibit-raise-frame select-frame-set-input-focus)
 215
 216 ;; Transient mark mode hacks.
 217
 218 (defadvice exchange-point-and-mark
 219     (around mdw-highlight (&optional arg) activate compile)
 220   "Maybe don't actually exchange point and mark.
 221 If `transient-mark-mode' is on and the mark is inactive, then
 222 just activate it.  A non-trivial prefix argument will force the
 223 usual behaviour.  A trivial prefix argument (i.e., just C-u) will
 224 activate the mark and temporarily enable `transient-mark-mode' if
 225 it's currently off."
 226   (cond ((or mark-active
 227              (and (not transient-mark-mode) (not arg))
 228              (and arg (or (not (consp arg))
 229                           (not (= (car arg) 4)))))
 230          ad-do-it)
 231         (t
 232          (or transient-mark-mode (setq transient-mark-mode 'only))
 233          (set-mark (mark t)))))
 234
 235 ;; Functions for sexp diary entries.
 236
 237 (defun mdw-weekday (l)
 238   "Return non-nil if `date' falls on one of the days of the week in L.
 239 L is a list of day numbers (from 0 to 6 for Sunday through to
 240 Saturday) or symbols `sunday', `monday', etc. (or a mixture).  If
 241 the date stored in `date' falls on a listed day, then the
 242 function returns non-nil."
 243   (let ((d (calendar-day-of-week date)))
 244     (or (memq d l)
 245         (memq (nth d '(sunday monday tuesday wednesday
 246                               thursday friday saturday)) l))))
 247
 248 (defun mdw-todo (&optional when)
 249   "Return non-nil today, or on WHEN, whichever is later."
 250   (let ((w (calendar-absolute-from-gregorian (calendar-current-date)))
 251         (d (calendar-absolute-from-gregorian date)))
 252     (if when
 253         (setq w (max w (calendar-absolute-from-gregorian
 254                         (cond
 255                          ((not european-calendar-style)
 256                           when)
 257                          ((> (car when) 100)
 258                           (list (nth 1 when)
 259                                 (nth 2 when)
 260                                 (nth 0 when)))
 261                          (t
 262                           (list (nth 1 when)
 263                                 (nth 0 when)
 264                                 (nth 2 when))))))))
 265     (eq w d)))
 266
 267 ;; Fighting with Org-mode's evil key maps.
 268
 269 (defvar mdw-evil-keymap-keys
 270   '(([S-up] . [?\C-c up])
 271     ([S-down] . [?\C-c down])
 272     ([S-left] . [?\C-c left])
 273     ([S-right] . [?\C-c right])
 274     (([M-up] [?\e up]) . [C-up])
 275     (([M-down] [?\e down]) . [C-down])
 276     (([M-left] [?\e left]) . [C-left])
 277     (([M-right] [?\e right]) . [C-right]))
 278   "Defines evil keybindings to clobber in `mdw-clobber-evil-keymap'.
 279 The value is an alist mapping evil keys (as a list, or singleton)
 280 to good keys (in the same form).")
 281
 282 (defun mdw-clobber-evil-keymap (keymap)
 283   "Replace evil key bindings in the KEYMAP.
 284 Evil key bindings are defined in `mdw-evil-keymap-keys'."
 285   (dolist (entry mdw-evil-keymap-keys)
 286     (let ((binding nil)
 287           (keys (if (listp (car entry))
 288                     (car entry)
 289                   (list (car entry))))
 290           (replacements (if (listp (cdr entry))
 291                             (cdr entry)
 292                           (list (cdr entry)))))
 293       (catch 'found
 294         (dolist (key keys)
 295           (setq binding (lookup-key keymap key))
 296           (when binding
 297             (throw 'found nil))))
 298       (when binding
 299         (dolist (key keys)
 300           (define-key keymap key nil))
 301         (dolist (key replacements)
 302           (define-key keymap key binding))))))
 303
 304 (eval-after-load "org-latex"
 305   '(progn
 306      (push '("strayman"
 307              "\\documentclass{strayman}
 308 \\usepackage[utf8]{inputenc}
 309 \\usepackage[palatino, helvetica, courier, maths=cmr]{mdwfonts}
 310 \\usepackage[T1]{fontenc}
 311 \\usepackage{graphicx, tikz, mdwtab, mdwmath, crypto, longtable}"
 312              ("\\section{%s}" . "\\section*{%s}")
 313              ("\\subsection{%s}" . "\\subsection*{%s}")
 314              ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
 315              ("\\paragraph{%s}" . "\\paragraph*{%s}")
 316              ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
 317            org-export-latex-classes)))
 318
 319 (setq org-export-docbook-xslt-proc-command "xsltproc --output %o %s %i"
 320       org-export-docbook-xsl-fo-proc-command "fop %i.safe %o"
 321       org-export-docbook-xslt-stylesheet
 322       "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl")
 323
 324 ;;;--------------------------------------------------------------------------
 325 ;;; Mail and news hacking.
 326
 327 (define-derived-mode  mdwmail-mode mail-mode "[mdw] mail"
 328   "Major mode for editing news and mail messages from external programs.
 329 Not much right now.  Just support for doing MailCrypt stuff."
 330   :syntax-table nil
 331   :abbrev-table nil
 332   (run-hooks 'mail-setup-hook))
 333
 334 (define-key mdwmail-mode-map [?\C-c ?\C-c] 'disabled-operation)
 335
 336 (add-hook 'mdwail-mode-hook
 337           (lambda ()
 338             (set-buffer-file-coding-system 'utf-8)
 339             (make-local-variable 'paragraph-separate)
 340             (make-local-variable 'paragraph-start)
 341             (setq paragraph-start
 342                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 343                           paragraph-start))
 344             (setq paragraph-separate
 345                   (concat "[ \t]*[-_][-_][-_]+$\\|^-- \\|-----\\|"
 346                           paragraph-separate))))
 347
 348 ;; How to encrypt in mdwmail.
 349
 350 (defun mdwmail-mc-encrypt (&optional recip scm start end from sign)
 351   (or start
 352       (setq start (save-excursion
 353                     (goto-char (point-min))
 354                     (or (search-forward "\n\n" nil t) (point-min)))))
 355   (or end
 356       (setq end (point-max)))
 357   (mc-encrypt-generic recip scm start end from sign))
 358
 359 ;; How to sign in mdwmail.
 360
 361 (defun mdwmail-mc-sign (key scm start end uclr)
 362   (or start
 363       (setq start (save-excursion
 364                     (goto-char (point-min))
 365                     (or (search-forward "\n\n" nil t) (point-min)))))
 366   (or end
 367       (setq end (point-max)))
 368   (mc-sign-generic key scm start end uclr))
 369
 370 ;; Some signature mangling.
 371
 372 (defun mdwmail-mangle-signature ()
 373   (save-excursion
 374     (goto-char (point-min))
 375     (perform-replace "\n-- \n" "\n-- " nil nil nil)))
 376 (add-hook 'mail-setup-hook 'mdwmail-mangle-signature)
 377 (add-hook 'message-setup-hook 'mdwmail-mangle-signature)
 378
 379 ;; Insert my login name into message-ids, so I can score replies.
 380
 381 (defadvice message-unique-id (after mdw-user-name last activate compile)
 382   "Ensure that the user's name appears at the end of the message-id string,
 383 so that it can be used for convenient filtering."
 384   (setq ad-return-value (concat ad-return-value "." (user-login-name))))
 385
 386 ;; Tell my movemail hack where movemail is.
 387 ;;
 388 ;; This is needed to shup up warnings about LD_PRELOAD.
 389
 390 (let ((path exec-path))
 391   (while path
 392     (let ((try (expand-file-name "movemail" (car path))))
 393       (if (file-executable-p try)
 394           (setenv "REAL_MOVEMAIL" try))
 395       (setq path (cdr path)))))
 396
 397 (eval-after-load "erc"
 398     '(load "~/.ercrc.el"))
 399
 400 ;;;--------------------------------------------------------------------------
 401 ;;; Utility functions.
 402
 403 (or (fboundp 'line-number-at-pos)
 404     (defun line-number-at-pos (&optional pos)
 405       (let ((opoint (or pos (point))) start)
 406         (save-excursion
 407           (save-restriction
 408             (goto-char (point-min))
 409             (widen)
 410             (forward-line 0)
 411             (setq start (point))
 412             (goto-char opoint)
 413             (forward-line 0)
 414             (1+ (count-lines 1 (point))))))))
 415
 416 (defun mdw-uniquify-alist (&rest alists)
 417   "Return the concatenation of the ALISTS with duplicate elements removed.
 418 The first association with a given key prevails; others are
 419 ignored.  The input lists are not modified, although they'll
 420 probably become garbage."
 421   (and alists
 422        (let ((start-list (cons nil nil)))
 423          (mdw-do-uniquify start-list
 424                           start-list
 425                           (car alists)
 426                           (cdr alists)))))
 427
 428 (defun mdw-do-uniquify (done end l rest)
 429   "A helper function for mdw-uniquify-alist.
 430 The DONE argument is a list whose first element is `nil'.  It
 431 contains the uniquified alist built so far.  The leading `nil' is
 432 stripped off at the end of the operation; it's only there so that
 433 DONE always references a cons cell.  END refers to the final cons
 434 cell in the DONE list; it is modified in place each time to avoid
 435 the overheads of `append'ing all the time.  The L argument is the
 436 alist we're currently processing; the remaining alists are given
 437 in REST."
 438
 439   ;; There are several different cases to deal with here.
 440   (cond
 441
 442    ;; Current list isn't empty.  Add the first item to the DONE list if
 443    ;; there's not an item with the same KEY already there.
 444    (l (or (assoc (car (car l)) done)
 445           (progn
 446             (setcdr end (cons (car l) nil))
 447             (setq end (cdr end))))
 448       (mdw-do-uniquify done end (cdr l) rest))
 449
 450    ;; The list we were working on is empty.  Shunt the next list into the
 451    ;; current list position and go round again.
 452    (rest (mdw-do-uniquify done end (car rest) (cdr rest)))
 453
 454    ;; Everything's done.  Remove the leading `nil' from the DONE list and
 455    ;; return it.  Finished!
 456    (t (cdr done))))
 457
 458 (defun date ()
 459   "Insert the current date in a pleasing way."
 460   (interactive)
 461   (insert (save-excursion
 462             (let ((buffer (get-buffer-create "*tmp*")))
 463               (unwind-protect (progn (set-buffer buffer)
 464                                      (erase-buffer)
 465                                      (shell-command "date +%Y-%m-%d" t)
 466                                      (goto-char (mark))
 467                                      (delete-backward-char 1)
 468                                      (buffer-string))
 469                 (kill-buffer buffer))))))
 470
 471 (defun uuencode (file &optional name)
 472   "UUencodes a file, maybe calling it NAME, into the current buffer."
 473   (interactive "fInput file name: ")
 474
 475   ;; If NAME isn't specified, then guess from the filename.
 476   (if (not name)
 477       (setq name
 478             (substring file
 479                        (or (string-match "[^/]*$" file) 0))))
 480   (print (format "uuencode `%s' `%s'" file name))
 481
 482   ;; Now actually do the thing.
 483   (call-process "uuencode" file t nil name))
 484
 485 (defvar np-file "~/.np"
 486   "*Where the `now-playing' file is.")
 487
 488 (defun np (&optional arg)
 489   "Grabs a `now-playing' string."
 490   (interactive)
 491   (save-excursion
 492     (or arg (progn
 493               (goto-char (point-max))
 494               (insert "\nNP: ")
 495               (insert-file-contents np-file)))))
 496
 497 (defun mdw-version-< (ver-a ver-b)
 498   "Answer whether VER-A is strictly earlier than VER-B.
 499 VER-A and VER-B are version numbers, which are strings containing digit
 500 sequences separated by `.'."
 501   (let* ((la (mapcar (lambda (x) (car (read-from-string x)))
 502                      (split-string ver-a "\\.")))
 503          (lb (mapcar (lambda (x) (car (read-from-string x)))
 504                      (split-string ver-b "\\."))))
 505     (catch 'done
 506       (while t
 507         (cond ((null la) (throw 'done lb))
 508               ((null lb) (throw 'done nil))
 509               ((< (car la) (car lb)) (throw 'done t))
 510               ((= (car la) (car lb)) (setq la (cdr la) lb (cdr lb))))))))
 511
 512 (defun mdw-check-autorevert ()
 513   "Sets global-auto-revert-ignore-buffer appropriately for this buffer.
 514 This takes into consideration whether it's been found using
 515 tramp, which seems to get itself into a twist."
 516   (cond ((not (boundp 'global-auto-revert-ignore-buffer))
 517          nil)
 518         ((and (buffer-file-name)
 519               (fboundp 'tramp-tramp-file-p)
 520               (tramp-tramp-file-p (buffer-file-name)))
 521          (unless global-auto-revert-ignore-buffer
 522            (setq global-auto-revert-ignore-buffer 'tramp)))
 523         ((eq global-auto-revert-ignore-buffer 'tramp)
 524          (setq global-auto-revert-ignore-buffer nil))))
 525
 526 (defadvice find-file (after mdw-autorevert activate)
 527   (mdw-check-autorevert))
 528 (defadvice write-file (after mdw-autorevert activate)
 529   (mdw-check-autorevert))
 530
 531 ;;;--------------------------------------------------------------------------
 532 ;;; Dired hacking.
 533
 534 (defadvice dired-maybe-insert-subdir
 535     (around mdw-marked-insertion first activate)
 536   "The DIRNAME may be a list of directory names to insert.
 537 Interactively, if files are marked, then insert all of them.
 538 With a numeric prefix argument, select that many entries near
 539 point; with a non-numeric prefix argument, prompt for listing
 540 options."
 541   (interactive
 542    (list (dired-get-marked-files nil
 543                                  (and (integerp current-prefix-arg)
 544                                       current-prefix-arg)
 545                                  #'file-directory-p)
 546          (and current-prefix-arg
 547               (not (integerp current-prefix-arg))
 548               (read-string "Switches for listing: "
 549                            (or dired-subdir-switches
 550                                dired-actual-switches)))))
 551   (let ((dirs (ad-get-arg 0)))
 552     (dolist (dir (if (listp dirs) dirs (list dirs)))
 553       (ad-set-arg 0 dir)
 554       ad-do-it)))
 555
 556 ;;;--------------------------------------------------------------------------
 557 ;;; URL viewing.
 558
 559 (defun mdw-w3m-browse-url (url &optional new-session-p)
 560   "Invoke w3m on the URL in its current window, or at least a different one.
 561 If NEW-SESSION-P, start a new session."
 562   (interactive "sURL: \nP")
 563   (save-excursion
 564     (let ((window (selected-window)))
 565       (unwind-protect
 566           (progn
 567             (select-window (or (and (not new-session-p)
 568                                     (get-buffer-window "*w3m*"))
 569                                (progn
 570                                  (if (one-window-p t) (split-window))
 571                                  (get-lru-window))))
 572             (w3m-browse-url url new-session-p))
 573         (select-window window)))))
 574
 575 (defvar mdw-good-url-browsers
 576   '(browse-url-generic
 577     (w3m . mdw-w3m-browse-url)
 578     browse-url-w3
 579     browse-url-mozilla)
 580   "List of good browsers for mdw-good-url-browsers.
 581 Each item is a browser function name, or a cons (CHECK . FUNC).
 582 A symbol FOO stands for (FOO . FOO).")
 583
 584 (defun mdw-good-url-browser ()
 585   "Return a good URL browser.
 586 Trundle the list of such things, finding the first item for which
 587 CHECK is fboundp, and returning the correponding FUNC."
 588   (let ((bs mdw-good-url-browsers) b check func answer)
 589     (while (and bs (not answer))
 590       (setq b (car bs)
 591             bs (cdr bs))
 592       (if (consp b)
 593           (setq check (car b) func (cdr b))
 594         (setq check b func b))
 595       (if (fboundp check)
 596           (setq answer func)))
 597     answer))
 598
 599 (eval-after-load "w3m-search"
 600   '(progn
 601      (dolist
 602          (item
 603           '(("g" "Google" "http://www.google.co.uk/search?q=%s")
 604             ("gd" "Google Directory"
 605              "http://www.google.com/search?cat=gwd/Top&q=%s")
 606             ("gg" "Google Groups" "http://groups.google.com/groups?q=%s")
 607             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
 608             ("gi" "Images" "http://images.google.com/images?q=%s")
 609             ("rfc" "RFC"
 610              "http://metalzone.distorted.org.uk/ftp/pub/mirrors/rfc/rfc%s.txt.gz")
 611             ("wp" "Wikipedia"
 612              "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
 613             ("imdb" "IMDb" "http://www.imdb.com/Find?%s")
 614             ("nc-wiki" "nCipher wiki"
 615              "http://wiki.ncipher.com/wiki/bin/view/Devel/?topic=%s")
 616             ("map" "Google maps" "http://maps.google.co.uk/maps?q=%s&hl=en")
 617             ("lp" "Launchpad bug by number"
 618              "https://bugs.launchpad.net/bugs/%s")
 619             ("lppkg" "Launchpad bugs by package"
 620              "https://bugs.launchpad.net/%s")
 621             ("msdn" "MSDN"
 622              "http://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
 623             ("debbug" "Debian bug by number"
 624              "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
 625             ("debbugpkg" "Debian bugs by package"
 626              "http://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")
 627             ("ljlogin" "LJ login" "http://www.livejournal.com/login.bml")))
 628        (add-to-list 'w3m-search-engine-alist
 629                     (list (cadr item) (caddr item) nil))
 630        (add-to-list 'w3m-uri-replace-alist
 631                     (list (concat "\\`" (car item) ":")
 632                           'w3m-search-uri-replace
 633                           (cadr item))))))
 634
 635 ;;;--------------------------------------------------------------------------
 636 ;;; Paragraph filling.
 637
 638 ;; Useful variables.
 639
 640 (defvar mdw-fill-prefix nil
 641   "*Used by `mdw-line-prefix' and `mdw-fill-paragraph'.
 642 If there's no fill prefix currently set (by the `fill-prefix'
 643 variable) and there's a match from one of the regexps here, it
 644 gets used to set the fill-prefix for the current operation.
 645
 646 The variable is a list of items of the form `REGEXP . PREFIX'; if
 647 the REGEXP matches, the PREFIX is used to set the fill prefix.
 648 It in turn is a list of things:
 649
 650   STRING -- insert a literal string
 651   (match . N) -- insert the thing matched by bracketed subexpression N
 652   (pad . N) -- a string of whitespace the same width as subexpression N
 653   (expr . FORM) -- the result of evaluating FORM")
 654
 655 (make-variable-buffer-local 'mdw-fill-prefix)
 656
 657 (defvar mdw-hanging-indents
 658   (concat "\\(\\("
 659             "\\([*o+]\\|-[-#]?\\|[0-9]+\\.\\|\\[[0-9]+\\]\\|([a-zA-Z])\\)"
 660             "[ \t]+"
 661           "\\)?\\)")
 662   "*Standard regexp matching parts of a hanging indent.
 663 This is mainly useful in `auto-fill-mode'.")
 664
 665 ;; Setting things up.
 666
 667 (fset 'mdw-do-auto-fill (symbol-function 'do-auto-fill))
 668
 669 ;; Utility functions.
 670
 671 (defun mdw-maybe-tabify (s)
 672   "Tabify or untabify the string S, according to `indent-tabs-mode'."
 673   (let ((tabfun (if indent-tabs-mode #'tabify #'untabify)))
 674     (with-temp-buffer
 675       (save-match-data
 676         (insert s "\n")
 677         (let ((start (point-min)) (end (point-max)))
 678           (funcall tabfun (point-min) (point-max))
 679           (setq s (buffer-substring (point-min) (1- (point-max)))))))))
 680
 681 (defun mdw-examine-fill-prefixes (l)
 682   "Given a list of dynamic fill prefixes, pick one which matches
 683 context and return the static fill prefix to use.  Point must be
 684 at the start of a line, and match data must be saved."
 685   (cond ((not l) nil)
 686                ((looking-at (car (car l)))
 687                 (mdw-maybe-tabify (apply #'concat
 688                                          (mapcar #'mdw-do-prefix-match
 689                                                  (cdr (car l))))))
 690                (t (mdw-examine-fill-prefixes (cdr l)))))
 691
 692 (defun mdw-maybe-car (p)
 693   "If P is a pair, return (car P), otherwise just return P."
 694   (if (consp p) (car p) p))
 695
 696 (defun mdw-padding (s)
 697   "Return a string the same width as S but made entirely from whitespace."
 698   (let* ((l (length s)) (i 0) (n (make-string l ? )))
 699     (while (< i l)
 700       (if (= 9 (aref s i))
 701           (aset n i 9))
 702       (setq i (1+ i)))
 703     n))
 704
 705 (defun mdw-do-prefix-match (m)
 706   "Expand a dynamic prefix match element.
 707 See `mdw-fill-prefix' for details."
 708   (cond ((not (consp m)) (format "%s" m))
 709            ((eq (car m) 'match) (match-string (mdw-maybe-car (cdr m))))
 710            ((eq (car m) 'pad) (mdw-padding (match-string
 711                                             (mdw-maybe-car (cdr m)))))
 712            ((eq (car m) 'eval) (eval (cdr m)))
 713            (t "")))
 714
 715 (defun mdw-choose-dynamic-fill-prefix ()
 716   "Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
 717   (cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
 718            ((not mdw-fill-prefix) fill-prefix)
 719            (t (save-excursion
 720                 (beginning-of-line)
 721                 (save-match-data
 722                   (mdw-examine-fill-prefixes mdw-fill-prefix))))))
 723
 724 (defun do-auto-fill ()
 725   "Handle auto-filling, working out a dynamic fill prefix in the
 726 case where there isn't a sensible static one."
 727   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 728     (mdw-do-auto-fill)))
 729
 730 (defun mdw-fill-paragraph ()
 731   "Fill paragraph, getting a dynamic fill prefix."
 732   (interactive)
 733   (let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
 734     (fill-paragraph nil)))
 735
 736 (defun mdw-standard-fill-prefix (rx &optional mat)
 737   "Set the dynamic fill prefix, handling standard hanging indents and stuff.
 738 This is just a short-cut for setting the thing by hand, and by
 739 design it doesn't cope with anything approximating a complicated
 740 case."
 741   (setq mdw-fill-prefix
 742            `((,(concat rx mdw-hanging-indents)
 743               (match . 1)
 744               (pad . ,(or mat 2))))))
 745
 746 ;;;--------------------------------------------------------------------------
 747 ;;; Other common declarations.
 748
 749 ;; Common mode settings.
 750
 751 (defvar mdw-auto-indent t
 752   "Whether to indent automatically after a newline.")
 753
 754 (defun mdw-whitespace-mode (&optional arg)
 755   "Turn on/off whitespace mode, but don't highlight trailing space."
 756   (interactive "P")
 757   (when (and (boundp 'whitespace-style)
 758              (fboundp 'whitespace-mode))
 759     (let ((whitespace-style (remove 'trailing whitespace-style)))
 760       (whitespace-mode arg))
 761     (setq show-trailing-whitespace whitespace-mode)))
 762
 763 (defun mdw-misc-mode-config ()
 764   (and mdw-auto-indent
 765        (cond ((eq major-mode 'lisp-mode)
 766               (local-set-key "\C-m" 'mdw-indent-newline-and-indent))
 767              ((or (eq major-mode 'slime-repl-mode)
 768                   (eq major-mode 'asm-mode))
 769               nil)
 770              (t
 771               (local-set-key "\C-m" 'newline-and-indent))))
 772   (local-set-key [C-return] 'newline)
 773   (make-local-variable 'page-delimiter)
 774   (setq page-delimiter "\f\\|^.*-\\{6\\}.*$")
 775   (setq comment-column 40)
 776   (auto-fill-mode 1)
 777   (setq fill-column 77)
 778   (setq show-trailing-whitespace t)
 779   (mdw-whitespace-mode 1)
 780   (and (fboundp 'gtags-mode)
 781        (gtags-mode))
 782   (if (fboundp 'hs-minor-mode)
 783       (trap (hs-minor-mode t))
 784     (outline-minor-mode t))
 785   (reveal-mode t)
 786   (trap (turn-on-font-lock)))
 787
 788 (defun mdw-post-config-mode-hack ()
 789   (mdw-whitespace-mode 1))
 790
 791 (eval-after-load 'gtags
 792   '(progn
 793      (dolist (key '([mouse-2] [mouse-3]))
 794        (define-key gtags-mode-map key nil))
 795      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
 796      (define-key gtags-select-mode-map [C-S-mouse-2]
 797        'gtags-select-tag-by-event)
 798      (dolist (map (list gtags-mode-map gtags-select-mode-map))
 799        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
 800
 801 ;; Backup file handling.
 802
 803 (defvar mdw-backup-disable-regexps nil
 804   "*List of regular expressions: if a file name matches any of
 805 these then the file is not backed up.")
 806
 807 (defun mdw-backup-enable-predicate (name)
 808   "[mdw]'s default backup predicate.
 809 Allows a backup if the standard predicate would allow it, and it
 810 doesn't match any of the regular expressions in
 811 `mdw-backup-disable-regexps'."
 812   (and (normal-backup-enable-predicate name)
 813        (let ((answer t) (list mdw-backup-disable-regexps))
 814          (save-match-data
 815            (while list
 816              (if (string-match (car list) name)
 817                  (setq answer nil))
 818              (setq list (cdr list)))
 819            answer))))
 820 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
 821
 822 ;; Frame cleanup.
 823
 824 (defun mdw-last-one-out-turn-off-the-lights (frame)
 825   "Disconnect from an X display if this was the last frame on that display."
 826   (let ((frame-display (frame-parameter frame 'display)))
 827     (when (and frame-display
 828                (eq window-system 'x)
 829                (not (some (lambda (fr)
 830                             (and (not (eq fr frame))
 831                                  (string= (frame-parameter fr 'display)
 832                                           frame-display)))
 833                           (frame-list))))
 834       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 835 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 836
 837 ;;;--------------------------------------------------------------------------
 838 ;;; General fontification.
 839
 840 (defmacro mdw-define-face (name &rest body)
 841   "Define a face, and make sure it's actually set as the definition."
 842   (declare (indent 1)
 843            (debug 0))
 844   `(progn
 845      (make-face ',name)
 846      (defvar ,name ',name)
 847      (put ',name 'face-defface-spec ',body)
 848      (face-spec-set ',name ',body nil)))
 849
 850 (mdw-define-face default
 851   (((type w32)) :family "courier new" :height 85)
 852   (((type x)) :family "6x13" :foundry "trad" :height 130)
 853   (((type color)) :foreground "white" :background "black")
 854   (t nil))
 855 (mdw-define-face fixed-pitch
 856   (((type w32)) :family "courier new" :height 85)
 857   (((type x)) :family "6x13" :foundry "trad" :height 130)
 858   (t :foreground "white" :background "black"))
 859 (if (>= emacs-major-version 23)
 860     (mdw-define-face variable-pitch
 861       (((type x)) :family "sans" :height 100))
 862   (mdw-define-face variable-pitch
 863     (((type x)) :family "helvetica" :height 90)))
 864 (mdw-define-face region
 865   (((type tty) (class color)) :background "blue")
 866   (((type tty) (class mono)) :inverse-video t)
 867   (t :background "grey30"))
 868 (mdw-define-face minibuffer-prompt
 869   (t :weight bold))
 870 (mdw-define-face mode-line
 871   (((class color)) :foreground "blue" :background "yellow"
 872                    :box (:line-width 1 :style released-button))
 873   (t :inverse-video t))
 874 (mdw-define-face mode-line-inactive
 875   (((class color)) :foreground "yellow" :background "blue"
 876                    :box (:line-width 1 :style released-button))
 877   (t :inverse-video t))
 878 (mdw-define-face scroll-bar
 879   (t :foreground "black" :background "lightgrey"))
 880 (mdw-define-face fringe
 881   (t :foreground "yellow"))
 882 (mdw-define-face show-paren-match
 883   (((class color)) :background "darkgreen")
 884   (t :underline t))
 885 (mdw-define-face show-paren-mismatch
 886   (((class color)) :background "red")
 887   (t :inverse-video t))
 888 (mdw-define-face highlight
 889   (((type x) (class color)) :background "DarkSeaGreen4")
 890   (((type tty) (class color)) :background "cyan")
 891   (t :inverse-video t))
 892
 893 (mdw-define-face holiday-face
 894   (t :background "red"))
 895 (mdw-define-face calendar-today-face
 896   (t :foreground "yellow" :weight bold))
 897
 898 (mdw-define-face comint-highlight-prompt
 899   (t :weight bold))
 900 (mdw-define-face comint-highlight-input
 901   (t nil))
 902
 903 (mdw-define-face dired-directory
 904   (t :foreground "cyan" :weight bold))
 905 (mdw-define-face dired-symlink
 906   (t :foreground "cyan"))
 907 (mdw-define-face dired-perm-write
 908   (t nil))
 909
 910 (mdw-define-face trailing-whitespace
 911   (((class color)) :background "red")
 912   (t :inverse-video t))
 913 (mdw-define-face mdw-punct-face
 914   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
 915 (mdw-define-face mdw-number-face
 916   (t :foreground "yellow"))
 917 (mdw-define-face font-lock-function-name-face
 918   (t :slant italic))
 919 (mdw-define-face font-lock-keyword-face
 920   (t :weight bold))
 921 (mdw-define-face font-lock-constant-face
 922   (t :slant italic))
 923 (mdw-define-face font-lock-builtin-face
 924   (t :weight bold))
 925 (mdw-define-face font-lock-type-face
 926   (t :weight bold :slant italic))
 927 (mdw-define-face font-lock-reference-face
 928   (t :weight bold))
 929 (mdw-define-face font-lock-variable-name-face
 930   (t :slant italic))
 931 (mdw-define-face font-lock-comment-delimiter-face
 932   (((class mono)) :weight bold)
 933   (((type tty) (class color)) :foreground "green")
 934   (t :slant italic :foreground "SeaGreen1"))
 935 (mdw-define-face font-lock-comment-face
 936   (((class mono)) :weight bold)
 937   (((type tty) (class color)) :foreground "green")
 938   (t :slant italic :foreground "SeaGreen1"))
 939 (mdw-define-face font-lock-string-face
 940   (((class mono)) :weight bold)
 941   (((class color)) :foreground "SkyBlue1"))
 942
 943 (mdw-define-face message-separator
 944   (t :background "red" :foreground "white" :weight bold))
 945 (mdw-define-face message-cited-text
 946   (default :slant italic)
 947   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 948 (mdw-define-face message-header-cc
 949   (default :weight bold)
 950   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 951 (mdw-define-face message-header-newsgroups
 952   (default :weight bold)
 953   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 954 (mdw-define-face message-header-subject
 955   (default :weight bold)
 956   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 957 (mdw-define-face message-header-to
 958   (default :weight bold)
 959   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 960 (mdw-define-face message-header-xheader
 961   (default :weight bold)
 962   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 963 (mdw-define-face message-header-other
 964   (default :weight bold)
 965   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 966 (mdw-define-face message-header-name
 967   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
 968 (mdw-define-face which-func
 969   (t nil))
 970
 971 (mdw-define-face diff-header
 972   (t nil))
 973 (mdw-define-face diff-index
 974   (t :weight bold))
 975 (mdw-define-face diff-file-header
 976   (t :weight bold))
 977 (mdw-define-face diff-hunk-header
 978   (t :foreground "SkyBlue1"))
 979 (mdw-define-face diff-function
 980   (t :foreground "SkyBlue1" :weight bold))
 981 (mdw-define-face diff-header
 982   (t :background "grey10"))
 983 (mdw-define-face diff-added
 984   (t :foreground "green"))
 985 (mdw-define-face diff-removed
 986   (t :foreground "red"))
 987 (mdw-define-face diff-context
 988   (t nil))
 989 (mdw-define-face diff-refine-change
 990   (((class color) (type x)) :background "RoyalBlue4")
 991   (t :underline t))
 992
 993 (mdw-define-face dylan-header-background
 994   (((class color) (type x)) :background "NavyBlue")
 995   (t :background "blue"))
 996
 997 (mdw-define-face magit-diff-add
 998   (t :foreground "green"))
 999 (mdw-define-face magit-diff-del
1000   (t :foreground "red"))
1001 (mdw-define-face magit-diff-file-header
1002   (t :weight bold))
1003 (mdw-define-face magit-diff-hunk-header
1004   (t :foreground "SkyBlue1"))
1005 (mdw-define-face magit-item-highlight
1006   (((type tty)) :background "blue")
1007   (t :background "DarkSeaGreen4"))
1008 (mdw-define-face magit-log-head-label-remote
1009   (((type tty)) :background "cyan" :foreground "green")
1010   (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1011 (mdw-define-face magit-log-head-label-local
1012   (((type tty)) :background "cyan" :foreground "yellow")
1013   (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1014 (mdw-define-face magit-log-head-label-tags
1015   (((type tty)) :background "red" :foreground "yellow")
1016   (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1017 (mdw-define-face magit-log-graph
1018   (((type tty)) :foreground "magenta")
1019   (t :foreground "grey80"))
1020
1021 (mdw-define-face erc-input-face
1022   (t :foreground "red"))
1023
1024 (mdw-define-face woman-bold
1025   (t :weight bold))
1026 (mdw-define-face woman-italic
1027   (t :slant italic))
1028
1029 (eval-after-load "rst"
1030   '(progn
1031      (mdw-define-face rst-level-1-face
1032        (t :foreground "SkyBlue1" :weight bold))
1033      (mdw-define-face rst-level-2-face
1034        (t :foreground "SeaGreen1" :weight bold))
1035      (mdw-define-face rst-level-3-face
1036        (t :weight bold))
1037      (mdw-define-face rst-level-4-face
1038        (t :slant italic))
1039      (mdw-define-face rst-level-5-face
1040        (t :underline t))
1041      (mdw-define-face rst-level-6-face
1042        ())))
1043
1044 (mdw-define-face p4-depot-added-face
1045   (t :foreground "green"))
1046 (mdw-define-face p4-depot-branch-op-face
1047   (t :foreground "yellow"))
1048 (mdw-define-face p4-depot-deleted-face
1049   (t :foreground "red"))
1050 (mdw-define-face p4-depot-unmapped-face
1051   (t :foreground "SkyBlue1"))
1052 (mdw-define-face p4-diff-change-face
1053   (t :foreground "yellow"))
1054 (mdw-define-face p4-diff-del-face
1055   (t :foreground "red"))
1056 (mdw-define-face p4-diff-file-face
1057   (t :foreground "SkyBlue1"))
1058 (mdw-define-face p4-diff-head-face
1059   (t :background "grey10"))
1060 (mdw-define-face p4-diff-ins-face
1061   (t :foreground "green"))
1062
1063 (mdw-define-face w3m-anchor-face
1064   (t :foreground "SkyBlue1" :underline t))
1065 (mdw-define-face w3m-arrived-anchor-face
1066   (t :foreground "SkyBlue1" :underline t))
1067
1068 (mdw-define-face whizzy-slice-face
1069   (t :background "grey10"))
1070 (mdw-define-face whizzy-error-face
1071   (t :background "darkred"))
1072
1073 ;; Ellipses used to indicate hidden text (and similar).
1074 (mdw-define-face mdw-ellipsis-face
1075   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1076 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1077       (backslash (make-glyph-code ?\ 'mdw-ellipsis-face))
1078       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1079       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1080   (set-display-table-slot standard-display-table 0 dollar)
1081   (set-display-table-slot standard-display-table 1 backslash)
1082   (set-display-table-slot standard-display-table 4
1083                           (vector dot dot dot))
1084   (set-display-table-slot standard-display-table 5 bar))
1085
1086 ;;;--------------------------------------------------------------------------
1087 ;;; C programming configuration.
1088
1089 ;; Linux kernel hacking.
1090
1091 (defvar linux-c-mode-hook)
1092
1093 (defun linux-c-mode ()
1094   (interactive)
1095   (c-mode)
1096   (setq major-mode 'linux-c-mode)
1097   (setq mode-name "Linux C")
1098   (run-hooks 'linux-c-mode-hook))
1099
1100 ;; Make C indentation nice.
1101
1102 (defun mdw-c-lineup-arglist (langelem)
1103   "Hack for DWIMmery in c-lineup-arglist."
1104   (if (save-excursion
1105         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1106       0
1107     (c-lineup-arglist langelem)))
1108
1109 (defun mdw-c-indent-extern-mumble (langelem)
1110   "Indent `extern \"...\" {' lines."
1111   (save-excursion
1112     (back-to-indentation)
1113     (if (looking-at
1114          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1115         c-basic-offset
1116       nil)))
1117
1118 (defun mdw-c-style ()
1119   (c-add-style "[mdw] C and C++ style"
1120                '((c-basic-offset . 2)
1121                  (comment-column . 40)
1122                  (c-class-key . "class")
1123                  (c-backslash-column . 72)
1124                  (c-offsets-alist
1125                   (substatement-open . (add 0 c-indent-one-line-block))
1126                   (defun-open . (add 0 c-indent-one-line-block))
1127                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1128                   (topmost-intro . mdw-c-indent-extern-mumble)
1129                   (cpp-define-intro . 0)
1130                   (knr-argdecl . 0)
1131                   (inextern-lang . [0])
1132                   (label . 0)
1133                   (case-label . +)
1134                   (access-label . -)
1135                   (inclass . +)
1136                   (inline-open . ++)
1137                   (statement-cont . +)
1138                   (statement-case-intro . +)))
1139                t))
1140
1141 (defvar mdw-c-comment-fill-prefix
1142   `((,(concat "\\([ \t]*/?\\)"
1143               "\\(\*\\|//]\\)"
1144               "\\([ \t]*\\)"
1145               "\\([A-Za-z]+:[ \t]*\\)?"
1146               mdw-hanging-indents)
1147      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1148   "Fill prefix matching C comments (both kinds).")
1149
1150 (defun mdw-fontify-c-and-c++ ()
1151
1152   ;; Fiddle with some syntax codes.
1153   (modify-syntax-entry ?* ". 23")
1154   (modify-syntax-entry ?/ ". 124b")
1155   (modify-syntax-entry ?\n "> b")
1156
1157   ;; Other stuff.
1158   (mdw-c-style)
1159   (setq c-hanging-comment-ender-p nil)
1160   (setq c-backslash-column 72)
1161   (setq c-label-minimum-indentation 0)
1162   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1163
1164   ;; Now define things to be fontified.
1165   (make-local-variable 'font-lock-keywords)
1166   (let ((c-keywords
1167          (mdw-regexps "and"             ;C++
1168                       "and_eq"          ;C++
1169                       "asm"             ;K&R, GCC
1170                       "auto"            ;K&R, C89
1171                       "bitand"          ;C++
1172                       "bitor"           ;C++
1173                       "bool"            ;C++, C9X macro
1174                       "break"           ;K&R, C89
1175                       "case"            ;K&R, C89
1176                       "catch"           ;C++
1177                       "char"            ;K&R, C89
1178                       "class"           ;C++
1179                       "complex"         ;C9X macro, C++ template type
1180                       "compl"           ;C++
1181                       "const"           ;C89
1182                       "const_cast"      ;C++
1183                       "continue"        ;K&R, C89
1184                       "defined"         ;C89 preprocessor
1185                       "default"         ;K&R, C89
1186                       "delete"          ;C++
1187                       "do"              ;K&R, C89
1188                       "double"          ;K&R, C89
1189                       "dynamic_cast"    ;C++
1190                       "else"            ;K&R, C89
1191                       ;; "entry"        ;K&R -- never used
1192                       "enum"            ;C89
1193                       "explicit"        ;C++
1194                       "export"          ;C++
1195                       "extern"          ;K&R, C89
1196                       "false"           ;C++, C9X macro
1197                       "float"           ;K&R, C89
1198                       "for"             ;K&R, C89
1199                       ;; "fortran"      ;K&R
1200                       "friend"          ;C++
1201                       "goto"            ;K&R, C89
1202                       "if"              ;K&R, C89
1203                       "imaginary"       ;C9X macro
1204                       "inline"          ;C++, C9X, GCC
1205                       "int"             ;K&R, C89
1206                       "long"            ;K&R, C89
1207                       "mutable"         ;C++
1208                       "namespace"       ;C++
1209                       "new"             ;C++
1210                       "operator"        ;C++
1211                       "or"              ;C++
1212                       "or_eq"           ;C++
1213                       "private"         ;C++
1214                       "protected"       ;C++
1215                       "public"          ;C++
1216                       "register"        ;K&R, C89
1217                       "reinterpret_cast" ;C++
1218                       "restrict"         ;C9X
1219                       "return"           ;K&R, C89
1220                       "short"            ;K&R, C89
1221                       "signed"           ;C89
1222                       "sizeof"           ;K&R, C89
1223                       "static"           ;K&R, C89
1224                       "static_cast"      ;C++
1225                       "struct"           ;K&R, C89
1226                       "switch"           ;K&R, C89
1227                       "template"         ;C++
1228                       "this"             ;C++
1229                       "throw"            ;C++
1230                       "true"             ;C++, C9X macro
1231                       "try"              ;C++
1232                       "this"             ;C++
1233                       "typedef"          ;C89
1234                       "typeid"           ;C++
1235                       "typeof"           ;GCC
1236                       "typename"         ;C++
1237                       "union"            ;K&R, C89
1238                       "unsigned"         ;K&R, C89
1239                       "using"            ;C++
1240                       "virtual"          ;C++
1241                       "void"             ;C89
1242                       "volatile"         ;C89
1243                       "wchar_t"          ;C++, C89 library type
1244                       "while"            ;K&R, C89
1245                       "xor"              ;C++
1246                       "xor_eq"           ;C++
1247                       "_Bool"            ;C9X
1248                       "_Complex"         ;C9X
1249                       "_Imaginary"       ;C9X
1250                       "_Pragma"          ;C9X preprocessor
1251                       "__alignof__"      ;GCC
1252                       "__asm__"          ;GCC
1253                       "__attribute__"    ;GCC
1254                       "__complex__"      ;GCC
1255                       "__const__"        ;GCC
1256                       "__extension__"    ;GCC
1257                       "__imag__"         ;GCC
1258                       "__inline__"       ;GCC
1259                       "__label__"        ;GCC
1260                       "__real__"         ;GCC
1261                       "__signed__"       ;GCC
1262                       "__typeof__"       ;GCC
1263                       "__volatile__"     ;GCC
1264                       ))
1265         (preprocessor-keywords
1266          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1267                       "ident" "if" "ifdef" "ifndef" "import" "include"
1268                       "line" "pragma" "unassert" "undef" "warning"))
1269         (objc-keywords
1270          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1271                       "interface" "private" "protected" "protocol" "public"
1272                       "selector")))
1273
1274     (setq font-lock-keywords
1275           (list
1276
1277            ;; Fontify include files as strings.
1278            (list (concat "^[ \t]*\\#[ \t]*"
1279                          "\\(include\\|import\\)"
1280                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1281                  '(2 font-lock-string-face))
1282
1283            ;; Preprocessor directives are `references'?.
1284            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1285                          preprocessor-keywords
1286                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1287                  '(1 font-lock-keyword-face))
1288
1289            ;; Handle the keywords defined above.
1290            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1291                  '(0 font-lock-keyword-face))
1292
1293            (list (concat "\\<\\(" c-keywords "\\)\\>")
1294                  '(0 font-lock-keyword-face))
1295
1296            ;; Handle numbers too.
1297            ;;
1298            ;; This looks strange, I know.  It corresponds to the
1299            ;; preprocessor's idea of what a number looks like, rather than
1300            ;; anything sensible.
1301            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1302                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1303                  '(0 mdw-number-face))
1304
1305            ;; And anything else is punctuation.
1306            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1307                  '(0 mdw-punct-face))))
1308
1309     (mdw-post-config-mode-hack)))
1310
1311 ;;;--------------------------------------------------------------------------
1312 ;;; AP calc mode.
1313
1314 (defun apcalc-mode ()
1315   (interactive)
1316   (c-mode)
1317   (setq major-mode 'apcalc-mode)
1318   (setq mode-name "AP Calc")
1319   (run-hooks 'apcalc-mode-hook))
1320
1321 (defun mdw-fontify-apcalc ()
1322
1323   ;; Fiddle with some syntax codes.
1324   (modify-syntax-entry ?* ". 23")
1325   (modify-syntax-entry ?/ ". 14")
1326
1327   ;; Other stuff.
1328   (mdw-c-style)
1329   (setq c-hanging-comment-ender-p nil)
1330   (setq c-backslash-column 72)
1331   (setq comment-start "/* ")
1332   (setq comment-end " */")
1333   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1334
1335   ;; Now define things to be fontified.
1336   (make-local-variable 'font-lock-keywords)
1337   (let ((c-keywords
1338          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1339                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1340                       "local" "mat" "obj" "print" "quit" "read" "return"
1341                       "show" "static" "switch" "while" "write")))
1342
1343     (setq font-lock-keywords
1344           (list
1345
1346            ;; Handle the keywords defined above.
1347            (list (concat "\\<\\(" c-keywords "\\)\\>")
1348                  '(0 font-lock-keyword-face))
1349
1350            ;; Handle numbers too.
1351            ;;
1352            ;; This looks strange, I know.  It corresponds to the
1353            ;; preprocessor's idea of what a number looks like, rather than
1354            ;; anything sensible.
1355            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1356                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1357                  '(0 mdw-number-face))
1358
1359            ;; And anything else is punctuation.
1360            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1361                  '(0 mdw-punct-face)))))
1362
1363   (mdw-post-config-mode-hack))
1364
1365 ;;;--------------------------------------------------------------------------
1366 ;;; Java programming configuration.
1367
1368 ;; Make indentation nice.
1369
1370 (defun mdw-java-style ()
1371   (c-add-style "[mdw] Java style"
1372                '((c-basic-offset . 2)
1373                  (c-offsets-alist (substatement-open . 0)
1374                                   (label . +)
1375                                   (case-label . +)
1376                                   (access-label . 0)
1377                                   (inclass . +)
1378                                   (statement-case-intro . +)))
1379                t))
1380
1381 ;; Declare Java fontification style.
1382
1383 (defun mdw-fontify-java ()
1384
1385   ;; Other stuff.
1386   (mdw-java-style)
1387   (setq c-hanging-comment-ender-p nil)
1388   (setq c-backslash-column 72)
1389   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1390
1391   ;; Now define things to be fontified.
1392   (make-local-variable 'font-lock-keywords)
1393   (let ((java-keywords
1394          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1395                       "char" "class" "const" "continue" "default" "do"
1396                       "double" "else" "extends" "final" "finally" "float"
1397                       "for" "goto" "if" "implements" "import" "instanceof"
1398                       "int" "interface" "long" "native" "new" "package"
1399                       "private" "protected" "public" "return" "short"
1400                       "static" "super" "switch" "synchronized" "this"
1401                       "throw" "throws" "transient" "try" "void" "volatile"
1402                       "while"
1403
1404                       "false" "null" "true")))
1405
1406     (setq font-lock-keywords
1407           (list
1408
1409            ;; Handle the keywords defined above.
1410            (list (concat "\\<\\(" java-keywords "\\)\\>")
1411                  '(0 font-lock-keyword-face))
1412
1413            ;; Handle numbers too.
1414            ;;
1415            ;; The following isn't quite right, but it's close enough.
1416            (list (concat "\\<\\("
1417                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1418                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1419                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1420                          "[lLfFdD]?")
1421                  '(0 mdw-number-face))
1422
1423            ;; And anything else is punctuation.
1424            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1425                  '(0 mdw-punct-face)))))
1426
1427   (mdw-post-config-mode-hack))
1428
1429 ;;;--------------------------------------------------------------------------
1430 ;;; Javascript programming configuration.
1431
1432 (defun mdw-javascript-style ()
1433   (setq js-indent-level 2)
1434   (setq js-expr-indent-offset 0))
1435
1436 (defun mdw-fontify-javascript ()
1437
1438   ;; Other stuff.
1439   (mdw-javascript-style)
1440   (setq js-auto-indent-flag t)
1441
1442   ;; Now define things to be fontified.
1443   (make-local-variable 'font-lock-keywords)
1444   (let ((javascript-keywords
1445          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1446                       "char" "class" "const" "continue" "debugger" "default"
1447                       "delete" "do" "double" "else" "enum" "export" "extends"
1448                       "final" "finally" "float" "for" "function" "goto" "if"
1449                       "implements" "import" "in" "instanceof" "int"
1450                       "interface" "let" "long" "native" "new" "package"
1451                       "private" "protected" "public" "return" "short"
1452                       "static" "super" "switch" "synchronized" "throw"
1453                       "throws" "transient" "try" "typeof" "var" "void"
1454                       "volatile" "while" "with" "yield"
1455
1456                       "boolean" "byte" "char" "double" "float" "int" "long"
1457                       "short" "void"))
1458         (javascript-constants
1459          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1460                       "arguments" "this")))
1461
1462     (setq font-lock-keywords
1463           (list
1464
1465            ;; Handle the keywords defined above.
1466            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1467                  '(0 font-lock-keyword-face))
1468
1469            ;; Handle the predefined constants defined above.
1470            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1471                  '(0 font-lock-variable-name-face))
1472
1473            ;; Handle numbers too.
1474            ;;
1475            ;; The following isn't quite right, but it's close enough.
1476            (list (concat "\\_<\\("
1477                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1478                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1479                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1480                          "[lLfFdD]?")
1481                  '(0 mdw-number-face))
1482
1483            ;; And anything else is punctuation.
1484            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1485                  '(0 mdw-punct-face)))))
1486
1487   (mdw-post-config-mode-hack))
1488
1489 ;;;--------------------------------------------------------------------------
1490 ;;; C# programming configuration.
1491
1492 ;; Make indentation nice.
1493
1494 (defun mdw-csharp-style ()
1495   (c-add-style "[mdw] C# style"
1496                '((c-basic-offset . 2)
1497                  (c-offsets-alist (substatement-open . 0)
1498                                   (label . 0)
1499                                   (case-label . +)
1500                                   (access-label . 0)
1501                                   (inclass . +)
1502                                   (statement-case-intro . +)))
1503                t))
1504
1505 ;; Declare C# fontification style.
1506
1507 (defun mdw-fontify-csharp ()
1508
1509   ;; Other stuff.
1510   (mdw-csharp-style)
1511   (setq c-hanging-comment-ender-p nil)
1512   (setq c-backslash-column 72)
1513   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1514
1515   ;; Now define things to be fontified.
1516   (make-local-variable 'font-lock-keywords)
1517   (let ((csharp-keywords
1518          (mdw-regexps "abstract" "as" "base" "bool" "break"
1519                       "byte" "case" "catch" "char" "checked"
1520                       "class" "const" "continue" "decimal" "default"
1521                       "delegate" "do" "double" "else" "enum"
1522                       "event" "explicit" "extern" "false" "finally"
1523                       "fixed" "float" "for" "foreach" "goto"
1524                       "if" "implicit" "in" "int" "interface"
1525                       "internal" "is" "lock" "long" "namespace"
1526                       "new" "null" "object" "operator" "out"
1527                       "override" "params" "private" "protected" "public"
1528                       "readonly" "ref" "return" "sbyte" "sealed"
1529                       "short" "sizeof" "stackalloc" "static" "string"
1530                       "struct" "switch" "this" "throw" "true"
1531                       "try" "typeof" "uint" "ulong" "unchecked"
1532                       "unsafe" "ushort" "using" "virtual" "void"
1533                       "volatile" "while" "yield")))
1534
1535     (setq font-lock-keywords
1536           (list
1537
1538            ;; Handle the keywords defined above.
1539            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1540                  '(0 font-lock-keyword-face))
1541
1542            ;; Handle numbers too.
1543            ;;
1544            ;; The following isn't quite right, but it's close enough.
1545            (list (concat "\\<\\("
1546                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1547                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1548                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1549                          "[lLfFdD]?")
1550                  '(0 mdw-number-face))
1551
1552            ;; And anything else is punctuation.
1553            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1554                  '(0 mdw-punct-face)))))
1555
1556   (mdw-post-config-mode-hack))
1557
1558 (define-derived-mode csharp-mode java-mode "C#"
1559   "Major mode for editing C# code.")
1560
1561 ;;;--------------------------------------------------------------------------
1562 ;;; F# programming configuration.
1563
1564 (setq fsharp-indent-offset 2)
1565
1566 (defun mdw-fontify-fsharp ()
1567
1568   (let ((punct "=<>+-*/|&%!@?"))
1569     (do ((i 0 (1+ i)))
1570         ((>= i (length punct)))
1571       (modify-syntax-entry (aref punct i) ".")))
1572
1573   (modify-syntax-entry ?_ "_")
1574   (modify-syntax-entry ?( "(")
1575   (modify-syntax-entry ?) ")")
1576
1577   (setq indent-tabs-mode nil)
1578
1579   (let ((fsharp-keywords
1580          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1581                       "base" "begin" "break"
1582                       "checked" "class" "component" "const" "constraint"
1583                       "constructor" "continue"
1584                       "default" "delegate" "do" "done" "downcast" "downto"
1585                       "eager" "elif" "else" "end" "exception" "extern"
1586                       "false" "finally" "fixed" "for" "fori" "fun" "function"
1587                       "functor"
1588                       "global"
1589                       "if" "in" "include" "inherit" "inline" "interface"
1590                       "internal"
1591                       "lazy" "let"
1592                       "match" "measure" "member" "method" "mixin" "module"
1593                       "mutable"
1594                       "namespace" "new" "null"
1595                       "object""of" "open" "or" "override"
1596                       "parallel" "params" "private" "process" "protected"
1597                       "public" "pure"
1598                       "rec" "recursive" "return"
1599                       "sealed" "sig" "static" "struct"
1600                       "tailcall" "then" "to" "trait" "true" "try" "type"
1601                       "upcast" "use"
1602                       "val" "virtual" "void" "volatile"
1603                       "when" "while" "with"
1604                       "yield"))
1605
1606         (fsharp-builtins
1607          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"))
1608
1609         (bang-keywords
1610          (mdw-regexps "do" "let" "return" "use" "yield"))
1611
1612         (preprocessor-keywords
1613          (mdw-regexps "if" "indent" "else" "endif")))
1614
1615     (setq font-lock-keywords
1616           (list (list (concat "\\(^\\|[^\"]\\)"
1617                               "\\(" "(\\*"
1618                                     "[^*]*\\*+"
1619                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1620                                     ")"
1621                               "\\|"
1622                                     "//.*"
1623                               "\\)")
1624                       '(2 font-lock-comment-face))
1625
1626                 (list (concat "'" "\\("
1627                                     "\\\\"
1628                                     "\\(" "[ntbr'\\]"
1629                                     "\\|" "[0-9][0-9][0-9]"
1630                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
1631                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
1632                                     "\\)"
1633                                   "\\|"
1634                                   "." "\\)" "'"
1635                               "\\|"
1636                               "\"" "[^\"\\]*"
1637                                     "\\(" "\\\\" "\\(.\\|\n\\)"
1638                                           "[^\"\\]*" "\\)*"
1639                               "\\(\"\\|\\'\\)")
1640                       '(0 font-lock-string-face))
1641
1642                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
1643                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
1644                               "\\|"
1645                               "\\_<\\(" fsharp-keywords "\\)\\_>")
1646                       '(0 font-lock-keyword-face))
1647                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
1648                       '(0 font-lock-variable-name-face))
1649
1650                 (list (concat "\\_<"
1651                               "\\(" "0[bB][01]+" "\\|"
1652                                     "0[oO][0-7]+" "\\|"
1653                                     "0[xX][0-9a-fA-F]+" "\\)"
1654                               "\\(" "lf\\|LF" "\\|"
1655                                     "[uU]?[ysnlL]?" "\\)"
1656                               "\\|"
1657                               "\\_<"
1658                               "[0-9]+" "\\("
1659                                 "[mMQRZING]"
1660                                 "\\|"
1661                                 "\\(\\.[0-9]*\\)?"
1662                                 "\\([eE][-+]?[0-9]+\\)?"
1663                                 "[fFmM]?"
1664                                 "\\|"
1665                                 "[uU]?[ysnlL]?"
1666                               "\\)")
1667                       '(0 mdw-number-face))
1668
1669                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1670                       '(0 mdw-punct-face)))))
1671
1672   (mdw-post-config-mode-hack))
1673
1674 (defun mdw-fontify-inferior-fsharp ()
1675   (mdw-fontify-fsharp)
1676   (setq font-lock-keywords
1677         (append (list (list "^[#-]" '(0 font-lock-comment-face))
1678                       (list "^>" '(0 font-lock-keyword-face)))
1679                 font-lock-keywords)))
1680
1681 ;;;--------------------------------------------------------------------------
1682 ;;; Go programming configuration.
1683
1684 (defun mdw-fontify-go ()
1685
1686   (make-local-variable 'font-lock-keywords)
1687   (let ((go-keywords
1688          (mdw-regexps "break" "case" "chan" "const" "continue"
1689                       "default" "defer" "else" "fallthrough" "for"
1690                       "func" "go" "goto" "if" "import"
1691                       "interface" "map" "package" "range" "return"
1692                       "select" "struct" "switch" "type" "var"))
1693         (go-intrinsics
1694          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
1695                       "float32" "float64" "int" "uint8" "int16" "int32"
1696                       "int64" "rune" "string" "uint" "uint8" "uint16"
1697                       "uint32" "uint64" "uintptr" "void"
1698                       "false" "iota" "nil" "true"
1699                       "init" "main"
1700                       "append" "cap" "copy" "delete" "imag" "len" "make"
1701                       "new" "panic" "real" "recover")))
1702
1703     (setq font-lock-keywords
1704           (list
1705
1706            ;; Handle the keywords defined above.
1707            (list (concat "\\<\\(" go-keywords "\\)\\>")
1708                  '(0 font-lock-keyword-face))
1709            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
1710                  '(0 font-lock-variable-name-face))
1711
1712            ;; Strings and characters.
1713            (list (concat "'"
1714                          "\\(" "[^\\']" "\\|"
1715                                "\\\\"
1716                                "\\(" "[abfnrtv\\'\"]" "\\|"
1717                                      "[0-7]\\{3\\}" "\\|"
1718                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
1719                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
1720                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
1721                          "'"
1722                          "\\|"
1723                          "\""
1724                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
1725                          "\\(\"\\|$\\)"
1726                          "\\|"
1727                          "`" "[^`]+" "`")
1728                  '(0 font-lock-string-face))
1729
1730            ;; Handle numbers too.
1731            ;;
1732            ;; The following isn't quite right, but it's close enough.
1733            (list (concat "\\<\\("
1734                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1735                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1736                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
1737                  '(0 mdw-number-face))
1738
1739            ;; And anything else is punctuation.
1740            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1741                  '(0 mdw-punct-face)))))
1742
1743   (mdw-post-config-mode-hack))
1744
1745 ;;;--------------------------------------------------------------------------
1746 ;;; Awk programming configuration.
1747
1748 ;; Make Awk indentation nice.
1749
1750 (defun mdw-awk-style ()
1751   (c-add-style "[mdw] Awk style"
1752                '((c-basic-offset . 2)
1753                  (c-offsets-alist (substatement-open . 0)
1754                                   (statement-cont . 0)
1755                                   (statement-case-intro . +)))
1756                t))
1757
1758 ;; Declare Awk fontification style.
1759
1760 (defun mdw-fontify-awk ()
1761
1762   ;; Miscellaneous fiddling.
1763   (mdw-awk-style)
1764   (setq c-backslash-column 72)
1765   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1766
1767   ;; Now define things to be fontified.
1768   (make-local-variable 'font-lock-keywords)
1769   (let ((c-keywords
1770          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
1771                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
1772                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
1773                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
1774                       "atan2" "break" "close" "continue" "cos" "delete"
1775                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
1776                       "function" "gensub" "getline" "gsub" "if" "in"
1777                       "index" "int" "length" "log" "match" "next" "rand"
1778                       "return" "print" "printf" "sin" "split" "sprintf"
1779                       "sqrt" "srand" "strftime" "sub" "substr" "system"
1780                       "systime" "tolower" "toupper" "while")))
1781
1782     (setq font-lock-keywords
1783           (list
1784
1785            ;; Handle the keywords defined above.
1786            (list (concat "\\<\\(" c-keywords "\\)\\>")
1787                  '(0 font-lock-keyword-face))
1788
1789            ;; Handle numbers too.
1790            ;;
1791            ;; The following isn't quite right, but it's close enough.
1792            (list (concat "\\<\\("
1793                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1794                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1795                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1796                          "[uUlL]*")
1797                  '(0 mdw-number-face))
1798
1799            ;; And anything else is punctuation.
1800            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1801                  '(0 mdw-punct-face)))))
1802
1803   (mdw-post-config-mode-hack))
1804
1805 ;;;--------------------------------------------------------------------------
1806 ;;; Perl programming style.
1807
1808 ;; Perl indentation style.
1809
1810 (fset 'perl-mode 'cperl-mode)
1811 (setq cperl-indent-level 2)
1812 (setq cperl-continued-statement-offset 2)
1813 (setq cperl-continued-brace-offset 0)
1814 (setq cperl-brace-offset -2)
1815 (setq cperl-brace-imaginary-offset 0)
1816 (setq cperl-label-offset 0)
1817
1818 ;; Define perl fontification style.
1819
1820 (defun mdw-fontify-perl ()
1821
1822   ;; Miscellaneous fiddling.
1823   (modify-syntax-entry ?$ "\\")
1824   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
1825   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1826
1827   ;; Now define fontification things.
1828   (make-local-variable 'font-lock-keywords)
1829   (let ((perl-keywords
1830          (mdw-regexps "and" "break" "cmp" "continue" "do" "else" "elsif" "eq"
1831                       "for" "foreach" "ge" "given" "gt" "goto" "if"
1832                       "last" "le" "lt" "local" "my" "ne" "next" "or"
1833                       "our" "package" "redo" "require" "return" "sub"
1834                       "undef" "unless" "until" "use" "when" "while")))
1835
1836     (setq font-lock-keywords
1837           (list
1838
1839            ;; Set up the keywords defined above.
1840            (list (concat "\\<\\(" perl-keywords "\\)\\>")
1841                  '(0 font-lock-keyword-face))
1842
1843            ;; At least numbers are simpler than C.
1844            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1845                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1846                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
1847                  '(0 mdw-number-face))
1848
1849            ;; And anything else is punctuation.
1850            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1851                  '(0 mdw-punct-face)))))
1852
1853   (mdw-post-config-mode-hack))
1854
1855 (defun perl-number-tests (&optional arg)
1856   "Assign consecutive numbers to lines containing `#t'.  With ARG,
1857 strip numbers instead."
1858   (interactive "P")
1859   (save-excursion
1860     (goto-char (point-min))
1861     (let ((i 0) (fmt (if arg "" " %4d")))
1862       (while (search-forward "#t" nil t)
1863         (delete-region (point) (line-end-position))
1864         (setq i (1+ i))
1865         (insert (format fmt i)))
1866       (goto-char (point-min))
1867       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
1868           (replace-match (format "\\1%d" i))))))
1869
1870 ;;;--------------------------------------------------------------------------
1871 ;;; Python programming style.
1872
1873 (defun mdw-fontify-pythonic (keywords)
1874
1875   ;; Miscellaneous fiddling.
1876   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1877   (setq indent-tabs-mode nil)
1878
1879   ;; Now define fontification things.
1880   (make-local-variable 'font-lock-keywords)
1881   (setq font-lock-keywords
1882         (list
1883
1884          ;; Set up the keywords defined above.
1885          (list (concat "\\_<\\(" keywords "\\)\\_>")
1886                '(0 font-lock-keyword-face))
1887
1888          ;; At least numbers are simpler than C.
1889          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
1890                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
1891                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
1892                '(0 mdw-number-face))
1893
1894          ;; And anything else is punctuation.
1895          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1896                '(0 mdw-punct-face))))
1897
1898   (mdw-post-config-mode-hack))
1899
1900 ;; Define Python fontification styles.
1901
1902 (defun mdw-fontify-python ()
1903   (mdw-fontify-pythonic
1904    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
1905                 "del" "elif" "else" "except" "exec" "finally" "for"
1906                 "from" "global" "if" "import" "in" "is" "lambda"
1907                 "not" "or" "pass" "print" "raise" "return" "try"
1908                 "while" "with" "yield")))
1909
1910 (defun mdw-fontify-pyrex ()
1911   (mdw-fontify-pythonic
1912    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
1913                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
1914                 "extern" "finally" "for" "from" "global" "if"
1915                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
1916                 "raise" "return" "struct" "try" "while" "with"
1917                 "yield")))
1918
1919 ;;;--------------------------------------------------------------------------
1920 ;;; Icon programming style.
1921
1922 ;; Icon indentation style.
1923
1924 (setq icon-brace-offset 0
1925       icon-continued-brace-offset 0
1926       icon-continued-statement-offset 2
1927       icon-indent-level 2)
1928
1929 ;; Define Icon fontification style.
1930
1931 (defun mdw-fontify-icon ()
1932
1933   ;; Miscellaneous fiddling.
1934   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
1935
1936   ;; Now define fontification things.
1937   (make-local-variable 'font-lock-keywords)
1938   (let ((icon-keywords
1939          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
1940                       "end" "every" "fail" "global" "if" "initial"
1941                       "invocable" "link" "local" "next" "not" "of"
1942                       "procedure" "record" "repeat" "return" "static"
1943                       "suspend" "then" "to" "until" "while"))
1944         (preprocessor-keywords
1945          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
1946                       "include" "line" "undef")))
1947     (setq font-lock-keywords
1948           (list
1949
1950            ;; Set up the keywords defined above.
1951            (list (concat "\\<\\(" icon-keywords "\\)\\>")
1952                  '(0 font-lock-keyword-face))
1953
1954            ;; The things that Icon calls keywords.
1955            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
1956
1957            ;; At least numbers are simpler than C.
1958            (list (concat "\\<[0-9]+"
1959                          "\\([rR][0-9a-zA-Z]+\\|"
1960                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
1961                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
1962                  '(0 mdw-number-face))
1963
1964            ;; Preprocessor.
1965            (list (concat "^[ \t]*$[ \t]*\\<\\("
1966                          preprocessor-keywords
1967                          "\\)\\>")
1968                  '(0 font-lock-keyword-face))
1969
1970            ;; And anything else is punctuation.
1971            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1972                  '(0 mdw-punct-face)))))
1973
1974   (mdw-post-config-mode-hack))
1975
1976 ;;;--------------------------------------------------------------------------
1977 ;;; ARM assembler programming configuration.
1978
1979 ;; There doesn't appear to be an Emacs mode for this yet.
1980 ;;
1981 ;; Better do something about that, I suppose.
1982
1983 (defvar arm-assembler-mode-map nil)
1984 (defvar arm-assembler-abbrev-table nil)
1985 (defvar arm-assembler-mode-syntax-table (make-syntax-table))
1986
1987 (or arm-assembler-mode-map
1988     (progn
1989       (setq arm-assembler-mode-map (make-sparse-keymap))
1990       (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline)
1991       (define-key arm-assembler-mode-map [C-return] 'newline)
1992       (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop)))
1993
1994 (defun arm-assembler-mode ()
1995   "Major mode for ARM assembler programs"
1996   (interactive)
1997
1998   ;; Do standard major mode things.
1999   (kill-all-local-variables)
2000   (use-local-map arm-assembler-mode-map)
2001   (setq local-abbrev-table arm-assembler-abbrev-table)
2002   (setq major-mode 'arm-assembler-mode)
2003   (setq mode-name "ARM assembler")
2004
2005   ;; Set up syntax table.
2006   (set-syntax-table arm-assembler-mode-syntax-table)
2007   (modify-syntax-entry ?;   ; Nasty hack
2008                        "<" arm-assembler-mode-syntax-table)
2009   (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table)
2010   (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table)
2011   (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table)
2012
2013   (make-local-variable 'comment-start)
2014   (setq comment-start ";")
2015   (make-local-variable 'comment-end)
2016   (setq comment-end "")
2017   (make-local-variable 'comment-column)
2018   (setq comment-column 48)
2019   (make-local-variable 'comment-start-skip)
2020   (setq comment-start-skip ";+[ \t]*")
2021
2022   ;; Play with indentation.
2023   (make-local-variable 'indent-line-function)
2024   (setq indent-line-function 'indent-relative-maybe)
2025
2026   ;; Set fill prefix.
2027   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2028
2029   ;; Fiddle with fontification.
2030   (make-local-variable 'font-lock-keywords)
2031   (setq font-lock-keywords
2032         (list
2033
2034          ;; Handle numbers too.
2035          ;;
2036          ;; The following isn't quite right, but it's close enough.
2037          (list (concat "\\("
2038                        "&[0-9a-fA-F]+\\|"
2039                        "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)"
2040                        "\\)")
2041                '(0 mdw-number-face))
2042
2043          ;; Do something about operators.
2044          (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)"
2045                '(1 font-lock-keyword-face)
2046                '(2 font-lock-string-face))
2047          (list ":[a-zA-Z]+:"
2048                '(0 font-lock-keyword-face))
2049
2050          ;; Do menemonics and directives.
2051          (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)"
2052                '(1 font-lock-keyword-face))
2053
2054          ;; And anything else is punctuation.
2055          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2056                '(0 mdw-punct-face))))
2057
2058   (mdw-post-config-mode-hack)
2059   (run-hooks 'arm-assembler-mode-hook))
2060
2061 ;;;--------------------------------------------------------------------------
2062 ;;; Assembler mode.
2063
2064 (defun mdw-fontify-asm ()
2065   (modify-syntax-entry ?' "\"")
2066   (modify-syntax-entry ?. "w")
2067   (setf fill-prefix nil)
2068   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2069
2070 ;;;--------------------------------------------------------------------------
2071 ;;; TCL configuration.
2072
2073 (defun mdw-fontify-tcl ()
2074   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2075   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2076   (make-local-variable 'font-lock-keywords)
2077   (setq font-lock-keywords
2078         (list
2079          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2080                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2081                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2082                '(0 mdw-number-face))
2083          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2084                '(0 mdw-punct-face))))
2085   (mdw-post-config-mode-hack))
2086
2087 ;;;--------------------------------------------------------------------------
2088 ;;; Dylan programming configuration.
2089
2090 (defun mdw-fontify-dylan ()
2091
2092   (make-local-variable 'font-lock-keywords)
2093
2094   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
2095   ;; hook, which undoes all of our configuration.
2096   (setq major-mode 'dylan-mode)
2097   (font-lock-set-defaults)
2098
2099   (let* ((word "[-_a-zA-Z!*@<>$%]+")
2100          (dylan-keywords (mdw-regexps
2101
2102                           "C-address" "C-callable-wrapper" "C-function"
2103                           "C-mapped-subtype" "C-pointer-type" "C-struct"
2104                           "C-subtype" "C-union" "C-variable"
2105
2106                           "above" "abstract" "afterwards" "all"
2107                           "begin" "below" "block" "by"
2108                           "case" "class" "cleanup" "constant" "create"
2109                           "define" "domain"
2110                           "else" "elseif" "end" "exception" "export"
2111                           "finally" "for" "from" "function"
2112                           "generic"
2113                           "handler"
2114                           "if" "in" "instance" "interface" "iterate"
2115                           "keyed-by"
2116                           "let" "library" "local"
2117                           "macro" "method" "module"
2118                           "otherwise"
2119                           "profiling"
2120                           "select" "slot" "subclass"
2121                           "table" "then" "to"
2122                           "unless" "until" "use"
2123                           "variable" "virtual"
2124                           "when" "while"))
2125          (sharp-keywords (mdw-regexps
2126                           "all-keys" "key" "next" "rest" "include"
2127                           "t" "f")))
2128     (setq font-lock-keywords
2129           (list (list (concat "\\<\\(" dylan-keywords
2130                               "\\|" "with\\(out\\)?-" word
2131                               "\\)\\>")
2132                       '(0 font-lock-keyword-face))
2133                 (list (concat "\\<" word ":" "\\|"
2134                               "#\\(" sharp-keywords "\\)\\>")
2135                       '(0 font-lock-variable-name-face))
2136                 (list (concat "\\("
2137                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
2138                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2139                                 "\\|" "/[0-9]+"
2140                               "\\)"
2141                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2142                               "\\|" "#b[01]+"
2143                               "\\|" "#o[0-7]+"
2144                               "\\|" "#x[0-9a-zA-Z]+"
2145                               "\\)\\>")
2146                       '(0 mdw-number-face))
2147                 (list (concat "\\("
2148                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2149                               "\\_<[-+*/=<>:&|]+\\_>"
2150                               "\\)")
2151                       '(0 mdw-punct-face)))))
2152
2153   (mdw-post-config-mode-hack))
2154
2155 ;;;--------------------------------------------------------------------------
2156 ;;; Algol 68 configuration.
2157
2158 (setq a68-indent-step 2)
2159
2160 (defun mdw-fontify-algol-68 ()
2161
2162   ;; Fix up the syntax table.
2163   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2164   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2165     (modify-syntax-entry ch "." a68-mode-syntax-table))
2166
2167   (make-local-variable 'font-lock-keywords)
2168
2169   (let ((not-comment
2170          (let ((word "COMMENT"))
2171            (do ((regexp (concat "[^" (substring word 0 1) "]+")
2172                         (concat regexp "\\|"
2173                                 (substring word 0 i)
2174                                 "[^" (substring word i (1+ i)) "]"))
2175                 (i 1 (1+ i)))
2176                ((>= i (length word)) regexp)))))
2177     (setq font-lock-keywords
2178           (list (list (concat "\\<COMMENT\\>"
2179                               "\\(" not-comment "\\)\\{0,5\\}"
2180                               "\\(\\'\\|\\<COMMENT\\>\\)")
2181                       '(0 font-lock-comment-face))
2182                 (list (concat "\\<CO\\>"
2183                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2184                               "\\($\\|\\<CO\\>\\)")
2185                       '(0 font-lock-comment-face))
2186                 (list "\\<[A-Z_]+\\>"
2187                       '(0 font-lock-keyword-face))
2188                 (list (concat "\\<"
2189                               "[0-9]+"
2190                               "\\(\\.[0-9]+\\)?"
2191                               "\\([eE][-+]?[0-9]+\\)?"
2192                               "\\>")
2193                       '(0 mdw-number-face))
2194                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2195                       '(0 mdw-punct-face)))))
2196
2197   (mdw-post-config-mode-hack))
2198
2199 ;;;--------------------------------------------------------------------------
2200 ;;; REXX configuration.
2201
2202 (defun mdw-rexx-electric-* ()
2203   (interactive)
2204   (insert ?*)
2205   (rexx-indent-line))
2206
2207 (defun mdw-rexx-indent-newline-indent ()
2208   (interactive)
2209   (rexx-indent-line)
2210   (if abbrev-mode (expand-abbrev))
2211   (newline-and-indent))
2212
2213 (defun mdw-fontify-rexx ()
2214
2215   ;; Various bits of fiddling.
2216   (setq mdw-auto-indent nil)
2217   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2218   (local-set-key [?*] 'mdw-rexx-electric-*)
2219   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2220           '(?! ?? ?# ?@ ?$))
2221   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2222
2223   ;; Set up keywords and things for fontification.
2224   (make-local-variable 'font-lock-keywords-case-fold-search)
2225   (setq font-lock-keywords-case-fold-search t)
2226
2227   (setq rexx-indent 2)
2228   (setq rexx-end-indent rexx-indent)
2229   (setq rexx-cont-indent rexx-indent)
2230
2231   (make-local-variable 'font-lock-keywords)
2232   (let ((rexx-keywords
2233          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2234                       "else" "end" "engineering" "exit" "expose" "for"
2235                       "forever" "form" "fuzz" "if" "interpret" "iterate"
2236                       "leave" "linein" "name" "nop" "numeric" "off" "on"
2237                       "options" "otherwise" "parse" "procedure" "pull"
2238                       "push" "queue" "return" "say" "select" "signal"
2239                       "scientific" "source" "then" "trace" "to" "until"
2240                       "upper" "value" "var" "version" "when" "while"
2241                       "with"
2242
2243                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2244                       "center" "center" "charin" "charout" "chars"
2245                       "compare" "condition" "copies" "c2d" "c2x"
2246                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
2247                       "errortext" "format" "fuzz" "insert" "lastpos"
2248                       "left" "length" "lineout" "lines" "max" "min"
2249                       "overlay" "pos" "queued" "random" "reverse" "right"
2250                       "sign" "sourceline" "space" "stream" "strip"
2251                       "substr" "subword" "symbol" "time" "translate"
2252                       "trunc" "value" "verify" "word" "wordindex"
2253                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2254                       "x2d")))
2255
2256     (setq font-lock-keywords
2257           (list
2258
2259            ;; Set up the keywords defined above.
2260            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2261                  '(0 font-lock-keyword-face))
2262
2263            ;; Fontify all symbols the same way.
2264            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2265                          "[A-Za-z0-9.!?_#@$]+\\)")
2266                  '(0 font-lock-variable-name-face))
2267
2268            ;; And everything else is punctuation.
2269            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2270                  '(0 mdw-punct-face)))))
2271
2272   (mdw-post-config-mode-hack))
2273
2274 ;;;--------------------------------------------------------------------------
2275 ;;; Standard ML programming style.
2276
2277 (defun mdw-fontify-sml ()
2278
2279   ;; Make underscore an honorary letter.
2280   (modify-syntax-entry ?' "w")
2281
2282   ;; Set fill prefix.
2283   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2284
2285   ;; Now define fontification things.
2286   (make-local-variable 'font-lock-keywords)
2287   (let ((sml-keywords
2288          (mdw-regexps "abstype" "and" "andalso" "as"
2289                       "case"
2290                       "datatype" "do"
2291                       "else" "end" "eqtype" "exception"
2292                       "fn" "fun" "functor"
2293                       "handle"
2294                       "if" "in" "include" "infix" "infixr"
2295                       "let" "local"
2296                       "nonfix"
2297                       "of" "op" "open" "orelse"
2298                       "raise" "rec"
2299                       "sharing" "sig" "signature" "struct" "structure"
2300                       "then" "type"
2301                       "val"
2302                       "where" "while" "with" "withtype")))
2303
2304     (setq font-lock-keywords
2305           (list
2306
2307            ;; Set up the keywords defined above.
2308            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2309                  '(0 font-lock-keyword-face))
2310
2311            ;; At least numbers are simpler than C.
2312            (list (concat "\\<\\(\\~\\|\\)"
2313                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2314                                    "[wW][0-9]+\\)\\|"
2315                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2316                                          "\\([eE]\\(\\~\\|\\)"
2317                                                 "[0-9]+\\|\\)\\)\\)")
2318                  '(0 mdw-number-face))
2319
2320            ;; And anything else is punctuation.
2321            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2322                  '(0 mdw-punct-face)))))
2323
2324   (mdw-post-config-mode-hack))
2325
2326 ;;;--------------------------------------------------------------------------
2327 ;;; Haskell configuration.
2328
2329 (defun mdw-fontify-haskell ()
2330
2331   ;; Fiddle with syntax table to get comments right.
2332   (modify-syntax-entry ?' "_")
2333   (modify-syntax-entry ?- ". 12")
2334   (modify-syntax-entry ?\n ">")
2335
2336   ;; Make punctuation be punctuation
2337   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2338     (do ((i 0 (1+ i)))
2339         ((>= i (length punct)))
2340       (modify-syntax-entry (aref punct i) ".")))
2341
2342   ;; Set fill prefix.
2343   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2344
2345   ;; Fiddle with fontification.
2346   (make-local-variable 'font-lock-keywords)
2347   (let ((haskell-keywords
2348          (mdw-regexps "as"
2349                       "case" "ccall" "class"
2350                       "data" "default" "deriving" "do"
2351                       "else" "exists"
2352                       "forall" "foreign"
2353                       "hiding"
2354                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
2355                       "let"
2356                       "mdo" "module"
2357                       "newtype"
2358                       "of"
2359                       "proc"
2360                       "qualified"
2361                       "rec"
2362                       "safe" "stdcall"
2363                       "then" "type"
2364                       "unsafe"
2365                       "where"))
2366         (control-sequences
2367          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2368                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2369                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2370                       "SP" "STX" "SUB" "SYN" "US" "VT")))
2371
2372     (setq font-lock-keywords
2373           (list
2374            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2375                               "\\(-+}\\|-*\\'\\)"
2376                          "\\|"
2377                          "--.*$")
2378                  '(0 font-lock-comment-face))
2379            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2380                  '(0 font-lock-keyword-face))
2381            (list (concat "'\\("
2382                          "[^\\]"
2383                          "\\|"
2384                          "\\\\"
2385                          "\\(" "[abfnrtv\\\"']" "\\|"
2386                                "^" "\\(" control-sequences "\\|"
2387                                          "[]A-Z@[\\^_]" "\\)" "\\|"
2388                                "\\|"
2389                                "[0-9]+" "\\|"
2390                                "[oO][0-7]+" "\\|"
2391                                "[xX][0-9A-Fa-f]+"
2392                          "\\)"
2393                          "\\)'")
2394                  '(0 font-lock-string-face))
2395            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2396                  '(0 font-lock-variable-name-face))
2397            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2398                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2399                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2400                  '(0 mdw-number-face))
2401            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2402                  '(0 mdw-punct-face)))))
2403
2404   (mdw-post-config-mode-hack))
2405
2406 ;;;--------------------------------------------------------------------------
2407 ;;; Erlang configuration.
2408
2409 (setq erlang-electric-commands nil)
2410
2411 (defun mdw-fontify-erlang ()
2412
2413   ;; Set fill prefix.
2414   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2415
2416   ;; Fiddle with fontification.
2417   (make-local-variable 'font-lock-keywords)
2418   (let ((erlang-keywords
2419          (mdw-regexps "after" "and" "andalso"
2420                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2421                       "case" "catch" "cond"
2422                       "div" "end" "fun" "if" "let" "not"
2423                       "of" "or" "orelse"
2424                       "query" "receive" "rem" "try" "when" "xor")))
2425
2426     (setq font-lock-keywords
2427           (list
2428            (list "%.*$"
2429                  '(0 font-lock-comment-face))
2430            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2431                  '(0 font-lock-keyword-face))
2432            (list (concat "^-\\sw+\\>")
2433                  '(0 font-lock-keyword-face))
2434            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2435                  '(0 mdw-number-face))
2436            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2437                  '(0 mdw-punct-face)))))
2438
2439   (mdw-post-config-mode-hack))
2440
2441 ;;;--------------------------------------------------------------------------
2442 ;;; Texinfo configuration.
2443
2444 (defun mdw-fontify-texinfo ()
2445
2446   ;; Set fill prefix.
2447   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2448
2449   ;; Real fontification things.
2450   (make-local-variable 'font-lock-keywords)
2451   (setq font-lock-keywords
2452         (list
2453
2454          ;; Environment names are keywords.
2455          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2456                '(2 font-lock-keyword-face))
2457
2458          ;; Unmark escaped magic characters.
2459          (list "\\(@\\)\\([@{}]\\)"
2460                '(1 font-lock-keyword-face)
2461                '(2 font-lock-variable-name-face))
2462
2463          ;; Make sure we get comments properly.
2464          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2465                '(0 font-lock-comment-face))
2466
2467          ;; Command names are keywords.
2468          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2469                '(0 font-lock-keyword-face))
2470
2471          ;; Fontify TeX special characters as punctuation.
2472          (list "[{}]+"
2473                '(0 mdw-punct-face))))
2474
2475   (mdw-post-config-mode-hack))
2476
2477 ;;;--------------------------------------------------------------------------
2478 ;;; TeX and LaTeX configuration.
2479
2480 (defun mdw-fontify-tex ()
2481   (setq ispell-parser 'tex)
2482   (turn-on-reftex)
2483
2484   ;; Don't make maths into a string.
2485   (modify-syntax-entry ?$ ".")
2486   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2487   (local-set-key [?$] 'self-insert-command)
2488
2489   ;; Set fill prefix.
2490   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2491
2492   ;; Real fontification things.
2493   (make-local-variable 'font-lock-keywords)
2494   (setq font-lock-keywords
2495         (list
2496
2497          ;; Environment names are keywords.
2498          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2499                        "{\\([^}\n]*\\)}")
2500                '(2 font-lock-keyword-face))
2501
2502          ;; Suspended environment names are keywords too.
2503          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2504                        "{\\([^}\n]*\\)}")
2505                '(3 font-lock-keyword-face))
2506
2507          ;; Command names are keywords.
2508          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2509                '(0 font-lock-keyword-face))
2510
2511          ;; Handle @/.../ for italics.
2512          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2513          ;;       '(1 font-lock-keyword-face)
2514          ;;       '(3 font-lock-keyword-face))
2515
2516          ;; Handle @*...* for boldness.
2517          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2518          ;;       '(1 font-lock-keyword-face)
2519          ;;       '(3 font-lock-keyword-face))
2520
2521          ;; Handle @`...' for literal syntax things.
2522          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2523          ;;       '(1 font-lock-keyword-face)
2524          ;;       '(3 font-lock-keyword-face))
2525
2526          ;; Handle @<...> for nonterminals.
2527          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2528          ;;       '(1 font-lock-keyword-face)
2529          ;;       '(3 font-lock-keyword-face))
2530
2531          ;; Handle other @-commands.
2532          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2533          ;;       '(0 font-lock-keyword-face))
2534
2535          ;; Make sure we get comments properly.
2536          (list "%.*"
2537                '(0 font-lock-comment-face))
2538
2539          ;; Fontify TeX special characters as punctuation.
2540          (list "[$^_{}#&]"
2541                '(0 mdw-punct-face))))
2542
2543   (mdw-post-config-mode-hack))
2544
2545 ;;;--------------------------------------------------------------------------
2546 ;;; SGML hacking.
2547
2548 (defun mdw-sgml-mode ()
2549   (interactive)
2550   (sgml-mode)
2551   (mdw-standard-fill-prefix "")
2552   (make-local-variable 'sgml-delimiters)
2553   (setq sgml-delimiters
2554         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2555           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2556           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2557           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2558           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2559           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2560           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2561           "NULL" ""))
2562   (setq major-mode 'mdw-sgml-mode)
2563   (setq mode-name "[mdw] SGML")
2564   (run-hooks 'mdw-sgml-mode-hook))
2565
2566 ;;;--------------------------------------------------------------------------
2567 ;;; Configuration files.
2568
2569 (defvar mdw-conf-quote-normal nil
2570   "*Control syntax category of quote characters `\"' and `''.
2571 If this is `t', consider quote characters to be normal
2572 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2573 leave quote characters as quotes.  If this is a list, then
2574 consider the quote characters in the list to be normal
2575 punctuation.  If this is a single quote character, then consider
2576 that character only to be normal punctuation.")
2577 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2578   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2579   (or (booleanp value)
2580       (every (lambda (v) (memq v '(?\" ?')))
2581              (if (listp value) value (list value)))))
2582 (put 'mdw-conf-quote-normal 'safe-local-variable '
2583      mdw-conf-quote-normal-acceptable-value-p)
2584
2585 (defun mdw-fix-up-quote ()
2586   "Apply the setting of `mdw-conf-quote-normal'."
2587   (let ((flag mdw-conf-quote-normal))
2588     (cond ((eq flag t)
2589            (conf-quote-normal t))
2590           ((not flag)
2591            nil)
2592           (t
2593            (let ((table (copy-syntax-table (syntax-table))))
2594              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2595                    (if (listp flag) flag (list flag)))
2596              (set-syntax-table table)
2597              (and font-lock-mode (font-lock-fontify-buffer)))))))
2598 (defun mdw-fix-up-quote-hack ()
2599   "Unpleasant hack to call `mdw-fix-up-quote' at the right time.
2600 Annoyingly, `hack-local-variables' is done after `set-auto-mode'
2601 so we wouldn't see a local-variable setting of
2602 `mdw-conf-quote-normal' in `conf-mode-hook'.  Instead, wire
2603 ourselves onto `hack-local-variables-hook' here, and check the
2604 setting once it's actually been made."
2605   (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t))
2606 (add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t)
2607
2608 ;;;--------------------------------------------------------------------------
2609 ;;; Shell scripts.
2610
2611 (defun mdw-setup-sh-script-mode ()
2612
2613   ;; Fetch the shell interpreter's name.
2614   (let ((shell-name sh-shell-file))
2615
2616     ;; Try reading the hash-bang line.
2617     (save-excursion
2618       (goto-char (point-min))
2619       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2620           (setq shell-name (match-string 1))))
2621
2622     ;; Now try to set the shell.
2623     ;;
2624     ;; Don't let `sh-set-shell' bugger up my script.
2625     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2626       (sh-set-shell shell-name)))
2627
2628   ;; Now enable my keys and the fontification.
2629   (mdw-misc-mode-config)
2630
2631   ;; Set the indentation level correctly.
2632   (setq sh-indentation 2)
2633   (setq sh-basic-offset 2))
2634
2635 (setq sh-shell-file "/bin/sh")
2636
2637 ;; Awful hacking to override the shell detection for particular scripts.
2638 (defmacro define-custom-shell-mode (name shell)
2639   `(defun ,name ()
2640      (interactive)
2641      (set (make-local-variable 'sh-shell-file) ,shell)
2642      (sh-mode)))
2643 (define-custom-shell-mode bash-mode "/bin/bash")
2644 (define-custom-shell-mode rc-mode "/usr/bin/rc")
2645 (put 'sh-shell-file 'permanent-local t)
2646
2647 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
2648 (eval-after-load "sh-script"
2649   '(or (assq 'rc sh-mode-syntax-table-input)
2650        (let ((frag '(nil
2651                      ?# "<"
2652                      ?\n ">#"
2653                      ?\" "\"\""
2654                      ?\' "\"\'"
2655                      ?$ "'"
2656                      ?\` "."
2657                      ?! "_"
2658                      ?% "_"
2659                      ?. "_"
2660                      ?^ "_"
2661                      ?~ "_"
2662                      ?, "_"
2663                      ?= "."
2664                      ?< "."
2665                      ?> "."))
2666              (assoc (assq 'rc sh-mode-syntax-table-input)))
2667          (if assoc
2668              (rplacd assoc frag)
2669            (setq sh-mode-syntax-table-input
2670                  (cons (cons 'rc frag)
2671                        sh-mode-syntax-table-input))))))
2672
2673 ;;;--------------------------------------------------------------------------
2674 ;;; Emacs shell mode.
2675
2676 (defun mdw-eshell-prompt ()
2677   (let ((left "[") (right "]"))
2678     (when (= (user-uid) 0)
2679       (setq left "«" right "»"))
2680     (concat left
2681             (save-match-data
2682               (replace-regexp-in-string "\\..*$" "" (system-name)))
2683             " "
2684             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
2685                    (home (expand-file-name "~")) (nhome (length home)))
2686               (if (and (>= npwd nhome)
2687                        (or (= nhome npwd)
2688                            (= (elt pwd nhome) ?/))
2689                        (string= (substring pwd 0 nhome) home))
2690                   (concat "~" (substring pwd (length home)))
2691                 pwd))
2692             right)))
2693 (setq eshell-prompt-function 'mdw-eshell-prompt)
2694 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
2695
2696 (defun eshell/e (file) (find-file file) nil)
2697 (defun eshell/ee (file) (find-file-other-window file) nil)
2698 (defun eshell/w3m (url) (w3m-goto-url url) nil)
2699
2700 (mdw-define-face eshell-prompt (t :weight bold))
2701 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
2702 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
2703 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
2704 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
2705 (mdw-define-face eshell-ls-executable (t :weight bold))
2706 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
2707 (mdw-define-face eshell-ls-readonly (t nil))
2708 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
2709
2710 ;;;--------------------------------------------------------------------------
2711 ;;; Messages-file mode.
2712
2713 (defun messages-mode-guts ()
2714   (setq messages-mode-syntax-table (make-syntax-table))
2715   (set-syntax-table messages-mode-syntax-table)
2716   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
2717   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
2718   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
2719   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
2720   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
2721   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
2722   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
2723   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
2724   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
2725   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
2726   (make-local-variable 'comment-start)
2727   (make-local-variable 'comment-end)
2728   (make-local-variable 'indent-line-function)
2729   (setq indent-line-function 'indent-relative)
2730   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2731   (make-local-variable 'font-lock-defaults)
2732   (make-local-variable 'messages-mode-keywords)
2733   (let ((keywords
2734          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
2735                       "export" "enum" "fixed-octetstring" "flags"
2736                       "harmless" "map" "nested" "optional"
2737                       "optional-tagged" "package" "primitive"
2738                       "primitive-nullfree" "relaxed[ \t]+enum"
2739                       "set" "table" "tagged-optional"   "union"
2740                       "variadic" "vector" "version" "version-tag")))
2741     (setq messages-mode-keywords
2742           (list
2743            (list (concat "\\<\\(" keywords "\\)\\>:")
2744                  '(0 font-lock-keyword-face))
2745            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
2746            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
2747              (0 font-lock-variable-name-face))
2748            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
2749            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2750              (0 mdw-punct-face)))))
2751   (setq font-lock-defaults
2752         '(messages-mode-keywords nil nil nil nil))
2753   (run-hooks 'messages-file-hook))
2754
2755 (defun messages-mode ()
2756   (interactive)
2757   (fundamental-mode)
2758   (setq major-mode 'messages-mode)
2759   (setq mode-name "Messages")
2760   (messages-mode-guts)
2761   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
2762   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
2763   (setq comment-start "# ")
2764   (setq comment-end "")
2765   (run-hooks 'messages-mode-hook))
2766
2767 (defun cpp-messages-mode ()
2768   (interactive)
2769   (fundamental-mode)
2770   (setq major-mode 'cpp-messages-mode)
2771   (setq mode-name "CPP Messages")
2772   (messages-mode-guts)
2773   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
2774   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
2775   (setq comment-start "/* ")
2776   (setq comment-end " */")
2777   (let ((preprocessor-keywords
2778          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2779                       "ident" "if" "ifdef" "ifndef" "import" "include"
2780                       "line" "pragma" "unassert" "undef" "warning")))
2781     (setq messages-mode-keywords
2782           (append (list (list (concat "^[ \t]*\\#[ \t]*"
2783                                       "\\(include\\|import\\)"
2784                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
2785                               '(2 font-lock-string-face))
2786                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2787                                       preprocessor-keywords
2788                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
2789                               '(1 font-lock-keyword-face)))
2790                   messages-mode-keywords)))
2791   (run-hooks 'cpp-messages-mode-hook))
2792
2793 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
2794 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
2795 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
2796
2797 ;;;--------------------------------------------------------------------------
2798 ;;; Messages-file mode.
2799
2800 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
2801   "Face to use for subsittution directives.")
2802 (make-face 'mallow-driver-substitution-face)
2803 (defvar mallow-driver-text-face 'mallow-driver-text-face
2804   "Face to use for body text.")
2805 (make-face 'mallow-driver-text-face)
2806
2807 (defun mallow-driver-mode ()
2808   (interactive)
2809   (fundamental-mode)
2810   (setq major-mode 'mallow-driver-mode)
2811   (setq mode-name "Mallow driver")
2812   (setq mallow-driver-mode-syntax-table (make-syntax-table))
2813   (set-syntax-table mallow-driver-mode-syntax-table)
2814   (make-local-variable 'comment-start)
2815   (make-local-variable 'comment-end)
2816   (make-local-variable 'indent-line-function)
2817   (setq indent-line-function 'indent-relative)
2818   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
2819   (make-local-variable 'font-lock-defaults)
2820   (make-local-variable 'mallow-driver-mode-keywords)
2821   (let ((keywords
2822          (mdw-regexps "each" "divert" "file" "if"
2823                       "perl" "set" "string" "type" "write")))
2824     (setq mallow-driver-mode-keywords
2825           (list
2826            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
2827                  '(0 font-lock-keyword-face))
2828            (list "^%\\s *\\(#.*\\|\\)$"
2829                  '(0 font-lock-comment-face))
2830            (list "^%"
2831                  '(0 font-lock-keyword-face))
2832            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
2833            (list "\\${[^}]*}"
2834                  '(0 mallow-driver-substitution-face t)))))
2835   (setq font-lock-defaults
2836         '(mallow-driver-mode-keywords nil nil nil nil))
2837   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
2838   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
2839   (setq comment-start "%# ")
2840   (setq comment-end "")
2841   (run-hooks 'mallow-driver-mode-hook))
2842
2843 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
2844
2845 ;;;--------------------------------------------------------------------------
2846 ;;; NFast debugs.
2847
2848 (defun nfast-debug-mode ()
2849   (interactive)
2850   (fundamental-mode)
2851   (setq major-mode 'nfast-debug-mode)
2852   (setq mode-name "NFast debug")
2853   (setq messages-mode-syntax-table (make-syntax-table))
2854   (set-syntax-table messages-mode-syntax-table)
2855   (make-local-variable 'font-lock-defaults)
2856   (make-local-variable 'nfast-debug-mode-keywords)
2857   (setq truncate-lines t)
2858   (setq nfast-debug-mode-keywords
2859         (list
2860          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
2861            (0 font-lock-keyword-face))
2862          (list (concat "^[ \t]+\\(\\("
2863                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2864                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
2865                        "[ \t]+\\)*"
2866                        "[0-9a-fA-F]+\\)[ \t]*$")
2867            '(0 mdw-number-face))
2868          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
2869            (1 font-lock-keyword-face))
2870          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
2871            (1 font-lock-warning-face))
2872          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
2873            (1 nil))
2874          (list (concat "^[ \t]+\\.cmd=[ \t]+"
2875                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
2876            '(1 font-lock-keyword-face))
2877          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
2878          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
2879          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
2880          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
2881   (setq font-lock-defaults
2882         '(nfast-debug-mode-keywords nil nil nil nil))
2883   (run-hooks 'nfast-debug-mode-hook))
2884
2885 ;;;--------------------------------------------------------------------------
2886 ;;; Other languages.
2887
2888 ;; Smalltalk.
2889
2890 (defun mdw-setup-smalltalk ()
2891   (and mdw-auto-indent
2892        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
2893   (make-local-variable 'mdw-auto-indent)
2894   (setq mdw-auto-indent nil)
2895   (local-set-key "\C-i" 'smalltalk-reindent))
2896
2897 (defun mdw-fontify-smalltalk ()
2898   (make-local-variable 'font-lock-keywords)
2899   (setq font-lock-keywords
2900         (list
2901          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
2902                '(0 font-lock-keyword-face))
2903          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2904                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2905                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2906                '(0 mdw-number-face))
2907          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2908                '(0 mdw-punct-face))))
2909   (mdw-post-config-mode-hack))
2910
2911 ;; Lispy languages.
2912
2913 ;; Unpleasant bodge.
2914 (unless (boundp 'slime-repl-mode-map)
2915   (setq slime-repl-mode-map (make-sparse-keymap)))
2916
2917 (defun mdw-indent-newline-and-indent ()
2918   (interactive)
2919   (indent-for-tab-command)
2920   (newline-and-indent))
2921
2922 (eval-after-load "cl-indent"
2923   '(progn
2924      (mapc #'(lambda (pair)
2925                (put (car pair)
2926                     'common-lisp-indent-function
2927                     (cdr pair)))
2928       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
2929         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
2930
2931 (defun mdw-common-lisp-indent ()
2932   (make-local-variable 'lisp-indent-function)
2933   (setq lisp-indent-function 'common-lisp-indent-function))
2934
2935 (setq lisp-simple-loop-indentation 2
2936       lisp-loop-keyword-indentation 6
2937       lisp-loop-forms-indentation 6)
2938
2939 (defun mdw-fontify-lispy ()
2940
2941   ;; Set fill prefix.
2942   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
2943
2944   ;; Not much fontification needed.
2945   (make-local-variable 'font-lock-keywords)
2946   (setq font-lock-keywords
2947         (list (list (concat "\\("
2948                             "\\_<[-+]?"
2949                             "\\(" "[0-9]+/[0-9]+"
2950                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
2951                                         "\\.[0-9]+" "\\)"
2952                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
2953                             "\\)"
2954                             "\\|"
2955                             "#"
2956                             "\\(" "x" "[-+]?"
2957                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
2958                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
2959                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
2960                             "\\|" "[0-9]+" "r" "[-+]?"
2961                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
2962                             "\\)"
2963                             "\\)\\_>")
2964                     '(0 mdw-number-face))
2965               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2966                     '(0 mdw-punct-face))))
2967
2968   (mdw-post-config-mode-hack))
2969
2970 (defun comint-send-and-indent ()
2971   (interactive)
2972   (comint-send-input)
2973   (and mdw-auto-indent
2974        (indent-for-tab-command)))
2975
2976 (defun mdw-setup-m4 ()
2977
2978   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
2979   ;; annoying: fix it.
2980   (modify-syntax-entry ?{ "(")
2981   (modify-syntax-entry ?} ")")
2982
2983   ;; Fill prefix.
2984   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
2985
2986 ;;;--------------------------------------------------------------------------
2987 ;;; Text mode.
2988
2989 (defun mdw-text-mode ()
2990   (setq fill-column 72)
2991   (flyspell-mode t)
2992   (mdw-standard-fill-prefix
2993    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
2994   (auto-fill-mode 1))
2995
2996 ;;;--------------------------------------------------------------------------
2997 ;;; Outline and hide/show modes.
2998
2999 (defun mdw-outline-collapse-all ()
3000   "Completely collapse everything in the entire buffer."
3001   (interactive)
3002   (save-excursion
3003     (goto-char (point-min))
3004     (while (< (point) (point-max))
3005       (hide-subtree)
3006       (forward-line))))
3007
3008 (setq hs-hide-comments-when-hiding-all nil)
3009
3010 (defadvice hs-hide-all (after hide-first-comment activate)
3011   (save-excursion (hs-hide-initial-comment-block)))
3012
3013 ;;;--------------------------------------------------------------------------
3014 ;;; Shell mode.
3015
3016 (defun mdw-sh-mode-setup ()
3017   (local-set-key [?\C-a] 'comint-bol)
3018   (add-hook 'comint-output-filter-functions
3019             'comint-watch-for-password-prompt))
3020
3021 (defun mdw-term-mode-setup ()
3022   (setq term-prompt-regexp shell-prompt-pattern)
3023   (make-local-variable 'mouse-yank-at-point)
3024   (make-local-variable 'transient-mark-mode)
3025   (setq mouse-yank-at-point t)
3026   (auto-fill-mode -1)
3027   (setq tab-width 8))
3028
3029 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3030 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3031 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3032 (defun term-send-meta-meta-something ()
3033   (interactive)
3034   (term-send-raw-string "\e\e")
3035   (term-send-raw))
3036 (eval-after-load 'term
3037   '(progn
3038      (define-key term-raw-map [?\e ?\e] nil)
3039      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3040      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3041      (define-key term-raw-map [M-right] 'term-send-meta-right)
3042      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3043      (define-key term-raw-map [M-left] 'term-send-meta-left)
3044      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3045
3046 (defadvice term-exec (before program-args-list compile activate)
3047   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3048 This allows you to pass a list of arguments through `ansi-term'."
3049   (let ((program (ad-get-arg 2)))
3050     (if (listp program)
3051         (progn
3052           (ad-set-arg 2 (car program))
3053           (ad-set-arg 4 (cdr program))))))
3054
3055 (defun ssh (host)
3056   "Open a terminal containing an ssh session to the HOST."
3057   (interactive "sHost: ")
3058   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3059
3060 ;;;--------------------------------------------------------------------------
3061 ;;; Inferior Emacs Lisp.
3062
3063 (setq comint-prompt-read-only t)
3064
3065 (eval-after-load "comint"
3066   '(progn
3067      (define-key comint-mode-map "\C-w" 'comint-kill-region)
3068      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3069
3070 (eval-after-load "ielm"
3071   '(progn
3072      (define-key ielm-map "\C-w" 'comint-kill-region)
3073      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3074
3075 ;;;----- That's all, folks --------------------------------------------------
3076
3077 (provide 'dot-emacs)