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

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