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

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