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

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