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 (make-face 'mdw-virgin-face)
1102
1103 (defmacro mdw-define-face (name &rest body)
1104   "Define a face, and make sure it's actually set as the definition."
1105   (declare (indent 1)
1106            (debug 0))
1107   `(progn
1108      (copy-face 'mdw-virgin-face ',name)
1109      (defvar ,name ',name)
1110      (put ',name 'face-defface-spec ',body)
1111      (face-spec-set ',name ',body nil)))
1112
1113 (mdw-define-face default
1114   (((type w32)) :family "courier new" :height 85)
1115   (((type x)) :family "6x13" :foundry "trad" :height 130)
1116   (((type color)) :foreground "white" :background "black")
1117   (t nil))
1118 (mdw-define-face fixed-pitch
1119   (((type w32)) :family "courier new" :height 85)
1120   (((type x)) :family "6x13" :foundry "trad" :height 130)
1121   (t :foreground "white" :background "black"))
1122 (if (mdw-emacs-version-p 23)
1123     (mdw-define-face variable-pitch
1124       (((type x)) :family "sans" :height 100))
1125   (mdw-define-face variable-pitch
1126     (((type x)) :family "helvetica" :height 90)))
1127 (mdw-define-face region
1128   (((type tty) (class color)) :background "blue")
1129   (((type tty) (class mono)) :inverse-video t)
1130   (t :background "grey30"))
1131 (mdw-define-face match
1132   (((type tty) (class color)) :background "blue")
1133   (((type tty) (class mono)) :inverse-video t)
1134   (t :background "blue"))
1135 (mdw-define-face mc/cursor-face
1136   (((type tty) (class mono)) :inverse-video t)
1137   (t :background "red"))
1138 (mdw-define-face minibuffer-prompt
1139   (t :weight bold))
1140 (mdw-define-face mode-line
1141   (((class color)) :foreground "blue" :background "yellow"
1142                    :box (:line-width 1 :style released-button))
1143   (t :inverse-video t))
1144 (mdw-define-face mode-line-inactive
1145   (((class color)) :foreground "yellow" :background "blue"
1146                    :box (:line-width 1 :style released-button))
1147   (t :inverse-video t))
1148 (mdw-define-face nobreak-space
1149   (((type tty)))
1150   (t :inherit escape-glyph :underline t))
1151 (mdw-define-face scroll-bar
1152   (t :foreground "black" :background "lightgrey"))
1153 (mdw-define-face fringe
1154   (t :foreground "yellow"))
1155 (mdw-define-face show-paren-match
1156   (((class color)) :background "darkgreen")
1157   (t :underline t))
1158 (mdw-define-face show-paren-mismatch
1159   (((class color)) :background "red")
1160   (t :inverse-video t))
1161 (mdw-define-face highlight
1162   (((type x) (class color)) :background "DarkSeaGreen4")
1163   (((type tty) (class color)) :background "cyan")
1164   (t :inverse-video t))
1165
1166 (mdw-define-face holiday-face
1167   (t :background "red"))
1168 (mdw-define-face calendar-today-face
1169   (t :foreground "yellow" :weight bold))
1170
1171 (mdw-define-face comint-highlight-prompt
1172   (t :weight bold))
1173 (mdw-define-face comint-highlight-input
1174   (t nil))
1175
1176 (mdw-define-face dired-directory
1177   (t :foreground "cyan" :weight bold))
1178 (mdw-define-face dired-symlink
1179   (t :foreground "cyan"))
1180 (mdw-define-face dired-perm-write
1181   (t nil))
1182
1183 (mdw-define-face trailing-whitespace
1184   (((class color)) :background "red")
1185   (t :inverse-video t))
1186 (mdw-define-face mdw-punct-face
1187   (((type tty)) :foreground "yellow") (t :foreground "burlywood2"))
1188 (mdw-define-face mdw-number-face
1189   (t :foreground "yellow"))
1190 (mdw-define-face mdw-trivial-face)
1191 (mdw-define-face font-lock-function-name-face
1192   (t :slant italic))
1193 (mdw-define-face font-lock-keyword-face
1194   (t :weight bold))
1195 (mdw-define-face font-lock-constant-face
1196   (t :slant italic))
1197 (mdw-define-face font-lock-builtin-face
1198   (t :weight bold))
1199 (mdw-define-face font-lock-type-face
1200   (t :weight bold :slant italic))
1201 (mdw-define-face font-lock-reference-face
1202   (t :weight bold))
1203 (mdw-define-face font-lock-variable-name-face
1204   (t :slant italic))
1205 (mdw-define-face font-lock-comment-delimiter-face
1206   (((class mono)) :weight bold)
1207   (((type tty) (class color)) :foreground "green")
1208   (t :slant italic :foreground "SeaGreen1"))
1209 (mdw-define-face font-lock-comment-face
1210   (((class mono)) :weight bold)
1211   (((type tty) (class color)) :foreground "green")
1212   (t :slant italic :foreground "SeaGreen1"))
1213 (mdw-define-face font-lock-string-face
1214   (((class mono)) :weight bold)
1215   (((class color)) :foreground "SkyBlue1"))
1216
1217 (mdw-define-face message-separator
1218   (t :background "red" :foreground "white" :weight bold))
1219 (mdw-define-face message-cited-text
1220   (default :slant italic)
1221   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1222 (mdw-define-face message-header-cc
1223   (default :weight bold)
1224   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1225 (mdw-define-face message-header-newsgroups
1226   (default :weight bold)
1227   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1228 (mdw-define-face message-header-subject
1229   (default :weight bold)
1230   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1231 (mdw-define-face message-header-to
1232   (default :weight bold)
1233   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1234 (mdw-define-face message-header-xheader
1235   (default :weight bold)
1236   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1237 (mdw-define-face message-header-other
1238   (default :weight bold)
1239   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1240 (mdw-define-face message-header-name
1241   (((type tty)) :foreground "green") (t :foreground "SeaGreen1"))
1242 (mdw-define-face which-func
1243   (t nil))
1244
1245 (mdw-define-face diff-header
1246   (t nil))
1247 (mdw-define-face diff-index
1248   (t :weight bold))
1249 (mdw-define-face diff-file-header
1250   (t :weight bold))
1251 (mdw-define-face diff-hunk-header
1252   (t :foreground "SkyBlue1"))
1253 (mdw-define-face diff-function
1254   (t :foreground "SkyBlue1" :weight bold))
1255 (mdw-define-face diff-header
1256   (t :background "grey10"))
1257 (mdw-define-face diff-added
1258   (t :foreground "green"))
1259 (mdw-define-face diff-removed
1260   (t :foreground "red"))
1261 (mdw-define-face diff-context
1262   (t nil))
1263 (mdw-define-face diff-refine-change
1264   (((class color) (type x)) :background "RoyalBlue4")
1265   (t :underline t))
1266
1267 (mdw-define-face dylan-header-background
1268   (((class color) (type x)) :background "NavyBlue")
1269   (t :background "blue"))
1270
1271 (mdw-define-face magit-diff-add
1272   (t :foreground "green"))
1273 (mdw-define-face magit-diff-del
1274   (t :foreground "red"))
1275 (mdw-define-face magit-diff-file-header
1276   (t :weight bold))
1277 (mdw-define-face magit-diff-hunk-header
1278   (t :foreground "SkyBlue1"))
1279 (mdw-define-face magit-item-highlight
1280   (((type tty)) :background "blue")
1281   (t :background "grey11"))
1282 (mdw-define-face magit-log-head-label-remote
1283   (((type tty)) :background "cyan" :foreground "green")
1284   (t :background "grey11" :foreground "DarkSeaGreen2" :box t))
1285 (mdw-define-face magit-log-head-label-local
1286   (((type tty)) :background "cyan" :foreground "yellow")
1287   (t :background "grey11" :foreground "LightSkyBlue1" :box t))
1288 (mdw-define-face magit-log-head-label-tags
1289   (((type tty)) :background "red" :foreground "yellow")
1290   (t :background "LemonChiffon1" :foreground "goldenrod4" :box t))
1291 (mdw-define-face magit-log-graph
1292   (((type tty)) :foreground "magenta")
1293   (t :foreground "grey80"))
1294
1295 (mdw-define-face erc-input-face
1296   (t :foreground "red"))
1297
1298 (mdw-define-face woman-bold
1299   (t :weight bold))
1300 (mdw-define-face woman-italic
1301   (t :slant italic))
1302
1303 (eval-after-load "rst"
1304   '(progn
1305      (mdw-define-face rst-level-1-face
1306        (t :foreground "SkyBlue1" :weight bold))
1307      (mdw-define-face rst-level-2-face
1308        (t :foreground "SeaGreen1" :weight bold))
1309      (mdw-define-face rst-level-3-face
1310        (t :weight bold))
1311      (mdw-define-face rst-level-4-face
1312        (t :slant italic))
1313      (mdw-define-face rst-level-5-face
1314        (t :underline t))
1315      (mdw-define-face rst-level-6-face
1316        ())))
1317
1318 (mdw-define-face p4-depot-added-face
1319   (t :foreground "green"))
1320 (mdw-define-face p4-depot-branch-op-face
1321   (t :foreground "yellow"))
1322 (mdw-define-face p4-depot-deleted-face
1323   (t :foreground "red"))
1324 (mdw-define-face p4-depot-unmapped-face
1325   (t :foreground "SkyBlue1"))
1326 (mdw-define-face p4-diff-change-face
1327   (t :foreground "yellow"))
1328 (mdw-define-face p4-diff-del-face
1329   (t :foreground "red"))
1330 (mdw-define-face p4-diff-file-face
1331   (t :foreground "SkyBlue1"))
1332 (mdw-define-face p4-diff-head-face
1333   (t :background "grey10"))
1334 (mdw-define-face p4-diff-ins-face
1335   (t :foreground "green"))
1336
1337 (mdw-define-face w3m-anchor-face
1338   (t :foreground "SkyBlue1" :underline t))
1339 (mdw-define-face w3m-arrived-anchor-face
1340   (t :foreground "SkyBlue1" :underline t))
1341
1342 (mdw-define-face whizzy-slice-face
1343   (t :background "grey10"))
1344 (mdw-define-face whizzy-error-face
1345   (t :background "darkred"))
1346
1347 ;; Ellipses used to indicate hidden text (and similar).
1348 (mdw-define-face mdw-ellipsis-face
1349   (((type tty)) :foreground "blue") (t :foreground "grey60"))
1350 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
1351       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
1352       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
1353       (bar (make-glyph-code ?| mdw-ellipsis-face)))
1354   (set-display-table-slot standard-display-table 0 dollar)
1355   (set-display-table-slot standard-display-table 1 backslash)
1356   (set-display-table-slot standard-display-table 4
1357                           (vector dot dot dot))
1358   (set-display-table-slot standard-display-table 5 bar))
1359
1360 ;;;--------------------------------------------------------------------------
1361 ;;; C programming configuration.
1362
1363 ;; Linux kernel hacking.
1364
1365 (defvar linux-c-mode-hook)
1366
1367 (defun linux-c-mode ()
1368   (interactive)
1369   (c-mode)
1370   (setq major-mode 'linux-c-mode)
1371   (setq mode-name "Linux C")
1372   (run-hooks 'linux-c-mode-hook))
1373
1374 ;; Make C indentation nice.
1375
1376 (defun mdw-c-lineup-arglist (langelem)
1377   "Hack for DWIMmery in c-lineup-arglist."
1378   (if (save-excursion
1379         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
1380       0
1381     (c-lineup-arglist langelem)))
1382
1383 (defun mdw-c-indent-extern-mumble (langelem)
1384   "Indent `extern \"...\" {' lines."
1385   (save-excursion
1386     (back-to-indentation)
1387     (if (looking-at
1388          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
1389         c-basic-offset
1390       nil)))
1391
1392 (defun mdw-c-style ()
1393   (c-add-style "[mdw] C and C++ style"
1394                '((c-basic-offset . 2)
1395                  (comment-column . 40)
1396                  (c-class-key . "class")
1397                  (c-backslash-column . 72)
1398                  (c-offsets-alist
1399                   (substatement-open . (add 0 c-indent-one-line-block))
1400                   (defun-open . (add 0 c-indent-one-line-block))
1401                   (arglist-cont-nonempty . mdw-c-lineup-arglist)
1402                   (topmost-intro . mdw-c-indent-extern-mumble)
1403                   (cpp-define-intro . 0)
1404                   (knr-argdecl . 0)
1405                   (inextern-lang . [0])
1406                   (label . 0)
1407                   (case-label . +)
1408                   (access-label . -)
1409                   (inclass . +)
1410                   (inline-open . ++)
1411                   (statement-cont . +)
1412                   (statement-case-intro . +)))
1413                t))
1414
1415 (defvar mdw-c-comment-fill-prefix
1416   `((,(concat "\\([ \t]*/?\\)"
1417               "\\(\*\\|//]\\)"
1418               "\\([ \t]*\\)"
1419               "\\([A-Za-z]+:[ \t]*\\)?"
1420               mdw-hanging-indents)
1421      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
1422   "Fill prefix matching C comments (both kinds).")
1423
1424 (defun mdw-fontify-c-and-c++ ()
1425
1426   ;; Fiddle with some syntax codes.
1427   (modify-syntax-entry ?* ". 23")
1428   (modify-syntax-entry ?/ ". 124b")
1429   (modify-syntax-entry ?\n "> b")
1430
1431   ;; Other stuff.
1432   (mdw-c-style)
1433   (setq c-hanging-comment-ender-p nil)
1434   (setq c-backslash-column 72)
1435   (setq c-label-minimum-indentation 0)
1436   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1437
1438   ;; Now define things to be fontified.
1439   (make-local-variable 'font-lock-keywords)
1440   (let ((c-keywords
1441          (mdw-regexps "alignas"          ;C11 macro, C++11
1442                       "alignof"          ;C++11
1443                       "and"              ;C++, C95 macro
1444                       "and_eq"           ;C++, C95 macro
1445                       "asm"              ;K&R, C++, GCC
1446                       "atomic"           ;C11 macro, C++11 template type
1447                       "auto"             ;K&R, C89
1448                       "bitand"           ;C++, C95 macro
1449                       "bitor"            ;C++, C95 macro
1450                       "bool"             ;C++, C99 macro
1451                       "break"            ;K&R, C89
1452                       "case"             ;K&R, C89
1453                       "catch"            ;C++
1454                       "char"             ;K&R, C89
1455                       "char16_t"         ;C++11, C11 library type
1456                       "char32_t"         ;C++11, C11 library type
1457                       "class"            ;C++
1458                       "complex"          ;C99 macro, C++ template type
1459                       "compl"            ;C++, C95 macro
1460                       "const"            ;C89
1461                       "constexpr"        ;C++11
1462                       "const_cast"       ;C++
1463                       "continue"         ;K&R, C89
1464                       "decltype"         ;C++11
1465                       "defined"          ;C89 preprocessor
1466                       "default"          ;K&R, C89
1467                       "delete"           ;C++
1468                       "do"               ;K&R, C89
1469                       "double"           ;K&R, C89
1470                       "dynamic_cast"     ;C++
1471                       "else"             ;K&R, C89
1472                       ;; "entry"         ;K&R -- never used
1473                       "enum"             ;C89
1474                       "explicit"         ;C++
1475                       "export"           ;C++
1476                       "extern"           ;K&R, C89
1477                       "float"            ;K&R, C89
1478                       "for"              ;K&R, C89
1479                       ;; "fortran"       ;K&R
1480                       "friend"           ;C++
1481                       "goto"             ;K&R, C89
1482                       "if"               ;K&R, C89
1483                       "imaginary"        ;C99 macro
1484                       "inline"           ;C++, C99, GCC
1485                       "int"              ;K&R, C89
1486                       "long"             ;K&R, C89
1487                       "mutable"          ;C++
1488                       "namespace"        ;C++
1489                       "new"              ;C++
1490                       "noexcept"         ;C++11
1491                       "noreturn"         ;C11 macro
1492                       "not"              ;C++, C95 macro
1493                       "not_eq"           ;C++, C95 macro
1494                       "nullptr"          ;C++11
1495                       "operator"         ;C++
1496                       "or"               ;C++, C95 macro
1497                       "or_eq"            ;C++, C95 macro
1498                       "private"          ;C++
1499                       "protected"        ;C++
1500                       "public"           ;C++
1501                       "register"         ;K&R, C89
1502                       "reinterpret_cast" ;C++
1503                       "restrict"         ;C99
1504                       "return"           ;K&R, C89
1505                       "short"            ;K&R, C89
1506                       "signed"           ;C89
1507                       "sizeof"           ;K&R, C89
1508                       "static"           ;K&R, C89
1509                       "static_assert"    ;C11 macro, C++11
1510                       "static_cast"      ;C++
1511                       "struct"           ;K&R, C89
1512                       "switch"           ;K&R, C89
1513                       "template"         ;C++
1514                       "throw"            ;C++
1515                       "try"              ;C++
1516                       "thread_local"     ;C11 macro, C++11
1517                       "typedef"          ;C89
1518                       "typeid"           ;C++
1519                       "typeof"           ;GCC
1520                       "typename"         ;C++
1521                       "union"            ;K&R, C89
1522                       "unsigned"         ;K&R, C89
1523                       "using"            ;C++
1524                       "virtual"          ;C++
1525                       "void"             ;C89
1526                       "volatile"         ;C89
1527                       "wchar_t"          ;C++, C89 library type
1528                       "while"            ;K&R, C89
1529                       "xor"              ;C++, C95 macro
1530                       "xor_eq"           ;C++, C95 macro
1531                       "_Alignas"         ;C11
1532                       "_Alignof"         ;C11
1533                       "_Atomic"          ;C11
1534                       "_Bool"            ;C99
1535                       "_Complex"         ;C99
1536                       "_Generic"         ;C11
1537                       "_Imaginary"       ;C99
1538                       "_Noreturn"        ;C11
1539                       "_Pragma"          ;C99 preprocessor
1540                       "_Static_assert"   ;C11
1541                       "_Thread_local"    ;C11
1542                       "__alignof__"      ;GCC
1543                       "__asm__"          ;GCC
1544                       "__attribute__"    ;GCC
1545                       "__complex__"      ;GCC
1546                       "__const__"        ;GCC
1547                       "__extension__"    ;GCC
1548                       "__imag__"         ;GCC
1549                       "__inline__"       ;GCC
1550                       "__label__"        ;GCC
1551                       "__real__"         ;GCC
1552                       "__signed__"       ;GCC
1553                       "__typeof__"       ;GCC
1554                       "__volatile__"     ;GCC
1555                       ))
1556         (c-constants
1557          (mdw-regexps "false"            ;C++, C99 macro
1558                       "this"             ;C++
1559                       "true"             ;C++, C99 macro
1560                       ))
1561         (preprocessor-keywords
1562          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
1563                       "ident" "if" "ifdef" "ifndef" "import" "include"
1564                       "line" "pragma" "unassert" "undef" "warning"))
1565         (objc-keywords
1566          (mdw-regexps "class" "defs" "encode" "end" "implementation"
1567                       "interface" "private" "protected" "protocol" "public"
1568                       "selector")))
1569
1570     (setq font-lock-keywords
1571           (list
1572
1573            ;; Fontify include files as strings.
1574            (list (concat "^[ \t]*\\#[ \t]*"
1575                          "\\(include\\|import\\)"
1576                          "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
1577                  '(2 font-lock-string-face))
1578
1579            ;; Preprocessor directives are `references'?.
1580            (list (concat "^\\([ \t]*#[ \t]*\\(\\("
1581                          preprocessor-keywords
1582                          "\\)\\>\\|[0-9]+\\|$\\)\\)")
1583                  '(1 font-lock-keyword-face))
1584
1585            ;; Handle the keywords defined above.
1586            (list (concat "@\\<\\(" objc-keywords "\\)\\>")
1587                  '(0 font-lock-keyword-face))
1588
1589            (list (concat "\\<\\(" c-keywords "\\)\\>")
1590                  '(0 font-lock-keyword-face))
1591
1592            (list (concat "\\<\\(" c-constants "\\)\\>")
1593                  '(0 font-lock-variable-name-face))
1594
1595            ;; Handle numbers too.
1596            ;;
1597            ;; This looks strange, I know.  It corresponds to the
1598            ;; preprocessor's idea of what a number looks like, rather than
1599            ;; anything sensible.
1600            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1601                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1602                  '(0 mdw-number-face))
1603
1604            ;; And anything else is punctuation.
1605            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1606                  '(0 mdw-punct-face))))))
1607
1608 ;;;--------------------------------------------------------------------------
1609 ;;; AP calc mode.
1610
1611 (defun apcalc-mode ()
1612   (interactive)
1613   (c-mode)
1614   (setq major-mode 'apcalc-mode)
1615   (setq mode-name "AP Calc")
1616   (run-hooks 'apcalc-mode-hook))
1617
1618 (defun mdw-fontify-apcalc ()
1619
1620   ;; Fiddle with some syntax codes.
1621   (modify-syntax-entry ?* ". 23")
1622   (modify-syntax-entry ?/ ". 14")
1623
1624   ;; Other stuff.
1625   (mdw-c-style)
1626   (setq c-hanging-comment-ender-p nil)
1627   (setq c-backslash-column 72)
1628   (setq comment-start "/* ")
1629   (setq comment-end " */")
1630   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1631
1632   ;; Now define things to be fontified.
1633   (make-local-variable 'font-lock-keywords)
1634   (let ((c-keywords
1635          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
1636                       "do" "else" "exit" "for" "global" "goto" "help" "if"
1637                       "local" "mat" "obj" "print" "quit" "read" "return"
1638                       "show" "static" "switch" "while" "write")))
1639
1640     (setq font-lock-keywords
1641           (list
1642
1643            ;; Handle the keywords defined above.
1644            (list (concat "\\<\\(" c-keywords "\\)\\>")
1645                  '(0 font-lock-keyword-face))
1646
1647            ;; Handle numbers too.
1648            ;;
1649            ;; This looks strange, I know.  It corresponds to the
1650            ;; preprocessor's idea of what a number looks like, rather than
1651            ;; anything sensible.
1652            (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
1653                          "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
1654                  '(0 mdw-number-face))
1655
1656            ;; And anything else is punctuation.
1657            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1658                  '(0 mdw-punct-face))))))
1659
1660 ;;;--------------------------------------------------------------------------
1661 ;;; Java programming configuration.
1662
1663 ;; Make indentation nice.
1664
1665 (defun mdw-java-style ()
1666   (c-add-style "[mdw] Java style"
1667                '((c-basic-offset . 2)
1668                  (c-offsets-alist (substatement-open . 0)
1669                                   (label . +)
1670                                   (case-label . +)
1671                                   (access-label . 0)
1672                                   (inclass . +)
1673                                   (statement-case-intro . +)))
1674                t))
1675
1676 ;; Declare Java fontification style.
1677
1678 (defun mdw-fontify-java ()
1679
1680   ;; Other stuff.
1681   (mdw-java-style)
1682   (setq c-hanging-comment-ender-p nil)
1683   (setq c-backslash-column 72)
1684   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1685
1686   ;; Now define things to be fontified.
1687   (make-local-variable 'font-lock-keywords)
1688   (let ((java-keywords
1689          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1690                       "char" "class" "const" "continue" "default" "do"
1691                       "double" "else" "extends" "final" "finally" "float"
1692                       "for" "goto" "if" "implements" "import" "instanceof"
1693                       "int" "interface" "long" "native" "new" "package"
1694                       "private" "protected" "public" "return" "short"
1695                       "static" "switch" "synchronized" "throw" "throws"
1696                       "transient" "try" "void" "volatile" "while"))
1697
1698         (java-constants
1699          (mdw-regexps "false" "null" "super" "this" "true")))
1700
1701     (setq font-lock-keywords
1702           (list
1703
1704            ;; Handle the keywords defined above.
1705            (list (concat "\\<\\(" java-keywords "\\)\\>")
1706                  '(0 font-lock-keyword-face))
1707
1708            ;; Handle the magic constants defined above.
1709            (list (concat "\\<\\(" java-constants "\\)\\>")
1710                  '(0 font-lock-variable-name-face))
1711
1712            ;; Handle numbers too.
1713            ;;
1714            ;; The following isn't quite right, but it's close enough.
1715            (list (concat "\\<\\("
1716                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1717                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1718                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1719                          "[lLfFdD]?")
1720                  '(0 mdw-number-face))
1721
1722            ;; And anything else is punctuation.
1723            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1724                  '(0 mdw-punct-face))))))
1725
1726 ;;;--------------------------------------------------------------------------
1727 ;;; Javascript programming configuration.
1728
1729 (defun mdw-javascript-style ()
1730   (setq js-indent-level 2)
1731   (setq js-expr-indent-offset 0))
1732
1733 (defun mdw-fontify-javascript ()
1734
1735   ;; Other stuff.
1736   (mdw-javascript-style)
1737   (setq js-auto-indent-flag t)
1738
1739   ;; Now define things to be fontified.
1740   (make-local-variable 'font-lock-keywords)
1741   (let ((javascript-keywords
1742          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
1743                       "char" "class" "const" "continue" "debugger" "default"
1744                       "delete" "do" "double" "else" "enum" "export" "extends"
1745                       "final" "finally" "float" "for" "function" "goto" "if"
1746                       "implements" "import" "in" "instanceof" "int"
1747                       "interface" "let" "long" "native" "new" "package"
1748                       "private" "protected" "public" "return" "short"
1749                       "static" "super" "switch" "synchronized" "throw"
1750                       "throws" "transient" "try" "typeof" "var" "void"
1751                       "volatile" "while" "with" "yield"
1752
1753                       "boolean" "byte" "char" "double" "float" "int" "long"
1754                       "short" "void"))
1755         (javascript-constants
1756          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
1757                       "arguments" "this")))
1758
1759     (setq font-lock-keywords
1760           (list
1761
1762            ;; Handle the keywords defined above.
1763            (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
1764                  '(0 font-lock-keyword-face))
1765
1766            ;; Handle the predefined constants defined above.
1767            (list (concat "\\_<\\(" javascript-constants "\\)\\_>")
1768                  '(0 font-lock-variable-name-face))
1769
1770            ;; Handle numbers too.
1771            ;;
1772            ;; The following isn't quite right, but it's close enough.
1773            (list (concat "\\_<\\("
1774                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1775                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1776                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1777                          "[lLfFdD]?")
1778                  '(0 mdw-number-face))
1779
1780            ;; And anything else is punctuation.
1781            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1782                  '(0 mdw-punct-face))))))
1783
1784 ;;;--------------------------------------------------------------------------
1785 ;;; Scala programming configuration.
1786
1787 (defun mdw-fontify-scala ()
1788
1789   ;; Comment filling.
1790   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1791
1792   ;; Define things to be fontified.
1793   (make-local-variable 'font-lock-keywords)
1794   (let ((scala-keywords
1795          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
1796                       "extends" "final" "finally" "for" "forSome" "if"
1797                       "implicit" "import" "lazy" "match" "new" "object"
1798                       "override" "package" "private" "protected" "return"
1799                       "sealed" "throw" "trait" "try" "type" "val"
1800                       "var" "while" "with" "yield"))
1801         (scala-constants
1802          (mdw-regexps "false" "null" "super" "this" "true"))
1803         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
1804
1805     (setq font-lock-keywords
1806           (list
1807
1808            ;; Magical identifiers between backticks.
1809            (list (concat "`\\([^`]+\\)`")
1810                  '(1 font-lock-variable-name-face))
1811
1812            ;; Handle the keywords defined above.
1813            (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
1814                  '(0 font-lock-keyword-face))
1815
1816            ;; Handle the constants defined above.
1817            (list (concat "\\_<\\(" scala-constants "\\)\\_>")
1818                  '(0 font-lock-variable-name-face))
1819
1820            ;; Magical identifiers between backticks.
1821            (list (concat "`\\([^`]+\\)`")
1822                  '(1 font-lock-variable-name-face))
1823
1824            ;; Handle numbers too.
1825            ;;
1826            ;; As usual, not quite right.
1827            (list (concat "\\_<\\("
1828                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1829                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1830                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1831                          "[lLfFdD]?")
1832                  '(0 mdw-number-face))
1833
1834            ;; Identifiers with trailing operators.
1835            (list (concat "_\\(" punctuation "\\)+")
1836                  '(0 mdw-trivial-face))
1837
1838            ;; And everything else is punctuation.
1839            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1840                  '(0 mdw-punct-face)))
1841
1842           font-lock-syntactic-keywords
1843           (list
1844
1845            ;; Single quotes around characters.  But not when used to quote
1846            ;; symbol names.  Ugh.
1847            (list (concat "\\('\\)"
1848                          "\\(" "."
1849                          "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
1850                                "u+" "[0-9a-fA-F]\\{4\\}"
1851                          "\\|" "\\\\" "[0-7]\\{1,3\\}"
1852                          "\\|" "\\\\" "." "\\)"
1853                          "\\('\\)")
1854                  '(1 "\"")
1855                  '(4 "\""))))))
1856
1857 ;;;--------------------------------------------------------------------------
1858 ;;; C# programming configuration.
1859
1860 ;; Make indentation nice.
1861
1862 (defun mdw-csharp-style ()
1863   (c-add-style "[mdw] C# style"
1864                '((c-basic-offset . 2)
1865                  (c-offsets-alist (substatement-open . 0)
1866                                   (label . 0)
1867                                   (case-label . +)
1868                                   (access-label . 0)
1869                                   (inclass . +)
1870                                   (statement-case-intro . +)))
1871                t))
1872
1873 ;; Declare C# fontification style.
1874
1875 (defun mdw-fontify-csharp ()
1876
1877   ;; Other stuff.
1878   (mdw-csharp-style)
1879   (setq c-hanging-comment-ender-p nil)
1880   (setq c-backslash-column 72)
1881   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
1882
1883   ;; Now define things to be fontified.
1884   (make-local-variable 'font-lock-keywords)
1885   (let ((csharp-keywords
1886          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
1887                       "char" "checked" "class" "const" "continue" "decimal"
1888                       "default" "delegate" "do" "double" "else" "enum"
1889                       "event" "explicit" "extern" "finally" "fixed" "float"
1890                       "for" "foreach" "goto" "if" "implicit" "in" "int"
1891                       "interface" "internal" "is" "lock" "long" "namespace"
1892                       "new" "object" "operator" "out" "override" "params"
1893                       "private" "protected" "public" "readonly" "ref"
1894                       "return" "sbyte" "sealed" "short" "sizeof"
1895                       "stackalloc" "static" "string" "struct" "switch"
1896                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
1897                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
1898                       "while" "yield"))
1899
1900         (csharp-constants
1901          (mdw-regexps "base" "false" "null" "this" "true")))
1902
1903     (setq font-lock-keywords
1904           (list
1905
1906            ;; Handle the keywords defined above.
1907            (list (concat "\\<\\(" csharp-keywords "\\)\\>")
1908                  '(0 font-lock-keyword-face))
1909
1910            ;; Handle the magic constants defined above.
1911            (list (concat "\\<\\(" csharp-constants "\\)\\>")
1912                  '(0 font-lock-variable-name-face))
1913
1914            ;; Handle numbers too.
1915            ;;
1916            ;; The following isn't quite right, but it's close enough.
1917            (list (concat "\\<\\("
1918                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
1919                          "[0-9]+\\(\\.[0-9]*\\|\\)"
1920                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
1921                          "[lLfFdD]?")
1922                  '(0 mdw-number-face))
1923
1924            ;; And anything else is punctuation.
1925            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
1926                  '(0 mdw-punct-face))))))
1927
1928 (define-derived-mode csharp-mode java-mode "C#"
1929   "Major mode for editing C# code.")
1930
1931 ;;;--------------------------------------------------------------------------
1932 ;;; F# programming configuration.
1933
1934 (setq fsharp-indent-offset 2)
1935
1936 (defun mdw-fontify-fsharp ()
1937
1938   (let ((punct "=<>+-*/|&%!@?"))
1939     (do ((i 0 (1+ i)))
1940         ((>= i (length punct)))
1941       (modify-syntax-entry (aref punct i) ".")))
1942
1943   (modify-syntax-entry ?_ "_")
1944   (modify-syntax-entry ?( "(")
1945   (modify-syntax-entry ?) ")")
1946
1947   (setq indent-tabs-mode nil)
1948
1949   (let ((fsharp-keywords
1950          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
1951                       "begin" "break"
1952                       "checked" "class" "component" "const" "constraint"
1953                       "constructor" "continue"
1954                       "default" "delegate" "do" "done" "downcast" "downto"
1955                       "eager" "elif" "else" "end" "exception" "extern"
1956                       "finally" "fixed" "for" "fori" "fun" "function"
1957                       "functor"
1958                       "global"
1959                       "if" "in" "include" "inherit" "inline" "interface"
1960                       "internal"
1961                       "lazy" "let"
1962                       "match" "measure" "member" "method" "mixin" "module"
1963                       "mutable"
1964                       "namespace" "new"
1965                       "object" "of" "open" "or" "override"
1966                       "parallel" "params" "private" "process" "protected"
1967                       "public" "pure"
1968                       "rec" "recursive" "return"
1969                       "sealed" "sig" "static" "struct"
1970                       "tailcall" "then" "to" "trait" "try" "type"
1971                       "upcast" "use"
1972                       "val" "virtual" "void" "volatile"
1973                       "when" "while" "with"
1974                       "yield"))
1975
1976         (fsharp-builtins
1977          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
1978                       "base" "false" "null" "true"))
1979
1980         (bang-keywords
1981          (mdw-regexps "do" "let" "return" "use" "yield"))
1982
1983         (preprocessor-keywords
1984          (mdw-regexps "if" "indent" "else" "endif")))
1985
1986     (setq font-lock-keywords
1987           (list (list (concat "\\(^\\|[^\"]\\)"
1988                               "\\(" "(\\*"
1989                                     "[^*]*\\*+"
1990                                     "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
1991                                     ")"
1992                               "\\|"
1993                                     "//.*"
1994                               "\\)")
1995                       '(2 font-lock-comment-face))
1996
1997                 (list (concat "'" "\\("
1998                                     "\\\\"
1999                                     "\\(" "[ntbr'\\]"
2000                                     "\\|" "[0-9][0-9][0-9]"
2001                                     "\\|" "u" "[0-9a-fA-F]\\{4\\}"
2002                                     "\\|" "U" "[0-9a-fA-F]\\{8\\}"
2003                                     "\\)"
2004                                   "\\|"
2005                                   "." "\\)" "'"
2006                               "\\|"
2007                               "\"" "[^\"\\]*"
2008                                     "\\(" "\\\\" "\\(.\\|\n\\)"
2009                                           "[^\"\\]*" "\\)*"
2010                               "\\(\"\\|\\'\\)")
2011                       '(0 font-lock-string-face))
2012
2013                 (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
2014                               "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
2015                               "\\|"
2016                               "\\_<\\(" fsharp-keywords "\\)\\_>")
2017                       '(0 font-lock-keyword-face))
2018                 (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
2019                       '(0 font-lock-variable-name-face))
2020
2021                 (list (concat "\\_<"
2022                               "\\(" "0[bB][01]+" "\\|"
2023                                     "0[oO][0-7]+" "\\|"
2024                                     "0[xX][0-9a-fA-F]+" "\\)"
2025                               "\\(" "lf\\|LF" "\\|"
2026                                     "[uU]?[ysnlL]?" "\\)"
2027                               "\\|"
2028                               "\\_<"
2029                               "[0-9]+" "\\("
2030                                 "[mMQRZING]"
2031                                 "\\|"
2032                                 "\\(\\.[0-9]*\\)?"
2033                                 "\\([eE][-+]?[0-9]+\\)?"
2034                                 "[fFmM]?"
2035                                 "\\|"
2036                                 "[uU]?[ysnlL]?"
2037                               "\\)")
2038                       '(0 mdw-number-face))
2039
2040                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2041                       '(0 mdw-punct-face))))))
2042
2043 (defun mdw-fontify-inferior-fsharp ()
2044   (mdw-fontify-fsharp)
2045   (setq font-lock-keywords
2046         (append (list (list "^[#-]" '(0 font-lock-comment-face))
2047                       (list "^>" '(0 font-lock-keyword-face)))
2048                 font-lock-keywords)))
2049
2050 ;;;--------------------------------------------------------------------------
2051 ;;; Go programming configuration.
2052
2053 (defun mdw-fontify-go ()
2054
2055   (make-local-variable 'font-lock-keywords)
2056   (let ((go-keywords
2057          (mdw-regexps "break" "case" "chan" "const" "continue"
2058                       "default" "defer" "else" "fallthrough" "for"
2059                       "func" "go" "goto" "if" "import"
2060                       "interface" "map" "package" "range" "return"
2061                       "select" "struct" "switch" "type" "var"))
2062         (go-intrinsics
2063          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
2064                       "float32" "float64" "int" "uint8" "int16" "int32"
2065                       "int64" "rune" "string" "uint" "uint8" "uint16"
2066                       "uint32" "uint64" "uintptr" "void"
2067                       "false" "iota" "nil" "true"
2068                       "init" "main"
2069                       "append" "cap" "copy" "delete" "imag" "len" "make"
2070                       "new" "panic" "real" "recover")))
2071
2072     (setq font-lock-keywords
2073           (list
2074
2075            ;; Handle the keywords defined above.
2076            (list (concat "\\<\\(" go-keywords "\\)\\>")
2077                  '(0 font-lock-keyword-face))
2078            (list (concat "\\<\\(" go-intrinsics "\\)\\>")
2079                  '(0 font-lock-variable-name-face))
2080
2081            ;; Strings and characters.
2082            (list (concat "'"
2083                          "\\(" "[^\\']" "\\|"
2084                                "\\\\"
2085                                "\\(" "[abfnrtv\\'\"]" "\\|"
2086                                      "[0-7]\\{3\\}" "\\|"
2087                                      "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
2088                                      "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
2089                                      "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
2090                          "'"
2091                          "\\|"
2092                          "\""
2093                          "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
2094                          "\\(\"\\|$\\)"
2095                          "\\|"
2096                          "`" "[^`]+" "`")
2097                  '(0 font-lock-string-face))
2098
2099            ;; Handle numbers too.
2100            ;;
2101            ;; The following isn't quite right, but it's close enough.
2102            (list (concat "\\<\\("
2103                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2104                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2105                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)")
2106                  '(0 mdw-number-face))
2107
2108            ;; And anything else is punctuation.
2109            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2110                  '(0 mdw-punct-face))))))
2111
2112 ;;;--------------------------------------------------------------------------
2113 ;;; Rust programming configuration.
2114
2115 (setq-default rust-indent-offset 2)
2116
2117 (defun mdw-self-insert-and-indent (count)
2118   (interactive "p")
2119   (self-insert-command count)
2120   (indent-according-to-mode))
2121
2122 (defun mdw-fontify-rust ()
2123
2124   ;; Hack syntax categories.
2125   (modify-syntax-entry ?= ".")
2126
2127   ;; Fontify keywords and things.
2128   (make-local-variable 'font-lock-keywords)
2129   (let ((rust-keywords
2130          (mdw-regexps "abstract" "alignof" "as"
2131                       "become" "box" "break"
2132                       "const" "continue" "create"
2133                       "do"
2134                       "else" "enum" "extern"
2135                       "false" "final" "fn" "for"
2136                       "if" "impl" "in"
2137                       "let" "loop"
2138                       "macro" "match" "mod" "move" "mut"
2139                       "offsetof" "override"
2140                       "priv" "pub" "pure"
2141                       "ref" "return"
2142                       "self" "sizeof" "static" "struct" "super"
2143                       "true" "trait" "type" "typeof"
2144                       "unsafe" "unsized" "use"
2145                       "virtual"
2146                       "where" "while"
2147                       "yield"))
2148         (rust-builtins
2149          (mdw-regexps "array" "pointer" "slice" "tuple"
2150                       "bool" "true" "false"
2151                       "f32" "f64"
2152                       "i8" "i16" "i32" "i64" "isize"
2153                       "u8" "u16" "u32" "u64" "usize"
2154                       "char" "str")))
2155     (setq font-lock-keywords
2156           (list
2157
2158            ;; Handle the keywords defined above.
2159            (list (concat "\\<\\(" rust-keywords "\\)\\>")
2160                  '(0 font-lock-keyword-face))
2161            (list (concat "\\<\\(" rust-builtins "\\)\\>")
2162                  '(0 font-lock-variable-name-face))
2163
2164            ;; Handle numbers too.
2165            (list (concat "\\<\\("
2166                                "[0-9][0-9_]*"
2167                                "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
2168                                "\\|" "\\.[0-9_]+"
2169                                "\\)"
2170                                "\\(f32\\|f64\\)?"
2171                          "\\|" "\\(" "[0-9][0-9_]*"
2172                                "\\|" "0x[0-9a-fA-F_]+"
2173                                "\\|" "0o[0-7_]+"
2174                                "\\|" "0b[01_]+"
2175                                "\\)"
2176                                "\\([ui]\\(8\\|16\\|32\\|64\\|s\\|size\\)\\)?"
2177                          "\\)\\>")
2178                  '(0 mdw-number-face))
2179
2180            ;; And anything else is punctuation.
2181            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2182                  '(0 mdw-punct-face)))))
2183
2184   ;; Hack key bindings.
2185   (local-set-key [?{] 'mdw-self-insert-and-indent)
2186   (local-set-key [?}] 'mdw-self-insert-and-indent))
2187
2188 ;;;--------------------------------------------------------------------------
2189 ;;; Awk programming configuration.
2190
2191 ;; Make Awk indentation nice.
2192
2193 (defun mdw-awk-style ()
2194   (c-add-style "[mdw] Awk style"
2195                '((c-basic-offset . 2)
2196                  (c-offsets-alist (substatement-open . 0)
2197                                   (statement-cont . 0)
2198                                   (statement-case-intro . +)))
2199                t))
2200
2201 ;; Declare Awk fontification style.
2202
2203 (defun mdw-fontify-awk ()
2204
2205   ;; Miscellaneous fiddling.
2206   (mdw-awk-style)
2207   (setq c-backslash-column 72)
2208   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2209
2210   ;; Now define things to be fontified.
2211   (make-local-variable 'font-lock-keywords)
2212   (let ((c-keywords
2213          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
2214                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
2215                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
2216                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
2217                       "atan2" "break" "close" "continue" "cos" "delete"
2218                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
2219                       "function" "gensub" "getline" "gsub" "if" "in"
2220                       "index" "int" "length" "log" "match" "next" "rand"
2221                       "return" "print" "printf" "sin" "split" "sprintf"
2222                       "sqrt" "srand" "strftime" "sub" "substr" "system"
2223                       "systime" "tolower" "toupper" "while")))
2224
2225     (setq font-lock-keywords
2226           (list
2227
2228            ;; Handle the keywords defined above.
2229            (list (concat "\\<\\(" c-keywords "\\)\\>")
2230                  '(0 font-lock-keyword-face))
2231
2232            ;; Handle numbers too.
2233            ;;
2234            ;; The following isn't quite right, but it's close enough.
2235            (list (concat "\\<\\("
2236                          "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2237                          "[0-9]+\\(\\.[0-9]*\\|\\)"
2238                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)\\)"
2239                          "[uUlL]*")
2240                  '(0 mdw-number-face))
2241
2242            ;; And anything else is punctuation.
2243            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2244                  '(0 mdw-punct-face))))))
2245
2246 ;;;--------------------------------------------------------------------------
2247 ;;; Perl programming style.
2248
2249 ;; Perl indentation style.
2250
2251 (setq perl-indent-level 2)
2252
2253 (setq cperl-indent-level 2)
2254 (setq cperl-continued-statement-offset 2)
2255 (setq cperl-continued-brace-offset 0)
2256 (setq cperl-brace-offset -2)
2257 (setq cperl-brace-imaginary-offset 0)
2258 (setq cperl-label-offset 0)
2259
2260 ;; Define perl fontification style.
2261
2262 (defun mdw-fontify-perl ()
2263
2264   ;; Miscellaneous fiddling.
2265   (modify-syntax-entry ?$ "\\")
2266   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
2267   (modify-syntax-entry ?: "." font-lock-syntax-table)
2268   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2269
2270   ;; Now define fontification things.
2271   (make-local-variable 'font-lock-keywords)
2272   (let ((perl-keywords
2273          (mdw-regexps "and"
2274                       "break"
2275                       "cmp" "continue"
2276                       "default" "do"
2277                       "else" "elsif" "eq"
2278                       "for" "foreach"
2279                       "ge" "given" "gt" "goto"
2280                       "if"
2281                       "last" "le" "local" "lt"
2282                       "my"
2283                       "ne" "next"
2284                       "or" "our"
2285                       "package"
2286                       "redo" "require" "return"
2287                       "sub"
2288                       "undef" "unless" "until" "use"
2289                       "when" "while")))
2290
2291     (setq font-lock-keywords
2292           (list
2293
2294            ;; Set up the keywords defined above.
2295            (list (concat "\\<\\(" perl-keywords "\\)\\>")
2296                  '(0 font-lock-keyword-face))
2297
2298            ;; At least numbers are simpler than C.
2299            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2300                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2301                          "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2302                  '(0 mdw-number-face))
2303
2304            ;; And anything else is punctuation.
2305            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2306                  '(0 mdw-punct-face))))))
2307
2308 (defun perl-number-tests (&optional arg)
2309   "Assign consecutive numbers to lines containing `#t'.  With ARG,
2310 strip numbers instead."
2311   (interactive "P")
2312   (save-excursion
2313     (goto-char (point-min))
2314     (let ((i 0) (fmt (if arg "" " %4d")))
2315       (while (search-forward "#t" nil t)
2316         (delete-region (point) (line-end-position))
2317         (setq i (1+ i))
2318         (insert (format fmt i)))
2319       (goto-char (point-min))
2320       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
2321           (replace-match (format "\\1%d" i))))))
2322
2323 ;;;--------------------------------------------------------------------------
2324 ;;; Python programming style.
2325
2326 (defun mdw-fontify-pythonic (keywords)
2327
2328   ;; Miscellaneous fiddling.
2329   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2330   (setq indent-tabs-mode nil)
2331
2332   ;; Now define fontification things.
2333   (make-local-variable 'font-lock-keywords)
2334   (setq font-lock-keywords
2335         (list
2336
2337          ;; Set up the keywords defined above.
2338          (list (concat "\\_<\\(" keywords "\\)\\_>")
2339                '(0 font-lock-keyword-face))
2340
2341          ;; At least numbers are simpler than C.
2342          (list (concat "\\_<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2343                        "\\_<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2344                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|[lL]\\|\\)")
2345                '(0 mdw-number-face))
2346
2347          ;; And anything else is punctuation.
2348          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2349                '(0 mdw-punct-face)))))
2350
2351 ;; Define Python fontification styles.
2352
2353 (defun mdw-fontify-python ()
2354   (mdw-fontify-pythonic
2355    (mdw-regexps "and" "as" "assert" "break" "class" "continue" "def"
2356                 "del" "elif" "else" "except" "exec" "finally" "for"
2357                 "from" "global" "if" "import" "in" "is" "lambda"
2358                 "not" "or" "pass" "print" "raise" "return" "try"
2359                 "while" "with" "yield")))
2360
2361 (defun mdw-fontify-pyrex ()
2362   (mdw-fontify-pythonic
2363    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
2364                 "ctypedef" "def" "del" "elif" "else" "except" "exec"
2365                 "extern" "finally" "for" "from" "global" "if"
2366                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
2367                 "raise" "return" "struct" "try" "while" "with"
2368                 "yield")))
2369
2370 ;;;--------------------------------------------------------------------------
2371 ;;; Icon programming style.
2372
2373 ;; Icon indentation style.
2374
2375 (setq icon-brace-offset 0
2376       icon-continued-brace-offset 0
2377       icon-continued-statement-offset 2
2378       icon-indent-level 2)
2379
2380 ;; Define Icon fontification style.
2381
2382 (defun mdw-fontify-icon ()
2383
2384   ;; Miscellaneous fiddling.
2385   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2386
2387   ;; Now define fontification things.
2388   (make-local-variable 'font-lock-keywords)
2389   (let ((icon-keywords
2390          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
2391                       "end" "every" "fail" "global" "if" "initial"
2392                       "invocable" "link" "local" "next" "not" "of"
2393                       "procedure" "record" "repeat" "return" "static"
2394                       "suspend" "then" "to" "until" "while"))
2395         (preprocessor-keywords
2396          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
2397                       "include" "line" "undef")))
2398     (setq font-lock-keywords
2399           (list
2400
2401            ;; Set up the keywords defined above.
2402            (list (concat "\\<\\(" icon-keywords "\\)\\>")
2403                  '(0 font-lock-keyword-face))
2404
2405            ;; The things that Icon calls keywords.
2406            (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
2407
2408            ;; At least numbers are simpler than C.
2409            (list (concat "\\<[0-9]+"
2410                          "\\([rR][0-9a-zA-Z]+\\|"
2411                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
2412                          "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
2413                  '(0 mdw-number-face))
2414
2415            ;; Preprocessor.
2416            (list (concat "^[ \t]*$[ \t]*\\<\\("
2417                          preprocessor-keywords
2418                          "\\)\\>")
2419                  '(0 font-lock-keyword-face))
2420
2421            ;; And anything else is punctuation.
2422            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2423                  '(0 mdw-punct-face))))))
2424
2425 ;;;--------------------------------------------------------------------------
2426 ;;; Assembler mode.
2427
2428 (defun mdw-fontify-asm ()
2429   (modify-syntax-entry ?' "\"")
2430   (modify-syntax-entry ?. "w")
2431   (modify-syntax-entry ?\n ">")
2432   (setf fill-prefix nil)
2433   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
2434
2435 (defun mdw-asm-set-comment ()
2436   (modify-syntax-entry ?; "."
2437                        )
2438   (modify-syntax-entry asm-comment-char "<b")
2439   (setq comment-start (string asm-comment-char ? )))
2440 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
2441 (put 'asm-comment-char 'safe-local-variable 'characterp)
2442
2443 ;;;--------------------------------------------------------------------------
2444 ;;; TCL configuration.
2445
2446 (defun mdw-fontify-tcl ()
2447   (mapcar #'(lambda (ch) (modify-syntax-entry ch ".")) '(?$))
2448   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
2449   (make-local-variable 'font-lock-keywords)
2450   (setq font-lock-keywords
2451         (list
2452          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
2453                        "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
2454                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
2455                '(0 mdw-number-face))
2456          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2457                '(0 mdw-punct-face)))))
2458
2459 ;;;--------------------------------------------------------------------------
2460 ;;; Dylan programming configuration.
2461
2462 (defun mdw-fontify-dylan ()
2463
2464   (make-local-variable 'font-lock-keywords)
2465
2466   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
2467   ;; hook, which undoes all of our configuration.
2468   (setq major-mode 'dylan-mode)
2469   (font-lock-set-defaults)
2470
2471   (let* ((word "[-_a-zA-Z!*@<>$%]+")
2472          (dylan-keywords (mdw-regexps
2473
2474                           "C-address" "C-callable-wrapper" "C-function"
2475                           "C-mapped-subtype" "C-pointer-type" "C-struct"
2476                           "C-subtype" "C-union" "C-variable"
2477
2478                           "above" "abstract" "afterwards" "all"
2479                           "begin" "below" "block" "by"
2480                           "case" "class" "cleanup" "constant" "create"
2481                           "define" "domain"
2482                           "else" "elseif" "end" "exception" "export"
2483                           "finally" "for" "from" "function"
2484                           "generic"
2485                           "handler"
2486                           "if" "in" "instance" "interface" "iterate"
2487                           "keyed-by"
2488                           "let" "library" "local"
2489                           "macro" "method" "module"
2490                           "otherwise"
2491                           "profiling"
2492                           "select" "slot" "subclass"
2493                           "table" "then" "to"
2494                           "unless" "until" "use"
2495                           "variable" "virtual"
2496                           "when" "while"))
2497          (sharp-keywords (mdw-regexps
2498                           "all-keys" "key" "next" "rest" "include"
2499                           "t" "f")))
2500     (setq font-lock-keywords
2501           (list (list (concat "\\<\\(" dylan-keywords
2502                               "\\|" "with\\(out\\)?-" word
2503                               "\\)\\>")
2504                       '(0 font-lock-keyword-face))
2505                 (list (concat "\\<" word ":" "\\|"
2506                               "#\\(" sharp-keywords "\\)\\>")
2507                       '(0 font-lock-variable-name-face))
2508                 (list (concat "\\("
2509                               "\\([-+]\\|\\<\\)[0-9]+" "\\("
2510                                 "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
2511                                 "\\|" "/[0-9]+"
2512                               "\\)"
2513                               "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
2514                               "\\|" "#b[01]+"
2515                               "\\|" "#o[0-7]+"
2516                               "\\|" "#x[0-9a-zA-Z]+"
2517                               "\\)\\>")
2518                       '(0 mdw-number-face))
2519                 (list (concat "\\("
2520                               "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
2521                               "\\_<[-+*/=<>:&|]+\\_>"
2522                               "\\)")
2523                       '(0 mdw-punct-face))))))
2524
2525 ;;;--------------------------------------------------------------------------
2526 ;;; Algol 68 configuration.
2527
2528 (setq a68-indent-step 2)
2529
2530 (defun mdw-fontify-algol-68 ()
2531
2532   ;; Fix up the syntax table.
2533   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
2534   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
2535     (modify-syntax-entry ch "." a68-mode-syntax-table))
2536
2537   (make-local-variable 'font-lock-keywords)
2538
2539   (let ((not-comment
2540          (let ((word "COMMENT"))
2541            (do ((regexp (concat "[^" (substring word 0 1) "]+")
2542                         (concat regexp "\\|"
2543                                 (substring word 0 i)
2544                                 "[^" (substring word i (1+ i)) "]"))
2545                 (i 1 (1+ i)))
2546                ((>= i (length word)) regexp)))))
2547     (setq font-lock-keywords
2548           (list (list (concat "\\<COMMENT\\>"
2549                               "\\(" not-comment "\\)\\{0,5\\}"
2550                               "\\(\\'\\|\\<COMMENT\\>\\)")
2551                       '(0 font-lock-comment-face))
2552                 (list (concat "\\<CO\\>"
2553                               "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
2554                               "\\($\\|\\<CO\\>\\)")
2555                       '(0 font-lock-comment-face))
2556                 (list "\\<[A-Z_]+\\>"
2557                       '(0 font-lock-keyword-face))
2558                 (list (concat "\\<"
2559                               "[0-9]+"
2560                               "\\(\\.[0-9]+\\)?"
2561                               "\\([eE][-+]?[0-9]+\\)?"
2562                               "\\>")
2563                       '(0 mdw-number-face))
2564                 (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
2565                       '(0 mdw-punct-face))))))
2566
2567 ;;;--------------------------------------------------------------------------
2568 ;;; REXX configuration.
2569
2570 (defun mdw-rexx-electric-* ()
2571   (interactive)
2572   (insert ?*)
2573   (rexx-indent-line))
2574
2575 (defun mdw-rexx-indent-newline-indent ()
2576   (interactive)
2577   (rexx-indent-line)
2578   (if abbrev-mode (expand-abbrev))
2579   (newline-and-indent))
2580
2581 (defun mdw-fontify-rexx ()
2582
2583   ;; Various bits of fiddling.
2584   (setq mdw-auto-indent nil)
2585   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
2586   (local-set-key [?*] 'mdw-rexx-electric-*)
2587   (mapcar #'(lambda (ch) (modify-syntax-entry ch "w"))
2588           '(?! ?? ?# ?@ ?$))
2589   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
2590
2591   ;; Set up keywords and things for fontification.
2592   (make-local-variable 'font-lock-keywords-case-fold-search)
2593   (setq font-lock-keywords-case-fold-search t)
2594
2595   (setq rexx-indent 2)
2596   (setq rexx-end-indent rexx-indent)
2597   (setq rexx-cont-indent rexx-indent)
2598
2599   (make-local-variable 'font-lock-keywords)
2600   (let ((rexx-keywords
2601          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
2602                       "else" "end" "engineering" "exit" "expose" "for"
2603                       "forever" "form" "fuzz" "if" "interpret" "iterate"
2604                       "leave" "linein" "name" "nop" "numeric" "off" "on"
2605                       "options" "otherwise" "parse" "procedure" "pull"
2606                       "push" "queue" "return" "say" "select" "signal"
2607                       "scientific" "source" "then" "trace" "to" "until"
2608                       "upper" "value" "var" "version" "when" "while"
2609                       "with"
2610
2611                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
2612                       "center" "center" "charin" "charout" "chars"
2613                       "compare" "condition" "copies" "c2d" "c2x"
2614                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
2615                       "errortext" "format" "fuzz" "insert" "lastpos"
2616                       "left" "length" "lineout" "lines" "max" "min"
2617                       "overlay" "pos" "queued" "random" "reverse" "right"
2618                       "sign" "sourceline" "space" "stream" "strip"
2619                       "substr" "subword" "symbol" "time" "translate"
2620                       "trunc" "value" "verify" "word" "wordindex"
2621                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
2622                       "x2d")))
2623
2624     (setq font-lock-keywords
2625           (list
2626
2627            ;; Set up the keywords defined above.
2628            (list (concat "\\<\\(" rexx-keywords "\\)\\>")
2629                  '(0 font-lock-keyword-face))
2630
2631            ;; Fontify all symbols the same way.
2632            (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
2633                          "[A-Za-z0-9.!?_#@$]+\\)")
2634                  '(0 font-lock-variable-name-face))
2635
2636            ;; And everything else is punctuation.
2637            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2638                  '(0 mdw-punct-face))))))
2639
2640 ;;;--------------------------------------------------------------------------
2641 ;;; Standard ML programming style.
2642
2643 (defun mdw-fontify-sml ()
2644
2645   ;; Make underscore an honorary letter.
2646   (modify-syntax-entry ?' "w")
2647
2648   ;; Set fill prefix.
2649   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
2650
2651   ;; Now define fontification things.
2652   (make-local-variable 'font-lock-keywords)
2653   (let ((sml-keywords
2654          (mdw-regexps "abstype" "and" "andalso" "as"
2655                       "case"
2656                       "datatype" "do"
2657                       "else" "end" "eqtype" "exception"
2658                       "fn" "fun" "functor"
2659                       "handle"
2660                       "if" "in" "include" "infix" "infixr"
2661                       "let" "local"
2662                       "nonfix"
2663                       "of" "op" "open" "orelse"
2664                       "raise" "rec"
2665                       "sharing" "sig" "signature" "struct" "structure"
2666                       "then" "type"
2667                       "val"
2668                       "where" "while" "with" "withtype")))
2669
2670     (setq font-lock-keywords
2671           (list
2672
2673            ;; Set up the keywords defined above.
2674            (list (concat "\\<\\(" sml-keywords "\\)\\>")
2675                  '(0 font-lock-keyword-face))
2676
2677            ;; At least numbers are simpler than C.
2678            (list (concat "\\<\\(\\~\\|\\)"
2679                             "\\(0\\(\\([wW]\\|\\)[xX][0-9a-fA-F]+\\|"
2680                                    "[wW][0-9]+\\)\\|"
2681                                 "\\([0-9]+\\(\\.[0-9]+\\|\\)"
2682                                          "\\([eE]\\(\\~\\|\\)"
2683                                                 "[0-9]+\\|\\)\\)\\)")
2684                  '(0 mdw-number-face))
2685
2686            ;; And anything else is punctuation.
2687            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2688                  '(0 mdw-punct-face))))))
2689
2690 ;;;--------------------------------------------------------------------------
2691 ;;; Haskell configuration.
2692
2693 (defun mdw-fontify-haskell ()
2694
2695   ;; Fiddle with syntax table to get comments right.
2696   (modify-syntax-entry ?' "_")
2697   (modify-syntax-entry ?- ". 12")
2698   (modify-syntax-entry ?\n ">")
2699
2700   ;; Make punctuation be punctuation
2701   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
2702     (do ((i 0 (1+ i)))
2703         ((>= i (length punct)))
2704       (modify-syntax-entry (aref punct i) ".")))
2705
2706   ;; Set fill prefix.
2707   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
2708
2709   ;; Fiddle with fontification.
2710   (make-local-variable 'font-lock-keywords)
2711   (let ((haskell-keywords
2712          (mdw-regexps "as"
2713                       "case" "ccall" "class"
2714                       "data" "default" "deriving" "do"
2715                       "else" "exists"
2716                       "forall" "foreign"
2717                       "hiding"
2718                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
2719                       "let"
2720                       "mdo" "module"
2721                       "newtype"
2722                       "of"
2723                       "proc"
2724                       "qualified"
2725                       "rec"
2726                       "safe" "stdcall"
2727                       "then" "type"
2728                       "unsafe"
2729                       "where"))
2730         (control-sequences
2731          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
2732                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
2733                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
2734                       "SP" "STX" "SUB" "SYN" "US" "VT")))
2735
2736     (setq font-lock-keywords
2737           (list
2738            (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
2739                               "\\(-+}\\|-*\\'\\)"
2740                          "\\|"
2741                          "--.*$")
2742                  '(0 font-lock-comment-face))
2743            (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
2744                  '(0 font-lock-keyword-face))
2745            (list (concat "'\\("
2746                          "[^\\]"
2747                          "\\|"
2748                          "\\\\"
2749                          "\\(" "[abfnrtv\\\"']" "\\|"
2750                                "^" "\\(" control-sequences "\\|"
2751                                          "[]A-Z@[\\^_]" "\\)" "\\|"
2752                                "\\|"
2753                                "[0-9]+" "\\|"
2754                                "[oO][0-7]+" "\\|"
2755                                "[xX][0-9A-Fa-f]+"
2756                          "\\)"
2757                          "\\)'")
2758                  '(0 font-lock-string-face))
2759            (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
2760                  '(0 font-lock-variable-name-face))
2761            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
2762                          "\\_<[0-9]+\\(\\.[0-9]*\\|\\)"
2763                          "\\([eE]\\([-+]\\|\\)[0-9]+\\|\\)")
2764                  '(0 mdw-number-face))
2765            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2766                  '(0 mdw-punct-face))))))
2767
2768 ;;;--------------------------------------------------------------------------
2769 ;;; Erlang configuration.
2770
2771 (setq erlang-electric-commands nil)
2772
2773 (defun mdw-fontify-erlang ()
2774
2775   ;; Set fill prefix.
2776   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
2777
2778   ;; Fiddle with fontification.
2779   (make-local-variable 'font-lock-keywords)
2780   (let ((erlang-keywords
2781          (mdw-regexps "after" "and" "andalso"
2782                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
2783                       "case" "catch" "cond"
2784                       "div" "end" "fun" "if" "let" "not"
2785                       "of" "or" "orelse"
2786                       "query" "receive" "rem" "try" "when" "xor")))
2787
2788     (setq font-lock-keywords
2789           (list
2790            (list "%.*$"
2791                  '(0 font-lock-comment-face))
2792            (list (concat "\\<\\(" erlang-keywords "\\)\\>")
2793                  '(0 font-lock-keyword-face))
2794            (list (concat "^-\\sw+\\>")
2795                  '(0 font-lock-keyword-face))
2796            (list "\\<[0-9]+\\(\\|#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)\\>"
2797                  '(0 mdw-number-face))
2798            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2799                  '(0 mdw-punct-face))))))
2800
2801 ;;;--------------------------------------------------------------------------
2802 ;;; Texinfo configuration.
2803
2804 (defun mdw-fontify-texinfo ()
2805
2806   ;; Set fill prefix.
2807   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
2808
2809   ;; Real fontification things.
2810   (make-local-variable 'font-lock-keywords)
2811   (setq font-lock-keywords
2812         (list
2813
2814          ;; Environment names are keywords.
2815          (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
2816                '(2 font-lock-keyword-face))
2817
2818          ;; Unmark escaped magic characters.
2819          (list "\\(@\\)\\([@{}]\\)"
2820                '(1 font-lock-keyword-face)
2821                '(2 font-lock-variable-name-face))
2822
2823          ;; Make sure we get comments properly.
2824          (list "@c\\(\\|omment\\)\\( .*\\)?$"
2825                '(0 font-lock-comment-face))
2826
2827          ;; Command names are keywords.
2828          (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2829                '(0 font-lock-keyword-face))
2830
2831          ;; Fontify TeX special characters as punctuation.
2832          (list "[{}]+"
2833                '(0 mdw-punct-face)))))
2834
2835 ;;;--------------------------------------------------------------------------
2836 ;;; TeX and LaTeX configuration.
2837
2838 (defun mdw-fontify-tex ()
2839   (setq ispell-parser 'tex)
2840   (turn-on-reftex)
2841
2842   ;; Don't make maths into a string.
2843   (modify-syntax-entry ?$ ".")
2844   (modify-syntax-entry ?$ "." font-lock-syntax-table)
2845   (local-set-key [?$] 'self-insert-command)
2846
2847   ;; Make `tab' be useful, given that tab stops in TeX don't work well.
2848   (local-set-key "\C-i" 'indent-relative)
2849   (setq indent-tabs-mode nil)
2850
2851   ;; Set fill prefix.
2852   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
2853
2854   ;; Real fontification things.
2855   (make-local-variable 'font-lock-keywords)
2856   (setq font-lock-keywords
2857         (list
2858
2859          ;; Environment names are keywords.
2860          (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
2861                        "{\\([^}\n]*\\)}")
2862                '(2 font-lock-keyword-face))
2863
2864          ;; Suspended environment names are keywords too.
2865          (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
2866                        "{\\([^}\n]*\\)}")
2867                '(3 font-lock-keyword-face))
2868
2869          ;; Command names are keywords.
2870          (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
2871                '(0 font-lock-keyword-face))
2872
2873          ;; Handle @/.../ for italics.
2874          ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
2875          ;;       '(1 font-lock-keyword-face)
2876          ;;       '(3 font-lock-keyword-face))
2877
2878          ;; Handle @*...* for boldness.
2879          ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
2880          ;;       '(1 font-lock-keyword-face)
2881          ;;       '(3 font-lock-keyword-face))
2882
2883          ;; Handle @`...' for literal syntax things.
2884          ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
2885          ;;       '(1 font-lock-keyword-face)
2886          ;;       '(3 font-lock-keyword-face))
2887
2888          ;; Handle @<...> for nonterminals.
2889          ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
2890          ;;       '(1 font-lock-keyword-face)
2891          ;;       '(3 font-lock-keyword-face))
2892
2893          ;; Handle other @-commands.
2894          ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
2895          ;;       '(0 font-lock-keyword-face))
2896
2897          ;; Make sure we get comments properly.
2898          (list "%.*"
2899                '(0 font-lock-comment-face))
2900
2901          ;; Fontify TeX special characters as punctuation.
2902          (list "[$^_{}#&]"
2903                '(0 mdw-punct-face)))))
2904
2905 ;;;--------------------------------------------------------------------------
2906 ;;; SGML hacking.
2907
2908 (defun mdw-sgml-mode ()
2909   (interactive)
2910   (sgml-mode)
2911   (mdw-standard-fill-prefix "")
2912   (make-local-variable 'sgml-delimiters)
2913   (setq sgml-delimiters
2914         '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
2915           "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT" "\""
2916           "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]" "NESTC" "{"
2917           "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">" "PIO" "<?"
2918           "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" "," "STAGO" ":"
2919           "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
2920           "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE" "/>"
2921           "NULL" ""))
2922   (setq major-mode 'mdw-sgml-mode)
2923   (setq mode-name "[mdw] SGML")
2924   (run-hooks 'mdw-sgml-mode-hook))
2925
2926 ;;;--------------------------------------------------------------------------
2927 ;;; Configuration files.
2928
2929 (defvar mdw-conf-quote-normal nil
2930   "*Control syntax category of quote characters `\"' and `''.
2931 If this is `t', consider quote characters to be normal
2932 punctuation, as for `conf-quote-normal'.  If this is `nil' then
2933 leave quote characters as quotes.  If this is a list, then
2934 consider the quote characters in the list to be normal
2935 punctuation.  If this is a single quote character, then consider
2936 that character only to be normal punctuation.")
2937 (defun mdw-conf-quote-normal-acceptable-value-p (value)
2938   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
2939   (or (booleanp value)
2940       (every (lambda (v) (memq v '(?\" ?')))
2941              (if (listp value) value (list value)))))
2942 (put 'mdw-conf-quote-normal 'safe-local-variable
2943      'mdw-conf-quote-normal-acceptable-value-p)
2944
2945 (defun mdw-fix-up-quote ()
2946   "Apply the setting of `mdw-conf-quote-normal'."
2947   (let ((flag mdw-conf-quote-normal))
2948     (cond ((eq flag t)
2949            (conf-quote-normal t))
2950           ((not flag)
2951            nil)
2952           (t
2953            (let ((table (copy-syntax-table (syntax-table))))
2954              (mapc (lambda (ch) (modify-syntax-entry ch "." table))
2955                    (if (listp flag) flag (list flag)))
2956              (set-syntax-table table)
2957              (and font-lock-mode (font-lock-fontify-buffer)))))))
2958 (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t)
2959
2960 ;;;--------------------------------------------------------------------------
2961 ;;; Shell scripts.
2962
2963 (defun mdw-setup-sh-script-mode ()
2964
2965   ;; Fetch the shell interpreter's name.
2966   (let ((shell-name sh-shell-file))
2967
2968     ;; Try reading the hash-bang line.
2969     (save-excursion
2970       (goto-char (point-min))
2971       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
2972           (setq shell-name (match-string 1))))
2973
2974     ;; Now try to set the shell.
2975     ;;
2976     ;; Don't let `sh-set-shell' bugger up my script.
2977     (let ((executable-set-magic #'(lambda (s &rest r) s)))
2978       (sh-set-shell shell-name)))
2979
2980   ;; Don't insert here-document scaffolding automatically.
2981   (local-set-key "<" 'self-insert-command)
2982
2983   ;; Now enable my keys and the fontification.
2984   (mdw-misc-mode-config)
2985
2986   ;; Set the indentation level correctly.
2987   (setq sh-indentation 2)
2988   (setq sh-basic-offset 2))
2989
2990 (setq sh-shell-file "/bin/sh")
2991
2992 ;; Awful hacking to override the shell detection for particular scripts.
2993 (defmacro define-custom-shell-mode (name shell)
2994   `(defun ,name ()
2995      (interactive)
2996      (set (make-local-variable 'sh-shell-file) ,shell)
2997      (sh-mode)))
2998 (define-custom-shell-mode bash-mode "/bin/bash")
2999 (define-custom-shell-mode rc-mode "/usr/bin/rc")
3000 (put 'sh-shell-file 'permanent-local t)
3001
3002 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
3003 (eval-after-load "sh-script"
3004   '(or (assq 'rc sh-mode-syntax-table-input)
3005        (let ((frag '(nil
3006                      ?# "<"
3007                      ?\n ">#"
3008                      ?\" "\"\""
3009                      ?\' "\"\'"
3010                      ?$ "'"
3011                      ?\` "."
3012                      ?! "_"
3013                      ?% "_"
3014                      ?. "_"
3015                      ?^ "_"
3016                      ?~ "_"
3017                      ?, "_"
3018                      ?= "."
3019                      ?< "."
3020                      ?> "."))
3021              (assoc (assq 'rc sh-mode-syntax-table-input)))
3022          (if assoc
3023              (rplacd assoc frag)
3024            (setq sh-mode-syntax-table-input
3025                  (cons (cons 'rc frag)
3026                        sh-mode-syntax-table-input))))))
3027
3028 ;;;--------------------------------------------------------------------------
3029 ;;; Emacs shell mode.
3030
3031 (defun mdw-eshell-prompt ()
3032   (let ((left "[") (right "]"))
3033     (when (= (user-uid) 0)
3034       (setq left "«" right "»"))
3035     (concat left
3036             (save-match-data
3037               (replace-regexp-in-string "\\..*$" "" (system-name)))
3038             " "
3039             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
3040                    (home (expand-file-name "~")) (nhome (length home)))
3041               (if (and (>= npwd nhome)
3042                        (or (= nhome npwd)
3043                            (= (elt pwd nhome) ?/))
3044                        (string= (substring pwd 0 nhome) home))
3045                   (concat "~" (substring pwd (length home)))
3046                 pwd))
3047             right)))
3048 (setq eshell-prompt-function 'mdw-eshell-prompt)
3049 (setq eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
3050
3051 (defun eshell/e (file) (find-file file) nil)
3052 (defun eshell/ee (file) (find-file-other-window file) nil)
3053 (defun eshell/w3m (url) (w3m-goto-url url) nil)
3054
3055 (mdw-define-face eshell-prompt (t :weight bold))
3056 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
3057 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
3058 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
3059 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
3060 (mdw-define-face eshell-ls-executable (t :weight bold))
3061 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
3062 (mdw-define-face eshell-ls-readonly (t nil))
3063 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
3064
3065 ;;;--------------------------------------------------------------------------
3066 ;;; Messages-file mode.
3067
3068 (defun messages-mode-guts ()
3069   (setq messages-mode-syntax-table (make-syntax-table))
3070   (set-syntax-table messages-mode-syntax-table)
3071   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
3072   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
3073   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
3074   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
3075   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
3076   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
3077   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
3078   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
3079   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
3080   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
3081   (make-local-variable 'comment-start)
3082   (make-local-variable 'comment-end)
3083   (make-local-variable 'indent-line-function)
3084   (setq indent-line-function 'indent-relative)
3085   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3086   (make-local-variable 'font-lock-defaults)
3087   (make-local-variable 'messages-mode-keywords)
3088   (let ((keywords
3089          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
3090                       "export" "enum" "fixed-octetstring" "flags"
3091                       "harmless" "map" "nested" "optional"
3092                       "optional-tagged" "package" "primitive"
3093                       "primitive-nullfree" "relaxed[ \t]+enum"
3094                       "set" "table" "tagged-optional"   "union"
3095                       "variadic" "vector" "version" "version-tag")))
3096     (setq messages-mode-keywords
3097           (list
3098            (list (concat "\\<\\(" keywords "\\)\\>:")
3099                  '(0 font-lock-keyword-face))
3100            '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
3101            '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
3102              (0 font-lock-variable-name-face))
3103            '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
3104            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3105              (0 mdw-punct-face)))))
3106   (setq font-lock-defaults
3107         '(messages-mode-keywords nil nil nil nil))
3108   (run-hooks 'messages-file-hook))
3109
3110 (defun messages-mode ()
3111   (interactive)
3112   (fundamental-mode)
3113   (setq major-mode 'messages-mode)
3114   (setq mode-name "Messages")
3115   (messages-mode-guts)
3116   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
3117   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
3118   (setq comment-start "# ")
3119   (setq comment-end "")
3120   (run-hooks 'messages-mode-hook))
3121
3122 (defun cpp-messages-mode ()
3123   (interactive)
3124   (fundamental-mode)
3125   (setq major-mode 'cpp-messages-mode)
3126   (setq mode-name "CPP Messages")
3127   (messages-mode-guts)
3128   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
3129   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
3130   (setq comment-start "/* ")
3131   (setq comment-end " */")
3132   (let ((preprocessor-keywords
3133          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3134                       "ident" "if" "ifdef" "ifndef" "import" "include"
3135                       "line" "pragma" "unassert" "undef" "warning")))
3136     (setq messages-mode-keywords
3137           (append (list (list (concat "^[ \t]*\\#[ \t]*"
3138                                       "\\(include\\|import\\)"
3139                                       "[ \t]*\\(<[^>]+\\(>\\|\\)\\)")
3140                               '(2 font-lock-string-face))
3141                         (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3142                                       preprocessor-keywords
3143                                       "\\)\\>\\|[0-9]+\\|$\\)\\)")
3144                               '(1 font-lock-keyword-face)))
3145                   messages-mode-keywords)))
3146   (run-hooks 'cpp-messages-mode-hook))
3147
3148 (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
3149 (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
3150 ; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
3151
3152 ;;;--------------------------------------------------------------------------
3153 ;;; Messages-file mode.
3154
3155 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
3156   "Face to use for subsittution directives.")
3157 (make-face 'mallow-driver-substitution-face)
3158 (defvar mallow-driver-text-face 'mallow-driver-text-face
3159   "Face to use for body text.")
3160 (make-face 'mallow-driver-text-face)
3161
3162 (defun mallow-driver-mode ()
3163   (interactive)
3164   (fundamental-mode)
3165   (setq major-mode 'mallow-driver-mode)
3166   (setq mode-name "Mallow driver")
3167   (setq mallow-driver-mode-syntax-table (make-syntax-table))
3168   (set-syntax-table mallow-driver-mode-syntax-table)
3169   (make-local-variable 'comment-start)
3170   (make-local-variable 'comment-end)
3171   (make-local-variable 'indent-line-function)
3172   (setq indent-line-function 'indent-relative)
3173   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
3174   (make-local-variable 'font-lock-defaults)
3175   (make-local-variable 'mallow-driver-mode-keywords)
3176   (let ((keywords
3177          (mdw-regexps "each" "divert" "file" "if"
3178                       "perl" "set" "string" "type" "write")))
3179     (setq mallow-driver-mode-keywords
3180           (list
3181            (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
3182                  '(0 font-lock-keyword-face))
3183            (list "^%\\s *\\(#.*\\|\\)$"
3184                  '(0 font-lock-comment-face))
3185            (list "^%"
3186                  '(0 font-lock-keyword-face))
3187            (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
3188            (list "\\${[^}]*}"
3189                  '(0 mallow-driver-substitution-face t)))))
3190   (setq font-lock-defaults
3191         '(mallow-driver-mode-keywords nil nil nil nil))
3192   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
3193   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
3194   (setq comment-start "%# ")
3195   (setq comment-end "")
3196   (run-hooks 'mallow-driver-mode-hook))
3197
3198 (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t)
3199
3200 ;;;--------------------------------------------------------------------------
3201 ;;; NFast debugs.
3202
3203 (defun nfast-debug-mode ()
3204   (interactive)
3205   (fundamental-mode)
3206   (setq major-mode 'nfast-debug-mode)
3207   (setq mode-name "NFast debug")
3208   (setq messages-mode-syntax-table (make-syntax-table))
3209   (set-syntax-table messages-mode-syntax-table)
3210   (make-local-variable 'font-lock-defaults)
3211   (make-local-variable 'nfast-debug-mode-keywords)
3212   (setq truncate-lines t)
3213   (setq nfast-debug-mode-keywords
3214         (list
3215          '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
3216            (0 font-lock-keyword-face))
3217          (list (concat "^[ \t]+\\(\\("
3218                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3219                        "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
3220                        "[ \t]+\\)*"
3221                        "[0-9a-fA-F]+\\)[ \t]*$")
3222            '(0 mdw-number-face))
3223          '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
3224            (1 font-lock-keyword-face))
3225          '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
3226            (1 font-lock-warning-face))
3227          '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
3228            (1 nil))
3229          (list (concat "^[ \t]+\\.cmd=[ \t]+"
3230                        "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
3231            '(1 font-lock-keyword-face))
3232          '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
3233          '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
3234          '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
3235          '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
3236   (setq font-lock-defaults
3237         '(nfast-debug-mode-keywords nil nil nil nil))
3238   (run-hooks 'nfast-debug-mode-hook))
3239
3240 ;;;--------------------------------------------------------------------------
3241 ;;; Other languages.
3242
3243 ;; Smalltalk.
3244
3245 (defun mdw-setup-smalltalk ()
3246   (and mdw-auto-indent
3247        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
3248   (make-local-variable 'mdw-auto-indent)
3249   (setq mdw-auto-indent nil)
3250   (local-set-key "\C-i" 'smalltalk-reindent))
3251
3252 (defun mdw-fontify-smalltalk ()
3253   (make-local-variable 'font-lock-keywords)
3254   (setq font-lock-keywords
3255         (list
3256          (list "\\<[A-Z][a-zA-Z0-9]*\\>"
3257                '(0 font-lock-keyword-face))
3258          (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3259                        "[0-9][0-9_]*\\(\\.[0-9_]*\\|\\)"
3260                        "\\([eE]\\([-+]\\|\\)[0-9_]+\\|\\)")
3261                '(0 mdw-number-face))
3262          (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3263                '(0 mdw-punct-face)))))
3264
3265 ;; Lispy languages.
3266
3267 ;; Unpleasant bodge.
3268 (unless (boundp 'slime-repl-mode-map)
3269   (setq slime-repl-mode-map (make-sparse-keymap)))
3270
3271 (defun mdw-indent-newline-and-indent ()
3272   (interactive)
3273   (indent-for-tab-command)
3274   (newline-and-indent))
3275
3276 (eval-after-load "cl-indent"
3277   '(progn
3278      (mapc #'(lambda (pair)
3279                (put (car pair)
3280                     'common-lisp-indent-function
3281                     (cdr pair)))
3282       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
3283         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
3284
3285 (defun mdw-common-lisp-indent ()
3286   (make-local-variable 'lisp-indent-function)
3287   (setq lisp-indent-function 'common-lisp-indent-function))
3288
3289 (setq lisp-simple-loop-indentation 2
3290       lisp-loop-keyword-indentation 6
3291       lisp-loop-forms-indentation 6)
3292
3293 (defun mdw-fontify-lispy ()
3294
3295   ;; Set fill prefix.
3296   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
3297
3298   ;; Not much fontification needed.
3299   (make-local-variable 'font-lock-keywords)
3300   (setq font-lock-keywords
3301         (list (list (concat "\\("
3302                             "\\_<[-+]?"
3303                             "\\(" "[0-9]+/[0-9]+"
3304                             "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
3305                                         "\\.[0-9]+" "\\)"
3306                                   "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
3307                             "\\)"
3308                             "\\|"
3309                             "#"
3310                             "\\(" "x" "[-+]?"
3311                                   "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
3312                             "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
3313                             "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
3314                             "\\|" "[0-9]+" "r" "[-+]?"
3315                                   "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
3316                             "\\)"
3317                             "\\)\\_>")
3318                     '(0 mdw-number-face))
3319               (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3320                     '(0 mdw-punct-face)))))
3321
3322 (defun comint-send-and-indent ()
3323   (interactive)
3324   (comint-send-input)
3325   (and mdw-auto-indent
3326        (indent-for-tab-command)))
3327
3328 (defun mdw-setup-m4 ()
3329
3330   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
3331   ;; annoying: fix it.
3332   (modify-syntax-entry ?{ "(")
3333   (modify-syntax-entry ?} ")")
3334
3335   ;; Fill prefix.
3336   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
3337
3338 ;;;--------------------------------------------------------------------------
3339 ;;; Text mode.
3340
3341 (defun mdw-text-mode ()
3342   (setq fill-column 72)
3343   (flyspell-mode t)
3344   (mdw-standard-fill-prefix
3345    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
3346   (auto-fill-mode 1))
3347
3348 ;;;--------------------------------------------------------------------------
3349 ;;; Outline and hide/show modes.
3350
3351 (defun mdw-outline-collapse-all ()
3352   "Completely collapse everything in the entire buffer."
3353   (interactive)
3354   (save-excursion
3355     (goto-char (point-min))
3356     (while (< (point) (point-max))
3357       (hide-subtree)
3358       (forward-line))))
3359
3360 (setq hs-hide-comments-when-hiding-all nil)
3361
3362 (defadvice hs-hide-all (after hide-first-comment activate)
3363   (save-excursion (hs-hide-initial-comment-block)))
3364
3365 ;;;--------------------------------------------------------------------------
3366 ;;; Shell mode.
3367
3368 (defun mdw-sh-mode-setup ()
3369   (local-set-key [?\C-a] 'comint-bol)
3370   (add-hook 'comint-output-filter-functions
3371             'comint-watch-for-password-prompt))
3372
3373 (defun mdw-term-mode-setup ()
3374   (setq term-prompt-regexp shell-prompt-pattern)
3375   (make-local-variable 'mouse-yank-at-point)
3376   (make-local-variable 'transient-mark-mode)
3377   (setq mouse-yank-at-point t)
3378   (auto-fill-mode -1)
3379   (setq tab-width 8))
3380
3381 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
3382 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
3383 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
3384 (defun term-send-meta-meta-something ()
3385   (interactive)
3386   (term-send-raw-string "\e\e")
3387   (term-send-raw))
3388 (eval-after-load 'term
3389   '(progn
3390      (define-key term-raw-map [?\e ?\e] nil)
3391      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
3392      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
3393      (define-key term-raw-map [M-right] 'term-send-meta-right)
3394      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
3395      (define-key term-raw-map [M-left] 'term-send-meta-left)
3396      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
3397
3398 (defadvice term-exec (before program-args-list compile activate)
3399   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
3400 This allows you to pass a list of arguments through `ansi-term'."
3401   (let ((program (ad-get-arg 2)))
3402     (if (listp program)
3403         (progn
3404           (ad-set-arg 2 (car program))
3405           (ad-set-arg 4 (cdr program))))))
3406
3407 (defun ssh (host)
3408   "Open a terminal containing an ssh session to the HOST."
3409   (interactive "sHost: ")
3410   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
3411
3412 (defvar git-grep-command
3413   "env PAGER=cat git grep --no-color -nH -e "
3414   "*The default command for \\[git-grep].")
3415
3416 (defvar git-grep-history nil)
3417
3418 (defun git-grep (command-args)
3419   "Run `git grep' with user-specified args and collect output in a buffer."
3420   (interactive
3421    (list (read-shell-command "Run git grep (like this): "
3422                              git-grep-command 'git-grep-history)))
3423   (grep command-args))
3424
3425 ;;;--------------------------------------------------------------------------
3426 ;;; Inferior Emacs Lisp.
3427
3428 (setq comint-prompt-read-only t)
3429
3430 (eval-after-load "comint"
3431   '(progn
3432      (define-key comint-mode-map "\C-w" 'comint-kill-region)
3433      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
3434
3435 (eval-after-load "ielm"
3436   '(progn
3437      (define-key ielm-map "\C-w" 'comint-kill-region)
3438      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
3439
3440 ;;;----- That's all, folks --------------------------------------------------
3441
3442 (provide 'dot-emacs)