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