chiark - git - mdw - profile/blob - el/dot-emacs.el

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