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

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