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

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