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