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

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