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