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

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