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

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