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