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

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