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

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