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