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