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

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