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