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