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

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