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