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