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

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