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