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

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