mdw@git.distorted.org.uk Git - profile/blob - el/dot-emacs.el

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