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   (flyspell-prog-mode)
1781   (and (fboundp 'gtags-mode)
1782        (gtags-mode))
1783   (if (fboundp 'hs-minor-mode)
1784       (trap (hs-minor-mode t))
1785     (outline-minor-mode t))
1786   (reveal-mode t)
1787   (trap (turn-on-font-lock)))
1788
1789 (defun mdw-post-local-vars-misc-mode-config ()
1790   (setq whitespace-line-column mdw-text-width)
1791   (when (and mdw-do-misc-mode-hacking
1792              (not buffer-read-only))
1793     (setq show-trailing-whitespace t)
1794     (mdw-whitespace-mode 1)))
1795 (add-hook 'hack-local-variables-hook 'mdw-post-local-vars-misc-mode-config)
1796
1797 (defmacro mdw-advise-update-angry-fruit-salad (&rest funcs)
1798   `(progn ,@(mapcar (lambda (func)
1799                       `(defadvice ,func
1800                            (after mdw-angry-fruit-salad activate)
1801                          (when mdw-do-misc-mode-hacking
1802                            (setq show-trailing-whitespace
1803                                  (not buffer-read-only))
1804                            (mdw-whitespace-mode (if buffer-read-only 0 1)))))
1805                     funcs)))
1806 (mdw-advise-update-angry-fruit-salad toggle-read-only
1807                                      read-only-mode
1808                                      view-mode
1809                                      view-mode-enable
1810                                      view-mode-disable)
1811
1812 (eval-after-load 'gtags
1813   '(progn
1814      (dolist (key '([mouse-2] [mouse-3]))
1815        (define-key gtags-mode-map key nil))
1816      (define-key gtags-mode-map [C-S-mouse-2] 'gtags-find-tag-by-event)
1817      (define-key gtags-select-mode-map [C-S-mouse-2]
1818        'gtags-select-tag-by-event)
1819      (dolist (map (list gtags-mode-map gtags-select-mode-map))
1820        (define-key map [C-S-mouse-3] 'gtags-pop-stack))))
1821
1822 ;; Backup file handling.
1823
1824 (defcustom mdw-backup-disable-regexps nil
1825   "List of regular expressions: if a file name matches any of
1826 these then the file is not backed up."
1827   :type '(repeat regexp))
1828
1829 (defun mdw-backup-enable-predicate (name)
1830   "[mdw]'s default backup predicate.
1831 Allows a backup if the standard predicate would allow it, and it
1832 doesn't match any of the regular expressions in
1833 `mdw-backup-disable-regexps'."
1834   (and (normal-backup-enable-predicate name)
1835        (let ((answer t) (list mdw-backup-disable-regexps))
1836          (save-match-data
1837            (while list
1838              (if (string-match (car list) name)
1839                  (setq answer nil))
1840              (setq list (cdr list)))
1841            answer))))
1842 (setq backup-enable-predicate 'mdw-backup-enable-predicate)
1843
1844 ;; Frame cleanup.
1845
1846 (defun mdw-last-one-out-turn-off-the-lights (frame)
1847   "Disconnect from an X display if this was the last frame on that display."
1848   (let ((frame-display (frame-parameter frame 'display)))
1849     (when (and frame-display
1850                (eq window-system 'x)
1851                (not (cl-some (lambda (fr)
1852                                (and (not (eq fr frame))
1853                                     (string= (frame-parameter fr 'display)
1854                                              frame-display)))
1855                              (frame-list))))
1856       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
1857 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
1858
1859 ;;;--------------------------------------------------------------------------
1860 ;;; Fullscreen-ness.
1861
1862 (defcustom mdw-full-screen-parameters
1863   '((menu-bar-lines . 0)
1864     ;;(vertical-scroll-bars . nil)
1865     )
1866   "Frame parameters to set when making a frame fullscreen."
1867   :type '(alist :key-type symbol))
1868
1869 (defcustom mdw-full-screen-save
1870   '(width height)
1871   "Extra frame parameters to save when setting fullscreen."
1872   :type '(repeat symbol))
1873
1874 (defun mdw-toggle-full-screen (&optional frame)
1875   "Show the FRAME fullscreen."
1876   (interactive)
1877   (when window-system
1878     (cond ((frame-parameter frame 'fullscreen)
1879            (set-frame-parameter frame 'fullscreen nil)
1880            (modify-frame-parameters
1881             nil
1882             (or (frame-parameter frame 'mdw-full-screen-saved)
1883                 (mapcar (lambda (assoc)
1884                           (assq (car assoc) default-frame-alist))
1885                         mdw-full-screen-parameters))))
1886           (t
1887            (let ((saved (mapcar (lambda (param)
1888                                   (cons param (frame-parameter frame param)))
1889                                 (append (mapcar #'car
1890                                                 mdw-full-screen-parameters)
1891                                         mdw-full-screen-save))))
1892              (set-frame-parameter frame 'mdw-full-screen-saved saved))
1893            (modify-frame-parameters frame mdw-full-screen-parameters)
1894            (set-frame-parameter frame 'fullscreen 'fullboth)))))
1895
1896 ;;;--------------------------------------------------------------------------
1897 ;;; General fontification.
1898
1899 (make-face 'mdw-virgin-face)
1900
1901 (defmacro mdw-define-face (name &rest body)
1902   "Define a face, and make sure it's actually set as the definition."
1903   (declare (indent 1)
1904            (debug 0))
1905   `(progn
1906      (copy-face 'mdw-virgin-face ',name)
1907      (defvar ,name ',name)
1908      (put ',name 'face-defface-spec ',body)
1909      (face-spec-set ',name ',body nil)))
1910
1911 (mdw-define-face default
1912   (((type w32)) :family "courier new" :height 85)
1913   (((type x)) :family "6x13" :foundry "trad" :height 130)
1914   (((type color)) :foreground "white" :background "black")
1915   (t nil))
1916 (mdw-define-face fixed-pitch
1917   (((type w32)) :family "courier new" :height 85)
1918   (((type x)) :family "6x13" :foundry "trad" :height 130)
1919   (t :foreground "white" :background "black"))
1920 (mdw-define-face fixed-pitch-serif
1921   (((type w32)) :family "courier new" :height 85 :weight bold)
1922   (((type x)) :family "6x13" :foundry "trad" :height 130 :weight bold)
1923   (t :foreground "white" :background "black" :weight bold))
1924 (mdw-define-face variable-pitch
1925   (((type x)) :family "helvetica" :height 120))
1926 (mdw-define-face region
1927   (((min-colors 64)) :background "grey30")
1928   (((class color)) :background "blue")
1929   (t :inverse-video t))
1930 (mdw-define-face error
1931   (((class color)) :background "red")
1932   (t :inverse-video t))
1933 (mdw-define-face match
1934   (((class color)) :background "blue")
1935   (t :inverse-video t))
1936 (mdw-define-face mc/cursor-face
1937   (((class color)) :background "red")
1938   (t :inverse-video t))
1939 (mdw-define-face minibuffer-prompt
1940   (t :weight bold))
1941 (mdw-define-face mode-line
1942   (((class color)) :foreground "blue" :background "yellow"
1943                    :box (:line-width 1 :style released-button))
1944   (t :inverse-video t))
1945 (mdw-define-face mode-line-inactive
1946   (((class color)) :foreground "yellow" :background "blue"
1947                    :box (:line-width 1 :style released-button))
1948   (t :inverse-video t))
1949 (mdw-define-face nobreak-space
1950   (((type tty)))
1951   (t :inherit escape-glyph :underline t))
1952 (mdw-define-face scroll-bar
1953   (t :foreground "black" :background "lightgrey"))
1954 (mdw-define-face fringe
1955   (t :foreground "yellow"))
1956 (mdw-define-face show-paren-match
1957   (((min-colors 64)) :background "darkgreen")
1958   (((class color)) :background "green")
1959   (t :underline t))
1960 (mdw-define-face show-paren-mismatch
1961   (((class color)) :background "red")
1962   (t :inverse-video t))
1963 (mdw-define-face highlight
1964   (((min-colors 64)) :background "DarkSeaGreen4")
1965   (((class color)) :background "cyan")
1966   (t :inverse-video t))
1967
1968 (mdw-define-face viper-minibuffer-emacs (t nil))
1969 (mdw-define-face viper-minibuffer-insert (t nil))
1970 (mdw-define-face viper-minibuffer-vi (t nil))
1971 (mdw-define-face viper-replace-overlay
1972   (((min-colors 64)) :background "darkred")
1973   (((class color)) :background "red")
1974   (t :inverse-video t))
1975 (mdw-define-face viper-search (t :inherit isearch))
1976
1977 (mdw-define-face compilation-error
1978   (((class color)) :foreground "red" :weight bold)
1979   (t :weight bold))
1980 (mdw-define-face compilation-warning
1981   (((class color)) :foreground "orange" :weight bold)
1982   (t :weight bold))
1983 (mdw-define-face compilation-info
1984   (((class color)) :foreground "green" :weight bold)
1985   (t :weight bold))
1986 (mdw-define-face compilation-line-number
1987   (t :weight bold))
1988 (mdw-define-face compilation-column-number
1989   (((min-colors 64)) :foreground "lightgrey"))
1990 (setq compilation-message-face 'mdw-virgin-face)
1991 (setq compilation-enter-directory-face 'font-lock-comment-face)
1992 (setq compilation-leave-directory-face 'font-lock-comment-face)
1993
1994 (mdw-define-face holiday-face
1995   (t :background "red"))
1996 (mdw-define-face calendar-today-face
1997   (t :foreground "yellow" :weight bold))
1998
1999 (mdw-define-face flyspell-incorrect
2000   (((type x)) :underline (:color "red" :style wave))
2001   (((class color)) :foreground "red" :underline t)
2002   (t :underline t))
2003 (mdw-define-face flyspell-duplicate
2004   (((type x)) :underline (:color "orange" :style wave))
2005   (((class color)) :foreground "orange" :underline t)
2006   (t :underline t))
2007
2008 (mdw-define-face comint-highlight-prompt
2009   (t :weight bold))
2010 (mdw-define-face comint-highlight-input
2011   (t nil))
2012
2013 (mdw-define-face Man-underline
2014   (((type tty)) :underline t)
2015   (t :slant italic))
2016
2017 (mdw-define-face ido-subdir
2018   (t :foreground "cyan" :weight bold))
2019
2020 (mdw-define-face dired-directory
2021   (t :foreground "cyan" :weight bold))
2022 (mdw-define-face dired-symlink
2023   (t :foreground "cyan"))
2024 (mdw-define-face dired-perm-write
2025   (t nil))
2026
2027 (mdw-define-face trailing-whitespace
2028   (((class color)) :background "red")
2029   (t :inverse-video t))
2030 (mdw-define-face whitespace-line
2031   (((class color)) :background "darkred")
2032   (t :inverse-video t))
2033 (mdw-define-face mdw-punct-face
2034   (((min-colors 64)) :foreground "burlywood2")
2035   (((class color)) :foreground "yellow"))
2036 (mdw-define-face mdw-number-face
2037   (t :foreground "yellow"))
2038 (mdw-define-face mdw-trivial-face)
2039 (mdw-define-face font-lock-function-name-face
2040   (t :slant italic))
2041 (mdw-define-face font-lock-keyword-face
2042   (t :weight bold))
2043 (mdw-define-face font-lock-constant-face
2044   (t :slant italic))
2045 (mdw-define-face font-lock-builtin-face
2046   (t :weight bold))
2047 (mdw-define-face font-lock-type-face
2048   (t :weight bold :slant italic))
2049 (mdw-define-face font-lock-reference-face
2050   (t :weight bold))
2051 (mdw-define-face font-lock-variable-name-face
2052   (t :slant italic))
2053 (mdw-define-face font-lock-comment-face
2054   (((min-colors 64)) :slant italic :foreground "SeaGreen1")
2055   (((class color)) :foreground "green")
2056   (t :weight bold))
2057 (mdw-define-face font-lock-comment-delimiter-face
2058   (t :inherit font-lock-comment-face))
2059 (mdw-define-face font-lock-string-face
2060   (((min-colors 64)) :foreground "SkyBlue1")
2061   (((class color)) :foreground "cyan")
2062   (t :weight bold))
2063 (mdw-define-face font-lock-doc-face
2064   (t :inherit font-lock-string-face))
2065
2066 (mdw-define-face message-separator
2067   (t :background "red" :foreground "white" :weight bold))
2068 (mdw-define-face message-cited-text
2069   (default :slant italic)
2070   (((min-colors 64)) :foreground "SkyBlue1")
2071   (((class color)) :foreground "cyan"))
2072 (mdw-define-face message-header-cc
2073   (default :slant italic)
2074   (((min-colors 64)) :foreground "SeaGreen1")
2075   (((class color)) :foreground "green"))
2076 (mdw-define-face message-header-newsgroups
2077   (default :slant italic)
2078   (((min-colors 64)) :foreground "SeaGreen1")
2079   (((class color)) :foreground "green"))
2080 (mdw-define-face message-header-subject
2081   (((min-colors 64)) :foreground "SeaGreen1")
2082   (((class color)) :foreground "green"))
2083 (mdw-define-face message-header-to
2084   (((min-colors 64)) :foreground "SeaGreen1")
2085   (((class color)) :foreground "green"))
2086 (mdw-define-face message-header-xheader
2087   (default :slant italic)
2088   (((min-colors 64)) :foreground "SeaGreen1")
2089   (((class color)) :foreground "green"))
2090 (mdw-define-face message-header-other
2091   (default :slant italic)
2092   (((min-colors 64)) :foreground "SeaGreen1")
2093   (((class color)) :foreground "green"))
2094 (mdw-define-face message-header-name
2095   (default :weight bold)
2096   (((min-colors 64)) :foreground "SeaGreen1")
2097   (((class color)) :foreground "green"))
2098
2099 (mdw-define-face which-func
2100   (t nil))
2101
2102 (mdw-define-face gnus-header-name
2103   (default :weight bold)
2104   (((min-colors 64)) :foreground "SeaGreen1")
2105   (((class color)) :foreground "green"))
2106 (mdw-define-face gnus-header-subject
2107   (((min-colors 64)) :foreground "SeaGreen1")
2108   (((class color)) :foreground "green"))
2109 (mdw-define-face gnus-header-from
2110   (((min-colors 64)) :foreground "SeaGreen1")
2111   (((class color)) :foreground "green"))
2112 (mdw-define-face gnus-header-to
2113   (((min-colors 64)) :foreground "SeaGreen1")
2114   (((class color)) :foreground "green"))
2115 (mdw-define-face gnus-header-content
2116   (default :slant italic)
2117   (((min-colors 64)) :foreground "SeaGreen1")
2118   (((class color)) :foreground "green"))
2119
2120 (mdw-define-face gnus-cite-1
2121   (((min-colors 64)) :foreground "SkyBlue1")
2122   (((class color)) :foreground "cyan"))
2123 (mdw-define-face gnus-cite-2
2124   (((min-colors 64)) :foreground "RoyalBlue2")
2125   (((class color)) :foreground "blue"))
2126 (mdw-define-face gnus-cite-3
2127   (((min-colors 64)) :foreground "MediumOrchid")
2128   (((class color)) :foreground "magenta"))
2129 (mdw-define-face gnus-cite-4
2130   (((min-colors 64)) :foreground "firebrick2")
2131   (((class color)) :foreground "red"))
2132 (mdw-define-face gnus-cite-5
2133   (((min-colors 64)) :foreground "burlywood2")
2134   (((class color)) :foreground "yellow"))
2135 (mdw-define-face gnus-cite-6
2136   (((min-colors 64)) :foreground "SeaGreen1")
2137   (((class color)) :foreground "green"))
2138 (mdw-define-face gnus-cite-7
2139   (((min-colors 64)) :foreground "SlateBlue1")
2140   (((class color)) :foreground "cyan"))
2141 (mdw-define-face gnus-cite-8
2142   (((min-colors 64)) :foreground "RoyalBlue2")
2143   (((class color)) :foreground "blue"))
2144 (mdw-define-face gnus-cite-9
2145   (((min-colors 64)) :foreground "purple2")
2146   (((class color)) :foreground "magenta"))
2147 (mdw-define-face gnus-cite-10
2148   (((min-colors 64)) :foreground "DarkOrange2")
2149   (((class color)) :foreground "red"))
2150 (mdw-define-face gnus-cite-11
2151   (t :foreground "grey"))
2152
2153 (mdw-define-face gnus-emphasis-underline
2154   (((type tty)) :underline t)
2155   (t :slant italic))
2156
2157 (mdw-define-face diff-header
2158   (t nil))
2159 (mdw-define-face diff-index
2160   (t :weight bold))
2161 (mdw-define-face diff-file-header
2162   (t :weight bold))
2163 (mdw-define-face diff-hunk-header
2164   (((min-colors 64)) :foreground "SkyBlue1")
2165   (((class color)) :foreground "cyan"))
2166 (mdw-define-face diff-function
2167   (default :weight bold)
2168   (((min-colors 64)) :foreground "SkyBlue1")
2169   (((class color)) :foreground "cyan"))
2170 (mdw-define-face diff-header
2171   (((min-colors 64)) :background "grey10"))
2172 (mdw-define-face diff-added
2173   (((class color)) :foreground "green"))
2174 (mdw-define-face diff-removed
2175   (((class color)) :foreground "red"))
2176 (mdw-define-face diff-context
2177   (t nil))
2178 (mdw-define-face diff-refine-change
2179   (((min-colors 64)) :background "RoyalBlue4")
2180   (t :underline t))
2181 (mdw-define-face diff-refine-removed
2182   (((min-colors 64)) :background "#500")
2183   (t :underline t))
2184 (mdw-define-face diff-refine-added
2185   (((min-colors 64)) :background "#050")
2186   (t :underline t))
2187
2188 (setq ediff-force-faces t)
2189 (mdw-define-face ediff-current-diff-A
2190   (((min-colors 64)) :background "darkred")
2191   (((class color)) :background "red")
2192   (t :inverse-video t))
2193 (mdw-define-face ediff-fine-diff-A
2194   (((min-colors 64)) :background "red3")
2195   (((class color)) :inverse-video t)
2196   (t :inverse-video nil))
2197 (mdw-define-face ediff-even-diff-A
2198   (((min-colors 64)) :background "#300"))
2199 (mdw-define-face ediff-odd-diff-A
2200   (((min-colors 64)) :background "#300"))
2201 (mdw-define-face ediff-current-diff-B
2202   (((min-colors 64)) :background "darkgreen")
2203   (((class color)) :background "magenta")
2204   (t :inverse-video t))
2205 (mdw-define-face ediff-fine-diff-B
2206   (((min-colors 64)) :background "green4")
2207   (((class color)) :inverse-video t)
2208   (t :inverse-video nil))
2209 (mdw-define-face ediff-even-diff-B
2210   (((min-colors 64)) :background "#020"))
2211 (mdw-define-face ediff-odd-diff-B
2212   (((min-colors 64)) :background "#020"))
2213 (mdw-define-face ediff-current-diff-C
2214   (((min-colors 64)) :background "darkblue")
2215   (((class color)) :background "blue")
2216   (t :inverse-video t))
2217 (mdw-define-face ediff-fine-diff-C
2218   (((min-colors 64)) :background "blue1")
2219   (((class color)) :inverse-video t)
2220   (t :inverse-video nil))
2221 (mdw-define-face ediff-even-diff-C
2222   (((min-colors 64)) :background "#004"))
2223 (mdw-define-face ediff-odd-diff-C
2224   (((min-colors 64)) :background "#004"))
2225 (mdw-define-face ediff-current-diff-Ancestor
2226   (((min-colors 64)) :background "#630")
2227   (((class color)) :background "blue")
2228   (t :inverse-video t))
2229 (mdw-define-face ediff-even-diff-Ancestor
2230   (((min-colors 64)) :background "#320"))
2231 (mdw-define-face ediff-odd-diff-Ancestor
2232   (((min-colors 64)) :background "#320"))
2233
2234 (mdw-define-face magit-hash
2235   (((min-colors 64)) :foreground "grey40")
2236   (((class color)) :foreground "blue"))
2237 (mdw-define-face magit-popup-argument
2238   (((min-colors 64)) :foreground "SeaGreen1")
2239   (((class color)) :foreground "green")
2240   (t :weight bold))
2241 (mdw-define-face magit-diff-hunk-heading
2242   (((min-colors 64)) :foreground "grey70" :background "grey25")
2243   (((class color)) :foreground "yellow"))
2244 (mdw-define-face magit-diff-hunk-heading-highlight
2245   (((min-colors 64)) :foreground "grey70" :background "grey35")
2246   (((class color)) :foreground "yellow" :background "blue"))
2247 (mdw-define-face magit-diff-added
2248   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
2249   (((class color)) :foreground "green"))
2250 (mdw-define-face magit-diff-added-highlight
2251   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
2252   (((class color)) :foreground "green" :background "blue"))
2253 (mdw-define-face magit-diff-removed
2254   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
2255   (((class color)) :foreground "red"))
2256 (mdw-define-face magit-diff-removed-highlight
2257   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
2258   (((class color)) :foreground "red" :background "blue"))
2259 (mdw-define-face magit-blame-heading
2260   (((min-colors 64)) :foreground "white" :background "grey25"
2261                      :weight normal :slant normal)
2262   (((class color)) :foreground "white" :background "blue"
2263                    :weight normal :slant normal))
2264 (mdw-define-face magit-blame-name
2265   (t :inherit magit-blame-heading :slant italic))
2266 (mdw-define-face magit-blame-date
2267   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
2268   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
2269 (mdw-define-face magit-blame-summary
2270   (t :inherit magit-blame-heading :weight bold))
2271
2272 (mdw-define-face dylan-header-background
2273   (((min-colors 64)) :background "NavyBlue")
2274   (((class color)) :background "blue"))
2275
2276 (mdw-define-face erc-my-nick-face
2277   (t :foreground "yellow" :weight bold))
2278 (mdw-define-face erc-current-nick-face
2279   (t :foreground "yellow" :weight bold))
2280 (mdw-define-face erc-input-face
2281   (t :foreground "yellow"))
2282 (mdw-define-face erc-action-face
2283   ())
2284 (mdw-define-face erc-button
2285   (t :foreground "cyan" :underline t :weight semi-bold))
2286
2287 (mdw-define-face woman-bold
2288   (t :weight bold))
2289 (mdw-define-face woman-italic
2290   (t :slant italic))
2291
2292 (eval-after-load "rst"
2293   '(progn
2294      (mdw-define-face rst-level-1-face
2295        (t :foreground "SkyBlue1" :weight bold))
2296      (mdw-define-face rst-level-2-face
2297        (t :foreground "SeaGreen1" :weight bold))
2298      (mdw-define-face rst-level-3-face
2299        (t :weight bold))
2300      (mdw-define-face rst-level-4-face
2301        (t :slant italic))
2302      (mdw-define-face rst-level-5-face
2303        (t :underline t))
2304      (mdw-define-face rst-level-6-face
2305        ())))
2306
2307 (mdw-define-face p4-depot-added-face
2308   (t :foreground "green"))
2309 (mdw-define-face p4-depot-branch-op-face
2310   (t :foreground "yellow"))
2311 (mdw-define-face p4-depot-deleted-face
2312   (t :foreground "red"))
2313 (mdw-define-face p4-depot-unmapped-face
2314   (t :foreground "SkyBlue1"))
2315 (mdw-define-face p4-diff-change-face
2316   (t :foreground "yellow"))
2317 (mdw-define-face p4-diff-del-face
2318   (t :foreground "red"))
2319 (mdw-define-face p4-diff-file-face
2320   (t :foreground "SkyBlue1"))
2321 (mdw-define-face p4-diff-head-face
2322   (t :background "grey10"))
2323 (mdw-define-face p4-diff-ins-face
2324   (t :foreground "green"))
2325
2326 (mdw-define-face w3m-anchor-face
2327   (t :foreground "SkyBlue1" :underline t))
2328 (mdw-define-face w3m-arrived-anchor-face
2329   (t :foreground "SkyBlue1" :underline t))
2330
2331 (mdw-define-face whizzy-slice-face
2332   (t :background "grey10"))
2333 (mdw-define-face whizzy-error-face
2334   (t :background "darkred"))
2335
2336 ;; Ellipses used to indicate hidden text (and similar).
2337 (mdw-define-face mdw-ellipsis-face
2338   (((type tty)) :foreground "blue") (t :foreground "grey60"))
2339 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
2340       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
2341       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
2342       (bar (make-glyph-code ?| mdw-ellipsis-face)))
2343   (set-display-table-slot standard-display-table 0 dollar)
2344   (set-display-table-slot standard-display-table 1 backslash)
2345   (set-display-table-slot standard-display-table 4
2346                           (vector dot dot dot))
2347   (set-display-table-slot standard-display-table 5 bar))
2348
2349 ;;;--------------------------------------------------------------------------
2350 ;;; Where is point?
2351
2352 (mdw-define-face mdw-point-overlay-face
2353   (((type graphic)))
2354   (((min-colors 64)) :background "darkblue")
2355   (((class color)) :background "blue")
2356   (((type tty) (class mono)) :inverse-video t))
2357
2358 (defcustom mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar)
2359   "Bitmaps to display in the left and right fringes in the current line."
2360   :type '(cons symbol symbol))
2361
2362 (defun mdw-configure-point-overlay ()
2363   (let ((ov (make-overlay 0 0)))
2364     (overlay-put ov 'priority 0)
2365     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
2366            (left (car fringe)) (right (cdr fringe))
2367            (s ""))
2368       (when left
2369         (let ((ss "."))
2370           (put-text-property 0 1 'display `(left-fringe ,left) ss)
2371           (setq s (concat s ss))))
2372       (when right
2373         (let ((ss "."))
2374           (put-text-property 0 1 'display `(right-fringe ,right) ss)
2375           (setq s (concat s ss))))
2376       (when (or left right)
2377         (overlay-put ov 'before-string s)))
2378     (overlay-put ov 'face 'mdw-point-overlay-face)
2379     (delete-overlay ov)
2380     ov))
2381
2382 (defvar mdw-point-overlay (mdw-configure-point-overlay)
2383   "An overlay used for showing where point is in the selected window.")
2384 (defun mdw-reconfigure-point-overlay ()
2385   (interactive)
2386   (setq mdw-point-overlay (mdw-configure-point-overlay)))
2387
2388 (defun mdw-remove-point-overlay ()
2389   "Remove the current-point overlay."
2390   (delete-overlay mdw-point-overlay))
2391
2392 (defun mdw-update-point-overlay ()
2393   "Mark the current point position with an overlay."
2394   (if (not mdw-point-overlay-mode)
2395       (mdw-remove-point-overlay)
2396     (overlay-put mdw-point-overlay 'window (selected-window))
2397     (move-overlay mdw-point-overlay
2398                   (line-beginning-position)
2399                   (+ (line-end-position) 1))))
2400
2401 (defvar mdw-point-overlay-buffers nil
2402   "List of buffers using `mdw-point-overlay-mode'.")
2403
2404 (define-minor-mode mdw-point-overlay-mode
2405   "Indicate current line with an overlay."
2406   :global nil
2407   (let ((buffer (current-buffer)))
2408     (setq mdw-point-overlay-buffers
2409             (cl-mapcan (lambda (buf)
2410                          (if (and (buffer-live-p buf)
2411                                   (not (eq buf buffer)))
2412                              (list buf)))
2413                        mdw-point-overlay-buffers))
2414     (if mdw-point-overlay-mode
2415         (setq mdw-point-overlay-buffers
2416                 (cons buffer mdw-point-overlay-buffers))))
2417   (cond (mdw-point-overlay-buffers
2418          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
2419          (add-hook 'post-command-hook 'mdw-update-point-overlay))
2420         (t
2421          (mdw-remove-point-overlay)
2422          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
2423          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
2424
2425 (define-globalized-minor-mode mdw-global-point-overlay-mode
2426   mdw-point-overlay-mode
2427   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
2428
2429 (defvar mdw-terminal-title-alist nil)
2430 (defun mdw-update-terminal-title ()
2431   (when (let ((term (frame-parameter nil 'tty-type)))
2432           (and term (string-match "^xterm" term)))
2433     (let* ((tty (frame-parameter nil 'tty))
2434            (old (assoc tty mdw-terminal-title-alist))
2435            (new (format-mode-line frame-title-format)))
2436       (unless (and old (equal (cdr old) new))
2437         (if old (rplacd old new)
2438           (setq mdw-terminal-title-alist
2439                   (cons (cons tty new) mdw-terminal-title-alist)))
2440         (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
2441
2442 (add-hook 'post-command-hook 'mdw-update-terminal-title)
2443
2444 ;;;--------------------------------------------------------------------------
2445 ;;; Ediff hacking.
2446
2447 (defvar mdw-ediff-previous-windows)
2448 (defun mdw-ediff-setup ()
2449   (setq mdw-ediff-previous-windows (current-window-configuration)))
2450 (defun mdw-ediff-suspend-or-quit ()
2451   (set-window-configuration mdw-ediff-previous-windows))
2452 (add-hook 'ediff-before-setup-hook 'mdw-ediff-setup)
2453 (add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t)
2454 (add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t)
2455
2456 ;;;--------------------------------------------------------------------------
2457 ;;; C programming configuration.
2458
2459 ;; Make C indentation nice.
2460
2461 (defun mdw-c-lineup-arglist (langelem)
2462   "Hack for DWIMmery in c-lineup-arglist."
2463   (if (save-excursion
2464         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
2465       0
2466     (c-lineup-arglist langelem)))
2467
2468 (defun mdw-c-indent-extern-mumble (langelem)
2469   "Indent `extern \"...\" {' lines."
2470   (save-excursion
2471     (back-to-indentation)
2472     (if (looking-at
2473          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
2474         c-basic-offset
2475       nil)))
2476
2477 (defun mdw-c-indent-arglist-nested (langelem)
2478   "Indent continued argument lists.
2479 If we've nested more than one argument list, then only introduce a single
2480 indentation anyway."
2481   (let ((context c-syntactic-context)
2482         (pos (c-langelem-2nd-pos c-syntactic-element))
2483         (should-indent-p t))
2484     (while (and context
2485                 (eq (caar context) 'arglist-cont-nonempty))
2486       (when (and (= (cl-caddr (pop context)) pos)
2487                  context
2488                  (memq (caar context) '(arglist-intro
2489                                         arglist-cont-nonempty)))
2490         (setq should-indent-p nil)))
2491     (if should-indent-p '+ 0)))
2492
2493 (defvar mdw-define-c-styles-hook nil
2494   "Hook run when `cc-mode' starts up to define styles.")
2495
2496 (defun mdw-merge-style-alists (first second)
2497   (let ((output nil))
2498     (dolist (item first)
2499       (let ((key (car item)) (value (cdr item)))
2500         (if (let* ((key-name (symbol-name key))
2501                    (key-len (length key-name)))
2502               (and (>= key-len 6)
2503                    (string= (substring key-name (- key-len 6)) "-alist")))
2504             (push (cons key
2505                         (mdw-merge-style-alists value
2506                                                 (cdr (assoc key second))))
2507                   output)
2508           (push item output))))
2509     (dolist (item second)
2510       (unless (assoc (car item) first)
2511         (push item output)))
2512     (nreverse output)))
2513
2514 (cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
2515   "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
2516 A function, named `mdw-define-c-style/NAME', is defined to actually install
2517 the style using `c-add-style', and added to the hook
2518 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
2519 set."
2520   (declare (indent defun))
2521   (let* ((name-string (symbol-name name))
2522          (var (intern (concat "mdw-c-style/" name-string)))
2523          (func (intern (concat "mdw-define-c-style/" name-string))))
2524     `(progn
2525        (setq ,var
2526                ,(if (null parent)
2527                     `',assocs
2528                   (let ((parent-list (intern (concat "mdw-c-style/"
2529                                                      (symbol-name parent)))))
2530                     `(mdw-merge-style-alists ',assocs ,parent-list))))
2531        (defun ,func () (c-add-style ,name-string ,var))
2532        (and (featurep 'cc-mode) (,func))
2533        (add-hook 'mdw-define-c-styles-hook ',func)
2534        ',name)))
2535
2536 (eval-after-load "cc-mode"
2537   '(run-hooks 'mdw-define-c-styles-hook))
2538
2539 (mdw-define-c-style mdw-c ()
2540   (c-basic-offset . 2)
2541   (comment-column . 40)
2542   (c-class-key . "class")
2543   (c-backslash-column . 72)
2544   (c-label-minimum-indentation . 0)
2545   (c-indent-comments-syntactically-p t)
2546   (c-indent-comment-alist (end-block . (column . nil))
2547                           (cpp-end-block . (column . nil))
2548                           (other . (column . nil)))
2549   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
2550                    (defun-open . (add 0 c-indent-one-line-block))
2551                    (arglist-cont-nonempty . mdw-c-lineup-arglist)
2552                    (topmost-intro . mdw-c-indent-extern-mumble)
2553                    (cpp-define-intro . 0)
2554                    (knr-argdecl . 0)
2555                    (inextern-lang . [0])
2556                    (label . 0)
2557                    (case-label . +)
2558                    (access-label . -)
2559                    (inclass . +)
2560                    (inline-open . ++)
2561                    (statement-cont . +)
2562                    (statement-case-intro . +)))
2563
2564 (mdw-define-c-style mdw-trustonic-c (mdw-c)
2565   (c-basic-offset . 4)
2566   (c-offsets-alist (access-label . -2)))
2567
2568 (mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c)
2569   (comment-column . 0)
2570   (c-indent-comment-alist (anchored-comment . (column . 0))
2571                           (end-block . (space . 1))
2572                           (cpp-end-block . (space . 1))
2573                           (other . (space . 1)))
2574   (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
2575
2576 (defun mdw-set-default-c-style (modes style)
2577   "Update the default CC Mode style for MODES to be STYLE.
2578
2579 MODES may be a list of major mode names or a singleton.  STYLE is a style
2580 name, as a symbol."
2581   (let ((modes (if (listp modes) modes (list modes)))
2582         (style (symbol-name style)))
2583     (setq c-default-style
2584             (append (mapcar (lambda (mode)
2585                               (cons mode style))
2586                             modes)
2587                     (cl-remove-if (lambda (assoc)
2588                                     (memq (car assoc) modes))
2589                                   (if (listp c-default-style)
2590                                       c-default-style
2591                                     (list (cons 'other
2592                                                 c-default-style))))))))
2593 (setq c-default-style "mdw-c")
2594
2595 (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
2596
2597 (defvar mdw-c-comment-fill-prefix
2598   `((,(concat "\\([ \t]*/?\\)"
2599               "\\(\\*\\|//\\)"
2600               "\\([ \t]*\\)"
2601               "\\([A-Za-z]+:[ \t]*\\)?"
2602               mdw-hanging-indents)
2603      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
2604   "Fill prefix matching C comments (both kinds).")
2605
2606 (defun mdw-fontify-c-and-c++ ()
2607
2608   ;; Fiddle with some syntax codes.
2609   (modify-syntax-entry ?* ". 23")
2610   (modify-syntax-entry ?/ ". 124b")
2611   (modify-syntax-entry ?\n "> b")
2612
2613   ;; Other stuff.
2614   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2615
2616   ;; Now define things to be fontified.
2617   (make-local-variable 'font-lock-keywords)
2618   (let ((c-keywords
2619          (mdw-regexps "alignas"          ;C11 macro, C++11
2620                       "alignof"          ;C++11
2621                       "and"              ;C++, C95 macro
2622                       "and_eq"           ;C++, C95 macro
2623                       "asm"              ;K&R, C++, GCC
2624                       "atomic"           ;C11 macro, C++11 template type
2625                       "auto"             ;K&R, C89
2626                       "bitand"           ;C++, C95 macro
2627                       "bitor"            ;C++, C95 macro
2628                       "bool"             ;C++, C99 macro
2629                       "break"            ;K&R, C89
2630                       "case"             ;K&R, C89
2631                       "catch"            ;C++
2632                       "char"             ;K&R, C89
2633                       "char16_t"         ;C++11, C11 library type
2634                       "char32_t"         ;C++11, C11 library type
2635                       "class"            ;C++
2636                       "complex"          ;C99 macro, C++ template type
2637                       "compl"            ;C++, C95 macro
2638                       "const"            ;C89
2639                       "constexpr"        ;C++11
2640                       "const_cast"       ;C++
2641                       "continue"         ;K&R, C89
2642                       "decltype"         ;C++11
2643                       "defined"          ;C89 preprocessor
2644                       "default"          ;K&R, C89
2645                       "delete"           ;C++
2646                       "do"               ;K&R, C89
2647                       "double"           ;K&R, C89
2648                       "dynamic_cast"     ;C++
2649                       "else"             ;K&R, C89
2650                       ;; "entry"         ;K&R -- never used
2651                       "enum"             ;C89
2652                       "explicit"         ;C++
2653                       "export"           ;C++
2654                       "extern"           ;K&R, C89
2655                       "float"            ;K&R, C89
2656                       "for"              ;K&R, C89
2657                       ;; "fortran"       ;K&R
2658                       "friend"           ;C++
2659                       "goto"             ;K&R, C89
2660                       "if"               ;K&R, C89
2661                       "imaginary"        ;C99 macro
2662                       "inline"           ;C++, C99, GCC
2663                       "int"              ;K&R, C89
2664                       "long"             ;K&R, C89
2665                       "mutable"          ;C++
2666                       "namespace"        ;C++
2667                       "new"              ;C++
2668                       "noexcept"         ;C++11
2669                       "noreturn"         ;C11 macro
2670                       "not"              ;C++, C95 macro
2671                       "not_eq"           ;C++, C95 macro
2672                       "nullptr"          ;C++11
2673                       "operator"         ;C++
2674                       "or"               ;C++, C95 macro
2675                       "or_eq"            ;C++, C95 macro
2676                       "private"          ;C++
2677                       "protected"        ;C++
2678                       "public"           ;C++
2679                       "register"         ;K&R, C89
2680                       "reinterpret_cast" ;C++
2681                       "restrict"         ;C99
2682                       "return"           ;K&R, C89
2683                       "short"            ;K&R, C89
2684                       "signed"           ;C89
2685                       "sizeof"           ;K&R, C89
2686                       "static"           ;K&R, C89
2687                       "static_assert"    ;C11 macro, C++11
2688                       "static_cast"      ;C++
2689                       "struct"           ;K&R, C89
2690                       "switch"           ;K&R, C89
2691                       "template"         ;C++
2692                       "throw"            ;C++
2693                       "try"              ;C++
2694                       "thread_local"     ;C11 macro, C++11
2695                       "typedef"          ;C89
2696                       "typeid"           ;C++
2697                       "typeof"           ;GCC
2698                       "typename"         ;C++
2699                       "union"            ;K&R, C89
2700                       "unsigned"         ;K&R, C89
2701                       "using"            ;C++
2702                       "virtual"          ;C++
2703                       "void"             ;C89
2704                       "volatile"         ;C89
2705                       "wchar_t"          ;C++, C89 library type
2706                       "while"            ;K&R, C89
2707                       "xor"              ;C++, C95 macro
2708                       "xor_eq"           ;C++, C95 macro
2709                       "_Alignas"         ;C11
2710                       "_Alignof"         ;C11
2711                       "_Atomic"          ;C11
2712                       "_Bool"            ;C99
2713                       "_Complex"         ;C99
2714                       "_Generic"         ;C11
2715                       "_Imaginary"       ;C99
2716                       "_Noreturn"        ;C11
2717                       "_Pragma"          ;C99 preprocessor
2718                       "_Static_assert"   ;C11
2719                       "_Thread_local"    ;C11
2720                       "__alignof__"      ;GCC
2721                       "__asm__"          ;GCC
2722                       "__attribute__"    ;GCC
2723                       "__complex__"      ;GCC
2724                       "__const__"        ;GCC
2725                       "__extension__"    ;GCC
2726                       "__imag__"         ;GCC
2727                       "__inline__"       ;GCC
2728                       "__label__"        ;GCC
2729                       "__real__"         ;GCC
2730                       "__signed__"       ;GCC
2731                       "__typeof__"       ;GCC
2732                       "__volatile__"     ;GCC
2733                       ))
2734         (c-builtins
2735          (mdw-regexps "false"            ;C++, C99 macro
2736                       "this"             ;C++
2737                       "true"             ;C++, C99 macro
2738                       ))
2739         (preprocessor-keywords
2740          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2741                       "ident" "if" "ifdef" "ifndef" "import" "include"
2742                       "line" "pragma" "unassert" "undef" "warning"))
2743         (objc-keywords
2744          (mdw-regexps "class" "defs" "encode" "end" "implementation"
2745                       "interface" "private" "protected" "protocol" "public"
2746                       "selector")))
2747
2748     (setq font-lock-keywords
2749             (list
2750
2751              ;; Fontify include files as strings.
2752              (list (concat "^[ \t]*\\#[ \t]*"
2753                            "\\(include\\|import\\)"
2754                            "[ \t]*\\(<[^>]+>?\\)")
2755                    '(2 font-lock-string-face))
2756
2757              ;; Preprocessor directives are `references'?.
2758              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2759                            preprocessor-keywords
2760                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
2761                    '(1 font-lock-keyword-face))
2762
2763              ;; Handle the keywords defined above.
2764              (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2765                    '(0 font-lock-keyword-face))
2766
2767              (list (concat "\\<\\(" c-keywords "\\)\\>")
2768                    '(0 font-lock-keyword-face))
2769
2770              (list (concat "\\<\\(" c-builtins "\\)\\>")
2771                    '(0 font-lock-variable-name-face))
2772
2773              ;; Handle numbers too.
2774              ;;
2775              ;; This looks strange, I know.  It corresponds to the
2776              ;; preprocessor's idea of what a number looks like, rather than
2777              ;; anything sensible.
2778              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2779                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2780                    '(0 mdw-number-face))
2781
2782              ;; And anything else is punctuation.
2783              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2784                    '(0 mdw-punct-face))))))
2785
2786 (define-derived-mode sod-mode c-mode "Sod"
2787   "Major mode for editing Sod code.")
2788 (push '("\\.sod$" . sod-mode) auto-mode-alist)
2789
2790 (dolist (hook '(c-mode-hook objc-mode-hook c++-mode-hook))
2791   (add-hook hook 'mdw-misc-mode-config t)
2792   (add-hook hook 'mdw-fontify-c-and-c++ t))
2793
2794 ;;;--------------------------------------------------------------------------
2795 ;;; AP calc mode.
2796
2797 (define-derived-mode apcalc-mode c-mode "AP Calc"
2798   "Major mode for editing Calc code.")
2799
2800 (defun mdw-fontify-apcalc ()
2801
2802   ;; Fiddle with some syntax codes.
2803   (modify-syntax-entry ?* ". 23")
2804   (modify-syntax-entry ?/ ". 14")
2805
2806   ;; Other stuff.
2807   (setq comment-start "/* ")
2808   (setq comment-end " */")
2809   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2810
2811   ;; Now define things to be fontified.
2812   (make-local-variable 'font-lock-keywords)
2813   (let ((c-keywords
2814          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2815                       "do" "else" "exit" "for" "global" "goto" "help" "if"
2816                       "local" "mat" "obj" "print" "quit" "read" "return"
2817                       "show" "static" "switch" "while" "write")))
2818
2819     (setq font-lock-keywords
2820             (list
2821
2822              ;; Handle the keywords defined above.
2823              (list (concat "\\<\\(" c-keywords "\\)\\>")
2824                    '(0 font-lock-keyword-face))
2825
2826              ;; Handle numbers too.
2827              ;;
2828              ;; This looks strange, I know.  It corresponds to the
2829              ;; preprocessor's idea of what a number looks like, rather than
2830              ;; anything sensible.
2831              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2832                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2833                    '(0 mdw-number-face))
2834
2835              ;; And anything else is punctuation.
2836              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2837                    '(0 mdw-punct-face))))))
2838
2839 (progn
2840   (add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
2841   (add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t))
2842
2843 ;;;--------------------------------------------------------------------------
2844 ;;; Java programming configuration.
2845
2846 ;; Make indentation nice.
2847
2848 (mdw-define-c-style mdw-java ()
2849   (c-basic-offset . 2)
2850   (c-backslash-column . 72)
2851   (c-offsets-alist (substatement-open . 0)
2852                    (label . +)
2853                    (case-label . +)
2854                    (access-label . 0)
2855                    (inclass . +)
2856                    (statement-case-intro . +)))
2857 (mdw-set-default-c-style 'java-mode 'mdw-java)
2858
2859 ;; Declare Java fontification style.
2860
2861 (defun mdw-fontify-java ()
2862
2863   ;; Fiddle with some syntax codes.
2864   (modify-syntax-entry ?@ ".")
2865   (modify-syntax-entry ?@ "." font-lock-syntax-table)
2866
2867   ;; Other stuff.
2868   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2869
2870   ;; Now define things to be fontified.
2871   (make-local-variable 'font-lock-keywords)
2872   (let ((java-keywords
2873          (mdw-regexps "abstract" "assert"
2874                       "boolean" "break" "byte"
2875                       "case" "catch" "char" "class" "const" "continue"
2876                       "default" "do" "double"
2877                       "else" "enum" "extends"
2878                       "final" "finally" "float" "for"
2879                       "goto"
2880                       "if" "implements" "import" "instanceof" "int"
2881                       "interface"
2882                       "long"
2883                       "native" "new"
2884                       "package" "private" "protected" "public"
2885                       "return"
2886                       "short" "static" "strictfp" "switch" "synchronized"
2887                       "throw" "throws" "transient" "try"
2888                       "void" "volatile"
2889                       "while"))
2890
2891         (java-builtins
2892          (mdw-regexps "false" "null" "super" "this" "true")))
2893
2894     (setq font-lock-keywords
2895             (list
2896
2897              ;; Handle the keywords defined above.
2898              (list (concat "\\<\\(" java-keywords "\\)\\>")
2899                    '(0 font-lock-keyword-face))
2900
2901              ;; Handle the magic builtins defined above.
2902              (list (concat "\\<\\(" java-builtins "\\)\\>")
2903                    '(0 font-lock-variable-name-face))
2904
2905              ;; Handle numbers too.
2906              ;;
2907              ;; The following isn't quite right, but it's close enough.
2908              (list (concat "\\<\\("
2909                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2910                            "[0-9]+\\(\\.[0-9]*\\)?"
2911                            "\\([eE][-+]?[0-9]+\\)?\\)"
2912                            "[lLfFdD]?")
2913                    '(0 mdw-number-face))
2914
2915              ;; And anything else is punctuation.
2916              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2917                    '(0 mdw-punct-face))))))
2918
2919 (progn
2920   (add-hook 'java-mode-hook 'mdw-misc-mode-config t)
2921   (add-hook 'java-mode-hook 'mdw-fontify-java t))
2922
2923 ;;;--------------------------------------------------------------------------
2924 ;;; Javascript programming configuration.
2925
2926 (defun mdw-javascript-style ()
2927   (setq js-indent-level 2)
2928   (setq js-expr-indent-offset 0))
2929
2930 (defun mdw-fontify-javascript ()
2931
2932   ;; Other stuff.
2933   (mdw-javascript-style)
2934   (setq js-auto-indent-flag t)
2935
2936   ;; Now define things to be fontified.
2937   (make-local-variable 'font-lock-keywords)
2938   (let ((javascript-keywords
2939          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2940                       "char" "class" "const" "continue" "debugger" "default"
2941                       "delete" "do" "double" "else" "enum" "export" "extends"
2942                       "final" "finally" "float" "for" "function" "goto" "if"
2943                       "implements" "import" "in" "instanceof" "int"
2944                       "interface" "let" "long" "native" "new" "package"
2945                       "private" "protected" "public" "return" "short"
2946                       "static" "super" "switch" "synchronized" "throw"
2947                       "throws" "transient" "try" "typeof" "var" "void"
2948                       "volatile" "while" "with" "yield"))
2949         (javascript-builtins
2950          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2951                       "arguments" "this")))
2952
2953     (setq font-lock-keywords
2954             (list
2955
2956              ;; Handle the keywords defined above.
2957              (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2958                    '(0 font-lock-keyword-face))
2959
2960              ;; Handle the predefined builtins defined above.
2961              (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
2962                    '(0 font-lock-variable-name-face))
2963
2964              ;; Handle numbers too.
2965              ;;
2966              ;; The following isn't quite right, but it's close enough.
2967              (list (concat "\\_<\\("
2968                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2969                            "[0-9]+\\(\\.[0-9]*\\)?"
2970                            "\\([eE][-+]?[0-9]+\\)?\\)"
2971                            "[lLfFdD]?")
2972                    '(0 mdw-number-face))
2973
2974              ;; And anything else is punctuation.
2975              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2976                    '(0 mdw-punct-face))))))
2977
2978 (progn
2979   (add-hook 'js-mode-hook 'mdw-misc-mode-config t)
2980   (add-hook 'js-mode-hook 'mdw-fontify-javascript t))
2981
2982 ;;;--------------------------------------------------------------------------
2983 ;;; Scala programming configuration.
2984
2985 (defun mdw-fontify-scala ()
2986
2987   ;; Comment filling.
2988   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2989
2990   ;; Define things to be fontified.
2991   (make-local-variable 'font-lock-keywords)
2992   (let ((scala-keywords
2993          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2994                       "extends" "final" "finally" "for" "forSome" "if"
2995                       "implicit" "import" "lazy" "match" "new" "object"
2996                       "override" "package" "private" "protected" "return"
2997                       "sealed" "throw" "trait" "try" "type" "val"
2998                       "var" "while" "with" "yield"))
2999         (scala-constants
3000          (mdw-regexps "false" "null" "super" "this" "true"))
3001         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
3002
3003     (setq font-lock-keywords
3004             (list
3005
3006              ;; Magical identifiers between backticks.
3007              (list (concat "`\\([^`]+\\)`")
3008                    '(1 font-lock-variable-name-face))
3009
3010              ;; Handle the keywords defined above.
3011              (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
3012                    '(0 font-lock-keyword-face))
3013
3014              ;; Handle the constants defined above.
3015              (list (concat "\\_<\\(" scala-constants "\\)\\_>")
3016                    '(0 font-lock-variable-name-face))
3017
3018              ;; Magical identifiers between backticks.
3019              (list (concat "`\\([^`]+\\)`")
3020                    '(1 font-lock-variable-name-face))
3021
3022              ;; Handle numbers too.
3023              ;;
3024              ;; As usual, not quite right.
3025              (list (concat "\\_<\\("
3026                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3027                            "[0-9]+\\(\\.[0-9]*\\)?"
3028                            "\\([eE][-+]?[0-9]+\\)?\\)"
3029                            "[lLfFdD]?")
3030                    '(0 mdw-number-face))
3031
3032              ;; And everything else is punctuation.
3033              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3034                    '(0 mdw-punct-face)))
3035
3036           font-lock-syntactic-keywords
3037             (list
3038
3039              ;; Single quotes around characters.  But not when used to quote
3040              ;; symbol names.  Ugh.
3041              (list (concat "\\('\\)"
3042                            "\\(" "."
3043                            "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
3044                            "u+" "[0-9a-fA-F]\\{4\\}"
3045                            "\\|" "\\\\" "[0-7]\\{1,3\\}"
3046                            "\\|" "\\\\" "." "\\)"
3047                            "\\('\\)")
3048                    '(1 "\"")
3049                    '(4 "\""))))))
3050
3051 (progn
3052   (add-hook 'scala-mode-hook 'mdw-misc-mode-config t)
3053   (add-hook 'scala-mode-hook 'mdw-fontify-scala t))
3054
3055 ;;;--------------------------------------------------------------------------
3056 ;;; C# programming configuration.
3057
3058 ;; Make indentation nice.
3059
3060 (mdw-define-c-style mdw-csharp ()
3061   (c-basic-offset . 2)
3062   (c-backslash-column . 72)
3063   (c-offsets-alist (substatement-open . 0)
3064                    (label . 0)
3065                    (case-label . +)
3066                    (access-label . 0)
3067                    (inclass . +)
3068                    (statement-case-intro . +)))
3069 (mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
3070
3071 ;; Declare C# fontification style.
3072
3073 (defun mdw-fontify-csharp ()
3074
3075   ;; Other stuff.
3076   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
3077
3078   ;; Now define things to be fontified.
3079   (make-local-variable 'font-lock-keywords)
3080   (let ((csharp-keywords
3081          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
3082                       "char" "checked" "class" "const" "continue" "decimal"
3083                       "default" "delegate" "do" "double" "else" "enum"
3084                       "event" "explicit" "extern" "finally" "fixed" "float"
3085                       "for" "foreach" "goto" "if" "implicit" "in" "int"
3086                       "interface" "internal" "is" "lock" "long" "namespace"
3087                       "new" "object" "operator" "out" "override" "params"
3088                       "private" "protected" "public" "readonly" "ref"
3089                       "return" "sbyte" "sealed" "short" "sizeof"
3090                       "stackalloc" "static" "string" "struct" "switch"
3091                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
3092                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
3093                       "while" "yield"))
3094
3095         (csharp-builtins
3096          (mdw-regexps "base" "false" "null" "this" "true")))
3097
3098     (setq font-lock-keywords
3099             (list
3100
3101              ;; Handle the keywords defined above.
3102              (list (concat "\\<\\(" csharp-keywords "\\)\\>")
3103                    '(0 font-lock-keyword-face))
3104
3105              ;; Handle the magic builtins defined above.
3106              (list (concat "\\<\\(" csharp-builtins "\\)\\>")
3107                    '(0 font-lock-variable-name-face))
3108
3109              ;; Handle numbers too.
3110              ;;
3111              ;; The following isn't quite right, but it's close enough.
3112              (list (concat "\\<\\("
3113                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3114                            "[0-9]+\\(\\.[0-9]*\\)?"
3115                            "\\([eE][-+]?[0-9]+\\)?\\)"
3116                            "[lLfFdD]?")
3117                    '(0 mdw-number-face))
3118
3119              ;; And anything else is punctuation.
3120              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3121                    '(0 mdw-punct-face))))))
3122
3123 (define-derived-mode csharp-mode java-mode "C#"
3124   "Major mode for editing C# code.")
3125
3126 (add-hook 'csharp-mode-hook 'mdw-fontify-csharp t)
3127
3128 ;;;--------------------------------------------------------------------------
3129 ;;; F# programming configuration.
3130
3131 (setq fsharp-indent-offset 2)
3132
3133 (defun mdw-fontify-fsharp ()
3134
3135   (let ((punct "=<>+-*/|&%!@?"))
3136     (cl-do ((i 0 (1+ i)))
3137         ((>= i (length punct)))
3138       (modify-syntax-entry (aref punct i) ".")))
3139
3140   (modify-syntax-entry ?_ "_")
3141   (modify-syntax-entry ?( "(")
3142   (modify-syntax-entry ?) ")")
3143
3144   (setq indent-tabs-mode nil)
3145
3146   (let ((fsharp-keywords
3147          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
3148                       "begin" "break"
3149                       "checked" "class" "component" "const" "constraint"
3150                       "constructor" "continue"
3151                       "default" "delegate" "do" "done" "downcast" "downto"
3152                       "eager" "elif" "else" "end" "exception" "extern"
3153                       "finally" "fixed" "for" "fori" "fun" "function"
3154                       "functor"
3155                       "global"
3156                       "if" "in" "include" "inherit" "inline" "interface"
3157                       "internal"
3158                       "lazy" "let"
3159                       "match" "measure" "member" "method" "mixin" "module"
3160                       "mutable"
3161                       "namespace" "new"
3162                       "object" "of" "open" "or" "override"
3163                       "parallel" "params" "private" "process" "protected"
3164                       "public" "pure"
3165                       "rec" "recursive" "return"
3166                       "sealed" "sig" "static" "struct"
3167                       "tailcall" "then" "to" "trait" "try" "type"
3168                       "upcast" "use"
3169                       "val" "virtual" "void" "volatile"
3170                       "when" "while" "with"
3171                       "yield"))
3172
3173         (fsharp-builtins
3174          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
3175                       "base" "false" "null" "true"))
3176
3177         (bang-keywords
3178          (mdw-regexps "do" "let" "return" "use" "yield"))
3179
3180         (preprocessor-keywords
3181          (mdw-regexps "if" "indent" "else" "endif")))
3182
3183     (setq font-lock-keywords
3184             (list (list (concat "\\(^\\|[^\"]\\)"
3185                                 "\\(" "(\\*"
3186                                       "[^*]*\\*+"
3187                                       "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
3188                                       ")"
3189                                 "\\|"
3190                                       "//.*"
3191                                 "\\)")
3192                         '(2 font-lock-comment-face))
3193
3194                   (list (concat "'" "\\("
3195                                       "\\\\"
3196                                       "\\(" "[ntbr'\\]"
3197                                       "\\|" "[0-9][0-9][0-9]"
3198                                       "\\|" "u" "[0-9a-fA-F]\\{4\\}"
3199                                       "\\|" "U" "[0-9a-fA-F]\\{8\\}"
3200                                       "\\)"
3201                                     "\\|"
3202                                     "." "\\)" "'"
3203                                 "\\|"
3204                                 "\"" "[^\"\\]*"
3205                                       "\\(" "\\\\" "\\(.\\|\n\\)"
3206                                             "[^\"\\]*" "\\)*"
3207                                 "\\(\"\\|\\'\\)")
3208                         '(0 font-lock-string-face))
3209
3210                   (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
3211                                 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
3212                                 "\\|"
3213                                 "\\_<\\(" fsharp-keywords "\\)\\_>")
3214                         '(0 font-lock-keyword-face))
3215                   (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
3216                         '(0 font-lock-variable-name-face))
3217
3218                   (list (concat "\\_<"
3219                                 "\\(" "0[bB][01]+" "\\|"
3220                                       "0[oO][0-7]+" "\\|"
3221                                       "0[xX][0-9a-fA-F]+" "\\)"
3222                                 "\\(" "lf\\|LF" "\\|"
3223                                       "[uU]?[ysnlL]?" "\\)"
3224                                 "\\|"
3225                                 "\\_<"
3226                                 "[0-9]+" "\\("
3227                                   "[mMQRZING]"
3228                                   "\\|"
3229                                   "\\(\\.[0-9]*\\)?"
3230                                   "\\([eE][-+]?[0-9]+\\)?"
3231                                   "[fFmM]?"
3232                                   "\\|"
3233                                   "[uU]?[ysnlL]?"
3234                                 "\\)")
3235                         '(0 mdw-number-face))
3236
3237                   (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3238                         '(0 mdw-punct-face))))))
3239
3240 (defun mdw-fontify-inferior-fsharp ()
3241   (mdw-fontify-fsharp)
3242   (setq font-lock-keywords
3243           (append (list (list "^[#-]" '(0 font-lock-comment-face))
3244                         (list "^>" '(0 font-lock-keyword-face)))
3245                   font-lock-keywords)))
3246
3247 (progn
3248   (add-hook 'fsharp-mode-hook 'mdw-misc-mode-config t)
3249   (add-hook 'fsharp-mode-hook 'mdw-fontify-fsharp t)
3250   (add-hook 'inferior-fsharp-mode-hooks 'mdw-fontify-inferior-fsharp t))
3251
3252 ;;;--------------------------------------------------------------------------
3253 ;;; Go programming configuration.
3254
3255 (defun mdw-fontify-go ()
3256
3257   (make-local-variable 'font-lock-keywords)
3258   (let ((go-keywords
3259          (mdw-regexps "break" "case" "chan" "const" "continue"
3260                       "default" "defer" "else" "fallthrough" "for"
3261                       "func" "go" "goto" "if" "import"
3262                       "interface" "map" "package" "range" "return"
3263                       "select" "struct" "switch" "type" "var"))
3264         (go-intrinsics
3265          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
3266                       "float32" "float64" "int" "uint8" "int16" "int32"
3267                       "int64" "rune" "string" "uint" "uint8" "uint16"
3268                       "uint32" "uint64" "uintptr" "void"
3269                       "false" "iota" "nil" "true"
3270                       "init" "main"
3271                       "append" "cap" "copy" "delete" "imag" "len" "make"
3272                       "new" "panic" "real" "recover")))
3273
3274     (setq font-lock-keywords
3275             (list
3276
3277              ;; Handle the keywords defined above.
3278              (list (concat "\\<\\(" go-keywords "\\)\\>")
3279                    '(0 font-lock-keyword-face))
3280              (list (concat "\\<\\(" go-intrinsics "\\)\\>")
3281                    '(0 font-lock-variable-name-face))
3282
3283              ;; Strings and characters.
3284              (list (concat "'"
3285                            "\\(" "[^\\']" "\\|"
3286                                  "\\\\"
3287                                  "\\(" "[abfnrtv\\'\"]" "\\|"
3288                                        "[0-7]\\{3\\}" "\\|"
3289                                        "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
3290                                        "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
3291                                        "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
3292                            "'"
3293                            "\\|"
3294                            "\""
3295                            "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
3296                            "\\(\"\\|$\\)"
3297                            "\\|"
3298                            "`" "[^`]+" "`")
3299                    '(0 font-lock-string-face))
3300
3301              ;; Handle numbers too.
3302              ;;
3303              ;; The following isn't quite right, but it's close enough.
3304              (list (concat "\\<\\("
3305                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3306                            "[0-9]+\\(\\.[0-9]*\\)?"
3307                            "\\([eE][-+]?[0-9]+\\)?\\)")
3308                    '(0 mdw-number-face))
3309
3310              ;; And anything else is punctuation.
3311              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3312                    '(0 mdw-punct-face))))))
3313 (progn
3314   (add-hook 'go-mode-hook 'mdw-misc-mode-config t)
3315   (add-hook 'go-mode-hook 'mdw-fontify-go t))
3316
3317 ;;;--------------------------------------------------------------------------
3318 ;;; Rust programming configuration.
3319
3320 (setq-default rust-indent-offset 2)
3321
3322 (defun mdw-self-insert-and-indent (count)
3323   (interactive "p")
3324   (self-insert-command count)
3325   (indent-according-to-mode))
3326
3327 (defun mdw-fontify-rust ()
3328
3329   ;; Hack syntax categories.
3330   (modify-syntax-entry ?$ ".")
3331   (modify-syntax-entry ?% ".")
3332   (modify-syntax-entry ?= ".")
3333
3334   ;; Fontify keywords and things.
3335   (make-local-variable 'font-lock-keywords)
3336   (let ((rust-keywords
3337          (mdw-regexps "abstract" "alignof" "as" "async" "await"
3338                       "become" "box" "break"
3339                       "const" "continue" "crate"
3340                       "do" "dyn"
3341                       "else" "enum" "extern"
3342                       "final" "fn" "for"
3343                       "if" "impl" "in"
3344                       "let" "loop"
3345                       "macro" "match" "mod" "move" "mut"
3346                       "offsetof" "override"
3347                       "priv" "proc" "pub" "pure"
3348                       "ref" "return"
3349                       "sizeof" "static" "struct" "super"
3350                       "trait" "try" "type" "typeof"
3351                       "union" "unsafe" "unsized" "use"
3352                       "virtual"
3353                       "where" "while"
3354                       "yield"))
3355         (rust-builtins
3356          (mdw-regexps "array" "pointer" "slice" "tuple"
3357                       "bool" "true" "false"
3358                       "f32" "f64"
3359                       "i8" "i16" "i32" "i64" "isize"
3360                       "u8" "u16" "u32" "u64" "usize"
3361                       "char" "str"
3362                       "self" "Self")))
3363     (setq font-lock-keywords
3364             (list
3365
3366              ;; Handle the keywords defined above.
3367              (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
3368                    '(0 font-lock-keyword-face))
3369              (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
3370                    '(0 font-lock-variable-name-face))
3371
3372              ;; Handle numbers too.
3373              (list (concat "\\_<\\("
3374                                  "[0-9][0-9_]*"
3375                                  "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
3376                                  "\\|" "\\.[0-9_]+"
3377                                  "\\)"
3378                                  "\\(f32\\|f64\\)?"
3379                            "\\|" "\\(" "[0-9][0-9_]*"
3380                                  "\\|" "0x[0-9a-fA-F_]+"
3381                                  "\\|" "0o[0-7_]+"
3382                                  "\\|" "0b[01_]+"
3383                                  "\\)"
3384                                  "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
3385                            "\\)\\_>")
3386                    '(0 mdw-number-face))
3387
3388              ;; And anything else is punctuation.
3389              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3390                    '(0 mdw-punct-face)))
3391             font-lock-syntactic-face-function nil))
3392
3393   ;; Hack key bindings.
3394   (local-set-key [?{] 'mdw-self-insert-and-indent)
3395   (local-set-key [?}] 'mdw-self-insert-and-indent))
3396
3397 (progn
3398   (add-hook 'rust-mode-hook 'mdw-misc-mode-config t)
3399   (add-hook 'rust-mode-hook 'mdw-fontify-rust t))
3400
3401 ;;;--------------------------------------------------------------------------
3402 ;;; Awk programming configuration.
3403
3404 ;; Make Awk indentation nice.
3405
3406 (mdw-define-c-style mdw-awk ()
3407   (c-basic-offset . 2)
3408   (c-offsets-alist (substatement-open . 0)
3409                    (c-backslash-column . 72)
3410                    (statement-cont . 0)
3411                    (statement-case-intro . +)))
3412 (mdw-set-default-c-style 'awk-mode 'mdw-awk)
3413
3414 ;; Declare Awk fontification style.
3415
3416 (defun mdw-fontify-awk ()
3417
3418   ;; Miscellaneous fiddling.
3419   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3420
3421   ;; Now define things to be fontified.
3422   (make-local-variable 'font-lock-keywords)
3423   (let ((c-keywords
3424          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
3425                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
3426                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
3427                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
3428                       "atan2" "break" "close" "continue" "cos" "delete"
3429                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
3430                       "function" "gensub" "getline" "gsub" "if" "in"
3431                       "index" "int" "length" "log" "match" "next" "rand"
3432                       "return" "print" "printf" "sin" "split" "sprintf"
3433                       "sqrt" "srand" "strftime" "sub" "substr" "system"
3434                       "systime" "tolower" "toupper" "while")))
3435
3436     (setq font-lock-keywords
3437             (list
3438
3439              ;; Handle the keywords defined above.
3440              (list (concat "\\<\\(" c-keywords "\\)\\>")
3441                    '(0 font-lock-keyword-face))
3442
3443              ;; Handle numbers too.
3444              ;;
3445              ;; The following isn't quite right, but it's close enough.
3446              (list (concat "\\<\\("
3447                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3448                            "[0-9]+\\(\\.[0-9]*\\)?"
3449                            "\\([eE][-+]?[0-9]+\\)?\\)"
3450                            "[uUlL]*")
3451                    '(0 mdw-number-face))
3452
3453              ;; And anything else is punctuation.
3454              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3455                    '(0 mdw-punct-face))))))
3456
3457 (progn
3458   (add-hook 'awk-mode-hook 'mdw-misc-mode-config t)
3459   (add-hook 'awk-mode-hook 'mdw-fontify-awk t))
3460
3461 ;;;--------------------------------------------------------------------------
3462 ;;; Perl programming style.
3463
3464 ;; Perl indentation style.
3465
3466 (setq-default perl-indent-level 2)
3467
3468 (setq-default cperl-indent-level 2
3469               cperl-continued-statement-offset 2
3470               cperl-indent-region-fix-constructs nil
3471               cperl-continued-brace-offset 0
3472               cperl-brace-offset -2
3473               cperl-brace-imaginary-offset 0
3474               cperl-label-offset 0)
3475
3476 ;; Define perl fontification style.
3477
3478 (defun mdw-fontify-perl ()
3479
3480   ;; Miscellaneous fiddling.
3481   (modify-syntax-entry ?$ "\\")
3482   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
3483   (modify-syntax-entry ?: "." font-lock-syntax-table)
3484   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3485   (setq auto-fill-function #'do-auto-fill)
3486
3487   ;; Now define fontification things.
3488   (make-local-variable 'font-lock-keywords)
3489   (let ((perl-keywords
3490          (mdw-regexps "and"
3491                       "break"
3492                       "cmp" "continue"
3493                       "default" "do"
3494                       "else" "elsif" "eq"
3495                       "for" "foreach"
3496                       "ge" "given" "gt" "goto"
3497                       "if"
3498                       "last" "le" "local" "lt"
3499                       "my"
3500                       "ne" "next"
3501                       "or" "our"
3502                       "package"
3503                       "redo" "require" "return"
3504                       "sub"
3505                       "undef" "unless" "until" "use"
3506                       "when" "while")))
3507
3508     (setq font-lock-keywords
3509             (list
3510
3511              ;; Set up the keywords defined above.
3512              (list (concat "\\<\\(" perl-keywords "\\)\\>")
3513                    '(0 font-lock-keyword-face))
3514
3515              ;; At least numbers are simpler than C.
3516              (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3517                            "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
3518                            "\\([eE][-+]?[0-9_]+\\)?")
3519                    '(0 mdw-number-face))
3520
3521              ;; And anything else is punctuation.
3522              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3523                    '(0 mdw-punct-face))))))
3524
3525 (defun perl-number-tests (&optional arg)
3526   "Assign consecutive numbers to lines containing `#t'.  With ARG,
3527 strip numbers instead."
3528   (interactive "P")
3529   (save-excursion
3530     (goto-char (point-min))
3531     (let ((i 0) (fmt (if arg "" " %4d")))
3532       (while (search-forward "#t" nil t)
3533         (delete-region (point) (line-end-position))
3534         (setq i (1+ i))
3535         (insert (format fmt i)))
3536       (goto-char (point-min))
3537       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
3538           (replace-match (format "\\1%d" i))))))
3539
3540 (dolist (hook '(perl-mode-hook cperl-mode-hook))
3541   (add-hook hook 'mdw-misc-mode-config t)
3542   (add-hook hook 'mdw-fontify-perl t))
3543
3544 ;;;--------------------------------------------------------------------------
3545 ;;; Python programming style.
3546
3547 (setq-default py-indent-offset 2
3548               python-indent 2
3549               python-indent-offset 2
3550               python-fill-docstring-style 'symmetric)
3551
3552 (defun mdw-fontify-pythonic (keywords soft-keywords builtins)
3553
3554   ;; Miscellaneous fiddling.
3555   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3556   (setq indent-tabs-mode nil)
3557   (set (make-local-variable 'forward-sexp-function) nil)
3558
3559   ;; Now define fontification things.
3560   (make-local-variable 'font-lock-keywords)
3561   (setq font-lock-keywords
3562           (list
3563
3564            ;; Set up the keywords defined above.
3565            (list (concat "\\_<\\(" keywords "\\)\\_>")
3566                  '(0 font-lock-keyword-face))
3567            (list (concat "\\(^\\|[^.]\\)\\_<\\(" soft-keywords "\\)\\_>")
3568                  '(2 font-lock-keyword-face))
3569            (list (concat "\\(^\\|[^.]\\)\\_<\\(" builtins "\\)\\_>")
3570                  '(2 font-lock-variable-name-face))
3571            (list (concat "\\_<\\(__\\(\\sw+\\|\\s_+\\)+__\\)\\_>")
3572                  '(0 font-lock-variable-name-face))
3573
3574            ;; At least numbers are simpler than C.
3575            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
3576                          "\\_<[0-9][0-9]*\\(\\.[0-9]*\\)?"
3577                          "\\([eE][-+]?[0-9]+\\|[lL]\\)?")
3578                  '(0 mdw-number-face))
3579
3580            ;; And anything else is punctuation.
3581            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3582                  '(0 mdw-punct-face)))))
3583
3584 ;; Define Python fontification styles.
3585
3586 (defun mdw-fontify-python ()
3587   (mdw-fontify-pythonic
3588    (mdw-regexps "and" "as" "assert" "async" "await"
3589                 "break"
3590                 "class" "continue"
3591                 "def" "del"
3592                 "elif" "else" "except" ;"exec"
3593                 "finally" "for" "from"
3594                 "global"
3595                 "if" "import" "in" "is"
3596                 "lambda"
3597                 "nonlocal"
3598                 "not"
3599                 "or"
3600                 "pass" ;"print"
3601                 "raise" "return"
3602                 "try" ;"type"
3603                 "while" "with"
3604                 "yield")
3605
3606    (mdw-regexps "case"
3607                 "match")
3608
3609    (mdw-regexps "Ellipsis"
3610                 "False"
3611                 "None" "NotImplemented"
3612                 "True"
3613                 "__debug__"
3614
3615                 "BaseException"
3616                   "BaseExceptionGroup"
3617                   "Exception"
3618                     "StandardError"
3619                       "ArithmeticError"
3620                         "FloatingPointError"
3621                         "OverflowError"
3622                         "ZeroDivisionError"
3623                       "AssertionError"
3624                       "AttributeError"
3625                       "BufferError"
3626                       "EnvironmentError"
3627                         "IOError"
3628                         "OSError"
3629                           "BlockingIOError"
3630                           "ChildProcessError"
3631                           "ConnectionError"
3632                             "BrokenPipeError"
3633                             "ConnectionAbortedError"
3634                             "ConnectionRefusedError"
3635                             "ConnectionResetError"
3636                           "FileExistsError"
3637                           "FileNotFoundError"
3638                           "InterruptedError"
3639                           "IsADirectoryError"
3640                           "NotADirectoryError"
3641                           "PermissionError"
3642                           "TimeoutError"
3643                       "EOFError"
3644                       "ExceptionGroup"
3645                       "ImportError"
3646                         "ModuleNotFoundError"
3647                       "LookupError"
3648                         "IndexError"
3649                         "KeyError"
3650                       "MemoryError"
3651                       "NameError"
3652                         "UnboundLocalError"
3653                       "ReferenceError"
3654                       "RuntimeError"
3655                         "NotImplementedError"
3656                         "RecursionError"
3657                       "SyntaxError"
3658                         "IndentationError"
3659                           "TabError"
3660                       "SystemError"
3661                       "TypeError"
3662                       "ValueError"
3663                         "UnicodeError"
3664                           "UnicodeDecodeError"
3665                           "UnicodeEncodeError"
3666                           "UnicodeTranslateError"
3667                     "StopIteration"
3668                     "Warning"
3669                       "BytesWarning"
3670                       "DeprecationWarning"
3671                       "EncodingWarning"
3672                       "FutureWarning"
3673                       "ImportWarning"
3674                       "PendingDeprecationWarning"
3675                       "ResourceWarning"
3676                       "RuntimeWarning"
3677                       "SyntaxWarning"
3678                       "UnicodeWarning"
3679                       "UserWarning"
3680                   "GeneratorExit"
3681                   "KeyboardInterrupt"
3682                   "SystemExit"
3683
3684                 "abs" "absolute_import" "aiter"
3685                   "all" "anext" "any" "apply" "ascii"
3686                 "basestring" "bin" "bool" "breakpoint"
3687                   "buffer" "bytearray" "bytes"
3688                 "callable" "coerce" "chr" "classmethod"
3689                   "cmp" "compile" "complex"
3690                 "delattr" "dict" "dir" "divmod"
3691                 "enumerate" "eval" "exec" "execfile"
3692                 "file" "filter" "float" "format" "frozenset"
3693                 "getattr" "globals"
3694                 "hasattr" "hash" "help" "hex"
3695                 "id" "input" "int" "intern"
3696                   "isinstance" "issubclass" "iter"
3697                 "len" "list" "locals" "long"
3698                 "map" "max" "memoryview" "min"
3699                 "next"
3700                 "object" "oct" "open" "ord"
3701                 "pow" "print" "property"
3702                 "range" "raw_input" "reduce" "reload"
3703                   "repr" "reversed" "round"
3704                 "set" "setattr" "slice" "sorted"
3705                   "staticmethod" "str" "sum" "super"
3706                 "tuple" "type"
3707                 "unichr" "unicode"
3708                 "vars"
3709                 "xrange"
3710                 "zip"
3711                 "__import__")))
3712
3713 (defun mdw-fontify-pyrex ()
3714   (mdw-fontify-pythonic
3715    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
3716                 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
3717                 "extern" "finally" "for" "from" "global" "if"
3718                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
3719                 "property" "raise" "return" "struct" "try" "while" "with"
3720                 "yield")
3721    ""
3722    ""))
3723
3724 (define-derived-mode pyrex-mode python-mode "Pyrex"
3725   "Major mode for editing Pyrex source code")
3726 (setq auto-mode-alist
3727         (append '(("\\.pyx$" . pyrex-mode)
3728                   ("\\.pxd$" . pyrex-mode)
3729                   ("\\.pxi$" . pyrex-mode))
3730                 auto-mode-alist))
3731
3732 (progn
3733   (add-hook 'python-mode-hook 'mdw-misc-mode-config t)
3734   (add-hook 'python-mode-hook 'mdw-fontify-python t)
3735   (add-hook 'pyrex-mode-hook 'mdw-fontify-pyrex t))
3736
3737 ;;;--------------------------------------------------------------------------
3738 ;;; Lua programming style.
3739
3740 (setq-default lua-indent-level 2)
3741
3742 (defun mdw-fontify-lua ()
3743
3744   ;; Miscellaneous fiddling.
3745   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3746
3747   ;; Now define fontification things.
3748   (make-local-variable 'font-lock-keywords)
3749   (let ((lua-keywords
3750          (mdw-regexps "and" "break" "do" "else" "elseif" "end"
3751                       "false" "for" "function" "goto" "if" "in" "local"
3752                       "nil" "not" "or" "repeat" "return" "then" "true"
3753                       "until" "while")))
3754     (setq font-lock-keywords
3755             (list
3756
3757              ;; Set up the keywords defined above.
3758              (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
3759                    '(0 font-lock-keyword-face))
3760
3761              ;; At least numbers are simpler than C.
3762              (list (concat "\\_<\\(" "0[xX]"
3763                                      "\\(" "[0-9a-fA-F]+"
3764                                            "\\(\\.[0-9a-fA-F]*\\)?"
3765                                      "\\|" "\\.[0-9a-fA-F]+"
3766                                      "\\)"
3767                                      "\\([pP][-+]?[0-9]+\\)?"
3768                                "\\|" "\\(" "[0-9]+"
3769                                            "\\(\\.[0-9]*\\)?"
3770                                      "\\|" "\\.[0-9]+"
3771                                      "\\)"
3772                                      "\\([eE][-+]?[0-9]+\\)?"
3773                                "\\)")
3774                    '(0 mdw-number-face))
3775
3776              ;; And anything else is punctuation.
3777              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3778                    '(0 mdw-punct-face))))))
3779
3780 (progn
3781   (add-hook 'lua-mode-hook 'mdw-misc-mode-config t)
3782   (add-hook 'lua-mode-hook 'mdw-fontify-lua t))
3783
3784 ;;;--------------------------------------------------------------------------
3785 ;;; Icon programming style.
3786
3787 ;; Icon indentation style.
3788
3789 (setq-default icon-brace-offset 0
3790               icon-continued-brace-offset 0
3791               icon-continued-statement-offset 2
3792               icon-indent-level 2)
3793
3794 ;; Define Icon fontification style.
3795
3796 (defun mdw-fontify-icon ()
3797
3798   ;; Miscellaneous fiddling.
3799   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3800
3801   ;; Now define fontification things.
3802   (make-local-variable 'font-lock-keywords)
3803   (let ((icon-keywords
3804          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
3805                       "end" "every" "fail" "global" "if" "initial"
3806                       "invocable" "link" "local" "next" "not" "of"
3807                       "procedure" "record" "repeat" "return" "static"
3808                       "suspend" "then" "to" "until" "while"))
3809         (preprocessor-keywords
3810          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
3811                       "include" "line" "undef")))
3812     (setq font-lock-keywords
3813             (list
3814
3815              ;; Set up the keywords defined above.
3816              (list (concat "\\<\\(" icon-keywords "\\)\\>")
3817                    '(0 font-lock-keyword-face))
3818
3819              ;; The things that Icon calls keywords.
3820              (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
3821
3822              ;; At least numbers are simpler than C.
3823              (list (concat "\\<[0-9]+"
3824                            "\\([rR][0-9a-zA-Z]+\\|"
3825                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
3826                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
3827                    '(0 mdw-number-face))
3828
3829              ;; Preprocessor.
3830              (list (concat "^[ \t]*$[ \t]*\\<\\("
3831                            preprocessor-keywords
3832                            "\\)\\>")
3833                    '(0 font-lock-keyword-face))
3834
3835              ;; And anything else is punctuation.
3836              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3837                    '(0 mdw-punct-face))))))
3838
3839 (progn
3840   (add-hook 'icon-mode-hook 'mdw-misc-mode-config t)
3841   (add-hook 'icon-mode-hook 'mdw-fontify-icon t))
3842
3843 ;;;--------------------------------------------------------------------------
3844 ;;; Fortran mode.
3845
3846 (defun mdw-fontify-fortran-common ()
3847   (let ((fortran-keywords
3848          (mdw-regexps "access"
3849                       "assign"
3850                       "associate"
3851                       "backspace"
3852                       "blank"
3853                       "block\\s-*data"
3854                       "call"
3855                       "case"
3856                       "character"
3857                       "class"
3858                       "close"
3859                       "common"
3860                       "complex"
3861                       "continue"
3862                       "critical"
3863                       "data"
3864                       "dimension"
3865                       "do"
3866                       "double\\s-*precision"
3867                       "else" "elseif" "elsewhere"
3868                       "end"
3869                         "endblock" "endblockdata"
3870                         "endcritical"
3871                         "enddo"
3872                         "endinterface"
3873                         "endmodule"
3874                         "endprocedure"
3875                         "endprogram"
3876                         "endselect"
3877                         "endsubmodule"
3878                         "endsubroutine"
3879                         "endtype"
3880                         "endwhere"
3881                         "endenum"
3882                         "end\\s-*file"
3883                         "endforall"
3884                         "endfunction"
3885                         "endif"
3886                       "entry"
3887                       "enum"
3888                       "equivalence"
3889                       "err"
3890                       "external"
3891                       "file"
3892                       "fmt"
3893                       "forall"
3894                       "form"
3895                       "format"
3896                       "function"
3897                       "go\\s-*to"
3898                       "if"
3899                       "implicit"
3900                       "in" "inout"
3901                       "inquire"
3902                       "include"
3903                       "integer"
3904                       "interface"
3905                       "intrinsic"
3906                       "iostat"
3907                       "len"
3908                       "logical"
3909                       "module"
3910                       "open"
3911                       "out"
3912                       "parameter"
3913                       "pause"
3914                       "procedure"
3915                       "program"
3916                       "precision"
3917                       "program"
3918                       "read"
3919                       "real"
3920                       "rec"
3921                       "recl"
3922                       "return"
3923                       "rewind"
3924                       "save"
3925                       "select" "selectcase" "selecttype"
3926                       "status"
3927                       "stop"
3928                       "submodule"
3929                       "subroutine"
3930                       "then"
3931                       "to"
3932                       "type"
3933                       "unit"
3934                       "where"
3935                       "write"))
3936         (fortran-operators (mdw-regexps "and"
3937                                         "eq"
3938                                         "eqv"
3939                                         "false"
3940                                         "ge"
3941                                         "gt"
3942                                         "le"
3943                                         "lt"
3944                                         "ne"
3945                                         "neqv"
3946                                         "not"
3947                                         "or"
3948                                         "true"))
3949         (fortran-intrinsics (mdw-regexps "abs" "dabs" "iabs" "cabs"
3950                                          "atan" "datan" "atan2" "datan2"
3951                                          "cmplx"
3952                                          "conjg"
3953                                          "cos" "dcos" "ccos"
3954                                          "dble"
3955                                          "dim" "idim"
3956                                          "exp" "dexp" "cexp"
3957                                          "float"
3958                                          "ifix"
3959                                          "aimag"
3960                                          "int" "aint" "idint"
3961                                          "alog" "dlog" "clog"
3962                                          "alog10" "dlog10"
3963                                          "max"
3964                                          "amax0" "amax1"
3965                                          "max0" "max1"
3966                                          "dmax1"
3967                                          "min"
3968                                          "amin0" "amin1"
3969                                          "min0" "min1"
3970                                          "dmin1"
3971                                          "mod" "amod" "dmod"
3972                                          "sin" "dsin" "csin"
3973                                          "sign" "isign" "dsign"
3974                                          "sngl"
3975                                          "sqrt" "dsqrt" "csqrt"
3976                                          "tanh"))
3977         (preprocessor-keywords
3978          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3979                       "ident" "if" "ifdef" "ifndef" "import" "include"
3980                       "line" "pragma" "unassert" "undef" "warning")))
3981     (setq font-lock-keywords-case-fold-search t
3982             font-lock-keywords
3983             (list
3984
3985              ;; Fontify include files as strings.
3986              (list (concat "^[ \t]*\\#[ \t]*" "include"
3987                            "[ \t]*\\(<[^>]+>?\\)")
3988                    '(1 font-lock-string-face))
3989
3990              ;; Preprocessor directives are `references'?.
3991              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3992                            preprocessor-keywords
3993                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
3994                    '(1 font-lock-keyword-face))
3995
3996              ;; Set up the keywords defined above.
3997              (list (concat "\\<\\(" fortran-keywords "\\)\\>")
3998                    '(0 font-lock-keyword-face))
3999
4000              ;; Set up the `.foo.' operators.
4001              (list (concat "\\.\\(" fortran-operators "\\)\\.")
4002                    '(0 font-lock-keyword-face))
4003
4004              ;; Set up the intrinsic functions.
4005              (list (concat "\\<\\(" fortran-intrinsics "\\)\\>")
4006                    '(0 font-lock-variable-name-face))
4007
4008              ;; Numbers.
4009              (list (concat       "\\(" "\\<" "[0-9]+" "\\(\\.[0-9]*\\)?"
4010                                  "\\|" "\\.[0-9]+"
4011                                  "\\)"
4012                                  "\\(" "[de]" "[+-]?" "[0-9]+" "\\)?"
4013                                  "\\(" "_" "\\sw+" "\\)?"
4014                            "\\|" "b'[01]*'" "\\|" "'[01]*'b"
4015                            "\\|" "b\"[01]*\"" "\\|" "\"[01]*\"b"
4016                            "\\|" "o'[0-7]*'" "\\|" "'[0-7]*'o"
4017                            "\\|" "o\"[0-7]*\"" "\\|" "\"[0-7]*\"o"
4018                            "\\|" "[xz]'[0-9a-f]*'" "\\|" "'[0-9a-f]*'[xz]"
4019                            "\\|" "[xz]\"[0-9a-f]*\"" "\\|" "\"[0-9a-f]*\"[xz]")
4020                    '(0 mdw-number-face))
4021
4022              ;; Any anything else is punctuation.
4023              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4024                    '(0 mdw-punct-face))))
4025
4026     (modify-syntax-entry ?/ "." font-lock-syntax-table)
4027     (modify-syntax-entry ?< ".")
4028     (modify-syntax-entry ?> ".")))
4029
4030 (defun mdw-fontify-fortran () (mdw-fontify-fortran-common))
4031 (defun mdw-fontify-f90 () (mdw-fontify-fortran-common))
4032
4033 (setq fortran-do-indent 2
4034       fortran-if-indent 2
4035       fortran-structure-indent 2
4036       fortran-comment-line-start "*"
4037       fortran-comment-indent-style 'relative
4038       fortran-continuation-string "&"
4039       fortran-continuation-indent 4)
4040
4041 (setq f90-do-indent 2
4042       f90-if-indent 2
4043       f90-program-indent 2
4044       f90-continuation-indent 4
4045       f90-smart-end-names nil
4046       f90-smart-end 'no-blink)
4047
4048 (progn
4049   (add-hook 'fortran-mode-hook 'mdw-misc-mode-config t)
4050   (add-hook 'fortran-mode-hook 'mdw-fontify-fortran t)
4051   (add-hook 'f90-mode-hook 'mdw-misc-mode-config t)
4052   (add-hook 'f90-mode-hook 'mdw-fontify-f90 t))
4053
4054 ;;;--------------------------------------------------------------------------
4055 ;;; Ada programming configuration.
4056
4057 (setq ada-auto-case nil
4058       ada-broken-indent 2
4059       ada-broken-decl-indent 2
4060       ada-indent 2
4061       ada-indent-handle-comment-special t
4062       ada-indent-record-rel-type 2
4063       ada-indent-return 2
4064       ada-fill-comment-prefix "-- "
4065       ada-fill-comment-postfix ""
4066       ada-label-indent -2
4067       ada-language-version 'ada2005
4068       ada-when-indent 2)
4069
4070 (defun mdw-fontify-ada ()
4071
4072   ;; Set the fill prefix.
4073   (mdw-standard-fill-prefix "\\([ \t]*--+[ \t]*\\)")
4074   (setq fill-paragraph-function nil)
4075
4076   ;; Fontify keywords and things.
4077   (make-local-variable 'font-lock-keywords)
4078   (let ((ada-keywords
4079          (mdw-regexps "abort" "abs" "abstract" "accept" "access" "aliased"
4080                         "all" "and" "array" "at"
4081                       "begin" "body"
4082                       "case" "constant"
4083                       "declare" "delay" "delta" "digits" "do"
4084                       "else" "elsif" "end" "entry" "exception" "exit"
4085                       "for" "function"
4086                       "generic" "goto"
4087                       "if" "in" "interface" "is"
4088                       "limited" "loop"
4089                       "mod"
4090                       "new" "not" "null"
4091                       "of" "or" "others" "out" "overriding"
4092                       "package" "parallel" "pragma" "private" "procedure"
4093                         "protected"
4094                       "raise" "range" "record" "rem" "renames" "requeue"
4095                         "return" "reverse"
4096                       "select" "separate" "some" "subtype" "synchronized"
4097                       "tagged" "task" "terminate" "then" "type"
4098                       "until" "use"
4099                       "when" "while" "with"
4100                       "xor")))
4101     (setq font-lock-keywords
4102             (list
4103
4104              ;; Handle the keywords defined above.
4105              (list (concat "\\_<\\(" ada-keywords "\\)\\_>")
4106                    '(0 font-lock-keyword-face))
4107
4108              ;; Handle numbers too.
4109              (list (concat "\\_<"
4110                            "[0-9]+\\(_[0-9]+\\)*"
4111                            "\\(" "#"
4112                                  "[0-9a-f]+\\(_[0-9a-f]+\\)*"
4113                                  "\\(" "\\."
4114                                        "[0-9a-f]+\\(_[0-9a-f]+\\)*" "\\)?"
4115                                  "#"
4116                                  "\\(" "e" "[-+]?"
4117                                        "[0-9]+\\(_[0-9]+\\)*" "\\_>" "\\)?"
4118                            "\\|" "\\(" "\\." "[0-9]+\\(_[0-9]+\\)*" "\\)?"
4119                                  "\\(" "e" "[-+]?"
4120                                        "[0-9]+\\(_[0-9]+\\)*" "\\)?"
4121                                  "\\_>"
4122                            "\\)")
4123                    '(0 mdw-number-face))
4124
4125              ;; And anything else is punctuation.
4126              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4127                    '(0 mdw-punct-face)))
4128             ;font-lock-syntactic-face-function nil
4129                                                  )))
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 ;;; Other languages.
5385
5386 ;; Smalltalk.
5387
5388 (defun mdw-setup-smalltalk ()
5389   (and mdw-auto-indent
5390        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
5391   (make-local-variable 'mdw-auto-indent)
5392   (setq mdw-auto-indent nil)
5393   (local-set-key "\C-i" 'smalltalk-reindent))
5394
5395 (defun mdw-fontify-smalltalk ()
5396   (make-local-variable 'font-lock-keywords)
5397   (setq font-lock-keywords
5398           (list
5399            (list "\\<[A-Z][a-zA-Z0-9]*\\>"
5400                  '(0 font-lock-keyword-face))
5401            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
5402                          "[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
5403                          "\\([eE][-+]?[0-9_]+\\)?")
5404                  '(0 mdw-number-face))
5405            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5406                  '(0 mdw-punct-face)))))
5407
5408 (progn
5409   (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
5410   (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
5411
5412 ;; m4.
5413
5414 (defun mdw-setup-m4 ()
5415
5416   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
5417   ;; annoying: fix it.
5418   (modify-syntax-entry ?{ "(")
5419   (modify-syntax-entry ?} ")")
5420
5421   ;; Fill prefix.
5422   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
5423
5424 (dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
5425   (add-hook hook #'mdw-misc-mode-config t)
5426   (add-hook hook #'mdw-setup-m4 t))
5427
5428 ;; Make.
5429
5430 (progn
5431   (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
5432
5433 ;; nroff/troff.
5434
5435 (progn
5436   (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t))
5437
5438 ;;;--------------------------------------------------------------------------
5439 ;;; Text mode.
5440
5441 (defun mdw-text-mode ()
5442   (setq fill-column 72)
5443   (flyspell-mode t)
5444   (mdw-standard-fill-prefix
5445    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
5446   (auto-fill-mode 1))
5447
5448 (eval-after-load "flyspell"
5449   '(define-key flyspell-mode-map "\C-\M-i" nil))
5450
5451 (progn
5452   (add-hook 'text-mode-hook 'mdw-text-mode t))
5453
5454 ;;;--------------------------------------------------------------------------
5455 ;;; Outline and hide/show modes.
5456
5457 (defun mdw-outline-collapse-all ()
5458   "Completely collapse everything in the entire buffer."
5459   (interactive)
5460   (save-excursion
5461     (goto-char (point-min))
5462     (while (< (point) (point-max))
5463       (hide-subtree)
5464       (forward-line))))
5465
5466 (setq hs-hide-comments-when-hiding-all nil)
5467
5468 (defadvice hs-hide-all (after hide-first-comment activate)
5469   (save-excursion (hs-hide-initial-comment-block)))
5470
5471 ;;;--------------------------------------------------------------------------
5472 ;;; Shell mode.
5473
5474 (defun mdw-sh-mode-setup ()
5475   (local-set-key [?\C-a] 'comint-bol)
5476   (add-hook 'comint-output-filter-functions
5477             'comint-watch-for-password-prompt))
5478
5479 (defun mdw-term-mode-setup ()
5480   (setq term-prompt-regexp shell-prompt-pattern)
5481   (make-local-variable 'mouse-yank-at-point)
5482   (make-local-variable 'transient-mark-mode)
5483   (setq mouse-yank-at-point t)
5484   (auto-fill-mode -1)
5485   (setq tab-width 8))
5486
5487 (defun comint-send-and-indent ()
5488   (interactive)
5489   (comint-send-input)
5490   (and mdw-auto-indent
5491        (indent-for-tab-command)))
5492
5493 (defadvice comint-line-beginning-position
5494     (around mdw-calculate-it-properly () activate compile)
5495   "Calculate the actual line start for multi-line input."
5496   (if (or comint-use-prompt-regexp
5497           (eq (field-at-pos (point)) 'output))
5498       ad-do-it
5499     (setq ad-return-value
5500             (constrain-to-field (line-beginning-position) (point)))))
5501
5502 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
5503 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
5504 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
5505 (defun term-send-meta-meta-something ()
5506   (interactive)
5507   (term-send-raw-string "\e\e")
5508   (term-send-raw))
5509 (eval-after-load 'term
5510   '(progn
5511      (define-key term-raw-map [?\e ?\e] nil)
5512      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
5513      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
5514      (define-key term-raw-map [M-right] 'term-send-meta-right)
5515      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
5516      (define-key term-raw-map [M-left] 'term-send-meta-left)
5517      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
5518
5519 (defadvice term-exec (before program-args-list compile activate)
5520   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
5521 This allows you to pass a list of arguments through `ansi-term'."
5522   (let ((program (ad-get-arg 2)))
5523     (if (listp program)
5524         (progn
5525           (ad-set-arg 2 (car program))
5526           (ad-set-arg 4 (cdr program))))))
5527
5528 (defadvice term-exec-1 (around hack-environment compile activate)
5529   "Hack the environment inherited by inferiors in the terminal."
5530   (let ((process-environment (copy-tree process-environment)))
5531     (setenv "LD_PRELOAD" nil)
5532     ad-do-it))
5533
5534 (defadvice shell (around hack-environment compile activate)
5535   "Hack the environment inherited by inferiors in the shell."
5536   (let ((process-environment (copy-tree process-environment)))
5537     (setenv "LD_PRELOAD" nil)
5538     ad-do-it))
5539
5540 (defun ssh (host)
5541   "Open a terminal containing an ssh session to the HOST."
5542   (interactive "sHost: ")
5543   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
5544
5545 (defcustom git-grep-command
5546   "env GIT_PAGER=cat git grep --no-color -nH -e "
5547   "The default command for \\[git-grep]."
5548   :type 'string)
5549
5550 (defvar git-grep-history nil)
5551
5552 (defun git-grep (command-args)
5553   "Run `git grep' with user-specified args and collect output in a buffer."
5554   (interactive
5555    (list (read-shell-command "Run git grep (like this): "
5556                              git-grep-command 'git-grep-history)))
5557   (let ((grep-use-null-device nil))
5558     (grep command-args)))
5559
5560 ;;;--------------------------------------------------------------------------
5561 ;;; Magit configuration.
5562
5563 (setq magit-diff-refine-hunk 't
5564       magit-view-git-manual-method 'man
5565       magit-log-margin '(nil age magit-log-margin-width t 18)
5566       magit-wip-after-save-local-mode-lighter ""
5567       magit-wip-after-apply-mode-lighter ""
5568       magit-wip-before-change-mode-lighter "")
5569 (eval-after-load "magit"
5570   '(progn (global-magit-file-mode 1)
5571           (magit-wip-after-save-mode 1)
5572           (magit-wip-after-apply-mode 1)
5573           (magit-wip-before-change-mode 1)
5574           (add-to-list 'magit-no-confirm 'safe-with-wip)
5575           (add-to-list 'magit-no-confirm 'trash)
5576           (push '(:eval (if (or magit-wip-after-save-local-mode
5577                                 magit-wip-after-apply-mode
5578                                 magit-wip-before-change-mode)
5579                             (format " wip:%s%s%s"
5580                                     (if magit-wip-after-apply-mode "A" "")
5581                                     (if magit-wip-before-change-mode "C" "")
5582                                     (if magit-wip-after-save-local-mode "S" ""))))
5583                 minor-mode-alist)
5584           (dolist (popup '(magit-diff-popup
5585                            magit-diff-refresh-popup
5586                            magit-diff-mode-refresh-popup
5587                            magit-revision-mode-refresh-popup))
5588             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))
5589           (magit-define-popup-switch 'magit-rebase-popup ?r
5590                                      "Rebase merges" "--rebase-merges")))
5591
5592 (defadvice magit-wip-commit-buffer-file
5593     (around mdw-just-this-buffer activate compile)
5594   (let ((magit-save-repository-buffers nil)) ad-do-it))
5595
5596 (defadvice magit-discard
5597     (around mdw-delete-if-prefix-argument activate compile)
5598   (let ((magit-delete-by-moving-to-trash
5599          (and (null current-prefix-arg)
5600               magit-delete-by-moving-to-trash)))
5601     ad-do-it))
5602
5603 (setq magit-repolist-columns
5604         '(("Name" 16 magit-repolist-column-ident nil)
5605           ("Version" 18 magit-repolist-column-version nil)
5606           ("St" 2 magit-repolist-column-dirty nil)
5607           ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
5608           ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
5609           ("Path" 32 magit-repolist-column-path nil)))
5610
5611 (setq magit-repository-directories '(("~/etc/profile" . 0)
5612                                      ("~/src/" . 1)))
5613
5614 (defadvice magit-list-repos (around mdw-dirname () activate compile)
5615   "Make sure the returned names are directory names.
5616 Otherwise child processes get started in the wrong directory and
5617 there is sadness."
5618   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
5619
5620 (defun mdw-repolist-column-unpulled-from-upstream (_id)
5621   "Insert number of upstream commits not in the current branch."
5622   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5623     (and upstream
5624          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
5625            (propertize (number-to-string n) 'face
5626                        (if (> n 0) 'bold 'shadow))))))
5627
5628 (defun mdw-repolist-column-unpushed-to-upstream (_id)
5629   "Insert number of commits in the current branch but not its upstream."
5630   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5631     (and upstream
5632          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
5633            (propertize (number-to-string n) 'face
5634                        (if (> n 0) 'bold 'shadow))))))
5635
5636 (defun mdw-try-smerge ()
5637   (save-excursion
5638     (goto-char (point-min))
5639     (when (re-search-forward "^<<<<<<< " nil t)
5640       (smerge-mode 1))))
5641 (add-hook 'find-file-hook 'mdw-try-smerge t)
5642
5643 (defcustom mdw-magit-new-window-modes
5644   '(magit-diff-mode
5645     magit-log-mode
5646     magit-process-mode
5647     magit-revision-mode
5648     magit-stash-mode
5649     magit-status-mode)
5650   "Magit modes which should cause a new window to be used."
5651   :type '(repeat symbol))
5652
5653 (defun mdw-display-magit-buffer (buffer)
5654   "Like `magit-display-buffer-traditional'.
5655 But uses `mdw-magit-new-window-modes' for its list of modes
5656 rather than baking the list into the function."
5657   (display-buffer buffer
5658                   (let ((mode (with-current-buffer buffer major-mode)))
5659                     (if (and (not mdw-designated-window)
5660                              (derived-mode-p 'magit-mode)
5661                              (mdw-submode-p mode 'magit-mode)
5662                              (not (memq mode mdw-magit-new-window-modes)))
5663                         '(display-buffer-same-window . nil)
5664                       nil))))
5665 (setq magit-display-buffer-function 'mdw-display-magit-buffer)
5666
5667 (defun mdw-display-magit-file-buffer (buffer)
5668   "Show a file buffer from a diff."
5669   (select-window (display-buffer buffer)))
5670 (setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer)
5671
5672 ;;;--------------------------------------------------------------------------
5673 ;;; GUD, and especially GDB.
5674
5675 ;; Inhibit window dedication.  I mean, seriously, wtf?
5676 (defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
5677   "Don't make windows dedicated.  Seriously."
5678   (set-window-dedicated-p ad-return-value nil))
5679 (defadvice gdb-set-window-buffer
5680     (after mdw-undedicated (name &optional ignore-dedicated window)
5681      compile activate)
5682   "Don't make windows dedicated.  Seriously."
5683   (set-window-dedicated-p (or window (selected-window)) nil))
5684
5685 (defadvice gud-find-expr
5686     (around mdw-inhibit-read-only (&rest args) compile activate)
5687   "Inhibit errors caused by my setting of `comint-prompt-read-only'."
5688   (let ((inhibit-read-only t)) ad-do-it))
5689
5690 ;;;--------------------------------------------------------------------------
5691 ;;; SQL stuff.
5692
5693 (setq sql-postgres-options '("-n" "-P" "pager=off")
5694       sql-postgres-login-params
5695         '((user :default "mdw")
5696           (database :default "mdw")
5697           (server :default "db.distorted.org.uk")))
5698
5699 ;;;--------------------------------------------------------------------------
5700 ;;; Man pages.
5701
5702 ;; Turn off `noip' when running `man': it interferes with `man-db''s own
5703 ;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
5704 ;; better.
5705 (defadvice Man-getpage-in-background
5706     (around mdw-inhibit-noip (topic) compile activate)
5707   "Inhibit the `noip' preload hack when invoking `man'."
5708   (let* ((old-preload (getenv "LD_PRELOAD"))
5709          (preloads (and old-preload
5710                         (save-match-data (split-string old-preload ":"))))
5711          (any nil)
5712          (filtered nil))
5713     (save-match-data
5714       (while preloads
5715         (let ((item (pop preloads)))
5716           (if (string-match  "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item)
5717               (setq any t)
5718             (push item filtered)))))
5719     (if any
5720         (unwind-protect
5721             (progn
5722               (setenv "LD_PRELOAD"
5723                       (and filtered
5724                            (with-output-to-string
5725                              (setq filtered (nreverse filtered))
5726                              (let ((first t))
5727                                (while filtered
5728                                  (if first (setq first nil)
5729                                    (write-char ?:))
5730                                  (write-string (pop filtered)))))))
5731               ad-do-it)
5732           (setenv "LD_PRELOAD" old-preload))
5733       ad-do-it)))
5734
5735 ;;;--------------------------------------------------------------------------
5736 ;;; MPC configuration.
5737
5738 (eval-when-compile (trap (require 'mpc)))
5739
5740 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
5741
5742 (defun mdw-mpc-now-playing ()
5743   (interactive)
5744   (require 'mpc)
5745   (save-excursion
5746     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
5747     (mpc--status-callback))
5748   (let ((state (cdr (assq 'state mpc-status))))
5749     (cond ((member state '("stop"))
5750            (message "mpd stopped."))
5751           ((member state '("play" "pause"))
5752            (let* ((artist (cdr (assq 'Artist mpc-status)))
5753                   (album (cdr (assq 'Album mpc-status)))
5754                   (title (cdr (assq 'Title mpc-status)))
5755                   (file (cdr (assq 'file mpc-status)))
5756                   (duration-string (cdr (assq 'Time mpc-status)))
5757                   (time-string (cdr (assq 'time mpc-status)))
5758                   (time (and time-string
5759                              (string-to-number
5760                               (if (string-match ":" time-string)
5761                                   (substring time-string
5762                                              0 (match-beginning 0))
5763                                 (time-string)))))
5764                   (duration (and duration-string
5765                                  (string-to-number duration-string)))
5766                   (pos (and time duration
5767                             (format " [%d:%02d/%d:%02d]"
5768                                     (/ time 60) (mod time 60)
5769                                     (/ duration 60) (mod duration 60))))
5770                   (fmt (cond ((and artist title)
5771                               (format "`%s' by %s%s" title artist
5772                                       (if album (format ", from `%s'" album)
5773                                         "")))
5774                              (file
5775                               (format "`%s' (no tags)" file))
5776                              (t
5777                               "(no idea what's playing!)"))))
5778              (if (string= state "play")
5779                  (message "mpd playing %s%s" fmt (or pos ""))
5780                (message "mpd paused in %s%s" fmt (or pos "")))))
5781           (t
5782            (message "mpd in unknown state `%s'" state)))))
5783
5784 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
5785   `(defun ,func ,bvl
5786      (interactive ,@interactive)
5787      (require 'mpc)
5788      ,@body
5789      (mdw-mpc-now-playing)))
5790
5791 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
5792   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
5793       (mpc-pause)
5794     (mpc-play)))
5795
5796 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
5797 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
5798 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
5799
5800 (defun mdw-mpc-louder (step)
5801   (interactive (list (if current-prefix-arg
5802                          (prefix-numeric-value current-prefix-arg)
5803                        +10)))
5804   (mpc-proc-cmd (format "volume %+d" step)))
5805
5806 (defun mdw-mpc-quieter (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-hack-lines (arg interactivep func)
5813   (if (and interactivep (use-region-p))
5814       (let ((from (region-beginning)) (to (region-end)))
5815         (goto-char from)
5816         (beginning-of-line)
5817         (funcall func)
5818         (forward-line)
5819         (while (< (point) to)
5820           (funcall func)
5821           (forward-line)))
5822     (let ((n (prefix-numeric-value arg)))
5823       (cond ((cl-minusp n)
5824              (unless (bolp)
5825                (beginning-of-line)
5826                (funcall func)
5827                (cl-incf n))
5828              (while (cl-minusp n)
5829                (forward-line -1)
5830                (funcall func)
5831                (cl-incf n)))
5832             (t
5833              (beginning-of-line)
5834              (while (cl-plusp n)
5835                (funcall func)
5836                (forward-line)
5837                (cl-decf n)))))))
5838
5839 (defun mdw-mpc-select-one ()
5840   (when (and (get-char-property (point) 'mpc-file)
5841              (not (get-char-property (point) 'mpc-select)))
5842     (mpc-select-toggle)))
5843
5844 (defun mdw-mpc-unselect-one ()
5845   (when (get-char-property (point) 'mpc-select)
5846     (mpc-select-toggle)))
5847
5848 (defun mdw-mpc-select (&optional arg interactivep)
5849   (interactive (list current-prefix-arg t))
5850   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5851
5852 (defun mdw-mpc-unselect (&optional arg interactivep)
5853   (interactive (list current-prefix-arg t))
5854   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
5855
5856 (defun mdw-mpc-unselect-backwards (arg)
5857   (interactive "p")
5858   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
5859
5860 (defun mdw-mpc-unselect-all ()
5861   (interactive)
5862   (setq mpc-select nil)
5863   (mpc-selection-refresh))
5864
5865 (defun mdw-mpc-next-line (arg)
5866   (interactive "p")
5867   (beginning-of-line)
5868   (forward-line arg))
5869
5870 (defun mdw-mpc-previous-line (arg)
5871   (interactive "p")
5872   (beginning-of-line)
5873   (forward-line (- arg)))
5874
5875 (defun mdw-mpc-playlist-add (&optional arg interactivep)
5876   (interactive (list current-prefix-arg t))
5877   (let ((mpc-select mpc-select))
5878     (when (or arg (and interactivep (use-region-p)))
5879       (setq mpc-select nil)
5880       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5881     (setq mpc-select (reverse mpc-select))
5882     (mpc-playlist-add)))
5883
5884 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
5885   (interactive (list current-prefix-arg t))
5886   (setq mpc-select (nreverse mpc-select))
5887   (mpc-select-save
5888     (when (or arg (and interactivep (use-region-p)))
5889       (setq mpc-select nil)
5890       (mpc-selection-refresh)
5891       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5892       (mpc-playlist-delete)))
5893
5894 (defun mdw-mpc-hack-tagbrowsers ()
5895   (setq-local mode-line-format
5896                 '("%e"
5897                   mode-line-frame-identification
5898                   mode-line-buffer-identification)))
5899 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
5900
5901 (defun mdw-mpc-hack-songs ()
5902   (setq-local header-line-format
5903               ;; '("MPC " mpc-volume " " mpc-current-song)
5904               (list (propertize " " 'display '(space :align-to 0))
5905                     ;; 'mpc-songs-format-description
5906                     '(:eval
5907                       (let ((deactivate-mark) (hscroll (window-hscroll)))
5908                         (with-temp-buffer
5909                           (mpc-format mpc-songs-format 'self hscroll)
5910                           ;; That would be simpler than the hscroll handling in
5911                           ;; mpc-format, but currently move-to-column does not
5912                           ;; recognize :space display properties.
5913                           ;; (move-to-column hscroll)
5914                           ;; (delete-region (point-min) (point))
5915                           (buffer-string)))))))
5916 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
5917
5918 (eval-after-load "mpc"
5919   '(progn
5920      (define-key mpc-mode-map "m" 'mdw-mpc-select)
5921      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
5922      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
5923      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
5924      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
5925      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
5926      (define-key mpc-mode-map "/" 'mpc-songs-search)
5927      (setq mpc-songs-mode-map (make-sparse-keymap))
5928      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
5929      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
5930      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
5931      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
5932      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
5933
5934 ;;;--------------------------------------------------------------------------
5935 ;;; Inferior Emacs Lisp.
5936
5937 (setq comint-prompt-read-only t)
5938
5939 (eval-after-load "comint"
5940   '(progn
5941      (define-key comint-mode-map "\C-w" 'comint-kill-region)
5942      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
5943
5944 (eval-after-load "ielm"
5945   '(progn
5946      (define-key ielm-map "\C-w" 'comint-kill-region)
5947      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
5948
5949 ;;;----- That's all, folks --------------------------------------------------
5950
5951 (provide 'dot-emacs)