1 ;;; undo-tree.el --- Treat undo history as a tree
3 ;; Copyright (C) 2009-2012 Free Software Foundation, Inc
5 ;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
7 ;; Keywords: convenience, files, undo, redo, history, tree
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/undo-tree.git
11 ;; This file is part of Emacs.
13 ;; This file is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; Emacs has a powerful undo system. Unlike the standard undo/redo system in
30 ;; most software, it allows you to recover *any* past state of a buffer
31 ;; (whereas the standard undo/redo system can lose past states as soon as you
32 ;; redo). However, this power comes at a price: many people find Emacs' undo
33 ;; system confusing and difficult to use, spawning a number of packages that
34 ;; replace it with the less powerful but more intuitive undo/redo system.
36 ;; Both the loss of data with standard undo/redo, and the confusion of Emacs'
37 ;; undo, stem from trying to treat undo history as a linear sequence of
38 ;; changes. It's not. The `undo-tree-mode' provided by this package replaces
39 ;; Emacs' undo system with a system that treats undo history as what it is: a
40 ;; branching tree of changes. This simple idea allows the more intuitive
41 ;; behaviour of the standard undo/redo system to be combined with the power of
42 ;; never losing any history. An added side bonus is that undo history can in
43 ;; some cases be stored more efficiently, allowing more changes to accumulate
44 ;; before Emacs starts discarding history.
46 ;; The only downside to this more advanced yet simpler undo system is that it
47 ;; was inspired by Vim. But, after all, most successful religions steal the
48 ;; best ideas from their competitors!
54 ;; This package has only been tested with Emacs versions 22, 23 and CVS. It
55 ;; will not work without modifications in earlier versions of Emacs.
57 ;; To install `undo-tree-mode', make sure this file is saved in a directory in
58 ;; your `load-path', and add the line:
60 ;; (require 'undo-tree)
62 ;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using
63 ;; "M-x byte-compile-file" from within emacs).
65 ;; If you want to replace the standard Emacs' undo system with the
66 ;; `undo-tree-mode' system in all buffers, you can enable it globally by
69 ;; (global-undo-tree-mode)
71 ;; to your .emacs file.
77 ;; If you're the kind of person who likes to jump in the car and drive,
78 ;; without bothering to first figure out whether the button on the left dips
79 ;; the headlights or operates the ejector seat (after all, you'll soon figure
80 ;; it out when you push it), then here's the minimum you need to know:
82 ;; `undo-tree-mode' and `global-undo-tree-mode'
83 ;; Enable undo-tree mode (either in the current buffer or globally).
85 ;; C-_ C-/ (`undo-tree-undo')
88 ;; M-_ C-? (`undo-tree-redo')
91 ;; `undo-tree-switch-branch'
92 ;; Switch undo-tree branch.
93 ;; (What does this mean? Better press the button and see!)
95 ;; C-x u (`undo-tree-visualize')
96 ;; Visualize the undo tree.
97 ;; (Better try pressing this button too!)
99 ;; C-x r u (`undo-tree-save-state-to-register')
100 ;; Save current buffer state to register.
102 ;; C-x r U (`undo-tree-restore-state-from-register')
103 ;; Restore buffer state from register.
107 ;; In the undo-tree visualizer:
109 ;; <up> p C-p (`undo-tree-visualize-undo')
112 ;; <down> n C-n (`undo-tree-visualize-redo')
115 ;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
116 ;; Switch to previous undo-tree branch.
118 ;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
119 ;; Switch to next undo-tree branch.
121 ;; <mouse-1> (`undo-tree-visualizer-mouse-set')
122 ;; Set state to node at mouse click.
124 ;; t (`undo-tree-visualizer-toggle-timestamps')
125 ;; Toggle display of time-stamps.
127 ;; d (`undo-tree-visualizer-toggle-diff')
128 ;; Toggle diff display.
130 ;; s (`undo-tree-visualizer-selection-mode')
131 ;; Toggle keyboard selection mode.
133 ;; q (`undo-tree-visualizer-quit')
134 ;; Quit undo-tree-visualizer.
136 ;; C-q (`undo-tree-visualizer-abort')
137 ;; Abort undo-tree-visualizer.
153 ;; In visualizer selection mode:
155 ;; <up> p C-p (`undo-tree-visualizer-select-previous')
156 ;; Select previous node.
158 ;; <down> n C-n (`undo-tree-visualizer-select-next')
161 ;; <left> b C-b (`undo-tree-visualizer-select-left')
162 ;; Select left sibling node.
164 ;; <right> f C-f (`undo-tree-visualizer-select-right')
165 ;; Select right sibling node.
168 ;; Select node 10 above.
171 ;; Select node 10 below.
173 ;; <enter> (`undo-tree-visualizer-set')
174 ;; Set state to selected node and exit selection mode.
176 ;; s (`undo-tree-visualizer-mode')
177 ;; Exit selection mode.
179 ;; t (`undo-tree-visualizer-toggle-timestamps')
180 ;; Toggle display of time-stamps.
182 ;; d (`undo-tree-visualizer-toggle-diff')
183 ;; Toggle diff display.
185 ;; q (`undo-tree-visualizer-quit')
186 ;; Quit undo-tree-visualizer.
188 ;; C-q (`undo-tree-visualizer-abort')
189 ;; Abort undo-tree-visualizer.
203 ;; To understand the different undo systems, it's easiest to consider an
204 ;; example. Imagine you make a few edits in a buffer. As you edit, you
205 ;; accumulate a history of changes, which we might visualize as a string of
206 ;; past buffer states, growing downwards:
208 ;; o (initial buffer state)
217 ;; x (current buffer state)
220 ;; Now imagine that you undo the last two changes. We can visualize this as
221 ;; rewinding the current state back two steps:
223 ;; o (initial buffer state)
226 ;; x (current buffer state)
235 ;; However, this isn't a good representation of what Emacs' undo system
236 ;; does. Instead, it treats the undos as *new* changes to the buffer, and adds
237 ;; them to the history:
239 ;; o (initial buffer state)
248 ;; x (buffer state before undo)
257 ;; Actually, since the buffer returns to a previous state after an undo,
258 ;; perhaps a better way to visualize it is to imagine the string of changes
259 ;; turning back on itself:
261 ;; (initial buffer state) o
264 ;; (first edit) o x (second undo)
267 ;; (second edit) o o (first undo)
270 ;; o (buffer state before undo)
272 ;; Treating undos as new changes might seem a strange thing to do. But the
273 ;; advantage becomes clear as soon as we imagine what happens when you edit
274 ;; the buffer again. Since you've undone a couple of changes, new edits will
275 ;; branch off from the buffer state that you've rewound to. Conceptually, it
278 ;; o (initial buffer state)
289 ;; The standard undo/redo system only lets you go backwards and forwards
290 ;; linearly. So as soon as you make that new edit, it discards the old
291 ;; branch. Emacs' undo just keeps adding changes to the end of the string. So
292 ;; the undo history in the two systems now looks like this:
294 ;; Undo/Redo: Emacs' undo
302 ;; . x (new edit) o o |
303 ;; (discarded . | / |
310 ;; Now, what if you change your mind about those undos, and decide you did
311 ;; like those other changes you'd made after all? With the standard undo/redo
312 ;; system, you're lost. There's no way to recover them, because that branch
313 ;; was discarded when you made the new edit.
315 ;; However, in Emacs' undo system, those old buffer states are still there in
316 ;; the undo history. You just have to rewind back through the new edit, and
317 ;; back through the changes made by the undos, until you reach them. Of
318 ;; course, since Emacs treats undos (even undos of undos!) as new changes,
319 ;; you're really weaving backwards and forwards through the history, all the
320 ;; time adding new changes to the end of the string as you go:
325 ;; o o o (undo new edit)
328 ;; o o | | o (undo the undo)
331 ;; (trying to get o | | x (undo the undo)
332 ;; to this state) | /
336 ;; So far, this is still reasonably intuitive to use. It doesn't behave so
337 ;; differently to standard undo/redo, except that by going back far enough you
338 ;; can access changes that would be lost in standard undo/redo.
340 ;; However, imagine that after undoing as just described, you decide you
341 ;; actually want to rewind right back to the initial state. If you're lucky,
342 ;; and haven't invoked any command since the last undo, you can just keep on
343 ;; undoing until you get back to the start:
345 ;; (trying to get o x (got there!)
346 ;; to this state) | |
348 ;; o o o o (keep undoing)
351 ;; o o | | o o (keep undoing)
354 ;; (already undid o | | o (got this far)
355 ;; to this state) | /
359 ;; But if you're unlucky, and you happen to have moved the point (say) after
360 ;; getting to the state labelled "got this far", then you've "broken the undo
361 ;; chain". Hold on to something solid, because things are about to get
362 ;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
363 ;; undos! So to get back to the initial state you now have to rewind through
364 ;; *all* the changes, including the undos you just did:
366 ;; (trying to get o x (finally got there!)
367 ;; to this state) | |
371 ;; | | \ | \ | \ | \ |
372 ;; o o | | o o o | o o
373 ;; | / | | | / | | | /
375 ;; (already undid o | | o<. | | o
376 ;; to this state) | / : | /
380 ;; (got this far, but
381 ;; broke the undo chain)
385 ;; In practice you can just hold down the undo key until you reach the buffer
386 ;; state that you want. But whatever you do, don't move around in the buffer
387 ;; to *check* that you've got back to where you want! Because you'll break the
388 ;; undo chain, and then you'll have to traverse the entire string of undos
389 ;; again, just to get back to the point at which you broke the
390 ;; chain. Undo-in-region and commands such as `undo-only' help to make using
391 ;; Emacs' undo a little easier, but nonetheless it remains confusing for many
395 ;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
396 ;; the history we've been discussing (make a few edits, undo a couple of them,
397 ;; and edit again)? The diagram that conceptually represented our undo
398 ;; history, before we started discussing specific undo systems? It looked like
401 ;; o (initial buffer state)
407 ;; o x (current state)
412 ;; Well, that's *exactly* what the undo history looks like to
413 ;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
414 ;; does), nor does it treat undos as new changes to be added to the end of a
415 ;; linear string of buffer states (as Emacs' undo does). It just keeps track
416 ;; of the tree of branching changes that make up the entire undo history.
418 ;; If you undo from this point, you'll rewind back up the tree to the previous
432 ;; If you were to undo again, you'd rewind back to the initial state. If on
433 ;; the other hand you redo the change, you'll end up back at the bottom of the
434 ;; most recent branch:
436 ;; o (undo takes you here)
442 ;; o x (redo takes you here)
447 ;; So far, this is just like the standard undo/redo system. But what if you
448 ;; want to return to a buffer state located on a previous branch of the
449 ;; history? Since `undo-tree-mode' keeps the entire history, you simply need
450 ;; to tell it to switch to a different branch, and then redo the changes you
456 ;; o (start here, but switch
457 ;; |\ to the other branch)
464 ;; Now you're on the other branch, if you undo and redo changes you'll stay on
465 ;; that branch, moving up and down through the buffer states located on that
466 ;; branch. Until you decide to switch branches again, of course.
468 ;; Real undo trees might have multiple branches and sub-branches:
481 ;; Trying to imagine what Emacs' undo would do as you move about such a tree
482 ;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
483 ;; just moving around this undo history tree. Most of the time, you'll
484 ;; probably only need to stay on the most recent branch, in which case it
485 ;; behaves like standard undo/redo, and is just as simple to understand. But
486 ;; if you ever need to recover a buffer state on a different branch, the
487 ;; possibility of switching between branches and accessing the full undo
488 ;; history is still there.
492 ;; The Undo-Tree Visualizer
493 ;; ========================
495 ;; Actually, it gets better. You don't have to imagine all these tree
496 ;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
497 ;; draws them for you! In fact, it draws even better diagrams: it highlights
498 ;; the node representing the current buffer state, it highlights the current
499 ;; branch, and you can toggle the display of time-stamps (by hitting "t") and
500 ;; a diff of the undo changes (by hitting "d"). (There's one other tiny
501 ;; difference: the visualizer puts the most recent branch on the left rather
504 ;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
506 ;; In the visualizer, the usual keys for moving up and down a buffer instead
507 ;; move up and down the undo history tree (e.g. the up and down arrow keys, or
508 ;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
509 ;; history you are visualizing) is updated as you move around the undo tree in
510 ;; the visualizer. If you reach a branch point in the visualizer, the usual
511 ;; keys for moving forward and backward in a buffer instead switch branch
512 ;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
514 ;; Clicking with the mouse on any node in the visualizer will take you
515 ;; directly to that node, resetting the state of the parent buffer to the
516 ;; state represented by that node.
518 ;; You can also select nodes directly using the keyboard, by hitting "s" to
519 ;; toggle selection mode. The usual motion keys now allow you to move around
520 ;; the tree without changing the parent buffer. Hitting <enter> will reset the
521 ;; state of the parent buffer to the state represented by the currently
524 ;; It can be useful to see how long ago the parent buffer was in the state
525 ;; represented by a particular node in the visualizer. Hitting "t" in the
526 ;; visualizer toggles the display of time-stamps for all the nodes. (Note
527 ;; that, because of the way `undo-tree-mode' works, these time-stamps may be
528 ;; somewhat later than the true times, especially if it's been a long time
529 ;; since you last undid any changes.)
531 ;; To get some idea of what changes are represented by a given node in the
532 ;; tree, it can be useful to see a diff of the changes. Hit "d" in the
533 ;; visualizer to toggle a diff display. This normally displays a diff between
534 ;; the current state and the previous one, i.e. it shows you the changes that
535 ;; will be applied if you undo (move up the tree). However, the diff display
536 ;; really comes into its own in the visualizer's selection mode (see above),
537 ;; where it instead shows a diff between the current state and the currently
538 ;; selected state, i.e. it shows you the changes that will be applied if you
539 ;; reset to the selected state.
541 ;; (Note that the diff is generated by the Emacs `diff' command, and is
542 ;; displayed using `diff-mode'. See the corresponding customization groups if
543 ;; you want to customize the diff display.)
545 ;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
546 ;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
547 ;; returning the parent buffer to whatever state it was originally in when the
555 ;; Emacs allows a very useful and powerful method of undoing only selected
556 ;; changes: when a region is active, only changes that affect the text within
557 ;; that region will be undone. With the standard Emacs undo system, changes
558 ;; produced by undoing-in-region naturally get added onto the end of the
559 ;; linear undo history:
563 ;; | x (second undo-in-region)
566 ;; | o (first undo-in-region)
572 ;; You can of course redo these undos-in-region as usual, by undoing the
580 ;; | o o (undo the undo-in-region)
584 ;; o x (undo the undo-in-region)
587 ;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
588 ;; region, undoing only undoes changes that affect that region. However, the
589 ;; way these undos-in-region are recorded in the undo history is quite
590 ;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
591 ;; undo history. The new branch consists of an undo step that undoes some of
592 ;; the changes that affect the current region, and another step that undoes
593 ;; the remaining changes needed to rejoin the previous undo history.
595 ;; Previous undo history Undo-in-region
603 ;; o o x (undo-in-region)
608 ;; As long as you don't change the active region after undoing-in-region,
609 ;; continuing to undo-in-region extends the new branch, pulling more changes
610 ;; that affect the current region into an undo step immediately above your
611 ;; current location in the undo tree, and pushing the point at which the new
612 ;; branch is attached further up the tree:
614 ;; First undo-in-region Second undo-in-region
619 ;; o o x (undo-in-region)
627 ;; Redoing takes you back down the undo tree, as usual (as long as you haven't
628 ;; changed the active region after undoing-in-region, it doesn't matter if it
643 ;; What about redo-in-region? Obviously, this only makes sense if you have
644 ;; already undone some changes, so that there are some changes to redo!
645 ;; Redoing-in-region splits off a new branch of the undo history below your
646 ;; current location in the undo tree. This time, the new branch consists of a
647 ;; redo step that redoes some of the redo changes that affect the current
648 ;; region, followed by all the remaining redo changes.
650 ;; Previous undo history Redo-in-region
658 ;; o o x (redo-in-region)
663 ;; As long as you don't change the active region after redoing-in-region,
664 ;; continuing to redo-in-region extends the new branch, pulling more redo
665 ;; changes into a redo step immediately below your current location in the
668 ;; First redo-in-region Second redo-in-region
676 ;; o x (redo-in-region) o o
679 ;; o o o x (redo-in-region)
684 ;; Note that undo-in-region and redo-in-region only ever add new changes to
685 ;; the undo tree, they *never* modify existing undo history. So you can always
686 ;; return to previous buffer states by switching to a previous branch of the
694 ;; * modified `undo-list-transfer-to-tree' and `undo-list-pop-changeset' to
695 ;; cope better if undo boundary before undo-tree-canary is missing
696 ;; (e.g. org-mode's `org-self-insert-cluster-for-undo' removes this undo
698 ;; * added `undo-tree-history-directory-alist', the undo history file analogue
699 ;; of `backup-directory-alist'
702 ;; * added `~' to end of default history save-file name
703 ;; * avoid error in `undo-tree-save-history' when undo is disabled in buffer
704 ;; or buffer has no undo information to save
707 ;; * remove now unnecessary compatibility hack for `called-interactively-p'
710 ;; * implemented diff display in visualizer, toggled on and off using
711 ;; `undo-tree-visualizer-toggle-diff'
712 ;; * added `undo-tree-visualizer-diff' customization option, to display diff
714 ;; * added `called-interactively-p', `registerv-make', `registerv-data',
715 ;; `diff-no-select' and `diff-file-local-copy' compatibility hacks for
717 ;; * split out core of `undo-tree-undo' and `undo-tree-redo' into internal
718 ;; `undo-tree-undo-1' and `undo-tree-redo-1' functions, which now take an
719 ;; additional optional argument to preserve timestamps
720 ;; * preserve timestamps when generating diff for visualizer diff view
721 ;; * fixed bug in `undo-tree-visualizer-select-left' and
722 ;; `undo-tree-visualizer-select-right' when using selection mode whilst
723 ;; timestamps are displayed
724 ;; * fixed bug in `undo-tree-draw-node' caused by new registerv structure,
725 ;; which prevented registers from being displayed in visualizer
726 ;; * added `undo-tree-visualizer-relative-timestamps' option to make
727 ;; visualizer display timestamps relative to current time
728 ;; * use a function `undo-tree-make-history-save-file-name' function to
729 ;; generate history save filename, allowing save file to be customized by
730 ;; overriding this function
731 ;; * clear visualizer data / kill visualizer in `undo-tree-save-history'
732 ;; before saving history to file, otherwise markers in visualizer meta-data
733 ;; cause read errors in `undo-tree-load-history'
734 ;; * make `undo-tree-visualizer-timestamps' into defcustom, to allow
735 ;; timestamps to be displayed by default
736 ;; * use `undo-tree-visualizer-selected-node' to store currently selected node
737 ;; in visualizer selection mode, instead of relying on point location, to
738 ;; avoid errors if point was moved manually
739 ;; * added `undo-tree-visualizer-abort' command to quit visualizer and return
740 ;; to original state, stored in `undo-tree-visualizer-initial-node'
743 ;; * implemented persistent history storage: `undo-tree-save-history' and
744 ;; `undo-tree-load-history' save and restore an undo tree to file, enabling
745 ;; `undo-tree-auto-save-history' causes history to be saved and restored
746 ;; automatically when saving or loading files
747 ;; * renamed internal `make-undo-tree-<struct>' functions to
748 ;; `undo-tree-make-<struct>' to avoid polluting name-space
749 ;; * create proper registerv structure using `registerv-make' when storing
750 ;; undo state in registers in `undo-tree-save-state-to-register' (and
751 ;; `undo-tree-restore-state-from-register')
752 ;; * suppress branch point messages when undo/redoing from `undo-tree-set'
753 ;; * make various interactive commands signal an error if buffer is read-only
754 ;; * let-bind `inhibit-read-only' instead of setting and restoring
755 ;; `buffer-read-only'
756 ;; * use non-nil `undo-tree-inhibit-kill-visualizer' instead of
757 ;; `undo-in-progress' to inhibit `undo-tree-kill-visualizer', so that
758 ;; undoing and redoing in parent buffer also kill visualizer
761 ;; * improved `undo-tree-switch-branch': display current branch number in
762 ;; prompt, switch to other branch without prompting when there are only two,
763 ;; and display message indicating new branch number after switching
766 ;; * set `permanent-local' property on `buffer-undo-tree', to prevent history
767 ;; being discarded when switching major-mode
768 ;; * added `undo-tree-enable-undo-in-region' customization option to allow
769 ;; undo-in-region to be disabled.
770 ;; * fixed bug in `undo-list-pop-changeset' which, through a subtle chain of
771 ;; consequences, occasionally caused undo-tree-mode to lose large amounts of
772 ;; undo history (thanks to Magnar Sveen for his sterling efforts in helping
776 ;; * added `term-mode' to `undo-tree-incompatible-major-modes'
779 ;; * added additional check in `undo-list-GCd-marker-elt-p' to guard against
780 ;; undo elements being mis-identified as marker elements
781 ;; * fixed bug in `undo-list-transfer-to-tree'
784 ;; * use `get-buffer-create' when creating the visualizer buffer in
785 ;; `undo-tree-visualize', to fix bug caused by `global-undo-tree-mode' being
786 ;; enabled in the visualizer when `default-major-mode' is set to something
787 ;; other than `fundamental-mode' (thanks to Michael Heerdegen for suggesting
789 ;; * modified `turn-on-undo-tree-mode' to avoid turning on `undo-tree-mode' if
790 ;; the buffer's `major-mode' implements its own undo system, by checking
791 ;; whether `undo' is remapped, the default "C-/" or "C-_" bindings have been
792 ;; overridden, or the `major-mode' is listed in
793 ;; `undo-tree-incompatible-major-modes'
794 ;; * discard position entries from `buffer-undo-list' changesets created by
795 ;; undoing or redoing, to ensure point is always moved to where the change
796 ;; is (standard Emacs `undo' also does this)
797 ;; * fixed `undo-tree-draw-node' to use correct faces and indicate registers
798 ;; when displaying timestamps in visualizer
801 ;; * implemented undo-in-region
802 ;; * fixed bugs in `undo-list-transfer-to-tree' and
803 ;; `undo-list-rebuild-from-tree' which caused errors when undo history was
805 ;; * defun `region-active-p' if not already defined, for compatibility with
809 ;; * modified `undo-tree-node' defstruct and macros to allow arbitrary
810 ;; meta-data to be stored in a plist associated with a node, and
811 ;; reimplemented storage of visualizer data on top of this
812 ;; * display registers storing undo-tree state in visualizer
813 ;; * implemented keyboard selection in visualizer
814 ;; * rebuild `buffer-undo-list' from tree when disabling `undo-tree-mode'
817 ;; * added support for marker undo entries
820 ;; * pass null argument to `kill-buffer' call in `undo-tree-visualizer-quit',
821 ;; since the argument's not optional in earlier Emacs versions
822 ;; * added match for "No further redo information" to
823 ;; `debug-ignored-errors' to prevent debugger being called on this error
824 ;; * made `undo-tree-visualizer-quit' select the window displaying the
825 ;; visualizer's parent buffer, or switch to the parent buffer if no window
827 ;; * fixed bug in `undo-tree-switch-branch'
828 ;; * general code tidying and reorganisation
829 ;; * fixed bugs in history-discarding logic
830 ;; * fixed bug in `undo-tree-insert' triggered by `undo-tree-visualizer-set'
831 ;; by ensuring mark is deactivated
834 ;; * added `undo-tree-mode-lighter' customization option to allow the
835 ;; mode-line lighter to be changed
836 ;; * bug-fix in `undo-tree-discard-node'
837 ;; * added `undo-tree-save-state-to-register' and
838 ;; `undo-tree-restore-state-from-register' commands and keybindings for
839 ;; saving/restoring undo-tree states using registers
842 ;; * modified `undo-tree-visualize' to mark the visualizer window as
843 ;; soft-dedicated, and changed `undo-tree-visualizer-quit' to use
844 ;; `kill-buffer', so that the visualizer window is deleted along with its
845 ;; buffer if the visualizer buffer was displayed in a new window, but not if
846 ;; it was displayed in an existing window.
849 ;; * modified `undo-tree-undo' and `undo-tree-redo' to always replace
850 ;; redo/undo entries with new ones generated by `primitive-undo', as the new
851 ;; changesets will restore the point more reliably
854 ;; * fixed `undo-tree-visualizer-quit' to remove `after-change-functions'
855 ;; hook there, rather than in `undo-tree-kill-visualizer'
858 ;; * fixed keybindings
859 ;; * renamed `undo-tree-visualizer-switch-previous-branch' and
860 ;; `undo-tree-visualizer-switch-next-branch' to
861 ;; `undo-tree-visualizer-switch-branch-left' and
862 ;; `undo-tree-visualizer-switch-branch-right'
865 ;; * prevented `undo-tree-kill-visualizer' from killing visualizer when
866 ;; undoing/redoing from the visualizer, which completely broke the
868 ;; * changed one redo binding, so that at least one set of undo/redo bindings
869 ;; works in a terminal
870 ;; * bound vertical scrolling commands in `undo-tree-visualizer-map', in case
871 ;; they aren't bound globally
872 ;; * added missing :group argument to `defface's
881 (eval-when-compile (require 'cl))
886 ;;; =====================================================================
887 ;;; Compatibility hacks for older Emacsen
889 ;; `characterp' isn't defined in Emacs versions < 23
890 (unless (fboundp 'characterp)
891 (defalias 'characterp 'char-valid-p))
893 ;; `region-active-p' isn't defined in Emacs versions < 23
894 (unless (fboundp 'region-active-p)
895 (defun region-active-p () (and transient-mark-mode mark-active)))
898 ;; `registerv' defstruct isn't defined in Emacs versions < 24
899 (unless (fboundp 'registerv-make)
900 (defmacro registerv-make (data &rest dummy) data))
902 (unless (fboundp 'registerv-data)
903 (defmacro registerv-data (data) data))
906 ;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
907 ;; versions < 24 (copied and adapted from Emacs 24)
908 (unless (fboundp 'diff-no-select)
909 (defun diff-no-select (old new &optional switches no-async buf)
910 ;; Noninteractive helper for creating and reverting diff buffers
911 (unless (bufferp new) (setq new (expand-file-name new)))
912 (unless (bufferp old) (setq old (expand-file-name old)))
913 (or switches (setq switches diff-switches)) ; If not specified, use default.
914 (unless (listp switches) (setq switches (list switches)))
915 (or buf (setq buf (get-buffer-create "*Diff*")))
916 (let* ((old-alt (diff-file-local-copy old))
917 (new-alt (diff-file-local-copy new))
921 ;; Use explicitly specified switches
923 ,@(mapcar #'shell-quote-argument
925 (when (or old-alt new-alt)
926 (list "-L" (if (stringp old)
927 old (prin1-to-string old))
928 "-L" (if (stringp new)
929 new (prin1-to-string new))))
930 (list (or old-alt old)
933 (thisdir default-directory))
934 (with-current-buffer buf
935 (setq buffer-read-only t)
936 (buffer-disable-undo (current-buffer))
937 (let ((inhibit-read-only t))
939 (buffer-enable-undo (current-buffer))
941 (set (make-local-variable 'revert-buffer-function)
942 (lambda (_ignore-auto _noconfirm)
943 (diff-no-select old new switches no-async (current-buffer))))
944 (setq default-directory thisdir)
945 (let ((inhibit-read-only t))
946 (insert command "\n"))
947 (if (and (not no-async) (fboundp 'start-process))
948 (let ((proc (start-process "Diff" buf shell-file-name
949 shell-command-switch command)))
950 (set-process-filter proc 'diff-process-filter)
951 (set-process-sentinel
952 proc (lambda (proc _msg)
953 (with-current-buffer (process-buffer proc)
954 (diff-sentinel (process-exit-status proc))
955 (if old-alt (delete-file old-alt))
956 (if new-alt (delete-file new-alt))))))
957 ;; Async processes aren't available.
958 (let ((inhibit-read-only t))
960 (call-process shell-file-name nil buf nil
961 shell-command-switch command))
962 (if old-alt (delete-file old-alt))
963 (if new-alt (delete-file new-alt)))))
966 (unless (fboundp 'diff-file-local-copy)
967 (defun diff-file-local-copy (file-or-buf)
968 (if (bufferp file-or-buf)
969 (with-current-buffer file-or-buf
970 (let ((tempfile (make-temp-file "buffer-content-")))
971 (write-region nil nil tempfile nil 'nomessage)
973 (file-local-copy file-or-buf))))
978 ;;; =====================================================================
979 ;;; Global variables and customization options
981 (defvar buffer-undo-tree nil
982 "Tree of undo entries in current buffer.")
983 (make-variable-buffer-local 'buffer-undo-tree)
984 (put 'buffer-undo-tree 'permanent-local t)
987 (defgroup undo-tree nil
991 (defcustom undo-tree-mode-lighter " Undo-Tree"
992 "Lighter displayed in mode line
993 when `undo-tree-mode' is enabled."
998 (defcustom undo-tree-auto-save-history nil
999 "When non-nil, `undo-tree-mode' will save undo history to file
1000 when a buffer is saved to file.
1002 It will automatically load undo history when a buffer is loaded
1003 from file, if an undo save file exists.
1005 Undo-tree history is saved to a file called
1006 \".<buffer-file-name>.~undo-tree\" in the same directory as the
1009 WARNING! `undo-tree-auto-save-history' will not work properly in
1010 Emacs versions prior to 24.1.50.1, so it cannot be enabled via
1011 the customization interface in versions earlier than that one. To
1012 ignore this warning and enable it regardless, set
1013 `undo-tree-auto-save-history' to a non-nil value outside of
1016 :type (if (version-list-< (version-to-list emacs-version) '(24 1 50 1))
1017 '(choice (const :tag "<disabled>" nil))
1021 (defcustom undo-tree-history-directory-alist nil
1022 "Alist of filename patterns and undo history directory names.
1023 Each element looks like (REGEXP . DIRECTORY). Undo history for
1024 files with names matching REGEXP will be saved in DIRECTORY.
1025 DIRECTORY may be relative or absolute. If it is absolute, so
1026 that all matching files are backed up into the same directory,
1027 the file names in this directory will be the full name of the
1028 file backed up with all directory separators changed to `!' to
1029 prevent clashes. This will not work correctly if your filesystem
1030 truncates the resulting name.
1032 For the common case of all backups going into one directory, the
1033 alist should contain a single element pairing \".\" with the
1034 appropriate directory name.
1036 If this variable is nil, or it fails to match a filename, the
1037 backup is made in the original file's directory.
1039 On MS-DOS filesystems without long names this variable is always
1042 :type '(repeat (cons (regexp :tag "Regexp matching filename")
1043 (directory :tag "Undo history directory name"))))
1046 (defcustom undo-tree-visualizer-relative-timestamps t
1047 "When non-nil, display times relative to current time
1048 when displaying time stamps in visualizer.
1050 Otherwise, display absolute times."
1055 (defcustom undo-tree-visualizer-timestamps nil
1056 "When non-nil, display time-stamps by default
1057 in undo-tree visualizer.
1059 \\<undo-tree-visualizer-map>You can always toggle time-stamps on and off \
1060 using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
1061 setting of this variable."
1064 (make-variable-buffer-local 'undo-tree-visualizer-timestamps)
1067 (defcustom undo-tree-visualizer-diff nil
1068 "When non-nil, display diff by default in undo-tree visualizer.
1070 \\<undo-tree-visualizer-map>You can always toggle the diff display \
1071 using \\[undo-tree-visualizer-toggle-diff], regardless of the
1072 setting of this variable."
1075 (make-variable-buffer-local 'undo-tree-visualizer-diff)
1078 (defcustom undo-tree-incompatible-major-modes '(term-mode)
1079 "List of major-modes in which `undo-tree-mode' should not be enabled.
1080 \(See `turn-on-undo-tree-mode'.\)"
1082 :type '(repeat symbol))
1085 (defcustom undo-tree-enable-undo-in-region t
1086 "When non-nil, enable undo-in-region.
1088 When undo-in-region is enabled, undoing or redoing when the
1089 region is active (in `transient-mark-mode') or with a prefix
1090 argument (not in `transient-mark-mode') only undoes changes
1091 within the current region."
1096 (defface undo-tree-visualizer-default-face
1097 '((((class color)) :foreground "gray"))
1098 "Face used to draw undo-tree in visualizer."
1101 (defface undo-tree-visualizer-current-face
1102 '((((class color)) :foreground "red"))
1103 "Face used to highlight current undo-tree node in visualizer."
1106 (defface undo-tree-visualizer-active-branch-face
1107 '((((class color) (background dark))
1108 (:foreground "white" :weight bold))
1109 (((class color) (background light))
1110 (:foreground "black" :weight bold)))
1111 "Face used to highlight active undo-tree branch in visualizer."
1114 (defface undo-tree-visualizer-register-face
1115 '((((class color)) :foreground "yellow"))
1116 "Face used to highlight undo-tree nodes saved to a register
1121 (defvar undo-tree-visualizer-parent-buffer nil
1122 "Parent buffer in visualizer.")
1123 (make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
1125 ;; stores current horizontal spacing needed for drawing undo-tree
1126 (defvar undo-tree-visualizer-spacing nil)
1127 (make-variable-buffer-local 'undo-tree-visualizer-spacing)
1129 ;; calculate horizontal spacing required for drawing undo-tree with current
1131 (defsubst undo-tree-visualizer-calculate-spacing ()
1132 (if undo-tree-visualizer-timestamps
1133 (if undo-tree-visualizer-relative-timestamps 9 13)
1136 ;; holds node that was current when visualizer was invoked
1137 (defvar undo-tree-visualizer-initial-node nil)
1138 (make-variable-buffer-local 'undo-tree-visualizer-initial-node)
1140 ;; holds currently selected node in visualizer selection mode
1141 (defvar undo-tree-visualizer-selected-node nil)
1142 (make-variable-buffer-local 'undo-tree-visualizer-selected)
1144 ;; dynamically bound to t when undoing from visualizer, to inhibit
1145 ;; `undo-tree-kill-visualizer' hook function in parent buffer
1146 (defvar undo-tree-inhibit-kill-visualizer nil)
1149 (defconst undo-tree-visualizer-buffer-name " *undo-tree*")
1150 (defconst undo-tree-diff-buffer-name "*undo-tree Diff*")
1152 ;; prevent debugger being called on "No further redo information"
1153 (add-to-list 'debug-ignored-errors "^No further redo information")
1158 ;;; =================================================================
1159 ;;; Setup default keymaps
1161 (defvar undo-tree-map nil
1162 "Keymap used in undo-tree-mode.")
1164 (unless undo-tree-map
1165 (let ((map (make-sparse-keymap)))
1166 ;; remap `undo' and `undo-only' to `undo-tree-undo'
1167 (define-key map [remap undo] 'undo-tree-undo)
1168 (define-key map [remap undo-only] 'undo-tree-undo)
1169 ;; bind standard undo bindings (since these match redo counterparts)
1170 (define-key map (kbd "C-/") 'undo-tree-undo)
1171 (define-key map "\C-_" 'undo-tree-undo)
1172 ;; redo doesn't exist normally, so define our own keybindings
1173 (define-key map (kbd "C-?") 'undo-tree-redo)
1174 (define-key map (kbd "M-_") 'undo-tree-redo)
1175 ;; just in case something has defined `redo'...
1176 (define-key map [remap redo] 'undo-tree-redo)
1177 ;; we use "C-x u" for the undo-tree visualizer
1178 (define-key map (kbd "\C-x u") 'undo-tree-visualize)
1179 ;; bind register commands
1180 (define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
1181 (define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
1183 (setq undo-tree-map map)))
1186 (defvar undo-tree-visualizer-map nil
1187 "Keymap used in undo-tree visualizer.")
1189 (unless undo-tree-visualizer-map
1190 (let ((map (make-sparse-keymap)))
1191 ;; vertical motion keys undo/redo
1192 (define-key map [remap previous-line] 'undo-tree-visualize-undo)
1193 (define-key map [remap next-line] 'undo-tree-visualize-redo)
1194 (define-key map [up] 'undo-tree-visualize-undo)
1195 (define-key map "p" 'undo-tree-visualize-undo)
1196 (define-key map "\C-p" 'undo-tree-visualize-undo)
1197 (define-key map [down] 'undo-tree-visualize-redo)
1198 (define-key map "n" 'undo-tree-visualize-redo)
1199 (define-key map "\C-n" 'undo-tree-visualize-redo)
1200 ;; horizontal motion keys switch branch
1201 (define-key map [remap forward-char]
1202 'undo-tree-visualize-switch-branch-right)
1203 (define-key map [remap backward-char]
1204 'undo-tree-visualize-switch-branch-left)
1205 (define-key map [right] 'undo-tree-visualize-switch-branch-right)
1206 (define-key map "f" 'undo-tree-visualize-switch-branch-right)
1207 (define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
1208 (define-key map [left] 'undo-tree-visualize-switch-branch-left)
1209 (define-key map "b" 'undo-tree-visualize-switch-branch-left)
1210 (define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
1211 ;; mouse sets buffer state to node at click
1212 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
1213 ;; toggle timestamps
1214 (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
1216 (define-key map "d" 'undo-tree-visualizer-toggle-diff)
1218 (define-key map "s" 'undo-tree-visualizer-selection-mode)
1219 ;; horizontal scrolling may be needed if the tree is very wide
1220 (define-key map "," 'undo-tree-visualizer-scroll-left)
1221 (define-key map "." 'undo-tree-visualizer-scroll-right)
1222 (define-key map "<" 'undo-tree-visualizer-scroll-left)
1223 (define-key map ">" 'undo-tree-visualizer-scroll-right)
1224 ;; vertical scrolling may be needed if the tree is very tall
1225 (define-key map [next] 'scroll-up)
1226 (define-key map [prior] 'scroll-down)
1227 ;; quit/abort visualizer
1228 (define-key map "q" 'undo-tree-visualizer-quit)
1229 (define-key map "\C-q" 'undo-tree-visualizer-abort)
1231 (setq undo-tree-visualizer-map map)))
1234 (defvar undo-tree-visualizer-selection-map nil
1235 "Keymap used in undo-tree visualizer selection mode.")
1237 (unless undo-tree-visualizer-selection-map
1238 (let ((map (make-sparse-keymap)))
1239 ;; vertical motion keys move up and down tree
1240 (define-key map [remap previous-line]
1241 'undo-tree-visualizer-select-previous)
1242 (define-key map [remap next-line]
1243 'undo-tree-visualizer-select-next)
1244 (define-key map [up] 'undo-tree-visualizer-select-previous)
1245 (define-key map "p" 'undo-tree-visualizer-select-previous)
1246 (define-key map "\C-p" 'undo-tree-visualizer-select-previous)
1247 (define-key map [down] 'undo-tree-visualizer-select-next)
1248 (define-key map "n" 'undo-tree-visualizer-select-next)
1249 (define-key map "\C-n" 'undo-tree-visualizer-select-next)
1250 ;; vertical scroll keys move up and down quickly
1251 (define-key map [next]
1252 (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
1253 (define-key map [prior]
1254 (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
1255 ;; horizontal motion keys move to left and right siblings
1256 (define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
1257 (define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
1258 (define-key map [right] 'undo-tree-visualizer-select-right)
1259 (define-key map "f" 'undo-tree-visualizer-select-right)
1260 (define-key map "\C-f" 'undo-tree-visualizer-select-right)
1261 (define-key map [left] 'undo-tree-visualizer-select-left)
1262 (define-key map "b" 'undo-tree-visualizer-select-left)
1263 (define-key map "\C-b" 'undo-tree-visualizer-select-left)
1264 ;; horizontal scroll keys move left or right quickly
1266 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1268 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1270 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1272 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1273 ;; mouse or <enter> sets buffer state to node at point/click
1274 (define-key map "\r" 'undo-tree-visualizer-set)
1275 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
1276 ;; toggle timestamps
1277 (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
1279 (define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
1280 ;; quit visualizer selection mode
1281 (define-key map "s" 'undo-tree-visualizer-mode)
1283 (define-key map "q" 'undo-tree-visualizer-quit)
1284 (define-key map "\C-q" 'undo-tree-visualizer-abort)
1286 (setq undo-tree-visualizer-selection-map map)))
1291 ;;; =====================================================================
1292 ;;; Undo-tree data structure
1298 (:constructor make-undo-tree
1300 (root (undo-tree-make-node nil nil))
1303 (object-pool (make-hash-table :test 'eq :weakness 'value))))
1306 root current size object-pool)
1312 (:type vector) ; create unnamed struct
1314 (:constructor undo-tree-make-node
1318 (timestamp (current-time))
1320 (:constructor undo-tree-make-node-backwards
1324 (next (list next-node))
1325 (timestamp (current-time))
1328 previous next undo redo timestamp branch meta-data)
1331 (defmacro undo-tree-node-p (n)
1332 (let ((len (length (undo-tree-make-node nil nil))))
1333 `(and (vectorp ,n) (= (length ,n) ,len))))
1338 (undo-tree-region-data
1339 (:type vector) ; create unnamed struct
1341 (:constructor undo-tree-make-region-data
1342 (&optional undo-beginning undo-end
1343 redo-beginning redo-end))
1344 (:constructor undo-tree-make-undo-region-data
1345 (undo-beginning undo-end))
1346 (:constructor undo-tree-make-redo-region-data
1347 (redo-beginning redo-end))
1349 undo-beginning undo-end redo-beginning redo-end)
1352 (defmacro undo-tree-region-data-p (r)
1353 (let ((len (length (undo-tree-make-region-data))))
1354 `(and (vectorp ,r) (= (length ,r) ,len))))
1356 (defmacro undo-tree-node-clear-region-data (node)
1357 `(setf (undo-tree-node-meta-data ,node)
1360 (plist-put (undo-tree-node-meta-data ,node)
1364 (defmacro undo-tree-node-undo-beginning (node)
1365 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1366 (when (undo-tree-region-data-p r)
1367 (undo-tree-region-data-undo-beginning r))))
1369 (defmacro undo-tree-node-undo-end (node)
1370 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1371 (when (undo-tree-region-data-p r)
1372 (undo-tree-region-data-undo-end r))))
1374 (defmacro undo-tree-node-redo-beginning (node)
1375 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1376 (when (undo-tree-region-data-p r)
1377 (undo-tree-region-data-redo-beginning r))))
1379 (defmacro undo-tree-node-redo-end (node)
1380 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1381 (when (undo-tree-region-data-p r)
1382 (undo-tree-region-data-redo-end r))))
1385 (defsetf undo-tree-node-undo-beginning (node) (val)
1386 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1387 (unless (undo-tree-region-data-p r)
1388 (setf (undo-tree-node-meta-data ,node)
1389 (plist-put (undo-tree-node-meta-data ,node) :region
1390 (setq r (undo-tree-make-region-data)))))
1391 (setf (undo-tree-region-data-undo-beginning r) ,val)))
1393 (defsetf undo-tree-node-undo-end (node) (val)
1394 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1395 (unless (undo-tree-region-data-p r)
1396 (setf (undo-tree-node-meta-data ,node)
1397 (plist-put (undo-tree-node-meta-data ,node) :region
1398 (setq r (undo-tree-make-region-data)))))
1399 (setf (undo-tree-region-data-undo-end r) ,val)))
1401 (defsetf undo-tree-node-redo-beginning (node) (val)
1402 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1403 (unless (undo-tree-region-data-p r)
1404 (setf (undo-tree-node-meta-data ,node)
1405 (plist-put (undo-tree-node-meta-data ,node) :region
1406 (setq r (undo-tree-make-region-data)))))
1407 (setf (undo-tree-region-data-redo-beginning r) ,val)))
1409 (defsetf undo-tree-node-redo-end (node) (val)
1410 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1411 (unless (undo-tree-region-data-p r)
1412 (setf (undo-tree-node-meta-data ,node)
1413 (plist-put (undo-tree-node-meta-data ,node) :region
1414 (setq r (undo-tree-make-region-data)))))
1415 (setf (undo-tree-region-data-redo-end r) ,val)))
1420 (undo-tree-visualizer-data
1421 (:type vector) ; create unnamed struct
1423 (:constructor undo-tree-make-visualizer-data
1424 (&optional lwidth cwidth rwidth marker))
1426 lwidth cwidth rwidth marker)
1429 (defmacro undo-tree-visualizer-data-p (v)
1430 (let ((len (length (undo-tree-make-visualizer-data))))
1431 `(and (vectorp ,v) (= (length ,v) ,len))))
1433 (defmacro undo-tree-node-clear-visualizer-data (node)
1434 `(setf (undo-tree-node-meta-data ,node)
1437 (plist-put (undo-tree-node-meta-data ,node)
1438 :visualizer nil)))))
1441 (defmacro undo-tree-node-lwidth (node)
1442 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1443 (when (undo-tree-visualizer-data-p v)
1444 (undo-tree-visualizer-data-lwidth v))))
1446 (defmacro undo-tree-node-cwidth (node)
1447 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1448 (when (undo-tree-visualizer-data-p v)
1449 (undo-tree-visualizer-data-cwidth v))))
1451 (defmacro undo-tree-node-rwidth (node)
1452 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1453 (when (undo-tree-visualizer-data-p v)
1454 (undo-tree-visualizer-data-rwidth v))))
1456 (defmacro undo-tree-node-marker (node)
1457 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1458 (when (undo-tree-visualizer-data-p v)
1459 (undo-tree-visualizer-data-marker v))))
1462 (defsetf undo-tree-node-lwidth (node) (val)
1463 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1464 (unless (undo-tree-visualizer-data-p v)
1465 (setf (undo-tree-node-meta-data ,node)
1466 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1467 (setq v (undo-tree-make-visualizer-data)))))
1468 (setf (undo-tree-visualizer-data-lwidth v) ,val)))
1470 (defsetf undo-tree-node-cwidth (node) (val)
1471 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1472 (unless (undo-tree-visualizer-data-p v)
1473 (setf (undo-tree-node-meta-data ,node)
1474 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1475 (setq v (undo-tree-make-visualizer-data)))))
1476 (setf (undo-tree-visualizer-data-cwidth v) ,val)))
1478 (defsetf undo-tree-node-rwidth (node) (val)
1479 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1480 (unless (undo-tree-visualizer-data-p v)
1481 (setf (undo-tree-node-meta-data ,node)
1482 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1483 (setq v (undo-tree-make-visualizer-data)))))
1484 (setf (undo-tree-visualizer-data-rwidth v) ,val)))
1486 (defsetf undo-tree-node-marker (node) (val)
1487 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1488 (unless (undo-tree-visualizer-data-p v)
1489 (setf (undo-tree-node-meta-data ,node)
1490 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1491 (setq v (undo-tree-make-visualizer-data)))))
1492 (setf (undo-tree-visualizer-data-marker v) ,val)))
1497 (undo-tree-register-data
1500 (:constructor undo-tree-make-register-data (buffer node)))
1503 (defun undo-tree-register-data-p (data)
1506 (undo-tree-node-p (undo-tree-register-data-node data))))
1508 (defun undo-tree-register-data-print-func (data)
1509 (princ (format "an undo-tree state for buffer %s"
1510 (undo-tree-register-data-buffer data))))
1512 (defmacro undo-tree-node-register (node)
1513 `(plist-get (undo-tree-node-meta-data ,node) :register))
1515 (defsetf undo-tree-node-register (node) (val)
1516 `(setf (undo-tree-node-meta-data ,node)
1517 (plist-put (undo-tree-node-meta-data ,node) :register ,val)))
1522 ;;; =====================================================================
1523 ;;; Basic undo-tree data structure functions
1525 (defun undo-tree-grow (undo)
1526 "Add an UNDO node to current branch of `buffer-undo-tree'."
1527 (let* ((current (undo-tree-current buffer-undo-tree))
1528 (new (undo-tree-make-node current undo)))
1529 (push new (undo-tree-node-next current))
1530 (setf (undo-tree-current buffer-undo-tree) new)))
1533 (defun undo-tree-grow-backwards (node undo &optional redo)
1534 "Add new node *above* undo-tree NODE, and return new node.
1535 Note that this will overwrite NODE's \"previous\" link, so should
1536 only be used on a detached NODE, never on nodes that are already
1537 part of `buffer-undo-tree'."
1538 (let ((new (undo-tree-make-node-backwards node undo redo)))
1539 (setf (undo-tree-node-previous node) new)
1543 (defun undo-tree-splice-node (node splice)
1544 "Splice NODE into undo tree, below node SPLICE.
1545 Note that this will overwrite NODE's \"next\" and \"previous\"
1546 links, so should only be used on a detached NODE, never on nodes
1547 that are already part of `buffer-undo-tree'."
1548 (setf (undo-tree-node-next node) (undo-tree-node-next splice)
1549 (undo-tree-node-branch node) (undo-tree-node-branch splice)
1550 (undo-tree-node-previous node) splice
1551 (undo-tree-node-next splice) (list node)
1552 (undo-tree-node-branch splice) 0)
1553 (dolist (n (undo-tree-node-next node))
1554 (setf (undo-tree-node-previous n) node)))
1557 (defun undo-tree-snip-node (node)
1558 "Snip NODE out of undo tree."
1559 (let* ((parent (undo-tree-node-previous node))
1561 ;; if NODE is only child, replace parent's next links with NODE's
1562 (if (= (length (undo-tree-node-next parent)) 0)
1563 (setf (undo-tree-node-next parent) (undo-tree-node-next node)
1564 (undo-tree-node-branch parent) (undo-tree-node-branch node))
1566 (setq position (undo-tree-position node (undo-tree-node-next parent)))
1568 ;; if active branch used do go via NODE, set parent's branch to active
1570 ((= (undo-tree-node-branch parent) position)
1571 (setf (undo-tree-node-branch parent)
1572 (+ position (undo-tree-node-branch node))))
1573 ;; if active branch didn't go via NODE, update parent's branch to point
1574 ;; to same node as before
1575 ((> (undo-tree-node-branch parent) position)
1576 (incf (undo-tree-node-branch parent)
1577 (1- (length (undo-tree-node-next node))))))
1578 ;; replace NODE in parent's next list with NODE's entire next list
1580 (setf (undo-tree-node-next parent)
1581 (nconc (undo-tree-node-next node)
1582 (cdr (undo-tree-node-next parent))))
1583 (setq p (nthcdr (1- position) (undo-tree-node-next parent)))
1584 (setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
1585 ;; update previous links of NODE's children
1586 (dolist (n (undo-tree-node-next node))
1587 (setf (undo-tree-node-previous n) parent))))
1590 (defun undo-tree-mapc (--undo-tree-mapc-function-- undo-tree)
1591 ;; Apply FUNCTION to each node in UNDO-TREE.
1592 (let ((stack (list (undo-tree-root undo-tree)))
1595 (setq node (pop stack))
1596 (funcall --undo-tree-mapc-function-- node)
1597 (setq stack (append (undo-tree-node-next node) stack)))))
1600 (defmacro undo-tree-num-branches ()
1601 "Return number of branches at current undo tree node."
1602 '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
1605 (defun undo-tree-position (node list)
1606 "Find the first occurrence of NODE in LIST.
1607 Return the index of the matching item, or nil of not found.
1608 Comparison is done with `eq'."
1612 (when (eq node (car list)) (throw 'found i))
1614 (setq list (cdr list))))
1618 (defvar *undo-tree-id-counter* 0)
1619 (make-variable-buffer-local '*undo-tree-id-counter*)
1621 (defmacro undo-tree-generate-id ()
1622 ;; Generate a new, unique id (uninterned symbol).
1623 ;; The name is made by appending a number to "undo-tree-id".
1624 ;; (Copied from CL package `gensym'.)
1625 `(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*))))
1626 (make-symbol (format "undo-tree-id%d" num))))
1631 ;;; =====================================================================
1632 ;;; Utility functions for handling `buffer-undo-list' and changesets
1634 (defmacro undo-list-marker-elt-p (elt)
1635 `(markerp (car-safe ,elt)))
1637 (defmacro undo-list-GCd-marker-elt-p (elt)
1638 ;; Return t if ELT is a marker element whose marker has been moved to the
1639 ;; object-pool, so may potentially have been garbage-collected.
1640 ;; Note: Valid marker undo elements should be uniquely identified as cons
1641 ;; cells with a symbol in the car (replacing the marker), and a number in
1642 ;; the cdr. However, to guard against future changes to undo element
1643 ;; formats, we perform an additional redundant check on the symbol name.
1644 `(and (car-safe ,elt)
1645 (symbolp (car ,elt))
1646 (let ((str (symbol-name (car ,elt))))
1647 (and (> (length str) 12)
1648 (string= (substring str 0 12) "undo-tree-id")))
1649 (numberp (cdr-safe ,elt))))
1652 (defun undo-tree-move-GC-elts-to-pool (elt)
1653 ;; Move elements that can be garbage-collected into `buffer-undo-tree'
1654 ;; object pool, substituting a unique id that can be used to retrieve them
1655 ;; later. (Only markers require this treatment currently.)
1656 (when (undo-list-marker-elt-p elt)
1657 (let ((id (undo-tree-generate-id)))
1658 (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
1662 (defun undo-tree-restore-GC-elts-from-pool (elt)
1663 ;; Replace object id's in ELT with corresponding objects from
1664 ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
1665 ;; any object in ELT has been garbage-collected.
1666 (if (undo-list-GCd-marker-elt-p elt)
1667 (when (setcar elt (gethash (car elt)
1668 (undo-tree-object-pool buffer-undo-tree)))
1673 (defun undo-list-clean-GCd-elts (undo-list)
1674 ;; Remove object id's from UNDO-LIST that refer to elements that have been
1675 ;; garbage-collected. UNDO-LIST is modified by side-effect.
1676 (while (undo-list-GCd-marker-elt-p (car undo-list))
1677 (unless (gethash (caar undo-list)
1678 (undo-tree-object-pool buffer-undo-tree))
1679 (setq undo-list (cdr undo-list))))
1680 (let ((p undo-list))
1682 (when (and (undo-list-GCd-marker-elt-p (cadr p))
1683 (null (gethash (car (cadr p))
1684 (undo-tree-object-pool buffer-undo-tree))))
1685 (setcdr p (cddr p)))
1690 (defun undo-list-pop-changeset (&optional discard-pos)
1691 ;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
1692 ;; any position entries from changeset.
1694 ;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
1695 ;; at head of undo list
1696 (while (or (null (car buffer-undo-list))
1697 (and discard-pos (integerp (car buffer-undo-list))))
1698 (setq buffer-undo-list (cdr buffer-undo-list)))
1699 ;; pop elements up to next undo boundary, discarding position entries if
1700 ;; DISCARD-POS is non-nil
1701 (if (eq (car buffer-undo-list) 'undo-tree-canary)
1702 (push nil buffer-undo-list)
1703 (let* ((changeset (list (pop buffer-undo-list)))
1706 (undo-tree-move-GC-elts-to-pool (car p))
1707 (while (and discard-pos (integerp (car buffer-undo-list)))
1708 (setq buffer-undo-list (cdr buffer-undo-list)))
1709 (and (car buffer-undo-list)
1710 (not (eq (car buffer-undo-list) 'undo-tree-canary))))
1711 (setcdr p (list (pop buffer-undo-list)))
1716 (defun undo-tree-copy-list (undo-list)
1717 ;; Return a deep copy of first changeset in `undo-list'. Object id's are
1718 ;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
1721 ;; if first element contains an object id, replace it with object from
1722 ;; pool, discarding element entirely if it's been GC'd
1725 (undo-tree-restore-GC-elts-from-pool (pop undo-list))))
1726 (setq copy (list copy)
1728 ;; copy remaining elements, replacing object id's with objects from
1729 ;; pool, or discarding them entirely if they've been GC'd
1731 (when (setcdr p (undo-tree-restore-GC-elts-from-pool
1732 (undo-copy-list-1 (pop undo-list))))
1733 (setcdr p (list (cdr p)))
1739 (defun undo-list-transfer-to-tree ()
1740 ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
1742 ;; if `buffer-undo-tree' is empty, create initial undo-tree
1743 (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
1744 ;; make sure there's a canary at end of `buffer-undo-list'
1745 (when (null buffer-undo-list)
1746 (setq buffer-undo-list '(nil undo-tree-canary)))
1748 (unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1749 (eq (car buffer-undo-list) 'undo-tree-canary))
1750 ;; create new node from first changeset in `buffer-undo-list', save old
1751 ;; `buffer-undo-tree' current node, and make new node the current node
1752 (let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
1753 (splice (undo-tree-current buffer-undo-tree))
1754 (size (undo-list-byte-size (undo-tree-node-undo node))))
1755 (setf (undo-tree-current buffer-undo-tree) node)
1756 ;; grow tree fragment backwards using `buffer-undo-list' changesets
1757 (while (and buffer-undo-list
1758 (not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
1760 (undo-tree-grow-backwards node (undo-list-pop-changeset)))
1761 (incf size (undo-list-byte-size (undo-tree-node-undo node))))
1762 ;; if no undo history has been discarded from `buffer-undo-list' since
1763 ;; last transfer, splice new tree fragment onto end of old
1764 ;; `buffer-undo-tree' current node
1765 (if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1766 (eq (car buffer-undo-list) 'undo-tree-canary))
1768 (setf (undo-tree-node-previous node) splice)
1769 (push node (undo-tree-node-next splice))
1770 (setf (undo-tree-node-branch splice) 0)
1771 (incf (undo-tree-size buffer-undo-tree) size))
1772 ;; if undo history has been discarded, replace entire
1773 ;; `buffer-undo-tree' with new tree fragment
1774 (setq node (undo-tree-grow-backwards node nil))
1775 (setf (undo-tree-root buffer-undo-tree) node)
1776 (setq buffer-undo-list '(nil undo-tree-canary))
1777 (setf (undo-tree-size buffer-undo-tree) size)
1778 (setq buffer-undo-list '(nil undo-tree-canary))))
1779 ;; discard undo history if necessary
1780 (undo-tree-discard-history)))
1783 (defun undo-list-byte-size (undo-list)
1784 ;; Return size (in bytes) of UNDO-LIST
1785 (let ((size 0) (p undo-list))
1787 (incf size 8) ; cons cells use up 8 bytes
1788 (when (and (consp (car p)) (stringp (caar p)))
1789 (incf size (string-bytes (caar p))))
1795 (defun undo-list-rebuild-from-tree ()
1796 "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
1797 (unless (eq buffer-undo-list t)
1798 (undo-list-transfer-to-tree)
1799 (setq buffer-undo-list nil)
1800 (when buffer-undo-tree
1801 (let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
1802 (push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
1804 (time-less-p (undo-tree-node-timestamp a)
1805 (undo-tree-node-timestamp b))))
1807 ;; Traverse tree in depth-and-oldest-first order, but add undo records
1808 ;; on the way down, and redo records on the way up.
1809 (while (or (car stack)
1810 (not (eq (car (nth 1 stack))
1811 (undo-tree-current buffer-undo-tree))))
1814 (setq buffer-undo-list
1815 (append (undo-tree-node-undo (caar stack))
1818 (push (sort (mapcar 'identity
1819 (undo-tree-node-next (caar stack)))
1821 (time-less-p (undo-tree-node-timestamp a)
1822 (undo-tree-node-timestamp b))))
1825 (setq buffer-undo-list
1826 (append (undo-tree-node-redo (caar stack))
1829 (pop (car stack))))))))
1834 ;;; =====================================================================
1835 ;;; History discarding functions
1837 (defun undo-tree-oldest-leaf (node)
1838 ;; Return oldest leaf node below NODE.
1839 (while (undo-tree-node-next node)
1841 (car (sort (mapcar 'identity (undo-tree-node-next node))
1843 (time-less-p (undo-tree-node-timestamp a)
1844 (undo-tree-node-timestamp b)))))))
1848 (defun undo-tree-discard-node (node)
1849 ;; Discard NODE from `buffer-undo-tree', and return next in line for
1852 ;; don't discard current node
1853 (unless (eq node (undo-tree-current buffer-undo-tree))
1855 ;; discarding root node...
1856 (if (eq node (undo-tree-root buffer-undo-tree))
1858 ;; should always discard branches before root
1859 ((> (length (undo-tree-node-next node)) 1)
1860 (error "Trying to discard undo-tree root which still\
1861 has multiple branches"))
1862 ;; don't discard root if current node is only child
1863 ((eq (car (undo-tree-node-next node))
1864 (undo-tree-current buffer-undo-tree))
1868 ;; clear any register referring to root
1869 (let ((r (undo-tree-node-register node)))
1870 (when (and r (eq (get-register r) node))
1871 (set-register r nil)))
1872 ;; make child of root into new root
1873 (setq node (setf (undo-tree-root buffer-undo-tree)
1874 (car (undo-tree-node-next node))))
1875 ;; update undo-tree size
1876 (decf (undo-tree-size buffer-undo-tree)
1877 (+ (undo-list-byte-size (undo-tree-node-undo node))
1878 (undo-list-byte-size (undo-tree-node-redo node))))
1879 ;; discard new root's undo data
1880 (setf (undo-tree-node-undo node) nil
1881 (undo-tree-node-redo node) nil)
1882 ;; if new root has branches, or new root is current node, next node
1883 ;; to discard is oldest leaf, otherwise it's new root
1884 (if (or (> (length (undo-tree-node-next node)) 1)
1885 (eq (car (undo-tree-node-next node))
1886 (undo-tree-current buffer-undo-tree)))
1887 (undo-tree-oldest-leaf node)
1890 ;; discarding leaf node...
1891 (let* ((parent (undo-tree-node-previous node))
1892 (current (nth (undo-tree-node-branch parent)
1893 (undo-tree-node-next parent))))
1894 ;; clear any register referring to the discarded node
1895 (let ((r (undo-tree-node-register node)))
1896 (when (and r (eq (get-register r) node))
1897 (set-register r nil)))
1898 ;; update undo-tree size
1899 (decf (undo-tree-size buffer-undo-tree)
1900 (+ (undo-list-byte-size (undo-tree-node-undo node))
1901 (undo-list-byte-size (undo-tree-node-redo node))))
1902 (setf (undo-tree-node-next parent)
1903 (delq node (undo-tree-node-next parent))
1904 (undo-tree-node-branch parent)
1905 (undo-tree-position current (undo-tree-node-next parent)))
1906 ;; if parent has branches, or parent is current node, next node to
1907 ;; discard is oldest leaf, otherwise it's parent
1908 (if (or (eq parent (undo-tree-current buffer-undo-tree))
1909 (and (undo-tree-node-next parent)
1910 (or (not (eq parent (undo-tree-root buffer-undo-tree)))
1911 (> (length (undo-tree-node-next parent)) 1))))
1912 (undo-tree-oldest-leaf parent)
1917 (defun undo-tree-discard-history ()
1918 "Discard undo history until we're within memory usage limits
1919 set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
1921 (when (> (undo-tree-size buffer-undo-tree) undo-limit)
1922 ;; if there are no branches off root, first node to discard is root;
1923 ;; otherwise it's leaf node at botom of oldest branch
1924 (let ((node (if (> (length (undo-tree-node-next
1925 (undo-tree-root buffer-undo-tree))) 1)
1926 (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
1927 (undo-tree-root buffer-undo-tree))))
1929 ;; discard nodes until memory use is within `undo-strong-limit'
1931 (> (undo-tree-size buffer-undo-tree) undo-strong-limit))
1932 (setq node (undo-tree-discard-node node)))
1934 ;; discard nodes until next node to discard would bring memory use
1935 ;; within `undo-limit'
1937 ;; check first if last discard has brought us within
1938 ;; `undo-limit', in case we can avoid more expensive
1939 ;; `undo-strong-limit' calculation
1940 ;; Note: this assumes undo-strong-limit > undo-limit;
1941 ;; if not, effectively undo-strong-limit = undo-limit
1942 (> (undo-tree-size buffer-undo-tree) undo-limit)
1943 (> (- (undo-tree-size buffer-undo-tree)
1944 ;; if next node to discard is root, the memory we
1945 ;; free-up comes from discarding changesets from its
1947 (if (eq node (undo-tree-root buffer-undo-tree))
1948 (+ (undo-list-byte-size
1949 (undo-tree-node-undo
1950 (car (undo-tree-node-next node))))
1951 (undo-list-byte-size
1952 (undo-tree-node-redo
1953 (car (undo-tree-node-next node)))))
1954 ;; ...otherwise, it comes from discarding changesets
1955 ;; from along with the node itself
1956 (+ (undo-list-byte-size (undo-tree-node-undo node))
1957 (undo-list-byte-size (undo-tree-node-redo node)))
1960 (setq node (undo-tree-discard-node node)))
1962 ;; if we're still over the `undo-outer-limit', discard entire history
1963 (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
1964 ;; query first if `undo-ask-before-discard' is set
1965 (if undo-ask-before-discard
1968 "Buffer `%s' undo info is %d bytes long; discard it? "
1969 (buffer-name) (undo-tree-size buffer-undo-tree)))
1970 (setq buffer-undo-tree nil))
1971 ;; otherwise, discard and display warning
1973 '(undo discard-info)
1975 (format "Buffer `%s' undo info was %d bytes long.\n"
1976 (buffer-name) (undo-tree-size buffer-undo-tree))
1977 "The undo info was discarded because it exceeded\
1980 This is normal if you executed a command that made a huge change
1981 to the buffer. In that case, to prevent similar problems in the
1982 future, set `undo-outer-limit' to a value that is large enough to
1983 cover the maximum size of normal changes you expect a single
1984 command to make, but not so large that it might exceed the
1985 maximum memory allotted to Emacs.
1987 If you did not execute any such command, the situation is
1988 probably due to a bug and you should report it.
1990 You can disable the popping up of this buffer by adding the entry
1991 \(undo discard-info) to the user option `warning-suppress-types',
1992 which is defined in the `warnings' library.\n")
1994 (setq buffer-undo-tree nil)))
2000 ;;; =====================================================================
2001 ;;; Visualizer-related functions
2003 (defun undo-tree-compute-widths (undo-tree)
2004 "Recursively compute widths for all UNDO-TREE's nodes."
2005 (let ((stack (list (undo-tree-root undo-tree)))
2008 ;; try to compute widths for node at top of stack
2009 (if (undo-tree-node-p
2010 (setq res (undo-tree-node-compute-widths (car stack))))
2011 ;; if computation fails, it returns a node whose widths still need
2012 ;; computing, which we push onto the stack
2014 ;; otherwise, store widths and remove it from stack
2015 (setf (undo-tree-node-lwidth (car stack)) (aref res 0)
2016 (undo-tree-node-cwidth (car stack)) (aref res 1)
2017 (undo-tree-node-rwidth (car stack)) (aref res 2))
2021 (defun undo-tree-node-compute-widths (node)
2022 ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
2023 ;; (in a vector) if successful. Otherwise, returns a node whose widths need
2024 ;; calculating before NODE's can be calculated.
2025 (let ((num-children (length (undo-tree-node-next node)))
2026 (lwidth 0) (cwidth 0) (rwidth 0)
2030 ;; leaf nodes have 0 width
2033 (undo-tree-node-lwidth node) 0
2034 (undo-tree-node-cwidth node) 1
2035 (undo-tree-node-rwidth node) 0))
2037 ;; odd number of children
2038 ((= (mod num-children 2) 1)
2039 (setq p (undo-tree-node-next node))
2040 ;; compute left-width
2041 (dotimes (i (/ num-children 2))
2042 (if (undo-tree-node-lwidth (car p))
2043 (incf lwidth (+ (undo-tree-node-lwidth (car p))
2044 (undo-tree-node-cwidth (car p))
2045 (undo-tree-node-rwidth (car p))))
2046 ;; if child's widths haven't been computed, return that child
2047 (throw 'need-widths (car p)))
2049 (if (undo-tree-node-lwidth (car p))
2050 (incf lwidth (undo-tree-node-lwidth (car p)))
2051 (throw 'need-widths (car p)))
2052 ;; centre-width is inherited from middle child
2053 (setf cwidth (undo-tree-node-cwidth (car p)))
2054 ;; compute right-width
2055 (incf rwidth (undo-tree-node-rwidth (car p)))
2057 (dotimes (i (/ num-children 2))
2058 (if (undo-tree-node-lwidth (car p))
2059 (incf rwidth (+ (undo-tree-node-lwidth (car p))
2060 (undo-tree-node-cwidth (car p))
2061 (undo-tree-node-rwidth (car p))))
2062 (throw 'need-widths (car p)))
2065 ;; even number of children
2067 (setq p (undo-tree-node-next node))
2068 ;; compute left-width
2069 (dotimes (i (/ num-children 2))
2070 (if (undo-tree-node-lwidth (car p))
2071 (incf lwidth (+ (undo-tree-node-lwidth (car p))
2072 (undo-tree-node-cwidth (car p))
2073 (undo-tree-node-rwidth (car p))))
2074 (throw 'need-widths (car p)))
2076 ;; centre-width is 0 when number of children is even
2078 ;; compute right-width
2079 (dotimes (i (/ num-children 2))
2080 (if (undo-tree-node-lwidth (car p))
2081 (incf rwidth (+ (undo-tree-node-lwidth (car p))
2082 (undo-tree-node-cwidth (car p))
2083 (undo-tree-node-rwidth (car p))))
2084 (throw 'need-widths (car p)))
2087 ;; return left-, centre- and right-widths
2088 (vector lwidth cwidth rwidth))))
2091 (defun undo-tree-clear-visualizer-data (undo-tree)
2092 ;; Clear visualizer data from UNDO-TREE.
2094 (lambda (node) (undo-tree-node-clear-visualizer-data node))
2100 ;;; =====================================================================
2101 ;;; Undo-in-region functions
2103 (defun undo-tree-pull-undo-in-region-branch (start end)
2104 ;; Pull out entries from undo changesets to create a new undo-in-region
2105 ;; branch, which undoes changeset entries lying between START and END first,
2106 ;; followed by remaining entries from the changesets, before rejoining the
2107 ;; existing undo tree history. Repeated calls will, if appropriate, extend
2108 ;; the current undo-in-region branch rather than creating a new one.
2110 ;; if we're just reverting the last redo-in-region, we don't need to
2111 ;; manipulate the undo tree at all
2112 (if (undo-tree-reverting-redo-in-region-p start end)
2113 t ; return t to indicate success
2115 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2116 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2117 ;; don't have to treat the first element differently, we prepend a dummy
2118 ;; leading nil to the lists, and have the pointers point to that
2120 ;; Note: using '(nil) instead of (list nil) in the `let*' results in
2121 ;; bizarre errors when the code is byte-compiled, where parts of the
2122 ;; lists appear to survive across different calls to this function.
2123 ;; An obscure byte-compiler bug, perhaps?
2124 (let* ((region-changeset (list nil))
2125 (r region-changeset)
2126 (delta-list (list nil))
2128 (node (undo-tree-current buffer-undo-tree))
2129 (repeated-undo-in-region
2130 (undo-tree-repeated-undo-in-region-p start end))
2131 undo-adjusted-markers ; `undo-elt-in-region' expects this
2132 fragment splice original-fragment original-splice original-current
2133 got-visible-elt undo-list elt)
2135 ;; --- initialisation ---
2137 ;; if this is a repeated undo in the same region, start pulling changes
2138 ;; from NODE at which undo-in-region branch iss attached, and detatch
2139 ;; the branch, using it as initial FRAGMENT of branch being constructed
2140 (repeated-undo-in-region
2141 (setq original-current node
2142 fragment (car (undo-tree-node-next node))
2144 ;; undo up to node at which undo-in-region branch is attached
2145 ;; (recognizable as first node with more than one branch)
2146 (let ((mark-active nil))
2147 (while (= (length (undo-tree-node-next node)) 1)
2150 node (undo-tree-current buffer-undo-tree))))
2151 (when (eq splice node) (setq splice nil))
2152 ;; detatch undo-in-region branch
2153 (setf (undo-tree-node-next node)
2154 (delq fragment (undo-tree-node-next node))
2155 (undo-tree-node-previous fragment) nil
2156 original-fragment fragment
2157 original-splice node))
2159 ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
2160 ;; nodes below the current one in the active branch
2161 ((undo-tree-node-next node)
2162 (setq fragment (undo-tree-make-node nil nil)
2164 (while (setq node (nth (undo-tree-node-branch node)
2165 (undo-tree-node-next node)))
2166 (push (undo-tree-make-node
2168 (undo-copy-list (undo-tree-node-undo node))
2169 (undo-copy-list (undo-tree-node-redo node)))
2170 (undo-tree-node-next splice))
2171 (setq splice (car (undo-tree-node-next splice))))
2172 (setq fragment (car (undo-tree-node-next fragment))
2174 node (undo-tree-current buffer-undo-tree))))
2177 ;; --- pull undo-in-region elements into branch ---
2178 ;; work backwards up tree, pulling out undo elements within region until
2179 ;; we've got one that undoes a visible change (insertion or deletion)
2181 (while (and (not got-visible-elt) node (undo-tree-node-undo node))
2182 ;; we cons a dummy nil element on the front of the changeset so that
2183 ;; we can conveniently remove the first (real) element from the
2184 ;; changeset if we need to; the leading nil is removed once we're
2185 ;; done with this changeset
2186 (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
2187 elt (cadr undo-list))
2190 (setq fragment (undo-tree-grow-backwards fragment undo-list))
2191 (unless splice (setq splice fragment)))
2192 (setq fragment (undo-tree-make-node nil undo-list))
2193 (setq splice fragment))
2197 ;; keep elements within region
2198 ((undo-elt-in-region elt start end)
2199 ;; set flag if kept element is visible (insertion or deletion)
2200 (when (and (consp elt)
2201 (or (stringp (car elt)) (integerp (car elt))))
2202 (setq got-visible-elt t))
2203 ;; adjust buffer positions in elements previously undone before
2204 ;; kept element, as kept element will now be undone first
2205 (undo-tree-adjust-elements-to-elt splice elt)
2206 ;; move kept element to undo-in-region changeset, adjusting its
2207 ;; buffer position as it will now be undone first
2208 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
2210 (setcdr undo-list (cddr undo-list)))
2212 ;; discard "was unmodified" elements
2213 ;; FIXME: deal properly with these
2214 ((and (consp elt) (eq (car elt) t))
2215 (setcdr undo-list (cddr undo-list)))
2217 ;; if element crosses region, we can't pull any more elements
2218 ((undo-elt-crosses-region elt start end)
2219 ;; if we've found a visible element, it must be earlier in
2220 ;; current node's changeset; stop pulling elements (null
2221 ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
2223 (setq undo-list nil)
2224 ;; if we haven't found a visible element yet, pulling
2225 ;; undo-in-region branch has failed
2226 (setq region-changeset nil)
2229 ;; if rejecting element, add its delta (if any) to the list
2231 (let ((delta (undo-delta elt)))
2232 (when (/= 0 (cdr delta))
2233 (setcdr d (list delta))
2235 (setq undo-list (cdr undo-list))))
2237 ;; process next element of current changeset
2238 (setq elt (cadr undo-list)))
2240 ;; if there are remaining elements in changeset, remove dummy nil
2242 (if (cadr (undo-tree-node-undo fragment))
2243 (pop (undo-tree-node-undo fragment))
2244 ;; otherwise, if we've kept all elements in changeset, discard
2246 (when (eq splice fragment) (setq splice nil))
2247 (setq fragment (car (undo-tree-node-next fragment))))
2248 ;; process changeset from next node up the tree
2249 (setq node (undo-tree-node-previous node))))
2251 ;; pop dummy nil from front of `region-changeset'
2252 (pop region-changeset)
2255 ;; --- integrate branch into tree ---
2256 ;; if no undo-in-region elements were found, restore undo tree
2257 (if (null region-changeset)
2258 (when original-current
2259 (push original-fragment (undo-tree-node-next original-splice))
2260 (setf (undo-tree-node-branch original-splice) 0
2261 (undo-tree-node-previous original-fragment) original-splice)
2262 (let ((mark-active nil))
2263 (while (not (eq (undo-tree-current buffer-undo-tree)
2265 (undo-tree-redo-1)))
2266 nil) ; return nil to indicate failure
2269 ;; need to undo up to node where new branch will be attached, to
2270 ;; ensure redo entries are populated, and then redo back to where we
2272 (let ((mark-active nil)
2273 (current (undo-tree-current buffer-undo-tree)))
2274 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2276 (while (not (eq (undo-tree-current buffer-undo-tree) current))
2277 (undo-tree-redo-1)))
2280 ;; if there's no remaining fragment, just create undo-in-region node
2281 ;; and attach it to parent of last node from which elements were
2284 (setq fragment (undo-tree-make-node node region-changeset))
2285 (push fragment (undo-tree-node-next node))
2286 (setf (undo-tree-node-branch node) 0)
2287 ;; set current node to undo-in-region node
2288 (setf (undo-tree-current buffer-undo-tree) fragment))
2290 ;; if no splice point has been set, add undo-in-region node to top of
2291 ;; fragment and attach it to parent of last node from which elements
2294 (setq fragment (undo-tree-grow-backwards fragment region-changeset))
2295 (push fragment (undo-tree-node-next node))
2296 (setf (undo-tree-node-branch node) 0
2297 (undo-tree-node-previous fragment) node)
2298 ;; set current node to undo-in-region node
2299 (setf (undo-tree-current buffer-undo-tree) fragment))
2301 ;; if fragment contains nodes, attach fragment to parent of last node
2302 ;; from which elements were pulled, and splice in undo-in-region node
2304 (setf (undo-tree-node-previous fragment) node)
2305 (push fragment (undo-tree-node-next node))
2306 (setf (undo-tree-node-branch node) 0)
2307 ;; if this is a repeated undo-in-region, then we've left the current
2308 ;; node at the original splice-point; we need to set the current
2309 ;; node to the equivalent node on the undo-in-region branch and redo
2310 ;; back to where we started
2311 (when repeated-undo-in-region
2312 (setf (undo-tree-current buffer-undo-tree)
2313 (undo-tree-node-previous original-fragment))
2314 (let ((mark-active nil))
2315 (while (not (eq (undo-tree-current buffer-undo-tree) splice))
2316 (undo-tree-redo-1 nil 'preserve-undo))))
2317 ;; splice new undo-in-region node into fragment
2318 (setq node (undo-tree-make-node nil region-changeset))
2319 (undo-tree-splice-node node splice)
2320 ;; set current node to undo-in-region node
2321 (setf (undo-tree-current buffer-undo-tree) node)))
2323 ;; update undo-tree size
2324 (setq node (undo-tree-node-previous fragment))
2326 (and (setq node (car (undo-tree-node-next node)))
2327 (not (eq node original-fragment))
2328 (incf (undo-tree-size buffer-undo-tree)
2329 (undo-list-byte-size (undo-tree-node-undo node)))
2330 (when (undo-tree-node-redo node)
2331 (incf (undo-tree-size buffer-undo-tree)
2332 (undo-list-byte-size (undo-tree-node-redo node))))
2334 t) ; indicate undo-in-region branch was successfully pulled
2339 (defun undo-tree-pull-redo-in-region-branch (start end)
2340 ;; Pull out entries from redo changesets to create a new redo-in-region
2341 ;; branch, which redoes changeset entries lying between START and END first,
2342 ;; followed by remaining entries from the changesets. Repeated calls will,
2343 ;; if appropriate, extend the current redo-in-region branch rather than
2344 ;; creating a new one.
2346 ;; if we're just reverting the last undo-in-region, we don't need to
2347 ;; manipulate the undo tree at all
2348 (if (undo-tree-reverting-undo-in-region-p start end)
2349 t ; return t to indicate success
2351 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2352 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2353 ;; don't have to treat the first element differently, we prepend a dummy
2354 ;; leading nil to the lists, and have the pointers point to that
2356 ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
2357 ;; errors when the code is byte-compiled, where parts of the lists
2358 ;; appear to survive across different calls to this function. An
2359 ;; obscure byte-compiler bug, perhaps?
2360 (let* ((region-changeset (list nil))
2361 (r region-changeset)
2362 (delta-list (list nil))
2364 (node (undo-tree-current buffer-undo-tree))
2365 (repeated-redo-in-region
2366 (undo-tree-repeated-redo-in-region-p start end))
2367 undo-adjusted-markers ; `undo-elt-in-region' expects this
2368 fragment splice got-visible-elt redo-list elt)
2370 ;; --- inisitalisation ---
2372 ;; if this is a repeated redo-in-region, detach fragment below current
2374 (repeated-redo-in-region
2375 (when (setq fragment (car (undo-tree-node-next node)))
2376 (setf (undo-tree-node-previous fragment) nil
2377 (undo-tree-node-next node)
2378 (delq fragment (undo-tree-node-next node)))))
2379 ;; if this is a new redo-in-region, initial fragment is a copy of all
2380 ;; nodes below the current one in the active branch
2381 ((undo-tree-node-next node)
2382 (setq fragment (undo-tree-make-node nil nil)
2384 (while (setq node (nth (undo-tree-node-branch node)
2385 (undo-tree-node-next node)))
2386 (push (undo-tree-make-node
2388 (undo-copy-list (undo-tree-node-redo node)))
2389 (undo-tree-node-next splice))
2390 (setq splice (car (undo-tree-node-next splice))))
2391 (setq fragment (car (undo-tree-node-next fragment)))))
2394 ;; --- pull redo-in-region elements into branch ---
2395 ;; work down fragment, pulling out redo elements within region until
2396 ;; we've got one that redoes a visible change (insertion or deletion)
2397 (setq node fragment)
2399 (while (and (not got-visible-elt) node (undo-tree-node-redo node))
2400 ;; we cons a dummy nil element on the front of the changeset so that
2401 ;; we can conveniently remove the first (real) element from the
2402 ;; changeset if we need to; the leading nil is removed once we're
2403 ;; done with this changeset
2404 (setq redo-list (push nil (undo-tree-node-redo node))
2405 elt (cadr redo-list))
2408 ;; keep elements within region
2409 ((undo-elt-in-region elt start end)
2410 ;; set flag if kept element is visible (insertion or deletion)
2411 (when (and (consp elt)
2412 (or (stringp (car elt)) (integerp (car elt))))
2413 (setq got-visible-elt t))
2414 ;; adjust buffer positions in elements previously redone before
2415 ;; kept element, as kept element will now be redone first
2416 (undo-tree-adjust-elements-to-elt fragment elt t)
2417 ;; move kept element to redo-in-region changeset, adjusting its
2418 ;; buffer position as it will now be redone first
2419 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
2421 (setcdr redo-list (cddr redo-list)))
2423 ;; discard "was unmodified" elements
2424 ;; FIXME: deal properly with these
2425 ((and (consp elt) (eq (car elt) t))
2426 (setcdr redo-list (cddr redo-list)))
2428 ;; if element crosses region, we can't pull any more elements
2429 ((undo-elt-crosses-region elt start end)
2430 ;; if we've found a visible element, it must be earlier in
2431 ;; current node's changeset; stop pulling elements (null
2432 ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
2434 (setq redo-list nil)
2435 ;; if we haven't found a visible element yet, pulling
2436 ;; redo-in-region branch has failed
2437 (setq region-changeset nil)
2440 ;; if rejecting element, add its delta (if any) to the list
2442 (let ((delta (undo-delta elt)))
2443 (when (/= 0 (cdr delta))
2444 (setcdr d (list delta))
2446 (setq redo-list (cdr redo-list))))
2448 ;; process next element of current changeset
2449 (setq elt (cadr redo-list)))
2451 ;; if there are remaining elements in changeset, remove dummy nil
2453 (if (cadr (undo-tree-node-redo node))
2454 (pop (undo-tree-node-undo node))
2455 ;; otherwise, if we've kept all elements in changeset, discard
2457 (if (eq fragment node)
2458 (setq fragment (car (undo-tree-node-next fragment)))
2459 (undo-tree-snip-node node)))
2460 ;; process changeset from next node in fragment
2461 (setq node (car (undo-tree-node-next node)))))
2463 ;; pop dummy nil from front of `region-changeset'
2464 (pop region-changeset)
2467 ;; --- integrate branch into tree ---
2468 (setq node (undo-tree-current buffer-undo-tree))
2469 ;; if no redo-in-region elements were found, restore undo tree
2470 (if (null (car region-changeset))
2471 (when (and repeated-redo-in-region fragment)
2472 (push fragment (undo-tree-node-next node))
2473 (setf (undo-tree-node-branch node) 0
2474 (undo-tree-node-previous fragment) node)
2475 nil) ; return nil to indicate failure
2477 ;; otherwise, add redo-in-region node to top of fragment, and attach
2478 ;; it below current node
2481 (undo-tree-grow-backwards fragment nil region-changeset)
2482 (undo-tree-make-node nil nil region-changeset)))
2483 (push fragment (undo-tree-node-next node))
2484 (setf (undo-tree-node-branch node) 0
2485 (undo-tree-node-previous fragment) node)
2486 ;; update undo-tree size
2487 (unless repeated-redo-in-region
2488 (setq node fragment)
2490 (and (setq node (car (undo-tree-node-next node)))
2491 (incf (undo-tree-size buffer-undo-tree)
2492 (undo-list-byte-size
2493 (undo-tree-node-redo node)))))))
2494 (incf (undo-tree-size buffer-undo-tree)
2495 (undo-list-byte-size (undo-tree-node-redo fragment)))
2496 t) ; indicate undo-in-region branch was successfully pulled
2501 (defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
2502 "Adjust buffer positions of undo elements, starting at NODE's
2503 and going up the tree (or down the active branch if BELOW is
2504 non-nil) and through the nodes' undo elements until we reach
2505 UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
2506 of either NODE itself or some node above it in the tree."
2507 (let ((delta (list (undo-delta undo-elt)))
2508 (undo-list (undo-tree-node-undo node)))
2509 ;; adjust elements until we reach UNDO-ELT
2510 (while (and (car undo-list)
2511 (not (eq (car undo-list) undo-elt)))
2513 (undo-tree-apply-deltas (car undo-list) delta -1))
2514 ;; move to next undo element in list, or to next node if we've run out
2516 (unless (car (setq undo-list (cdr undo-list)))
2518 (setq node (nth (undo-tree-node-branch node)
2519 (undo-tree-node-next node)))
2520 (setq node (undo-tree-node-previous node)))
2521 (setq undo-list (undo-tree-node-undo node))))))
2525 (defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
2526 ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
2527 ;; (only useful value for SGN is -1).
2528 (let (position offset)
2529 (dolist (delta deltas)
2530 (setq position (car delta)
2531 offset (* (cdr delta) (or sgn 1)))
2534 ((integerp undo-elt)
2535 (when (>= undo-elt position)
2536 (setq undo-elt (- undo-elt offset))))
2537 ;; nil (or any other atom)
2539 ;; (TEXT . POSITION)
2540 ((stringp (car undo-elt))
2541 (let ((text-pos (abs (cdr undo-elt)))
2542 (point-at-end (< (cdr undo-elt) 0)))
2543 (if (>= text-pos position)
2544 (setcdr undo-elt (* (if point-at-end -1 1)
2545 (- text-pos offset))))))
2547 ((integerp (car undo-elt))
2548 (when (>= (car undo-elt) position)
2549 (setcar undo-elt (- (car undo-elt) offset))
2550 (setcdr undo-elt (- (cdr undo-elt) offset))))
2551 ;; (nil PROPERTY VALUE BEG . END)
2552 ((null (car undo-elt))
2553 (let ((tail (nthcdr 3 undo-elt)))
2554 (when (>= (car tail) position)
2555 (setcar tail (- (car tail) offset))
2556 (setcdr tail (- (cdr tail) offset)))))
2562 (defun undo-tree-repeated-undo-in-region-p (start end)
2563 ;; Return non-nil if undo-in-region between START and END is a repeated
2565 (let ((node (undo-tree-current buffer-undo-tree)))
2567 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
2568 (eq (undo-tree-node-undo-beginning node) start)
2569 (eq (undo-tree-node-undo-end node) end))))
2572 (defun undo-tree-repeated-redo-in-region-p (start end)
2573 ;; Return non-nil if undo-in-region between START and END is a repeated
2575 (let ((node (undo-tree-current buffer-undo-tree)))
2576 (and (eq (undo-tree-node-redo-beginning node) start)
2577 (eq (undo-tree-node-redo-end node) end))))
2580 ;; Return non-nil if undo-in-region between START and END is simply
2581 ;; reverting the last redo-in-region
2582 (defalias 'undo-tree-reverting-undo-in-region-p
2583 'undo-tree-repeated-undo-in-region-p)
2586 ;; Return non-nil if redo-in-region between START and END is simply
2587 ;; reverting the last undo-in-region
2588 (defalias 'undo-tree-reverting-redo-in-region-p
2589 'undo-tree-repeated-redo-in-region-p)
2594 ;;; =====================================================================
2595 ;;; Undo-tree commands
2598 (define-minor-mode undo-tree-mode
2599 "Toggle undo-tree mode.
2600 With no argument, this command toggles the mode.
2601 A positive prefix argument turns the mode on.
2602 A negative prefix argument turns it off.
2604 Undo-tree-mode replaces Emacs' standard undo feature with a more
2605 powerful yet easier to use version, that treats the undo history
2606 as what it is: a tree.
2608 The following keys are available in `undo-tree-mode':
2612 Within the undo-tree visualizer, the following keys are available:
2614 \\{undo-tree-visualizer-map}"
2617 undo-tree-mode-lighter ; lighter
2618 undo-tree-map ; keymap
2621 ;; if enabling `undo-tree-mode', set up history-saving hooks if
2622 ;; `undo-tree-auto-save-history' is enabled
2624 (when undo-tree-auto-save-history
2625 (add-hook 'write-file-functions 'undo-tree-save-history-hook nil t)
2626 (add-hook 'find-file-hook 'undo-tree-load-history-hook nil t)))
2627 ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
2628 ;; Emacs undo can work
2630 (undo-list-rebuild-from-tree)
2631 (setq buffer-undo-tree nil)
2632 (when undo-tree-auto-save-history
2633 (remove-hook 'write-file-functions 'undo-tree-save-history-hook t)
2634 (remove-hook 'find-file-hook 'undo-tree-load-history-hook t)))))
2637 (defun turn-on-undo-tree-mode (&optional print-message)
2638 "Enable `undo-tree-mode' in the current buffer, when appropriate.
2639 Some major modes implement their own undo system, which should
2640 not normally be overridden by `undo-tree-mode'. This command does
2641 not enable `undo-tree-mode' in such buffers. If you want to force
2642 `undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
2645 The heuristic used to detect major modes in which
2646 `undo-tree-mode' should not be used is to check whether either
2647 the `undo' command has been remapped, or the default undo
2648 keybindings (C-/ and C-_) have been overridden somewhere other
2649 than in the global map. In addition, `undo-tree-mode' will not be
2650 enabled if the buffer's `major-mode' appears in
2651 `undo-tree-incompatible-major-modes'."
2653 (if (or (key-binding [remap undo])
2654 (undo-tree-overridden-undo-bindings-p)
2655 (memq major-mode undo-tree-incompatible-major-modes))
2657 (message "Buffer does not support undo-tree-mode;\
2658 undo-tree-mode NOT enabled"))
2659 (undo-tree-mode 1)))
2662 (defun undo-tree-overridden-undo-bindings-p ()
2663 "Returns t if default undo bindings are overridden, nil otherwise.
2664 Checks if either of the default undo key bindings (\"C-/\" or
2665 \"C-_\") are overridden in the current buffer by any keymap other
2666 than the global one. (So global redefinitions of the default undo
2667 key bindings do not count.)"
2668 (let ((binding1 (lookup-key (current-global-map) [?\C-/]))
2669 (binding2 (lookup-key (current-global-map) [?\C-_])))
2670 (global-set-key [?\C-/] 'undo)
2671 (global-set-key [?\C-_] 'undo)
2673 (or (and (key-binding [?\C-/])
2674 (not (eq (key-binding [?\C-/]) 'undo)))
2675 (and (key-binding [?\C-_])
2676 (not (eq (key-binding [?\C-_]) 'undo))))
2677 (global-set-key [?\C-/] binding1)
2678 (global-set-key [?\C-_] binding2))))
2682 (define-globalized-minor-mode global-undo-tree-mode
2683 undo-tree-mode turn-on-undo-tree-mode)
2687 (defun undo-tree-undo (&optional arg)
2689 Repeat this command to undo more changes.
2690 A numeric ARG serves as a repeat count.
2692 In Transient Mark mode when the mark is active, only undo changes
2693 within the current region. Similarly, when not in Transient Mark
2694 mode, just \\[universal-argument] as an argument limits undo to
2695 changes within the current region."
2697 ;; throw error if undo is disabled in buffer
2698 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2699 (undo-tree-undo-1 arg)
2700 ;; inform user if at branch point
2701 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2704 (defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
2705 ;; Internal undo function. An active mark in `transient-mark-mode', or
2706 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
2707 ;; causes the existing redo record to be preserved, rather than replacing it
2708 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2709 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2710 ;; should *only* be used when temporarily visiting another undo state and
2711 ;; immediately returning to the original state afterwards. Otherwise, it
2712 ;; could cause history-discarding errors.)
2713 (let ((undo-in-progress t)
2714 (undo-in-region (and undo-tree-enable-undo-in-region
2715 (or (region-active-p)
2716 (and arg (not (numberp arg))))))
2718 ;; transfer entries accumulated in `buffer-undo-list' to
2719 ;; `buffer-undo-tree'
2720 (undo-list-transfer-to-tree)
2722 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2723 ;; check if at top of undo tree
2724 (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2725 (error "No further undo information"))
2727 ;; if region is active, or a non-numeric prefix argument was supplied,
2728 ;; try to pull out a new branch of changes affecting the region
2729 (when (and undo-in-region
2730 (not (undo-tree-pull-undo-in-region-branch
2731 (region-beginning) (region-end))))
2732 (error "No further undo information for region"))
2734 ;; remove any GC'd elements from node's undo list
2735 (setq current (undo-tree-current buffer-undo-tree))
2736 (decf (undo-tree-size buffer-undo-tree)
2737 (undo-list-byte-size (undo-tree-node-undo current)))
2738 (setf (undo-tree-node-undo current)
2739 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2740 (incf (undo-tree-size buffer-undo-tree)
2741 (undo-list-byte-size (undo-tree-node-undo current)))
2742 ;; undo one record from undo tree
2743 (when undo-in-region
2744 (setq pos (set-marker (make-marker) (point)))
2745 (set-marker-insertion-type pos t))
2746 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
2749 ;; if preserving old redo record, discard new redo entries that
2750 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2751 ;; elements from node's redo list
2754 (undo-list-pop-changeset)
2755 (decf (undo-tree-size buffer-undo-tree)
2756 (undo-list-byte-size (undo-tree-node-redo current)))
2757 (setf (undo-tree-node-redo current)
2758 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2759 (incf (undo-tree-size buffer-undo-tree)
2760 (undo-list-byte-size (undo-tree-node-redo current))))
2761 ;; otherwise, record redo entries that `primitive-undo' has added to
2762 ;; `buffer-undo-list' in current node's redo record, replacing
2763 ;; existing entry if one already exists
2764 (when (undo-tree-node-redo current)
2765 (decf (undo-tree-size buffer-undo-tree)
2766 (undo-list-byte-size (undo-tree-node-redo current))))
2767 (setf (undo-tree-node-redo current)
2768 (undo-list-pop-changeset 'discard-pos))
2769 (incf (undo-tree-size buffer-undo-tree)
2770 (undo-list-byte-size (undo-tree-node-redo current))))
2772 ;; rewind current node and update timestamp
2773 (setf (undo-tree-current buffer-undo-tree)
2774 (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
2775 (unless preserve-timestamps
2776 (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
2779 ;; if undoing-in-region, record current node, region and direction so we
2780 ;; can tell if undo-in-region is repeated, and re-activate mark if in
2781 ;; `transient-mark-mode'; if not, erase any leftover data
2782 (if (not undo-in-region)
2783 (undo-tree-node-clear-region-data current)
2785 ;; note: we deliberately want to store the region information in the
2786 ;; node *below* the now current one
2787 (setf (undo-tree-node-undo-beginning current) (region-beginning)
2788 (undo-tree-node-undo-end current) (region-end))
2789 (set-marker pos nil)))
2791 ;; undo deactivates mark unless undoing-in-region
2792 (setq deactivate-mark (not undo-in-region))))
2796 (defun undo-tree-redo (&optional arg)
2797 "Redo changes. A numeric ARG serves as a repeat count.
2799 In Transient Mark mode when the mark is active, only redo changes
2800 within the current region. Similarly, when not in Transient Mark
2801 mode, just \\[universal-argument] as an argument limits redo to
2802 changes within the current region."
2804 ;; throw error if undo is disabled in buffer
2805 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2806 (undo-tree-redo-1 arg)
2807 ;; inform user if at branch point
2808 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2811 (defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
2812 ;; Internal redo function. An active mark in `transient-mark-mode', or
2813 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
2814 ;; causes the existing redo record to be preserved, rather than replacing it
2815 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2816 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2817 ;; should *only* be used when temporarily visiting another undo state and
2818 ;; immediately returning to the original state afterwards. Otherwise, it
2819 ;; could cause history-discarding errors.)
2820 (let ((undo-in-progress t)
2821 (redo-in-region (and undo-tree-enable-undo-in-region
2822 (or (region-active-p)
2823 (and arg (not (numberp arg))))))
2825 ;; transfer entries accumulated in `buffer-undo-list' to
2826 ;; `buffer-undo-tree'
2827 (undo-list-transfer-to-tree)
2829 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2830 ;; check if at bottom of undo tree
2831 (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
2832 (error "No further redo information"))
2834 ;; if region is active, or a non-numeric prefix argument was supplied,
2835 ;; try to pull out a new branch of changes affecting the region
2836 (when (and redo-in-region
2837 (not (undo-tree-pull-redo-in-region-branch
2838 (region-beginning) (region-end))))
2839 (error "No further redo information for region"))
2841 ;; advance current node
2842 (setq current (undo-tree-current buffer-undo-tree)
2843 current (setf (undo-tree-current buffer-undo-tree)
2844 (nth (undo-tree-node-branch current)
2845 (undo-tree-node-next current))))
2846 ;; remove any GC'd elements from node's redo list
2847 (decf (undo-tree-size buffer-undo-tree)
2848 (undo-list-byte-size (undo-tree-node-redo current)))
2849 (setf (undo-tree-node-redo current)
2850 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2851 (incf (undo-tree-size buffer-undo-tree)
2852 (undo-list-byte-size (undo-tree-node-redo current)))
2853 ;; redo one record from undo tree
2854 (when redo-in-region
2855 (setq pos (set-marker (make-marker) (point)))
2856 (set-marker-insertion-type pos t))
2857 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
2860 ;; if preserving old undo record, discard new undo entries that
2861 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2862 ;; elements from node's redo list
2865 (undo-list-pop-changeset)
2866 (decf (undo-tree-size buffer-undo-tree)
2867 (undo-list-byte-size (undo-tree-node-undo current)))
2868 (setf (undo-tree-node-undo current)
2869 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2870 (incf (undo-tree-size buffer-undo-tree)
2871 (undo-list-byte-size (undo-tree-node-undo current))))
2872 ;; otherwise, record undo entries that `primitive-undo' has added to
2873 ;; `buffer-undo-list' in current node's undo record, replacing
2874 ;; existing entry if one already exists
2875 (when (undo-tree-node-undo current)
2876 (decf (undo-tree-size buffer-undo-tree)
2877 (undo-list-byte-size (undo-tree-node-undo current))))
2878 (setf (undo-tree-node-undo current)
2879 (undo-list-pop-changeset 'discard-pos))
2880 (incf (undo-tree-size buffer-undo-tree)
2881 (undo-list-byte-size (undo-tree-node-undo current))))
2884 (unless preserve-timestamps
2885 (setf (undo-tree-node-timestamp current) (current-time)))
2887 ;; if redoing-in-region, record current node, region and direction so we
2888 ;; can tell if redo-in-region is repeated, and re-activate mark if in
2889 ;; `transient-mark-mode'
2890 (if (not redo-in-region)
2891 (undo-tree-node-clear-region-data current)
2893 (setf (undo-tree-node-redo-beginning current) (region-beginning)
2894 (undo-tree-node-redo-end current) (region-end))
2895 (set-marker pos nil)))
2897 ;; redo deactivates the mark unless redoing-in-region
2898 (setq deactivate-mark (not redo-in-region))))
2902 (defun undo-tree-switch-branch (branch)
2903 "Switch to a different BRANCH of the undo tree.
2904 This will affect which branch to descend when *redoing* changes
2905 using `undo-tree-redo'."
2906 (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
2907 (and (not (eq buffer-undo-list t))
2908 (or (undo-list-transfer-to-tree) t)
2909 (let ((b (undo-tree-node-branch
2911 buffer-undo-tree))))
2913 ;; switch to other branch if only 2
2914 ((= (undo-tree-num-branches) 2) (- 1 b))
2915 ;; prompt if more than 2
2916 ((> (undo-tree-num-branches) 2)
2918 (format "Branch (0-%d, on %d): "
2919 (1- (undo-tree-num-branches)) b)))
2921 ;; throw error if undo is disabled in buffer
2922 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2923 ;; sanity check branch number
2924 (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point"))
2925 (when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
2926 (error "Invalid branch number"))
2927 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2928 (undo-list-transfer-to-tree)
2930 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
2932 (message "Switched to branch %d" branch))
2935 (defun undo-tree-set (node &optional preserve-timestamps)
2936 ;; Set buffer to state corresponding to NODE. Returns intersection point
2937 ;; between path back from current node and path back from selected NODE.
2938 ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
2939 ;; undo-tree nodes. (This should *only* be used when temporarily visiting
2940 ;; another undo state and immediately returning to the original state
2941 ;; afterwards. Otherwise, it could cause history-discarding errors.)
2942 (let ((path (make-hash-table :test 'eq))
2944 (puthash (undo-tree-root buffer-undo-tree) t path)
2945 ;; build list of nodes leading back from selected node to root, updating
2946 ;; branches as we go to point down to selected node
2949 (when (undo-tree-node-previous n)
2950 (setf (undo-tree-node-branch (undo-tree-node-previous n))
2952 n (undo-tree-node-next (undo-tree-node-previous n))))
2953 (setq n (undo-tree-node-previous n)))))
2954 ;; work backwards from current node until we intersect path back from
2956 (setq n (undo-tree-current buffer-undo-tree))
2957 (while (not (gethash n path))
2958 (setq n (undo-tree-node-previous n)))
2959 ;; ascend tree until intersection node
2960 (while (not (eq (undo-tree-current buffer-undo-tree) n))
2962 ;; descend tree until selected node
2963 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2965 n)) ; return intersection node
2969 (defun undo-tree-save-state-to-register (register)
2970 "Store current undo-tree state to REGISTER.
2971 The saved state can be restored using
2972 `undo-tree-restore-state-from-register'.
2973 Argument is a character, naming the register."
2974 (interactive "cUndo-tree state to register: ")
2975 ;; throw error if undo is disabled in buffer
2976 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2977 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2978 (undo-list-transfer-to-tree)
2979 ;; save current node to REGISTER
2981 register (registerv-make
2982 (undo-tree-make-register-data
2983 (current-buffer) (undo-tree-current buffer-undo-tree))
2984 :print-func 'undo-tree-register-data-print-func))
2985 ;; record REGISTER in current node, for visualizer
2986 (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
2991 (defun undo-tree-restore-state-from-register (register)
2992 "Restore undo-tree state from REGISTER.
2993 The state must be saved using `undo-tree-save-state-to-register'.
2994 Argument is a character, naming the register."
2995 (interactive "*cRestore undo-tree state from register: ")
2996 ;; throw error if undo is disabled in buffer, or if register doesn't contain
2997 ;; an undo-tree node
2998 (let ((data (registerv-data (get-register register))))
3000 ((eq buffer-undo-list t)
3001 (error "No undo information in this buffer"))
3002 ((not (undo-tree-register-data-p data))
3003 (error "Register doesn't contain undo-tree state"))
3004 ((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
3005 (error "Register contains undo-tree state for a different buffer")))
3006 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3007 (undo-list-transfer-to-tree)
3008 ;; restore buffer state corresponding to saved node
3009 (undo-tree-set (undo-tree-register-data-node data))))
3013 (defun undo-tree-make-history-save-file-name (file)
3014 "Create the undo history file name for FILE.
3015 Normally this is the file's name with `.' prepended and
3016 `~undo-tree~' appended.
3018 A match for FILE is sought in `undo-tree-history-directory-alist';
3019 see the documentation of that variable. If the directory for the
3020 backup doesn't exist, it is created."
3021 (let* ((backup-directory-alist undo-tree-history-directory-alist)
3022 (name (make-backup-file-name-1 file)))
3023 (concat (file-name-directory name) "." (file-name-nondirectory name)
3027 (defun undo-tree-save-history (&optional filename overwrite)
3028 "Store undo-tree history to file.
3030 If optional argument FILENAME is omitted, default save file is
3031 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
3032 Otherwise, prompt for one.
3034 If OVERWRITE is non-nil, any existing file will be overwritten
3035 without asking for confirmation."
3037 (undo-list-transfer-to-tree)
3038 (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
3040 (undo-tree-kill-visualizer)
3041 (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
3042 (let ((buff (current-buffer))
3043 (tree (copy-undo-tree buffer-undo-tree)))
3047 (if buffer-file-name
3048 (undo-tree-make-history-save-file-name buffer-file-name)
3049 (expand-file-name (read-file-name "File to save in: ") nil))))
3050 (when (or (not (file-exists-p filename))
3052 (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
3053 ;; discard undo-tree object pool before saving
3054 (setf (undo-tree-object-pool tree) nil)
3055 ;; print undo-tree to file
3056 (with-temp-file filename
3057 (prin1 (sha1 buff) (current-buffer))
3058 (terpri (current-buffer))
3059 (let ((print-circle t)) (prin1 tree (current-buffer))))))))
3063 (defun undo-tree-load-history (&optional filename noerror)
3064 "Load undo-tree history from file.
3066 If optional argument FILENAME is null, default load file is
3067 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
3068 Otherwise, prompt for one.
3070 If optional argument NOERROR is non-nil, return nil instead of
3071 signaling an error if file is not found."
3076 (if buffer-file-name
3077 (undo-tree-make-history-save-file-name buffer-file-name)
3078 (expand-file-name (read-file-name "File to load from: ") nil))))
3080 ;; attempt to read undo-tree from FILENAME
3082 (unless (file-exists-p filename)
3084 (throw 'load-error nil)
3085 (error "File \"%s\" does not exist; could not load undo-tree history"
3087 (let (buff tmp hash tree)
3088 (setq buff (current-buffer))
3090 (insert-file-contents filename)
3091 (goto-char (point-min))
3093 (setq hash (read (current-buffer)))
3096 (funcall (if noerror 'message 'error)
3097 "Error reading undo-tree history from \"%s\"" filename)
3098 (throw 'load-error nil)))
3099 (unless (string= (sha1 buff) hash)
3101 (funcall (if noerror 'message 'error)
3102 "Buffer has been modified; could not load undo-tree history")
3103 (throw 'load-error nil))
3105 (setq tree (read (current-buffer)))
3108 (funcall (if noerror 'message 'error)
3109 "Error reading undo-tree history from \"%s\"" filename)
3110 (throw 'load-error nil)))
3112 ;; initialise empty undo-tree object pool
3113 (setf (undo-tree-object-pool tree)
3114 (make-hash-table :test 'eq :weakness 'value))
3115 (setq buffer-undo-tree tree))))
3119 ;; Versions of save/load functions for use in hooks
3120 (defun undo-tree-save-history-hook ()
3121 (undo-tree-save-history nil t) nil)
3123 (defun undo-tree-load-history-hook ()
3124 (undo-tree-load-history nil t))
3129 ;;; =====================================================================
3130 ;;; Undo-tree visualizer
3132 (defun undo-tree-visualize ()
3133 "Visualize the current buffer's undo tree."
3136 ;; throw error if undo is disabled in buffer
3137 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
3138 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3139 (undo-list-transfer-to-tree)
3140 ;; add hook to kill visualizer buffer if original buffer is changed
3141 (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
3142 ;; prepare *undo-tree* buffer, then draw tree in it
3143 (let ((undo-tree buffer-undo-tree)
3144 (buff (current-buffer))
3145 (display-buffer-mark-dedicated 'soft))
3146 (switch-to-buffer-other-window
3147 (get-buffer-create undo-tree-visualizer-buffer-name))
3148 (setq undo-tree-visualizer-parent-buffer buff)
3149 (setq buffer-undo-tree undo-tree)
3150 (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
3151 (setq undo-tree-visualizer-spacing
3152 (undo-tree-visualizer-calculate-spacing))
3153 (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
3154 (undo-tree-visualizer-mode)
3155 (let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
3158 (defun undo-tree-kill-visualizer (&rest dummy)
3159 ;; Kill visualizer. Added to `before-change-functions' hook of original
3160 ;; buffer when visualizer is invoked.
3161 (unless undo-tree-inhibit-kill-visualizer
3163 (with-current-buffer undo-tree-visualizer-buffer-name
3164 (undo-tree-visualizer-quit)))))
3168 (defun undo-tree-draw-tree (undo-tree)
3169 ;; Draw UNDO-TREE in current buffer.
3171 (undo-tree-move-down 1) ; top margin
3172 (undo-tree-clear-visualizer-data undo-tree)
3173 (undo-tree-compute-widths undo-tree)
3174 (undo-tree-move-forward
3175 (max (/ (window-width) 2)
3176 (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree))
3177 ;; add space for left part of left-most time-stamp
3178 (if undo-tree-visualizer-timestamps
3179 (/ (- undo-tree-visualizer-spacing 4) 2)
3183 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3184 (stack (list (undo-tree-root undo-tree)))
3185 (n (undo-tree-root undo-tree)))
3186 ;; link root node to its representation in visualizer
3187 (unless (markerp (undo-tree-node-marker n))
3188 (setf (undo-tree-node-marker n) (make-marker))
3189 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3190 (move-marker (undo-tree-node-marker n) (point))
3191 ;; draw nodes from stack until stack is empty
3193 (setq n (pop stack))
3194 (goto-char (undo-tree-node-marker n))
3195 (setq n (undo-tree-draw-subtree n nil))
3196 (setq stack (append stack n))))
3197 ;; highlight active branch
3198 (goto-char (undo-tree-node-marker (undo-tree-root undo-tree)))
3199 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3200 (undo-tree-highlight-active-branch (undo-tree-root undo-tree)))
3201 ;; highlight current node
3202 (undo-tree-draw-node (undo-tree-current undo-tree) 'current))
3205 (defun undo-tree-highlight-active-branch (node)
3206 ;; Draw highlighted active branch below NODE in current buffer.
3207 (let ((stack (list node)))
3208 ;; link node to its representation in visualizer
3209 (unless (markerp (undo-tree-node-marker node))
3210 (setf (undo-tree-node-marker node) (make-marker))
3211 (set-marker-insertion-type (undo-tree-node-marker node) nil))
3212 (move-marker (undo-tree-node-marker node) (point))
3213 ;; draw active branch
3215 (setq node (pop stack))
3216 (goto-char (undo-tree-node-marker node))
3217 (setq node (undo-tree-draw-subtree node 'active))
3218 (setq stack (append stack node)))))
3221 (defun undo-tree-draw-node (node &optional current)
3222 ;; Draw symbol representing NODE in visualizer.
3223 (goto-char (undo-tree-node-marker node))
3224 (when undo-tree-visualizer-timestamps
3225 (backward-char (/ undo-tree-visualizer-spacing 2)))
3227 (let ((register (undo-tree-node-register node))
3229 (unless (and register
3230 (eq node (undo-tree-register-data-node
3231 (registerv-data (get-register register)))))
3232 (setq register nil))
3233 ;; represent node by differentl symbols, depending on whether it's the
3234 ;; current node or is saved in a register
3237 (undo-tree-visualizer-timestamps
3238 (undo-tree-timestamp-to-string
3239 (undo-tree-node-timestamp node)
3240 undo-tree-visualizer-relative-timestamps
3243 (register (char-to-string register))
3248 (let ((undo-tree-insert-face
3249 (cons 'undo-tree-visualizer-current-face
3250 (and (boundp 'undo-tree-insert-face)
3251 (or (and (consp undo-tree-insert-face)
3252 undo-tree-insert-face)
3253 (list undo-tree-insert-face))))))
3254 (undo-tree-insert node-string)))
3256 (let ((undo-tree-insert-face
3257 (cons 'undo-tree-visualizer-register-face
3258 (and (boundp 'undo-tree-insert-face)
3259 (or (and (consp undo-tree-insert-face)
3260 undo-tree-insert-face)
3261 (list undo-tree-insert-face))))))
3262 (undo-tree-insert node-string)))
3263 (t (undo-tree-insert node-string)))
3265 (backward-char (if undo-tree-visualizer-timestamps
3266 (1+ (/ undo-tree-visualizer-spacing 2))
3268 (move-marker (undo-tree-node-marker node) (point))
3269 (put-text-property (point) (1+ (point)) 'undo-tree-node node)))
3272 (defun undo-tree-draw-subtree (node &optional active-branch)
3273 ;; Draw subtree rooted at NODE. The subtree will start from point.
3274 ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE.
3275 ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes.
3276 (let ((num-children (length (undo-tree-node-next node)))
3277 node-list pos trunk-pos n)
3279 (undo-tree-draw-node node)
3282 ;; if we're at a leaf node, we're done
3283 ((= num-children 0))
3285 ;; if node has only one child, draw it (not strictly necessary to deal
3286 ;; with this case separately, but as it's by far the most common case
3287 ;; this makes the code clearer and more efficient)
3289 (undo-tree-move-down 1)
3290 (undo-tree-insert ?|)
3292 (undo-tree-move-down 1)
3293 (undo-tree-insert ?|)
3295 (undo-tree-move-down 1)
3296 (setq n (car (undo-tree-node-next node)))
3297 ;; link next node to its representation in visualizer
3298 (unless (markerp (undo-tree-node-marker n))
3299 (setf (undo-tree-node-marker n) (make-marker))
3300 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3301 (move-marker (undo-tree-node-marker n) (point))
3302 ;; add next node to list of nodes to draw next
3305 ;; if node had multiple children, draw branches
3307 (undo-tree-move-down 1)
3308 (undo-tree-insert ?|)
3310 (setq trunk-pos (point))
3313 (- (undo-tree-node-char-lwidth node)
3314 (undo-tree-node-char-lwidth
3315 (car (undo-tree-node-next node)))))
3317 (setq n (cons nil (undo-tree-node-next node)))
3318 (dotimes (i (/ num-children 2))
3320 (when (or (null active-branch)
3322 (nth (undo-tree-node-branch node)
3323 (undo-tree-node-next node))))
3324 (undo-tree-move-forward 2)
3325 (undo-tree-insert ?_ (- trunk-pos pos 2))
3327 (undo-tree-move-forward 1)
3328 (undo-tree-move-down 1)
3329 (undo-tree-insert ?/)
3331 (undo-tree-move-down 1)
3332 ;; link node to its representation in visualizer
3333 (unless (markerp (undo-tree-node-marker (car n)))
3334 (setf (undo-tree-node-marker (car n)) (make-marker))
3335 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3336 (move-marker (undo-tree-node-marker (car n)) (point))
3337 ;; add node to list of nodes to draw next
3338 (push (car n) node-list))
3340 (undo-tree-move-forward
3341 (+ (undo-tree-node-char-rwidth (car n))
3342 (undo-tree-node-char-lwidth (cadr n))
3343 undo-tree-visualizer-spacing 1))
3345 ;; middle subtree (only when number of children is odd)
3346 (when (= (mod num-children 2) 1)
3348 (when (or (null active-branch)
3350 (nth (undo-tree-node-branch node)
3351 (undo-tree-node-next node))))
3352 (undo-tree-move-down 1)
3353 (undo-tree-insert ?|)
3355 (undo-tree-move-down 1)
3356 ;; link node to its representation in visualizer
3357 (unless (markerp (undo-tree-node-marker (car n)))
3358 (setf (undo-tree-node-marker (car n)) (make-marker))
3359 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3360 (move-marker (undo-tree-node-marker (car n)) (point))
3361 ;; add node to list of nodes to draw next
3362 (push (car n) node-list))
3364 (undo-tree-move-forward
3365 (+ (undo-tree-node-char-rwidth (car n))
3366 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3367 undo-tree-visualizer-spacing 1))
3371 (dotimes (i (/ num-children 2))
3373 (when (or (null active-branch)
3375 (nth (undo-tree-node-branch node)
3376 (undo-tree-node-next node))))
3377 (goto-char trunk-pos)
3378 (undo-tree-insert ?_ (- pos trunk-pos 1))
3381 (undo-tree-move-down 1)
3382 (undo-tree-insert ?\\)
3383 (undo-tree-move-down 1)
3384 ;; link node to its representation in visualizer
3385 (unless (markerp (undo-tree-node-marker (car n)))
3386 (setf (undo-tree-node-marker (car n)) (make-marker))
3387 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3388 (move-marker (undo-tree-node-marker (car n)) (point))
3389 ;; add node to list of nodes to draw next
3390 (push (car n) node-list))
3393 (undo-tree-move-forward
3394 (+ (undo-tree-node-char-rwidth (car n))
3395 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3396 undo-tree-visualizer-spacing 1))
3397 (setq pos (point))))
3399 ;; return list of nodes to draw next
3400 (nreverse node-list)))
3404 (defun undo-tree-node-char-lwidth (node)
3405 ;; Return left-width of NODE measured in characters.
3406 (if (= (length (undo-tree-node-next node)) 0) 0
3407 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
3408 (if (= (undo-tree-node-cwidth node) 0)
3409 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3412 (defun undo-tree-node-char-rwidth (node)
3413 ;; Return right-width of NODE measured in characters.
3414 (if (= (length (undo-tree-node-next node)) 0) 0
3415 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
3416 (if (= (undo-tree-node-cwidth node) 0)
3417 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3420 (defun undo-tree-insert (str &optional arg)
3421 ;; Insert character or string STR ARG times, overwriting, and using
3422 ;; `undo-tree-insert-face'.
3423 (unless arg (setq arg 1))
3424 (when (characterp str)
3425 (setq str (make-string arg str))
3427 (dotimes (i arg) (insert str))
3428 (setq arg (* arg (length str)))
3429 (undo-tree-move-forward arg)
3430 ;; make sure mark isn't active, otherwise `backward-delete-char' might
3431 ;; delete region instead of single char if transient-mark-mode is enabled
3432 (setq mark-active nil)
3433 (backward-delete-char arg)
3434 (when (boundp 'undo-tree-insert-face)
3435 (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
3438 (defun undo-tree-move-down (&optional arg)
3439 ;; Move down, extending buffer if necessary.
3440 (let ((row (line-number-at-pos))
3441 (col (current-column))
3443 (unless arg (setq arg 1))
3445 (setq line (line-number-at-pos))
3446 ;; if buffer doesn't have enough lines, add some
3447 (when (/= line (+ row arg))
3448 (insert (make-string (- arg (- line row)) ?\n)))
3449 (undo-tree-move-forward col)))
3452 (defun undo-tree-move-forward (&optional arg)
3453 ;; Move forward, extending buffer if necessary.
3454 (unless arg (setq arg 1))
3455 (let ((n (- (line-end-position) (point))))
3459 (insert (make-string (- arg n) ? )))))
3462 (defun undo-tree-timestamp-to-string
3463 (timestamp &optional relative current register)
3464 ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
3465 ;; if it's the CURRENT node and/or has an associated REGISTER.
3468 (let ((time (floor (float-time
3469 (subtract-time (current-time) timestamp))))
3473 (if (> (setq n (/ time 315360000)) 0)
3474 (if (> n 999) "-ages" (format "-%dy" n))
3475 (setq time (% time 315360000))
3477 (if (> (setq n (/ time 86400)) 0)
3479 (setq time (% time 86400))
3481 (if (> (setq n (/ time 3600)) 0)
3483 (setq time (% time 3600))
3485 (if (> (setq n (/ time 60)) 0)
3488 (format "-%ds" (% time 60)))))))
3490 (if current "*" " ")
3492 (if register (concat "[" (char-to-string register) "]")
3494 (setq n (length time))
3496 (concat (make-string (- 9 n) ? ) time)
3499 (concat (if current "*" " ")
3500 (format-time-string "%H:%M:%S" timestamp)
3502 (concat "[" (char-to-string register) "]")
3508 ;;; =====================================================================
3509 ;;; Visualizer mode commands
3511 (defun undo-tree-visualizer-mode ()
3512 "Major mode used in undo-tree visualizer.
3514 The undo-tree visualizer can only be invoked from a buffer in
3515 which `undo-tree-mode' is enabled. The visualizer displays the
3516 undo history tree graphically, and allows you to browse around
3517 the undo history, undoing or redoing the corresponding changes in
3520 Within the undo-tree visualizer, the following keys are available:
3522 \\{undo-tree-visualizer-map}"
3524 (setq major-mode 'undo-tree-visualizer-mode)
3525 (setq mode-name "undo-tree-visualizer-mode")
3526 (use-local-map undo-tree-visualizer-map)
3527 (setq truncate-lines t)
3528 (setq cursor-type nil)
3529 (setq buffer-read-only t)
3530 (setq undo-tree-visualizer-selected-node nil)
3531 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
3535 (defun undo-tree-visualize-undo (&optional arg)
3536 "Undo changes. A numeric ARG serves as a repeat count."
3538 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3539 (inhibit-read-only t))
3540 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3541 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3544 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo arg))
3545 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3546 (let ((inhibit-read-only t))
3547 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3548 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3551 (defun undo-tree-visualize-redo (&optional arg)
3552 "Redo changes. A numeric ARG serves as a repeat count."
3554 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3555 (inhibit-read-only t))
3556 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3557 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3560 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo arg))
3561 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3562 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3563 (let ((inhibit-read-only t))
3564 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3565 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3568 (defun undo-tree-visualize-switch-branch-right (arg)
3569 "Switch to next branch of the undo tree.
3570 This will affect which branch to descend when *redoing* changes
3571 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3573 ;; un-highlight old active branch below current node
3574 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3575 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3576 (inhibit-read-only t))
3577 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3579 (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
3580 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
3582 ((>= (+ branch arg) (undo-tree-num-branches))
3583 (1- (undo-tree-num-branches)))
3584 ((<= (+ branch arg) 0) 0)
3585 (t (+ branch arg))))
3586 (let ((inhibit-read-only t))
3587 ;; highlight new active branch below current node
3588 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3589 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3590 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3591 ;; re-highlight current node
3592 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
3595 (defun undo-tree-visualize-switch-branch-left (arg)
3596 "Switch to previous branch of the undo tree.
3597 This will affect which branch to descend when *redoing* changes
3598 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3600 (undo-tree-visualize-switch-branch-right (- arg)))
3603 (defun undo-tree-visualizer-quit ()
3604 "Quit the undo-tree visualizer."
3606 (undo-tree-clear-visualizer-data buffer-undo-tree)
3607 ;; remove kill visualizer hook from parent buffer
3609 (with-current-buffer undo-tree-visualizer-parent-buffer
3610 (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
3611 ;; kill diff buffer, if any
3612 (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
3613 (let ((parent undo-tree-visualizer-parent-buffer)
3615 ;; kill visualizer buffer
3617 ;; switch back to parent buffer
3619 (if (setq window (get-buffer-window parent))
3620 (select-window window)
3621 (switch-to-buffer parent))))))
3624 (defun undo-tree-visualizer-abort ()
3625 "Quit the undo-tree visualizer and return buffer to original state."
3627 (let ((node undo-tree-visualizer-initial-node))
3628 (undo-tree-visualizer-quit)
3629 (undo-tree-set node)))
3632 (defun undo-tree-visualizer-set (&optional pos)
3633 "Set buffer to state corresponding to undo tree node
3634 at POS, or point if POS is nil."
3636 (unless pos (setq pos (point)))
3637 (let ((node (get-text-property pos 'undo-tree-node)))
3639 ;; set parent buffer to state corresponding to node at POS
3640 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3641 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
3642 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3643 ;; re-draw undo tree
3644 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
3645 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3648 (defun undo-tree-visualizer-mouse-set (pos)
3649 "Set buffer to state corresponding to undo tree node
3650 at mouse event POS."
3652 (undo-tree-visualizer-set (event-start (nth 1 pos))))
3655 (defun undo-tree-visualizer-toggle-timestamps ()
3656 "Toggle display of time-stamps."
3658 (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
3659 (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
3661 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
3664 (defun undo-tree-visualizer-scroll-left (&optional arg)
3666 (scroll-right (or arg 1) t))
3669 (defun undo-tree-visualizer-scroll-right (&optional arg)
3671 (scroll-left (or arg 1) t))
3676 ;;; =====================================================================
3677 ;;; Visualizer selection mode
3679 (defun undo-tree-visualizer-selection-mode ()
3680 "Major mode used to select nodes in undo-tree visualizer."
3682 (setq major-mode 'undo-tree-visualizer-selection-mode)
3683 (setq mode-name "undo-tree-visualizer-selection-mode")
3684 (use-local-map undo-tree-visualizer-selection-map)
3685 (setq cursor-type 'box)
3686 (setq undo-tree-visualizer-selected-node
3687 (undo-tree-current buffer-undo-tree))
3688 ;; erase diff (if any), as initially selected node is identical to current
3689 (when undo-tree-visualizer-diff
3690 (let ((buff (get-buffer undo-tree-diff-buffer-name))
3691 (inhibit-read-only t))
3692 (when buff (with-current-buffer buff (erase-buffer))))))
3695 (defun undo-tree-visualizer-select-previous (&optional arg)
3696 "Move to previous node."
3698 (let ((node undo-tree-visualizer-selected-node))
3701 (unless (undo-tree-node-previous node) (throw 'top t))
3702 (setq node (undo-tree-node-previous node))))
3703 (goto-char (undo-tree-node-marker node))
3704 (when (and undo-tree-visualizer-diff
3705 (not (eq node undo-tree-visualizer-selected-node)))
3706 (undo-tree-visualizer-update-diff node))
3707 (setq undo-tree-visualizer-selected-node node)))
3710 (defun undo-tree-visualizer-select-next (&optional arg)
3711 "Move to next node."
3713 (let ((node undo-tree-visualizer-selected-node))
3716 (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
3719 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
3720 (goto-char (undo-tree-node-marker node))
3721 (when (and undo-tree-visualizer-diff
3722 (not (eq node undo-tree-visualizer-selected-node)))
3723 (undo-tree-visualizer-update-diff node))
3724 (setq undo-tree-visualizer-selected-node node)))
3727 (defun undo-tree-visualizer-select-right (&optional arg)
3728 "Move right to a sibling node."
3730 (let ((node undo-tree-visualizer-selected-node)
3732 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3733 (setq end (line-end-position))
3736 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3738 (setq node (get-text-property (point) 'undo-tree-node))
3739 (when (= (point) end) (throw 'end t)))))
3740 (goto-char (undo-tree-node-marker
3741 (or node undo-tree-visualizer-selected-node)))
3742 (when (and undo-tree-visualizer-diff node
3743 (not (eq node undo-tree-visualizer-selected-node)))
3744 (undo-tree-visualizer-update-diff node))
3745 (setq undo-tree-visualizer-selected-node node)))
3748 (defun undo-tree-visualizer-select-left (&optional arg)
3749 "Move left to a sibling node."
3751 (let ((node (get-text-property (point) 'undo-tree-node))
3753 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3754 (setq beg (line-beginning-position))
3757 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3759 (setq node (get-text-property (point) 'undo-tree-node))
3760 (when (= (point) beg) (throw 'beg t)))))
3761 (goto-char (undo-tree-node-marker
3762 (or node undo-tree-visualizer-selected-node)))
3763 (when (and undo-tree-visualizer-diff node
3764 (not (eq node undo-tree-visualizer-selected-node)))
3765 (undo-tree-visualizer-update-diff node))
3766 (setq undo-tree-visualizer-selected-node node)))
3770 ;;; =====================================================================
3771 ;;; Visualizer diff display
3773 (defun undo-tree-visualizer-toggle-diff ()
3774 "Toggle diff display in undo-tree visualizer."
3776 (if undo-tree-visualizer-diff
3777 (undo-tree-visualizer-hide-diff)
3778 (undo-tree-visualizer-show-diff)))
3781 (defun undo-tree-visualizer-selection-toggle-diff ()
3782 "Toggle diff display in undo-tree visualizer selection mode."
3784 (if undo-tree-visualizer-diff
3785 (undo-tree-visualizer-hide-diff)
3786 (let ((node (get-text-property (point) 'undo-tree-node)))
3787 (when node (undo-tree-visualizer-show-diff node)))))
3790 (defun undo-tree-visualizer-show-diff (&optional node)
3791 ;; show visualizer diff display
3792 (setq undo-tree-visualizer-diff t)
3793 (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
3794 (undo-tree-diff node)))
3795 (display-buffer-mark-dedicated 'soft)
3797 (setq win (split-window))
3798 (set-window-buffer win buff)
3799 (shrink-window-if-larger-than-buffer win)))
3802 (defun undo-tree-visualizer-hide-diff ()
3803 ;; hide visualizer diff display
3804 (setq undo-tree-visualizer-diff nil)
3805 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3806 (when win (with-selected-window win (kill-buffer-and-window)))))
3809 (defun undo-tree-diff (&optional node)
3810 ;; Create diff between current state and NODE (or previous state, if NODE is
3811 ;; null). Returns buffer containing diff.
3814 (let ((undo-tree-inhibit-kill-visualizer t)
3815 (current (undo-tree-current buffer-undo-tree)))
3816 (undo-tree-set (or node (undo-tree-node-previous current) current)
3817 'preserve-timestamps)
3818 (setq tmpfile (diff-file-local-copy (current-buffer)))
3819 (undo-tree-set current 'preserve-timestamps))
3820 (setq buff (diff-no-select
3821 (current-buffer) tmpfile nil 'noasync
3822 (get-buffer-create undo-tree-diff-buffer-name)))
3823 ;; delete process messages and useless headers from diff buffer
3824 (with-current-buffer buff
3825 (goto-char (point-min))
3826 (delete-region (point) (1+ (line-end-position 3)))
3827 (goto-char (point-max))
3829 (delete-region (point) (point-max))
3830 (setq cursor-type nil)
3831 (setq buffer-read-only t))
3835 (defun undo-tree-visualizer-update-diff (&optional node)
3836 ;; update visualizer diff display to show diff between current state and
3837 ;; NODE (or previous state, if NODE is null)
3838 (with-current-buffer undo-tree-visualizer-parent-buffer
3839 (undo-tree-diff node))
3840 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3843 (shrink-window-if-larger-than-buffer win))))
3847 (provide 'undo-tree)
3849 ;;; undo-tree.el ends here