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

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