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