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