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