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