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