;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*-
|
|
;; Copyright (C) 2009-2013 Free Software Foundation, Inc
|
|
;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
|
;; Version: 0.6.5
|
;; Keywords: convenience, files, undo, redo, history, tree
|
;; URL: http://www.dr-qubit.org/emacs.php
|
;; Repository: http://www.dr-qubit.org/git/undo-tree.git
|
|
;; This file is part of Emacs.
|
;;
|
;; This file is free software: you can redistribute it and/or modify it under
|
;; the terms of the GNU General Public License as published by the Free
|
;; Software Foundation, either version 3 of the License, or (at your option)
|
;; any later version.
|
;;
|
;; This program is distributed in the hope that it will be useful, but WITHOUT
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
;; more details.
|
;;
|
;; You should have received a copy of the GNU General Public License along
|
;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
|
;;; Commentary:
|
;;
|
;; Emacs has a powerful undo system. Unlike the standard undo/redo system in
|
;; most software, it allows you to recover *any* past state of a buffer
|
;; (whereas the standard undo/redo system can lose past states as soon as you
|
;; redo). However, this power comes at a price: many people find Emacs' undo
|
;; system confusing and difficult to use, spawning a number of packages that
|
;; replace it with the less powerful but more intuitive undo/redo system.
|
;;
|
;; Both the loss of data with standard undo/redo, and the confusion of Emacs'
|
;; undo, stem from trying to treat undo history as a linear sequence of
|
;; changes. It's not. The `undo-tree-mode' provided by this package replaces
|
;; Emacs' undo system with a system that treats undo history as what it is: a
|
;; branching tree of changes. This simple idea allows the more intuitive
|
;; behaviour of the standard undo/redo system to be combined with the power of
|
;; never losing any history. An added side bonus is that undo history can in
|
;; some cases be stored more efficiently, allowing more changes to accumulate
|
;; before Emacs starts discarding history.
|
;;
|
;; The only downside to this more advanced yet simpler undo system is that it
|
;; was inspired by Vim. But, after all, most successful religions steal the
|
;; best ideas from their competitors!
|
;;
|
;;
|
;; Installation
|
;; ============
|
;;
|
;; This package has only been tested with Emacs versions 24 and CVS. It should
|
;; work in Emacs versions 22 and 23 too, but will not work without
|
;; modifications in earlier versions of Emacs.
|
;;
|
;; To install `undo-tree-mode', make sure this file is saved in a directory in
|
;; your `load-path', and add the line:
|
;;
|
;; (require 'undo-tree)
|
;;
|
;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using
|
;; "M-x byte-compile-file" from within emacs).
|
;;
|
;; If you want to replace the standard Emacs' undo system with the
|
;; `undo-tree-mode' system in all buffers, you can enable it globally by
|
;; adding:
|
;;
|
;; (global-undo-tree-mode)
|
;;
|
;; to your .emacs file.
|
;;
|
;;
|
;; Quick-Start
|
;; ===========
|
;;
|
;; If you're the kind of person who likes to jump in the car and drive,
|
;; without bothering to first figure out whether the button on the left dips
|
;; the headlights or operates the ejector seat (after all, you'll soon figure
|
;; it out when you push it), then here's the minimum you need to know:
|
;;
|
;; `undo-tree-mode' and `global-undo-tree-mode'
|
;; Enable undo-tree mode (either in the current buffer or globally).
|
;;
|
;; C-_ C-/ (`undo-tree-undo')
|
;; Undo changes.
|
;;
|
;; M-_ C-? (`undo-tree-redo')
|
;; Redo changes.
|
;;
|
;; `undo-tree-switch-branch'
|
;; Switch undo-tree branch.
|
;; (What does this mean? Better press the button and see!)
|
;;
|
;; C-x u (`undo-tree-visualize')
|
;; Visualize the undo tree.
|
;; (Better try pressing this button too!)
|
;;
|
;; C-x r u (`undo-tree-save-state-to-register')
|
;; Save current buffer state to register.
|
;;
|
;; C-x r U (`undo-tree-restore-state-from-register')
|
;; Restore buffer state from register.
|
;;
|
;;
|
;;
|
;; In the undo-tree visualizer:
|
;;
|
;; <up> p C-p (`undo-tree-visualize-undo')
|
;; Undo changes.
|
;;
|
;; <down> n C-n (`undo-tree-visualize-redo')
|
;; Redo changes.
|
;;
|
;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
|
;; Switch to previous undo-tree branch.
|
;;
|
;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
|
;; Switch to next undo-tree branch.
|
;;
|
;; C-<up> M-{ (`undo-tree-visualize-undo-to-x')
|
;; Undo changes up to last branch point.
|
;;
|
;; C-<down> M-} (`undo-tree-visualize-redo-to-x')
|
;; Redo changes down to next branch point.
|
;;
|
;; <down> n C-n (`undo-tree-visualize-redo')
|
;; Redo changes.
|
;;
|
;; <mouse-1> (`undo-tree-visualizer-mouse-set')
|
;; Set state to node at mouse click.
|
;;
|
;; t (`undo-tree-visualizer-toggle-timestamps')
|
;; Toggle display of time-stamps.
|
;;
|
;; d (`undo-tree-visualizer-toggle-diff')
|
;; Toggle diff display.
|
;;
|
;; s (`undo-tree-visualizer-selection-mode')
|
;; Toggle keyboard selection mode.
|
;;
|
;; q (`undo-tree-visualizer-quit')
|
;; Quit undo-tree-visualizer.
|
;;
|
;; C-q (`undo-tree-visualizer-abort')
|
;; Abort undo-tree-visualizer.
|
;;
|
;; , <
|
;; Scroll left.
|
;;
|
;; . >
|
;; Scroll right.
|
;;
|
;; <pgup> M-v
|
;; Scroll up.
|
;;
|
;; <pgdown> C-v
|
;; Scroll down.
|
;;
|
;;
|
;;
|
;; In visualizer selection mode:
|
;;
|
;; <up> p C-p (`undo-tree-visualizer-select-previous')
|
;; Select previous node.
|
;;
|
;; <down> n C-n (`undo-tree-visualizer-select-next')
|
;; Select next node.
|
;;
|
;; <left> b C-b (`undo-tree-visualizer-select-left')
|
;; Select left sibling node.
|
;;
|
;; <right> f C-f (`undo-tree-visualizer-select-right')
|
;; Select right sibling node.
|
;;
|
;; <pgup> M-v
|
;; Select node 10 above.
|
;;
|
;; <pgdown> C-v
|
;; Select node 10 below.
|
;;
|
;; <enter> (`undo-tree-visualizer-set')
|
;; Set state to selected node and exit selection mode.
|
;;
|
;; s (`undo-tree-visualizer-mode')
|
;; Exit selection mode.
|
;;
|
;; t (`undo-tree-visualizer-toggle-timestamps')
|
;; Toggle display of time-stamps.
|
;;
|
;; d (`undo-tree-visualizer-toggle-diff')
|
;; Toggle diff display.
|
;;
|
;; q (`undo-tree-visualizer-quit')
|
;; Quit undo-tree-visualizer.
|
;;
|
;; C-q (`undo-tree-visualizer-abort')
|
;; Abort undo-tree-visualizer.
|
;;
|
;; , <
|
;; Scroll left.
|
;;
|
;; . >
|
;; Scroll right.
|
;;
|
;;
|
;;
|
;; Persistent undo history:
|
;;
|
;; Note: Requires Emacs version 24.3 or higher.
|
;;
|
;; `undo-tree-auto-save-history' (variable)
|
;; automatically save and restore undo-tree history along with buffer
|
;; (disabled by default)
|
;;
|
;; `undo-tree-save-history' (command)
|
;; manually save undo history to file
|
;;
|
;; `undo-tree-load-history' (command)
|
;; manually load undo history from file
|
;;
|
;;
|
;;
|
;; Compressing undo history:
|
;;
|
;; Undo history files cannot grow beyond the maximum undo tree size, which
|
;; is limited by `undo-limit', `undo-strong-limit' and
|
;; `undo-outer-limit'. Nevertheless, undo history files can grow quite
|
;; large. If you want to automatically compress undo history, add the
|
;; following advice to your .emacs file (replacing ".gz" with the filename
|
;; extension of your favourite compression algorithm):
|
;;
|
;; (defadvice undo-tree-make-history-save-file-name
|
;; (after undo-tree activate)
|
;; (setq ad-return-value (concat ad-return-value ".gz")))
|
;;
|
;;
|
;;
|
;;
|
;; Undo Systems
|
;; ============
|
;;
|
;; To understand the different undo systems, it's easiest to consider an
|
;; example. Imagine you make a few edits in a buffer. As you edit, you
|
;; accumulate a history of changes, which we might visualize as a string of
|
;; past buffer states, growing downwards:
|
;;
|
;; o (initial buffer state)
|
;; |
|
;; |
|
;; o (first edit)
|
;; |
|
;; |
|
;; o (second edit)
|
;; |
|
;; |
|
;; x (current buffer state)
|
;;
|
;;
|
;; Now imagine that you undo the last two changes. We can visualize this as
|
;; rewinding the current state back two steps:
|
;;
|
;; o (initial buffer state)
|
;; |
|
;; |
|
;; x (current buffer state)
|
;; |
|
;; |
|
;; o
|
;; |
|
;; |
|
;; o
|
;;
|
;;
|
;; However, this isn't a good representation of what Emacs' undo system
|
;; does. Instead, it treats the undos as *new* changes to the buffer, and adds
|
;; them to the history:
|
;;
|
;; o (initial buffer state)
|
;; |
|
;; |
|
;; o (first edit)
|
;; |
|
;; |
|
;; o (second edit)
|
;; |
|
;; |
|
;; x (buffer state before undo)
|
;; |
|
;; |
|
;; o (first undo)
|
;; |
|
;; |
|
;; x (second undo)
|
;;
|
;;
|
;; Actually, since the buffer returns to a previous state after an undo,
|
;; perhaps a better way to visualize it is to imagine the string of changes
|
;; turning back on itself:
|
;;
|
;; (initial buffer state) o
|
;; |
|
;; |
|
;; (first edit) o x (second undo)
|
;; | |
|
;; | |
|
;; (second edit) o o (first undo)
|
;; | /
|
;; |/
|
;; o (buffer state before undo)
|
;;
|
;; Treating undos as new changes might seem a strange thing to do. But the
|
;; advantage becomes clear as soon as we imagine what happens when you edit
|
;; the buffer again. Since you've undone a couple of changes, new edits will
|
;; branch off from the buffer state that you've rewound to. Conceptually, it
|
;; looks like this:
|
;;
|
;; o (initial buffer state)
|
;; |
|
;; |
|
;; o
|
;; |\
|
;; | \
|
;; o x (new edit)
|
;; |
|
;; |
|
;; o
|
;;
|
;; The standard undo/redo system only lets you go backwards and forwards
|
;; linearly. So as soon as you make that new edit, it discards the old
|
;; branch. Emacs' undo just keeps adding changes to the end of the string. So
|
;; the undo history in the two systems now looks like this:
|
;;
|
;; Undo/Redo: Emacs' undo
|
;;
|
;; o o
|
;; | |
|
;; | |
|
;; o o o
|
;; .\ | |\
|
;; . \ | | \
|
;; . x (new edit) o o |
|
;; (discarded . | / |
|
;; branch) . |/ |
|
;; . o |
|
;; |
|
;; |
|
;; x (new edit)
|
;;
|
;; Now, what if you change your mind about those undos, and decide you did
|
;; like those other changes you'd made after all? With the standard undo/redo
|
;; system, you're lost. There's no way to recover them, because that branch
|
;; was discarded when you made the new edit.
|
;;
|
;; However, in Emacs' undo system, those old buffer states are still there in
|
;; the undo history. You just have to rewind back through the new edit, and
|
;; back through the changes made by the undos, until you reach them. Of
|
;; course, since Emacs treats undos (even undos of undos!) as new changes,
|
;; you're really weaving backwards and forwards through the history, all the
|
;; time adding new changes to the end of the string as you go:
|
;;
|
;; o
|
;; |
|
;; |
|
;; o o o (undo new edit)
|
;; | |\ |\
|
;; | | \ | \
|
;; o o | | o (undo the undo)
|
;; | / | | |
|
;; |/ | | |
|
;; (trying to get o | | x (undo the undo)
|
;; to this state) | /
|
;; |/
|
;; o
|
;;
|
;; So far, this is still reasonably intuitive to use. It doesn't behave so
|
;; differently to standard undo/redo, except that by going back far enough you
|
;; can access changes that would be lost in standard undo/redo.
|
;;
|
;; However, imagine that after undoing as just described, you decide you
|
;; actually want to rewind right back to the initial state. If you're lucky,
|
;; and haven't invoked any command since the last undo, you can just keep on
|
;; undoing until you get back to the start:
|
;;
|
;; (trying to get o x (got there!)
|
;; to this state) | |
|
;; | |
|
;; o o o o (keep undoing)
|
;; | |\ |\ |
|
;; | | \ | \ |
|
;; o o | | o o (keep undoing)
|
;; | / | | | /
|
;; |/ | | |/
|
;; (already undid o | | o (got this far)
|
;; to this state) | /
|
;; |/
|
;; o
|
;;
|
;; But if you're unlucky, and you happen to have moved the point (say) after
|
;; getting to the state labelled "got this far", then you've "broken the undo
|
;; chain". Hold on to something solid, because things are about to get
|
;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
|
;; undos! So to get back to the initial state you now have to rewind through
|
;; *all* the changes, including the undos you just did:
|
;;
|
;; (trying to get o x (finally got there!)
|
;; to this state) | |
|
;; | |
|
;; o o o o o o
|
;; | |\ |\ |\ |\ |
|
;; | | \ | \ | \ | \ |
|
;; o o | | o o o | o o
|
;; | / | | | / | | | /
|
;; |/ | | |/ | | |/
|
;; (already undid o | | o<. | | o
|
;; to this state) | / : | /
|
;; |/ : |/
|
;; o : o
|
;; :
|
;; (got this far, but
|
;; broke the undo chain)
|
;;
|
;; Confused?
|
;;
|
;; In practice you can just hold down the undo key until you reach the buffer
|
;; state that you want. But whatever you do, don't move around in the buffer
|
;; to *check* that you've got back to where you want! Because you'll break the
|
;; undo chain, and then you'll have to traverse the entire string of undos
|
;; again, just to get back to the point at which you broke the
|
;; chain. Undo-in-region and commands such as `undo-only' help to make using
|
;; Emacs' undo a little easier, but nonetheless it remains confusing for many
|
;; people.
|
;;
|
;;
|
;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
|
;; the history we've been discussing (make a few edits, undo a couple of them,
|
;; and edit again)? The diagram that conceptually represented our undo
|
;; history, before we started discussing specific undo systems? It looked like
|
;; this:
|
;;
|
;; o (initial buffer state)
|
;; |
|
;; |
|
;; o
|
;; |\
|
;; | \
|
;; o x (current state)
|
;; |
|
;; |
|
;; o
|
;;
|
;; Well, that's *exactly* what the undo history looks like to
|
;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
|
;; does), nor does it treat undos as new changes to be added to the end of a
|
;; linear string of buffer states (as Emacs' undo does). It just keeps track
|
;; of the tree of branching changes that make up the entire undo history.
|
;;
|
;; If you undo from this point, you'll rewind back up the tree to the previous
|
;; state:
|
;;
|
;; o
|
;; |
|
;; |
|
;; x (undo)
|
;; |\
|
;; | \
|
;; o o
|
;; |
|
;; |
|
;; o
|
;;
|
;; If you were to undo again, you'd rewind back to the initial state. If on
|
;; the other hand you redo the change, you'll end up back at the bottom of the
|
;; most recent branch:
|
;;
|
;; o (undo takes you here)
|
;; |
|
;; |
|
;; o (start here)
|
;; |\
|
;; | \
|
;; o x (redo takes you here)
|
;; |
|
;; |
|
;; o
|
;;
|
;; So far, this is just like the standard undo/redo system. But what if you
|
;; want to return to a buffer state located on a previous branch of the
|
;; history? Since `undo-tree-mode' keeps the entire history, you simply need
|
;; to tell it to switch to a different branch, and then redo the changes you
|
;; want:
|
;;
|
;; o
|
;; |
|
;; |
|
;; o (start here, but switch
|
;; |\ to the other branch)
|
;; | \
|
;; (redo) o o
|
;; |
|
;; |
|
;; (redo) x
|
;;
|
;; Now you're on the other branch, if you undo and redo changes you'll stay on
|
;; that branch, moving up and down through the buffer states located on that
|
;; branch. Until you decide to switch branches again, of course.
|
;;
|
;; Real undo trees might have multiple branches and sub-branches:
|
;;
|
;; o
|
;; ____|______
|
;; / \
|
;; o o
|
;; ____|__ __|
|
;; / | \ / \
|
;; o o o o x
|
;; | |
|
;; / \ / \
|
;; o o o o
|
;;
|
;; Trying to imagine what Emacs' undo would do as you move about such a tree
|
;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
|
;; just moving around this undo history tree. Most of the time, you'll
|
;; probably only need to stay on the most recent branch, in which case it
|
;; behaves like standard undo/redo, and is just as simple to understand. But
|
;; if you ever need to recover a buffer state on a different branch, the
|
;; possibility of switching between branches and accessing the full undo
|
;; history is still there.
|
;;
|
;;
|
;;
|
;; The Undo-Tree Visualizer
|
;; ========================
|
;;
|
;; Actually, it gets better. You don't have to imagine all these tree
|
;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
|
;; draws them for you! In fact, it draws even better diagrams: it highlights
|
;; the node representing the current buffer state, it highlights the current
|
;; branch, and you can toggle the display of time-stamps (by hitting "t") and
|
;; a diff of the undo changes (by hitting "d"). (There's one other tiny
|
;; difference: the visualizer puts the most recent branch on the left rather
|
;; than the right.)
|
;;
|
;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
|
;;
|
;; In the visualizer, the usual keys for moving up and down a buffer instead
|
;; move up and down the undo history tree (e.g. the up and down arrow keys, or
|
;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
|
;; history you are visualizing) is updated as you move around the undo tree in
|
;; the visualizer. If you reach a branch point in the visualizer, the usual
|
;; keys for moving forward and backward in a buffer instead switch branch
|
;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
|
;;
|
;; Clicking with the mouse on any node in the visualizer will take you
|
;; directly to that node, resetting the state of the parent buffer to the
|
;; state represented by that node.
|
;;
|
;; You can also select nodes directly using the keyboard, by hitting "s" to
|
;; toggle selection mode. The usual motion keys now allow you to move around
|
;; the tree without changing the parent buffer. Hitting <enter> will reset the
|
;; state of the parent buffer to the state represented by the currently
|
;; selected node.
|
;;
|
;; It can be useful to see how long ago the parent buffer was in the state
|
;; represented by a particular node in the visualizer. Hitting "t" in the
|
;; visualizer toggles the display of time-stamps for all the nodes. (Note
|
;; that, because of the way `undo-tree-mode' works, these time-stamps may be
|
;; somewhat later than the true times, especially if it's been a long time
|
;; since you last undid any changes.)
|
;;
|
;; To get some idea of what changes are represented by a given node in the
|
;; tree, it can be useful to see a diff of the changes. Hit "d" in the
|
;; visualizer to toggle a diff display. This normally displays a diff between
|
;; the current state and the previous one, i.e. it shows you the changes that
|
;; will be applied if you undo (move up the tree). However, the diff display
|
;; really comes into its own in the visualizer's selection mode (see above),
|
;; where it instead shows a diff between the current state and the currently
|
;; selected state, i.e. it shows you the changes that will be applied if you
|
;; reset to the selected state.
|
;;
|
;; (Note that the diff is generated by the Emacs `diff' command, and is
|
;; displayed using `diff-mode'. See the corresponding customization groups if
|
;; you want to customize the diff display.)
|
;;
|
;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
|
;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
|
;; returning the parent buffer to whatever state it was originally in when the
|
;; visualizer was .
|
;;
|
;;
|
;;
|
;; Undo-in-Region
|
;; ==============
|
;;
|
;; Emacs allows a very useful and powerful method of undoing only selected
|
;; changes: when a region is active, only changes that affect the text within
|
;; that region will be undone. With the standard Emacs undo system, changes
|
;; produced by undoing-in-region naturally get added onto the end of the
|
;; linear undo history:
|
;;
|
;; o
|
;; |
|
;; | x (second undo-in-region)
|
;; o |
|
;; | |
|
;; | o (first undo-in-region)
|
;; o |
|
;; | /
|
;; |/
|
;; o
|
;;
|
;; You can of course redo these undos-in-region as usual, by undoing the
|
;; undos:
|
;;
|
;; o
|
;; |
|
;; | o_
|
;; o | \
|
;; | | |
|
;; | o o (undo the undo-in-region)
|
;; o | |
|
;; | / |
|
;; |/ |
|
;; o x (undo the undo-in-region)
|
;;
|
;;
|
;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
|
;; region, undoing only undoes changes that affect that region. However, the
|
;; way these undos-in-region are recorded in the undo history is quite
|
;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
|
;; undo history. The new branch consists of an undo step that undoes some of
|
;; the changes that affect the current region, and another step that undoes
|
;; the remaining changes needed to rejoin the previous undo history.
|
;;
|
;; Previous undo history Undo-in-region
|
;;
|
;; o o
|
;; | |
|
;; | |
|
;; o o
|
;; | |\
|
;; | | \
|
;; o o x (undo-in-region)
|
;; | | |
|
;; | | |
|
;; x o o
|
;;
|
;; As long as you don't change the active region after undoing-in-region,
|
;; continuing to undo-in-region extends the new branch, pulling more changes
|
;; that affect the current region into an undo step immediately above your
|
;; current location in the undo tree, and pushing the point at which the new
|
;; branch is attached further up the tree:
|
;;
|
;; First undo-in-region Second undo-in-region
|
;;
|
;; o o
|
;; | |\
|
;; | | \
|
;; o o x (undo-in-region)
|
;; |\ | |
|
;; | \ | |
|
;; o x o o
|
;; | | | |
|
;; | | | |
|
;; o o o o
|
;;
|
;; Redoing takes you back down the undo tree, as usual (as long as you haven't
|
;; changed the active region after undoing-in-region, it doesn't matter if it
|
;; is still active):
|
;;
|
;; o
|
;; |\
|
;; | \
|
;; o o
|
;; | |
|
;; | |
|
;; o o (redo)
|
;; | |
|
;; | |
|
;; o x (redo)
|
;;
|
;;
|
;; What about redo-in-region? Obviously, this only makes sense if you have
|
;; already undone some changes, so that there are some changes to redo!
|
;; Redoing-in-region splits off a new branch of the undo history below your
|
;; current location in the undo tree. This time, the new branch consists of a
|
;; redo step that redoes some of the redo changes that affect the current
|
;; region, followed by all the remaining redo changes.
|
;;
|
;; Previous undo history Redo-in-region
|
;;
|
;; o o
|
;; | |
|
;; | |
|
;; x o
|
;; | |\
|
;; | | \
|
;; o o x (redo-in-region)
|
;; | | |
|
;; | | |
|
;; o o o
|
;;
|
;; As long as you don't change the active region after redoing-in-region,
|
;; continuing to redo-in-region extends the new branch, pulling more redo
|
;; changes into a redo step immediately below your current location in the
|
;; undo tree.
|
;;
|
;; First redo-in-region Second redo-in-region
|
;;
|
;; o o
|
;; | |
|
;; | |
|
;; o o
|
;; |\ |\
|
;; | \ | \
|
;; o x (redo-in-region) o o
|
;; | | | |
|
;; | | | |
|
;; o o o x (redo-in-region)
|
;; |
|
;; |
|
;; o
|
;;
|
;; Note that undo-in-region and redo-in-region only ever add new changes to
|
;; the undo tree, they *never* modify existing undo history. So you can always
|
;; return to previous buffer states by switching to a previous branch of the
|
;; tree.
|
|
|
|
;;; Code:
|
|
(eval-when-compile (require 'cl))
|
(require 'diff)
|
|
|
|
;;; =====================================================================
|
;;; Compatibility hacks for older Emacsen
|
|
;; `characterp' isn't defined in Emacs versions < 23
|
(unless (fboundp 'characterp)
|
(defalias 'characterp 'char-valid-p))
|
|
;; `region-active-p' isn't defined in Emacs versions < 23
|
(unless (fboundp 'region-active-p)
|
(defun region-active-p () (and transient-mark-mode mark-active)))
|
|
|
;; `registerv' defstruct isn't defined in Emacs versions < 24
|
(unless (fboundp 'registerv-make)
|
(defmacro registerv-make (data &rest _dummy) data))
|
|
(unless (fboundp 'registerv-data)
|
(defmacro registerv-data (data) data))
|
|
|
;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
|
;; versions < 24 (copied and adapted from Emacs 24)
|
(unless (fboundp 'diff-no-select)
|
(defun diff-no-select (old new &optional switches no-async buf)
|
;; Noninteractive helper for creating and reverting diff buffers
|
(unless (bufferp new) (setq new (expand-file-name new)))
|
(unless (bufferp old) (setq old (expand-file-name old)))
|
(or switches (setq switches diff-switches)) ; If not specified, use default.
|
(unless (listp switches) (setq switches (list switches)))
|
(or buf (setq buf (get-buffer-create "*Diff*")))
|
(let* ((old-alt (diff-file-local-copy old))
|
(new-alt (diff-file-local-copy new))
|
(command
|
(mapconcat 'identity
|
`(,diff-command
|
;; Use explicitly specified switches
|
,@switches
|
,@(mapcar #'shell-quote-argument
|
(nconc
|
(when (or old-alt new-alt)
|
(list "-L" (if (stringp old)
|
old (prin1-to-string old))
|
"-L" (if (stringp new)
|
new (prin1-to-string new))))
|
(list (or old-alt old)
|
(or new-alt new)))))
|
" "))
|
(thisdir default-directory))
|
(with-current-buffer buf
|
(setq buffer-read-only t)
|
(buffer-disable-undo (current-buffer))
|
(let ((inhibit-read-only t))
|
(erase-buffer))
|
(buffer-enable-undo (current-buffer))
|
(diff-mode)
|
(set (make-local-variable 'revert-buffer-function)
|
(lambda (_ignore-auto _noconfirm)
|
(diff-no-select old new switches no-async (current-buffer))))
|
(setq default-directory thisdir)
|
(let ((inhibit-read-only t))
|
(insert command "\n"))
|
(if (and (not no-async) (fboundp 'start-process))
|
(let ((proc (start-process "Diff" buf shell-file-name
|
shell-command-switch command)))
|
(set-process-filter proc 'diff-process-filter)
|
(set-process-sentinel
|
proc (lambda (proc _msg)
|
(with-current-buffer (process-buffer proc)
|
(diff-sentinel (process-exit-status proc))
|
(if old-alt (delete-file old-alt))
|
(if new-alt (delete-file new-alt))))))
|
;; Async processes aren't available.
|
(let ((inhibit-read-only t))
|
(diff-sentinel
|
(call-process shell-file-name nil buf nil
|
shell-command-switch command))
|
(if old-alt (delete-file old-alt))
|
(if new-alt (delete-file new-alt)))))
|
buf)))
|
|
(unless (fboundp 'diff-file-local-copy)
|
(defun diff-file-local-copy (file-or-buf)
|
(if (bufferp file-or-buf)
|
(with-current-buffer file-or-buf
|
(let ((tempfile (make-temp-file "buffer-content-")))
|
(write-region nil nil tempfile nil 'nomessage)
|
tempfile))
|
(file-local-copy file-or-buf))))
|
|
|
;; `user-error' isn't defined in Emacs < 24.3
|
(unless (fboundp 'user-error)
|
(defalias 'user-error 'error)
|
;; prevent debugger being called on user errors
|
(add-to-list 'debug-ignored-errors "^No further undo information")
|
(add-to-list 'debug-ignored-errors "^No further redo information")
|
(add-to-list 'debug-ignored-errors "^No further redo information for region"))
|
|
|
|
|
|
;;; =====================================================================
|
;;; Global variables and customization options
|
|
(defvar buffer-undo-tree nil
|
"Tree of undo entries in current buffer.")
|
(put 'buffer-undo-tree 'permanent-local t)
|
(make-variable-buffer-local 'buffer-undo-tree)
|
|
|
(defgroup undo-tree nil
|
"Tree undo/redo."
|
:group 'undo)
|
|
(defcustom undo-tree-mode-lighter " Undo-Tree"
|
"Lighter displayed in mode line
|
when `undo-tree-mode' is enabled."
|
:group 'undo-tree
|
:type 'string)
|
|
|
(defcustom undo-tree-incompatible-major-modes '(term-mode)
|
"List of major-modes in which `undo-tree-mode' should not be enabled.
|
\(See `turn-on-undo-tree-mode'.\)"
|
:group 'undo-tree
|
:type '(repeat symbol))
|
|
|
(defcustom undo-tree-enable-undo-in-region t
|
"When non-nil, enable undo-in-region.
|
|
When undo-in-region is enabled, undoing or redoing when the
|
region is active (in `transient-mark-mode') or with a prefix
|
argument (not in `transient-mark-mode') only undoes changes
|
within the current region."
|
:group 'undo-tree
|
:type 'boolean)
|
|
|
(defcustom undo-tree-auto-save-history nil
|
"When non-nil, `undo-tree-mode' will save undo history to file
|
when a buffer is saved to file.
|
|
It will automatically load undo history when a buffer is loaded
|
from file, if an undo save file exists.
|
|
By default, undo-tree history is saved to a file called
|
\".<buffer-file-name>.~undo-tree~\" in the same directory as the
|
file itself. To save under a different directory, customize
|
`undo-tree-history-directory-alist' (see the documentation for
|
that variable for details).
|
|
WARNING! `undo-tree-auto-save-history' will not work properly in
|
Emacs versions prior to 24.3, so it cannot be enabled via
|
the customization interface in versions earlier than that one. To
|
ignore this warning and enable it regardless, set
|
`undo-tree-auto-save-history' to a non-nil value outside of
|
customize."
|
:group 'undo-tree
|
:type (if (version-list-< (version-to-list emacs-version) '(24 3))
|
'(choice (const :tag "<disabled>" nil))
|
'boolean))
|
|
|
(defcustom undo-tree-history-directory-alist nil
|
"Alist of filename patterns and undo history directory names.
|
Each element looks like (REGEXP . DIRECTORY). Undo history for
|
files with names matching REGEXP will be saved in DIRECTORY.
|
DIRECTORY may be relative or absolute. If it is absolute, so
|
that all matching files are backed up into the same directory,
|
the file names in this directory will be the full name of the
|
file backed up with all directory separators changed to `!' to
|
prevent clashes. This will not work correctly if your filesystem
|
truncates the resulting name.
|
|
For the common case of all backups going into one directory, the
|
alist should contain a single element pairing \".\" with the
|
appropriate directory name.
|
|
If this variable is nil, or it fails to match a filename, the
|
backup is made in the original file's directory.
|
|
On MS-DOS filesystems without long names this variable is always
|
ignored."
|
:group 'undo-tree
|
:type '(repeat (cons (regexp :tag "Regexp matching filename")
|
(directory :tag "Undo history directory name"))))
|
|
|
|
(defcustom undo-tree-visualizer-relative-timestamps t
|
"When non-nil, display times relative to current time
|
when displaying time stamps in visualizer.
|
|
Otherwise, display absolute times."
|
:group 'undo-tree
|
:type 'boolean)
|
|
|
(defcustom undo-tree-visualizer-timestamps nil
|
"When non-nil, display time-stamps by default
|
in undo-tree visualizer.
|
|
\\<undo-tree-visualizer-mode-map>You can always toggle time-stamps on and off \
|
using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
|
setting of this variable."
|
:group 'undo-tree
|
:type 'boolean)
|
|
|
(defcustom undo-tree-visualizer-diff nil
|
"When non-nil, display diff by default in undo-tree visualizer.
|
|
\\<undo-tree-visualizer-mode-map>You can always toggle the diff display \
|
using \\[undo-tree-visualizer-toggle-diff], regardless of the
|
setting of this variable."
|
:group 'undo-tree
|
:type 'boolean)
|
|
|
(defcustom undo-tree-visualizer-lazy-drawing 100
|
"When non-nil, use lazy undo-tree drawing in visualizer.
|
|
Setting this to a number causes the visualizer to switch to lazy
|
drawing when the number of nodes in the tree is larger than this
|
value.
|
|
Lazy drawing means that only the visible portion of the tree will
|
be drawn initially, and the tree will be extended later as
|
needed. For the most part, the only visible effect of this is to
|
significantly speed up displaying the visualizer for very large
|
trees.
|
|
There is one potential negative effect of lazy drawing. Other
|
branches of the tree will only be drawn once the node from which
|
they branch off becomes visible. So it can happen that certain
|
portions of the tree that would be shown with lazy drawing
|
disabled, will not be drawn immediately when it is
|
enabled. However, this effect is quite rare in practice."
|
:group 'undo-tree
|
:type '(choice (const :tag "never" nil)
|
(const :tag "always" t)
|
(integer :tag "> size")))
|
|
|
(defface undo-tree-visualizer-default-face
|
'((((class color)) :foreground "gray"))
|
"Face used to draw undo-tree in visualizer."
|
:group 'undo-tree)
|
|
(defface undo-tree-visualizer-current-face
|
'((((class color)) :foreground "red"))
|
"Face used to highlight current undo-tree node in visualizer."
|
:group 'undo-tree)
|
|
(defface undo-tree-visualizer-active-branch-face
|
'((((class color) (background dark))
|
(:foreground "white" :weight bold))
|
(((class color) (background light))
|
(:foreground "black" :weight bold)))
|
"Face used to highlight active undo-tree branch in visualizer."
|
:group 'undo-tree)
|
|
(defface undo-tree-visualizer-register-face
|
'((((class color)) :foreground "yellow"))
|
"Face used to highlight undo-tree nodes saved to a register
|
in visualizer."
|
:group 'undo-tree)
|
|
(defface undo-tree-visualizer-unmodified-face
|
'((((class color)) :foreground "cyan"))
|
"Face used to highlight nodes corresponding to unmodified buffers
|
in visualizer."
|
:group 'undo-tree)
|
|
|
(defvar undo-tree-visualizer-parent-buffer nil
|
"Parent buffer in visualizer.")
|
(put 'undo-tree-visualizer-parent-buffer 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
|
|
;; stores modification time of parent buffer's file, if any
|
(defvar undo-tree-visualizer-parent-mtime nil)
|
(put 'undo-tree-visualizer-parent-mtime 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-parent-mtime)
|
|
;; stores current horizontal spacing needed for drawing undo-tree
|
(defvar undo-tree-visualizer-spacing nil)
|
(put 'undo-tree-visualizer-spacing 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-spacing)
|
|
;; calculate horizontal spacing required for drawing tree with current
|
;; settings
|
(defsubst undo-tree-visualizer-calculate-spacing ()
|
(if undo-tree-visualizer-timestamps
|
(if undo-tree-visualizer-relative-timestamps 9 13)
|
3))
|
|
;; holds node that was current when visualizer was invoked
|
(defvar undo-tree-visualizer-initial-node nil)
|
(put 'undo-tree-visualizer-initial-node 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-initial-node)
|
|
;; holds currently selected node in visualizer selection mode
|
(defvar undo-tree-visualizer-selected-node nil)
|
(put 'undo-tree-visualizer-selected-node 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-selected)
|
|
;; used to store nodes at edge of currently drawn portion of tree
|
(defvar undo-tree-visualizer-needs-extending-down nil)
|
(put 'undo-tree-visualizer-needs-extending-down 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-down)
|
(defvar undo-tree-visualizer-needs-extending-up nil)
|
(put 'undo-tree-visualizer-needs-extending-up 'permanent-local t)
|
(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-up)
|
|
;; dynamically bound to t when undoing from visualizer, to inhibit
|
;; `undo-tree-kill-visualizer' hook function in parent buffer
|
(defvar undo-tree-inhibit-kill-visualizer nil)
|
|
;; can be let-bound to a face name, used in drawing functions
|
(defvar undo-tree-insert-face nil)
|
|
;; visualizer buffer names
|
(defconst undo-tree-visualizer-buffer-name " *undo-tree*")
|
(defconst undo-tree-diff-buffer-name "*undo-tree Diff*")
|
|
;; install history-auto-save hooks
|
(add-hook 'write-file-functions 'undo-tree-save-history-hook)
|
(add-hook 'find-file-hook 'undo-tree-load-history-hook)
|
|
|
|
|
;;; =================================================================
|
;;; Default keymaps
|
|
(defvar undo-tree-map nil
|
"Keymap used in undo-tree-mode.")
|
|
(unless undo-tree-map
|
(let ((map (make-sparse-keymap)))
|
;; remap `undo' and `undo-only' to `undo-tree-undo'
|
(define-key map [remap undo] 'undo-tree-undo)
|
(define-key map [remap undo-only] 'undo-tree-undo)
|
;; bind standard undo bindings (since these match redo counterparts)
|
(define-key map (kbd "C-/") 'undo-tree-undo)
|
(define-key map "\C-_" 'undo-tree-undo)
|
;; redo doesn't exist normally, so define our own keybindings
|
(define-key map (kbd "C-?") 'undo-tree-redo)
|
(define-key map (kbd "M-_") 'undo-tree-redo)
|
;; just in case something has defined `redo'...
|
(define-key map [remap redo] 'undo-tree-redo)
|
;; we use "C-x u" for the undo-tree visualizer
|
(define-key map (kbd "\C-x u") 'undo-tree-visualize)
|
;; bind register commands
|
(define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
|
(define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
|
;; set keymap
|
(setq undo-tree-map map)))
|
|
|
(defvar undo-tree-visualizer-mode-map nil
|
"Keymap used in undo-tree visualizer.")
|
|
(unless undo-tree-visualizer-mode-map
|
(let ((map (make-sparse-keymap)))
|
;; vertical motion keys undo/redo
|
(define-key map [remap previous-line] 'undo-tree-visualize-undo)
|
(define-key map [remap next-line] 'undo-tree-visualize-redo)
|
(define-key map [up] 'undo-tree-visualize-undo)
|
(define-key map "p" 'undo-tree-visualize-undo)
|
(define-key map "\C-p" 'undo-tree-visualize-undo)
|
(define-key map [down] 'undo-tree-visualize-redo)
|
(define-key map "n" 'undo-tree-visualize-redo)
|
(define-key map "\C-n" 'undo-tree-visualize-redo)
|
;; horizontal motion keys switch branch
|
(define-key map [remap forward-char]
|
'undo-tree-visualize-switch-branch-right)
|
(define-key map [remap backward-char]
|
'undo-tree-visualize-switch-branch-left)
|
(define-key map [right] 'undo-tree-visualize-switch-branch-right)
|
(define-key map "f" 'undo-tree-visualize-switch-branch-right)
|
(define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
|
(define-key map [left] 'undo-tree-visualize-switch-branch-left)
|
(define-key map "b" 'undo-tree-visualize-switch-branch-left)
|
(define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
|
;; paragraph motion keys undo/redo to significant points in tree
|
(define-key map [remap backward-paragraph] 'undo-tree-visualize-undo-to-x)
|
(define-key map [remap forward-paragraph] 'undo-tree-visualize-redo-to-x)
|
(define-key map "\M-{" 'undo-tree-visualize-undo-to-x)
|
(define-key map "\M-}" 'undo-tree-visualize-redo-to-x)
|
(define-key map [C-up] 'undo-tree-visualize-undo-to-x)
|
(define-key map [C-down] 'undo-tree-visualize-redo-to-x)
|
;; mouse sets buffer state to node at click
|
(define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
|
;; toggle timestamps
|
(define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
|
;; toggle diff
|
(define-key map "d" 'undo-tree-visualizer-toggle-diff)
|
;; toggle selection mode
|
(define-key map "s" 'undo-tree-visualizer-selection-mode)
|
;; horizontal scrolling may be needed if the tree is very wide
|
(define-key map "," 'undo-tree-visualizer-scroll-left)
|
(define-key map "." 'undo-tree-visualizer-scroll-right)
|
(define-key map "<" 'undo-tree-visualizer-scroll-left)
|
(define-key map ">" 'undo-tree-visualizer-scroll-right)
|
;; vertical scrolling may be needed if the tree is very tall
|
(define-key map [next] 'undo-tree-visualizer-scroll-up)
|
(define-key map [prior] 'undo-tree-visualizer-scroll-down)
|
;; quit/abort visualizer
|
(define-key map "q" 'undo-tree-visualizer-quit)
|
(define-key map "\C-q" 'undo-tree-visualizer-abort)
|
;; set keymap
|
(setq undo-tree-visualizer-mode-map map)))
|
|
|
(defvar undo-tree-visualizer-selection-mode-map nil
|
"Keymap used in undo-tree visualizer selection mode.")
|
|
(unless undo-tree-visualizer-selection-mode-map
|
(let ((map (make-sparse-keymap)))
|
;; vertical motion keys move up and down tree
|
(define-key map [remap previous-line]
|
'undo-tree-visualizer-select-previous)
|
(define-key map [remap next-line]
|
'undo-tree-visualizer-select-next)
|
(define-key map [up] 'undo-tree-visualizer-select-previous)
|
(define-key map "p" 'undo-tree-visualizer-select-previous)
|
(define-key map "\C-p" 'undo-tree-visualizer-select-previous)
|
(define-key map [down] 'undo-tree-visualizer-select-next)
|
(define-key map "n" 'undo-tree-visualizer-select-next)
|
(define-key map "\C-n" 'undo-tree-visualizer-select-next)
|
;; vertical scroll keys move up and down quickly
|
(define-key map [next]
|
(lambda () (interactive) (undo-tree-visualizer-select-next 10)))
|
(define-key map [prior]
|
(lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
|
;; horizontal motion keys move to left and right siblings
|
(define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
|
(define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
|
(define-key map [right] 'undo-tree-visualizer-select-right)
|
(define-key map "f" 'undo-tree-visualizer-select-right)
|
(define-key map "\C-f" 'undo-tree-visualizer-select-right)
|
(define-key map [left] 'undo-tree-visualizer-select-left)
|
(define-key map "b" 'undo-tree-visualizer-select-left)
|
(define-key map "\C-b" 'undo-tree-visualizer-select-left)
|
;; horizontal scroll keys move left or right quickly
|
(define-key map ","
|
(lambda () (interactive) (undo-tree-visualizer-select-left 10)))
|
(define-key map "."
|
(lambda () (interactive) (undo-tree-visualizer-select-right 10)))
|
(define-key map "<"
|
(lambda () (interactive) (undo-tree-visualizer-select-left 10)))
|
(define-key map ">"
|
(lambda () (interactive) (undo-tree-visualizer-select-right 10)))
|
;; <enter> sets buffer state to node at point
|
(define-key map "\r" 'undo-tree-visualizer-set)
|
;; mouse selects node at click
|
(define-key map [mouse-1] 'undo-tree-visualizer-mouse-select)
|
;; toggle diff
|
(define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
|
;; set keymap
|
(setq undo-tree-visualizer-selection-mode-map map)))
|
|
|
(defvar undo-tree-old-undo-menu-item nil)
|
|
(defun undo-tree-update-menu-bar ()
|
"Update `undo-tree-mode' Edit menu items."
|
(if undo-tree-mode
|
(progn
|
;; save old undo menu item, and install undo/redo menu items
|
(setq undo-tree-old-undo-menu-item
|
(cdr (assq 'undo (lookup-key global-map [menu-bar edit]))))
|
(define-key (lookup-key global-map [menu-bar edit])
|
[undo] '(menu-item "Undo" undo-tree-undo
|
:enable (and undo-tree-mode
|
(not buffer-read-only)
|
(not (eq t buffer-undo-list))
|
(undo-tree-node-previous
|
(undo-tree-current buffer-undo-tree)))
|
:help "Undo last operation"))
|
(define-key-after (lookup-key global-map [menu-bar edit])
|
[redo] '(menu-item "Redo" undo-tree-redo
|
:enable (and undo-tree-mode
|
(not buffer-read-only)
|
(not (eq t buffer-undo-list))
|
(undo-tree-node-next
|
(undo-tree-current buffer-undo-tree)))
|
:help "Redo last operation")
|
'undo))
|
;; uninstall undo/redo menu items
|
(define-key (lookup-key global-map [menu-bar edit])
|
[undo] undo-tree-old-undo-menu-item)
|
(define-key (lookup-key global-map [menu-bar edit])
|
[redo] nil)))
|
|
(add-hook 'menu-bar-update-hook 'undo-tree-update-menu-bar)
|
|
|
|
|
|
;;; =====================================================================
|
;;; Undo-tree data structure
|
|
(defstruct
|
(undo-tree
|
:named
|
(:constructor nil)
|
(:constructor make-undo-tree
|
(&aux
|
(root (undo-tree-make-node nil nil))
|
(current root)
|
(size 0)
|
(count 0)
|
(object-pool (make-hash-table :test 'eq :weakness 'value))))
|
;;(:copier nil)
|
)
|
root current size count object-pool)
|
|
|
|
(defstruct
|
(undo-tree-node
|
(:type vector) ; create unnamed struct
|
(:constructor nil)
|
(:constructor undo-tree-make-node
|
(previous undo
|
&optional redo
|
&aux
|
(timestamp (current-time))
|
(branch 0)))
|
(:constructor undo-tree-make-node-backwards
|
(next-node undo
|
&optional redo
|
&aux
|
(next (list next-node))
|
(timestamp (current-time))
|
(branch 0)))
|
(:copier nil))
|
previous next undo redo timestamp branch meta-data)
|
|
|
(defmacro undo-tree-node-p (n)
|
(let ((len (length (undo-tree-make-node nil nil))))
|
`(and (vectorp ,n) (= (length ,n) ,len))))
|
|
|
|
(defstruct
|
(undo-tree-region-data
|
(:type vector) ; create unnamed struct
|
(:constructor nil)
|
(:constructor undo-tree-make-region-data
|
(&optional undo-beginning undo-end
|
redo-beginning redo-end))
|
(:constructor undo-tree-make-undo-region-data
|
(undo-beginning undo-end))
|
(:constructor undo-tree-make-redo-region-data
|
(redo-beginning redo-end))
|
(:copier nil))
|
undo-beginning undo-end redo-beginning redo-end)
|
|
|
(defmacro undo-tree-region-data-p (r)
|
(let ((len (length (undo-tree-make-region-data))))
|
`(and (vectorp ,r) (= (length ,r) ,len))))
|
|
(defmacro undo-tree-node-clear-region-data (node)
|
`(setf (undo-tree-node-meta-data ,node)
|
(delq nil
|
(delq :region
|
(plist-put (undo-tree-node-meta-data ,node)
|
:region nil)))))
|
|
|
(defmacro undo-tree-node-undo-beginning (node)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(when (undo-tree-region-data-p r)
|
(undo-tree-region-data-undo-beginning r))))
|
|
(defmacro undo-tree-node-undo-end (node)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(when (undo-tree-region-data-p r)
|
(undo-tree-region-data-undo-end r))))
|
|
(defmacro undo-tree-node-redo-beginning (node)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(when (undo-tree-region-data-p r)
|
(undo-tree-region-data-redo-beginning r))))
|
|
(defmacro undo-tree-node-redo-end (node)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(when (undo-tree-region-data-p r)
|
(undo-tree-region-data-redo-end r))))
|
|
|
(defsetf undo-tree-node-undo-beginning (node) (val)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(unless (undo-tree-region-data-p r)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :region
|
(setq r (undo-tree-make-region-data)))))
|
(setf (undo-tree-region-data-undo-beginning r) ,val)))
|
|
(defsetf undo-tree-node-undo-end (node) (val)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(unless (undo-tree-region-data-p r)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :region
|
(setq r (undo-tree-make-region-data)))))
|
(setf (undo-tree-region-data-undo-end r) ,val)))
|
|
(defsetf undo-tree-node-redo-beginning (node) (val)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(unless (undo-tree-region-data-p r)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :region
|
(setq r (undo-tree-make-region-data)))))
|
(setf (undo-tree-region-data-redo-beginning r) ,val)))
|
|
(defsetf undo-tree-node-redo-end (node) (val)
|
`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
|
(unless (undo-tree-region-data-p r)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :region
|
(setq r (undo-tree-make-region-data)))))
|
(setf (undo-tree-region-data-redo-end r) ,val)))
|
|
|
|
(defstruct
|
(undo-tree-visualizer-data
|
(:type vector) ; create unnamed struct
|
(:constructor nil)
|
(:constructor undo-tree-make-visualizer-data
|
(&optional lwidth cwidth rwidth marker))
|
(:copier nil))
|
lwidth cwidth rwidth marker)
|
|
|
(defmacro undo-tree-visualizer-data-p (v)
|
(let ((len (length (undo-tree-make-visualizer-data))))
|
`(and (vectorp ,v) (= (length ,v) ,len))))
|
|
(defun undo-tree-node-clear-visualizer-data (node)
|
(let ((plist (undo-tree-node-meta-data node)))
|
(if (eq (car plist) :visualizer)
|
(setf (undo-tree-node-meta-data node) (nthcdr 2 plist))
|
(while (and plist (not (eq (cadr plist) :visualizer)))
|
(setq plist (cdr plist)))
|
(if plist (setcdr plist (nthcdr 3 plist))))))
|
|
(defmacro undo-tree-node-lwidth (node)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(when (undo-tree-visualizer-data-p v)
|
(undo-tree-visualizer-data-lwidth v))))
|
|
(defmacro undo-tree-node-cwidth (node)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(when (undo-tree-visualizer-data-p v)
|
(undo-tree-visualizer-data-cwidth v))))
|
|
(defmacro undo-tree-node-rwidth (node)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(when (undo-tree-visualizer-data-p v)
|
(undo-tree-visualizer-data-rwidth v))))
|
|
(defmacro undo-tree-node-marker (node)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(when (undo-tree-visualizer-data-p v)
|
(undo-tree-visualizer-data-marker v))))
|
|
|
(defsetf undo-tree-node-lwidth (node) (val)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(unless (undo-tree-visualizer-data-p v)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :visualizer
|
(setq v (undo-tree-make-visualizer-data)))))
|
(setf (undo-tree-visualizer-data-lwidth v) ,val)))
|
|
(defsetf undo-tree-node-cwidth (node) (val)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(unless (undo-tree-visualizer-data-p v)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :visualizer
|
(setq v (undo-tree-make-visualizer-data)))))
|
(setf (undo-tree-visualizer-data-cwidth v) ,val)))
|
|
(defsetf undo-tree-node-rwidth (node) (val)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(unless (undo-tree-visualizer-data-p v)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :visualizer
|
(setq v (undo-tree-make-visualizer-data)))))
|
(setf (undo-tree-visualizer-data-rwidth v) ,val)))
|
|
(defsetf undo-tree-node-marker (node) (val)
|
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
|
(unless (undo-tree-visualizer-data-p v)
|
(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :visualizer
|
(setq v (undo-tree-make-visualizer-data)))))
|
(setf (undo-tree-visualizer-data-marker v) ,val)))
|
|
|
|
(defstruct
|
(undo-tree-register-data
|
(:type vector)
|
(:constructor nil)
|
(:constructor undo-tree-make-register-data (buffer node)))
|
buffer node)
|
|
(defun undo-tree-register-data-p (data)
|
(and (vectorp data)
|
(= (length data) 2)
|
(undo-tree-node-p (undo-tree-register-data-node data))))
|
|
(defun undo-tree-register-data-print-func (data)
|
(princ (format "an undo-tree state for buffer %s"
|
(undo-tree-register-data-buffer data))))
|
|
(defmacro undo-tree-node-register (node)
|
`(plist-get (undo-tree-node-meta-data ,node) :register))
|
|
(defsetf undo-tree-node-register (node) (val)
|
`(setf (undo-tree-node-meta-data ,node)
|
(plist-put (undo-tree-node-meta-data ,node) :register ,val)))
|
|
|
|
|
;;; =====================================================================
|
;;; Basic undo-tree data structure functions
|
|
(defun undo-tree-grow (undo)
|
"Add an UNDO node to current branch of `buffer-undo-tree'."
|
(let* ((current (undo-tree-current buffer-undo-tree))
|
(new (undo-tree-make-node current undo)))
|
(push new (undo-tree-node-next current))
|
(setf (undo-tree-current buffer-undo-tree) new)))
|
|
|
(defun undo-tree-grow-backwards (node undo &optional redo)
|
"Add new node *above* undo-tree NODE, and return new node.
|
Note that this will overwrite NODE's \"previous\" link, so should
|
only be used on a detached NODE, never on nodes that are already
|
part of `buffer-undo-tree'."
|
(let ((new (undo-tree-make-node-backwards node undo redo)))
|
(setf (undo-tree-node-previous node) new)
|
new))
|
|
|
(defun undo-tree-splice-node (node splice)
|
"Splice NODE into undo tree, below node SPLICE.
|
Note that this will overwrite NODE's \"next\" and \"previous\"
|
links, so should only be used on a detached NODE, never on nodes
|
that are already part of `buffer-undo-tree'."
|
(setf (undo-tree-node-next node) (undo-tree-node-next splice)
|
(undo-tree-node-branch node) (undo-tree-node-branch splice)
|
(undo-tree-node-previous node) splice
|
(undo-tree-node-next splice) (list node)
|
(undo-tree-node-branch splice) 0)
|
(dolist (n (undo-tree-node-next node))
|
(setf (undo-tree-node-previous n) node)))
|
|
|
(defun undo-tree-snip-node (node)
|
"Snip NODE out of undo tree."
|
(let* ((parent (undo-tree-node-previous node))
|
position p)
|
;; if NODE is only child, replace parent's next links with NODE's
|
(if (= (length (undo-tree-node-next parent)) 0)
|
(setf (undo-tree-node-next parent) (undo-tree-node-next node)
|
(undo-tree-node-branch parent) (undo-tree-node-branch node))
|
;; otherwise...
|
(setq position (undo-tree-position node (undo-tree-node-next parent)))
|
(cond
|
;; if active branch used do go via NODE, set parent's branch to active
|
;; branch of NODE
|
((= (undo-tree-node-branch parent) position)
|
(setf (undo-tree-node-branch parent)
|
(+ position (undo-tree-node-branch node))))
|
;; if active branch didn't go via NODE, update parent's branch to point
|
;; to same node as before
|
((> (undo-tree-node-branch parent) position)
|
(incf (undo-tree-node-branch parent)
|
(1- (length (undo-tree-node-next node))))))
|
;; replace NODE in parent's next list with NODE's entire next list
|
(if (= position 0)
|
(setf (undo-tree-node-next parent)
|
(nconc (undo-tree-node-next node)
|
(cdr (undo-tree-node-next parent))))
|
(setq p (nthcdr (1- position) (undo-tree-node-next parent)))
|
(setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
|
;; update previous links of NODE's children
|
(dolist (n (undo-tree-node-next node))
|
(setf (undo-tree-node-previous n) parent))))
|
|
|
(defun undo-tree-mapc (--undo-tree-mapc-function-- node)
|
;; Apply FUNCTION to NODE and to each node below it.
|
(let ((stack (list node))
|
n)
|
(while stack
|
(setq n (pop stack))
|
(funcall --undo-tree-mapc-function-- n)
|
(setq stack (append (undo-tree-node-next n) stack)))))
|
|
|
(defmacro undo-tree-num-branches ()
|
"Return number of branches at current undo tree node."
|
'(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
|
|
|
(defun undo-tree-position (node list)
|
"Find the first occurrence of NODE in LIST.
|
Return the index of the matching item, or nil of not found.
|
Comparison is done with `eq'."
|
(let ((i 0))
|
(catch 'found
|
(while (progn
|
(when (eq node (car list)) (throw 'found i))
|
(incf i)
|
(setq list (cdr list))))
|
nil)))
|
|
|
(defvar *undo-tree-id-counter* 0)
|
(make-variable-buffer-local '*undo-tree-id-counter*)
|
|
(defmacro undo-tree-generate-id ()
|
;; Generate a new, unique id (uninterned symbol).
|
;; The name is made by appending a number to "undo-tree-id".
|
;; (Copied from CL package `gensym'.)
|
`(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*))))
|
(make-symbol (format "undo-tree-id%d" num))))
|
|
|
(defun undo-tree-decircle (undo-tree)
|
;; Nullify PREVIOUS links of UNDO-TREE nodes, to make UNDO-TREE data
|
;; structure non-circular.
|
(undo-tree-mapc
|
(lambda (node)
|
(dolist (n (undo-tree-node-next node))
|
(setf (undo-tree-node-previous n) nil)))
|
(undo-tree-root undo-tree)))
|
|
|
(defun undo-tree-recircle (undo-tree)
|
;; Recreate PREVIOUS links of UNDO-TREE nodes, to restore circular UNDO-TREE
|
;; data structure.
|
(undo-tree-mapc
|
(lambda (node)
|
(dolist (n (undo-tree-node-next node))
|
(setf (undo-tree-node-previous n) node)))
|
(undo-tree-root undo-tree)))
|
|
|
|
|
;;; =====================================================================
|
;;; Undo list and undo changeset utility functions
|
|
(defmacro undo-list-marker-elt-p (elt)
|
`(markerp (car-safe ,elt)))
|
|
(defmacro undo-list-GCd-marker-elt-p (elt)
|
;; Return t if ELT is a marker element whose marker has been moved to the
|
;; object-pool, so may potentially have been garbage-collected.
|
;; Note: Valid marker undo elements should be uniquely identified as cons
|
;; cells with a symbol in the car (replacing the marker), and a number in
|
;; the cdr. However, to guard against future changes to undo element
|
;; formats, we perform an additional redundant check on the symbol name.
|
`(and (car-safe ,elt)
|
(symbolp (car ,elt))
|
(let ((str (symbol-name (car ,elt))))
|
(and (> (length str) 12)
|
(string= (substring str 0 12) "undo-tree-id")))
|
(numberp (cdr-safe ,elt))))
|
|
|
(defun undo-tree-move-GC-elts-to-pool (elt)
|
;; Move elements that can be garbage-collected into `buffer-undo-tree'
|
;; object pool, substituting a unique id that can be used to retrieve them
|
;; later. (Only markers require this treatment currently.)
|
(when (undo-list-marker-elt-p elt)
|
(let ((id (undo-tree-generate-id)))
|
(puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
|
(setcar elt id))))
|
|
|
(defun undo-tree-restore-GC-elts-from-pool (elt)
|
;; Replace object id's in ELT with corresponding objects from
|
;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
|
;; any object in ELT has been garbage-collected.
|
(if (undo-list-GCd-marker-elt-p elt)
|
(when (setcar elt (gethash (car elt)
|
(undo-tree-object-pool buffer-undo-tree)))
|
elt)
|
elt))
|
|
|
(defun undo-list-clean-GCd-elts (undo-list)
|
;; Remove object id's from UNDO-LIST that refer to elements that have been
|
;; garbage-collected. UNDO-LIST is modified by side-effect.
|
(while (undo-list-GCd-marker-elt-p (car undo-list))
|
(unless (gethash (caar undo-list)
|
(undo-tree-object-pool buffer-undo-tree))
|
(setq undo-list (cdr undo-list))))
|
(let ((p undo-list))
|
(while (cdr p)
|
(when (and (undo-list-GCd-marker-elt-p (cadr p))
|
(null (gethash (car (cadr p))
|
(undo-tree-object-pool buffer-undo-tree))))
|
(setcdr p (cddr p)))
|
(setq p (cdr p))))
|
undo-list)
|
|
|
(defun undo-list-pop-changeset (&optional discard-pos)
|
;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
|
;; any position entries from changeset.
|
|
;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
|
;; at head of undo list
|
(while (or (null (car buffer-undo-list))
|
(and discard-pos (integerp (car buffer-undo-list))))
|
(setq buffer-undo-list (cdr buffer-undo-list)))
|
;; pop elements up to next undo boundary, discarding position entries if
|
;; DISCARD-POS is non-nil
|
(if (eq (car buffer-undo-list) 'undo-tree-canary)
|
(push nil buffer-undo-list)
|
(let* ((changeset (list (pop buffer-undo-list)))
|
(p changeset))
|
(while (progn
|
(undo-tree-move-GC-elts-to-pool (car p))
|
(while (and discard-pos (integerp (car buffer-undo-list)))
|
(setq buffer-undo-list (cdr buffer-undo-list)))
|
(and (car buffer-undo-list)
|
(not (eq (car buffer-undo-list) 'undo-tree-canary))))
|
(setcdr p (list (pop buffer-undo-list)))
|
(setq p (cdr p)))
|
changeset)))
|
|
|
(defun undo-tree-copy-list (undo-list)
|
;; Return a deep copy of first changeset in `undo-list'. Object id's are
|
;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
|
(when undo-list
|
(let (copy p)
|
;; if first element contains an object id, replace it with object from
|
;; pool, discarding element entirely if it's been GC'd
|
(while (null copy)
|
(setq copy
|
(undo-tree-restore-GC-elts-from-pool (pop undo-list))))
|
(setq copy (list copy)
|
p copy)
|
;; copy remaining elements, replacing object id's with objects from
|
;; pool, or discarding them entirely if they've been GC'd
|
(while undo-list
|
(when (setcdr p (undo-tree-restore-GC-elts-from-pool
|
(undo-copy-list-1 (pop undo-list))))
|
(setcdr p (list (cdr p)))
|
(setq p (cdr p))))
|
copy)))
|
|
|
|
(defun undo-list-transfer-to-tree ()
|
;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
|
|
;; `undo-list-transfer-to-tree' should never be called when undo is disabled
|
;; (i.e. `buffer-undo-tree' is t)
|
(assert (not (eq buffer-undo-tree t)))
|
|
;; if `buffer-undo-tree' is empty, create initial undo-tree
|
(when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
|
;; make sure there's a canary at end of `buffer-undo-list'
|
(when (null buffer-undo-list)
|
(setq buffer-undo-list '(nil undo-tree-canary)))
|
|
(unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
|
(eq (car buffer-undo-list) 'undo-tree-canary))
|
;; create new node from first changeset in `buffer-undo-list', save old
|
;; `buffer-undo-tree' current node, and make new node the current node
|
(let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
|
(splice (undo-tree-current buffer-undo-tree))
|
(size (undo-list-byte-size (undo-tree-node-undo node)))
|
(count 1))
|
(setf (undo-tree-current buffer-undo-tree) node)
|
;; grow tree fragment backwards using `buffer-undo-list' changesets
|
(while (and buffer-undo-list
|
(not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
|
(setq node
|
(undo-tree-grow-backwards node (undo-list-pop-changeset)))
|
(incf size (undo-list-byte-size (undo-tree-node-undo node)))
|
(incf count))
|
;; if no undo history has been discarded from `buffer-undo-list' since
|
;; last transfer, splice new tree fragment onto end of old
|
;; `buffer-undo-tree' current node
|
(if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
|
(eq (car buffer-undo-list) 'undo-tree-canary))
|
(progn
|
(setf (undo-tree-node-previous node) splice)
|
(push node (undo-tree-node-next splice))
|
(setf (undo-tree-node-branch splice) 0)
|
(incf (undo-tree-size buffer-undo-tree) size)
|
(incf (undo-tree-count buffer-undo-tree) count))
|
;; if undo history has been discarded, replace entire
|
;; `buffer-undo-tree' with new tree fragment
|
(setq node (undo-tree-grow-backwards node nil))
|
(setf (undo-tree-root buffer-undo-tree) node)
|
(setq buffer-undo-list '(nil undo-tree-canary))
|
(setf (undo-tree-size buffer-undo-tree) size)
|
(setf (undo-tree-count buffer-undo-tree) count)
|
(setq buffer-undo-list '(nil undo-tree-canary))))
|
;; discard undo history if necessary
|
(undo-tree-discard-history)))
|
|
|
(defun undo-list-byte-size (undo-list)
|
;; Return size (in bytes) of UNDO-LIST
|
(let ((size 0) (p undo-list))
|
(while p
|
(incf size 8) ; cons cells use up 8 bytes
|
(when (and (consp (car p)) (stringp (caar p)))
|
(incf size (string-bytes (caar p))))
|
(setq p (cdr p)))
|
size))
|
|
|
|
(defun undo-list-rebuild-from-tree ()
|
"Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
|
(unless (eq buffer-undo-list t)
|
(undo-list-transfer-to-tree)
|
(setq buffer-undo-list nil)
|
(when buffer-undo-tree
|
(let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
|
(push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
|
(lambda (a b)
|
(time-less-p (undo-tree-node-timestamp a)
|
(undo-tree-node-timestamp b))))
|
stack)
|
;; Traverse tree in depth-and-oldest-first order, but add undo records
|
;; on the way down, and redo records on the way up.
|
(while (or (car stack)
|
(not (eq (car (nth 1 stack))
|
(undo-tree-current buffer-undo-tree))))
|
(if (car stack)
|
(progn
|
(setq buffer-undo-list
|
(append (undo-tree-node-undo (caar stack))
|
buffer-undo-list))
|
(undo-boundary)
|
(push (sort (mapcar 'identity
|
(undo-tree-node-next (caar stack)))
|
(lambda (a b)
|
(time-less-p (undo-tree-node-timestamp a)
|
(undo-tree-node-timestamp b))))
|
stack))
|
(pop stack)
|
(setq buffer-undo-list
|
(append (undo-tree-node-redo (caar stack))
|
buffer-undo-list))
|
(undo-boundary)
|
(pop (car stack))))))))
|
|
|
|
|
;;; =====================================================================
|
;;; History discarding utility functions
|
|
(defun undo-tree-oldest-leaf (node)
|
;; Return oldest leaf node below NODE.
|
(while (undo-tree-node-next node)
|
(setq node
|
(car (sort (mapcar 'identity (undo-tree-node-next node))
|
(lambda (a b)
|
(time-less-p (undo-tree-node-timestamp a)
|
(undo-tree-node-timestamp b)))))))
|
node)
|
|
|
(defun undo-tree-discard-node (node)
|
;; Discard NODE from `buffer-undo-tree', and return next in line for
|
;; discarding.
|
|
;; don't discard current node
|
(unless (eq node (undo-tree-current buffer-undo-tree))
|
|
;; discarding root node...
|
(if (eq node (undo-tree-root buffer-undo-tree))
|
(cond
|
;; should always discard branches before root
|
((> (length (undo-tree-node-next node)) 1)
|
(error "Trying to discard undo-tree root which still\
|
has multiple branches"))
|
;; don't discard root if current node is only child
|
((eq (car (undo-tree-node-next node))
|
(undo-tree-current buffer-undo-tree))
|
nil)
|
;; discard root
|
(t
|
;; clear any register referring to root
|
(let ((r (undo-tree-node-register node)))
|
(when (and r (eq (get-register r) node))
|
(set-register r nil)))
|
;; make child of root into new root
|
(setq node (setf (undo-tree-root buffer-undo-tree)
|
(car (undo-tree-node-next node))))
|
;; update undo-tree size
|
(decf (undo-tree-size buffer-undo-tree)
|
(+ (undo-list-byte-size (undo-tree-node-undo node))
|
(undo-list-byte-size (undo-tree-node-redo node))))
|
(decf (undo-tree-count buffer-undo-tree))
|
;; discard new root's undo data and PREVIOUS link
|
(setf (undo-tree-node-undo node) nil
|
(undo-tree-node-redo node) nil
|
(undo-tree-node-previous node) nil)
|
;; if new root has branches, or new root is current node, next node
|
;; to discard is oldest leaf, otherwise it's new root
|
(if (or (> (length (undo-tree-node-next node)) 1)
|
(eq (car (undo-tree-node-next node))
|
(undo-tree-current buffer-undo-tree)))
|
(undo-tree-oldest-leaf node)
|
node)))
|
|
;; discarding leaf node...
|
(let* ((parent (undo-tree-node-previous node))
|
(current (nth (undo-tree-node-branch parent)
|
(undo-tree-node-next parent))))
|
;; clear any register referring to the discarded node
|
(let ((r (undo-tree-node-register node)))
|
(when (and r (eq (get-register r) node))
|
(set-register r nil)))
|
;; update undo-tree size
|
(decf (undo-tree-size buffer-undo-tree)
|
(+ (undo-list-byte-size (undo-tree-node-undo node))
|
(undo-list-byte-size (undo-tree-node-redo node))))
|
(decf (undo-tree-count buffer-undo-tree))
|
;; discard leaf
|
(setf (undo-tree-node-next parent)
|
(delq node (undo-tree-node-next parent))
|
(undo-tree-node-branch parent)
|
(undo-tree-position current (undo-tree-node-next parent)))
|
;; if parent has branches, or parent is current node, next node to
|
;; discard is oldest leaf, otherwise it's the parent itself
|
(if (or (eq parent (undo-tree-current buffer-undo-tree))
|
(and (undo-tree-node-next parent)
|
(or (not (eq parent (undo-tree-root buffer-undo-tree)))
|
(> (length (undo-tree-node-next parent)) 1))))
|
(undo-tree-oldest-leaf parent)
|
parent)))))
|
|
|
|
(defun undo-tree-discard-history ()
|
"Discard undo history until we're within memory usage limits
|
set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
|
|
(when (> (undo-tree-size buffer-undo-tree) undo-limit)
|
;; if there are no branches off root, first node to discard is root;
|
;; otherwise it's leaf node at botom of oldest branch
|
(let ((node (if (> (length (undo-tree-node-next
|
(undo-tree-root buffer-undo-tree))) 1)
|
(undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
|
(undo-tree-root buffer-undo-tree))))
|
|
;; discard nodes until memory use is within `undo-strong-limit'
|
(while (and node
|
(> (undo-tree-size buffer-undo-tree) undo-strong-limit))
|
(setq node (undo-tree-discard-node node)))
|
|
;; discard nodes until next node to discard would bring memory use
|
;; within `undo-limit'
|
(while (and node
|
;; check first if last discard has brought us within
|
;; `undo-limit', in case we can avoid more expensive
|
;; `undo-strong-limit' calculation
|
;; Note: this assumes undo-strong-limit > undo-limit;
|
;; if not, effectively undo-strong-limit = undo-limit
|
(> (undo-tree-size buffer-undo-tree) undo-limit)
|
(> (- (undo-tree-size buffer-undo-tree)
|
;; if next node to discard is root, the memory we
|
;; free-up comes from discarding changesets from its
|
;; only child...
|
(if (eq node (undo-tree-root buffer-undo-tree))
|
(+ (undo-list-byte-size
|
(undo-tree-node-undo
|
(car (undo-tree-node-next node))))
|
(undo-list-byte-size
|
(undo-tree-node-redo
|
(car (undo-tree-node-next node)))))
|
;; ...otherwise, it comes from discarding changesets
|
;; from along with the node itself
|
(+ (undo-list-byte-size (undo-tree-node-undo node))
|
(undo-list-byte-size (undo-tree-node-redo node)))
|
))
|
undo-limit))
|
(setq node (undo-tree-discard-node node)))
|
|
;; if we're still over the `undo-outer-limit', discard entire history
|
(when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
|
;; query first if `undo-ask-before-discard' is set
|
(if undo-ask-before-discard
|
(when (yes-or-no-p
|
(format
|
"Buffer `%s' undo info is %d bytes long; discard it? "
|
(buffer-name) (undo-tree-size buffer-undo-tree)))
|
(setq buffer-undo-tree nil))
|
;; otherwise, discard and display warning
|
(display-warning
|
'(undo discard-info)
|
(concat
|
(format "Buffer `%s' undo info was %d bytes long.\n"
|
(buffer-name) (undo-tree-size buffer-undo-tree))
|
"The undo info was discarded because it exceeded\
|
`undo-outer-limit'.
|
|
This is normal if you executed a command that made a huge change
|
to the buffer. In that case, to prevent similar problems in the
|
future, set `undo-outer-limit' to a value that is large enough to
|
cover the maximum size of normal changes you expect a single
|
command to make, but not so large that it might exceed the
|
maximum memory allotted to Emacs.
|
|
If you did not execute any such command, the situation is
|
probably due to a bug and you should report it.
|
|
You can disable the popping up of this buffer by adding the entry
|
\(undo discard-info) to the user option `warning-suppress-types',
|
which is defined in the `warnings' library.\n")
|
:warning)
|
(setq buffer-undo-tree nil)))
|
)))
|
|
|
|
|
;;; =====================================================================
|
;;; Visualizer utility functions
|
|
(defun undo-tree-compute-widths (node)
|
"Recursively compute widths for nodes below NODE."
|
(let ((stack (list node))
|
res)
|
(while stack
|
;; try to compute widths for node at top of stack
|
(if (undo-tree-node-p
|
(setq res (undo-tree-node-compute-widths (car stack))))
|
;; if computation fails, it returns a node whose widths still need
|
;; computing, which we push onto the stack
|
(push res stack)
|
;; otherwise, store widths and remove it from stack
|
(setf (undo-tree-node-lwidth (car stack)) (aref res 0)
|
(undo-tree-node-cwidth (car stack)) (aref res 1)
|
(undo-tree-node-rwidth (car stack)) (aref res 2))
|
(pop stack)))))
|
|
|
(defun undo-tree-node-compute-widths (node)
|
;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
|
;; (in a vector) if successful. Otherwise, returns a node whose widths need
|
;; calculating before NODE's can be calculated.
|
(let ((num-children (length (undo-tree-node-next node)))
|
(lwidth 0) (cwidth 0) (rwidth 0) p)
|
(catch 'need-widths
|
(cond
|
;; leaf nodes have 0 width
|
((= 0 num-children)
|
(setf cwidth 1
|
(undo-tree-node-lwidth node) 0
|
(undo-tree-node-cwidth node) 1
|
(undo-tree-node-rwidth node) 0))
|
|
;; odd number of children
|
((= (mod num-children 2) 1)
|
(setq p (undo-tree-node-next node))
|
;; compute left-width
|
(dotimes (i (/ num-children 2))
|
(if (undo-tree-node-lwidth (car p))
|
(incf lwidth (+ (undo-tree-node-lwidth (car p))
|
(undo-tree-node-cwidth (car p))
|
(undo-tree-node-rwidth (car p))))
|
;; if child's widths haven't been computed, return that child
|
(throw 'need-widths (car p)))
|
(setq p (cdr p)))
|
(if (undo-tree-node-lwidth (car p))
|
(incf lwidth (undo-tree-node-lwidth (car p)))
|
(throw 'need-widths (car p)))
|
;; centre-width is inherited from middle child
|
(setf cwidth (undo-tree-node-cwidth (car p)))
|
;; compute right-width
|
(incf rwidth (undo-tree-node-rwidth (car p)))
|
(setq p (cdr p))
|
(dotimes (i (/ num-children 2))
|
(if (undo-tree-node-lwidth (car p))
|
(incf rwidth (+ (undo-tree-node-lwidth (car p))
|
(undo-tree-node-cwidth (car p))
|
(undo-tree-node-rwidth (car p))))
|
(throw 'need-widths (car p)))
|
(setq p (cdr p))))
|
|
;; even number of children
|
(t
|
(setq p (undo-tree-node-next node))
|
;; compute left-width
|
(dotimes (i (/ num-children 2))
|
(if (undo-tree-node-lwidth (car p))
|
(incf lwidth (+ (undo-tree-node-lwidth (car p))
|
(undo-tree-node-cwidth (car p))
|
(undo-tree-node-rwidth (car p))))
|
(throw 'need-widths (car p)))
|
(setq p (cdr p)))
|
;; centre-width is 0 when number of children is even
|
(setq cwidth 0)
|
;; compute right-width
|
(dotimes (i (/ num-children 2))
|
(if (undo-tree-node-lwidth (car p))
|
(incf rwidth (+ (undo-tree-node-lwidth (car p))
|
(undo-tree-node-cwidth (car p))
|
(undo-tree-node-rwidth (car p))))
|
(throw 'need-widths (car p)))
|
(setq p (cdr p)))))
|
|
;; return left-, centre- and right-widths
|
(vector lwidth cwidth rwidth))))
|
|
|
(defun undo-tree-clear-visualizer-data (tree)
|
;; Clear visualizer data below NODE.
|
(undo-tree-mapc
|
(lambda (n) (undo-tree-node-clear-visualizer-data n))
|
(undo-tree-root tree)))
|
|
|
(defun undo-tree-node-unmodified-p (node &optional mtime)
|
;; Return non-nil if NODE corresponds to a buffer state that once upon a
|
;; time was unmodified. If a file modification time MTIME is specified,
|
;; return non-nil if the corresponding buffer state really is unmodified.
|
(let (changeset ntime)
|
(setq changeset
|
(or (undo-tree-node-redo node)
|
(and (setq changeset (car (undo-tree-node-next node)))
|
(undo-tree-node-undo changeset)))
|
ntime
|
(catch 'found
|
(dolist (elt changeset)
|
(when (and (consp elt) (eq (car elt) t) (consp (cdr elt))
|
(throw 'found (cdr elt)))))))
|
(and ntime
|
(or (null mtime)
|
;; high-precision timestamps
|
(if (listp (cdr ntime))
|
(equal ntime mtime)
|
;; old-style timestamps
|
(and (= (car ntime) (car mtime))
|
(= (cdr ntime) (cadr mtime))))))))
|
|
|
|
|
;;; =====================================================================
|
;;; Undo-in-region utility functions
|
|
;; `undo-elt-in-region' uses this as a dynamically-scoped variable
|
(defvar undo-adjusted-markers nil)
|
|
|
(defun undo-tree-pull-undo-in-region-branch (start end)
|
;; Pull out entries from undo changesets to create a new undo-in-region
|
;; branch, which undoes changeset entries lying between START and END first,
|
;; followed by remaining entries from the changesets, before rejoining the
|
;; existing undo tree history. Repeated calls will, if appropriate, extend
|
;; the current undo-in-region branch rather than creating a new one.
|
|
;; if we're just reverting the last redo-in-region, we don't need to
|
;; manipulate the undo tree at all
|
(if (undo-tree-reverting-redo-in-region-p start end)
|
t ; return t to indicate success
|
|
;; We build the `region-changeset' and `delta-list' lists forwards, using
|
;; pointers `r' and `d' to the penultimate element of the list. So that we
|
;; don't have to treat the first element differently, we prepend a dummy
|
;; leading nil to the lists, and have the pointers point to that
|
;; initially.
|
;; Note: using '(nil) instead of (list nil) in the `let*' results in
|
;; bizarre errors when the code is byte-compiled, where parts of the
|
;; lists appear to survive across different calls to this function.
|
;; An obscure byte-compiler bug, perhaps?
|
(let* ((region-changeset (list nil))
|
(r region-changeset)
|
(delta-list (list nil))
|
(d delta-list)
|
(node (undo-tree-current buffer-undo-tree))
|
(repeated-undo-in-region
|
(undo-tree-repeated-undo-in-region-p start end))
|
undo-adjusted-markers ; `undo-elt-in-region' expects this
|
fragment splice original-fragment original-splice original-current
|
got-visible-elt undo-list elt)
|
|
;; --- initialisation ---
|
(cond
|
;; if this is a repeated undo in the same region, start pulling changes
|
;; from NODE at which undo-in-region branch iss attached, and detatch
|
;; the branch, using it as initial FRAGMENT of branch being constructed
|
(repeated-undo-in-region
|
(setq original-current node
|
fragment (car (undo-tree-node-next node))
|
splice node)
|
;; undo up to node at which undo-in-region branch is attached
|
;; (recognizable as first node with more than one branch)
|
(let ((mark-active nil))
|
(while (= (length (undo-tree-node-next node)) 1)
|
(undo-tree-undo-1)
|
(setq fragment node
|
node (undo-tree-current buffer-undo-tree))))
|
(when (eq splice node) (setq splice nil))
|
;; detatch undo-in-region branch
|
(setf (undo-tree-node-next node)
|
(delq fragment (undo-tree-node-next node))
|
(undo-tree-node-previous fragment) nil
|
original-fragment fragment
|
original-splice node))
|
|
;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
|
;; nodes below the current one in the active branch
|
((undo-tree-node-next node)
|
(setq fragment (undo-tree-make-node nil nil)
|
splice fragment)
|
(while (setq node (nth (undo-tree-node-branch node)
|
(undo-tree-node-next node)))
|
(push (undo-tree-make-node
|
splice
|
(undo-copy-list (undo-tree-node-undo node))
|
(undo-copy-list (undo-tree-node-redo node)))
|
(undo-tree-node-next splice))
|
(setq splice (car (undo-tree-node-next splice))))
|
(setq fragment (car (undo-tree-node-next fragment))
|
splice nil
|
node (undo-tree-current buffer-undo-tree))))
|
|
|
;; --- pull undo-in-region elements into branch ---
|
;; work backwards up tree, pulling out undo elements within region until
|
;; we've got one that undoes a visible change (insertion or deletion)
|
(catch 'abort
|
(while (and (not got-visible-elt) node (undo-tree-node-undo node))
|
;; we cons a dummy nil element on the front of the changeset so that
|
;; we can conveniently remove the first (real) element from the
|
;; changeset if we need to; the leading nil is removed once we're
|
;; done with this changeset
|
(setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
|
elt (cadr undo-list))
|
(if fragment
|
(progn
|
(setq fragment (undo-tree-grow-backwards fragment undo-list))
|
(unless splice (setq splice fragment)))
|
(setq fragment (undo-tree-make-node nil undo-list))
|
(setq splice fragment))
|
|
(while elt
|
(cond
|
;; keep elements within region
|
((undo-elt-in-region elt start end)
|
;; set flag if kept element is visible (insertion or deletion)
|
(when (and (consp elt)
|
(or (stringp (car elt)) (integerp (car elt))))
|
(setq got-visible-elt t))
|
;; adjust buffer positions in elements previously undone before
|
;; kept element, as kept element will now be undone first
|
(undo-tree-adjust-elements-to-elt splice elt)
|
;; move kept element to undo-in-region changeset, adjusting its
|
;; buffer position as it will now be undone first
|
(setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
|
(setq r (cdr r))
|
(setcdr undo-list (cddr undo-list)))
|
|
;; discard "was unmodified" elements
|
;; FIXME: deal properly with these
|
((and (consp elt) (eq (car elt) t))
|
(setcdr undo-list (cddr undo-list)))
|
|
;; if element crosses region, we can't pull any more elements
|
((undo-elt-crosses-region elt start end)
|
;; if we've found a visible element, it must be earlier in
|
;; current node's changeset; stop pulling elements (null
|
;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
|
(if got-visible-elt
|
(setq undo-list nil)
|
;; if we haven't found a visible element yet, pulling
|
;; undo-in-region branch has failed
|
(setq region-changeset nil)
|
(throw 'abort t)))
|
|
;; if rejecting element, add its delta (if any) to the list
|
(t
|
(let ((delta (undo-delta elt)))
|
(when (/= 0 (cdr delta))
|
(setcdr d (list delta))
|
(setq d (cdr d))))
|
(setq undo-list (cdr undo-list))))
|
|
;; process next element of current changeset
|
(setq elt (cadr undo-list)))
|
|
;; if there are remaining elements in changeset, remove dummy nil
|
;; from front
|
(if (cadr (undo-tree-node-undo fragment))
|
(pop (undo-tree-node-undo fragment))
|
;; otherwise, if we've kept all elements in changeset, discard
|
;; empty changeset
|
(when (eq splice fragment) (setq splice nil))
|
(setq fragment (car (undo-tree-node-next fragment))))
|
;; process changeset from next node up the tree
|
(setq node (undo-tree-node-previous node))))
|
|
;; pop dummy nil from front of `region-changeset'
|
(setq region-changeset (cdr region-changeset))
|
|
|
;; --- integrate branch into tree ---
|
;; if no undo-in-region elements were found, restore undo tree
|
(if (null region-changeset)
|
(when original-current
|
(push original-fragment (undo-tree-node-next original-splice))
|
(setf (undo-tree-node-branch original-splice) 0
|
(undo-tree-node-previous original-fragment) original-splice)
|
(let ((mark-active nil))
|
(while (not (eq (undo-tree-current buffer-undo-tree)
|
original-current))
|
(undo-tree-redo-1)))
|
nil) ; return nil to indicate failure
|
|
;; otherwise...
|
;; need to undo up to node where new branch will be attached, to
|
;; ensure redo entries are populated, and then redo back to where we
|
;; started
|
(let ((mark-active nil)
|
(current (undo-tree-current buffer-undo-tree)))
|
(while (not (eq (undo-tree-current buffer-undo-tree) node))
|
(undo-tree-undo-1))
|
(while (not (eq (undo-tree-current buffer-undo-tree) current))
|
(undo-tree-redo-1)))
|
|
(cond
|
;; if there's no remaining fragment, just create undo-in-region node
|
;; and attach it to parent of last node from which elements were
|
;; pulled
|
((null fragment)
|
(setq fragment (undo-tree-make-node node region-changeset))
|
(push fragment (undo-tree-node-next node))
|
(setf (undo-tree-node-branch node) 0)
|
;; set current node to undo-in-region node
|
(setf (undo-tree-current buffer-undo-tree) fragment))
|
|
;; if no splice point has been set, add undo-in-region node to top of
|
;; fragment and attach it to parent of last node from which elements
|
;; were pulled
|
((null splice)
|
(setq fragment (undo-tree-grow-backwards fragment region-changeset))
|
(push fragment (undo-tree-node-next node))
|
(setf (undo-tree-node-branch node) 0
|
(undo-tree-node-previous fragment) node)
|
;; set current node to undo-in-region node
|
(setf (undo-tree-current buffer-undo-tree) fragment))
|
|
;; if fragment contains nodes, attach fragment to parent of last node
|
;; from which elements were pulled, and splice in undo-in-region node
|
(t
|
(setf (undo-tree-node-previous fragment) node)
|
(push fragment (undo-tree-node-next node))
|
(setf (undo-tree-node-branch node) 0)
|
;; if this is a repeated undo-in-region, then we've left the current
|
;; node at the original splice-point; we need to set the current
|
;; node to the equivalent node on the undo-in-region branch and redo
|
;; back to where we started
|
(when repeated-undo-in-region
|
(setf (undo-tree-current buffer-undo-tree)
|
(undo-tree-node-previous original-fragment))
|
(let ((mark-active nil))
|
(while (not (eq (undo-tree-current buffer-undo-tree) splice))
|
(undo-tree-redo-1 nil 'preserve-undo))))
|
;; splice new undo-in-region node into fragment
|
(setq node (undo-tree-make-node nil region-changeset))
|
(undo-tree-splice-node node splice)
|
;; set current node to undo-in-region node
|
(setf (undo-tree-current buffer-undo-tree) node)))
|
|
;; update undo-tree size
|
(setq node (undo-tree-node-previous fragment))
|
(while (progn
|
(and (setq node (car (undo-tree-node-next node)))
|
(not (eq node original-fragment))
|
(incf (undo-tree-count buffer-undo-tree))
|
(incf (undo-tree-size buffer-undo-tree)
|
(+ (undo-list-byte-size (undo-tree-node-undo node))
|
(undo-list-byte-size (undo-tree-node-redo node)))))))
|
t) ; indicate undo-in-region branch was successfully pulled
|
)))
|
|
|
|
(defun undo-tree-pull-redo-in-region-branch (start end)
|
;; Pull out entries from redo changesets to create a new redo-in-region
|
;; branch, which redoes changeset entries lying between START and END first,
|
;; followed by remaining entries from the changesets. Repeated calls will,
|
;; if appropriate, extend the current redo-in-region branch rather than
|
;; creating a new one.
|
|
;; if we're just reverting the last undo-in-region, we don't need to
|
;; manipulate the undo tree at all
|
(if (undo-tree-reverting-undo-in-region-p start end)
|
t ; return t to indicate success
|
|
;; We build the `region-changeset' and `delta-list' lists forwards, using
|
;; pointers `r' and `d' to the penultimate element of the list. So that we
|
;; don't have to treat the first element differently, we prepend a dummy
|
;; leading nil to the lists, and have the pointers point to that
|
;; initially.
|
;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
|
;; errors when the code is byte-compiled, where parts of the lists
|
;; appear to survive across different calls to this function. An
|
;; obscure byte-compiler bug, perhaps?
|
(let* ((region-changeset (list nil))
|
(r region-changeset)
|
(delta-list (list nil))
|
(d delta-list)
|
(node (undo-tree-current buffer-undo-tree))
|
(repeated-redo-in-region
|
(undo-tree-repeated-redo-in-region-p start end))
|
undo-adjusted-markers ; `undo-elt-in-region' expects this
|
fragment splice got-visible-elt redo-list elt)
|
|
;; --- inisitalisation ---
|
(cond
|
;; if this is a repeated redo-in-region, detach fragment below current
|
;; node
|
(repeated-redo-in-region
|
(when (setq fragment (car (undo-tree-node-next node)))
|
(setf (undo-tree-node-previous fragment) nil
|
(undo-tree-node-next node)
|
(delq fragment (undo-tree-node-next node)))))
|
;; if this is a new redo-in-region, initial fragment is a copy of all
|
;; nodes below the current one in the active branch
|
((undo-tree-node-next node)
|
(setq fragment (undo-tree-make-node nil nil)
|
splice fragment)
|
(while (setq node (nth (undo-tree-node-branch node)
|
(undo-tree-node-next node)))
|
(push (undo-tree-make-node
|
splice nil
|
(undo-copy-list (undo-tree-node-redo node)))
|
(undo-tree-node-next splice))
|
(setq splice (car (undo-tree-node-next splice))))
|
(setq fragment (car (undo-tree-node-next fragment)))))
|
|
|
;; --- pull redo-in-region elements into branch ---
|
;; work down fragment, pulling out redo elements within region until
|
;; we've got one that redoes a visible change (insertion or deletion)
|
(setq node fragment)
|
(catch 'abort
|
(while (and (not got-visible-elt) node (undo-tree-node-redo node))
|
;; we cons a dummy nil element on the front of the changeset so that
|
;; we can conveniently remove the first (real) element from the
|
;; changeset if we need to; the leading nil is removed once we're
|
;; done with this changeset
|
(setq redo-list (push nil (undo-tree-node-redo node))
|
elt (cadr redo-list))
|
(while elt
|
(cond
|
;; keep elements within region
|
((undo-elt-in-region elt start end)
|
;; set flag if kept element is visible (insertion or deletion)
|
(when (and (consp elt)
|
(or (stringp (car elt)) (integerp (car elt))))
|
(setq got-visible-elt t))
|
;; adjust buffer positions in elements previously redone before
|
;; kept element, as kept element will now be redone first
|
(undo-tree-adjust-elements-to-elt fragment elt t)
|
;; move kept element to redo-in-region changeset, adjusting its
|
;; buffer position as it will now be redone first
|
(setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
|
(setq r (cdr r))
|
(setcdr redo-list (cddr redo-list)))
|
|
;; discard "was unmodified" elements
|
;; FIXME: deal properly with these
|
((and (consp elt) (eq (car elt) t))
|
(setcdr redo-list (cddr redo-list)))
|
|
;; if element crosses region, we can't pull any more elements
|
((undo-elt-crosses-region elt start end)
|
;; if we've found a visible element, it must be earlier in
|
;; current node's changeset; stop pulling elements (null
|
;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
|
(if got-visible-elt
|
(setq redo-list nil)
|
;; if we haven't found a visible element yet, pulling
|
;; redo-in-region branch has failed
|
(setq region-changeset nil)
|
(throw 'abort t)))
|
|
;; if rejecting element, add its delta (if any) to the list
|
(t
|
(let ((delta (undo-delta elt)))
|
(when (/= 0 (cdr delta))
|
(setcdr d (list delta))
|
(setq d (cdr d))))
|
(setq redo-list (cdr redo-list))))
|
|
;; process next element of current changeset
|
(setq elt (cadr redo-list)))
|
|
;; if there are remaining elements in changeset, remove dummy nil
|
;; from front
|
(if (cadr (undo-tree-node-redo node))
|
(pop (undo-tree-node-undo node))
|
;; otherwise, if we've kept all elements in changeset, discard
|
;; empty changeset
|
(if (eq fragment node)
|
(setq fragment (car (undo-tree-node-next fragment)))
|
(undo-tree-snip-node node)))
|
;; process changeset from next node in fragment
|
(setq node (car (undo-tree-node-next node)))))
|
|
;; pop dummy nil from front of `region-changeset'
|
(setq region-changeset (cdr region-changeset))
|
|
|
;; --- integrate branch into tree ---
|
(setq node (undo-tree-current buffer-undo-tree))
|
;; if no redo-in-region elements were found, restore undo tree
|
(if (null (car region-changeset))
|
(when (and repeated-redo-in-region fragment)
|
(push fragment (undo-tree-node-next node))
|
(setf (undo-tree-node-branch node) 0
|
(undo-tree-node-previous fragment) node)
|
nil) ; return nil to indicate failure
|
|
;; otherwise, add redo-in-region node to top of fragment, and attach
|
;; it below current node
|
(setq fragment
|
(if fragment
|
(undo-tree-grow-backwards fragment nil region-changeset)
|
(undo-tree-make-node nil nil region-changeset)))
|
(push fragment (undo-tree-node-next node))
|
(setf (undo-tree-node-branch node) 0
|
(undo-tree-node-previous fragment) node)
|
;; update undo-tree size
|
(unless repeated-redo-in-region
|
(setq node fragment)
|
(while (and (setq node (car (undo-tree-node-next node)))
|
(incf (undo-tree-count buffer-undo-tree))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size
|
(undo-tree-node-redo node))))))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo fragment)))
|
t) ; indicate redo-in-region branch was successfully pulled
|
)))
|
|
|
|
(defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
|
"Adjust buffer positions of undo elements, starting at NODE's
|
and going up the tree (or down the active branch if BELOW is
|
non-nil) and through the nodes' undo elements until we reach
|
UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
|
of either NODE itself or some node above it in the tree."
|
(let ((delta (list (undo-delta undo-elt)))
|
(undo-list (undo-tree-node-undo node)))
|
;; adjust elements until we reach UNDO-ELT
|
(while (and (car undo-list)
|
(not (eq (car undo-list) undo-elt)))
|
(setcar undo-list
|
(undo-tree-apply-deltas (car undo-list) delta -1))
|
;; move to next undo element in list, or to next node if we've run out
|
;; of elements
|
(unless (car (setq undo-list (cdr undo-list)))
|
(if below
|
(setq node (nth (undo-tree-node-branch node)
|
(undo-tree-node-next node)))
|
(setq node (undo-tree-node-previous node)))
|
(setq undo-list (undo-tree-node-undo node))))))
|
|
|
|
(defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
|
;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
|
;; (only useful value for SGN is -1).
|
(let (position offset)
|
(dolist (delta deltas)
|
(setq position (car delta)
|
offset (* (cdr delta) (or sgn 1)))
|
(cond
|
;; POSITION
|
((integerp undo-elt)
|
(when (>= undo-elt position)
|
(setq undo-elt (- undo-elt offset))))
|
;; nil (or any other atom)
|
((atom undo-elt))
|
;; (TEXT . POSITION)
|
((stringp (car undo-elt))
|
(let ((text-pos (abs (cdr undo-elt)))
|
(point-at-end (< (cdr undo-elt) 0)))
|
(if (>= text-pos position)
|
(setcdr undo-elt (* (if point-at-end -1 1)
|
(- text-pos offset))))))
|
;; (BEGIN . END)
|
((integerp (car undo-elt))
|
(when (>= (car undo-elt) position)
|
(setcar undo-elt (- (car undo-elt) offset))
|
(setcdr undo-elt (- (cdr undo-elt) offset))))
|
;; (nil PROPERTY VALUE BEG . END)
|
((null (car undo-elt))
|
(let ((tail (nthcdr 3 undo-elt)))
|
(when (>= (car tail) position)
|
(setcar tail (- (car tail) offset))
|
(setcdr tail (- (cdr tail) offset)))))
|
))
|
undo-elt))
|
|
|
|
(defun undo-tree-repeated-undo-in-region-p (start end)
|
;; Return non-nil if undo-in-region between START and END is a repeated
|
;; undo-in-region
|
(let ((node (undo-tree-current buffer-undo-tree)))
|
(and (setq node
|
(nth (undo-tree-node-branch node) (undo-tree-node-next node)))
|
(eq (undo-tree-node-undo-beginning node) start)
|
(eq (undo-tree-node-undo-end node) end))))
|
|
|
(defun undo-tree-repeated-redo-in-region-p (start end)
|
;; Return non-nil if undo-in-region between START and END is a repeated
|
;; undo-in-region
|
(let ((node (undo-tree-current buffer-undo-tree)))
|
(and (eq (undo-tree-node-redo-beginning node) start)
|
(eq (undo-tree-node-redo-end node) end))))
|
|
|
;; Return non-nil if undo-in-region between START and END is simply
|
;; reverting the last redo-in-region
|
(defalias 'undo-tree-reverting-undo-in-region-p
|
'undo-tree-repeated-undo-in-region-p)
|
|
|
;; Return non-nil if redo-in-region between START and END is simply
|
;; reverting the last undo-in-region
|
(defalias 'undo-tree-reverting-redo-in-region-p
|
'undo-tree-repeated-redo-in-region-p)
|
|
|
|
|
;;; =====================================================================
|
;;; Undo-tree commands
|
|
;;;###autoload
|
(define-minor-mode undo-tree-mode
|
"Toggle undo-tree mode.
|
With no argument, this command toggles the mode.
|
A positive prefix argument turns the mode on.
|
A negative prefix argument turns it off.
|
|
Undo-tree-mode replaces Emacs' standard undo feature with a more
|
powerful yet easier to use version, that treats the undo history
|
as what it is: a tree.
|
|
The following keys are available in `undo-tree-mode':
|
|
\\{undo-tree-map}
|
|
Within the undo-tree visualizer, the following keys are available:
|
|
\\{undo-tree-visualizer-mode-map}"
|
|
nil ; init value
|
undo-tree-mode-lighter ; lighter
|
undo-tree-map ; keymap
|
|
;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
|
;; Emacs undo can work
|
(when (not undo-tree-mode)
|
(undo-list-rebuild-from-tree)
|
(setq buffer-undo-tree nil)))
|
|
|
(defun turn-on-undo-tree-mode (&optional print-message)
|
"Enable `undo-tree-mode' in the current buffer, when appropriate.
|
Some major modes implement their own undo system, which should
|
not normally be overridden by `undo-tree-mode'. This command does
|
not enable `undo-tree-mode' in such buffers. If you want to force
|
`undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
|
instead.
|
|
The heuristic used to detect major modes in which
|
`undo-tree-mode' should not be used is to check whether either
|
the `undo' command has been remapped, or the default undo
|
keybindings (C-/ and C-_) have been overridden somewhere other
|
than in the global map. In addition, `undo-tree-mode' will not be
|
enabled if the buffer's `major-mode' appears in
|
`undo-tree-incompatible-major-modes'."
|
(interactive "p")
|
(if (or (key-binding [remap undo])
|
(undo-tree-overridden-undo-bindings-p)
|
(memq major-mode undo-tree-incompatible-major-modes))
|
(when print-message
|
(message "Buffer does not support undo-tree-mode;\
|
undo-tree-mode NOT enabled"))
|
(undo-tree-mode 1)))
|
|
|
(defun undo-tree-overridden-undo-bindings-p ()
|
"Returns t if default undo bindings are overridden, nil otherwise.
|
Checks if either of the default undo key bindings (\"C-/\" or
|
\"C-_\") are overridden in the current buffer by any keymap other
|
than the global one. (So global redefinitions of the default undo
|
key bindings do not count.)"
|
(let ((binding1 (lookup-key (current-global-map) [?\C-/]))
|
(binding2 (lookup-key (current-global-map) [?\C-_])))
|
(global-set-key [?\C-/] 'undo)
|
(global-set-key [?\C-_] 'undo)
|
(unwind-protect
|
(or (and (key-binding [?\C-/])
|
(not (eq (key-binding [?\C-/]) 'undo)))
|
(and (key-binding [?\C-_])
|
(not (eq (key-binding [?\C-_]) 'undo))))
|
(global-set-key [?\C-/] binding1)
|
(global-set-key [?\C-_] binding2))))
|
|
|
;;;###autoload
|
(define-globalized-minor-mode global-undo-tree-mode
|
undo-tree-mode turn-on-undo-tree-mode)
|
|
|
|
(defun undo-tree-undo (&optional arg)
|
"Undo changes.
|
Repeat this command to undo more changes.
|
A numeric ARG serves as a repeat count.
|
|
In Transient Mark mode when the mark is active, only undo changes
|
within the current region. Similarly, when not in Transient Mark
|
mode, just \\[universal-argument] as an argument limits undo to
|
changes within the current region."
|
(interactive "*P")
|
;; throw error if undo is disabled in buffer
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
(undo-tree-undo-1 arg)
|
;; inform user if at branch point
|
(when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
|
|
|
(defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
|
;; Internal undo function. An active mark in `transient-mark-mode', or
|
;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
|
;; causes the existing redo record to be preserved, rather than replacing it
|
;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
|
;; disables updating of timestamps in visited undo-tree nodes. (This latter
|
;; should *only* be used when temporarily visiting another undo state and
|
;; immediately returning to the original state afterwards. Otherwise, it
|
;; could cause history-discarding errors.)
|
(let ((undo-in-progress t)
|
(undo-in-region (and undo-tree-enable-undo-in-region
|
(or (region-active-p)
|
(and arg (not (numberp arg))))))
|
pos current)
|
;; transfer entries accumulated in `buffer-undo-list' to
|
;; `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
|
(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
|
;; check if at top of undo tree
|
(unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
|
(user-error "No further undo information"))
|
|
;; if region is active, or a non-numeric prefix argument was supplied,
|
;; try to pull out a new branch of changes affecting the region
|
(when (and undo-in-region
|
(not (undo-tree-pull-undo-in-region-branch
|
(region-beginning) (region-end))))
|
(user-error "No further undo information for region"))
|
|
;; remove any GC'd elements from node's undo list
|
(setq current (undo-tree-current buffer-undo-tree))
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current)))
|
(setf (undo-tree-node-undo current)
|
(undo-list-clean-GCd-elts (undo-tree-node-undo current)))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current)))
|
;; undo one record from undo tree
|
(when undo-in-region
|
(setq pos (set-marker (make-marker) (point)))
|
(set-marker-insertion-type pos t))
|
(primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
|
(undo-boundary)
|
|
;; if preserving old redo record, discard new redo entries that
|
;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
|
;; elements from node's redo list
|
(if preserve-redo
|
(progn
|
(undo-list-pop-changeset)
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current)))
|
(setf (undo-tree-node-redo current)
|
(undo-list-clean-GCd-elts (undo-tree-node-redo current)))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current))))
|
;; otherwise, record redo entries that `primitive-undo' has added to
|
;; `buffer-undo-list' in current node's redo record, replacing
|
;; existing entry if one already exists
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current)))
|
(setf (undo-tree-node-redo current)
|
(undo-list-pop-changeset 'discard-pos))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current))))
|
|
;; rewind current node and update timestamp
|
(setf (undo-tree-current buffer-undo-tree)
|
(undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
|
(unless preserve-timestamps
|
(setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
|
(current-time)))
|
|
;; if undoing-in-region, record current node, region and direction so we
|
;; can tell if undo-in-region is repeated, and re-activate mark if in
|
;; `transient-mark-mode'; if not, erase any leftover data
|
(if (not undo-in-region)
|
(undo-tree-node-clear-region-data current)
|
(goto-char pos)
|
;; note: we deliberately want to store the region information in the
|
;; node *below* the now current one
|
(setf (undo-tree-node-undo-beginning current) (region-beginning)
|
(undo-tree-node-undo-end current) (region-end))
|
(set-marker pos nil)))
|
|
;; undo deactivates mark unless undoing-in-region
|
(setq deactivate-mark (not undo-in-region))))
|
|
|
|
(defun undo-tree-redo (&optional arg)
|
"Redo changes. A numeric ARG serves as a repeat count.
|
|
In Transient Mark mode when the mark is active, only redo changes
|
within the current region. Similarly, when not in Transient Mark
|
mode, just \\[universal-argument] as an argument limits redo to
|
changes within the current region."
|
(interactive "*P")
|
;; throw error if undo is disabled in buffer
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
(undo-tree-redo-1 arg)
|
;; inform user if at branch point
|
(when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
|
|
|
(defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
|
;; Internal redo function. An active mark in `transient-mark-mode', or
|
;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
|
;; causes the existing redo record to be preserved, rather than replacing it
|
;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
|
;; disables updating of timestamps in visited undo-tree nodes. (This latter
|
;; should *only* be used when temporarily visiting another undo state and
|
;; immediately returning to the original state afterwards. Otherwise, it
|
;; could cause history-discarding errors.)
|
(let ((undo-in-progress t)
|
(redo-in-region (and undo-tree-enable-undo-in-region
|
(or (region-active-p)
|
(and arg (not (numberp arg))))))
|
pos current)
|
;; transfer entries accumulated in `buffer-undo-list' to
|
;; `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
|
(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
|
;; check if at bottom of undo tree
|
(when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
|
(user-error "No further redo information"))
|
|
;; if region is active, or a non-numeric prefix argument was supplied,
|
;; try to pull out a new branch of changes affecting the region
|
(when (and redo-in-region
|
(not (undo-tree-pull-redo-in-region-branch
|
(region-beginning) (region-end))))
|
(user-error "No further redo information for region"))
|
|
;; get next node (but DON'T advance current node in tree yet, in case
|
;; redoing fails)
|
(setq current (undo-tree-current buffer-undo-tree)
|
current (nth (undo-tree-node-branch current)
|
(undo-tree-node-next current)))
|
;; remove any GC'd elements from node's redo list
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current)))
|
(setf (undo-tree-node-redo current)
|
(undo-list-clean-GCd-elts (undo-tree-node-redo current)))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-redo current)))
|
;; redo one record from undo tree
|
(when redo-in-region
|
(setq pos (set-marker (make-marker) (point)))
|
(set-marker-insertion-type pos t))
|
(primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
|
(undo-boundary)
|
;; advance current node in tree
|
(setf (undo-tree-current buffer-undo-tree) current)
|
|
;; if preserving old undo record, discard new undo entries that
|
;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
|
;; elements from node's redo list
|
(if preserve-undo
|
(progn
|
(undo-list-pop-changeset)
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current)))
|
(setf (undo-tree-node-undo current)
|
(undo-list-clean-GCd-elts (undo-tree-node-undo current)))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current))))
|
;; otherwise, record undo entries that `primitive-undo' has added to
|
;; `buffer-undo-list' in current node's undo record, replacing
|
;; existing entry if one already exists
|
(decf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current)))
|
(setf (undo-tree-node-undo current)
|
(undo-list-pop-changeset 'discard-pos))
|
(incf (undo-tree-size buffer-undo-tree)
|
(undo-list-byte-size (undo-tree-node-undo current))))
|
|
;; update timestamp
|
(unless preserve-timestamps
|
(setf (undo-tree-node-timestamp current) (current-time)))
|
|
;; if redoing-in-region, record current node, region and direction so we
|
;; can tell if redo-in-region is repeated, and re-activate mark if in
|
;; `transient-mark-mode'
|
(if (not redo-in-region)
|
(undo-tree-node-clear-region-data current)
|
(goto-char pos)
|
(setf (undo-tree-node-redo-beginning current) (region-beginning)
|
(undo-tree-node-redo-end current) (region-end))
|
(set-marker pos nil)))
|
|
;; redo deactivates the mark unless redoing-in-region
|
(setq deactivate-mark (not redo-in-region))))
|
|
|
|
(defun undo-tree-switch-branch (branch)
|
"Switch to a different BRANCH of the undo tree.
|
This will affect which branch to descend when *redoing* changes
|
using `undo-tree-redo'."
|
(interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
|
(and (not (eq buffer-undo-list t))
|
(or (undo-list-transfer-to-tree) t)
|
(let ((b (undo-tree-node-branch
|
(undo-tree-current
|
buffer-undo-tree))))
|
(cond
|
;; switch to other branch if only 2
|
((= (undo-tree-num-branches) 2) (- 1 b))
|
;; prompt if more than 2
|
((> (undo-tree-num-branches) 2)
|
(read-number
|
(format "Branch (0-%d, on %d): "
|
(1- (undo-tree-num-branches)) b)))
|
))))))
|
;; throw error if undo is disabled in buffer
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
;; sanity check branch number
|
(when (<= (undo-tree-num-branches) 1)
|
(user-error "Not at undo branch point"))
|
(when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
|
(user-error "Invalid branch number"))
|
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
;; switch branch
|
(setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
|
branch)
|
(message "Switched to branch %d" branch))
|
|
|
(defun undo-tree-set (node &optional preserve-timestamps)
|
;; Set buffer to state corresponding to NODE. Returns intersection point
|
;; between path back from current node and path back from selected NODE.
|
;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
|
;; undo-tree nodes. (This should *only* be used when temporarily visiting
|
;; another undo state and immediately returning to the original state
|
;; afterwards. Otherwise, it could cause history-discarding errors.)
|
(let ((path (make-hash-table :test 'eq))
|
(n node))
|
(puthash (undo-tree-root buffer-undo-tree) t path)
|
;; build list of nodes leading back from selected node to root, updating
|
;; branches as we go to point down to selected node
|
(while (progn
|
(puthash n t path)
|
(when (undo-tree-node-previous n)
|
(setf (undo-tree-node-branch (undo-tree-node-previous n))
|
(undo-tree-position
|
n (undo-tree-node-next (undo-tree-node-previous n))))
|
(setq n (undo-tree-node-previous n)))))
|
;; work backwards from current node until we intersect path back from
|
;; selected node
|
(setq n (undo-tree-current buffer-undo-tree))
|
(while (not (gethash n path))
|
(setq n (undo-tree-node-previous n)))
|
;; ascend tree until intersection node
|
(while (not (eq (undo-tree-current buffer-undo-tree) n))
|
(undo-tree-undo-1 nil nil preserve-timestamps))
|
;; descend tree until selected node
|
(while (not (eq (undo-tree-current buffer-undo-tree) node))
|
(undo-tree-redo-1 nil nil preserve-timestamps))
|
n)) ; return intersection node
|
|
|
|
(defun undo-tree-save-state-to-register (register)
|
"Store current undo-tree state to REGISTER.
|
The saved state can be restored using
|
`undo-tree-restore-state-from-register'.
|
Argument is a character, naming the register."
|
(interactive "cUndo-tree state to register: ")
|
;; throw error if undo is disabled in buffer
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
;; save current node to REGISTER
|
(set-register
|
register (registerv-make
|
(undo-tree-make-register-data
|
(current-buffer) (undo-tree-current buffer-undo-tree))
|
:print-func 'undo-tree-register-data-print-func))
|
;; record REGISTER in current node, for visualizer
|
(setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
|
register))
|
|
|
|
(defun undo-tree-restore-state-from-register (register)
|
"Restore undo-tree state from REGISTER.
|
The state must be saved using `undo-tree-save-state-to-register'.
|
Argument is a character, naming the register."
|
(interactive "*cRestore undo-tree state from register: ")
|
;; throw error if undo is disabled in buffer, or if register doesn't contain
|
;; an undo-tree node
|
(let ((data (registerv-data (get-register register))))
|
(cond
|
((eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
((not (undo-tree-register-data-p data))
|
(user-error "Register doesn't contain undo-tree state"))
|
((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
|
(user-error "Register contains undo-tree state for a different buffer")))
|
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
;; restore buffer state corresponding to saved node
|
(undo-tree-set (undo-tree-register-data-node data))))
|
|
|
|
|
;;; =====================================================================
|
;;; Persistent storage commands
|
|
(defun undo-tree-make-history-save-file-name (file)
|
"Create the undo history file name for FILE.
|
Normally this is the file's name with \".\" prepended and
|
\".~undo-tree~\" appended.
|
|
A match for FILE is sought in `undo-tree-history-directory-alist'
|
\(see the documentation of that variable for details\). If the
|
directory for the backup doesn't exist, it is created."
|
(let* ((backup-directory-alist undo-tree-history-directory-alist)
|
(name (make-backup-file-name-1 file)))
|
(concat (file-name-directory name) "." (file-name-nondirectory name)
|
".~undo-tree~")))
|
|
|
(defun undo-tree-save-history (&optional filename overwrite)
|
"Store undo-tree history to file.
|
|
If optional argument FILENAME is omitted, default save file is
|
\".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
|
Otherwise, prompt for one.
|
|
If OVERWRITE is non-nil, any existing file will be overwritten
|
without asking for confirmation."
|
(interactive)
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
(undo-list-transfer-to-tree)
|
(when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
|
(condition-case nil
|
(undo-tree-kill-visualizer)
|
(error (undo-tree-clear-visualizer-data buffer-undo-tree)))
|
(let ((buff (current-buffer))
|
tree)
|
;; get filename
|
(unless filename
|
(setq filename
|
(if buffer-file-name
|
(undo-tree-make-history-save-file-name buffer-file-name)
|
(expand-file-name (read-file-name "File to save in: ") nil))))
|
(when (or (not (file-exists-p filename))
|
overwrite
|
(yes-or-no-p (format "Overwrite \"%s\"? " filename)))
|
(unwind-protect
|
(progn
|
;; transform undo-tree into non-circular structure, and make
|
;; temporary copy
|
(undo-tree-decircle buffer-undo-tree)
|
(setq tree (copy-undo-tree buffer-undo-tree))
|
;; discard undo-tree object pool before saving
|
(setf (undo-tree-object-pool tree) nil)
|
;; print undo-tree to file
|
;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
|
;; to allow `auto-compression-mode' to take effect, in
|
;; case user has overridden or advised the default
|
;; `undo-tree-make-history-save-file-name' to add a
|
;; compressed file extension.
|
(with-auto-compression-mode
|
(with-temp-buffer
|
(prin1 (sha1 buff) (current-buffer))
|
(terpri (current-buffer))
|
(let ((print-circle t)) (prin1 tree (current-buffer)))
|
(write-region nil nil filename))))
|
;; restore circular undo-tree data structure
|
(undo-tree-recircle buffer-undo-tree))
|
))))
|
|
|
|
(defun undo-tree-load-history (&optional filename noerror)
|
"Load undo-tree history from file.
|
|
If optional argument FILENAME is null, default load file is
|
\".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
|
Otherwise, prompt for one.
|
|
If optional argument NOERROR is non-nil, return nil instead of
|
signaling an error if file is not found."
|
(interactive)
|
;; get filename
|
(unless filename
|
(setq filename
|
(if buffer-file-name
|
(undo-tree-make-history-save-file-name buffer-file-name)
|
(expand-file-name (read-file-name "File to load from: ") nil))))
|
|
;; attempt to read undo-tree from FILENAME
|
(catch 'load-error
|
(unless (file-exists-p filename)
|
(if noerror
|
(throw 'load-error nil)
|
(error "File \"%s\" does not exist; could not load undo-tree history"
|
filename)))
|
(let (buff hash tree)
|
(setq buff (current-buffer))
|
(with-auto-compression-mode
|
(with-temp-buffer
|
(insert-file-contents filename)
|
(goto-char (point-min))
|
(condition-case nil
|
(setq hash (read (current-buffer)))
|
(error
|
(kill-buffer nil)
|
(funcall (if noerror 'message 'user-error)
|
"Error reading undo-tree history from \"%s\"" filename)
|
(throw 'load-error nil)))
|
(unless (string= (sha1 buff) hash)
|
(kill-buffer nil)
|
(funcall (if noerror 'message 'user-error)
|
"Buffer has been modified; could not load undo-tree history")
|
(throw 'load-error nil))
|
(condition-case nil
|
(setq tree (read (current-buffer)))
|
(error
|
(kill-buffer nil)
|
(funcall (if noerror 'message 'error)
|
"Error reading undo-tree history from \"%s\"" filename)
|
(throw 'load-error nil)))
|
(kill-buffer nil)))
|
;; initialise empty undo-tree object pool
|
(setf (undo-tree-object-pool tree)
|
(make-hash-table :test 'eq :weakness 'value))
|
;; restore circular undo-tree data structure
|
(undo-tree-recircle tree)
|
(setq buffer-undo-tree tree))))
|
|
|
|
;; Versions of save/load functions for use in hooks
|
(defun undo-tree-save-history-hook ()
|
(when (and undo-tree-mode undo-tree-auto-save-history
|
(not (eq buffer-undo-list t)))
|
(undo-tree-save-history nil t) nil))
|
|
(defun undo-tree-load-history-hook ()
|
(when (and undo-tree-mode undo-tree-auto-save-history
|
(not (eq buffer-undo-list t))
|
(not revert-buffer-in-progress-p))
|
(undo-tree-load-history nil t)))
|
|
|
|
|
;;; =====================================================================
|
;;; Visualizer drawing functions
|
|
(defun undo-tree-visualize ()
|
"Visualize the current buffer's undo tree."
|
(interactive "*")
|
(deactivate-mark)
|
;; throw error if undo is disabled in buffer
|
(when (eq buffer-undo-list t)
|
(user-error "No undo information in this buffer"))
|
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
|
(undo-list-transfer-to-tree)
|
;; add hook to kill visualizer buffer if original buffer is changed
|
(add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
|
;; prepare *undo-tree* buffer, then draw tree in it
|
(let ((undo-tree buffer-undo-tree)
|
(buff (current-buffer))
|
(display-buffer-mark-dedicated 'soft))
|
(switch-to-buffer-other-window
|
(get-buffer-create undo-tree-visualizer-buffer-name))
|
(setq undo-tree-visualizer-parent-buffer buff)
|
(setq undo-tree-visualizer-parent-mtime
|
(and (buffer-file-name buff)
|
(nth 5 (file-attributes (buffer-file-name buff)))))
|
(setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
|
(setq undo-tree-visualizer-spacing
|
(undo-tree-visualizer-calculate-spacing))
|
(make-local-variable 'undo-tree-visualizer-timestamps)
|
(make-local-variable 'undo-tree-visualizer-diff)
|
(setq buffer-undo-tree undo-tree)
|
(undo-tree-visualizer-mode)
|
;; FIXME; don't know why `undo-tree-visualizer-mode' clears this
|
(setq buffer-undo-tree undo-tree)
|
(set (make-local-variable 'undo-tree-visualizer-lazy-drawing)
|
(or (eq undo-tree-visualizer-lazy-drawing t)
|
(and (numberp undo-tree-visualizer-lazy-drawing)
|
(>= (undo-tree-count undo-tree)
|
undo-tree-visualizer-lazy-drawing))))
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
|
(let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
|
|
|
(defun undo-tree-kill-visualizer (&rest _dummy)
|
;; Kill visualizer. Added to `before-change-functions' hook of original
|
;; buffer when visualizer is invoked.
|
(unless (or undo-tree-inhibit-kill-visualizer
|
(null (get-buffer undo-tree-visualizer-buffer-name)))
|
(with-current-buffer undo-tree-visualizer-buffer-name
|
(undo-tree-visualizer-quit))))
|
|
|
|
(defun undo-tree-draw-tree (undo-tree)
|
;; Draw undo-tree in current buffer starting from NODE (or root if nil).
|
(let ((node (if undo-tree-visualizer-lazy-drawing
|
(undo-tree-current undo-tree)
|
(undo-tree-root undo-tree))))
|
(erase-buffer)
|
(setq undo-tree-visualizer-needs-extending-down nil
|
undo-tree-visualizer-needs-extending-up nil)
|
(undo-tree-clear-visualizer-data undo-tree)
|
(undo-tree-compute-widths node)
|
;; lazy drawing starts vertically centred and displaced horizontally to
|
;; the left (window-width/4), since trees will typically grow right
|
(if undo-tree-visualizer-lazy-drawing
|
(progn
|
(undo-tree-move-down (/ (window-height) 2))
|
(undo-tree-move-forward (max 2 (/ (window-width) 4)))) ; left margin
|
;; non-lazy drawing starts in centre at top of buffer
|
(undo-tree-move-down 1) ; top margin
|
(undo-tree-move-forward
|
(max (/ (window-width) 2)
|
(+ (undo-tree-node-char-lwidth node)
|
;; add space for left part of left-most time-stamp
|
(if undo-tree-visualizer-timestamps
|
(/ (- undo-tree-visualizer-spacing 4) 2)
|
0)
|
2)))) ; left margin
|
;; link starting node to its representation in visualizer
|
(setf (undo-tree-node-marker node) (make-marker))
|
(set-marker-insertion-type (undo-tree-node-marker node) nil)
|
(move-marker (undo-tree-node-marker node) (point))
|
;; draw undo-tree
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
|
node-list)
|
(if (not undo-tree-visualizer-lazy-drawing)
|
(undo-tree-extend-down node t)
|
(undo-tree-extend-down node)
|
(undo-tree-extend-up node)
|
(setq node-list undo-tree-visualizer-needs-extending-down
|
undo-tree-visualizer-needs-extending-down nil)
|
(while node-list (undo-tree-extend-down (pop node-list)))))
|
;; highlight active branch
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
|
(undo-tree-highlight-active-branch
|
(or undo-tree-visualizer-needs-extending-up
|
(undo-tree-root undo-tree))))
|
;; highlight current node
|
(undo-tree-draw-node (undo-tree-current undo-tree) 'current)))
|
|
|
(defun undo-tree-extend-down (node &optional bottom)
|
;; Extend tree downwards starting from NODE and point. If BOTTOM is t,
|
;; extend all the way down to the leaves. If BOTTOM is a node, extend down
|
;; as far as that node. If BOTTOM is an integer, extend down as far as that
|
;; line. Otherwise, only extend visible portion of tree. NODE is assumed to
|
;; already have a node marker. Returns non-nil if anything was actually
|
;; extended.
|
(let ((extended nil)
|
(cur-stack (list node))
|
next-stack)
|
;; don't bother extending if BOTTOM specifies an already-drawn node
|
(unless (and (undo-tree-node-p bottom) (undo-tree-node-marker bottom))
|
;; draw nodes layer by layer
|
(while (or cur-stack
|
(prog1 (setq cur-stack next-stack)
|
(setq next-stack nil)))
|
(setq node (pop cur-stack))
|
;; if node is within range being drawn...
|
(if (or (eq bottom t)
|
(and (undo-tree-node-p bottom)
|
(not (eq (undo-tree-node-previous node) bottom)))
|
(and (integerp bottom)
|
(>= bottom (line-number-at-pos
|
(undo-tree-node-marker node))))
|
(and (null bottom)
|
(pos-visible-in-window-p (undo-tree-node-marker node)
|
nil t)))
|
;; ...draw one layer of node's subtree (if not already drawn)
|
(progn
|
(unless (and (undo-tree-node-next node)
|
(undo-tree-node-marker
|
(nth (undo-tree-node-branch node)
|
(undo-tree-node-next node))))
|
(goto-char (undo-tree-node-marker node))
|
(undo-tree-draw-subtree node)
|
(setq extended t))
|
(setq next-stack
|
(append (undo-tree-node-next node) next-stack)))
|
;; ...otherwise, postpone drawing until later
|
(push node undo-tree-visualizer-needs-extending-down))))
|
extended))
|
|
|
(defun undo-tree-extend-up (node &optional top)
|
;; Extend tree upwards starting from NODE. If TOP is t, extend all the way
|
;; to root. If TOP is a node, extend up as far as that node. If TOP is an
|
;; integer, extend up as far as that line. Otherwise, only extend visible
|
;; portion of tree. NODE is assumed to already have a node marker. Returns
|
;; non-nil if anything was actually extended.
|
(let ((extended nil) parent)
|
;; don't bother extending if TOP specifies an already-drawn node
|
(unless (and (undo-tree-node-p top) (undo-tree-node-marker top))
|
(while node
|
(setq parent (undo-tree-node-previous node))
|
;; if we haven't reached root...
|
(if parent
|
;; ...and node is within range being drawn...
|
(if (or (eq top t)
|
(and (undo-tree-node-p top) (not (eq node top)))
|
(and (integerp top)
|
(< top (line-number-at-pos
|
(undo-tree-node-marker node))))
|
(and (null top)
|
;; NOTE: we check point in case window-start is outdated
|
(< (min (line-number-at-pos (point))
|
(line-number-at-pos (window-start)))
|
(line-number-at-pos
|
(undo-tree-node-marker node)))))
|
;; ...and it hasn't already been drawn
|
(when (not (undo-tree-node-marker parent))
|
;; link parent node to its representation in visualizer
|
(undo-tree-compute-widths parent)
|
(undo-tree-move-to-parent node)
|
(setf (undo-tree-node-marker parent) (make-marker))
|
(set-marker-insertion-type
|
(undo-tree-node-marker parent) nil)
|
(move-marker (undo-tree-node-marker parent) (point))
|
;; draw subtree beneath parent
|
(setq undo-tree-visualizer-needs-extending-down
|
(nconc (delq node (undo-tree-draw-subtree parent))
|
undo-tree-visualizer-needs-extending-down))
|
(setq extended t))
|
;; ...otherwise, postpone drawing for later and exit
|
(setq undo-tree-visualizer-needs-extending-up (when parent node)
|
parent nil))
|
|
;; if we've reached root, stop extending and add top margin
|
(setq undo-tree-visualizer-needs-extending-up nil)
|
(goto-char (undo-tree-node-marker node))
|
(undo-tree-move-up 1) ; top margin
|
(delete-region (point-min) (line-beginning-position)))
|
;; next iteration
|
(setq node parent)))
|
extended))
|
|
|
(defun undo-tree-expand-down (from &optional to)
|
;; Expand tree downwards. FROM is the node to start expanding from. Stop
|
;; expanding at TO if specified. Otherwise, just expand visible portion of
|
;; tree and highlight active branch from FROM.
|
(when undo-tree-visualizer-needs-extending-down
|
(let ((inhibit-read-only t)
|
node-list extended)
|
;; extend down as far as TO node
|
(when to
|
(setq extended (undo-tree-extend-down from to))
|
(goto-char (undo-tree-node-marker to))
|
(redisplay t)) ; force redisplay to scroll buffer if necessary
|
;; extend visible portion of tree downwards
|
(setq node-list undo-tree-visualizer-needs-extending-down
|
undo-tree-visualizer-needs-extending-down nil)
|
(when node-list
|
(dolist (n node-list)
|
(when (undo-tree-extend-down n) (setq extended t)))
|
;; highlight active branch in newly-extended-down portion, if any
|
(when extended
|
(let ((undo-tree-insert-face
|
'undo-tree-visualizer-active-branch-face))
|
(undo-tree-highlight-active-branch from)))))))
|
|
|
(defun undo-tree-expand-up (from &optional to)
|
;; Expand tree upwards. FROM is the node to start expanding from, TO is the
|
;; node to stop expanding at. If TO node isn't specified, just expand visible
|
;; portion of tree and highlight active branch down to FROM.
|
(when undo-tree-visualizer-needs-extending-up
|
(let ((inhibit-read-only t)
|
extended node-list)
|
;; extend up as far as TO node
|
(when to
|
(setq extended (undo-tree-extend-up from to))
|
(goto-char (undo-tree-node-marker to))
|
;; simulate auto-scrolling if close to top of buffer
|
(when (<= (line-number-at-pos (point)) scroll-margin)
|
(undo-tree-move-up (if (= scroll-conservatively 0)
|
(/ (window-height) 2) 3))
|
(when (undo-tree-extend-up to) (setq extended t))
|
(goto-char (undo-tree-node-marker to))
|
(unless (= scroll-conservatively 0) (recenter scroll-margin))))
|
;; extend visible portion of tree upwards
|
(and undo-tree-visualizer-needs-extending-up
|
(undo-tree-extend-up undo-tree-visualizer-needs-extending-up)
|
(setq extended t))
|
;; extend visible portion of tree downwards
|
(setq node-list undo-tree-visualizer-needs-extending-down
|
undo-tree-visualizer-needs-extending-down nil)
|
(dolist (n node-list) (undo-tree-extend-down n))
|
;; highlight active branch in newly-extended-up portion, if any
|
(when extended
|
(let ((undo-tree-insert-face
|
'undo-tree-visualizer-active-branch-face))
|
(undo-tree-highlight-active-branch
|
(or undo-tree-visualizer-needs-extending-up
|
(undo-tree-root buffer-undo-tree))
|
from))))))
|
|
|
|
(defun undo-tree-highlight-active-branch (node &optional end)
|
;; Draw highlighted active branch below NODE in current buffer. Stop
|
;; highlighting at END node if specified.
|
(let ((stack (list node)))
|
;; draw active branch
|
(while stack
|
(setq node (pop stack))
|
(unless (or (eq node end)
|
(memq node undo-tree-visualizer-needs-extending-down))
|
(goto-char (undo-tree-node-marker node))
|
(setq node (undo-tree-draw-subtree node 'active)
|
stack (nconc stack node))))))
|
|
|
(defun undo-tree-draw-node (node &optional current)
|
;; Draw symbol representing NODE in visualizer. If CURRENT is non-nil, node
|
;; is current node.
|
(goto-char (undo-tree-node-marker node))
|
(when undo-tree-visualizer-timestamps
|
(undo-tree-move-backward (/ undo-tree-visualizer-spacing 2)))
|
|
(let* ((undo-tree-insert-face (and undo-tree-insert-face
|
(or (and (consp undo-tree-insert-face)
|
undo-tree-insert-face)
|
(list undo-tree-insert-face))))
|
(register (undo-tree-node-register node))
|
(unmodified (if undo-tree-visualizer-parent-mtime
|
(undo-tree-node-unmodified-p
|
node undo-tree-visualizer-parent-mtime)
|
(undo-tree-node-unmodified-p node)))
|
node-string)
|
;; check node's register (if any) still stores appropriate undo-tree state
|
(unless (and register
|
(undo-tree-register-data-p
|
(registerv-data (get-register register)))
|
(eq node (undo-tree-register-data-node
|
(registerv-data (get-register register)))))
|
(setq register nil))
|
;; represent node by different symbols, depending on whether it's the
|
;; current node, is saved in a register, or corresponds to an unmodified
|
;; buffer
|
(setq node-string
|
(cond
|
(undo-tree-visualizer-timestamps
|
(undo-tree-timestamp-to-string
|
(undo-tree-node-timestamp node)
|
undo-tree-visualizer-relative-timestamps
|
current register))
|
(register (char-to-string register))
|
(unmodified "s")
|
(current "x")
|
(t "o"))
|
undo-tree-insert-face
|
(nconc
|
(cond
|
(current '(undo-tree-visualizer-current-face))
|
(unmodified '(undo-tree-visualizer-unmodified-face))
|
(register '(undo-tree-visualizer-register-face)))
|
undo-tree-insert-face))
|
;; draw node and link it to its representation in visualizer
|
(undo-tree-insert node-string)
|
(undo-tree-move-backward (if undo-tree-visualizer-timestamps
|
(1+ (/ undo-tree-visualizer-spacing 2))
|
1))
|
(move-marker (undo-tree-node-marker node) (point))
|
(put-text-property (point) (1+ (point)) 'undo-tree-node node)))
|
|
|
(defun undo-tree-draw-subtree (node &optional active-branch)
|
;; Draw subtree rooted at NODE. The subtree will start from point.
|
;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. Returns
|
;; list of nodes below NODE.
|
(let ((num-children (length (undo-tree-node-next node)))
|
node-list pos trunk-pos n)
|
;; draw node itself
|
(undo-tree-draw-node node)
|
|
(cond
|
;; if we're at a leaf node, we're done
|
((= num-children 0))
|
|
;; if node has only one child, draw it (not strictly necessary to deal
|
;; with this case separately, but as it's by far the most common case
|
;; this makes the code clearer and more efficient)
|
((= num-children 1)
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?|)
|
(undo-tree-move-backward 1)
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?|)
|
(undo-tree-move-backward 1)
|
(undo-tree-move-down 1)
|
(setq n (car (undo-tree-node-next node)))
|
;; link next node to its representation in visualizer
|
(unless (markerp (undo-tree-node-marker n))
|
(setf (undo-tree-node-marker n) (make-marker))
|
(set-marker-insertion-type (undo-tree-node-marker n) nil))
|
(move-marker (undo-tree-node-marker n) (point))
|
;; add next node to list of nodes to draw next
|
(push n node-list))
|
|
;; if node has multiple children, draw branches
|
(t
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?|)
|
(undo-tree-move-backward 1)
|
(move-marker (setq trunk-pos (make-marker)) (point))
|
;; left subtrees
|
(undo-tree-move-backward
|
(- (undo-tree-node-char-lwidth node)
|
(undo-tree-node-char-lwidth
|
(car (undo-tree-node-next node)))))
|
(move-marker (setq pos (make-marker)) (point))
|
(setq n (cons nil (undo-tree-node-next node)))
|
(dotimes (i (/ num-children 2))
|
(setq n (cdr n))
|
(when (or (null active-branch)
|
(eq (car n)
|
(nth (undo-tree-node-branch node)
|
(undo-tree-node-next node))))
|
(undo-tree-move-forward 2)
|
(undo-tree-insert ?_ (- trunk-pos pos 2))
|
(goto-char pos)
|
(undo-tree-move-forward 1)
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?/)
|
(undo-tree-move-backward 2)
|
(undo-tree-move-down 1)
|
;; link node to its representation in visualizer
|
(unless (markerp (undo-tree-node-marker (car n)))
|
(setf (undo-tree-node-marker (car n)) (make-marker))
|
(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
|
(move-marker (undo-tree-node-marker (car n)) (point))
|
;; add node to list of nodes to draw next
|
(push (car n) node-list))
|
(goto-char pos)
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-rwidth (car n))
|
(undo-tree-node-char-lwidth (cadr n))
|
undo-tree-visualizer-spacing 1))
|
(move-marker pos (point)))
|
;; middle subtree (only when number of children is odd)
|
(when (= (mod num-children 2) 1)
|
(setq n (cdr n))
|
(when (or (null active-branch)
|
(eq (car n)
|
(nth (undo-tree-node-branch node)
|
(undo-tree-node-next node))))
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?|)
|
(undo-tree-move-backward 1)
|
(undo-tree-move-down 1)
|
;; link node to its representation in visualizer
|
(unless (markerp (undo-tree-node-marker (car n)))
|
(setf (undo-tree-node-marker (car n)) (make-marker))
|
(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
|
(move-marker (undo-tree-node-marker (car n)) (point))
|
;; add node to list of nodes to draw next
|
(push (car n) node-list))
|
(goto-char pos)
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-rwidth (car n))
|
(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
|
undo-tree-visualizer-spacing 1))
|
(move-marker pos (point)))
|
;; right subtrees
|
(move-marker trunk-pos (1+ trunk-pos))
|
(dotimes (i (/ num-children 2))
|
(setq n (cdr n))
|
(when (or (null active-branch)
|
(eq (car n)
|
(nth (undo-tree-node-branch node)
|
(undo-tree-node-next node))))
|
(goto-char trunk-pos)
|
(undo-tree-insert ?_ (- pos trunk-pos 1))
|
(goto-char pos)
|
(undo-tree-move-backward 1)
|
(undo-tree-move-down 1)
|
(undo-tree-insert ?\\)
|
(undo-tree-move-down 1)
|
;; link node to its representation in visualizer
|
(unless (markerp (undo-tree-node-marker (car n)))
|
(setf (undo-tree-node-marker (car n)) (make-marker))
|
(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
|
(move-marker (undo-tree-node-marker (car n)) (point))
|
;; add node to list of nodes to draw next
|
(push (car n) node-list))
|
(when (cdr n)
|
(goto-char pos)
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-rwidth (car n))
|
(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
|
undo-tree-visualizer-spacing 1))
|
(move-marker pos (point))))
|
))
|
;; return list of nodes to draw next
|
(nreverse node-list)))
|
|
|
(defun undo-tree-node-char-lwidth (node)
|
;; Return left-width of NODE measured in characters.
|
(if (= (length (undo-tree-node-next node)) 0) 0
|
(- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
|
(if (= (undo-tree-node-cwidth node) 0)
|
(1+ (/ undo-tree-visualizer-spacing 2)) 0))))
|
|
|
(defun undo-tree-node-char-rwidth (node)
|
;; Return right-width of NODE measured in characters.
|
(if (= (length (undo-tree-node-next node)) 0) 0
|
(- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
|
(if (= (undo-tree-node-cwidth node) 0)
|
(1+ (/ undo-tree-visualizer-spacing 2)) 0))))
|
|
|
(defun undo-tree-insert (str &optional arg)
|
;; Insert character or string STR ARG times, overwriting, and using
|
;; `undo-tree-insert-face'.
|
(unless arg (setq arg 1))
|
(when (characterp str)
|
(setq str (make-string arg str))
|
(setq arg 1))
|
(dotimes (i arg) (insert str))
|
(setq arg (* arg (length str)))
|
(undo-tree-move-forward arg)
|
;; make sure mark isn't active, otherwise `backward-delete-char' might
|
;; delete region instead of single char if transient-mark-mode is enabled
|
(setq mark-active nil)
|
(backward-delete-char arg)
|
(when undo-tree-insert-face
|
(put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
|
|
|
(defun undo-tree-move-down (&optional arg)
|
;; Move down, extending buffer if necessary.
|
(let ((row (line-number-at-pos))
|
(col (current-column))
|
line)
|
(unless arg (setq arg 1))
|
(forward-line arg)
|
(setq line (line-number-at-pos))
|
;; if buffer doesn't have enough lines, add some
|
(when (/= line (+ row arg))
|
(cond
|
((< arg 0)
|
(insert (make-string (- line row arg) ?\n))
|
(forward-line (+ arg (- row line))))
|
(t (insert (make-string (- arg (- line row)) ?\n)))))
|
(undo-tree-move-forward col)))
|
|
|
(defun undo-tree-move-up (&optional arg)
|
;; Move up, extending buffer if necessary.
|
(unless arg (setq arg 1))
|
(undo-tree-move-down (- arg)))
|
|
|
(defun undo-tree-move-forward (&optional arg)
|
;; Move forward, extending buffer if necessary.
|
(unless arg (setq arg 1))
|
(let (n)
|
(cond
|
((>= arg 0)
|
(setq n (- (line-end-position) (point)))
|
(if (> n arg)
|
(forward-char arg)
|
(end-of-line)
|
(insert (make-string (- arg n) ? ))))
|
((< arg 0)
|
(setq arg (- arg))
|
(setq n (- (point) (line-beginning-position)))
|
(when (< (- n 2) arg) ; -2 to create left-margin
|
;; no space left - shift entire buffer contents right!
|
(let ((pos (move-marker (make-marker) (point))))
|
(set-marker-insertion-type pos t)
|
(goto-char (point-min))
|
(while (not (eobp))
|
(insert-before-markers (make-string (- arg -2 n) ? ))
|
(forward-line 1))
|
(goto-char pos)))
|
(backward-char arg)))))
|
|
|
(defun undo-tree-move-backward (&optional arg)
|
;; Move backward, extending buffer if necessary.
|
(unless arg (setq arg 1))
|
(undo-tree-move-forward (- arg)))
|
|
|
(defun undo-tree-move-to-parent (node)
|
;; Move to position of parent of NODE, extending buffer if necessary.
|
(let* ((parent (undo-tree-node-previous node))
|
(n (undo-tree-node-next parent))
|
(l (length n)) p)
|
(goto-char (undo-tree-node-marker node))
|
(unless (= l 1)
|
;; move horizontally
|
(setq p (undo-tree-position node n))
|
(cond
|
;; node in centre subtree: no horizontal movement
|
((and (= (mod l 2) 1) (= p (/ l 2))))
|
;; node in left subtree: move right
|
((< p (/ l 2))
|
(setq n (nthcdr p n))
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-rwidth (car n))
|
(/ undo-tree-visualizer-spacing 2) 1))
|
(dotimes (i (- (/ l 2) p 1))
|
(setq n (cdr n))
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-lwidth (car n))
|
(undo-tree-node-char-rwidth (car n))
|
undo-tree-visualizer-spacing 1)))
|
(when (= (mod l 2) 1)
|
(setq n (cdr n))
|
(undo-tree-move-forward
|
(+ (undo-tree-node-char-lwidth (car n))
|
(/ undo-tree-visualizer-spacing 2) 1))))
|
(t ;; node in right subtree: move left
|
(setq n (nthcdr (/ l 2) n))
|
(when (= (mod l 2) 1)
|
(undo-tree-move-backward
|
(+ (undo-tree-node-char-rwidth (car n))
|
(/ undo-tree-visualizer-spacing 2) 1))
|
(setq n (cdr n)))
|
(dotimes (i (- p (/ l 2) (mod l 2)))
|
(undo-tree-move-backward
|
(+ (undo-tree-node-char-lwidth (car n))
|
(undo-tree-node-char-rwidth (car n))
|
undo-tree-visualizer-spacing 1))
|
(setq n (cdr n)))
|
(undo-tree-move-backward
|
(+ (undo-tree-node-char-lwidth (car n))
|
(/ undo-tree-visualizer-spacing 2) 1)))))
|
;; move vertically
|
(undo-tree-move-up 3)))
|
|
|
(defun undo-tree-timestamp-to-string
|
(timestamp &optional relative current register)
|
;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
|
;; if it's the CURRENT node and/or has an associated REGISTER.
|
(if relative
|
;; relative time
|
(let ((time (floor (float-time
|
(subtract-time (current-time) timestamp))))
|
n)
|
(setq time
|
;; years
|
(if (> (setq n (/ time 315360000)) 0)
|
(if (> n 999) "-ages" (format "-%dy" n))
|
(setq time (% time 315360000))
|
;; days
|
(if (> (setq n (/ time 86400)) 0)
|
(format "-%dd" n)
|
(setq time (% time 86400))
|
;; hours
|
(if (> (setq n (/ time 3600)) 0)
|
(format "-%dh" n)
|
(setq time (% time 3600))
|
;; mins
|
(if (> (setq n (/ time 60)) 0)
|
(format "-%dm" n)
|
;; secs
|
(format "-%ds" (% time 60)))))))
|
(setq time (concat
|
(if current "*" " ")
|
time
|
(if register (concat "[" (char-to-string register) "]")
|
" ")))
|
(setq n (length time))
|
(if (< n 9)
|
(concat (make-string (- 9 n) ? ) time)
|
time))
|
;; absolute time
|
(concat (if current " *" " ")
|
(format-time-string "%H:%M:%S" timestamp)
|
(if register
|
(concat "[" (char-to-string register) "]")
|
" "))))
|
|
|
|
|
;;; =====================================================================
|
;;; Visualizer commands
|
|
(define-derived-mode
|
undo-tree-visualizer-mode special-mode "undo-tree-visualizer"
|
"Major mode used in undo-tree visualizer.
|
|
The undo-tree visualizer can only be invoked from a buffer in
|
which `undo-tree-mode' is enabled. The visualizer displays the
|
undo history tree graphically, and allows you to browse around
|
the undo history, undoing or redoing the corresponding changes in
|
the parent buffer.
|
|
Within the undo-tree visualizer, the following keys are available:
|
|
\\{undo-tree-visualizer-mode-map}"
|
:syntax-table nil
|
:abbrev-table nil
|
(setq truncate-lines t)
|
(setq cursor-type nil)
|
(setq undo-tree-visualizer-selected-node nil))
|
|
|
|
(defun undo-tree-visualize-undo (&optional arg)
|
"Undo changes. A numeric ARG serves as a repeat count."
|
(interactive "p")
|
(let ((old (undo-tree-current buffer-undo-tree))
|
current)
|
;; unhighlight old current node
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
|
(inhibit-read-only t))
|
(undo-tree-draw-node old))
|
;; undo in parent buffer
|
(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
|
(deactivate-mark)
|
(unwind-protect
|
(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo-1 arg))
|
(setq current (undo-tree-current buffer-undo-tree))
|
(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
|
;; when using lazy drawing, extend tree upwards as required
|
(when undo-tree-visualizer-lazy-drawing
|
(undo-tree-expand-up old current))
|
;; highlight new current node
|
(let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
|
;; update diff display, if any
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
|
|
|
(defun undo-tree-visualize-redo (&optional arg)
|
"Redo changes. A numeric ARG serves as a repeat count."
|
(interactive "p")
|
(let ((old (undo-tree-current buffer-undo-tree))
|
current)
|
;; unhighlight old current node
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
|
(inhibit-read-only t))
|
(undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
|
;; redo in parent buffer
|
(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
|
(deactivate-mark)
|
(unwind-protect
|
(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo-1 arg))
|
(setq current (undo-tree-current buffer-undo-tree))
|
(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
|
;; when using lazy drawing, extend tree downwards as required
|
(when undo-tree-visualizer-lazy-drawing
|
(undo-tree-expand-down old current))
|
;; highlight new current node
|
(let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
|
;; update diff display, if any
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
|
|
|
(defun undo-tree-visualize-switch-branch-right (arg)
|
"Switch to next branch of the undo tree.
|
This will affect which branch to descend when *redoing* changes
|
using `undo-tree-redo' or `undo-tree-visualizer-redo'."
|
(interactive "p")
|
;; un-highlight old active branch below current node
|
(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
|
(inhibit-read-only t))
|
(undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
|
;; increment branch
|
(let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
|
(setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
|
(cond
|
((>= (+ branch arg) (undo-tree-num-branches))
|
(1- (undo-tree-num-branches)))
|
((<= (+ branch arg) 0) 0)
|
(t (+ branch arg))))
|
(let ((inhibit-read-only t))
|
;; highlight new active branch below current node
|
(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
|
(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
|
(undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
|
;; re-highlight current node
|
(undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
|
|
|
(defun undo-tree-visualize-switch-branch-left (arg)
|
"Switch to previous branch of the undo tree.
|
This will affect which branch to descend when *redoing* changes
|
using `undo-tree-redo' or `undo-tree-visualizer-redo'."
|
(interactive "p")
|
(undo-tree-visualize-switch-branch-right (- arg)))
|
|
|
(defun undo-tree-visualizer-quit ()
|
"Quit the undo-tree visualizer."
|
(interactive)
|
(undo-tree-clear-visualizer-data buffer-undo-tree)
|
;; remove kill visualizer hook from parent buffer
|
(unwind-protect
|
(with-current-buffer undo-tree-visualizer-parent-buffer
|
(remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
|
;; kill diff buffer, if any
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
|
(let ((parent undo-tree-visualizer-parent-buffer)
|
window)
|
;; kill visualizer buffer
|
(kill-buffer nil)
|
;; switch back to parent buffer
|
(unwind-protect
|
(if (setq window (get-buffer-window parent))
|
(select-window window)
|
(switch-to-buffer parent))))))
|
|
|
(defun undo-tree-visualizer-abort ()
|
"Quit the undo-tree visualizer and return buffer to original state."
|
(interactive)
|
(let ((node undo-tree-visualizer-initial-node))
|
(undo-tree-visualizer-quit)
|
(undo-tree-set node)))
|
|
|
(defun undo-tree-visualizer-set (&optional pos)
|
"Set buffer to state corresponding to undo tree node
|
at POS, or point if POS is nil."
|
(interactive)
|
(unless pos (setq pos (point)))
|
(let ((node (get-text-property pos 'undo-tree-node)))
|
(when node
|
;; set parent buffer to state corresponding to node at POS
|
(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
|
(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
|
(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
|
;; re-draw undo tree
|
(let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
|
|
|
(defun undo-tree-visualizer-mouse-set (pos)
|
"Set buffer to state corresponding to undo tree node
|
at mouse event POS."
|
(interactive "@e")
|
(undo-tree-visualizer-set (event-start (nth 1 pos))))
|
|
|
(defun undo-tree-visualize-undo-to-x (&optional x)
|
"Undo to last branch point, register, or saved state.
|
If X is the symbol `branch', undo to last branch point. If X is
|
the symbol `register', undo to last register. If X is the sumbol
|
`saved', undo to last saved state. If X is null, undo to first of
|
these that's encountered.
|
|
Interactively, a single \\[universal-argument] specifies
|
`branch', a double \\[universal-argument] \\[universal-argument]
|
specifies `saved', and a negative prefix argument specifies
|
`register'."
|
(interactive "P")
|
(when (and (called-interactively-p 'any) x)
|
(setq x (prefix-numeric-value x)
|
x (cond
|
((< x 0) 'register)
|
((<= x 4) 'branch)
|
(t 'saved))))
|
(let ((current (if undo-tree-visualizer-selection-mode
|
undo-tree-visualizer-selected-node
|
(undo-tree-current buffer-undo-tree)))
|
(diff undo-tree-visualizer-diff)
|
r)
|
(undo-tree-visualizer-hide-diff)
|
(while (and (undo-tree-node-previous current)
|
(or (if undo-tree-visualizer-selection-mode
|
(progn
|
(undo-tree-visualizer-select-previous)
|
(setq current undo-tree-visualizer-selected-node))
|
(undo-tree-visualize-undo)
|
(setq current (undo-tree-current buffer-undo-tree)))
|
t)
|
;; branch point
|
(not (or (and (or (null x) (eq x 'branch))
|
(> (undo-tree-num-branches) 1))
|
;; register
|
(and (or (null x) (eq x 'register))
|
(setq r (undo-tree-node-register current))
|
(undo-tree-register-data-p
|
(setq r (registerv-data (get-register r))))
|
(eq current (undo-tree-register-data-node r)))
|
;; saved state
|
(and (or (null x) (eq x 'saved))
|
(undo-tree-node-unmodified-p current))
|
))))
|
;; update diff display, if any
|
(when diff
|
(undo-tree-visualizer-show-diff
|
(when undo-tree-visualizer-selection-mode
|
undo-tree-visualizer-selected-node)))))
|
|
|
(defun undo-tree-visualize-redo-to-x (&optional x)
|
"Redo to last branch point, register, or saved state.
|
If X is the symbol `branch', redo to last branch point. If X is
|
the symbol `register', redo to last register. If X is the sumbol
|
`saved', redo to last saved state. If X is null, redo to first of
|
these that's encountered.
|
|
Interactively, a single \\[universal-argument] specifies
|
`branch', a double \\[universal-argument] \\[universal-argument]
|
specifies `saved', and a negative prefix argument specifies
|
`register'."
|
(interactive "P")
|
(when (and (called-interactively-p 'any) x)
|
(setq x (prefix-numeric-value x)
|
x (cond
|
((< x 0) 'register)
|
((<= x 4) 'branch)
|
(t 'saved))))
|
(let ((current (if undo-tree-visualizer-selection-mode
|
undo-tree-visualizer-selected-node
|
(undo-tree-current buffer-undo-tree)))
|
(diff undo-tree-visualizer-diff)
|
r)
|
(undo-tree-visualizer-hide-diff)
|
(while (and (undo-tree-node-next current)
|
(or (if undo-tree-visualizer-selection-mode
|
(progn
|
(undo-tree-visualizer-select-next)
|
(setq current undo-tree-visualizer-selected-node))
|
(undo-tree-visualize-redo)
|
(setq current (undo-tree-current buffer-undo-tree)))
|
t)
|
;; branch point
|
(not (or (and (or (null x) (eq x 'branch))
|
(> (undo-tree-num-branches) 1))
|
;; register
|
(and (or (null x) (eq x 'register))
|
(setq r (undo-tree-node-register current))
|
(undo-tree-register-data-p
|
(setq r (registerv-data (get-register r))))
|
(eq current (undo-tree-register-data-node r)))
|
;; saved state
|
(and (or (null x) (eq x 'saved))
|
(undo-tree-node-unmodified-p current))
|
))))
|
;; update diff display, if any
|
(when diff
|
(undo-tree-visualizer-show-diff
|
(when undo-tree-visualizer-selection-mode
|
undo-tree-visualizer-selected-node)))))
|
|
|
(defun undo-tree-visualizer-toggle-timestamps ()
|
"Toggle display of time-stamps."
|
(interactive)
|
(setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
|
(setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
|
;; redraw tree
|
(let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
|
|
|
(defun undo-tree-visualizer-scroll-left (&optional arg)
|
(interactive "p")
|
(scroll-left (or arg 1) t))
|
|
|
(defun undo-tree-visualizer-scroll-right (&optional arg)
|
(interactive "p")
|
(scroll-right (or arg 1) t))
|
|
|
(defun undo-tree-visualizer-scroll-up (&optional arg)
|
(interactive "P")
|
(if (or (and (numberp arg) (< arg 0)) (eq arg '-))
|
(undo-tree-visualizer-scroll-down arg)
|
;; scroll up and expand newly-visible portion of tree
|
(unwind-protect
|
(scroll-up-command arg)
|
(undo-tree-expand-down
|
(nth (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
|
(undo-tree-node-next (undo-tree-current buffer-undo-tree)))))
|
;; signal error if at eob
|
(when (and (not undo-tree-visualizer-needs-extending-down) (eobp))
|
(scroll-up))))
|
|
|
(defun undo-tree-visualizer-scroll-down (&optional arg)
|
(interactive "P")
|
(if (or (and (numberp arg) (< arg 0)) (eq arg '-))
|
(undo-tree-visualizer-scroll-up arg)
|
;; ensure there's enough room at top of buffer to scroll
|
(let ((scroll-lines
|
(or arg (- (window-height) next-screen-context-lines)))
|
(window-line (1- (line-number-at-pos (window-start)))))
|
(when (and undo-tree-visualizer-needs-extending-up
|
(< window-line scroll-lines))
|
(let ((inhibit-read-only t))
|
(goto-char (point-min))
|
(undo-tree-move-up (- scroll-lines window-line)))))
|
;; scroll down and expand newly-visible portion of tree
|
(unwind-protect
|
(scroll-down-command arg)
|
(undo-tree-expand-up
|
(undo-tree-node-previous (undo-tree-current buffer-undo-tree))))
|
;; signal error if at bob
|
(when (and (not undo-tree-visualizer-needs-extending-down) (bobp))
|
(scroll-down))))
|
|
|
|
|
;;; =====================================================================
|
;;; Visualizer selection mode
|
|
(define-minor-mode undo-tree-visualizer-selection-mode
|
"Toggle mode to select nodes in undo-tree visualizer."
|
:lighter "Select"
|
:keymap undo-tree-visualizer-selection-mode-map
|
:group undo-tree
|
(cond
|
;; enable selection mode
|
(undo-tree-visualizer-selection-mode
|
(setq cursor-type 'box)
|
(setq undo-tree-visualizer-selected-node
|
(undo-tree-current buffer-undo-tree))
|
;; erase diff (if any), as initially selected node is identical to current
|
(when undo-tree-visualizer-diff
|
(let ((buff (get-buffer undo-tree-diff-buffer-name))
|
(inhibit-read-only t))
|
(when buff (with-current-buffer buff (erase-buffer))))))
|
(t ;; disable selection mode
|
(setq cursor-type nil)
|
(setq undo-tree-visualizer-selected-node nil)
|
(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
|
(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
|
))
|
|
|
(defun undo-tree-visualizer-select-previous (&optional arg)
|
"Move to previous node."
|
(interactive "p")
|
(let ((node undo-tree-visualizer-selected-node))
|
(catch 'top
|
(dotimes (i (or arg 1))
|
(unless (undo-tree-node-previous node) (throw 'top t))
|
(setq node (undo-tree-node-previous node))))
|
;; when using lazy drawing, extend tree upwards as required
|
(when undo-tree-visualizer-lazy-drawing
|
(undo-tree-expand-up undo-tree-visualizer-selected-node node))
|
;; update diff display, if any
|
(when (and undo-tree-visualizer-diff
|
(not (eq node undo-tree-visualizer-selected-node)))
|
(undo-tree-visualizer-update-diff node))
|
;; move to selected node
|
(goto-char (undo-tree-node-marker node))
|
(setq undo-tree-visualizer-selected-node node)))
|
|
|
(defun undo-tree-visualizer-select-next (&optional arg)
|
"Move to next node."
|
(interactive "p")
|
(let ((node undo-tree-visualizer-selected-node))
|
(catch 'bottom
|
(dotimes (i (or arg 1))
|
(unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
|
(throw 'bottom t))
|
(setq node
|
(nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
|
;; when using lazy drawing, extend tree downwards as required
|
(when undo-tree-visualizer-lazy-drawing
|
(undo-tree-expand-down undo-tree-visualizer-selected-node node))
|
;; update diff display, if any
|
(when (and undo-tree-visualizer-diff
|
(not (eq node undo-tree-visualizer-selected-node)))
|
(undo-tree-visualizer-update-diff node))
|
;; move to selected node
|
(goto-char (undo-tree-node-marker node))
|
(setq undo-tree-visualizer-selected-node node)))
|
|
|
(defun undo-tree-visualizer-select-right (&optional arg)
|
"Move right to a sibling node."
|
(interactive "p")
|
(let ((node undo-tree-visualizer-selected-node)
|
end)
|
(goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
|
(setq end (line-end-position))
|
(catch 'end
|
(dotimes (i arg)
|
(while (or (null node) (eq node undo-tree-visualizer-selected-node))
|
(forward-char)
|
(setq node (get-text-property (point) 'undo-tree-node))
|
(when (= (point) end) (throw 'end t)))))
|
(goto-char (undo-tree-node-marker
|
(or node undo-tree-visualizer-selected-node)))
|
(when (and undo-tree-visualizer-diff node
|
(not (eq node undo-tree-visualizer-selected-node)))
|
(undo-tree-visualizer-update-diff node))
|
(when node (setq undo-tree-visualizer-selected-node node))))
|
|
|
(defun undo-tree-visualizer-select-left (&optional arg)
|
"Move left to a sibling node."
|
(interactive "p")
|
(let ((node (get-text-property (point) 'undo-tree-node))
|
beg)
|
(goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
|
(setq beg (line-beginning-position))
|
(catch 'beg
|
(dotimes (i arg)
|
(while (or (null node) (eq node undo-tree-visualizer-selected-node))
|
(backward-char)
|
(setq node (get-text-property (point) 'undo-tree-node))
|
(when (= (point) beg) (throw 'beg t)))))
|
(goto-char (undo-tree-node-marker
|
(or node undo-tree-visualizer-selected-node)))
|
(when (and undo-tree-visualizer-diff node
|
(not (eq node undo-tree-visualizer-selected-node)))
|
(undo-tree-visualizer-update-diff node))
|
(when node (setq undo-tree-visualizer-selected-node node))))
|
|
|
(defun undo-tree-visualizer-select (pos)
|
(let ((node (get-text-property pos 'undo-tree-node)))
|
(when node
|
;; select node at POS
|
(goto-char (undo-tree-node-marker node))
|
;; when using lazy drawing, extend tree up and down as required
|
(when undo-tree-visualizer-lazy-drawing
|
(undo-tree-expand-up undo-tree-visualizer-selected-node node)
|
(undo-tree-expand-down undo-tree-visualizer-selected-node node))
|
;; update diff display, if any
|
(when (and undo-tree-visualizer-diff
|
(not (eq node undo-tree-visualizer-selected-node)))
|
(undo-tree-visualizer-update-diff node))
|
;; update selected node
|
(setq undo-tree-visualizer-selected-node node)
|
)))
|
|
|
(defun undo-tree-visualizer-mouse-select (pos)
|
"Select undo tree node at mouse event POS."
|
(interactive "@e")
|
(undo-tree-visualizer-select (event-start (nth 1 pos))))
|
|
|
|
|
;;; =====================================================================
|
;;; Visualizer diff display
|
|
(defun undo-tree-visualizer-toggle-diff ()
|
"Toggle diff display in undo-tree visualizer."
|
(interactive)
|
(if undo-tree-visualizer-diff
|
(undo-tree-visualizer-hide-diff)
|
(undo-tree-visualizer-show-diff)))
|
|
|
(defun undo-tree-visualizer-selection-toggle-diff ()
|
"Toggle diff display in undo-tree visualizer selection mode."
|
(interactive)
|
(if undo-tree-visualizer-diff
|
(undo-tree-visualizer-hide-diff)
|
(let ((node (get-text-property (point) 'undo-tree-node)))
|
(when node (undo-tree-visualizer-show-diff node)))))
|
|
|
(defun undo-tree-visualizer-show-diff (&optional node)
|
;; show visualizer diff display
|
(setq undo-tree-visualizer-diff t)
|
(let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
|
(undo-tree-diff node)))
|
(display-buffer-mark-dedicated 'soft)
|
win)
|
(setq win (split-window))
|
(set-window-buffer win buff)
|
(shrink-window-if-larger-than-buffer win)))
|
|
|
(defun undo-tree-visualizer-hide-diff ()
|
;; hide visualizer diff display
|
(setq undo-tree-visualizer-diff nil)
|
(let ((win (get-buffer-window undo-tree-diff-buffer-name)))
|
(when win (with-selected-window win (kill-buffer-and-window)))))
|
|
|
(defun undo-tree-diff (&optional node)
|
;; Create diff between NODE and current state (or previous state and current
|
;; state, if NODE is null). Returns buffer containing diff.
|
(let (tmpfile buff)
|
;; generate diff
|
(let ((undo-tree-inhibit-kill-visualizer t)
|
(current (undo-tree-current buffer-undo-tree)))
|
(undo-tree-set (or node (undo-tree-node-previous current) current)
|
'preserve-timestamps)
|
(setq tmpfile (diff-file-local-copy (current-buffer)))
|
(undo-tree-set current 'preserve-timestamps))
|
(setq buff (diff-no-select
|
tmpfile (current-buffer) nil 'noasync
|
(get-buffer-create undo-tree-diff-buffer-name)))
|
;; delete process messages and useless headers from diff buffer
|
(let ((inhibit-read-only t))
|
(with-current-buffer buff
|
(goto-char (point-min))
|
(delete-region (point) (1+ (line-end-position 3)))
|
(goto-char (point-max))
|
(forward-line -2)
|
(delete-region (point) (point-max))
|
(setq cursor-type nil)
|
(setq buffer-read-only t)))
|
buff))
|
|
|
(defun undo-tree-visualizer-update-diff (&optional node)
|
;; update visualizer diff display to show diff between current state and
|
;; NODE (or previous state, if NODE is null)
|
(with-current-buffer undo-tree-visualizer-parent-buffer
|
(undo-tree-diff node))
|
(let ((win (get-buffer-window undo-tree-diff-buffer-name)))
|
(when win
|
(balance-windows)
|
(shrink-window-if-larger-than-buffer win))))
|
|
;;;; ChangeLog:
|
|
;; 2013-12-28 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; * undo-tree: Update to version 0.6.5.
|
;;
|
;; 2012-12-05 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; Update undo-tree to version 0.6.3
|
;;
|
;; * undo-tree.el: Implement lazy tree drawing to significantly speed up
|
;; visualization of large trees + various more minor improvements.
|
;;
|
;; 2012-09-25 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; Updated undo-tree package to version 0.5.5.
|
;;
|
;; Small bug-fix to avoid hooks triggering an error when trying to save
|
;; undo history in a buffer where undo is disabled.
|
;;
|
;; 2012-09-11 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; Updated undo-tree package to version 0.5.4
|
;;
|
;; Bug-fixes and improvements to persistent history storage.
|
;;
|
;; 2012-07-18 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; Update undo-tree to version 0.5.3
|
;;
|
;; * undo-tree.el: Cope gracefully with undo boundaries being deleted
|
;; (cf. bug#11774). Allow customization of directory to which undo
|
;; history is
|
;; saved.
|
;;
|
;; 2012-05-24 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; updated undo-tree package to version 0.5.2
|
;;
|
;; * undo-tree.el: add diff view feature in undo-tree visualizer.
|
;;
|
;; 2012-05-02 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; undo-tree.el: Update package to version 0.4
|
;;
|
;; 2012-04-20 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; undo-tree.el: Update package to version 0.3.4
|
;;
|
;; * undo-tree.el (undo-list-pop-changeset): fix pernicious bug causing
|
;; undo history to be lost.
|
;; (buffer-undo-tree): set permanent-local property.
|
;; (undo-tree-enable-undo-in-region): add new customization option
|
;; allowing undo-in-region to be disabled.
|
;;
|
;; 2012-01-26 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; undo-tree.el: Fixed copyright attribution and Emacs status.
|
;;
|
;; 2012-01-26 Toby S. Cubitt <tsc25@cantab.net>
|
;;
|
;; undo-tree.el: Update package to version 0.3.3
|
;;
|
;; 2011-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
;;
|
;; Add undo-tree.el
|
;;
|
|
|
|
|
(provide 'undo-tree)
|
|
;;; undo-tree.el ends here
|
