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

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