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