chiark - git - mdw - profile/blob - el/dot-emacs.el

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