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

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