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-firefox
1413     browse-url-mozilla
1414     browse-url-generic
1415     (w3m . mdw-w3m-browse-url)
1416     browse-url-w3)
1417   "List of good browsers for mdw-good-url-browsers.
1418 Each item is a browser function name, or a cons (CHECK . FUNC).
1419 A symbol FOO stands for (FOO . FOO)."
1420   :type '(repeat (choice function (cons function function))))
1421
1422 (defun mdw-good-url-browser ()
1423   "Return a good URL browser.
1424 Trundle the list of such things, finding the first item for which
1425 CHECK is fboundp, and returning the correponding FUNC."
1426   (let ((bs mdw-good-url-browsers) b check func answer)
1427     (while (and bs (not answer))
1428       (setq b (car bs)
1429             bs (cdr bs))
1430       (if (consp b)
1431           (setq check (car b) func (cdr b))
1432         (setq check b func b))
1433       (if (fboundp check)
1434           (setq answer func)))
1435     answer))
1436
1437 (eval-after-load "w3m-search"
1438   '(progn
1439      (dolist
1440          (item
1441           '(("ddg" "DuckDuckGo" "https://duckduckgo.com/?q=%s")
1442             ("sp" "StartPage" "https://www.startpage.com/do/search?query=%s")
1443             ("wp" "Wikipedia"
1444              "https://en.wikipedia.org/wiki/Special:Search?go=Go&search=%s")
1445             ("g" "Google" "https://www.google.co.uk/search?q=%s")
1446             ("gi" "Images" "https://images.google.com/images?q=%s")
1447             ("gd" "Google Directory"
1448              "https://www.google.com/search?cat=gwd/Top&q=%s")
1449             ("gg" "Google Groups" "https://groups.google.com/groups?q=%s")
1450             ("gm" "Google maps" "https://maps.google.co.uk/maps?q=%s&hl=en")
1451             ("ward" "Ward's wiki" "http://c2.com/cgi/wiki?%s")
1452             ("imdb" "IMDb" "https://www.imdb.com/Find?%s")
1453             ("lp" "Launchpad bug by number"
1454              "https://bugs.launchpad.net/bugs/%s")
1455             ("lppkg" "Launchpad bugs by package"
1456              "https://bugs.launchpad.net/%s")
1457             ("msdn" "MSDN"
1458              "https://social.msdn.microsoft.com/Search/en-GB/?query=%s&ac=8")
1459             ("debbug" "Debian bug by number"
1460              "https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s")
1461             ("debbugpkg" "Debian bugs by package"
1462              "https://bugs.debian.org/cgi-bin/pkgreport.cgi?pkg=%s")))
1463        (add-to-list 'w3m-search-engine-alist
1464                     (list (cadr item) (cl-caddr item) nil))
1465        (add-to-list 'w3m-uri-replace-alist
1466                     (list (concat "\\`" (car item) ":")
1467                           'w3m-search-uri-replace
1468                           (cadr item))))))
1469
1470 (setq w3m-search-default-engine "DuckDuckGo")
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-popup-argument
2219   (((min-colors 64)) :foreground "SeaGreen1")
2220   (((class color)) :foreground "green")
2221   (t :weight bold))
2222 (mdw-define-face magit-diff-hunk-heading
2223   (((min-colors 64)) :foreground "grey70" :background "grey25")
2224   (((class color)) :foreground "yellow"))
2225 (mdw-define-face magit-diff-hunk-heading-highlight
2226   (((min-colors 64)) :foreground "grey70" :background "grey35")
2227   (((class color)) :foreground "yellow" :background "blue"))
2228 (mdw-define-face magit-diff-added
2229   (((min-colors 64)) :foreground "#ddffdd" :background "#335533")
2230   (((class color)) :foreground "green"))
2231 (mdw-define-face magit-diff-added-highlight
2232   (((min-colors 64)) :foreground "#cceecc" :background "#336633")
2233   (((class color)) :foreground "green" :background "blue"))
2234 (mdw-define-face magit-diff-removed
2235   (((min-colors 64)) :foreground "#ffdddd" :background "#553333")
2236   (((class color)) :foreground "red"))
2237 (mdw-define-face magit-diff-removed-highlight
2238   (((min-colors 64)) :foreground "#eecccc" :background "#663333")
2239   (((class color)) :foreground "red" :background "blue"))
2240 (mdw-define-face magit-blame-heading
2241   (((min-colors 64)) :foreground "white" :background "grey25"
2242                      :weight normal :slant normal)
2243   (((class color)) :foreground "white" :background "blue"
2244                    :weight normal :slant normal))
2245 (mdw-define-face magit-blame-name
2246   (t :inherit magit-blame-heading :slant italic))
2247 (mdw-define-face magit-blame-date
2248   (((min-colors 64)) :inherit magit-blame-heading :foreground "grey60")
2249   (((class color)) :inherit magit-blame-heading :foreground "cyan"))
2250 (mdw-define-face magit-blame-summary
2251   (t :inherit magit-blame-heading :weight bold))
2252
2253 (mdw-define-face dylan-header-background
2254   (((min-colors 64)) :background "NavyBlue")
2255   (((class color)) :background "blue"))
2256
2257 (mdw-define-face erc-my-nick-face
2258   (t :foreground "yellow" :weight bold))
2259 (mdw-define-face erc-current-nick-face
2260   (t :foreground "yellow" :weight bold))
2261 (mdw-define-face erc-input-face
2262   (t :foreground "yellow"))
2263 (mdw-define-face erc-action-face
2264   ())
2265 (mdw-define-face erc-button
2266   (t :foreground "cyan" :underline t :weight semi-bold))
2267
2268 (mdw-define-face woman-bold
2269   (t :weight bold))
2270 (mdw-define-face woman-italic
2271   (t :slant italic))
2272
2273 (eval-after-load "rst"
2274   '(progn
2275      (mdw-define-face rst-level-1-face
2276        (t :foreground "SkyBlue1" :weight bold))
2277      (mdw-define-face rst-level-2-face
2278        (t :foreground "SeaGreen1" :weight bold))
2279      (mdw-define-face rst-level-3-face
2280        (t :weight bold))
2281      (mdw-define-face rst-level-4-face
2282        (t :slant italic))
2283      (mdw-define-face rst-level-5-face
2284        (t :underline t))
2285      (mdw-define-face rst-level-6-face
2286        ())))
2287
2288 (mdw-define-face p4-depot-added-face
2289   (t :foreground "green"))
2290 (mdw-define-face p4-depot-branch-op-face
2291   (t :foreground "yellow"))
2292 (mdw-define-face p4-depot-deleted-face
2293   (t :foreground "red"))
2294 (mdw-define-face p4-depot-unmapped-face
2295   (t :foreground "SkyBlue1"))
2296 (mdw-define-face p4-diff-change-face
2297   (t :foreground "yellow"))
2298 (mdw-define-face p4-diff-del-face
2299   (t :foreground "red"))
2300 (mdw-define-face p4-diff-file-face
2301   (t :foreground "SkyBlue1"))
2302 (mdw-define-face p4-diff-head-face
2303   (t :background "grey10"))
2304 (mdw-define-face p4-diff-ins-face
2305   (t :foreground "green"))
2306
2307 (mdw-define-face w3m-anchor-face
2308   (t :foreground "SkyBlue1" :underline t))
2309 (mdw-define-face w3m-arrived-anchor-face
2310   (t :foreground "SkyBlue1" :underline t))
2311
2312 (mdw-define-face whizzy-slice-face
2313   (t :background "grey10"))
2314 (mdw-define-face whizzy-error-face
2315   (t :background "darkred"))
2316
2317 ;; Ellipses used to indicate hidden text (and similar).
2318 (mdw-define-face mdw-ellipsis-face
2319   (((type tty)) :foreground "blue") (t :foreground "grey60"))
2320 (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
2321       (backslash (make-glyph-code ?\\ 'mdw-ellipsis-face))
2322       (dot (make-glyph-code ?. 'mdw-ellipsis-face))
2323       (bar (make-glyph-code ?| mdw-ellipsis-face)))
2324   (set-display-table-slot standard-display-table 0 dollar)
2325   (set-display-table-slot standard-display-table 1 backslash)
2326   (set-display-table-slot standard-display-table 4
2327                           (vector dot dot dot))
2328   (set-display-table-slot standard-display-table 5 bar))
2329
2330 ;;;--------------------------------------------------------------------------
2331 ;;; Where is point?
2332
2333 (mdw-define-face mdw-point-overlay-face
2334   (((type graphic)))
2335   (((min-colors 64)) :background "darkblue")
2336   (((class color)) :background "blue")
2337   (((type tty) (class mono)) :inverse-video t))
2338
2339 (defcustom mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar)
2340   "Bitmaps to display in the left and right fringes in the current line."
2341   :type '(cons symbol symbol))
2342
2343 (defun mdw-configure-point-overlay ()
2344   (let ((ov (make-overlay 0 0)))
2345     (overlay-put ov 'priority 0)
2346     (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
2347            (left (car fringe)) (right (cdr fringe))
2348            (s ""))
2349       (when left
2350         (let ((ss "."))
2351           (put-text-property 0 1 'display `(left-fringe ,left) ss)
2352           (setq s (concat s ss))))
2353       (when right
2354         (let ((ss "."))
2355           (put-text-property 0 1 'display `(right-fringe ,right) ss)
2356           (setq s (concat s ss))))
2357       (when (or left right)
2358         (overlay-put ov 'before-string s)))
2359     (overlay-put ov 'face 'mdw-point-overlay-face)
2360     (delete-overlay ov)
2361     ov))
2362
2363 (defvar mdw-point-overlay (mdw-configure-point-overlay)
2364   "An overlay used for showing where point is in the selected window.")
2365 (defun mdw-reconfigure-point-overlay ()
2366   (interactive)
2367   (setq mdw-point-overlay (mdw-configure-point-overlay)))
2368
2369 (defun mdw-remove-point-overlay ()
2370   "Remove the current-point overlay."
2371   (delete-overlay mdw-point-overlay))
2372
2373 (defun mdw-update-point-overlay ()
2374   "Mark the current point position with an overlay."
2375   (if (not mdw-point-overlay-mode)
2376       (mdw-remove-point-overlay)
2377     (overlay-put mdw-point-overlay 'window (selected-window))
2378     (move-overlay mdw-point-overlay
2379                   (line-beginning-position)
2380                   (+ (line-end-position) 1))))
2381
2382 (defvar mdw-point-overlay-buffers nil
2383   "List of buffers using `mdw-point-overlay-mode'.")
2384
2385 (define-minor-mode mdw-point-overlay-mode
2386   "Indicate current line with an overlay."
2387   :global nil
2388   (let ((buffer (current-buffer)))
2389     (setq mdw-point-overlay-buffers
2390             (cl-mapcan (lambda (buf)
2391                          (if (and (buffer-live-p buf)
2392                                   (not (eq buf buffer)))
2393                              (list buf)))
2394                        mdw-point-overlay-buffers))
2395     (if mdw-point-overlay-mode
2396         (setq mdw-point-overlay-buffers
2397                 (cons buffer mdw-point-overlay-buffers))))
2398   (cond (mdw-point-overlay-buffers
2399          (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
2400          (add-hook 'post-command-hook 'mdw-update-point-overlay))
2401         (t
2402          (mdw-remove-point-overlay)
2403          (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
2404          (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
2405
2406 (define-globalized-minor-mode mdw-global-point-overlay-mode
2407   mdw-point-overlay-mode
2408   (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
2409
2410 (defvar mdw-terminal-title-alist nil)
2411 (defun mdw-update-terminal-title ()
2412   (when (let ((term (frame-parameter nil 'tty-type)))
2413           (and term (string-match "^xterm" term)))
2414     (let* ((tty (frame-parameter nil 'tty))
2415            (old (assoc tty mdw-terminal-title-alist))
2416            (new (format-mode-line frame-title-format)))
2417       (unless (and old (equal (cdr old) new))
2418         (if old (rplacd old new)
2419           (setq mdw-terminal-title-alist
2420                   (cons (cons tty new) mdw-terminal-title-alist)))
2421         (send-string-to-terminal (concat "\e]2;" new "\e\\"))))))
2422
2423 (add-hook 'post-command-hook 'mdw-update-terminal-title)
2424
2425 ;;;--------------------------------------------------------------------------
2426 ;;; Ediff hacking.
2427
2428 (defvar mdw-ediff-previous-windows)
2429 (defun mdw-ediff-setup ()
2430   (setq mdw-ediff-previous-windows (current-window-configuration)))
2431 (defun mdw-ediff-suspend-or-quit ()
2432   (set-window-configuration mdw-ediff-previous-windows))
2433 (add-hook 'ediff-before-setup-hook 'mdw-ediff-setup)
2434 (add-hook 'ediff-quit-hook 'mdw-ediff-suspend-or-quit t)
2435 (add-hook 'ediff-suspend-hook 'mdw-ediff-suspend-or-quit t)
2436
2437 ;;;--------------------------------------------------------------------------
2438 ;;; C programming configuration.
2439
2440 ;; Make C indentation nice.
2441
2442 (defun mdw-c-lineup-arglist (langelem)
2443   "Hack for DWIMmery in c-lineup-arglist."
2444   (if (save-excursion
2445         (c-block-in-arglist-dwim (c-langelem-2nd-pos c-syntactic-element)))
2446       0
2447     (c-lineup-arglist langelem)))
2448
2449 (defun mdw-c-indent-extern-mumble (langelem)
2450   "Indent `extern \"...\" {' lines."
2451   (save-excursion
2452     (back-to-indentation)
2453     (if (looking-at
2454          "\\s-*\\<extern\\>\\s-*\"\\([^\\\\\"]+\\|\\.\\)*\"\\s-*{")
2455         c-basic-offset
2456       nil)))
2457
2458 (defun mdw-c-indent-arglist-nested (langelem)
2459   "Indent continued argument lists.
2460 If we've nested more than one argument list, then only introduce a single
2461 indentation anyway."
2462   (let ((context c-syntactic-context)
2463         (pos (c-langelem-2nd-pos c-syntactic-element))
2464         (should-indent-p t))
2465     (while (and context
2466                 (eq (caar context) 'arglist-cont-nonempty))
2467       (when (and (= (cl-caddr (pop context)) pos)
2468                  context
2469                  (memq (caar context) '(arglist-intro
2470                                         arglist-cont-nonempty)))
2471         (setq should-indent-p nil)))
2472     (if should-indent-p '+ 0)))
2473
2474 (defvar mdw-define-c-styles-hook nil
2475   "Hook run when `cc-mode' starts up to define styles.")
2476
2477 (defun mdw-merge-style-alists (first second)
2478   (let ((output nil))
2479     (dolist (item first)
2480       (let ((key (car item)) (value (cdr item)))
2481         (if (let* ((key-name (symbol-name key))
2482                    (key-len (length key-name)))
2483               (and (>= key-len 6)
2484                    (string= (substring key-name (- key-len 6)) "-alist")))
2485             (push (cons key
2486                         (mdw-merge-style-alists value
2487                                                 (cdr (assoc key second))))
2488                   output)
2489           (push item output))))
2490     (dolist (item second)
2491       (unless (assoc (car item) first)
2492         (push item output)))
2493     (nreverse output)))
2494
2495 (cl-defmacro mdw-define-c-style (name (&optional parent) &rest assocs)
2496   "Define a C style, called NAME (a symbol) based on PARENT, setting ASSOCs.
2497 A function, named `mdw-define-c-style/NAME', is defined to actually install
2498 the style using `c-add-style', and added to the hook
2499 `mdw-define-c-styles-hook'.  If CC Mode is already loaded, then the style is
2500 set."
2501   (declare (indent defun))
2502   (let* ((name-string (symbol-name name))
2503          (var (intern (concat "mdw-c-style/" name-string)))
2504          (func (intern (concat "mdw-define-c-style/" name-string))))
2505     `(progn
2506        (setq ,var
2507                ,(if (null parent)
2508                     `',assocs
2509                   (let ((parent-list (intern (concat "mdw-c-style/"
2510                                                      (symbol-name parent)))))
2511                     `(mdw-merge-style-alists ',assocs ,parent-list))))
2512        (defun ,func () (c-add-style ,name-string ,var))
2513        (and (featurep 'cc-mode) (,func))
2514        (add-hook 'mdw-define-c-styles-hook ',func)
2515        ',name)))
2516
2517 (eval-after-load "cc-mode"
2518   '(run-hooks 'mdw-define-c-styles-hook))
2519
2520 (mdw-define-c-style mdw-c ()
2521   (c-basic-offset . 2)
2522   (comment-column . 40)
2523   (c-class-key . "class")
2524   (c-backslash-column . 72)
2525   (c-label-minimum-indentation . 0)
2526   (c-indent-comments-syntactically-p t)
2527   (c-indent-comment-alist (end-block . (column . nil))
2528                           (cpp-end-block . (column . nil))
2529                           (other . (column . nil)))
2530   (c-offsets-alist (substatement-open . (add 0 c-indent-one-line-block))
2531                    (defun-open . (add 0 c-indent-one-line-block))
2532                    (arglist-cont-nonempty . mdw-c-lineup-arglist)
2533                    (topmost-intro . mdw-c-indent-extern-mumble)
2534                    (cpp-define-intro . 0)
2535                    (knr-argdecl . 0)
2536                    (inextern-lang . [0])
2537                    (label . 0)
2538                    (case-label . +)
2539                    (access-label . -)
2540                    (inclass . +)
2541                    (inline-open . ++)
2542                    (statement-cont . +)
2543                    (statement-case-intro . +)))
2544
2545 (mdw-define-c-style mdw-trustonic-c (mdw-c)
2546   (c-basic-offset . 4)
2547   (c-offsets-alist (access-label . -2)))
2548
2549 (mdw-define-c-style mdw-trustonic-alec-c (mdw-trustonic-c)
2550   (comment-column . 0)
2551   (c-indent-comment-alist (anchored-comment . (column . 0))
2552                           (end-block . (space . 1))
2553                           (cpp-end-block . (space . 1))
2554                           (other . (space . 1)))
2555   (c-offsets-alist (arglist-cont-nonempty . mdw-c-indent-arglist-nested)))
2556
2557 (defun mdw-set-default-c-style (modes style)
2558   "Update the default CC Mode style for MODES to be STYLE.
2559
2560 MODES may be a list of major mode names or a singleton.  STYLE is a style
2561 name, as a symbol."
2562   (let ((modes (if (listp modes) modes (list modes)))
2563         (style (symbol-name style)))
2564     (setq c-default-style
2565             (append (mapcar (lambda (mode)
2566                               (cons mode style))
2567                             modes)
2568                     (cl-remove-if (lambda (assoc)
2569                                     (memq (car assoc) modes))
2570                                   (if (listp c-default-style)
2571                                       c-default-style
2572                                     (list (cons 'other
2573                                                 c-default-style))))))))
2574 (setq c-default-style "mdw-c")
2575
2576 (mdw-set-default-c-style '(c-mode c++-mode) 'mdw-c)
2577
2578 (defvar mdw-c-comment-fill-prefix
2579   `((,(concat "\\([ \t]*/?\\)"
2580               "\\(\\*\\|//\\)"
2581               "\\([ \t]*\\)"
2582               "\\([A-Za-z]+:[ \t]*\\)?"
2583               mdw-hanging-indents)
2584      (pad . 1) (match . 2) (pad . 3) (pad . 4) (pad . 5)))
2585   "Fill prefix matching C comments (both kinds).")
2586
2587 (defun mdw-fontify-c-and-c++ ()
2588
2589   ;; Fiddle with some syntax codes.
2590   (modify-syntax-entry ?* ". 23")
2591   (modify-syntax-entry ?/ ". 124b")
2592   (modify-syntax-entry ?\n "> b")
2593
2594   ;; Other stuff.
2595   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2596
2597   ;; Now define things to be fontified.
2598   (make-local-variable 'font-lock-keywords)
2599   (let ((c-keywords
2600          (mdw-regexps "alignas"          ;C11 macro, C++11
2601                       "alignof"          ;C++11
2602                       "and"              ;C++, C95 macro
2603                       "and_eq"           ;C++, C95 macro
2604                       "asm"              ;K&R, C++, GCC
2605                       "atomic"           ;C11 macro, C++11 template type
2606                       "auto"             ;K&R, C89
2607                       "bitand"           ;C++, C95 macro
2608                       "bitor"            ;C++, C95 macro
2609                       "bool"             ;C++, C99 macro
2610                       "break"            ;K&R, C89
2611                       "case"             ;K&R, C89
2612                       "catch"            ;C++
2613                       "char"             ;K&R, C89
2614                       "char16_t"         ;C++11, C11 library type
2615                       "char32_t"         ;C++11, C11 library type
2616                       "class"            ;C++
2617                       "complex"          ;C99 macro, C++ template type
2618                       "compl"            ;C++, C95 macro
2619                       "const"            ;C89
2620                       "constexpr"        ;C++11
2621                       "const_cast"       ;C++
2622                       "continue"         ;K&R, C89
2623                       "decltype"         ;C++11
2624                       "defined"          ;C89 preprocessor
2625                       "default"          ;K&R, C89
2626                       "delete"           ;C++
2627                       "do"               ;K&R, C89
2628                       "double"           ;K&R, C89
2629                       "dynamic_cast"     ;C++
2630                       "else"             ;K&R, C89
2631                       ;; "entry"         ;K&R -- never used
2632                       "enum"             ;C89
2633                       "explicit"         ;C++
2634                       "export"           ;C++
2635                       "extern"           ;K&R, C89
2636                       "float"            ;K&R, C89
2637                       "for"              ;K&R, C89
2638                       ;; "fortran"       ;K&R
2639                       "friend"           ;C++
2640                       "goto"             ;K&R, C89
2641                       "if"               ;K&R, C89
2642                       "imaginary"        ;C99 macro
2643                       "inline"           ;C++, C99, GCC
2644                       "int"              ;K&R, C89
2645                       "long"             ;K&R, C89
2646                       "mutable"          ;C++
2647                       "namespace"        ;C++
2648                       "new"              ;C++
2649                       "noexcept"         ;C++11
2650                       "noreturn"         ;C11 macro
2651                       "not"              ;C++, C95 macro
2652                       "not_eq"           ;C++, C95 macro
2653                       "nullptr"          ;C++11
2654                       "operator"         ;C++
2655                       "or"               ;C++, C95 macro
2656                       "or_eq"            ;C++, C95 macro
2657                       "private"          ;C++
2658                       "protected"        ;C++
2659                       "public"           ;C++
2660                       "register"         ;K&R, C89
2661                       "reinterpret_cast" ;C++
2662                       "restrict"         ;C99
2663                       "return"           ;K&R, C89
2664                       "short"            ;K&R, C89
2665                       "signed"           ;C89
2666                       "sizeof"           ;K&R, C89
2667                       "static"           ;K&R, C89
2668                       "static_assert"    ;C11 macro, C++11
2669                       "static_cast"      ;C++
2670                       "struct"           ;K&R, C89
2671                       "switch"           ;K&R, C89
2672                       "template"         ;C++
2673                       "throw"            ;C++
2674                       "try"              ;C++
2675                       "thread_local"     ;C11 macro, C++11
2676                       "typedef"          ;C89
2677                       "typeid"           ;C++
2678                       "typeof"           ;GCC
2679                       "typename"         ;C++
2680                       "union"            ;K&R, C89
2681                       "unsigned"         ;K&R, C89
2682                       "using"            ;C++
2683                       "virtual"          ;C++
2684                       "void"             ;C89
2685                       "volatile"         ;C89
2686                       "wchar_t"          ;C++, C89 library type
2687                       "while"            ;K&R, C89
2688                       "xor"              ;C++, C95 macro
2689                       "xor_eq"           ;C++, C95 macro
2690                       "_Alignas"         ;C11
2691                       "_Alignof"         ;C11
2692                       "_Atomic"          ;C11
2693                       "_Bool"            ;C99
2694                       "_Complex"         ;C99
2695                       "_Generic"         ;C11
2696                       "_Imaginary"       ;C99
2697                       "_Noreturn"        ;C11
2698                       "_Pragma"          ;C99 preprocessor
2699                       "_Static_assert"   ;C11
2700                       "_Thread_local"    ;C11
2701                       "__alignof__"      ;GCC
2702                       "__asm__"          ;GCC
2703                       "__attribute__"    ;GCC
2704                       "__complex__"      ;GCC
2705                       "__const__"        ;GCC
2706                       "__extension__"    ;GCC
2707                       "__imag__"         ;GCC
2708                       "__inline__"       ;GCC
2709                       "__label__"        ;GCC
2710                       "__real__"         ;GCC
2711                       "__signed__"       ;GCC
2712                       "__typeof__"       ;GCC
2713                       "__volatile__"     ;GCC
2714                       ))
2715         (c-builtins
2716          (mdw-regexps "false"            ;C++, C99 macro
2717                       "this"             ;C++
2718                       "true"             ;C++, C99 macro
2719                       ))
2720         (preprocessor-keywords
2721          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
2722                       "ident" "if" "ifdef" "ifndef" "import" "include"
2723                       "line" "pragma" "unassert" "undef" "warning"))
2724         (objc-keywords
2725          (mdw-regexps "class" "defs" "encode" "end" "implementation"
2726                       "interface" "private" "protected" "protocol" "public"
2727                       "selector")))
2728
2729     (setq font-lock-keywords
2730             (list
2731
2732              ;; Fontify include files as strings.
2733              (list (concat "^[ \t]*\\#[ \t]*"
2734                            "\\(include\\|import\\)"
2735                            "[ \t]*\\(<[^>]+>?\\)")
2736                    '(2 font-lock-string-face))
2737
2738              ;; Preprocessor directives are `references'?.
2739              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
2740                            preprocessor-keywords
2741                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
2742                    '(1 font-lock-keyword-face))
2743
2744              ;; Handle the keywords defined above.
2745              (list (concat "@\\<\\(" objc-keywords "\\)\\>")
2746                    '(0 font-lock-keyword-face))
2747
2748              (list (concat "\\<\\(" c-keywords "\\)\\>")
2749                    '(0 font-lock-keyword-face))
2750
2751              (list (concat "\\<\\(" c-builtins "\\)\\>")
2752                    '(0 font-lock-variable-name-face))
2753
2754              ;; Handle numbers too.
2755              ;;
2756              ;; This looks strange, I know.  It corresponds to the
2757              ;; preprocessor's idea of what a number looks like, rather than
2758              ;; anything sensible.
2759              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2760                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2761                    '(0 mdw-number-face))
2762
2763              ;; And anything else is punctuation.
2764              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2765                    '(0 mdw-punct-face))))))
2766
2767 (define-derived-mode sod-mode c-mode "Sod"
2768   "Major mode for editing Sod code.")
2769 (push '("\\.sod$" . sod-mode) auto-mode-alist)
2770
2771 (dolist (hook '(c-mode-hook objc-mode-hook c++-mode-hook))
2772   (add-hook hook 'mdw-misc-mode-config t)
2773   (add-hook hook 'mdw-fontify-c-and-c++ t))
2774
2775 ;;;--------------------------------------------------------------------------
2776 ;;; AP calc mode.
2777
2778 (define-derived-mode apcalc-mode c-mode "AP Calc"
2779   "Major mode for editing Calc code.")
2780
2781 (defun mdw-fontify-apcalc ()
2782
2783   ;; Fiddle with some syntax codes.
2784   (modify-syntax-entry ?* ". 23")
2785   (modify-syntax-entry ?/ ". 14")
2786
2787   ;; Other stuff.
2788   (setq comment-start "/* ")
2789   (setq comment-end " */")
2790   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2791
2792   ;; Now define things to be fontified.
2793   (make-local-variable 'font-lock-keywords)
2794   (let ((c-keywords
2795          (mdw-regexps "break" "case" "cd" "continue" "define" "default"
2796                       "do" "else" "exit" "for" "global" "goto" "help" "if"
2797                       "local" "mat" "obj" "print" "quit" "read" "return"
2798                       "show" "static" "switch" "while" "write")))
2799
2800     (setq font-lock-keywords
2801             (list
2802
2803              ;; Handle the keywords defined above.
2804              (list (concat "\\<\\(" c-keywords "\\)\\>")
2805                    '(0 font-lock-keyword-face))
2806
2807              ;; Handle numbers too.
2808              ;;
2809              ;; This looks strange, I know.  It corresponds to the
2810              ;; preprocessor's idea of what a number looks like, rather than
2811              ;; anything sensible.
2812              (list (concat "\\(\\<[0-9]\\|\\.[0-9]\\)"
2813                            "\\([Ee][+-]\\|[0-9A-Za-z_.]\\)*")
2814                    '(0 mdw-number-face))
2815
2816              ;; And anything else is punctuation.
2817              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2818                    '(0 mdw-punct-face))))))
2819
2820 (progn
2821   (add-hook 'apcalc-mode-hook 'mdw-misc-mode-config t)
2822   (add-hook 'apcalc-mode-hook 'mdw-fontify-apcalc t))
2823
2824 ;;;--------------------------------------------------------------------------
2825 ;;; Java programming configuration.
2826
2827 ;; Make indentation nice.
2828
2829 (mdw-define-c-style mdw-java ()
2830   (c-basic-offset . 2)
2831   (c-backslash-column . 72)
2832   (c-offsets-alist (substatement-open . 0)
2833                    (label . +)
2834                    (case-label . +)
2835                    (access-label . 0)
2836                    (inclass . +)
2837                    (statement-case-intro . +)))
2838 (mdw-set-default-c-style 'java-mode 'mdw-java)
2839
2840 ;; Declare Java fontification style.
2841
2842 (defun mdw-fontify-java ()
2843
2844   ;; Fiddle with some syntax codes.
2845   (modify-syntax-entry ?@ ".")
2846   (modify-syntax-entry ?@ "." font-lock-syntax-table)
2847
2848   ;; Other stuff.
2849   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2850
2851   ;; Now define things to be fontified.
2852   (make-local-variable 'font-lock-keywords)
2853   (let ((java-keywords
2854          (mdw-regexps "abstract" "assert"
2855                       "boolean" "break" "byte"
2856                       "case" "catch" "char" "class" "const" "continue"
2857                       "default" "do" "double"
2858                       "else" "enum" "extends"
2859                       "final" "finally" "float" "for"
2860                       "goto"
2861                       "if" "implements" "import" "instanceof" "int"
2862                       "interface"
2863                       "long"
2864                       "native" "new"
2865                       "package" "private" "protected" "public"
2866                       "return"
2867                       "short" "static" "strictfp" "switch" "synchronized"
2868                       "throw" "throws" "transient" "try"
2869                       "void" "volatile"
2870                       "while"))
2871
2872         (java-builtins
2873          (mdw-regexps "false" "null" "super" "this" "true")))
2874
2875     (setq font-lock-keywords
2876             (list
2877
2878              ;; Handle the keywords defined above.
2879              (list (concat "\\<\\(" java-keywords "\\)\\>")
2880                    '(0 font-lock-keyword-face))
2881
2882              ;; Handle the magic builtins defined above.
2883              (list (concat "\\<\\(" java-builtins "\\)\\>")
2884                    '(0 font-lock-variable-name-face))
2885
2886              ;; Handle numbers too.
2887              ;;
2888              ;; The following isn't quite right, but it's close enough.
2889              (list (concat "\\<\\("
2890                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2891                            "[0-9]+\\(\\.[0-9]*\\)?"
2892                            "\\([eE][-+]?[0-9]+\\)?\\)"
2893                            "[lLfFdD]?")
2894                    '(0 mdw-number-face))
2895
2896              ;; And anything else is punctuation.
2897              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2898                    '(0 mdw-punct-face))))))
2899
2900 (progn
2901   (add-hook 'java-mode-hook 'mdw-misc-mode-config t)
2902   (add-hook 'java-mode-hook 'mdw-fontify-java t))
2903
2904 ;;;--------------------------------------------------------------------------
2905 ;;; Javascript programming configuration.
2906
2907 (defun mdw-javascript-style ()
2908   (setq js-indent-level 2)
2909   (setq js-expr-indent-offset 0))
2910
2911 (defun mdw-fontify-javascript ()
2912
2913   ;; Other stuff.
2914   (mdw-javascript-style)
2915   (setq js-auto-indent-flag t)
2916
2917   ;; Now define things to be fontified.
2918   (make-local-variable 'font-lock-keywords)
2919   (let ((javascript-keywords
2920          (mdw-regexps "abstract" "boolean" "break" "byte" "case" "catch"
2921                       "char" "class" "const" "continue" "debugger" "default"
2922                       "delete" "do" "double" "else" "enum" "export" "extends"
2923                       "final" "finally" "float" "for" "function" "goto" "if"
2924                       "implements" "import" "in" "instanceof" "int"
2925                       "interface" "let" "long" "native" "new" "package"
2926                       "private" "protected" "public" "return" "short"
2927                       "static" "super" "switch" "synchronized" "throw"
2928                       "throws" "transient" "try" "typeof" "var" "void"
2929                       "volatile" "while" "with" "yield"))
2930         (javascript-builtins
2931          (mdw-regexps "false" "null" "undefined" "Infinity" "NaN" "true"
2932                       "arguments" "this")))
2933
2934     (setq font-lock-keywords
2935             (list
2936
2937              ;; Handle the keywords defined above.
2938              (list (concat "\\_<\\(" javascript-keywords "\\)\\_>")
2939                    '(0 font-lock-keyword-face))
2940
2941              ;; Handle the predefined builtins defined above.
2942              (list (concat "\\_<\\(" javascript-builtins "\\)\\_>")
2943                    '(0 font-lock-variable-name-face))
2944
2945              ;; Handle numbers too.
2946              ;;
2947              ;; The following isn't quite right, but it's close enough.
2948              (list (concat "\\_<\\("
2949                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
2950                            "[0-9]+\\(\\.[0-9]*\\)?"
2951                            "\\([eE][-+]?[0-9]+\\)?\\)"
2952                            "[lLfFdD]?")
2953                    '(0 mdw-number-face))
2954
2955              ;; And anything else is punctuation.
2956              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
2957                    '(0 mdw-punct-face))))))
2958
2959 (progn
2960   (add-hook 'js-mode-hook 'mdw-misc-mode-config t)
2961   (add-hook 'js-mode-hook 'mdw-fontify-javascript t))
2962
2963 ;;;--------------------------------------------------------------------------
2964 ;;; Scala programming configuration.
2965
2966 (defun mdw-fontify-scala ()
2967
2968   ;; Comment filling.
2969   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
2970
2971   ;; Define things to be fontified.
2972   (make-local-variable 'font-lock-keywords)
2973   (let ((scala-keywords
2974          (mdw-regexps "abstract" "case" "catch" "class" "def" "do" "else"
2975                       "extends" "final" "finally" "for" "forSome" "if"
2976                       "implicit" "import" "lazy" "match" "new" "object"
2977                       "override" "package" "private" "protected" "return"
2978                       "sealed" "throw" "trait" "try" "type" "val"
2979                       "var" "while" "with" "yield"))
2980         (scala-constants
2981          (mdw-regexps "false" "null" "super" "this" "true"))
2982         (punctuation "[-!%^&*=+:@#~/?\\|`]"))
2983
2984     (setq font-lock-keywords
2985             (list
2986
2987              ;; Magical identifiers between backticks.
2988              (list (concat "`\\([^`]+\\)`")
2989                    '(1 font-lock-variable-name-face))
2990
2991              ;; Handle the keywords defined above.
2992              (list (concat "\\_<\\(" scala-keywords "\\)\\_>")
2993                    '(0 font-lock-keyword-face))
2994
2995              ;; Handle the constants defined above.
2996              (list (concat "\\_<\\(" scala-constants "\\)\\_>")
2997                    '(0 font-lock-variable-name-face))
2998
2999              ;; Magical identifiers between backticks.
3000              (list (concat "`\\([^`]+\\)`")
3001                    '(1 font-lock-variable-name-face))
3002
3003              ;; Handle numbers too.
3004              ;;
3005              ;; As usual, not quite right.
3006              (list (concat "\\_<\\("
3007                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3008                            "[0-9]+\\(\\.[0-9]*\\)?"
3009                            "\\([eE][-+]?[0-9]+\\)?\\)"
3010                            "[lLfFdD]?")
3011                    '(0 mdw-number-face))
3012
3013              ;; And everything else is punctuation.
3014              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3015                    '(0 mdw-punct-face)))
3016
3017           font-lock-syntactic-keywords
3018             (list
3019
3020              ;; Single quotes around characters.  But not when used to quote
3021              ;; symbol names.  Ugh.
3022              (list (concat "\\('\\)"
3023                            "\\(" "."
3024                            "\\|" "\\\\" "\\(" "\\\\\\\\" "\\)*"
3025                            "u+" "[0-9a-fA-F]\\{4\\}"
3026                            "\\|" "\\\\" "[0-7]\\{1,3\\}"
3027                            "\\|" "\\\\" "." "\\)"
3028                            "\\('\\)")
3029                    '(1 "\"")
3030                    '(4 "\""))))))
3031
3032 (progn
3033   (add-hook 'scala-mode-hook 'mdw-misc-mode-config t)
3034   (add-hook 'scala-mode-hook 'mdw-fontify-scala t))
3035
3036 ;;;--------------------------------------------------------------------------
3037 ;;; C# programming configuration.
3038
3039 ;; Make indentation nice.
3040
3041 (mdw-define-c-style mdw-csharp ()
3042   (c-basic-offset . 2)
3043   (c-backslash-column . 72)
3044   (c-offsets-alist (substatement-open . 0)
3045                    (label . 0)
3046                    (case-label . +)
3047                    (access-label . 0)
3048                    (inclass . +)
3049                    (statement-case-intro . +)))
3050 (mdw-set-default-c-style 'csharp-mode 'mdw-csharp)
3051
3052 ;; Declare C# fontification style.
3053
3054 (defun mdw-fontify-csharp ()
3055
3056   ;; Other stuff.
3057   (setq mdw-fill-prefix mdw-c-comment-fill-prefix)
3058
3059   ;; Now define things to be fontified.
3060   (make-local-variable 'font-lock-keywords)
3061   (let ((csharp-keywords
3062          (mdw-regexps "abstract" "as" "bool" "break" "byte" "case" "catch"
3063                       "char" "checked" "class" "const" "continue" "decimal"
3064                       "default" "delegate" "do" "double" "else" "enum"
3065                       "event" "explicit" "extern" "finally" "fixed" "float"
3066                       "for" "foreach" "goto" "if" "implicit" "in" "int"
3067                       "interface" "internal" "is" "lock" "long" "namespace"
3068                       "new" "object" "operator" "out" "override" "params"
3069                       "private" "protected" "public" "readonly" "ref"
3070                       "return" "sbyte" "sealed" "short" "sizeof"
3071                       "stackalloc" "static" "string" "struct" "switch"
3072                       "throw" "try" "typeof" "uint" "ulong" "unchecked"
3073                       "unsafe" "ushort" "using" "virtual" "void" "volatile"
3074                       "while" "yield"))
3075
3076         (csharp-builtins
3077          (mdw-regexps "base" "false" "null" "this" "true")))
3078
3079     (setq font-lock-keywords
3080             (list
3081
3082              ;; Handle the keywords defined above.
3083              (list (concat "\\<\\(" csharp-keywords "\\)\\>")
3084                    '(0 font-lock-keyword-face))
3085
3086              ;; Handle the magic builtins defined above.
3087              (list (concat "\\<\\(" csharp-builtins "\\)\\>")
3088                    '(0 font-lock-variable-name-face))
3089
3090              ;; Handle numbers too.
3091              ;;
3092              ;; The following isn't quite right, but it's close enough.
3093              (list (concat "\\<\\("
3094                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3095                            "[0-9]+\\(\\.[0-9]*\\)?"
3096                            "\\([eE][-+]?[0-9]+\\)?\\)"
3097                            "[lLfFdD]?")
3098                    '(0 mdw-number-face))
3099
3100              ;; And anything else is punctuation.
3101              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3102                    '(0 mdw-punct-face))))))
3103
3104 (define-derived-mode csharp-mode java-mode "C#"
3105   "Major mode for editing C# code.")
3106
3107 (add-hook 'csharp-mode-hook 'mdw-fontify-csharp t)
3108
3109 ;;;--------------------------------------------------------------------------
3110 ;;; F# programming configuration.
3111
3112 (setq fsharp-indent-offset 2)
3113
3114 (defun mdw-fontify-fsharp ()
3115
3116   (let ((punct "=<>+-*/|&%!@?"))
3117     (cl-do ((i 0 (1+ i)))
3118         ((>= i (length punct)))
3119       (modify-syntax-entry (aref punct i) ".")))
3120
3121   (modify-syntax-entry ?_ "_")
3122   (modify-syntax-entry ?( "(")
3123   (modify-syntax-entry ?) ")")
3124
3125   (setq indent-tabs-mode nil)
3126
3127   (let ((fsharp-keywords
3128          (mdw-regexps "abstract" "and" "as" "assert" "atomic"
3129                       "begin" "break"
3130                       "checked" "class" "component" "const" "constraint"
3131                       "constructor" "continue"
3132                       "default" "delegate" "do" "done" "downcast" "downto"
3133                       "eager" "elif" "else" "end" "exception" "extern"
3134                       "finally" "fixed" "for" "fori" "fun" "function"
3135                       "functor"
3136                       "global"
3137                       "if" "in" "include" "inherit" "inline" "interface"
3138                       "internal"
3139                       "lazy" "let"
3140                       "match" "measure" "member" "method" "mixin" "module"
3141                       "mutable"
3142                       "namespace" "new"
3143                       "object" "of" "open" "or" "override"
3144                       "parallel" "params" "private" "process" "protected"
3145                       "public" "pure"
3146                       "rec" "recursive" "return"
3147                       "sealed" "sig" "static" "struct"
3148                       "tailcall" "then" "to" "trait" "try" "type"
3149                       "upcast" "use"
3150                       "val" "virtual" "void" "volatile"
3151                       "when" "while" "with"
3152                       "yield"))
3153
3154         (fsharp-builtins
3155          (mdw-regexps "asr" "land" "lor" "lsl" "lsr" "lxor" "mod"
3156                       "base" "false" "null" "true"))
3157
3158         (bang-keywords
3159          (mdw-regexps "do" "let" "return" "use" "yield"))
3160
3161         (preprocessor-keywords
3162          (mdw-regexps "if" "indent" "else" "endif")))
3163
3164     (setq font-lock-keywords
3165             (list (list (concat "\\(^\\|[^\"]\\)"
3166                                 "\\(" "(\\*"
3167                                       "[^*]*\\*+"
3168                                       "\\(" "[^)*]" "[^*]*" "\\*+" "\\)*"
3169                                       ")"
3170                                 "\\|"
3171                                       "//.*"
3172                                 "\\)")
3173                         '(2 font-lock-comment-face))
3174
3175                   (list (concat "'" "\\("
3176                                       "\\\\"
3177                                       "\\(" "[ntbr'\\]"
3178                                       "\\|" "[0-9][0-9][0-9]"
3179                                       "\\|" "u" "[0-9a-fA-F]\\{4\\}"
3180                                       "\\|" "U" "[0-9a-fA-F]\\{8\\}"
3181                                       "\\)"
3182                                     "\\|"
3183                                     "." "\\)" "'"
3184                                 "\\|"
3185                                 "\"" "[^\"\\]*"
3186                                       "\\(" "\\\\" "\\(.\\|\n\\)"
3187                                             "[^\"\\]*" "\\)*"
3188                                 "\\(\"\\|\\'\\)")
3189                         '(0 font-lock-string-face))
3190
3191                   (list (concat "\\_<\\(" bang-keywords "\\)!" "\\|"
3192                                 "^#[ \t]*\\(" preprocessor-keywords "\\)\\_>"
3193                                 "\\|"
3194                                 "\\_<\\(" fsharp-keywords "\\)\\_>")
3195                         '(0 font-lock-keyword-face))
3196                   (list (concat "\\<\\(" fsharp-builtins "\\)\\_>")
3197                         '(0 font-lock-variable-name-face))
3198
3199                   (list (concat "\\_<"
3200                                 "\\(" "0[bB][01]+" "\\|"
3201                                       "0[oO][0-7]+" "\\|"
3202                                       "0[xX][0-9a-fA-F]+" "\\)"
3203                                 "\\(" "lf\\|LF" "\\|"
3204                                       "[uU]?[ysnlL]?" "\\)"
3205                                 "\\|"
3206                                 "\\_<"
3207                                 "[0-9]+" "\\("
3208                                   "[mMQRZING]"
3209                                   "\\|"
3210                                   "\\(\\.[0-9]*\\)?"
3211                                   "\\([eE][-+]?[0-9]+\\)?"
3212                                   "[fFmM]?"
3213                                   "\\|"
3214                                   "[uU]?[ysnlL]?"
3215                                 "\\)")
3216                         '(0 mdw-number-face))
3217
3218                   (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3219                         '(0 mdw-punct-face))))))
3220
3221 (defun mdw-fontify-inferior-fsharp ()
3222   (mdw-fontify-fsharp)
3223   (setq font-lock-keywords
3224           (append (list (list "^[#-]" '(0 font-lock-comment-face))
3225                         (list "^>" '(0 font-lock-keyword-face)))
3226                   font-lock-keywords)))
3227
3228 (progn
3229   (add-hook 'fsharp-mode-hook 'mdw-misc-mode-config t)
3230   (add-hook 'fsharp-mode-hook 'mdw-fontify-fsharp t)
3231   (add-hook 'inferior-fsharp-mode-hooks 'mdw-fontify-inferior-fsharp t))
3232
3233 ;;;--------------------------------------------------------------------------
3234 ;;; Go programming configuration.
3235
3236 (defun mdw-fontify-go ()
3237
3238   (make-local-variable 'font-lock-keywords)
3239   (let ((go-keywords
3240          (mdw-regexps "break" "case" "chan" "const" "continue"
3241                       "default" "defer" "else" "fallthrough" "for"
3242                       "func" "go" "goto" "if" "import"
3243                       "interface" "map" "package" "range" "return"
3244                       "select" "struct" "switch" "type" "var"))
3245         (go-intrinsics
3246          (mdw-regexps "bool" "byte" "complex64" "complex128" "error"
3247                       "float32" "float64" "int" "uint8" "int16" "int32"
3248                       "int64" "rune" "string" "uint" "uint8" "uint16"
3249                       "uint32" "uint64" "uintptr" "void"
3250                       "false" "iota" "nil" "true"
3251                       "init" "main"
3252                       "append" "cap" "copy" "delete" "imag" "len" "make"
3253                       "new" "panic" "real" "recover")))
3254
3255     (setq font-lock-keywords
3256             (list
3257
3258              ;; Handle the keywords defined above.
3259              (list (concat "\\<\\(" go-keywords "\\)\\>")
3260                    '(0 font-lock-keyword-face))
3261              (list (concat "\\<\\(" go-intrinsics "\\)\\>")
3262                    '(0 font-lock-variable-name-face))
3263
3264              ;; Strings and characters.
3265              (list (concat "'"
3266                            "\\(" "[^\\']" "\\|"
3267                                  "\\\\"
3268                                  "\\(" "[abfnrtv\\'\"]" "\\|"
3269                                        "[0-7]\\{3\\}" "\\|"
3270                                        "x" "[0-9A-Fa-f]\\{2\\}" "\\|"
3271                                        "u" "[0-9A-Fa-f]\\{4\\}" "\\|"
3272                                        "U" "[0-9A-Fa-f]\\{8\\}" "\\)" "\\)"
3273                            "'"
3274                            "\\|"
3275                            "\""
3276                            "\\(" "[^\n\\\"]+" "\\|" "\\\\." "\\)*"
3277                            "\\(\"\\|$\\)"
3278                            "\\|"
3279                            "`" "[^`]+" "`")
3280                    '(0 font-lock-string-face))
3281
3282              ;; Handle numbers too.
3283              ;;
3284              ;; The following isn't quite right, but it's close enough.
3285              (list (concat "\\<\\("
3286                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3287                            "[0-9]+\\(\\.[0-9]*\\)?"
3288                            "\\([eE][-+]?[0-9]+\\)?\\)")
3289                    '(0 mdw-number-face))
3290
3291              ;; And anything else is punctuation.
3292              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3293                    '(0 mdw-punct-face))))))
3294 (progn
3295   (add-hook 'go-mode-hook 'mdw-misc-mode-config t)
3296   (add-hook 'go-mode-hook 'mdw-fontify-go t))
3297
3298 ;;;--------------------------------------------------------------------------
3299 ;;; Rust programming configuration.
3300
3301 (setq-default rust-indent-offset 2)
3302
3303 (defun mdw-self-insert-and-indent (count)
3304   (interactive "p")
3305   (self-insert-command count)
3306   (indent-according-to-mode))
3307
3308 (defun mdw-fontify-rust ()
3309
3310   ;; Hack syntax categories.
3311   (modify-syntax-entry ?$ ".")
3312   (modify-syntax-entry ?% ".")
3313   (modify-syntax-entry ?= ".")
3314
3315   ;; Fontify keywords and things.
3316   (make-local-variable 'font-lock-keywords)
3317   (let ((rust-keywords
3318          (mdw-regexps "abstract" "alignof" "as" "async" "await"
3319                       "become" "box" "break"
3320                       "const" "continue" "crate"
3321                       "do" "dyn"
3322                       "else" "enum" "extern"
3323                       "final" "fn" "for"
3324                       "if" "impl" "in"
3325                       "let" "loop"
3326                       "macro" "match" "mod" "move" "mut"
3327                       "offsetof" "override"
3328                       "priv" "proc" "pub" "pure"
3329                       "ref" "return"
3330                       "sizeof" "static" "struct" "super"
3331                       "trait" "try" "type" "typeof"
3332                       "union" "unsafe" "unsized" "use"
3333                       "virtual"
3334                       "where" "while"
3335                       "yield"))
3336         (rust-builtins
3337          (mdw-regexps "array" "pointer" "slice" "tuple"
3338                       "bool" "true" "false"
3339                       "f32" "f64"
3340                       "i8" "i16" "i32" "i64" "isize"
3341                       "u8" "u16" "u32" "u64" "usize"
3342                       "char" "str"
3343                       "self" "Self")))
3344     (setq font-lock-keywords
3345             (list
3346
3347              ;; Handle the keywords defined above.
3348              (list (concat "\\_<\\(" rust-keywords "\\)\\_>")
3349                    '(0 font-lock-keyword-face))
3350              (list (concat "\\_<\\(" rust-builtins "\\)\\_>")
3351                    '(0 font-lock-variable-name-face))
3352
3353              ;; Handle numbers too.
3354              (list (concat "\\_<\\("
3355                                  "[0-9][0-9_]*"
3356                                  "\\(" "\\(\\.[0-9_]+\\)?[eE][-+]?[0-9_]+"
3357                                  "\\|" "\\.[0-9_]+"
3358                                  "\\)"
3359                                  "\\(f32\\|f64\\)?"
3360                            "\\|" "\\(" "[0-9][0-9_]*"
3361                                  "\\|" "0x[0-9a-fA-F_]+"
3362                                  "\\|" "0o[0-7_]+"
3363                                  "\\|" "0b[01_]+"
3364                                  "\\)"
3365                                  "\\([ui]\\(8\\|16\\|32\\|64\\|size\\)\\)?"
3366                            "\\)\\_>")
3367                    '(0 mdw-number-face))
3368
3369              ;; And anything else is punctuation.
3370              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3371                    '(0 mdw-punct-face)))
3372             font-lock-syntactic-face-function nil))
3373
3374   ;; Hack key bindings.
3375   (local-set-key [?{] 'mdw-self-insert-and-indent)
3376   (local-set-key [?}] 'mdw-self-insert-and-indent))
3377
3378 (progn
3379   (add-hook 'rust-mode-hook 'mdw-misc-mode-config t)
3380   (add-hook 'rust-mode-hook 'mdw-fontify-rust t))
3381
3382 ;;;--------------------------------------------------------------------------
3383 ;;; Awk programming configuration.
3384
3385 ;; Make Awk indentation nice.
3386
3387 (mdw-define-c-style mdw-awk ()
3388   (c-basic-offset . 2)
3389   (c-offsets-alist (substatement-open . 0)
3390                    (c-backslash-column . 72)
3391                    (statement-cont . 0)
3392                    (statement-case-intro . +)))
3393 (mdw-set-default-c-style 'awk-mode 'mdw-awk)
3394
3395 ;; Declare Awk fontification style.
3396
3397 (defun mdw-fontify-awk ()
3398
3399   ;; Miscellaneous fiddling.
3400   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3401
3402   ;; Now define things to be fontified.
3403   (make-local-variable 'font-lock-keywords)
3404   (let ((c-keywords
3405          (mdw-regexps "BEGIN" "END" "ARGC" "ARGIND" "ARGV" "CONVFMT"
3406                       "ENVIRON" "ERRNO" "FIELDWIDTHS" "FILENAME" "FNR"
3407                       "FS" "IGNORECASE" "NF" "NR" "OFMT" "OFS" "ORS" "RS"
3408                       "RSTART" "RLENGTH" "RT"   "SUBSEP"
3409                       "atan2" "break" "close" "continue" "cos" "delete"
3410                       "do" "else" "exit" "exp" "fflush" "file" "for" "func"
3411                       "function" "gensub" "getline" "gsub" "if" "in"
3412                       "index" "int" "length" "log" "match" "next" "rand"
3413                       "return" "print" "printf" "sin" "split" "sprintf"
3414                       "sqrt" "srand" "strftime" "sub" "substr" "system"
3415                       "systime" "tolower" "toupper" "while")))
3416
3417     (setq font-lock-keywords
3418             (list
3419
3420              ;; Handle the keywords defined above.
3421              (list (concat "\\<\\(" c-keywords "\\)\\>")
3422                    '(0 font-lock-keyword-face))
3423
3424              ;; Handle numbers too.
3425              ;;
3426              ;; The following isn't quite right, but it's close enough.
3427              (list (concat "\\<\\("
3428                            "0\\([xX][0-9a-fA-F]+\\|[0-7]+\\)\\|"
3429                            "[0-9]+\\(\\.[0-9]*\\)?"
3430                            "\\([eE][-+]?[0-9]+\\)?\\)"
3431                            "[uUlL]*")
3432                    '(0 mdw-number-face))
3433
3434              ;; And anything else is punctuation.
3435              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3436                    '(0 mdw-punct-face))))))
3437
3438 (progn
3439   (add-hook 'awk-mode-hook 'mdw-misc-mode-config t)
3440   (add-hook 'awk-mode-hook 'mdw-fontify-awk t))
3441
3442 ;;;--------------------------------------------------------------------------
3443 ;;; Perl programming style.
3444
3445 ;; Perl indentation style.
3446
3447 (setq-default perl-indent-level 2)
3448
3449 (setq-default cperl-indent-level 2
3450               cperl-continued-statement-offset 2
3451               cperl-indent-region-fix-constructs nil
3452               cperl-continued-brace-offset 0
3453               cperl-brace-offset -2
3454               cperl-brace-imaginary-offset 0
3455               cperl-label-offset 0)
3456
3457 ;; Define perl fontification style.
3458
3459 (defun mdw-fontify-perl ()
3460
3461   ;; Miscellaneous fiddling.
3462   (modify-syntax-entry ?$ "\\")
3463   (modify-syntax-entry ?$ "\\" font-lock-syntax-table)
3464   (modify-syntax-entry ?: "." font-lock-syntax-table)
3465   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3466   (setq auto-fill-function #'do-auto-fill)
3467
3468   ;; Now define fontification things.
3469   (make-local-variable 'font-lock-keywords)
3470   (let ((perl-keywords
3471          (mdw-regexps "and"
3472                       "break"
3473                       "cmp" "continue"
3474                       "default" "do"
3475                       "else" "elsif" "eq"
3476                       "for" "foreach"
3477                       "ge" "given" "gt" "goto"
3478                       "if"
3479                       "last" "le" "local" "lt"
3480                       "my"
3481                       "ne" "next"
3482                       "or" "our"
3483                       "package"
3484                       "redo" "require" "return"
3485                       "sub"
3486                       "undef" "unless" "until" "use"
3487                       "when" "while")))
3488
3489     (setq font-lock-keywords
3490             (list
3491
3492              ;; Set up the keywords defined above.
3493              (list (concat "\\<\\(" perl-keywords "\\)\\>")
3494                    '(0 font-lock-keyword-face))
3495
3496              ;; At least numbers are simpler than C.
3497              (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
3498                            "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
3499                            "\\([eE][-+]?[0-9_]+\\)?")
3500                    '(0 mdw-number-face))
3501
3502              ;; And anything else is punctuation.
3503              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3504                    '(0 mdw-punct-face))))))
3505
3506 (defun perl-number-tests (&optional arg)
3507   "Assign consecutive numbers to lines containing `#t'.  With ARG,
3508 strip numbers instead."
3509   (interactive "P")
3510   (save-excursion
3511     (goto-char (point-min))
3512     (let ((i 0) (fmt (if arg "" " %4d")))
3513       (while (search-forward "#t" nil t)
3514         (delete-region (point) (line-end-position))
3515         (setq i (1+ i))
3516         (insert (format fmt i)))
3517       (goto-char (point-min))
3518       (if (re-search-forward "\\(tests\\s-*=>\\s-*\\)\\w*" nil t)
3519           (replace-match (format "\\1%d" i))))))
3520
3521 (dolist (hook '(perl-mode-hook cperl-mode-hook))
3522   (add-hook hook 'mdw-misc-mode-config t)
3523   (add-hook hook 'mdw-fontify-perl t))
3524
3525 ;;;--------------------------------------------------------------------------
3526 ;;; Python programming style.
3527
3528 (setq-default py-indent-offset 2
3529               python-indent 2
3530               python-indent-offset 2
3531               python-fill-docstring-style 'symmetric)
3532
3533 (defun mdw-fontify-pythonic (keywords soft-keywords builtins)
3534
3535   ;; Miscellaneous fiddling.
3536   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3537   (setq indent-tabs-mode nil)
3538   (set (make-local-variable 'forward-sexp-function) nil)
3539
3540   ;; Now define fontification things.
3541   (make-local-variable 'font-lock-keywords)
3542   (setq font-lock-keywords
3543           (list
3544
3545            ;; Set up the keywords defined above.
3546            (list (concat "\\_<\\(" keywords "\\)\\_>")
3547                  '(0 font-lock-keyword-face))
3548            (list (concat "\\(^\\|[^.]\\)\\_<\\(" soft-keywords "\\)\\_>")
3549                  '(2 font-lock-keyword-face))
3550            (list (concat "\\(^\\|[^.]\\)\\_<\\(" builtins "\\)\\_>")
3551                  '(2 font-lock-variable-name-face))
3552            (list (concat "\\_<\\(__\\(\\sw+\\|\\s_+\\)+__\\)\\_>")
3553                  '(0 font-lock-variable-name-face))
3554
3555            ;; At least numbers are simpler than C.
3556            (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO]?[0-7]+\\|[bB][01]+\\)\\|"
3557                          "\\_<[0-9][0-9]*\\(\\.[0-9]*\\)?"
3558                          "\\([eE][-+]?[0-9]+\\|[lL]\\)?")
3559                  '(0 mdw-number-face))
3560
3561            ;; And anything else is punctuation.
3562            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3563                  '(0 mdw-punct-face)))))
3564
3565 ;; Define Python fontification styles.
3566
3567 (defun mdw-fontify-python ()
3568   (mdw-fontify-pythonic
3569    (mdw-regexps "and" "as" "assert" "async" "await"
3570                 "break"
3571                 "class" "continue"
3572                 "def" "del"
3573                 "elif" "else" "except" ;"exec"
3574                 "finally" "for" "from"
3575                 "global"
3576                 "if" "import" "in" "is"
3577                 "lambda"
3578                 "nonlocal"
3579                 "not"
3580                 "or"
3581                 "pass" ;"print"
3582                 "raise" "return"
3583                 "try" ;"type"
3584                 "while" "with"
3585                 "yield")
3586
3587    (mdw-regexps "case"
3588                 "match")
3589
3590    (mdw-regexps "Ellipsis"
3591                 "False"
3592                 "None" "NotImplemented"
3593                 "True"
3594                 "__debug__"
3595
3596                 "BaseException"
3597                   "BaseExceptionGroup"
3598                   "Exception"
3599                     "StandardError"
3600                       "ArithmeticError"
3601                         "FloatingPointError"
3602                         "OverflowError"
3603                         "ZeroDivisionError"
3604                       "AssertionError"
3605                       "AttributeError"
3606                       "BufferError"
3607                       "EnvironmentError"
3608                         "IOError"
3609                         "OSError"
3610                           "BlockingIOError"
3611                           "ChildProcessError"
3612                           "ConnectionError"
3613                             "BrokenPipeError"
3614                             "ConnectionAbortedError"
3615                             "ConnectionRefusedError"
3616                             "ConnectionResetError"
3617                           "FileExistsError"
3618                           "FileNotFoundError"
3619                           "InterruptedError"
3620                           "IsADirectoryError"
3621                           "NotADirectoryError"
3622                           "PermissionError"
3623                           "TimeoutError"
3624                       "EOFError"
3625                       "ExceptionGroup"
3626                       "ImportError"
3627                         "ModuleNotFoundError"
3628                       "LookupError"
3629                         "IndexError"
3630                         "KeyError"
3631                       "MemoryError"
3632                       "NameError"
3633                         "UnboundLocalError"
3634                       "ReferenceError"
3635                       "RuntimeError"
3636                         "NotImplementedError"
3637                         "RecursionError"
3638                       "SyntaxError"
3639                         "IndentationError"
3640                           "TabError"
3641                       "SystemError"
3642                       "TypeError"
3643                       "ValueError"
3644                         "UnicodeError"
3645                           "UnicodeDecodeError"
3646                           "UnicodeEncodeError"
3647                           "UnicodeTranslateError"
3648                     "StopIteration"
3649                     "Warning"
3650                       "BytesWarning"
3651                       "DeprecationWarning"
3652                       "EncodingWarning"
3653                       "FutureWarning"
3654                       "ImportWarning"
3655                       "PendingDeprecationWarning"
3656                       "ResourceWarning"
3657                       "RuntimeWarning"
3658                       "SyntaxWarning"
3659                       "UnicodeWarning"
3660                       "UserWarning"
3661                   "GeneratorExit"
3662                   "KeyboardInterrupt"
3663                   "SystemExit"
3664
3665                 "abs" "absolute_import" "aiter"
3666                   "all" "anext" "any" "apply" "ascii"
3667                 "basestring" "bin" "bool" "breakpoint"
3668                   "buffer" "bytearray" "bytes"
3669                 "callable" "coerce" "chr" "classmethod"
3670                   "cmp" "compile" "complex"
3671                 "delattr" "dict" "dir" "divmod"
3672                 "enumerate" "eval" "exec" "execfile"
3673                 "file" "filter" "float" "format" "frozenset"
3674                 "getattr" "globals"
3675                 "hasattr" "hash" "help" "hex"
3676                 "id" "input" "int" "intern"
3677                   "isinstance" "issubclass" "iter"
3678                 "len" "list" "locals" "long"
3679                 "map" "max" "memoryview" "min"
3680                 "next"
3681                 "object" "oct" "open" "ord"
3682                 "pow" "print" "property"
3683                 "range" "raw_input" "reduce" "reload"
3684                   "repr" "reversed" "round"
3685                 "set" "setattr" "slice" "sorted"
3686                   "staticmethod" "str" "sum" "super"
3687                 "tuple" "type"
3688                 "unichr" "unicode"
3689                 "vars"
3690                 "xrange"
3691                 "zip"
3692                 "__import__")))
3693
3694 (defun mdw-fontify-pyrex ()
3695   (mdw-fontify-pythonic
3696    (mdw-regexps "and" "as" "assert" "break" "cdef" "class" "continue"
3697                 "ctypedef" "def" "del" "elif" "else" "enum" "except" "exec"
3698                 "extern" "finally" "for" "from" "global" "if"
3699                 "import" "in" "is" "lambda" "not" "or" "pass" "print"
3700                 "property" "raise" "return" "struct" "try" "while" "with"
3701                 "yield")
3702    ""
3703    ""))
3704
3705 (define-derived-mode pyrex-mode python-mode "Pyrex"
3706   "Major mode for editing Pyrex source code")
3707 (setq auto-mode-alist
3708         (append '(("\\.pyx$" . pyrex-mode)
3709                   ("\\.pxd$" . pyrex-mode)
3710                   ("\\.pxi$" . pyrex-mode))
3711                 auto-mode-alist))
3712
3713 (progn
3714   (add-hook 'python-mode-hook 'mdw-misc-mode-config t)
3715   (add-hook 'python-mode-hook 'mdw-fontify-python t)
3716   (add-hook 'pyrex-mode-hook 'mdw-fontify-pyrex t))
3717
3718 ;;;--------------------------------------------------------------------------
3719 ;;; Lua programming style.
3720
3721 (setq-default lua-indent-level 2)
3722
3723 (defun mdw-fontify-lua ()
3724
3725   ;; Miscellaneous fiddling.
3726   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3727
3728   ;; Now define fontification things.
3729   (make-local-variable 'font-lock-keywords)
3730   (let ((lua-keywords
3731          (mdw-regexps "and" "break" "do" "else" "elseif" "end"
3732                       "false" "for" "function" "goto" "if" "in" "local"
3733                       "nil" "not" "or" "repeat" "return" "then" "true"
3734                       "until" "while")))
3735     (setq font-lock-keywords
3736             (list
3737
3738              ;; Set up the keywords defined above.
3739              (list (concat "\\_<\\(" lua-keywords "\\)\\_>")
3740                    '(0 font-lock-keyword-face))
3741
3742              ;; At least numbers are simpler than C.
3743              (list (concat "\\_<\\(" "0[xX]"
3744                                      "\\(" "[0-9a-fA-F]+"
3745                                            "\\(\\.[0-9a-fA-F]*\\)?"
3746                                      "\\|" "\\.[0-9a-fA-F]+"
3747                                      "\\)"
3748                                      "\\([pP][-+]?[0-9]+\\)?"
3749                                "\\|" "\\(" "[0-9]+"
3750                                            "\\(\\.[0-9]*\\)?"
3751                                      "\\|" "\\.[0-9]+"
3752                                      "\\)"
3753                                      "\\([eE][-+]?[0-9]+\\)?"
3754                                "\\)")
3755                    '(0 mdw-number-face))
3756
3757              ;; And anything else is punctuation.
3758              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3759                    '(0 mdw-punct-face))))))
3760
3761 (progn
3762   (add-hook 'lua-mode-hook 'mdw-misc-mode-config t)
3763   (add-hook 'lua-mode-hook 'mdw-fontify-lua t))
3764
3765 ;;;--------------------------------------------------------------------------
3766 ;;; Icon programming style.
3767
3768 ;; Icon indentation style.
3769
3770 (setq-default icon-brace-offset 0
3771               icon-continued-brace-offset 0
3772               icon-continued-statement-offset 2
3773               icon-indent-level 2)
3774
3775 ;; Define Icon fontification style.
3776
3777 (defun mdw-fontify-icon ()
3778
3779   ;; Miscellaneous fiddling.
3780   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
3781
3782   ;; Now define fontification things.
3783   (make-local-variable 'font-lock-keywords)
3784   (let ((icon-keywords
3785          (mdw-regexps "break" "by" "case" "create" "default" "do" "else"
3786                       "end" "every" "fail" "global" "if" "initial"
3787                       "invocable" "link" "local" "next" "not" "of"
3788                       "procedure" "record" "repeat" "return" "static"
3789                       "suspend" "then" "to" "until" "while"))
3790         (preprocessor-keywords
3791          (mdw-regexps "define" "else" "endif" "error" "ifdef" "ifndef"
3792                       "include" "line" "undef")))
3793     (setq font-lock-keywords
3794             (list
3795
3796              ;; Set up the keywords defined above.
3797              (list (concat "\\<\\(" icon-keywords "\\)\\>")
3798                    '(0 font-lock-keyword-face))
3799
3800              ;; The things that Icon calls keywords.
3801              (list "&\\sw+\\>" '(0 font-lock-variable-name-face))
3802
3803              ;; At least numbers are simpler than C.
3804              (list (concat "\\<[0-9]+"
3805                            "\\([rR][0-9a-zA-Z]+\\|"
3806                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\)\\>\\|"
3807                            "\\.[0-9]+\\([eE][+-]?[0-9]+\\)?\\>")
3808                    '(0 mdw-number-face))
3809
3810              ;; Preprocessor.
3811              (list (concat "^[ \t]*$[ \t]*\\<\\("
3812                            preprocessor-keywords
3813                            "\\)\\>")
3814                    '(0 font-lock-keyword-face))
3815
3816              ;; And anything else is punctuation.
3817              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
3818                    '(0 mdw-punct-face))))))
3819
3820 (progn
3821   (add-hook 'icon-mode-hook 'mdw-misc-mode-config t)
3822   (add-hook 'icon-mode-hook 'mdw-fontify-icon t))
3823
3824 ;;;--------------------------------------------------------------------------
3825 ;;; Fortran mode.
3826
3827 (defun mdw-fontify-fortran-common ()
3828   (let ((fortran-keywords
3829          (mdw-regexps "access"
3830                       "assign"
3831                       "associate"
3832                       "backspace"
3833                       "blank"
3834                       "block\\s-*data"
3835                       "call"
3836                       "case"
3837                       "character"
3838                       "class"
3839                       "close"
3840                       "common"
3841                       "complex"
3842                       "continue"
3843                       "critical"
3844                       "data"
3845                       "dimension"
3846                       "do"
3847                       "double\\s-*precision"
3848                       "else" "elseif" "elsewhere"
3849                       "end"
3850                         "endblock" "endblockdata"
3851                         "endcritical"
3852                         "enddo"
3853                         "endinterface"
3854                         "endmodule"
3855                         "endprocedure"
3856                         "endprogram"
3857                         "endselect"
3858                         "endsubmodule"
3859                         "endsubroutine"
3860                         "endtype"
3861                         "endwhere"
3862                         "endenum"
3863                         "end\\s-*file"
3864                         "endforall"
3865                         "endfunction"
3866                         "endif"
3867                       "entry"
3868                       "enum"
3869                       "equivalence"
3870                       "err"
3871                       "external"
3872                       "file"
3873                       "fmt"
3874                       "forall"
3875                       "form"
3876                       "format"
3877                       "function"
3878                       "go\\s-*to"
3879                       "if"
3880                       "implicit"
3881                       "in" "inout"
3882                       "inquire"
3883                       "include"
3884                       "integer"
3885                       "interface"
3886                       "intrinsic"
3887                       "iostat"
3888                       "len"
3889                       "logical"
3890                       "module"
3891                       "open"
3892                       "out"
3893                       "parameter"
3894                       "pause"
3895                       "procedure"
3896                       "program"
3897                       "precision"
3898                       "program"
3899                       "read"
3900                       "real"
3901                       "rec"
3902                       "recl"
3903                       "return"
3904                       "rewind"
3905                       "save"
3906                       "select" "selectcase" "selecttype"
3907                       "status"
3908                       "stop"
3909                       "submodule"
3910                       "subroutine"
3911                       "then"
3912                       "to"
3913                       "type"
3914                       "unit"
3915                       "where"
3916                       "write"))
3917         (fortran-operators (mdw-regexps "and"
3918                                         "eq"
3919                                         "eqv"
3920                                         "false"
3921                                         "ge"
3922                                         "gt"
3923                                         "le"
3924                                         "lt"
3925                                         "ne"
3926                                         "neqv"
3927                                         "not"
3928                                         "or"
3929                                         "true"))
3930         (fortran-intrinsics (mdw-regexps "abs" "dabs" "iabs" "cabs"
3931                                          "atan" "datan" "atan2" "datan2"
3932                                          "cmplx"
3933                                          "conjg"
3934                                          "cos" "dcos" "ccos"
3935                                          "dble"
3936                                          "dim" "idim"
3937                                          "exp" "dexp" "cexp"
3938                                          "float"
3939                                          "ifix"
3940                                          "aimag"
3941                                          "int" "aint" "idint"
3942                                          "alog" "dlog" "clog"
3943                                          "alog10" "dlog10"
3944                                          "max"
3945                                          "amax0" "amax1"
3946                                          "max0" "max1"
3947                                          "dmax1"
3948                                          "min"
3949                                          "amin0" "amin1"
3950                                          "min0" "min1"
3951                                          "dmin1"
3952                                          "mod" "amod" "dmod"
3953                                          "sin" "dsin" "csin"
3954                                          "sign" "isign" "dsign"
3955                                          "sngl"
3956                                          "sqrt" "dsqrt" "csqrt"
3957                                          "tanh"))
3958         (preprocessor-keywords
3959          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
3960                       "ident" "if" "ifdef" "ifndef" "import" "include"
3961                       "line" "pragma" "unassert" "undef" "warning")))
3962     (setq font-lock-keywords-case-fold-search t
3963             font-lock-keywords
3964             (list
3965
3966              ;; Fontify include files as strings.
3967              (list (concat "^[ \t]*\\#[ \t]*" "include"
3968                            "[ \t]*\\(<[^>]+>?\\)")
3969                    '(1 font-lock-string-face))
3970
3971              ;; Preprocessor directives are `references'?.
3972              (list (concat "^\\([ \t]*#[ \t]*\\(\\("
3973                            preprocessor-keywords
3974                            "\\)\\>\\|[0-9]+\\|$\\)\\)")
3975                    '(1 font-lock-keyword-face))
3976
3977              ;; Set up the keywords defined above.
3978              (list (concat "\\<\\(" fortran-keywords "\\)\\>")
3979                    '(0 font-lock-keyword-face))
3980
3981              ;; Set up the `.foo.' operators.
3982              (list (concat "\\.\\(" fortran-operators "\\)\\.")
3983                    '(0 font-lock-keyword-face))
3984
3985              ;; Set up the intrinsic functions.
3986              (list (concat "\\<\\(" fortran-intrinsics "\\)\\>")
3987                    '(0 font-lock-variable-name-face))
3988
3989              ;; Numbers.
3990              (list (concat       "\\(" "\\<" "[0-9]+" "\\(\\.[0-9]*\\)?"
3991                                  "\\|" "\\.[0-9]+"
3992                                  "\\)"
3993                                  "\\(" "[de]" "[+-]?" "[0-9]+" "\\)?"
3994                                  "\\(" "_" "\\sw+" "\\)?"
3995                            "\\|" "b'[01]*'" "\\|" "'[01]*'b"
3996                            "\\|" "b\"[01]*\"" "\\|" "\"[01]*\"b"
3997                            "\\|" "o'[0-7]*'" "\\|" "'[0-7]*'o"
3998                            "\\|" "o\"[0-7]*\"" "\\|" "\"[0-7]*\"o"
3999                            "\\|" "[xz]'[0-9a-f]*'" "\\|" "'[0-9a-f]*'[xz]"
4000                            "\\|" "[xz]\"[0-9a-f]*\"" "\\|" "\"[0-9a-f]*\"[xz]")
4001                    '(0 mdw-number-face))
4002
4003              ;; Any anything else is punctuation.
4004              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4005                    '(0 mdw-punct-face))))
4006
4007     (modify-syntax-entry ?/ "." font-lock-syntax-table)
4008     (modify-syntax-entry ?< ".")
4009     (modify-syntax-entry ?> ".")))
4010
4011 (defun mdw-fontify-fortran () (mdw-fontify-fortran-common))
4012 (defun mdw-fontify-f90 () (mdw-fontify-fortran-common))
4013
4014 (setq fortran-do-indent 2
4015       fortran-if-indent 2
4016       fortran-structure-indent 2
4017       fortran-comment-line-start "*"
4018       fortran-comment-indent-style 'relative
4019       fortran-continuation-string "&"
4020       fortran-continuation-indent 4)
4021
4022 (setq f90-do-indent 2
4023       f90-if-indent 2
4024       f90-program-indent 2
4025       f90-continuation-indent 4
4026       f90-smart-end-names nil
4027       f90-smart-end 'no-blink)
4028
4029 (progn
4030   (add-hook 'fortran-mode-hook 'mdw-misc-mode-config t)
4031   (add-hook 'fortran-mode-hook 'mdw-fontify-fortran t)
4032   (add-hook 'f90-mode-hook 'mdw-misc-mode-config t)
4033   (add-hook 'f90-mode-hook 'mdw-fontify-f90 t))
4034
4035 ;;;--------------------------------------------------------------------------
4036 ;;; Assembler mode.
4037
4038 (defun mdw-fontify-asm ()
4039   (modify-syntax-entry ?' "\"")
4040   (modify-syntax-entry ?. "w")
4041   (modify-syntax-entry ?\n ">")
4042   (setf fill-prefix nil)
4043   (modify-syntax-entry ?. "_")
4044   (modify-syntax-entry ?* ". 23")
4045   (modify-syntax-entry ?/ ". 124b")
4046   (modify-syntax-entry ?\n "> b")
4047   (local-set-key ";" 'self-insert-command)
4048   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)"))
4049
4050 (defun mdw-asm-set-comment ()
4051   (modify-syntax-entry ?; "."
4052                        )
4053   (modify-syntax-entry asm-comment-char "< b")
4054   (setq comment-start (string asm-comment-char ? )))
4055 (add-hook 'asm-mode-local-variables-hook 'mdw-asm-set-comment)
4056 (put 'asm-comment-char 'safe-local-variable 'characterp)
4057
4058 (progn
4059   (add-hook 'asm-mode-hook 'mdw-misc-mode-config t)
4060   (add-hook 'asm-mode-hook 'mdw-fontify-asm t))
4061
4062 ;;;--------------------------------------------------------------------------
4063 ;;; TCL configuration.
4064
4065 (setq-default tcl-indent-level 2)
4066
4067 (defun mdw-fontify-tcl ()
4068   (dolist (ch '(?$))
4069     (modify-syntax-entry ch "."))
4070   (mdw-standard-fill-prefix "\\([ \t]*#+[ \t]*\\)")
4071   (make-local-variable 'font-lock-keywords)
4072   (setq font-lock-keywords
4073           (list
4074            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
4075                          "\\<[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
4076                          "\\([eE][-+]?[0-9_]+\\)?")
4077                  '(0 mdw-number-face))
4078            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4079                  '(0 mdw-punct-face)))))
4080
4081 (progn
4082   (add-hook 'tcl-mode-hook 'mdw-misc-mode-config t)
4083   (add-hook 'tcl-mode-hook 'mdw-fontify-tcl t))
4084
4085 ;;;--------------------------------------------------------------------------
4086 ;;; Dylan programming configuration.
4087
4088 (defun mdw-fontify-dylan ()
4089
4090   (make-local-variable 'font-lock-keywords)
4091
4092   ;; Horrors.  `dylan-mode' sets the `major-mode' name after calling this
4093   ;; hook, which undoes all of our configuration.
4094   (setq major-mode 'dylan-mode)
4095   (font-lock-set-defaults)
4096
4097   (let* ((word "[-_a-zA-Z!*@<>$%]+")
4098          (dylan-keywords (mdw-regexps
4099
4100                           "C-address" "C-callable-wrapper" "C-function"
4101                           "C-mapped-subtype" "C-pointer-type" "C-struct"
4102                           "C-subtype" "C-union" "C-variable"
4103
4104                           "above" "abstract" "afterwards" "all"
4105                           "begin" "below" "block" "by"
4106                           "case" "class" "cleanup" "constant" "create"
4107                           "define" "domain"
4108                           "else" "elseif" "end" "exception" "export"
4109                           "finally" "for" "from" "function"
4110                           "generic"
4111                           "handler"
4112                           "if" "in" "instance" "interface" "iterate"
4113                           "keyed-by"
4114                           "let" "library" "local"
4115                           "macro" "method" "module"
4116                           "otherwise"
4117                           "profiling"
4118                           "select" "slot" "subclass"
4119                           "table" "then" "to"
4120                           "unless" "until" "use"
4121                           "variable" "virtual"
4122                           "when" "while"))
4123          (sharp-keywords (mdw-regexps
4124                           "all-keys" "key" "next" "rest" "include"
4125                           "t" "f")))
4126     (setq font-lock-keywords
4127             (list (list (concat "\\<\\(" dylan-keywords
4128                                 "\\|" "with\\(out\\)?-" word
4129                                 "\\)\\>")
4130                         '(0 font-lock-keyword-face))
4131                   (list (concat "\\<" word ":" "\\|"
4132                                 "#\\(" sharp-keywords "\\)\\>")
4133                         '(0 font-lock-variable-name-face))
4134                   (list (concat "\\("
4135                                 "\\([-+]\\|\\<\\)[0-9]+" "\\("
4136                                   "\\(\\.[0-9]+\\)?" "\\([eE][-+][0-9]+\\)?"
4137                                   "\\|" "/[0-9]+"
4138                                 "\\)"
4139                                 "\\|" "\\.[0-9]+" "\\([eE][-+][0-9]+\\)?"
4140                                 "\\|" "#b[01]+"
4141                                 "\\|" "#o[0-7]+"
4142                                 "\\|" "#x[0-9a-zA-Z]+"
4143                                 "\\)\\>")
4144                         '(0 mdw-number-face))
4145                   (list (concat "\\("
4146                                 "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\|"
4147                                 "\\_<[-+*/=<>:&|]+\\_>"
4148                                 "\\)")
4149                         '(0 mdw-punct-face))))))
4150
4151 (progn
4152   (add-hook 'dylan-mode-hook 'mdw-misc-mode-config t)
4153   (add-hook 'dylan-mode-hook 'mdw-fontify-dylan t))
4154
4155 ;;;--------------------------------------------------------------------------
4156 ;;; Algol 68 configuration.
4157
4158 (setq-default a68-indent-step 2)
4159
4160 (defun mdw-fontify-algol-68 ()
4161
4162   ;; Fix up the syntax table.
4163   (modify-syntax-entry ?# "!" a68-mode-syntax-table)
4164   (dolist (ch '(?- ?+ ?= ?< ?> ?* ?/ ?| ?&))
4165     (modify-syntax-entry ch "." a68-mode-syntax-table))
4166
4167   (make-local-variable 'font-lock-keywords)
4168
4169   (let ((not-comment
4170          (let ((word "COMMENT"))
4171            (cl-do ((regexp (concat "[^" (substring word 0 1) "]+")
4172                            (concat regexp "\\|"
4173                                    (substring word 0 i)
4174                                    "[^" (substring word i (1+ i)) "]"))
4175                    (i 1 (1+ i)))
4176                ((>= i (length word)) regexp)))))
4177     (setq font-lock-keywords
4178             (list (list (concat "\\<COMMENT\\>"
4179                                 "\\(" not-comment "\\)\\{0,5\\}"
4180                                 "\\(\\'\\|\\<COMMENT\\>\\)")
4181                         '(0 font-lock-comment-face))
4182                   (list (concat "\\<CO\\>"
4183                                 "\\([^C]+\\|C[^O]\\)\\{0,5\\}"
4184                                 "\\($\\|\\<CO\\>\\)")
4185                         '(0 font-lock-comment-face))
4186                   (list "\\<[A-Z_]+\\>"
4187                         '(0 font-lock-keyword-face))
4188                   (list (concat "\\<"
4189                                 "[0-9]+"
4190                                 "\\(\\.[0-9]+\\)?"
4191                                 "\\([eE][-+]?[0-9]+\\)?"
4192                                 "\\>")
4193                         '(0 mdw-number-face))
4194                   (list "\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/"
4195                         '(0 mdw-punct-face))))))
4196
4197 (dolist (hook '(a68-mode-hook a68-mode-hooks))
4198   (add-hook hook 'mdw-misc-mode-config t)
4199   (add-hook hook 'mdw-fontify-algol-68 t))
4200
4201 ;;;--------------------------------------------------------------------------
4202 ;;; REXX configuration.
4203
4204 (defun mdw-rexx-electric-* ()
4205   (interactive)
4206   (insert ?*)
4207   (rexx-indent-line))
4208
4209 (defun mdw-rexx-indent-newline-indent ()
4210   (interactive)
4211   (rexx-indent-line)
4212   (if abbrev-mode (expand-abbrev))
4213   (newline-and-indent))
4214
4215 (defun mdw-fontify-rexx ()
4216
4217   ;; Various bits of fiddling.
4218   (setq mdw-auto-indent nil)
4219   (local-set-key [?\C-m] 'mdw-rexx-indent-newline-indent)
4220   (local-set-key [?*] 'mdw-rexx-electric-*)
4221   (dolist (ch '(?! ?? ?# ?@ ?$)) (modify-syntax-entry ch "w"))
4222   (dolist (ch '(?¬)) (modify-syntax-entry ch "."))
4223   (mdw-standard-fill-prefix "\\([ \t]*/?\*[ \t]*\\)")
4224
4225   ;; Set up keywords and things for fontification.
4226   (make-local-variable 'font-lock-keywords-case-fold-search)
4227   (setq font-lock-keywords-case-fold-search t)
4228
4229   (setq rexx-indent 2)
4230   (setq rexx-end-indent rexx-indent)
4231   (setq rexx-cont-indent rexx-indent)
4232
4233   (make-local-variable 'font-lock-keywords)
4234   (let ((rexx-keywords
4235          (mdw-regexps "address" "arg" "by" "call" "digits" "do" "drop"
4236                       "else" "end" "engineering" "exit" "expose" "for"
4237                       "forever" "form" "fuzz" "if" "interpret" "iterate"
4238                       "leave" "linein" "name" "nop" "numeric" "off" "on"
4239                       "options" "otherwise" "parse" "procedure" "pull"
4240                       "push" "queue" "return" "say" "select" "signal"
4241                       "scientific" "source" "then" "trace" "to" "until"
4242                       "upper" "value" "var" "version" "when" "while"
4243                       "with"
4244
4245                       "abbrev" "abs" "bitand" "bitor" "bitxor" "b2x"
4246                       "center" "center" "charin" "charout" "chars"
4247                       "compare" "condition" "copies" "c2d" "c2x"
4248                       "datatype" "date" "delstr" "delword" "d2c" "d2x"
4249                       "errortext" "format" "fuzz" "insert" "lastpos"
4250                       "left" "length" "lineout" "lines" "max" "min"
4251                       "overlay" "pos" "queued" "random" "reverse" "right"
4252                       "sign" "sourceline" "space" "stream" "strip"
4253                       "substr" "subword" "symbol" "time" "translate"
4254                       "trunc" "value" "verify" "word" "wordindex"
4255                       "wordlength" "wordpos" "words" "xrange" "x2b" "x2c"
4256                       "x2d")))
4257
4258     (setq font-lock-keywords
4259             (list
4260
4261              ;; Set up the keywords defined above.
4262              (list (concat "\\<\\(" rexx-keywords "\\)\\>")
4263                    '(0 font-lock-keyword-face))
4264
4265              ;; Fontify all symbols the same way.
4266              (list (concat "\\<\\([0-9.][A-Za-z0-9.!?_#@$]*[Ee][+-]?[0-9]+\\|"
4267                            "[A-Za-z0-9.!?_#@$]+\\)")
4268                    '(0 font-lock-variable-name-face))
4269
4270              ;; And everything else is punctuation.
4271              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4272                    '(0 mdw-punct-face))))))
4273
4274 (progn
4275   (add-hook 'rexx-mode-hook 'mdw-misc-mode-config t)
4276   (add-hook 'rexx-mode-hook 'mdw-fontify-rexx t))
4277
4278 ;;;--------------------------------------------------------------------------
4279 ;;; Standard ML programming style.
4280
4281 (setq-default sml-nested-if-indent t
4282               sml-case-indent nil
4283               sml-indent-level 4
4284               sml-type-of-indent nil)
4285
4286 (defun mdw-fontify-sml ()
4287
4288   ;; Make underscore an honorary letter.
4289   (modify-syntax-entry ?' "w")
4290
4291   ;; Set fill prefix.
4292   (mdw-standard-fill-prefix "\\([ \t]*(\*[ \t]*\\)")
4293
4294   ;; Now define fontification things.
4295   (make-local-variable 'font-lock-keywords)
4296   (let ((sml-keywords
4297          (mdw-regexps "abstype" "and" "andalso" "as"
4298                       "case"
4299                       "datatype" "do"
4300                       "else" "end" "eqtype" "exception"
4301                       "fn" "fun" "functor"
4302                       "handle"
4303                       "if" "in" "include" "infix" "infixr"
4304                       "let" "local"
4305                       "nonfix"
4306                       "of" "op" "open" "orelse"
4307                       "raise" "rec"
4308                       "sharing" "sig" "signature" "struct" "structure"
4309                       "then" "type"
4310                       "val"
4311                       "where" "while" "with" "withtype")))
4312
4313     (setq font-lock-keywords
4314             (list
4315
4316              ;; Set up the keywords defined above.
4317              (list (concat "\\<\\(" sml-keywords "\\)\\>")
4318                    '(0 font-lock-keyword-face))
4319
4320              ;; At least numbers are simpler than C.
4321              (list (concat "\\<\\~?"
4322                               "\\(0\\([wW]?[xX][0-9a-fA-F]+\\|"
4323                                      "[wW][0-9]+\\)\\|"
4324                                   "\\([0-9]+\\(\\.[0-9]+\\)?"
4325                                            "\\([eE]\\~?"
4326                                                   "[0-9]+\\)?\\)\\)")
4327                    '(0 mdw-number-face))
4328
4329              ;; And anything else is punctuation.
4330              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4331                    '(0 mdw-punct-face))))))
4332
4333 (progn
4334   (add-hook 'sml-mode-hook 'mdw-misc-mode-config t)
4335   (add-hook 'sml-mode-hook 'mdw-fontify-sml t))
4336
4337 ;;;--------------------------------------------------------------------------
4338 ;;; Haskell configuration.
4339
4340 (setq-default haskell-indent-offset 2)
4341 (setq haskell-doc-prettify-types nil
4342       haskell-interactive-popup-errors nil)
4343
4344 (defun mdw-fontify-haskell ()
4345
4346   ;; Fiddle with syntax table to get comments right.
4347   (modify-syntax-entry ?' "_")
4348   (modify-syntax-entry ?- ". 12")
4349   (modify-syntax-entry ?\n ">")
4350
4351   ;; Make punctuation be punctuation
4352   (let ((punct "=<>+-*/|&%!@?$.^:#`"))
4353     (cl-do ((i 0 (1+ i)))
4354         ((>= i (length punct)))
4355       (modify-syntax-entry (aref punct i) ".")))
4356
4357   ;; Set fill prefix.
4358   (mdw-standard-fill-prefix "\\([ \t]*{?--?[ \t]*\\)")
4359
4360   ;; Fiddle with fontification.
4361   (make-local-variable 'font-lock-keywords)
4362   (let ((haskell-keywords
4363          (mdw-regexps "as"
4364                       "case" "ccall" "class"
4365                       "data" "default" "deriving" "do"
4366                       "else" "exists"
4367                       "forall" "foreign"
4368                       "hiding"
4369                       "if" "import" "in" "infix" "infixl" "infixr" "instance"
4370                       "let"
4371                       "mdo" "module"
4372                       "newtype"
4373                       "of"
4374                       "proc"
4375                       "qualified"
4376                       "rec"
4377                       "safe" "stdcall"
4378                       "then" "type"
4379                       "unsafe"
4380                       "where"))
4381         (control-sequences
4382          (mdw-regexps "ACK" "BEL" "BS" "CAN" "CR" "DC1" "DC2" "DC3" "DC4"
4383                       "DEL" "DLE" "EM" "ENQ" "EOT" "ESC" "ETB" "ETX" "FF"
4384                       "FS" "GS" "HT" "LF" "NAK" "NUL" "RS" "SI" "SO" "SOH"
4385                       "SP" "STX" "SUB" "SYN" "US" "VT")))
4386
4387     (setq font-lock-keywords
4388             (list
4389              (list (concat "{-" "[^-]*" "\\(-+[^-}][^-]*\\)*"
4390                                 "\\(-+}\\|-*\\'\\)"
4391                            "\\|"
4392                            "--.*$")
4393                    '(0 font-lock-comment-face))
4394              (list (concat "\\_<\\(" haskell-keywords "\\)\\_>")
4395                    '(0 font-lock-keyword-face))
4396              (list (concat "'\\("
4397                            "[^\\]"
4398                            "\\|"
4399                            "\\\\"
4400                            "\\(" "[abfnrtv\\\"']" "\\|"
4401                                  "^" "\\(" control-sequences "\\|"
4402                                            "[]A-Z@[\\^_]" "\\)" "\\|"
4403                                  "\\|"
4404                                  "[0-9]+" "\\|"
4405                                  "[oO][0-7]+" "\\|"
4406                                  "[xX][0-9A-Fa-f]+"
4407                            "\\)"
4408                            "\\)'")
4409                    '(0 font-lock-string-face))
4410              (list "\\_<[A-Z]\\(\\sw+\\|\\s_+\\)*\\_>"
4411                    '(0 font-lock-variable-name-face))
4412              (list (concat "\\_<0\\([xX][0-9a-fA-F]+\\|[oO][0-7]+\\)\\|"
4413                            "\\_<[0-9]+\\(\\.[0-9]*\\)?"
4414                            "\\([eE][-+]?[0-9]+\\)?")
4415                    '(0 mdw-number-face))
4416              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4417                    '(0 mdw-punct-face))))))
4418
4419 (progn
4420   (add-hook 'haskell-mode-hook 'mdw-misc-mode-config t)
4421   (add-hook 'haskell-mode-hook 'mdw-fontify-haskell t))
4422
4423 ;;;--------------------------------------------------------------------------
4424 ;;; Erlang configuration.
4425
4426 (setq-default erlang-electric-commands nil)
4427
4428 (defun mdw-fontify-erlang ()
4429
4430   ;; Set fill prefix.
4431   (mdw-standard-fill-prefix "\\([ \t]*{?%*[ \t]*\\)")
4432
4433   ;; Fiddle with fontification.
4434   (make-local-variable 'font-lock-keywords)
4435   (let ((erlang-keywords
4436          (mdw-regexps "after" "and" "andalso"
4437                       "band" "begin" "bnot" "bor" "bsl" "bsr" "bxor"
4438                       "case" "catch" "cond"
4439                       "div" "end" "fun" "if" "let" "not"
4440                       "of" "or" "orelse"
4441                       "query" "receive" "rem" "try" "when" "xor")))
4442
4443     (setq font-lock-keywords
4444             (list
4445              (list "%.*$"
4446                    '(0 font-lock-comment-face))
4447              (list (concat "\\<\\(" erlang-keywords "\\)\\>")
4448                    '(0 font-lock-keyword-face))
4449              (list (concat "^-\\sw+\\>")
4450                    '(0 font-lock-keyword-face))
4451              (list "\\<[0-9]+\\(#[0-9a-zA-Z]+\\|[eE][+-]?[0-9]+\\)?\\>"
4452                    '(0 mdw-number-face))
4453              (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4454                    '(0 mdw-punct-face))))))
4455
4456 (progn
4457   (add-hook 'erlang-mode-hook 'mdw-misc-mode-config t)
4458   (add-hook 'erlang-mode-hook 'mdw-fontify-erlang t))
4459
4460 ;;;--------------------------------------------------------------------------
4461 ;;; Texinfo configuration.
4462
4463 (defun mdw-fontify-texinfo ()
4464
4465   ;; Set fill prefix.
4466   (mdw-standard-fill-prefix "\\([ \t]*@c[ \t]+\\)")
4467
4468   ;; Real fontification things.
4469   (make-local-variable 'font-lock-keywords)
4470   (setq font-lock-keywords
4471           (list
4472
4473            ;; Environment names are keywords.
4474            (list "@\\(end\\)  *\\([a-zA-Z]*\\)?"
4475                  '(2 font-lock-keyword-face))
4476
4477            ;; Unmark escaped magic characters.
4478            (list "\\(@\\)\\([@{}]\\)"
4479                  '(1 font-lock-keyword-face)
4480                  '(2 font-lock-variable-name-face))
4481
4482            ;; Make sure we get comments properly.
4483            (list "@c\\(omment\\)?\\( .*\\)?$"
4484                  '(0 font-lock-comment-face))
4485
4486            ;; Command names are keywords.
4487            (list "@\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4488                  '(0 font-lock-keyword-face))
4489
4490            ;; Fontify TeX special characters as punctuation.
4491            (list "[{}]+"
4492                  '(0 mdw-punct-face)))))
4493
4494 (dolist (hook '(texinfo-mode-hook TeXinfo-mode-hook))
4495   (add-hook hook 'mdw-misc-mode-config t)
4496   (add-hook hook 'mdw-fontify-texinfo t))
4497
4498 ;;;--------------------------------------------------------------------------
4499 ;;; TeX and LaTeX configuration.
4500
4501 (setq-default LaTeX-table-label "tbl:"
4502               TeX-auto-untabify nil
4503               LaTeX-syntactic-comments nil
4504               LaTeX-fill-break-at-separators '(\\\[))
4505
4506 (defun mdw-fontify-tex ()
4507   (setq ispell-parser 'tex)
4508   (turn-on-reftex)
4509
4510   ;; Don't make maths into a string.
4511   (modify-syntax-entry ?$ ".")
4512   (modify-syntax-entry ?$ "." font-lock-syntax-table)
4513   (local-set-key [?$] 'self-insert-command)
4514
4515   ;; Make `tab' be useful, given that tab stops in TeX don't work well.
4516   (local-set-key "\C-\M-i" 'indent-relative)
4517   (setq indent-tabs-mode nil)
4518
4519   ;; Set fill prefix.
4520   (mdw-standard-fill-prefix "\\([ \t]*%+[ \t]*\\)")
4521
4522   ;; Real fontification things.
4523   (make-local-variable 'font-lock-keywords)
4524   (setq font-lock-keywords
4525           (list
4526
4527            ;; Environment names are keywords.
4528            (list (concat "\\\\\\(begin\\|end\\|newenvironment\\)"
4529                          "{\\([^}\n]*\\)}")
4530                  '(2 font-lock-keyword-face))
4531
4532            ;; Suspended environment names are keywords too.
4533            (list (concat "\\\\\\(suspend\\|resume\\)\\(\\[[^]]*\\]\\)?"
4534                          "{\\([^}\n]*\\)}")
4535                  '(3 font-lock-keyword-face))
4536
4537            ;; Command names are keywords.
4538            (list "\\\\\\([^a-zA-Z@]\\|[a-zA-Z@]*\\)"
4539                  '(0 font-lock-keyword-face))
4540
4541            ;; Handle @/.../ for italics.
4542            ;; (list "\\(@/\\)\\([^/]*\\)\\(/\\)"
4543            ;;     '(1 font-lock-keyword-face)
4544            ;;     '(3 font-lock-keyword-face))
4545
4546            ;; Handle @*...* for boldness.
4547            ;; (list "\\(@\\*\\)\\([^*]*\\)\\(\\*\\)"
4548            ;;     '(1 font-lock-keyword-face)
4549            ;;     '(3 font-lock-keyword-face))
4550
4551            ;; Handle @`...' for literal syntax things.
4552            ;; (list "\\(@`\\)\\([^']*\\)\\('\\)"
4553            ;;     '(1 font-lock-keyword-face)
4554            ;;     '(3 font-lock-keyword-face))
4555
4556            ;; Handle @<...> for nonterminals.
4557            ;; (list "\\(@<\\)\\([^>]*\\)\\(>\\)"
4558            ;;     '(1 font-lock-keyword-face)
4559            ;;     '(3 font-lock-keyword-face))
4560
4561            ;; Handle other @-commands.
4562            ;; (list "@\\([^a-zA-Z]\\|[a-zA-Z]*\\)"
4563            ;;     '(0 font-lock-keyword-face))
4564
4565            ;; Make sure we get comments properly.
4566            (list "%.*"
4567                  '(0 font-lock-comment-face))
4568
4569            ;; Fontify TeX special characters as punctuation.
4570            (list "[$^_{}#&]"
4571                  '(0 mdw-punct-face)))))
4572
4573 (setq TeX-install-font-lock 'tex-font-setup)
4574
4575 (eval-after-load 'font-latex
4576   '(defun font-latex-jit-lock-force-redisplay (buf start end)
4577      "Compatibility for Emacsen not offering `jit-lock-force-redisplay'."
4578      ;; The following block is an expansion of `jit-lock-force-redisplay'
4579      ;; and involved macros taken from CVS Emacs on 2007-04-28.
4580      (with-current-buffer buf
4581        (let ((modified (buffer-modified-p)))
4582          (unwind-protect
4583              (let ((buffer-undo-list t)
4584                    (inhibit-read-only t)
4585                    (inhibit-point-motion-hooks t)
4586                    (inhibit-modification-hooks t)
4587                    deactivate-mark
4588                    buffer-file-name
4589                    buffer-file-truename)
4590                (put-text-property start end 'fontified t))
4591            (unless modified
4592              (restore-buffer-modified-p nil)))))))
4593
4594 (setq TeX-output-view-style
4595         '(("^dvi$"
4596            ("^landscape$" "^pstricks$\\|^pst-\\|^psfrag$")
4597            "%(o?)dvips -t landscape %d -o && xdg-open %f")
4598           ("^dvi$" "^pstricks$\\|^pst-\\|^psfrag$"
4599            "%(o?)dvips %d -o && xdg-open %f")
4600           ("^dvi$"
4601            ("^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$" "^landscape$")
4602            "%(o?)xdvi %dS -paper a4r -s 0 %d")
4603           ("^dvi$" "^a4\\(?:dutch\\|paper\\|wide\\)\\|sem-a4$"
4604            "%(o?)xdvi %dS -paper a4 %d")
4605           ("^dvi$"
4606            ("^a5\\(?:comb\\|paper\\)$" "^landscape$")
4607            "%(o?)xdvi %dS -paper a5r -s 0 %d")
4608           ("^dvi$" "^a5\\(?:comb\\|paper\\)$" "%(o?)xdvi %dS -paper a5 %d")
4609           ("^dvi$" "^b5paper$" "%(o?)xdvi %dS -paper b5 %d")
4610           ("^dvi$" "^letterpaper$" "%(o?)xdvi %dS -paper us %d")
4611           ("^dvi$" "^legalpaper$" "%(o?)xdvi %dS -paper legal %d")
4612           ("^dvi$" "^executivepaper$" "%(o?)xdvi %dS -paper 7.25x10.5in %d")
4613           ("^dvi$" "." "%(o?)xdvi %dS %d")
4614           ("^pdf$" "." "xdg-open %o")
4615           ("^html?$" "." "sensible-browser %o")))
4616
4617 (setq TeX-view-program-list
4618         '(("mupdf" ("mupdf %o" (mode-io-correlate " %(outpage)")))))
4619
4620 (setq TeX-view-program-selection
4621         '(((output-dvi style-pstricks) "dvips and gv")
4622           (output-dvi "xdvi")
4623           (output-pdf "mupdf")
4624           (output-html "sensible-browser")))
4625
4626 (setq TeX-open-quote "\""
4627       TeX-close-quote "\"")
4628
4629 (setq reftex-use-external-file-finders t
4630       reftex-auto-recenter-toc t)
4631
4632 (setq reftex-label-alist
4633         '(("theorem" ?T "th:" "~\\ref{%s}" t ("theorems?" "th\\.") -2)
4634           ("axiom" ?A "ax:" "~\\ref{%s}" t ("axioms?" "ax\\.") -2)
4635           ("definition" ?D "def:" "~\\ref{%s}" t ("definitions?" "def\\.") -2)
4636           ("proposition" ?P "prop:" "~\\ref{%s}" t
4637            ("propositions?" "prop\\.") -2)
4638           ("lemma" ?L "lem:" "~\\ref{%s}" t ("lemmas?" "lem\\.") -2)
4639           ("example" ?X "eg:" "~\\ref{%s}" t ("examples?") -2)
4640           ("exercise" ?E "ex:" "~\\ref{%s}" t ("exercises?" "ex\\.") -2)
4641           ("enumerate" ?i "i:" "~\\ref{%s}" item ("items?"))))
4642 (setq reftex-section-prefixes
4643         '((0 . "part:")
4644           (1 . "ch:")
4645           (t . "sec:")))
4646
4647 (setq bibtex-field-delimiters 'double-quotes
4648       bibtex-align-at-equal-sign t
4649       bibtex-entry-format '(realign opts-or-alts required-fields
4650                             numerical-fields last-comma delimiters
4651                             unify-case sort-fields braces)
4652       bibtex-sort-ignore-string-entries nil
4653       bibtex-maintain-sorted-entries 'entry-class
4654       bibtex-include-OPTkey t
4655       bibtex-autokey-names-stretch 1
4656       bibtex-autokey-expand-strings t
4657       bibtex-autokey-name-separator "-"
4658       bibtex-autokey-year-length 4
4659       bibtex-autokey-titleword-separator "-"
4660       bibtex-autokey-name-year-separator "-"
4661       bibtex-autokey-year-title-separator ":")
4662
4663 (progn
4664   (dolist (hook '(tex-mode-hook latex-mode-hook
4665                                 TeX-mode-hook LaTeX-mode-hook))
4666     (add-hook hook 'mdw-misc-mode-config t)
4667     (add-hook hook 'mdw-fontify-tex t))
4668   (add-hook 'bibtex-mode-hook (lambda () (setq fill-column 76))))
4669
4670 ;;;--------------------------------------------------------------------------
4671 ;;; HTML, CSS, and other web foolishness.
4672
4673 (setq-default css-indent-offset 8)
4674
4675 ;;;--------------------------------------------------------------------------
4676 ;;; SGML hacking.
4677
4678 (setq-default psgml-html-build-new-buffer nil)
4679
4680 (defun mdw-sgml-mode ()
4681   (interactive)
4682   (sgml-mode)
4683   (mdw-standard-fill-prefix "")
4684   (make-local-variable 'sgml-delimiters)
4685   (setq sgml-delimiters
4686           '("AND" "&" "COM" "--" "CRO" "&#" "DSC" "]" "DSO" "[" "DTGC" "]"
4687             "DTGO" "[" "ERO" "&" "ETAGO" ":e" "GRPC" ")" "GRPO" "(" "LIT"
4688             "\"" "LITA" "'" "MDC" ">" "MDO" "<!" "MINUS" "-" "MSC" "]]"
4689             "NESTC" "{" "NET" "}" "OPT" "?" "OR" "|" "PERO" "%" "PIC" ">"
4690             "PIO" "<?" "PLUS" "+" "REFC" "." "REP" "*" "RNI" "#" "SEQ" ","
4691             "STAGO" ":" "TAGC" "." "VI" "=" "MS-START" "<![" "MS-END" "]]>"
4692             "XML-ECOM" "-->" "XML-PIC" "?>" "XML-SCOM" "<!--" "XML-TAGCE"
4693             "/>" "NULL" ""))
4694   (setq major-mode 'mdw-sgml-mode)
4695   (setq mode-name "[mdw] SGML")
4696   (run-hooks 'mdw-sgml-mode-hook))
4697
4698 ;;;--------------------------------------------------------------------------
4699 ;;; Configuration files.
4700
4701 (defcustom mdw-conf-quote-normal nil
4702   "Control syntax category of quote characters `\"' and `''.
4703 If this is `t', consider quote characters to be normal
4704 punctuation, as for `conf-quote-normal'.  If this is `nil' then
4705 leave quote characters as quotes.  If this is a list, then
4706 consider the quote characters in the list to be normal
4707 punctuation.  If this is a single quote character, then consider
4708 that character only to be normal punctuation."
4709   :type '(choice boolean character (repeat character))
4710   :safe 'mdw-conf-quote-normal-acceptable-value-p)
4711 (defun mdw-conf-quote-normal-acceptable-value-p (value)
4712   "Is the VALUE is an acceptable value for `mdw-conf-quote-normal'?"
4713   (or (booleanp value)
4714       (cl-every (lambda (v) (memq v '(?\" ?')))
4715                 (if (listp value) value (list value)))))
4716
4717 (defun mdw-fix-up-quote ()
4718   "Apply the setting of `mdw-conf-quote-normal'."
4719   (let ((flag mdw-conf-quote-normal))
4720     (cond ((eq flag t)
4721            (conf-quote-normal t))
4722           ((not flag)
4723            nil)
4724           (t
4725            (let ((table (copy-syntax-table (syntax-table))))
4726              (dolist (ch (if (listp flag) flag (list flag)))
4727                (modify-syntax-entry ch "." table))
4728              (set-syntax-table table)
4729              (and font-lock-mode (font-lock-fontify-buffer)))))))
4730
4731 (progn
4732   (add-hook 'conf-mode-hook 'mdw-misc-mode-config t)
4733   (add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t))
4734
4735 ;;;--------------------------------------------------------------------------
4736 ;;; Shell scripts.
4737
4738 (defun mdw-setup-sh-script-mode ()
4739
4740   ;; Fetch the shell interpreter's name.
4741   (let ((shell-name sh-shell-file))
4742
4743     ;; Try reading the hash-bang line.
4744     (save-excursion
4745       (goto-char (point-min))
4746       (if (looking-at "#![ \t]*\\([^ \t\n]*\\)")
4747           (setq shell-name (match-string 1))))
4748
4749     ;; Now try to set the shell.
4750     ;;
4751     ;; Don't let `sh-set-shell' bugger up my script.
4752     (let ((executable-set-magic #'(lambda (s &rest r) s)))
4753       (sh-set-shell shell-name)))
4754
4755   ;; Don't insert here-document scaffolding automatically.
4756   (local-set-key "<" 'self-insert-command)
4757
4758   ;; Now enable my keys and the fontification.
4759   (mdw-misc-mode-config)
4760
4761   ;; Set the indentation level correctly.
4762   (setq sh-indentation 2)
4763   (setq sh-basic-offset 2))
4764
4765 (setq sh-shell-file "/bin/sh")
4766
4767 ;; Awful hacking to override the shell detection for particular scripts.
4768 (defmacro define-custom-shell-mode (name shell)
4769   `(defun ,name ()
4770      (interactive)
4771      (set (make-local-variable 'sh-shell-file) ,shell)
4772      (sh-mode)))
4773 (define-custom-shell-mode bash-mode "/bin/bash")
4774 (define-custom-shell-mode rc-mode "/usr/bin/rc")
4775 (put 'sh-shell-file 'permanent-local t)
4776
4777 ;; Hack the rc syntax table.  Backquotes aren't paired in rc.
4778 (eval-after-load "sh-script"
4779   '(or (assq 'rc sh-mode-syntax-table-input)
4780        (let ((frag '(nil
4781                      ?# "<"
4782                      ?\n ">#"
4783                      ?\" "\"\""
4784                      ?\' "\"\'"
4785                      ?$ "'"
4786                      ?\` "."
4787                      ?! "_"
4788                      ?% "_"
4789                      ?. "_"
4790                      ?^ "_"
4791                      ?~ "_"
4792                      ?, "_"
4793                      ?= "."
4794                      ?< "."
4795                      ?> "."))
4796              (assoc (assq 'rc sh-mode-syntax-table-input)))
4797          (if assoc
4798              (rplacd assoc frag)
4799            (setq sh-mode-syntax-table-input
4800                    (cons (cons 'rc frag)
4801                          sh-mode-syntax-table-input))))))
4802
4803 (progn
4804   (add-hook 'sh-mode-hook 'mdw-misc-mode-config t)
4805   (add-hook 'sh-mode-hook 'mdw-setup-sh-script-mode t))
4806
4807 ;;;--------------------------------------------------------------------------
4808 ;;; Emacs shell mode.
4809
4810 (defun mdw-eshell-prompt ()
4811   (let ((left "[") (right "]"))
4812     (when (= (user-uid) 0)
4813       (setq left "«" right "»"))
4814     (concat left
4815             (save-match-data
4816               (replace-regexp-in-string "\\..*$" "" (system-name)))
4817             " "
4818             (let* ((pwd (eshell/pwd)) (npwd (length pwd))
4819                    (home (expand-file-name "~")) (nhome (length home)))
4820               (if (and (>= npwd nhome)
4821                        (or (= nhome npwd)
4822                            (= (elt pwd nhome) ?/))
4823                        (string= (substring pwd 0 nhome) home))
4824                   (concat "~" (substring pwd (length home)))
4825                 pwd))
4826             right)))
4827 (setq-default eshell-prompt-function 'mdw-eshell-prompt)
4828 (setq-default eshell-prompt-regexp "^\\[[^]>]+\\(\\]\\|>>?\\)")
4829
4830 (defun eshell/e (file) (find-file file) nil)
4831 (defun eshell/ee (file) (find-file-other-window file) nil)
4832 (defun eshell/w3m (url) (w3m-goto-url url) nil)
4833
4834 (mdw-define-face eshell-prompt (t :weight bold))
4835 (mdw-define-face eshell-ls-archive (t :weight bold :foreground "red"))
4836 (mdw-define-face eshell-ls-backup (t :foreground "lightgrey" :slant italic))
4837 (mdw-define-face eshell-ls-product (t :foreground "lightgrey" :slant italic))
4838 (mdw-define-face eshell-ls-clutter (t :foreground "lightgrey" :slant italic))
4839 (mdw-define-face eshell-ls-executable (t :weight bold))
4840 (mdw-define-face eshell-ls-directory (t :foreground "cyan" :weight bold))
4841 (mdw-define-face eshell-ls-readonly (t nil))
4842 (mdw-define-face eshell-ls-symlink (t :foreground "cyan"))
4843
4844 (defun mdw-eshell-hack () (setenv "LD_PRELOAD" nil))
4845 (add-hook 'eshell-mode-hook 'mdw-eshell-hack)
4846
4847 ;;;--------------------------------------------------------------------------
4848 ;;; Messages-file mode.
4849
4850 (defun messages-mode-guts ()
4851   (setq messages-mode-syntax-table (make-syntax-table))
4852   (set-syntax-table messages-mode-syntax-table)
4853   (modify-syntax-entry ?0 "w" messages-mode-syntax-table)
4854   (modify-syntax-entry ?1 "w" messages-mode-syntax-table)
4855   (modify-syntax-entry ?2 "w" messages-mode-syntax-table)
4856   (modify-syntax-entry ?3 "w" messages-mode-syntax-table)
4857   (modify-syntax-entry ?4 "w" messages-mode-syntax-table)
4858   (modify-syntax-entry ?5 "w" messages-mode-syntax-table)
4859   (modify-syntax-entry ?6 "w" messages-mode-syntax-table)
4860   (modify-syntax-entry ?7 "w" messages-mode-syntax-table)
4861   (modify-syntax-entry ?8 "w" messages-mode-syntax-table)
4862   (modify-syntax-entry ?9 "w" messages-mode-syntax-table)
4863   (make-local-variable 'comment-start)
4864   (make-local-variable 'comment-end)
4865   (make-local-variable 'indent-line-function)
4866   (setq indent-line-function 'indent-relative)
4867   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4868   (make-local-variable 'font-lock-defaults)
4869   (make-local-variable 'messages-mode-keywords)
4870   (let ((keywords
4871          (mdw-regexps "array" "bitmap" "callback" "docs[ \t]+enum"
4872                       "export" "enum" "fixed-octetstring" "flags"
4873                       "harmless" "map" "nested" "optional"
4874                       "optional-tagged" "package" "primitive"
4875                       "primitive-nullfree" "relaxed[ \t]+enum"
4876                       "set" "table" "tagged-optional"   "union"
4877                       "variadic" "vector" "version" "version-tag")))
4878     (setq messages-mode-keywords
4879             (list
4880              (list (concat "\\<\\(" keywords "\\)\\>:")
4881                    '(0 font-lock-keyword-face))
4882              '("\\([-a-zA-Z0-9]+:\\)" (0 font-lock-warning-face))
4883              '("\\(\\<[a-z][-_a-zA-Z0-9]*\\)"
4884                (0 font-lock-variable-name-face))
4885              '("\\<\\([0-9]+\\)\\>" (0 mdw-number-face))
4886              '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
4887                (0 mdw-punct-face)))))
4888   (setq font-lock-defaults
4889           '(messages-mode-keywords nil nil nil nil))
4890   (run-hooks 'messages-file-hook))
4891
4892 (defun messages-mode ()
4893   (interactive)
4894   (fundamental-mode)
4895   (setq major-mode 'messages-mode)
4896   (setq mode-name "Messages")
4897   (messages-mode-guts)
4898   (modify-syntax-entry ?# "<" messages-mode-syntax-table)
4899   (modify-syntax-entry ?\n ">" messages-mode-syntax-table)
4900   (setq comment-start "# ")
4901   (setq comment-end "")
4902   (run-hooks 'messages-mode-hook))
4903
4904 (defun cpp-messages-mode ()
4905   (interactive)
4906   (fundamental-mode)
4907   (setq major-mode 'cpp-messages-mode)
4908   (setq mode-name "CPP Messages")
4909   (messages-mode-guts)
4910   (modify-syntax-entry ?* ". 23" messages-mode-syntax-table)
4911   (modify-syntax-entry ?/ ". 14" messages-mode-syntax-table)
4912   (setq comment-start "/* ")
4913   (setq comment-end " */")
4914   (let ((preprocessor-keywords
4915          (mdw-regexps "assert" "define" "elif" "else" "endif" "error"
4916                       "ident" "if" "ifdef" "ifndef" "import" "include"
4917                       "line" "pragma" "unassert" "undef" "warning")))
4918     (setq messages-mode-keywords
4919             (append (list (list (concat "^[ \t]*\\#[ \t]*"
4920                                         "\\(include\\|import\\)"
4921                                         "[ \t]*\\(<[^>]+\\(>\\)?\\)")
4922                                 '(2 font-lock-string-face))
4923                           (list (concat "^\\([ \t]*#[ \t]*\\(\\("
4924                                         preprocessor-keywords
4925                                         "\\)\\>\\|[0-9]+\\|$\\)\\)")
4926                                 '(1 font-lock-keyword-face)))
4927                     messages-mode-keywords)))
4928   (run-hooks 'cpp-messages-mode-hook))
4929
4930 (progn
4931   (add-hook 'messages-mode-hook 'mdw-misc-mode-config t)
4932   (add-hook 'cpp-messages-mode-hook 'mdw-misc-mode-config t)
4933   ;; (add-hook 'messages-file-hook 'mdw-fontify-messages t)
4934   )
4935
4936 ;;;--------------------------------------------------------------------------
4937 ;;; Messages-file mode.
4938
4939 (defvar mallow-driver-substitution-face 'mallow-driver-substitution-face
4940   "Face to use for subsittution directives.")
4941 (make-face 'mallow-driver-substitution-face)
4942 (defvar mallow-driver-text-face 'mallow-driver-text-face
4943   "Face to use for body text.")
4944 (make-face 'mallow-driver-text-face)
4945
4946 (defun mallow-driver-mode ()
4947   (interactive)
4948   (fundamental-mode)
4949   (setq major-mode 'mallow-driver-mode)
4950   (setq mode-name "Mallow driver")
4951   (setq mallow-driver-mode-syntax-table (make-syntax-table))
4952   (set-syntax-table mallow-driver-mode-syntax-table)
4953   (make-local-variable 'comment-start)
4954   (make-local-variable 'comment-end)
4955   (make-local-variable 'indent-line-function)
4956   (setq indent-line-function 'indent-relative)
4957   (mdw-standard-fill-prefix "\\([ \t]*\\(;\\|/?\\*\\)+[ \t]*\\)")
4958   (make-local-variable 'font-lock-defaults)
4959   (make-local-variable 'mallow-driver-mode-keywords)
4960   (let ((keywords
4961          (mdw-regexps "each" "divert" "file" "if"
4962                       "perl" "set" "string" "type" "write")))
4963     (setq mallow-driver-mode-keywords
4964             (list
4965              (list (concat "^%\\s *\\(}\\|\\(" keywords "\\)\\>\\).*$")
4966                    '(0 font-lock-keyword-face))
4967              (list "^%\\s *\\(#.*\\)?$"
4968                    '(0 font-lock-comment-face))
4969              (list "^%"
4970                    '(0 font-lock-keyword-face))
4971              (list "^|?\\(.+\\)$" '(1 mallow-driver-text-face))
4972              (list "\\${[^}]*}"
4973                    '(0 mallow-driver-substitution-face t)))))
4974   (setq font-lock-defaults
4975         '(mallow-driver-mode-keywords nil nil nil nil))
4976   (modify-syntax-entry ?\" "_" mallow-driver-mode-syntax-table)
4977   (modify-syntax-entry ?\n ">" mallow-driver-mode-syntax-table)
4978   (setq comment-start "%# ")
4979   (setq comment-end "")
4980   (run-hooks 'mallow-driver-mode-hook))
4981
4982 (progn
4983   (add-hook 'mallow-driver-hook 'mdw-misc-mode-config t))
4984
4985 ;;;--------------------------------------------------------------------------
4986 ;;; NFast debugs.
4987
4988 (defun nfast-debug-mode ()
4989   (interactive)
4990   (fundamental-mode)
4991   (setq major-mode 'nfast-debug-mode)
4992   (setq mode-name "NFast debug")
4993   (setq messages-mode-syntax-table (make-syntax-table))
4994   (set-syntax-table messages-mode-syntax-table)
4995   (make-local-variable 'font-lock-defaults)
4996   (make-local-variable 'nfast-debug-mode-keywords)
4997   (setq truncate-lines t)
4998   (setq nfast-debug-mode-keywords
4999           (list
5000            '("^\\(NFast_\\(Connect\\|Disconnect\\|Submit\\|Wait\\)\\)"
5001              (0 font-lock-keyword-face))
5002            (list (concat "^[ \t]+\\(\\("
5003                          "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
5004                          "[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]"
5005                          "[ \t]+\\)*"
5006                          "[0-9a-fA-F]+\\)[ \t]*$")
5007                  '(0 mdw-number-face))
5008            '("^[ \t]+\.status=[ \t]+\\<\\(OK\\)\\>"
5009              (1 font-lock-keyword-face))
5010            '("^[ \t]+\.status=[ \t]+\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>"
5011              (1 font-lock-warning-face))
5012            '("^[ \t]+\.status[ \t]+\\<\\(zero\\)\\>"
5013              (1 nil))
5014            (list (concat "^[ \t]+\\.cmd=[ \t]+"
5015                          "\\<\\([a-zA-Z][0-9a-zA-Z]*\\)\\>")
5016                  '(1 font-lock-keyword-face))
5017            '("-?\\<\\([0-9]+\\|0x[0-9a-fA-F]+\\)\\>" (0 mdw-number-face))
5018            '("^\\([ \t]+[a-z0-9.]+\\)" (0 font-lock-variable-name-face))
5019            '("\\<\\([a-z][a-z0-9.]+\\)\\>=" (1 font-lock-variable-name-face))
5020            '("\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" (0 mdw-punct-face))))
5021   (setq font-lock-defaults
5022           '(nfast-debug-mode-keywords nil nil nil nil))
5023   (run-hooks 'nfast-debug-mode-hook))
5024
5025 ;;;--------------------------------------------------------------------------
5026 ;;; Lispy languages.
5027
5028 ;; Unpleasant bodge.
5029 (unless (boundp 'slime-repl-mode-map)
5030   (setq slime-repl-mode-map (make-sparse-keymap)))
5031
5032 (defun mdw-indent-newline-and-indent ()
5033   (interactive)
5034   (indent-for-tab-command)
5035   (newline-and-indent))
5036
5037 (eval-after-load "cl-indent"
5038   '(progn
5039      (mapc #'(lambda (pair)
5040                (put (car pair)
5041                     'common-lisp-indent-function
5042                     (cdr pair)))
5043       '((destructuring-bind . ((&whole 4 &rest 1) 4 &body))
5044         (multiple-value-bind . ((&whole 4 &rest 1) 4 &body))))))
5045
5046 (defun mdw-common-lisp-indent ()
5047   (make-local-variable 'lisp-indent-function)
5048   (setq lisp-indent-function 'common-lisp-indent-function))
5049
5050 (defmacro mdw-advise-hyperspec-lookup (func args)
5051   `(defadvice ,func (around mdw-browse-w3m ,args activate compile)
5052      (if (fboundp 'w3m)
5053          (let ((browse-url-browser-function #'mdw-w3m-browse-url))
5054            ad-do-it)
5055        ad-do-it)))
5056 (mdw-advise-hyperspec-lookup common-lisp-hyperspec (symbol))
5057 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-format (char))
5058 (mdw-advise-hyperspec-lookup common-lisp-hyperspec-lookup-reader-macro (char))
5059
5060 (defun mdw-fontify-lispy ()
5061
5062   ;; Set fill prefix.
5063   (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")
5064
5065   ;; Not much fontification needed.
5066   (make-local-variable 'font-lock-keywords)
5067     (setq font-lock-keywords
5068           (list (list (concat "\\("
5069                               "\\_<[-+]?"
5070                               "\\(" "[0-9]+/[0-9]+"
5071                               "\\|" "\\(" "[0-9]+" "\\(\\.[0-9]*\\)?" "\\|"
5072                                           "\\.[0-9]+" "\\)"
5073                                     "\\([dDeEfFlLsS][-+]?[0-9]+\\)?"
5074                               "\\)"
5075                               "\\|"
5076                               "#"
5077                               "\\(" "x" "[-+]?"
5078                                     "[0-9A-Fa-f]+" "\\(/[0-9A-Fa-f]+\\)?"
5079                               "\\|" "o" "[-+]?" "[0-7]+" "\\(/[0-7]+\\)?"
5080                               "\\|" "b" "[-+]?" "[01]+" "\\(/[01]+\\)?"
5081                               "\\|" "[0-9]+" "r" "[-+]?"
5082                                     "[0-9a-zA-Z]+" "\\(/[0-9a-zA-Z]+\\)?"
5083                               "\\)"
5084                               "\\)\\_>")
5085                       '(0 mdw-number-face))
5086                 (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5087                       '(0 mdw-punct-face)))))
5088
5089 ;; Special indentation.
5090
5091 (defcustom mdw-lisp-loop-default-indent 2
5092   "Default indent for simple `loop' body."
5093   :type 'integer
5094   :safe 'integerp)
5095 (defcustom mdw-lisp-setf-value-indent 2
5096   "Default extra indent for `setf' values."
5097   :type 'integer :safe 'integerp)
5098
5099 (setq lisp-simple-loop-indentation 0
5100       lisp-loop-keyword-indentation 0
5101       lisp-loop-forms-indentation 2
5102       lisp-lambda-list-keyword-parameter-alignment t)
5103
5104 (defun mdw-indent-funcall
5105     (path state &optional indent-point sexp-column normal-indent)
5106   "Indent `funcall' more usefully.
5107 Essentially, treat `funcall foo' as a function name, and align the arguments
5108 to `foo'."
5109   (and (or (not (consp path)) (null (cadr path)))
5110        (save-excursion
5111          (goto-char (cadr state))
5112          (forward-char 1)
5113          (let ((start-line (line-number-at-pos)))
5114            (and (condition-case nil (progn (forward-sexp 3) t)
5115                   (scan-error nil))
5116                 (progn
5117                   (forward-sexp -1)
5118                   (and (= start-line (line-number-at-pos))
5119                        (current-column))))))))
5120 (progn
5121   (put 'funcall 'common-lisp-indent-function 'mdw-indent-funcall)
5122   (put 'funcall 'lisp-indent-function 'mdw-indent-funcall))
5123
5124 (defun mdw-indent-setf
5125     (path state &optional indent-point sexp-column normal-indent)
5126   "Indent `setf' more usefully.
5127 If the values aren't on the same lines as their variables then indent them
5128 by `mdw-lisp-setf-value-indent' spaces."
5129   (and (or (not (consp path)) (null (cadr path)))
5130        (let ((basic-indent (save-excursion
5131                              (goto-char (cadr state))
5132                              (forward-char 1)
5133                              (and (condition-case nil
5134                                       (progn (forward-sexp 2) t)
5135                                     (scan-error nil))
5136                                   (progn
5137                                     (forward-sexp -1)
5138                                     (current-column)))))
5139              (offset (if (consp path) (car path)
5140                        (catch 'done
5141                          (save-excursion
5142                            (let ((start path)
5143                                  (count 0))
5144                              (goto-char (cadr state))
5145                              (forward-char 1)
5146                              (while (< (point) start)
5147                                (condition-case nil (forward-sexp 1)
5148                                  (scan-error (throw 'done nil)))
5149                                (cl-incf count))
5150                              (1- count)))))))
5151          (and basic-indent offset
5152               (list (+ basic-indent
5153                        (if (cl-oddp offset) 0
5154                          mdw-lisp-setf-value-indent))
5155                     basic-indent)))))
5156 (progn
5157   (put 'setf 'common-lisp-indent-functopion 'mdw-indent-setf)
5158   (put 'psetf 'common-lisp-indent-function 'mdw-indent-setf)
5159   (put 'setq 'common-lisp-indent-function 'mdw-indent-setf)
5160   (put 'setf 'lisp-indent-function 'mdw-indent-setf)
5161   (put 'setq 'lisp-indent-function 'mdw-indent-setf)
5162   (put 'setq-local 'lisp-indent-function 'mdw-indent-setf)
5163   (put 'setq-default 'lisp-indent-function 'mdw-indent-setf))
5164
5165 (defadvice common-lisp-loop-part-indentation
5166     (around mdw-fix-loop-indentation (indent-point state) activate compile)
5167   "Improve `loop' indentation.
5168 If the first subform is on the same line as the `loop' keyword, then
5169 align the other subforms beneath it.  Otherwise, indent them
5170 `mdw-lisp-loop-default-indent' columns in from the opening parenthesis."
5171
5172   (let* ((loop-indentation (save-excursion
5173                              (goto-char (elt state 1))
5174                              (current-column))))
5175
5176     ;; Don't really care about this.
5177     (when (and (boundp 'lisp-indent-backquote-substitution-mode)
5178                (eq lisp-indent-backquote-substitution-mode 'corrected))
5179       (save-excursion
5180         (goto-char (elt state 1))
5181         (cl-incf loop-indentation
5182                    (cond ((eq (char-before) ?,) -1)
5183                          ((and (eq (char-before) ?@)
5184                                (progn (backward-char)
5185                                       (eq (char-before) ?,)))
5186                           -2)
5187                          (t 0)))))
5188
5189     ;; If the first loop item is on the same line as the `loop' itself then
5190     ;; use that as the baseline.  Otherwise advance by the default indent.
5191     (goto-char (cadr state))
5192     (forward-char 1)
5193     (let ((baseline-indent
5194            (if (= (line-number-at-pos)
5195                   (if (condition-case nil (progn (forward-sexp 2) t)
5196                         (scan-error nil))
5197                       (progn (forward-sexp -1) (line-number-at-pos))
5198                     -1))
5199                (current-column)
5200              (+ loop-indentation mdw-lisp-loop-default-indent))))
5201
5202       (goto-char indent-point)
5203       (beginning-of-line)
5204
5205       (setq ad-return-value
5206               (list
5207                (cond ((condition-case ()
5208                           (save-excursion
5209                             (goto-char (elt state 1))
5210                             (forward-char 1)
5211                             (forward-sexp 2)
5212                             (backward-sexp 1)
5213                             (not (looking-at "\\(:\\|\\sw\\)")))
5214                         (error nil))
5215                       (+ baseline-indent lisp-simple-loop-indentation))
5216                      ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
5217                       (+ baseline-indent lisp-loop-keyword-indentation))
5218                      (t
5219                       (+ baseline-indent lisp-loop-forms-indentation)))
5220
5221                ;; Tell the caller that the next line needs recomputation,
5222                ;; even though it doesn't start a sexp.
5223                loop-indentation)))))
5224
5225 ;; SLIME setup.
5226
5227 (defcustom mdw-friendly-name "[mdw]"
5228   "How I want to be addressed."
5229   :type 'string
5230   :safe 'stringp)
5231 (defadvice slime-user-first-name
5232     (around mdw-use-friendly-name compile activate)
5233   (if mdw-friendly-name (setq ad-return-value mdw-friendly-name)
5234     ad-do-it))
5235
5236 (eval-and-compile
5237   (trap
5238     (if (not mdw-fast-startup)
5239         (progn
5240           (require 'slime-autoloads)
5241           (slime-setup '(slime-autodoc slime-c-p-c))))))
5242
5243 (let ((stuff '((cmucl ("cmucl"))
5244                (sbcl ("sbcl") :coding-system utf-8-unix)
5245                (clisp ("clisp") :coding-system utf-8-unix))))
5246   (or (boundp 'slime-lisp-implementations)
5247       (setq slime-lisp-implementations nil))
5248   (while stuff
5249     (let* ((head (car stuff))
5250            (found (assq (car head) slime-lisp-implementations)))
5251       (setq stuff (cdr stuff))
5252       (if found
5253           (rplacd found (cdr head))
5254         (setq slime-lisp-implementations
5255                 (cons head slime-lisp-implementations))))))
5256 (setq slime-default-lisp 'sbcl)
5257
5258 ;; Hooks.
5259
5260 (progn
5261   (dolist (hook '(emacs-lisp-mode-hook
5262                   scheme-mode-hook
5263                   lisp-mode-hook
5264                   inferior-lisp-mode-hook
5265                   lisp-interaction-mode-hook
5266                   ielm-mode-hook
5267                   slime-repl-mode-hook))
5268     (add-hook hook 'mdw-misc-mode-config t)
5269     (add-hook hook 'mdw-fontify-lispy t))
5270   (add-hook 'lisp-mode-hook 'mdw-common-lisp-indent t)
5271   (add-hook 'inferior-lisp-mode-hook
5272             #'(lambda () (local-set-key "\C-m" 'comint-send-and-indent)) t))
5273
5274 ;;;--------------------------------------------------------------------------
5275 ;;; Other languages.
5276
5277 ;; Smalltalk.
5278
5279 (defun mdw-setup-smalltalk ()
5280   (and mdw-auto-indent
5281        (local-set-key "\C-m" 'smalltalk-newline-and-indent))
5282   (make-local-variable 'mdw-auto-indent)
5283   (setq mdw-auto-indent nil)
5284   (local-set-key "\C-i" 'smalltalk-reindent))
5285
5286 (defun mdw-fontify-smalltalk ()
5287   (make-local-variable 'font-lock-keywords)
5288   (setq font-lock-keywords
5289           (list
5290            (list "\\<[A-Z][a-zA-Z0-9]*\\>"
5291                  '(0 font-lock-keyword-face))
5292            (list (concat "\\<0\\([xX][0-9a-fA-F_]+\\|[0-7_]+\\)\\|"
5293                          "[0-9][0-9_]*\\(\\.[0-9_]*\\)?"
5294                          "\\([eE][-+]?[0-9_]+\\)?")
5295                  '(0 mdw-number-face))
5296            (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
5297                  '(0 mdw-punct-face)))))
5298
5299 (progn
5300   (add-hook 'smalltalk-mode 'mdw-misc-mode-config t)
5301   (add-hook 'smalltalk-mode 'mdw-fontify-smalltalk t))
5302
5303 ;; m4.
5304
5305 (defun mdw-setup-m4 ()
5306
5307   ;; Inexplicably, Emacs doesn't match braces in m4 mode.  This is very
5308   ;; annoying: fix it.
5309   (modify-syntax-entry ?{ "(")
5310   (modify-syntax-entry ?} ")")
5311
5312   ;; Fill prefix.
5313   (mdw-standard-fill-prefix "\\([ \t]*\\(?:#+\\|\\<dnl\\>\\)[ \t]*\\)"))
5314
5315 (dolist (hook '(m4-mode-hook autoconf-mode-hook autotest-mode-hook))
5316   (add-hook hook #'mdw-misc-mode-config t)
5317   (add-hook hook #'mdw-setup-m4 t))
5318
5319 ;; Make.
5320
5321 (progn
5322   (add-hook 'makefile-mode-hook 'mdw-misc-mode-config t))
5323
5324 ;; nroff/troff.
5325
5326 (progn
5327   (add-hook 'nroff-mode-hook 'mdw-misc-mode-config t))
5328
5329 ;;;--------------------------------------------------------------------------
5330 ;;; Text mode.
5331
5332 (defun mdw-text-mode ()
5333   (setq fill-column 72)
5334   (flyspell-mode t)
5335   (mdw-standard-fill-prefix
5336    "\\([ \t]*\\([>#|:] ?\\)*[ \t]*\\)" 3)
5337   (auto-fill-mode 1))
5338
5339 (eval-after-load "flyspell"
5340   '(define-key flyspell-mode-map "\C-\M-i" nil))
5341
5342 (progn
5343   (add-hook 'text-mode-hook 'mdw-text-mode t))
5344
5345 ;;;--------------------------------------------------------------------------
5346 ;;; Outline and hide/show modes.
5347
5348 (defun mdw-outline-collapse-all ()
5349   "Completely collapse everything in the entire buffer."
5350   (interactive)
5351   (save-excursion
5352     (goto-char (point-min))
5353     (while (< (point) (point-max))
5354       (hide-subtree)
5355       (forward-line))))
5356
5357 (setq hs-hide-comments-when-hiding-all nil)
5358
5359 (defadvice hs-hide-all (after hide-first-comment activate)
5360   (save-excursion (hs-hide-initial-comment-block)))
5361
5362 ;;;--------------------------------------------------------------------------
5363 ;;; Shell mode.
5364
5365 (defun mdw-sh-mode-setup ()
5366   (local-set-key [?\C-a] 'comint-bol)
5367   (add-hook 'comint-output-filter-functions
5368             'comint-watch-for-password-prompt))
5369
5370 (defun mdw-term-mode-setup ()
5371   (setq term-prompt-regexp shell-prompt-pattern)
5372   (make-local-variable 'mouse-yank-at-point)
5373   (make-local-variable 'transient-mark-mode)
5374   (setq mouse-yank-at-point t)
5375   (auto-fill-mode -1)
5376   (setq tab-width 8))
5377
5378 (defun comint-send-and-indent ()
5379   (interactive)
5380   (comint-send-input)
5381   (and mdw-auto-indent
5382        (indent-for-tab-command)))
5383
5384 (defadvice comint-line-beginning-position
5385     (around mdw-calculate-it-properly () activate compile)
5386   "Calculate the actual line start for multi-line input."
5387   (if (or comint-use-prompt-regexp
5388           (eq (field-at-pos (point)) 'output))
5389       ad-do-it
5390     (setq ad-return-value
5391             (constrain-to-field (line-beginning-position) (point)))))
5392
5393 (defun term-send-meta-right () (interactive) (term-send-raw-string "\e\e[C"))
5394 (defun term-send-meta-left  () (interactive) (term-send-raw-string "\e\e[D"))
5395 (defun term-send-ctrl-uscore () (interactive) (term-send-raw-string "\C-_"))
5396 (defun term-send-meta-meta-something ()
5397   (interactive)
5398   (term-send-raw-string "\e\e")
5399   (term-send-raw))
5400 (eval-after-load 'term
5401   '(progn
5402      (define-key term-raw-map [?\e ?\e] nil)
5403      (define-key term-raw-map [?\e ?\e t] 'term-send-meta-meta-something)
5404      (define-key term-raw-map [?\C-/] 'term-send-ctrl-uscore)
5405      (define-key term-raw-map [M-right] 'term-send-meta-right)
5406      (define-key term-raw-map [?\e ?\M-O ?C] 'term-send-meta-right)
5407      (define-key term-raw-map [M-left] 'term-send-meta-left)
5408      (define-key term-raw-map [?\e ?\M-O ?D] 'term-send-meta-left)))
5409
5410 (defadvice term-exec (before program-args-list compile activate)
5411   "If the PROGRAM argument is a list, interpret it as (PROGRAM . SWITCHES).
5412 This allows you to pass a list of arguments through `ansi-term'."
5413   (let ((program (ad-get-arg 2)))
5414     (if (listp program)
5415         (progn
5416           (ad-set-arg 2 (car program))
5417           (ad-set-arg 4 (cdr program))))))
5418
5419 (defadvice term-exec-1 (around hack-environment compile activate)
5420   "Hack the environment inherited by inferiors in the terminal."
5421   (let ((process-environment (copy-tree process-environment)))
5422     (setenv "LD_PRELOAD" nil)
5423     ad-do-it))
5424
5425 (defadvice shell (around hack-environment compile activate)
5426   "Hack the environment inherited by inferiors in the shell."
5427   (let ((process-environment (copy-tree process-environment)))
5428     (setenv "LD_PRELOAD" nil)
5429     ad-do-it))
5430
5431 (defun ssh (host)
5432   "Open a terminal containing an ssh session to the HOST."
5433   (interactive "sHost: ")
5434   (ansi-term (list "ssh" host) (format "ssh@%s" host)))
5435
5436 (defcustom git-grep-command
5437   "env GIT_PAGER=cat git grep --no-color -nH -e "
5438   "The default command for \\[git-grep]."
5439   :type 'string)
5440
5441 (defvar git-grep-history nil)
5442
5443 (defun git-grep (command-args)
5444   "Run `git grep' with user-specified args and collect output in a buffer."
5445   (interactive
5446    (list (read-shell-command "Run git grep (like this): "
5447                              git-grep-command 'git-grep-history)))
5448   (let ((grep-use-null-device nil))
5449     (grep command-args)))
5450
5451 ;;;--------------------------------------------------------------------------
5452 ;;; Magit configuration.
5453
5454 (setq magit-diff-refine-hunk 't
5455       magit-view-git-manual-method 'man
5456       magit-log-margin '(nil age magit-log-margin-width t 18)
5457       magit-wip-after-save-local-mode-lighter ""
5458       magit-wip-after-apply-mode-lighter ""
5459       magit-wip-before-change-mode-lighter "")
5460 (eval-after-load "magit"
5461   '(progn (global-magit-file-mode 1)
5462           (magit-wip-after-save-mode 1)
5463           (magit-wip-after-apply-mode 1)
5464           (magit-wip-before-change-mode 1)
5465           (add-to-list 'magit-no-confirm 'safe-with-wip)
5466           (add-to-list 'magit-no-confirm 'trash)
5467           (push '(:eval (if (or magit-wip-after-save-local-mode
5468                                 magit-wip-after-apply-mode
5469                                 magit-wip-before-change-mode)
5470                             (format " wip:%s%s%s"
5471                                     (if magit-wip-after-apply-mode "A" "")
5472                                     (if magit-wip-before-change-mode "C" "")
5473                                     (if magit-wip-after-save-local-mode "S" ""))))
5474                 minor-mode-alist)
5475           (dolist (popup '(magit-diff-popup
5476                            magit-diff-refresh-popup
5477                            magit-diff-mode-refresh-popup
5478                            magit-revision-mode-refresh-popup))
5479             (magit-define-popup-switch popup ?R "Reverse diff" "-R"))
5480           (magit-define-popup-switch 'magit-rebase-popup ?r
5481                                      "Rebase merges" "--rebase-merges")))
5482
5483 (defadvice magit-wip-commit-buffer-file
5484     (around mdw-just-this-buffer activate compile)
5485   (let ((magit-save-repository-buffers nil)) ad-do-it))
5486
5487 (defadvice magit-discard
5488     (around mdw-delete-if-prefix-argument activate compile)
5489   (let ((magit-delete-by-moving-to-trash
5490          (and (null current-prefix-arg)
5491               magit-delete-by-moving-to-trash)))
5492     ad-do-it))
5493
5494 (setq magit-repolist-columns
5495         '(("Name" 16 magit-repolist-column-ident nil)
5496           ("Version" 18 magit-repolist-column-version nil)
5497           ("St" 2 magit-repolist-column-dirty nil)
5498           ("L<U" 3 mdw-repolist-column-unpulled-from-upstream nil)
5499           ("L>U" 3 mdw-repolist-column-unpushed-to-upstream nil)
5500           ("Path" 32 magit-repolist-column-path nil)))
5501
5502 (setq magit-repository-directories '(("~/etc/profile" . 0)
5503                                      ("~/src/" . 1)))
5504
5505 (defadvice magit-list-repos (around mdw-dirname () activate compile)
5506   "Make sure the returned names are directory names.
5507 Otherwise child processes get started in the wrong directory and
5508 there is sadness."
5509   (setq ad-return-value (mapcar #'file-name-as-directory ad-do-it)))
5510
5511 (defun mdw-repolist-column-unpulled-from-upstream (_id)
5512   "Insert number of upstream commits not in the current branch."
5513   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5514     (and upstream
5515          (let ((n (cadr (magit-rev-diff-count "HEAD" upstream))))
5516            (propertize (number-to-string n) 'face
5517                        (if (> n 0) 'bold 'shadow))))))
5518
5519 (defun mdw-repolist-column-unpushed-to-upstream (_id)
5520   "Insert number of commits in the current branch but not its upstream."
5521   (let ((upstream (magit-get-upstream-branch (magit-get-current-branch) t)))
5522     (and upstream
5523          (let ((n (car (magit-rev-diff-count "HEAD" upstream))))
5524            (propertize (number-to-string n) 'face
5525                        (if (> n 0) 'bold 'shadow))))))
5526
5527 (defun mdw-try-smerge ()
5528   (save-excursion
5529     (goto-char (point-min))
5530     (when (re-search-forward "^<<<<<<< " nil t)
5531       (smerge-mode 1))))
5532 (add-hook 'find-file-hook 'mdw-try-smerge t)
5533
5534 (defcustom mdw-magit-new-window-modes
5535   '(magit-diff-mode
5536     magit-log-mode
5537     magit-process-mode
5538     magit-revision-mode
5539     magit-stash-mode
5540     magit-status-mode)
5541   "Magit modes which should cause a new window to be used."
5542   :type '(repeat symbol))
5543
5544 (defun mdw-display-magit-buffer (buffer)
5545   "Like `magit-display-buffer-traditional'.
5546 But uses `mdw-magit-new-window-modes' for its list of modes
5547 rather than baking the list into the function."
5548   (display-buffer buffer
5549                   (let ((mode (with-current-buffer buffer major-mode)))
5550                     (if (and (not mdw-designated-window)
5551                              (derived-mode-p 'magit-mode)
5552                              (mdw-submode-p mode 'magit-mode)
5553                              (not (memq mode mdw-magit-new-window-modes)))
5554                         '(display-buffer-same-window . nil)
5555                       nil))))
5556 (setq magit-display-buffer-function 'mdw-display-magit-buffer)
5557
5558 (defun mdw-display-magit-file-buffer (buffer)
5559   "Show a file buffer from a diff."
5560   (select-window (display-buffer buffer)))
5561 (setq magit-display-file-buffer-function 'mdw-display-magit-file-buffer)
5562
5563 ;;;--------------------------------------------------------------------------
5564 ;;; GUD, and especially GDB.
5565
5566 ;; Inhibit window dedication.  I mean, seriously, wtf?
5567 (defadvice gdb-display-buffer (after mdw-undedicated (buf) compile activate)
5568   "Don't make windows dedicated.  Seriously."
5569   (set-window-dedicated-p ad-return-value nil))
5570 (defadvice gdb-set-window-buffer
5571     (after mdw-undedicated (name &optional ignore-dedicated window)
5572      compile activate)
5573   "Don't make windows dedicated.  Seriously."
5574   (set-window-dedicated-p (or window (selected-window)) nil))
5575
5576 (defadvice gud-find-expr
5577     (around mdw-inhibit-read-only (&rest args) compile activate)
5578   "Inhibit errors caused by my setting of `comint-prompt-read-only'."
5579   (let ((inhibit-read-only t)) ad-do-it))
5580
5581 ;;;--------------------------------------------------------------------------
5582 ;;; SQL stuff.
5583
5584 (setq sql-postgres-options '("-n" "-P" "pager=off")
5585       sql-postgres-login-params
5586         '((user :default "mdw")
5587           (database :default "mdw")
5588           (server :default "db.distorted.org.uk")))
5589
5590 ;;;--------------------------------------------------------------------------
5591 ;;; Man pages.
5592
5593 ;; Turn off `noip' when running `man': it interferes with `man-db''s own
5594 ;; seccomp(2)-based sandboxing, which is (in this case, at least) strictly
5595 ;; better.
5596 (defadvice Man-getpage-in-background
5597     (around mdw-inhibit-noip (topic) compile activate)
5598   "Inhibit the `noip' preload hack when invoking `man'."
5599   (let* ((old-preload (getenv "LD_PRELOAD"))
5600          (preloads (and old-preload
5601                         (save-match-data (split-string old-preload ":"))))
5602          (any nil)
5603          (filtered nil))
5604     (save-match-data
5605       (while preloads
5606         (let ((item (pop preloads)))
5607           (if (string-match  "\\(/\\|^\\)noip\.so\\(:\\|$\\)" item)
5608               (setq any t)
5609             (push item filtered)))))
5610     (if any
5611         (unwind-protect
5612             (progn
5613               (setenv "LD_PRELOAD"
5614                       (and filtered
5615                            (with-output-to-string
5616                              (setq filtered (nreverse filtered))
5617                              (let ((first t))
5618                                (while filtered
5619                                  (if first (setq first nil)
5620                                    (write-char ?:))
5621                                  (write-string (pop filtered)))))))
5622               ad-do-it)
5623           (setenv "LD_PRELOAD" old-preload))
5624       ad-do-it)))
5625
5626 ;;;--------------------------------------------------------------------------
5627 ;;; MPC configuration.
5628
5629 (eval-when-compile (trap (require 'mpc)))
5630
5631 (setq mpc-browser-tags '(Artist|Composer|Performer Album|Playlist))
5632
5633 (defun mdw-mpc-now-playing ()
5634   (interactive)
5635   (require 'mpc)
5636   (save-excursion
5637     (set-buffer (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong"))))
5638     (mpc--status-callback))
5639   (let ((state (cdr (assq 'state mpc-status))))
5640     (cond ((member state '("stop"))
5641            (message "mpd stopped."))
5642           ((member state '("play" "pause"))
5643            (let* ((artist (cdr (assq 'Artist mpc-status)))
5644                   (album (cdr (assq 'Album mpc-status)))
5645                   (title (cdr (assq 'Title mpc-status)))
5646                   (file (cdr (assq 'file mpc-status)))
5647                   (duration-string (cdr (assq 'Time mpc-status)))
5648                   (time-string (cdr (assq 'time mpc-status)))
5649                   (time (and time-string
5650                              (string-to-number
5651                               (if (string-match ":" time-string)
5652                                   (substring time-string
5653                                              0 (match-beginning 0))
5654                                 (time-string)))))
5655                   (duration (and duration-string
5656                                  (string-to-number duration-string)))
5657                   (pos (and time duration
5658                             (format " [%d:%02d/%d:%02d]"
5659                                     (/ time 60) (mod time 60)
5660                                     (/ duration 60) (mod duration 60))))
5661                   (fmt (cond ((and artist title)
5662                               (format "`%s' by %s%s" title artist
5663                                       (if album (format ", from `%s'" album)
5664                                         "")))
5665                              (file
5666                               (format "`%s' (no tags)" file))
5667                              (t
5668                               "(no idea what's playing!)"))))
5669              (if (string= state "play")
5670                  (message "mpd playing %s%s" fmt (or pos ""))
5671                (message "mpd paused in %s%s" fmt (or pos "")))))
5672           (t
5673            (message "mpd in unknown state `%s'" state)))))
5674
5675 (defmacro mdw-define-mpc-wrapper (func bvl interactive &rest body)
5676   `(defun ,func ,bvl
5677      (interactive ,@interactive)
5678      (require 'mpc)
5679      ,@body
5680      (mdw-mpc-now-playing)))
5681
5682 (mdw-define-mpc-wrapper mdw-mpc-play-or-pause () nil
5683   (if (member (cdr (assq 'state (mpc-cmd-status))) '("play"))
5684       (mpc-pause)
5685     (mpc-play)))
5686
5687 (mdw-define-mpc-wrapper mdw-mpc-next () nil (mpc-next))
5688 (mdw-define-mpc-wrapper mdw-mpc-prev () nil (mpc-prev))
5689 (mdw-define-mpc-wrapper mdw-mpc-stop () nil (mpc-stop))
5690
5691 (defun mdw-mpc-louder (step)
5692   (interactive (list (if current-prefix-arg
5693                          (prefix-numeric-value current-prefix-arg)
5694                        +10)))
5695   (mpc-proc-cmd (format "volume %+d" step)))
5696
5697 (defun mdw-mpc-quieter (step)
5698   (interactive (list (if current-prefix-arg
5699                          (prefix-numeric-value current-prefix-arg)
5700                        +10)))
5701   (mpc-proc-cmd (format "volume %+d" (- step))))
5702
5703 (defun mdw-mpc-hack-lines (arg interactivep func)
5704   (if (and interactivep (use-region-p))
5705       (let ((from (region-beginning)) (to (region-end)))
5706         (goto-char from)
5707         (beginning-of-line)
5708         (funcall func)
5709         (forward-line)
5710         (while (< (point) to)
5711           (funcall func)
5712           (forward-line)))
5713     (let ((n (prefix-numeric-value arg)))
5714       (cond ((cl-minusp n)
5715              (unless (bolp)
5716                (beginning-of-line)
5717                (funcall func)
5718                (cl-incf n))
5719              (while (cl-minusp n)
5720                (forward-line -1)
5721                (funcall func)
5722                (cl-incf n)))
5723             (t
5724              (beginning-of-line)
5725              (while (cl-plusp n)
5726                (funcall func)
5727                (forward-line)
5728                (cl-decf n)))))))
5729
5730 (defun mdw-mpc-select-one ()
5731   (when (and (get-char-property (point) 'mpc-file)
5732              (not (get-char-property (point) 'mpc-select)))
5733     (mpc-select-toggle)))
5734
5735 (defun mdw-mpc-unselect-one ()
5736   (when (get-char-property (point) 'mpc-select)
5737     (mpc-select-toggle)))
5738
5739 (defun mdw-mpc-select (&optional arg interactivep)
5740   (interactive (list current-prefix-arg t))
5741   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5742
5743 (defun mdw-mpc-unselect (&optional arg interactivep)
5744   (interactive (list current-prefix-arg t))
5745   (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-unselect-one))
5746
5747 (defun mdw-mpc-unselect-backwards (arg)
5748   (interactive "p")
5749   (mdw-mpc-hack-lines (- arg) t 'mdw-mpc-unselect-one))
5750
5751 (defun mdw-mpc-unselect-all ()
5752   (interactive)
5753   (setq mpc-select nil)
5754   (mpc-selection-refresh))
5755
5756 (defun mdw-mpc-next-line (arg)
5757   (interactive "p")
5758   (beginning-of-line)
5759   (forward-line arg))
5760
5761 (defun mdw-mpc-previous-line (arg)
5762   (interactive "p")
5763   (beginning-of-line)
5764   (forward-line (- arg)))
5765
5766 (defun mdw-mpc-playlist-add (&optional arg interactivep)
5767   (interactive (list current-prefix-arg t))
5768   (let ((mpc-select mpc-select))
5769     (when (or arg (and interactivep (use-region-p)))
5770       (setq mpc-select nil)
5771       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5772     (setq mpc-select (reverse mpc-select))
5773     (mpc-playlist-add)))
5774
5775 (defun mdw-mpc-playlist-delete (&optional arg interactivep)
5776   (interactive (list current-prefix-arg t))
5777   (setq mpc-select (nreverse mpc-select))
5778   (mpc-select-save
5779     (when (or arg (and interactivep (use-region-p)))
5780       (setq mpc-select nil)
5781       (mpc-selection-refresh)
5782       (mdw-mpc-hack-lines arg interactivep 'mdw-mpc-select-one))
5783       (mpc-playlist-delete)))
5784
5785 (defun mdw-mpc-hack-tagbrowsers ()
5786   (setq-local mode-line-format
5787                 '("%e"
5788                   mode-line-frame-identification
5789                   mode-line-buffer-identification)))
5790 (add-hook 'mpc-tagbrowser-mode-hook 'mdw-mpc-hack-tagbrowsers)
5791
5792 (defun mdw-mpc-hack-songs ()
5793   (setq-local header-line-format
5794               ;; '("MPC " mpc-volume " " mpc-current-song)
5795               (list (propertize " " 'display '(space :align-to 0))
5796                     ;; 'mpc-songs-format-description
5797                     '(:eval
5798                       (let ((deactivate-mark) (hscroll (window-hscroll)))
5799                         (with-temp-buffer
5800                           (mpc-format mpc-songs-format 'self hscroll)
5801                           ;; That would be simpler than the hscroll handling in
5802                           ;; mpc-format, but currently move-to-column does not
5803                           ;; recognize :space display properties.
5804                           ;; (move-to-column hscroll)
5805                           ;; (delete-region (point-min) (point))
5806                           (buffer-string)))))))
5807 (add-hook 'mpc-songs-mode-hook 'mdw-mpc-hack-songs)
5808
5809 (eval-after-load "mpc"
5810   '(progn
5811      (define-key mpc-mode-map "m" 'mdw-mpc-select)
5812      (define-key mpc-mode-map "u" 'mdw-mpc-unselect)
5813      (define-key mpc-mode-map "\177" 'mdw-mpc-unselect-backwards)
5814      (define-key mpc-mode-map "\e\177" 'mdw-mpc-unselect-all)
5815      (define-key mpc-mode-map "n" 'mdw-mpc-next-line)
5816      (define-key mpc-mode-map "p" 'mdw-mpc-previous-line)
5817      (define-key mpc-mode-map "/" 'mpc-songs-search)
5818      (setq mpc-songs-mode-map (make-sparse-keymap))
5819      (set-keymap-parent mpc-songs-mode-map mpc-mode-map)
5820      (define-key mpc-songs-mode-map "l" 'mpc-playlist)
5821      (define-key mpc-songs-mode-map "+" 'mdw-mpc-playlist-add)
5822      (define-key mpc-songs-mode-map "-" 'mdw-mpc-playlist-delete)
5823      (define-key mpc-songs-mode-map "\r" 'mpc-songs-jump-to)))
5824
5825 ;;;--------------------------------------------------------------------------
5826 ;;; Inferior Emacs Lisp.
5827
5828 (setq comint-prompt-read-only t)
5829
5830 (eval-after-load "comint"
5831   '(progn
5832      (define-key comint-mode-map "\C-w" 'comint-kill-region)
5833      (define-key comint-mode-map [C-S-backspace] 'comint-kill-whole-line)))
5834
5835 (eval-after-load "ielm"
5836   '(progn
5837      (define-key ielm-map "\C-w" 'comint-kill-region)
5838      (define-key ielm-map [C-S-backspace] 'comint-kill-whole-line)))
5839
5840 ;;;----- That's all, folks --------------------------------------------------
5841
5842 (provide 'dot-emacs)