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

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