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