mdw@git.distorted.org.uk Git - profile/blob - el/dot-emacs.el

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