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

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