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