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