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