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

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