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

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