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

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