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