1 ;;; undo-tree.el --- Treat undo history as a tree
3 ;; Copyright (C) 2009-2011 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 ;; Git Repository: http://www.dr-qubit.org/git/undo-tree.git
11 ;; This file is part of Emacs.
13 ;; Emacs 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 ;; Emacs 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 jump in the car and drive, without
78 ;; bothering to first figure out whether the button on the left dips the
79 ;; headlights or operates the ejector seat (after all, you'll soon figure it
80 ;; 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.
106 ;; In the undo-tree visualizer:
108 ;; <up> p C-p (`undo-tree-visualize-undo')
111 ;; <down> n C-n (`undo-tree-visualize-redo')
114 ;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
115 ;; Switch to previous undo-tree branch.
117 ;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
118 ;; Switch to next undo-tree branch.
120 ;; t (`undo-tree-visualizer-toggle-timestamps')
121 ;; Toggle display of time-stamps.
123 ;; q C-q (`undo-tree-visualizer-quit')
124 ;; Quit undo-tree-visualizer.
143 ;; To understand the different undo systems, it's easiest to consider an
144 ;; example. Imagine you make a few edits in a buffer. As you edit, you
145 ;; accumulate a history of changes, which we might visualize as a string of
146 ;; past buffer states, growing downwards:
148 ;; o (initial buffer state)
157 ;; x (current buffer state)
160 ;; Now imagine that you undo the last two changes. We can visualize this as
161 ;; rewinding the current state back two steps:
163 ;; o (initial buffer state)
166 ;; x (current buffer state)
175 ;; However, this isn't a good representation of what Emacs' undo system
176 ;; does. Instead, it treats the undos as *new* changes to the buffer, and adds
177 ;; them to the history:
179 ;; o (initial buffer state)
188 ;; x (buffer state before undo)
197 ;; Actually, since the buffer returns to a previous state after an undo,
198 ;; perhaps a better way to visualize it is to imagine the string of changes
199 ;; turning back on itself:
201 ;; (initial buffer state) o
204 ;; (first edit) o x (second undo)
207 ;; (second edit) o o (first undo)
210 ;; o (buffer state before undo)
212 ;; Treating undos as new changes might seem a strange thing to do. But the
213 ;; advantage becomes clear as soon as we imagine what happens when you edit
214 ;; the buffer again. Since you've undone a couple of changes, new edits will
215 ;; branch off from the buffer state that you've rewound to. Conceptually, it
218 ;; o (initial buffer state)
229 ;; The standard undo/redo system only lets you go backwards and forwards
230 ;; linearly. So as soon as you make that new edit, it discards the old
231 ;; branch. Emacs' undo just keeps adding changes to the end of the string. So
232 ;; the undo history in the two systems now looks like this:
234 ;; Undo/Redo: Emacs' undo
242 ;; . x (new edit) o o |
243 ;; (discarded . | / |
250 ;; Now, what if you change your mind about those undos, and decide you did
251 ;; like those other changes you'd made after all? With the standard undo/redo
252 ;; system, you're lost. There's no way to recover them, because that branch
253 ;; was discarded when you made the new edit.
255 ;; However, in Emacs' undo system, those old buffer states are still there in
256 ;; the undo history. You just have to rewind back through the new edit, and
257 ;; back through the changes made by the undos, until you reach them. Of
258 ;; course, since Emacs treats undos (even undos of undos!) as new changes,
259 ;; you're really weaving backwards and forwards through the history, all the
260 ;; time adding new changes to the end of the string as you go:
265 ;; o o o (undo new edit)
268 ;; o o | | o (undo the undo)
271 ;; (trying to get o | | x (undo the undo)
272 ;; to this state) | /
276 ;; So far, this is still reasonably intuitive to use. It doesn't behave so
277 ;; differently to standard undo/redo, except that by going back far enough you
278 ;; can access changes that would be lost in standard undo/redo.
280 ;; However, imagine that after undoing as just described, you decide you
281 ;; actually want to rewind right back to the initial state. If you're lucky,
282 ;; and haven't invoked any command since the last undo, you can just keep on
283 ;; undoing until you get back to the start:
285 ;; (trying to get o x (got there!)
286 ;; to this state) | |
288 ;; o o o o (keep undoing)
291 ;; o o | | o o (keep undoing)
294 ;; (already undid o | | o (got this far)
295 ;; to this state) | /
299 ;; But if you're unlucky, and you happen to have moved the point (say) after
300 ;; getting to the state labelled "got this far", then you've "broken the undo
301 ;; chain". Hold on to something solid, because things are about to get
302 ;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
303 ;; undos! So to get back to the initial state you now have to rewind through
304 ;; *all* the changes, including the undos you just did:
306 ;; (trying to get o x (finally got there!)
307 ;; to this state) | |
311 ;; | | \ | \ | \ | \ |
312 ;; o o | | o o o | o o
313 ;; | / | | | / | | | /
315 ;; (already undid o | | o<. | | o
316 ;; to this state) | / : | /
320 ;; (got this far, but
321 ;; broke the undo chain)
325 ;; In practice you can just hold down the undo key until you reach the buffer
326 ;; state that you want. But whatever you do, don't move around in the buffer
327 ;; to *check* that you've got back to where you want! Because you'll break the
328 ;; undo chain, and then you'll have to traverse the entire string of undos
329 ;; again, just to get back to the point at which you broke the
330 ;; chain. Undo-in-region and commands such as `undo-only' help to make using
331 ;; Emacs' undo a little easier, but nonetheless it remains confusing for many
335 ;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
336 ;; the history we've been discussing (make a few edits, undo a couple of them,
337 ;; and edit again)? The diagram that conceptually represented our undo
338 ;; history, before we started discussing specific undo systems? It looked like
341 ;; o (initial buffer state)
347 ;; o x (current state)
352 ;; Well, that's *exactly* what the undo history looks like to
353 ;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
354 ;; does), nor does it treat undos as new changes to be added to the end of a
355 ;; linear string of buffer states (as Emacs' undo does). It just keeps track
356 ;; of the tree of branching changes that make up the entire undo history.
358 ;; If you undo from this point, you'll rewind back up the tree to the previous
372 ;; If you were to undo again, you'd rewind back to the initial state. If on
373 ;; the other hand you redo the change, you'll end up back at the bottom of the
374 ;; most recent branch:
376 ;; o (undo takes you here)
382 ;; o x (redo takes you here)
387 ;; So far, this is just like the standard undo/redo system. But what if you
388 ;; want to return to a buffer state located on a previous branch of the
389 ;; history? Since `undo-tree-mode' keeps the entire history, you simply need
390 ;; to tell it to switch to a different branch, and then redo the changes you
396 ;; o (start here, but switch
397 ;; |\ to the other branch)
404 ;; Now you're on the other branch, if you undo and redo changes you'll stay on
405 ;; that branch, moving up and down through the buffer states located on that
406 ;; branch. Until you decide to switch branches again, of course.
408 ;; Real undo trees might have multiple branches and sub-branches:
421 ;; Trying to imagine what Emacs' undo would do as you move about such a tree
422 ;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
423 ;; just moving around this undo history tree. Most of the time, you'll
424 ;; probably only need to stay on the most recent branch, in which case it
425 ;; behaves like standard undo/redo, and is just as simple to understand. But
426 ;; if you ever need to recover a buffer state on a different branch, the
427 ;; possibility of switching between branches and accessing the full undo
428 ;; history is still there.
432 ;; The Undo-Tree Visualizer
433 ;; ========================
435 ;; Actually, it gets better. You don't have to imagine all these tree
436 ;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
437 ;; draws them for you! In fact, it draws even better diagrams: it highlights
438 ;; the node representing the current buffer state, it highlights the current
439 ;; branch, and (by hitting "t") you can toggle the display of
440 ;; time-stamps. (There's one other tiny difference: the visualizer puts the
441 ;; most recent branch on the left rather than the right.)
443 ;; In the visualizer, the usual keys for moving up and down a buffer instead
444 ;; move up and down the undo history tree (e.g. the up and down arrow keys, or
445 ;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
446 ;; history you are visualizing) is updated as you move around the undo tree in
447 ;; the visualizer. If you reach a branch point in the visualizer, the usual
448 ;; keys for moving forward and backward in a buffer instead switch branch
449 ;; (e.g. the left and right arrow keys, or "C-f" and "C-b"). And clicking with
450 ;; the mouse on any node in the visualizer will take you directly to that
451 ;; node, resetting the state of the parent buffer to the state represented by
454 ;; It can be useful to see how long ago the parent buffer was in the state
455 ;; represented by a particular node in the visualizer. Hitting "t" in the
456 ;; visualizer toggles the display of time-stamps for all the nodes. (Note
457 ;; that, because of the way `undo-tree-mode' works, these time-stamps may be
458 ;; somewhat later than the true times, especially if it's been a long time
459 ;; since you last undid any changes.)
461 ;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
462 ;; whatever state you ended at.
469 ;; Emacs allows a very useful and powerful method of undoing only selected
470 ;; changes: when a region is active, only changes that affect the text within
471 ;; that region will are undone. With the standard Emacs undo system, changes
472 ;; produced by undoing-in-region naturally get added onto the end of the
473 ;; linear undo history:
477 ;; | x (second undo-in-region)
480 ;; | o (first undo-in-region)
486 ;; You can of course redo these undos-in-region as usual, by undoing the
494 ;; | o o (undo the undo-in-region)
498 ;; o x (undo the undo-in-region)
501 ;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
502 ;; region, undoing only undoes changes that affect that region. However, the
503 ;; way these undos-in-region are recorded in the undo history is quite
504 ;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
505 ;; undo history. The new branch consists of an undo step that undoes some of
506 ;; the changes that affect the current region, and another step that undoes
507 ;; the remaining changes needed to rejoin the previous undo history.
509 ;; Previous undo history Undo-in-region
517 ;; o o x (undo-in-region)
522 ;; As long as you don't change the active region after undoing-in-region,
523 ;; continuing to undo-in-region extends the new branch, pulling more changes
524 ;; that affect the current region into an undo step immediately above your
525 ;; current location in the undo tree, and pushing the point at which the new
526 ;; branch is attached further up the tree:
528 ;; First undo-in-region Second undo-in-region
533 ;; o o x (undo-in-region)
541 ;; Redoing takes you back down the undo tree, as usual (as long as you haven't
542 ;; changed the active region after undoing-in-region, it doesn't matter if it
557 ;; What about redo-in-region? Obviously, this only makes sense if you have
558 ;; already undone some changes, so that there are some changes to redo!
559 ;; Redoing-in-region splits off a new branch of the undo history below your
560 ;; current location in the undo tree. This time, the new branch consists of a
561 ;; redo step that redoes some of the redo changes that affect the current
562 ;; region, followed by all the remaining redo changes.
564 ;; Previous undo history Redo-in-region
572 ;; o o x (redo-in-region)
577 ;; As long as you don't change the active region after redoing-in-region,
578 ;; continuing to redo-in-region extends the new branch, pulling more redo
579 ;; changes into a redo step immediately below your current location in the
582 ;; First redo-in-region Second redo-in-region
590 ;; o x (redo-in-region) o o
593 ;; o o o x (redo-in-region)
598 ;; Note that undo-in-region and redo-in-region only ever add new changes to
599 ;; the undo tree, they *never* modify existing undo history. So you can always
600 ;; return to previous buffer states by switching to a previous branch of the
608 ;; * use `get-buffer-create' when creating the visualizer buffer in
609 ;; `undo-tree-visualize', to fix bug caused by `global-undo-tree-mode' being
610 ;; enabled in the visualizer when `default-major-mode' is set to something
611 ;; other than `fundamental-mode' (thanks to Michael Heerdegen for suggesting
613 ;; * modified `turn-on-undo-tree-mode' to avoid turning on `undo-tree-mode' if
614 ;; the buffer's `major-mode' implements its own undo system, by checking
615 ;; whether `undo' is remapped, the default "C-/" or "C-_" bindings have been
616 ;; overridden, or the `major-mode' is listed in
617 ;; `undo-tree-incompatible-major-modes'
618 ;; * discard position entries from `buffer-undo-list' changesets created by
619 ;; undoing or redoing, to ensure point is always moved to where the change
620 ;; is (standard Emacs `undo' also does this)
621 ;; * fixed `undo-tree-draw-node' to use correct faces and indicate registers
622 ;; when displaying timestamps in visualizer
625 ;; * implemented undo-in-region
626 ;; * fixed bugs in `undo-list-transfer-to-tree' and
627 ;; `undo-list-rebuild-from-tree' which caused errors when undo history was
629 ;; * defun `region-active-p' if not already defined, for compatibility with
633 ;; * modified `undo-tree-node' defstruct and macros to allow arbitrary
634 ;; meta-data to be stored in a plist associated with a node, and
635 ;; reimplemented storage of visualizer data on top of this
636 ;; * display registers storing undo-tree state in visualizer
637 ;; * implemented keyboard selection in visualizer
638 ;; * rebuild `buffer-undo-list' from tree when disabling `undo-tree-mode'
641 ;; * added support for marker undo entries
644 ;; * pass null argument to `kill-buffer' call in `undo-tree-visualizer-quit',
645 ;; since the argument's not optional in earlier Emacs versions
646 ;; * added match for "No further redo information" to
647 ;; `debug-ignored-errors' to prevent debugger being called on this error
648 ;; * made `undo-tree-visualizer-quit' select the window displaying the
649 ;; visualizer's parent buffer, or switch to the parent buffer if no window
651 ;; * fixed bug in `undo-tree-switch-branch'
652 ;; * general code tidying and reorganisation
653 ;; * fixed bugs in history-discarding logic
654 ;; * fixed bug in `undo-tree-insert' triggered by `undo-tree-visualizer-set'
655 ;; by ensuring mark is deactivated
658 ;; * added `undo-tree-mode-lighter' customization option to allow the
659 ;; mode-line lighter to be changed
660 ;; * bug-fix in `undo-tree-discard-node'
661 ;; * added `undo-tree-save-state-to-register' and
662 ;; `undo-tree-restore-state-from-register' commands and keybindings for
663 ;; saving/restoring undo-tree states using registers
666 ;; * modified `undo-tree-visualize' to mark the visualizer window as
667 ;; soft-dedicated, and changed `undo-tree-visualizer-quit' to use
668 ;; `kill-buffer', so that the visualizer window is deleted along with its
669 ;; buffer if the visualizer buffer was displayed in a new window, but not if
670 ;; it was displayed in an existing window.
673 ;; * modified `undo-tree-undo' and `undo-tree-redo' to always replace
674 ;; redo/undo entries with new ones generated by `primitive-undo', as the new
675 ;; changesets will restore the point more reliably
678 ;; * fixed `undo-tree-visualizer-quit' to remove `after-change-functions'
679 ;; hook there, rather than in `undo-tree-kill-visualizer'
682 ;; * fixed keybindings
683 ;; * renamed `undo-tree-visualizer-switch-previous-branch' and
684 ;; `undo-tree-visualizer-switch-next-branch' to
685 ;; `undo-tree-visualizer-switch-branch-left' and
686 ;; `undo-tree-visualizer-switch-branch-right'
689 ;; * prevented `undo-tree-kill-visualizer' from killing visualizer when
690 ;; undoing/redoing from the visualizer, which completely broke the
692 ;; * changed one redo binding, so that at least one set of undo/redo bindings
693 ;; works in a terminal
694 ;; * bound vertical scrolling commands in `undo-tree-visualizer-map', in case
695 ;; they aren't bound globally
696 ;; * added missing :group argument to `defface's
705 (eval-when-compile (require 'cl))
707 ;; `characterp' isn't defined in Emacs versions <= 22
708 (unless (fboundp 'characterp)
709 (defalias 'characterp 'char-valid-p))
711 ;; `region-active-p' isn't defined in Emacs versions <= 22
712 (unless (fboundp 'region-active-p)
713 (defun region-active-p () (and transient-mark-mode mark-active)))
717 ;;; =====================================================================
718 ;;; Global variables and customization options
720 (defvar buffer-undo-tree nil
721 "Tree of undo entries in current buffer.")
722 (make-variable-buffer-local 'buffer-undo-tree)
725 (defgroup undo-tree nil
729 (defcustom undo-tree-mode-lighter " Undo-Tree"
730 "Lighter displayed in mode line
731 when `undo-tree-mode' is enabled."
735 (defcustom undo-tree-incompatible-major-modes nil
736 "List of major-modes in which `undo-tree-mode' should not be enabled.
737 \(See `turn-on-undo-tree-mode'.\)"
739 :type '(repeat symbol))
741 (defcustom undo-tree-visualizer-spacing 3
742 "Horizontal spacing in undo-tree visualization.
743 Must be a postivie odd integer."
746 :match (lambda (w n) (and (integerp n) (> n 0) (= (mod n 2) 1)))))
747 (make-variable-buffer-local 'undo-tree-visualizer-spacing)
749 (defvar undo-tree-map nil
750 "Keymap used in undo-tree-mode.")
753 (defface undo-tree-visualizer-default-face
754 '((((class color)) :foreground "gray"))
755 "*Face used to draw undo-tree in visualizer."
758 (defface undo-tree-visualizer-current-face
759 '((((class color)) :foreground "red"))
760 "*Face used to highlight current undo-tree node in visualizer."
763 (defface undo-tree-visualizer-active-branch-face
764 '((((class color) (background dark))
765 (:foreground "white" :weight bold))
766 (((class color) (background light))
767 (:foreground "black" :weight bold)))
768 "*Face used to highlight active undo-tree branch
772 (defface undo-tree-visualizer-register-face
773 '((((class color)) :foreground "yellow"))
774 "*Face used to highlight undo-tree nodes saved to a register
778 (defvar undo-tree-visualizer-map nil
779 "Keymap used in undo-tree visualizer.")
781 (defvar undo-tree-visualizer-selection-map nil
782 "Keymap used in undo-tree visualizer selection mode.")
785 (defvar undo-tree-visualizer-parent-buffer nil
786 "Parent buffer in visualizer.")
787 (make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
789 (defvar undo-tree-visualizer-timestamps nil
790 "Non-nil when visualizer is displaying time-stamps.")
791 (make-variable-buffer-local 'undo-tree-visualizer-timestamps)
793 (defconst undo-tree-visualizer-buffer-name " *undo-tree*")
795 ;; prevent debugger being called on "No further redo information"
796 (add-to-list 'debug-ignored-errors "^No further redo information")
801 ;;; =================================================================
802 ;;; Setup default keymaps
804 (unless undo-tree-map
805 (setq undo-tree-map (make-sparse-keymap))
806 ;; remap `undo' and `undo-only' to `undo-tree-undo'
807 (define-key undo-tree-map [remap undo] 'undo-tree-undo)
808 (define-key undo-tree-map [remap undo-only] 'undo-tree-undo)
809 ;; bind standard undo bindings (since these match redo counterparts)
810 (define-key undo-tree-map (kbd "C-/") 'undo-tree-undo)
811 (define-key undo-tree-map "\C-_" 'undo-tree-undo)
812 ;; redo doesn't exist normally, so define our own keybindings
813 (define-key undo-tree-map (kbd "C-?") 'undo-tree-redo)
814 (define-key undo-tree-map (kbd "M-_") 'undo-tree-redo)
815 ;; just in case something has defined `redo'...
816 (define-key undo-tree-map [remap redo] 'undo-tree-redo)
817 ;; we use "C-x u" for the undo-tree visualizer
818 (define-key undo-tree-map (kbd "\C-x u") 'undo-tree-visualize)
819 ;; bind register commands
820 (define-key undo-tree-map (kbd "C-x r u")
821 'undo-tree-save-state-to-register)
822 (define-key undo-tree-map (kbd "C-x r U")
823 'undo-tree-restore-state-from-register))
826 (unless undo-tree-visualizer-map
827 (setq undo-tree-visualizer-map (make-keymap))
828 ;; vertical motion keys undo/redo
829 (define-key undo-tree-visualizer-map [remap previous-line]
830 'undo-tree-visualize-undo)
831 (define-key undo-tree-visualizer-map [remap next-line]
832 'undo-tree-visualize-redo)
833 (define-key undo-tree-visualizer-map [up]
834 'undo-tree-visualize-undo)
835 (define-key undo-tree-visualizer-map "p"
836 'undo-tree-visualize-undo)
837 (define-key undo-tree-visualizer-map "\C-p"
838 'undo-tree-visualize-undo)
839 (define-key undo-tree-visualizer-map [down]
840 'undo-tree-visualize-redo)
841 (define-key undo-tree-visualizer-map "n"
842 'undo-tree-visualize-redo)
843 (define-key undo-tree-visualizer-map "\C-n"
844 'undo-tree-visualize-redo)
845 ;; horizontal motion keys switch branch
846 (define-key undo-tree-visualizer-map [remap forward-char]
847 'undo-tree-visualize-switch-branch-right)
848 (define-key undo-tree-visualizer-map [remap backward-char]
849 'undo-tree-visualize-switch-branch-left)
850 (define-key undo-tree-visualizer-map [right]
851 'undo-tree-visualize-switch-branch-right)
852 (define-key undo-tree-visualizer-map "f"
853 'undo-tree-visualize-switch-branch-right)
854 (define-key undo-tree-visualizer-map "\C-f"
855 'undo-tree-visualize-switch-branch-right)
856 (define-key undo-tree-visualizer-map [left]
857 'undo-tree-visualize-switch-branch-left)
858 (define-key undo-tree-visualizer-map "b"
859 'undo-tree-visualize-switch-branch-left)
860 (define-key undo-tree-visualizer-map "\C-b"
861 'undo-tree-visualize-switch-branch-left)
862 ;; mouse sets buffer state to node at click
863 (define-key undo-tree-visualizer-map [mouse-1]
864 'undo-tree-visualizer-mouse-set)
866 (define-key undo-tree-visualizer-map "t"
867 'undo-tree-visualizer-toggle-timestamps)
869 (define-key undo-tree-visualizer-map "s"
870 'undo-tree-visualizer-selection-mode)
871 ;; horizontal scrolling may be needed if the tree is very wide
872 (define-key undo-tree-visualizer-map ","
873 'undo-tree-visualizer-scroll-left)
874 (define-key undo-tree-visualizer-map "."
875 'undo-tree-visualizer-scroll-right)
876 (define-key undo-tree-visualizer-map "<"
877 'undo-tree-visualizer-scroll-left)
878 (define-key undo-tree-visualizer-map ">"
879 'undo-tree-visualizer-scroll-right)
880 ;; vertical scrolling may be needed if the tree is very tall
881 (define-key undo-tree-visualizer-map [next] 'scroll-up)
882 (define-key undo-tree-visualizer-map [prior] 'scroll-down)
884 (define-key undo-tree-visualizer-map "q"
885 'undo-tree-visualizer-quit)
886 (define-key undo-tree-visualizer-map "\C-q"
887 'undo-tree-visualizer-quit))
890 (unless undo-tree-visualizer-selection-map
891 (setq undo-tree-visualizer-selection-map (make-keymap))
892 ;; vertical motion keys move up and down tree
893 (define-key undo-tree-visualizer-selection-map [remap previous-line]
894 'undo-tree-visualizer-select-previous)
895 (define-key undo-tree-visualizer-selection-map [remap next-line]
896 'undo-tree-visualizer-select-next)
897 (define-key undo-tree-visualizer-selection-map [up]
898 'undo-tree-visualizer-select-previous)
899 (define-key undo-tree-visualizer-selection-map "p"
900 'undo-tree-visualizer-select-previous)
901 (define-key undo-tree-visualizer-selection-map "\C-p"
902 'undo-tree-visualizer-select-previous)
903 (define-key undo-tree-visualizer-selection-map [down]
904 'undo-tree-visualizer-select-next)
905 (define-key undo-tree-visualizer-selection-map "n"
906 'undo-tree-visualizer-select-next)
907 (define-key undo-tree-visualizer-selection-map "\C-n"
908 'undo-tree-visualizer-select-next)
909 ;; vertical scroll keys move up and down quickly
910 (define-key undo-tree-visualizer-selection-map [next]
911 (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
912 (define-key undo-tree-visualizer-selection-map [prior]
913 (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
914 ;; horizontal motion keys move to left and right siblings
915 (define-key undo-tree-visualizer-selection-map [remap forward-char]
916 'undo-tree-visualizer-select-right)
917 (define-key undo-tree-visualizer-selection-map [remap backward-char]
918 'undo-tree-visualizer-select-left)
919 (define-key undo-tree-visualizer-selection-map [right]
920 'undo-tree-visualizer-select-right)
921 (define-key undo-tree-visualizer-selection-map "f"
922 'undo-tree-visualizer-select-right)
923 (define-key undo-tree-visualizer-selection-map "\C-f"
924 'undo-tree-visualizer-select-right)
925 (define-key undo-tree-visualizer-selection-map [left]
926 'undo-tree-visualizer-select-left)
927 (define-key undo-tree-visualizer-selection-map "b"
928 'undo-tree-visualizer-select-left)
929 (define-key undo-tree-visualizer-selection-map "\C-b"
930 'undo-tree-visualizer-select-left)
931 ;; horizontal scroll keys move left or right quickly
932 (define-key undo-tree-visualizer-selection-map ","
933 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
934 (define-key undo-tree-visualizer-selection-map "."
935 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
936 (define-key undo-tree-visualizer-selection-map "<"
937 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
938 (define-key undo-tree-visualizer-selection-map ">"
939 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
940 ;; mouse or <enter> sets buffer state to node at point/click
941 (define-key undo-tree-visualizer-selection-map "\r"
942 'undo-tree-visualizer-set)
943 (define-key undo-tree-visualizer-selection-map [mouse-1]
944 'undo-tree-visualizer-mouse-set)
946 (define-key undo-tree-visualizer-selection-map "t"
947 'undo-tree-visualizer-toggle-timestamps)
948 ;; quit visualizer selection mode
949 (define-key undo-tree-visualizer-selection-map "s"
950 'undo-tree-visualizer-mode)
952 (define-key undo-tree-visualizer-selection-map "q"
953 'undo-tree-visualizer-quit)
954 (define-key undo-tree-visualizer-selection-map "\C-q"
955 'undo-tree-visualizer-quit))
960 ;;; =====================================================================
961 ;;; Undo-tree data structure
967 (:constructor make-undo-tree
969 (root (make-undo-tree-node nil nil))
972 (object-pool (make-hash-table :test 'eq :weakness 'value))))
974 root current size object-pool)
980 (:type vector) ; create unnamed struct
982 (:constructor make-undo-tree-node
986 (timestamp (current-time))
988 (:constructor make-undo-tree-node-backwards
992 (next (list next-node))
993 (timestamp (current-time))
996 previous next undo redo timestamp branch meta-data)
999 (defmacro undo-tree-node-p (n)
1000 (let ((len (length (make-undo-tree-node nil nil))))
1001 `(and (vectorp ,n) (= (length ,n) ,len))))
1006 (undo-tree-region-data
1007 (:type vector) ; create unnamed struct
1009 (:constructor make-undo-tree-region-data
1010 (&optional undo-beginning undo-end
1011 redo-beginning redo-end))
1012 (:constructor make-undo-tree-undo-region-data
1013 (undo-beginning undo-end))
1014 (:constructor make-undo-tree-redo-region-data
1015 (redo-beginning redo-end))
1017 undo-beginning undo-end redo-beginning redo-end)
1020 (defmacro undo-tree-region-data-p (r)
1021 (let ((len (length (make-undo-tree-region-data))))
1022 `(and (vectorp ,r) (= (length ,r) ,len))))
1024 (defmacro undo-tree-node-clear-region-data (node)
1025 `(setf (undo-tree-node-meta-data ,node)
1028 (plist-put (undo-tree-node-meta-data ,node)
1032 (defmacro undo-tree-node-undo-beginning (node)
1033 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1034 (when (undo-tree-region-data-p r)
1035 (undo-tree-region-data-undo-beginning r))))
1037 (defmacro undo-tree-node-undo-end (node)
1038 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1039 (when (undo-tree-region-data-p r)
1040 (undo-tree-region-data-undo-end r))))
1042 (defmacro undo-tree-node-redo-beginning (node)
1043 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1044 (when (undo-tree-region-data-p r)
1045 (undo-tree-region-data-redo-beginning r))))
1047 (defmacro undo-tree-node-redo-end (node)
1048 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1049 (when (undo-tree-region-data-p r)
1050 (undo-tree-region-data-redo-end r))))
1053 (defsetf undo-tree-node-undo-beginning (node) (val)
1054 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1055 (unless (undo-tree-region-data-p r)
1056 (setf (undo-tree-node-meta-data ,node)
1057 (plist-put (undo-tree-node-meta-data ,node) :region
1058 (setq r (make-undo-tree-region-data)))))
1059 (setf (undo-tree-region-data-undo-beginning r) ,val)))
1061 (defsetf undo-tree-node-undo-end (node) (val)
1062 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1063 (unless (undo-tree-region-data-p r)
1064 (setf (undo-tree-node-meta-data ,node)
1065 (plist-put (undo-tree-node-meta-data ,node) :region
1066 (setq r (make-undo-tree-region-data)))))
1067 (setf (undo-tree-region-data-undo-end r) ,val)))
1069 (defsetf undo-tree-node-redo-beginning (node) (val)
1070 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1071 (unless (undo-tree-region-data-p r)
1072 (setf (undo-tree-node-meta-data ,node)
1073 (plist-put (undo-tree-node-meta-data ,node) :region
1074 (setq r (make-undo-tree-region-data)))))
1075 (setf (undo-tree-region-data-redo-beginning r) ,val)))
1077 (defsetf undo-tree-node-redo-end (node) (val)
1078 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1079 (unless (undo-tree-region-data-p r)
1080 (setf (undo-tree-node-meta-data ,node)
1081 (plist-put (undo-tree-node-meta-data ,node) :region
1082 (setq r (make-undo-tree-region-data)))))
1083 (setf (undo-tree-region-data-redo-end r) ,val)))
1088 (undo-tree-visualizer-data
1089 (:type vector) ; create unnamed struct
1091 (:constructor make-undo-tree-visualizer-data
1092 (&optional lwidth cwidth rwidth marker))
1094 lwidth cwidth rwidth marker)
1097 (defmacro undo-tree-visualizer-data-p (v)
1098 (let ((len (length (make-undo-tree-visualizer-data))))
1099 `(and (vectorp ,v) (= (length ,v) ,len))))
1101 (defmacro undo-tree-node-clear-visualizer-data (node)
1102 `(setf (undo-tree-node-meta-data ,node)
1105 (plist-put (undo-tree-node-meta-data ,node)
1106 :visualizer nil)))))
1109 (defmacro undo-tree-node-lwidth (node)
1110 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1111 (when (undo-tree-visualizer-data-p v)
1112 (undo-tree-visualizer-data-lwidth v))))
1114 (defmacro undo-tree-node-cwidth (node)
1115 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1116 (when (undo-tree-visualizer-data-p v)
1117 (undo-tree-visualizer-data-cwidth v))))
1119 (defmacro undo-tree-node-rwidth (node)
1120 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1121 (when (undo-tree-visualizer-data-p v)
1122 (undo-tree-visualizer-data-rwidth v))))
1124 (defmacro undo-tree-node-marker (node)
1125 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1126 (when (undo-tree-visualizer-data-p v)
1127 (undo-tree-visualizer-data-marker v))))
1130 (defsetf undo-tree-node-lwidth (node) (val)
1131 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1132 (unless (undo-tree-visualizer-data-p v)
1133 (setf (undo-tree-node-meta-data ,node)
1134 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1135 (setq v (make-undo-tree-visualizer-data)))))
1136 (setf (undo-tree-visualizer-data-lwidth v) ,val)))
1138 (defsetf undo-tree-node-cwidth (node) (val)
1139 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1140 (unless (undo-tree-visualizer-data-p v)
1141 (setf (undo-tree-node-meta-data ,node)
1142 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1143 (setq v (make-undo-tree-visualizer-data)))))
1144 (setf (undo-tree-visualizer-data-cwidth v) ,val)))
1146 (defsetf undo-tree-node-rwidth (node) (val)
1147 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1148 (unless (undo-tree-visualizer-data-p v)
1149 (setf (undo-tree-node-meta-data ,node)
1150 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1151 (setq v (make-undo-tree-visualizer-data)))))
1152 (setf (undo-tree-visualizer-data-rwidth v) ,val)))
1154 (defsetf undo-tree-node-marker (node) (val)
1155 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1156 (unless (undo-tree-visualizer-data-p v)
1157 (setf (undo-tree-node-meta-data ,node)
1158 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1159 (setq v (make-undo-tree-visualizer-data)))))
1160 (setf (undo-tree-visualizer-data-marker v) ,val)))
1164 (defmacro undo-tree-node-register (node)
1165 `(plist-get (undo-tree-node-meta-data ,node) :register))
1167 (defsetf undo-tree-node-register (node) (val)
1168 `(setf (undo-tree-node-meta-data ,node)
1169 (plist-put (undo-tree-node-meta-data ,node) :register ,val)))
1174 ;;; =====================================================================
1175 ;;; Basic undo-tree data structure functions
1177 (defun undo-tree-grow (undo)
1178 "Add an UNDO node to current branch of `buffer-undo-tree'."
1179 (let* ((current (undo-tree-current buffer-undo-tree))
1180 (new (make-undo-tree-node current undo)))
1181 (push new (undo-tree-node-next current))
1182 (setf (undo-tree-current buffer-undo-tree) new)))
1185 (defun undo-tree-grow-backwards (node undo &optional redo)
1186 "Add new node *above* undo-tree NODE, and return new node.
1187 Note that this will overwrite NODE's \"previous\" link, so should
1188 only be used on a detached NODE, never on nodes that are already
1189 part of `buffer-undo-tree'."
1190 (let ((new (make-undo-tree-node-backwards node undo redo)))
1191 (setf (undo-tree-node-previous node) new)
1195 (defun undo-tree-splice-node (node splice)
1196 "Splice NODE into undo tree, below node SPLICE.
1197 Note that this will overwrite NODE's \"next\" and \"previous\"
1198 links, so should only be used on a detached NODE, never on nodes
1199 that are already part of `buffer-undo-tree'."
1200 (setf (undo-tree-node-next node) (undo-tree-node-next splice)
1201 (undo-tree-node-branch node) (undo-tree-node-branch splice)
1202 (undo-tree-node-previous node) splice
1203 (undo-tree-node-next splice) (list node)
1204 (undo-tree-node-branch splice) 0)
1205 (dolist (n (undo-tree-node-next node))
1206 (setf (undo-tree-node-previous n) node)))
1209 (defun undo-tree-snip-node (node)
1210 "Snip NODE out of undo tree."
1211 (let* ((parent (undo-tree-node-previous node))
1213 ;; if NODE is only child, replace parent's next links with NODE's
1214 (if (= (length (undo-tree-node-next parent)) 0)
1215 (setf (undo-tree-node-next parent) (undo-tree-node-next node)
1216 (undo-tree-node-branch parent) (undo-tree-node-branch node))
1218 (setq position (undo-tree-position node (undo-tree-node-next parent)))
1220 ;; if active branch used do go via NODE, set parent's branch to active
1222 ((= (undo-tree-node-branch parent) position)
1223 (setf (undo-tree-node-branch parent)
1224 (+ position (undo-tree-node-branch node))))
1225 ;; if active branch didn't go via NODE, update parent's branch to point
1226 ;; to same node as before
1227 ((> (undo-tree-node-branch parent) position)
1228 (incf (undo-tree-node-branch parent)
1229 (1- (length (undo-tree-node-next node))))))
1230 ;; replace NODE in parent's next list with NODE's entire next list
1232 (setf (undo-tree-node-next parent)
1233 (nconc (undo-tree-node-next node)
1234 (cdr (undo-tree-node-next parent))))
1235 (setq p (nthcdr (1- position) (undo-tree-node-next parent)))
1236 (setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
1237 ;; update previous links of NODE's children
1238 (dolist (n (undo-tree-node-next node))
1239 (setf (undo-tree-node-previous n) parent))))
1242 (defun undo-tree-mapc (--undo-tree-mapc-function-- undo-tree)
1243 ;; Apply FUNCTION to each node in UNDO-TREE.
1244 (let ((stack (list (undo-tree-root undo-tree)))
1247 (setq node (pop stack))
1248 (funcall --undo-tree-mapc-function-- node)
1249 (setq stack (append (undo-tree-node-next node) stack)))))
1252 (defmacro undo-tree-num-branches ()
1253 "Return number of branches at current undo tree node."
1254 '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
1257 (defun undo-tree-position (node list)
1258 "Find the first occurrence of NODE in LIST.
1259 Return the index of the matching item, or nil of not found.
1260 Comparison is done with `eq'."
1264 (when (eq node (car list)) (throw 'found i))
1266 (setq list (cdr list))))
1270 (defvar *undo-tree-id-counter* 0)
1271 (make-variable-buffer-local '*undo-tree-id-counter*)
1273 (defmacro undo-tree-generate-id ()
1274 ;; Generate a new, unique id (uninterned symbol).
1275 ;; The name is made by appending a number to "undo-tree-id".
1276 ;; (Copied from CL package `gensym'.)
1277 `(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*))))
1278 (make-symbol (format "undo-tree-id%d" num))))
1283 ;;; =====================================================================
1284 ;;; Utility functions for handling `buffer-undo-list' and changesets
1286 (defmacro undo-list-marker-elt-p (elt)
1287 `(markerp (car-safe ,elt)))
1289 (defmacro undo-list-GCd-marker-elt-p (elt)
1290 `(and (symbolp (car-safe ,elt)) (numberp (cdr-safe ,elt))))
1293 (defun undo-tree-move-GC-elts-to-pool (elt)
1294 ;; Move elements that can be garbage-collected into `buffer-undo-tree'
1295 ;; object pool, substituting a unique id that can be used to retrieve them
1296 ;; later. (Only markers require this treatment currently.)
1297 (when (undo-list-marker-elt-p elt)
1298 (let ((id (undo-tree-generate-id)))
1299 (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
1303 (defun undo-tree-restore-GC-elts-from-pool (elt)
1304 ;; Replace object id's in ELT with corresponding objects from
1305 ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
1306 ;; any object in ELT has been garbage-collected.
1307 (if (undo-list-GCd-marker-elt-p elt)
1308 (when (setcar elt (gethash (car elt)
1309 (undo-tree-object-pool buffer-undo-tree)))
1314 (defun undo-list-clean-GCd-elts (undo-list)
1315 ;; Remove object id's from UNDO-LIST that refer to elements that have been
1316 ;; garbage-collected. UNDO-LIST is modified by side-effect.
1317 (while (undo-list-GCd-marker-elt-p (car undo-list))
1318 (unless (gethash (caar undo-list)
1319 (undo-tree-object-pool buffer-undo-tree))
1320 (setq undo-list (cdr undo-list))))
1321 (let ((p undo-list))
1323 (when (and (undo-list-GCd-marker-elt-p (cadr p))
1324 (null (gethash (car (cadr p))
1325 (undo-tree-object-pool buffer-undo-tree))))
1326 (setcdr p (cddr p)))
1331 (defun undo-list-pop-changeset (&optional discard-pos)
1332 ;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
1333 ;; any position entries from changeset.
1335 ;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
1336 ;; at head of undo list
1337 (while (or (null (car buffer-undo-list))
1338 (and discard-pos (integerp (car buffer-undo-list))))
1339 (setq buffer-undo-list (cdr buffer-undo-list)))
1340 ;; pop elements up to next undo boundary
1341 (unless (eq (car buffer-undo-list) 'undo-tree-canary)
1342 (let* ((changeset (list (pop buffer-undo-list)))
1345 (undo-tree-move-GC-elts-to-pool (car p))
1346 (car buffer-undo-list))
1347 ;; discard position entries at head of undo list
1349 (while (and discard-pos (integerp (car buffer-undo-list)))
1350 (setq buffer-undo-list (cdr buffer-undo-list))))
1351 (setcdr p (list (pop buffer-undo-list)))
1356 (defun undo-tree-copy-list (undo-list)
1357 ;; Return a deep copy of first changeset in `undo-list'. Object id's are
1358 ;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
1361 ;; if first element contains an object id, replace it with object from
1362 ;; pool, discarding element entirely if it's been GC'd
1365 (undo-tree-restore-GC-elts-from-pool (pop undo-list))))
1366 (setq copy (list copy)
1368 ;; copy remaining elements, replacing object id's with objects from
1369 ;; pool, or discarding them entirely if they've been GC'd
1371 (when (setcdr p (undo-tree-restore-GC-elts-from-pool
1372 (undo-copy-list-1 (pop undo-list))))
1373 (setcdr p (list (cdr p)))
1379 (defun undo-list-transfer-to-tree ()
1380 ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
1382 ;; if `buffer-undo-tree' is empty, create initial undo-tree
1383 (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
1384 ;; make sure there's a canary at end of `buffer-undo-list'
1385 (if (null buffer-undo-list)
1386 (setq buffer-undo-list '(nil undo-tree-canary))
1387 (let ((elt (last buffer-undo-list)))
1388 (unless (eq (car elt) 'undo-tree-canary)
1389 (setcdr elt '(nil undo-tree-canary)))))
1391 (unless (eq (cadr buffer-undo-list) 'undo-tree-canary)
1392 ;; create new node from first changeset in `buffer-undo-list', save old
1393 ;; `buffer-undo-tree' current node, and make new node the current node
1394 (let* ((node (make-undo-tree-node nil (undo-list-pop-changeset)))
1395 (splice (undo-tree-current buffer-undo-tree))
1396 (size (undo-list-byte-size (undo-tree-node-undo node))))
1397 (setf (undo-tree-current buffer-undo-tree) node)
1398 ;; grow tree fragment backwards using `buffer-undo-list' changesets
1399 (while (and buffer-undo-list
1400 (not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
1402 (undo-tree-grow-backwards node (undo-list-pop-changeset)))
1403 (incf size (undo-list-byte-size (undo-tree-node-undo node))))
1404 ;; if no undo history has been discarded from `buffer-undo-list' since
1405 ;; last transfer, splice new tree fragment onto end of old
1406 ;; `buffer-undo-tree' current node
1407 (if (eq (cadr buffer-undo-list) 'undo-tree-canary)
1409 (setf (undo-tree-node-previous node) splice)
1410 (push node (undo-tree-node-next splice))
1411 (setf (undo-tree-node-branch splice) 0)
1412 (incf (undo-tree-size buffer-undo-tree) size))
1413 ;; if undo history has been discarded, replace entire
1414 ;; `buffer-undo-tree' with new tree fragment
1415 (setq node (undo-tree-grow-backwards node nil))
1416 (setf (undo-tree-root buffer-undo-tree) node)
1417 (setq buffer-undo-list '(nil undo-tree-canary))
1418 (setf (undo-tree-size buffer-undo-tree) size)))
1419 ;; discard undo history if necessary
1420 (undo-tree-discard-history)))
1423 (defun undo-list-byte-size (undo-list)
1424 ;; Return size (in bytes) of UNDO-LIST
1425 (let ((size 0) (p undo-list))
1427 (incf size 8) ; cons cells use up 8 bytes
1428 (when (and (consp (car p)) (stringp (caar p)))
1429 (incf size (string-bytes (caar p))))
1435 (defun undo-list-rebuild-from-tree ()
1436 "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
1437 (unless (eq buffer-undo-list t)
1438 (undo-list-transfer-to-tree)
1439 (setq buffer-undo-list nil)
1440 (when buffer-undo-tree
1441 (let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
1442 (push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
1444 (time-less-p (undo-tree-node-timestamp a)
1445 (undo-tree-node-timestamp b))))
1447 ;; Traverse tree in depth-and-oldest-first order, but add undo records
1448 ;; on the way down, and redo records on the way up.
1449 (while (or (car stack)
1450 (not (eq (car (nth 1 stack))
1451 (undo-tree-current buffer-undo-tree))))
1454 (setq buffer-undo-list
1455 (append (undo-tree-node-undo (caar stack))
1458 (push (sort (mapcar 'identity
1459 (undo-tree-node-next (caar stack)))
1461 (time-less-p (undo-tree-node-timestamp a)
1462 (undo-tree-node-timestamp b))))
1465 (setq buffer-undo-list
1466 (append (undo-tree-node-redo (caar stack))
1469 (pop (car stack))))))))
1474 ;;; =====================================================================
1475 ;;; History discarding functions
1477 (defun undo-tree-oldest-leaf (node)
1478 ;; Return oldest leaf node below NODE.
1479 (while (undo-tree-node-next node)
1481 (car (sort (mapcar 'identity (undo-tree-node-next node))
1483 (time-less-p (undo-tree-node-timestamp a)
1484 (undo-tree-node-timestamp b)))))))
1488 (defun undo-tree-discard-node (node)
1489 ;; Discard NODE from `buffer-undo-tree', and return next in line for
1492 ;; don't discard current node
1493 (unless (eq node (undo-tree-current buffer-undo-tree))
1495 ;; discarding root node...
1496 (if (eq node (undo-tree-root buffer-undo-tree))
1498 ;; should always discard branches before root
1499 ((> (length (undo-tree-node-next node)) 1)
1500 (error "Trying to discard undo-tree root which still\
1501 has multiple branches"))
1502 ;; don't discard root if current node is only child
1503 ((eq (car (undo-tree-node-next node))
1504 (undo-tree-current buffer-undo-tree))
1508 ;; make child of root into new root
1509 (setq node (setf (undo-tree-root buffer-undo-tree)
1510 (car (undo-tree-node-next node))))
1511 ;; update undo-tree size
1512 (decf (undo-tree-size buffer-undo-tree)
1513 (+ (undo-list-byte-size (undo-tree-node-undo node))
1514 (undo-list-byte-size (undo-tree-node-redo node))))
1515 ;; discard new root's undo data
1516 (setf (undo-tree-node-undo node) nil
1517 (undo-tree-node-redo node) nil)
1518 ;; if new root has branches, or new root is current node, next node
1519 ;; to discard is oldest leaf, otherwise it's new root
1520 (if (or (> (length (undo-tree-node-next node)) 1)
1521 (eq (car (undo-tree-node-next node))
1522 (undo-tree-current buffer-undo-tree)))
1523 (undo-tree-oldest-leaf node)
1526 ;; discarding leaf node...
1527 (let* ((parent (undo-tree-node-previous node))
1528 (current (nth (undo-tree-node-branch parent)
1529 (undo-tree-node-next parent))))
1530 ;; update undo-tree size
1531 (decf (undo-tree-size buffer-undo-tree)
1532 (+ (undo-list-byte-size (undo-tree-node-undo node))
1533 (undo-list-byte-size (undo-tree-node-redo node))))
1534 (setf (undo-tree-node-next parent)
1535 (delq node (undo-tree-node-next parent))
1536 (undo-tree-node-branch parent)
1537 (undo-tree-position current (undo-tree-node-next parent)))
1538 ;; if parent has branches, or parent is current node, next node to
1539 ;; discard is oldest leaf, otherwise it's parent
1540 (if (or (eq parent (undo-tree-current buffer-undo-tree))
1541 (and (undo-tree-node-next parent)
1542 (or (not (eq parent (undo-tree-root buffer-undo-tree)))
1543 (> (length (undo-tree-node-next parent)) 1))))
1544 (undo-tree-oldest-leaf parent)
1549 (defun undo-tree-discard-history ()
1550 "Discard undo history until we're within memory usage limits
1551 set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
1553 (when (> (undo-tree-size buffer-undo-tree) undo-limit)
1554 ;; if there are no branches off root, first node to discard is root;
1555 ;; otherwise it's leaf node at botom of oldest branch
1556 (let ((node (if (> (length (undo-tree-node-next
1557 (undo-tree-root buffer-undo-tree))) 1)
1558 (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
1559 (undo-tree-root buffer-undo-tree))))
1561 ;; discard nodes until memory use is within `undo-strong-limit'
1563 (> (undo-tree-size buffer-undo-tree) undo-strong-limit))
1564 (setq node (undo-tree-discard-node node)))
1566 ;; discard nodes until next node to discard would bring memory use
1567 ;; within `undo-limit'
1569 ;; check first if last discard has brought us within
1570 ;; `undo-limit', in case we can avoid more expensive
1571 ;; `undo-strong-limit' calculation
1572 ;; Note: this assumes undo-strong-limit > undo-limit;
1573 ;; if not, effectively undo-strong-limit = undo-limit
1574 (> (undo-tree-size buffer-undo-tree) undo-limit)
1575 (> (- (undo-tree-size buffer-undo-tree)
1576 ;; if next node to discard is root, the memory we
1577 ;; free-up comes from discarding changesets from its
1579 (if (eq node (undo-tree-root buffer-undo-tree))
1580 (+ (undo-list-byte-size
1581 (undo-tree-node-undo
1582 (car (undo-tree-node-next node))))
1583 (undo-list-byte-size
1584 (undo-tree-node-redo
1585 (car (undo-tree-node-next node)))))
1586 ;; ...otherwise, it comes from discarding changesets
1587 ;; from along with the node itself
1588 (+ (undo-list-byte-size (undo-tree-node-undo node))
1589 (undo-list-byte-size (undo-tree-node-redo node)))
1592 (setq node (undo-tree-discard-node node)))
1594 ;; if we're still over the `undo-outer-limit', discard entire history
1595 (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
1596 ;; query first if `undo-ask-before-discard' is set
1597 (if undo-ask-before-discard
1600 "Buffer `%s' undo info is %d bytes long; discard it? "
1601 (buffer-name) (undo-tree-size buffer-undo-tree)))
1602 (setq buffer-undo-tree nil))
1603 ;; otherwise, discard and display warning
1605 '(undo discard-info)
1607 (format "Buffer `%s' undo info was %d bytes long.\n"
1608 (buffer-name) (undo-tree-size buffer-undo-tree))
1609 "The undo info was discarded because it exceeded\
1612 This is normal if you executed a command that made a huge change
1613 to the buffer. In that case, to prevent similar problems in the
1614 future, set `undo-outer-limit' to a value that is large enough to
1615 cover the maximum size of normal changes you expect a single
1616 command to make, but not so large that it might exceed the
1617 maximum memory allotted to Emacs.
1619 If you did not execute any such command, the situation is
1620 probably due to a bug and you should report it.
1622 You can disable the popping up of this buffer by adding the entry
1623 \(undo discard-info) to the user option `warning-suppress-types',
1624 which is defined in the `warnings' library.\n")
1626 (setq buffer-undo-tree nil)))
1632 ;;; =====================================================================
1633 ;;; Visualizer-related functions
1635 (defun undo-tree-compute-widths (undo-tree)
1636 "Recursively compute widths for all UNDO-TREE's nodes."
1637 (let ((stack (list (undo-tree-root undo-tree)))
1640 ;; try to compute widths for node at top of stack
1641 (if (undo-tree-node-p
1642 (setq res (undo-tree-node-compute-widths (car stack))))
1643 ;; if computation fails, it returns a node whose widths still need
1644 ;; computing, which we push onto the stack
1646 ;; otherwise, store widths and remove it from stack
1647 (setf (undo-tree-node-lwidth (car stack)) (aref res 0)
1648 (undo-tree-node-cwidth (car stack)) (aref res 1)
1649 (undo-tree-node-rwidth (car stack)) (aref res 2))
1653 (defun undo-tree-node-compute-widths (node)
1654 ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
1655 ;; (in a vector) if successful. Otherwise, returns a node whose widths need
1656 ;; calculating before NODE's can be calculated.
1657 (let ((num-children (length (undo-tree-node-next node)))
1658 (lwidth 0) (cwidth 0) (rwidth 0)
1662 ;; leaf nodes have 0 width
1665 (undo-tree-node-lwidth node) 0
1666 (undo-tree-node-cwidth node) 1
1667 (undo-tree-node-rwidth node) 0))
1669 ;; odd number of children
1670 ((= (mod num-children 2) 1)
1671 (setq p (undo-tree-node-next node))
1672 ;; compute left-width
1673 (dotimes (i (/ num-children 2))
1674 (if (undo-tree-node-lwidth (car p))
1675 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1676 (undo-tree-node-cwidth (car p))
1677 (undo-tree-node-rwidth (car p))))
1678 ;; if child's widths haven't been computed, return that child
1679 (throw 'need-widths (car p)))
1681 (if (undo-tree-node-lwidth (car p))
1682 (incf lwidth (undo-tree-node-lwidth (car p)))
1683 (throw 'need-widths (car p)))
1684 ;; centre-width is inherited from middle child
1685 (setf cwidth (undo-tree-node-cwidth (car p)))
1686 ;; compute right-width
1687 (incf rwidth (undo-tree-node-rwidth (car p)))
1689 (dotimes (i (/ num-children 2))
1690 (if (undo-tree-node-lwidth (car p))
1691 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1692 (undo-tree-node-cwidth (car p))
1693 (undo-tree-node-rwidth (car p))))
1694 (throw 'need-widths (car p)))
1697 ;; even number of children
1699 (setq p (undo-tree-node-next node))
1700 ;; compute left-width
1701 (dotimes (i (/ num-children 2))
1702 (if (undo-tree-node-lwidth (car p))
1703 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1704 (undo-tree-node-cwidth (car p))
1705 (undo-tree-node-rwidth (car p))))
1706 (throw 'need-widths (car p)))
1708 ;; centre-width is 0 when number of children is even
1710 ;; compute right-width
1711 (dotimes (i (/ num-children 2))
1712 (if (undo-tree-node-lwidth (car p))
1713 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1714 (undo-tree-node-cwidth (car p))
1715 (undo-tree-node-rwidth (car p))))
1716 (throw 'need-widths (car p)))
1719 ;; return left-, centre- and right-widths
1720 (vector lwidth cwidth rwidth))))
1723 (defun undo-tree-clear-visualizer-data (undo-tree)
1724 ;; Clear visualizer data from UNDO-TREE.
1726 (lambda (node) (undo-tree-node-clear-visualizer-data node))
1732 ;;; =====================================================================
1733 ;;; Undo-in-region functions
1735 (defun undo-tree-pull-undo-in-region-branch (start end)
1736 ;; Pull out entries from undo changesets to create a new undo-in-region
1737 ;; branch, which undoes changeset entries lying between START and END first,
1738 ;; followed by remaining entries from the changesets, before rejoining the
1739 ;; existing undo tree history. Repeated calls will, if appropriate, extend
1740 ;; the current undo-in-region branch rather than creating a new one.
1742 ;; if we're just reverting the last redo-in-region, we don't need to
1743 ;; manipulate the undo tree at all
1744 (if (undo-tree-reverting-redo-in-region-p start end)
1745 t ; return t to indicate success
1747 ;; We build the `region-changeset' and `delta-list' lists forwards, using
1748 ;; pointers `r' and `d' to the penultimate element of the list. So that we
1749 ;; don't have to treat the first element differently, we prepend a dummy
1750 ;; leading nil to the lists, and have the pointers point to that
1752 ;; Note: using '(nil) instead of (list nil) in the `let*' results in
1753 ;; bizarre errors when the code is byte-compiled, where parts of the
1754 ;; lists appear to survive across different calls to this function.
1755 ;; An obscure byte-compiler bug, perhaps?
1756 (let* ((region-changeset (list nil))
1757 (r region-changeset)
1758 (delta-list (list nil))
1760 (node (undo-tree-current buffer-undo-tree))
1761 (repeated-undo-in-region
1762 (undo-tree-repeated-undo-in-region-p start end))
1763 undo-adjusted-markers ; `undo-elt-in-region' expects this
1764 fragment splice original-fragment original-splice original-current
1765 got-visible-elt undo-list elt)
1767 ;; --- initialisation ---
1769 ;; if this is a repeated undo in the same region, start pulling changes
1770 ;; from NODE at which undo-in-region branch iss attached, and detatch
1771 ;; the branch, using it as initial FRAGMENT of branch being constructed
1772 (repeated-undo-in-region
1773 (setq original-current node
1774 fragment (car (undo-tree-node-next node))
1776 ;; undo up to node at which undo-in-region branch is attached
1777 ;; (recognizable as first node with more than one branch)
1778 (let ((mark-active nil))
1779 (while (= (length (undo-tree-node-next node)) 1)
1782 node (undo-tree-current buffer-undo-tree))))
1783 (when (eq splice node) (setq splice nil))
1784 ;; detatch undo-in-region branch
1785 (setf (undo-tree-node-next node)
1786 (delq fragment (undo-tree-node-next node))
1787 (undo-tree-node-previous fragment) nil
1788 original-fragment fragment
1789 original-splice node))
1791 ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
1792 ;; nodes below the current one in the active branch
1793 ((undo-tree-node-next node)
1794 (setq fragment (make-undo-tree-node nil nil)
1796 (while (setq node (nth (undo-tree-node-branch node)
1797 (undo-tree-node-next node)))
1798 (push (make-undo-tree-node
1800 (undo-copy-list (undo-tree-node-undo node))
1801 (undo-copy-list (undo-tree-node-redo node)))
1802 (undo-tree-node-next splice))
1803 (setq splice (car (undo-tree-node-next splice))))
1804 (setq fragment (car (undo-tree-node-next fragment))
1806 node (undo-tree-current buffer-undo-tree))))
1809 ;; --- pull undo-in-region elements into branch ---
1810 ;; work backwards up tree, pulling out undo elements within region until
1811 ;; we've got one that undoes a visible change (insertion or deletion)
1813 (while (and (not got-visible-elt) node (undo-tree-node-undo node))
1814 ;; we cons a dummy nil element on the front of the changeset so that
1815 ;; we can conveniently remove the first (real) element from the
1816 ;; changeset if we need to; the leading nil is removed once we're
1817 ;; done with this changeset
1818 (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
1819 elt (cadr undo-list))
1822 (setq fragment (undo-tree-grow-backwards fragment undo-list))
1823 (unless splice (setq splice fragment)))
1824 (setq fragment (make-undo-tree-node nil undo-list))
1825 (setq splice fragment))
1829 ;; keep elements within region
1830 ((undo-elt-in-region elt start end)
1831 ;; set flag if kept element is visible (insertion or deletion)
1832 (when (and (consp elt)
1833 (or (stringp (car elt)) (integerp (car elt))))
1834 (setq got-visible-elt t))
1835 ;; adjust buffer positions in elements previously undone before
1836 ;; kept element, as kept element will now be undone first
1837 (undo-tree-adjust-elements-to-elt splice elt)
1838 ;; move kept element to undo-in-region changeset, adjusting its
1839 ;; buffer position as it will now be undone first
1840 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
1842 (setcdr undo-list (cddr undo-list)))
1844 ;; discard "was unmodified" elements
1845 ;; FIXME: deal properly with these
1846 ((and (consp elt) (eq (car elt) t))
1847 (setcdr undo-list (cddr undo-list)))
1849 ;; if element crosses region, we can't pull any more elements
1850 ((undo-elt-crosses-region elt start end)
1851 ;; if we've found a visible element, it must be earlier in
1852 ;; current node's changeset; stop pulling elements (null
1853 ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
1855 (setq undo-list nil)
1856 ;; if we haven't found a visible element yet, pulling
1857 ;; undo-in-region branch has failed
1858 (setq region-changeset nil)
1861 ;; if rejecting element, add its delta (if any) to the list
1863 (let ((delta (undo-delta elt)))
1864 (when (/= 0 (cdr delta))
1865 (setcdr d (list delta))
1867 (setq undo-list (cdr undo-list))))
1869 ;; process next element of current changeset
1870 (setq elt (cadr undo-list)))
1872 ;; if there are remaining elements in changeset, remove dummy nil
1874 (if (cadr (undo-tree-node-undo fragment))
1875 (pop (undo-tree-node-undo fragment))
1876 ;; otherwise, if we've kept all elements in changeset, discard
1878 (when (eq splice fragment) (setq splice nil))
1879 (setq fragment (car (undo-tree-node-next fragment))))
1880 ;; process changeset from next node up the tree
1881 (setq node (undo-tree-node-previous node))))
1883 ;; pop dummy nil from front of `region-changeset'
1884 (pop region-changeset)
1887 ;; --- integrate branch into tree ---
1888 ;; if no undo-in-region elements were found, restore undo tree
1889 (if (null region-changeset)
1890 (when original-current
1891 (push original-fragment (undo-tree-node-next original-splice))
1892 (setf (undo-tree-node-branch original-splice) 0
1893 (undo-tree-node-previous original-fragment) original-splice)
1894 (let ((mark-active nil))
1895 (while (not (eq (undo-tree-current buffer-undo-tree)
1898 nil) ; return nil to indicate failure
1901 ;; need to undo up to node where new branch will be attached, to
1902 ;; ensure redo entries are populated, and then redo back to where we
1904 (let ((mark-active nil)
1905 (current (undo-tree-current buffer-undo-tree)))
1906 (while (not (eq (undo-tree-current buffer-undo-tree) node))
1908 (while (not (eq (undo-tree-current buffer-undo-tree) current))
1912 ;; if there's no remaining fragment, just create undo-in-region node
1913 ;; and attach it to parent of last node from which elements were
1916 (setq fragment (make-undo-tree-node node region-changeset))
1917 (push fragment (undo-tree-node-next node))
1918 (setf (undo-tree-node-branch node) 0)
1919 ;; set current node to undo-in-region node
1920 (setf (undo-tree-current buffer-undo-tree) fragment))
1922 ;; if no splice point has been set, add undo-in-region node to top of
1923 ;; fragment and attach it to parent of last node from which elements
1926 (setq fragment (undo-tree-grow-backwards fragment region-changeset))
1927 (push fragment (undo-tree-node-next node))
1928 (setf (undo-tree-node-branch node) 0
1929 (undo-tree-node-previous fragment) node)
1930 ;; set current node to undo-in-region node
1931 (setf (undo-tree-current buffer-undo-tree) fragment))
1933 ;; if fragment contains nodes, attach fragment to parent of last node
1934 ;; from which elements were pulled, and splice in undo-in-region node
1936 (setf (undo-tree-node-previous fragment) node)
1937 (push fragment (undo-tree-node-next node))
1938 (setf (undo-tree-node-branch node) 0)
1939 ;; if this is a repeated undo-in-region, then we've left the current
1940 ;; node at the original splice-point; we need to set the current
1941 ;; node to the equivalent node on the undo-in-region branch and redo
1942 ;; back to where we started
1943 (when repeated-undo-in-region
1944 (setf (undo-tree-current buffer-undo-tree)
1945 (undo-tree-node-previous original-fragment))
1946 (let ((mark-active nil))
1947 (while (not (eq (undo-tree-current buffer-undo-tree) splice))
1948 (undo-tree-redo nil 'preserve-undo))))
1949 ;; splice new undo-in-region node into fragment
1950 (setq node (make-undo-tree-node nil region-changeset))
1951 (undo-tree-splice-node node splice)
1952 ;; set current node to undo-in-region node
1953 (setf (undo-tree-current buffer-undo-tree) node)))
1955 ;; update undo-tree size
1956 (setq node (undo-tree-node-previous fragment))
1958 (and (setq node (car (undo-tree-node-next node)))
1959 (not (eq node original-fragment))
1960 (incf (undo-tree-size buffer-undo-tree)
1961 (undo-list-byte-size (undo-tree-node-undo node)))
1962 (when (undo-tree-node-redo node)
1963 (incf (undo-tree-size buffer-undo-tree)
1964 (undo-list-byte-size (undo-tree-node-redo node))))
1966 t) ; indicate undo-in-region branch was successfully pulled
1971 (defun undo-tree-pull-redo-in-region-branch (start end)
1972 ;; Pull out entries from redo changesets to create a new redo-in-region
1973 ;; branch, which redoes changeset entries lying between START and END first,
1974 ;; followed by remaining entries from the changesets. Repeated calls will,
1975 ;; if appropriate, extend the current redo-in-region branch rather than
1976 ;; creating a new one.
1978 ;; if we're just reverting the last undo-in-region, we don't need to
1979 ;; manipulate the undo tree at all
1980 (if (undo-tree-reverting-undo-in-region-p start end)
1981 t ; return t to indicate success
1983 ;; We build the `region-changeset' and `delta-list' lists forwards, using
1984 ;; pointers `r' and `d' to the penultimate element of the list. So that we
1985 ;; don't have to treat the first element differently, we prepend a dummy
1986 ;; leading nil to the lists, and have the pointers point to that
1988 ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
1989 ;; errors when the code is byte-compiled, where parts of the lists
1990 ;; appear to survive across different calls to this function. An
1991 ;; obscure byte-compiler bug, perhaps?
1992 (let* ((region-changeset (list nil))
1993 (r region-changeset)
1994 (delta-list (list nil))
1996 (node (undo-tree-current buffer-undo-tree))
1997 (repeated-redo-in-region
1998 (undo-tree-repeated-redo-in-region-p start end))
1999 undo-adjusted-markers ; `undo-elt-in-region' expects this
2000 fragment splice got-visible-elt redo-list elt)
2002 ;; --- inisitalisation ---
2004 ;; if this is a repeated redo-in-region, detach fragment below current
2006 (repeated-redo-in-region
2007 (when (setq fragment (car (undo-tree-node-next node)))
2008 (setf (undo-tree-node-previous fragment) nil
2009 (undo-tree-node-next node)
2010 (delq fragment (undo-tree-node-next node)))))
2011 ;; if this is a new redo-in-region, initial fragment is a copy of all
2012 ;; nodes below the current one in the active branch
2013 ((undo-tree-node-next node)
2014 (setq fragment (make-undo-tree-node nil nil)
2016 (while (setq node (nth (undo-tree-node-branch node)
2017 (undo-tree-node-next node)))
2018 (push (make-undo-tree-node
2020 (undo-copy-list (undo-tree-node-redo node)))
2021 (undo-tree-node-next splice))
2022 (setq splice (car (undo-tree-node-next splice))))
2023 (setq fragment (car (undo-tree-node-next fragment)))))
2026 ;; --- pull redo-in-region elements into branch ---
2027 ;; work down fragment, pulling out redo elements within region until
2028 ;; we've got one that redoes a visible change (insertion or deletion)
2029 (setq node fragment)
2031 (while (and (not got-visible-elt) node (undo-tree-node-redo node))
2032 ;; we cons a dummy nil element on the front of the changeset so that
2033 ;; we can conveniently remove the first (real) element from the
2034 ;; changeset if we need to; the leading nil is removed once we're
2035 ;; done with this changeset
2036 (setq redo-list (push nil (undo-tree-node-redo node))
2037 elt (cadr redo-list))
2040 ;; keep elements within region
2041 ((undo-elt-in-region elt start end)
2042 ;; set flag if kept element is visible (insertion or deletion)
2043 (when (and (consp elt)
2044 (or (stringp (car elt)) (integerp (car elt))))
2045 (setq got-visible-elt t))
2046 ;; adjust buffer positions in elements previously redone before
2047 ;; kept element, as kept element will now be redone first
2048 (undo-tree-adjust-elements-to-elt fragment elt t)
2049 ;; move kept element to redo-in-region changeset, adjusting its
2050 ;; buffer position as it will now be redone first
2051 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
2053 (setcdr redo-list (cddr redo-list)))
2055 ;; discard "was unmodified" elements
2056 ;; FIXME: deal properly with these
2057 ((and (consp elt) (eq (car elt) t))
2058 (setcdr redo-list (cddr redo-list)))
2060 ;; if element crosses region, we can't pull any more elements
2061 ((undo-elt-crosses-region elt start end)
2062 ;; if we've found a visible element, it must be earlier in
2063 ;; current node's changeset; stop pulling elements (null
2064 ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
2066 (setq redo-list nil)
2067 ;; if we haven't found a visible element yet, pulling
2068 ;; redo-in-region branch has failed
2069 (setq region-changeset nil)
2072 ;; if rejecting element, add its delta (if any) to the list
2074 (let ((delta (undo-delta elt)))
2075 (when (/= 0 (cdr delta))
2076 (setcdr d (list delta))
2078 (setq redo-list (cdr redo-list))))
2080 ;; process next element of current changeset
2081 (setq elt (cadr redo-list)))
2083 ;; if there are remaining elements in changeset, remove dummy nil
2085 (if (cadr (undo-tree-node-redo node))
2086 (pop (undo-tree-node-undo node))
2087 ;; otherwise, if we've kept all elements in changeset, discard
2089 (if (eq fragment node)
2090 (setq fragment (car (undo-tree-node-next fragment)))
2091 (undo-tree-snip-node node)))
2092 ;; process changeset from next node in fragment
2093 (setq node (car (undo-tree-node-next node)))))
2095 ;; pop dummy nil from front of `region-changeset'
2096 (pop region-changeset)
2099 ;; --- integrate branch into tree ---
2100 (setq node (undo-tree-current buffer-undo-tree))
2101 ;; if no redo-in-region elements were found, restore undo tree
2102 (if (null (car region-changeset))
2103 (when (and repeated-redo-in-region fragment)
2104 (push fragment (undo-tree-node-next node))
2105 (setf (undo-tree-node-branch node) 0
2106 (undo-tree-node-previous fragment) node)
2107 nil) ; return nil to indicate failure
2109 ;; otherwise, add redo-in-region node to top of fragment, and attach
2110 ;; it below current node
2113 (undo-tree-grow-backwards fragment nil region-changeset)
2114 (make-undo-tree-node nil nil region-changeset)))
2115 (push fragment (undo-tree-node-next node))
2116 (setf (undo-tree-node-branch node) 0
2117 (undo-tree-node-previous fragment) node)
2118 ;; update undo-tree size
2119 (unless repeated-redo-in-region
2120 (setq node fragment)
2122 (and (setq node (car (undo-tree-node-next node)))
2123 (incf (undo-tree-size buffer-undo-tree)
2124 (undo-list-byte-size
2125 (undo-tree-node-redo node)))))))
2126 (incf (undo-tree-size buffer-undo-tree)
2127 (undo-list-byte-size (undo-tree-node-redo fragment)))
2128 t) ; indicate undo-in-region branch was successfully pulled
2133 (defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
2134 "Adjust buffer positions of undo elements, starting at NODE's
2135 and going up the tree (or down the active branch if BELOW is
2136 non-nil) and through the nodes' undo elements until we reach
2137 UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
2138 of either NODE itself or some node above it in the tree."
2139 (let ((delta (list (undo-delta undo-elt)))
2140 (undo-list (undo-tree-node-undo node)))
2141 ;; adjust elements until we reach UNDO-ELT
2142 (while (and (car undo-list)
2143 (not (eq (car undo-list) undo-elt)))
2145 (undo-tree-apply-deltas (car undo-list) delta -1))
2146 ;; move to next undo element in list, or to next node if we've run out
2148 (unless (car (setq undo-list (cdr undo-list)))
2150 (setq node (nth (undo-tree-node-branch node)
2151 (undo-tree-node-next node)))
2152 (setq node (undo-tree-node-previous node)))
2153 (setq undo-list (undo-tree-node-undo node))))))
2157 (defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
2158 ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
2159 ;; (only useful value for SGN is -1).
2160 (let (position offset)
2161 (dolist (delta deltas)
2162 (setq position (car delta)
2163 offset (* (cdr delta) (or sgn 1)))
2166 ((integerp undo-elt)
2167 (when (>= undo-elt position)
2168 (setq undo-elt (- undo-elt offset))))
2169 ;; nil (or any other atom)
2171 ;; (TEXT . POSITION)
2172 ((stringp (car undo-elt))
2173 (let ((text-pos (abs (cdr undo-elt)))
2174 (point-at-end (< (cdr undo-elt) 0)))
2175 (if (>= text-pos position)
2176 (setcdr undo-elt (* (if point-at-end -1 1)
2177 (- text-pos offset))))))
2179 ((integerp (car undo-elt))
2180 (when (>= (car undo-elt) position)
2181 (setcar undo-elt (- (car undo-elt) offset))
2182 (setcdr undo-elt (- (cdr undo-elt) offset))))
2183 ;; (nil PROPERTY VALUE BEG . END)
2184 ((null (car undo-elt))
2185 (let ((tail (nthcdr 3 undo-elt)))
2186 (when (>= (car tail) position)
2187 (setcar tail (- (car tail) offset))
2188 (setcdr tail (- (cdr tail) offset)))))
2194 (defun undo-tree-repeated-undo-in-region-p (start end)
2195 ;; Return non-nil if undo-in-region between START and END is a repeated
2197 (let ((node (undo-tree-current buffer-undo-tree)))
2199 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
2200 (eq (undo-tree-node-undo-beginning node) start)
2201 (eq (undo-tree-node-undo-end node) end))))
2204 (defun undo-tree-repeated-redo-in-region-p (start end)
2205 ;; Return non-nil if undo-in-region between START and END is a repeated
2207 (let ((node (undo-tree-current buffer-undo-tree)))
2208 (and (eq (undo-tree-node-redo-beginning node) start)
2209 (eq (undo-tree-node-redo-end node) end))))
2212 ;; Return non-nil if undo-in-region between START and END is simply
2213 ;; reverting the last redo-in-region
2214 (defalias 'undo-tree-reverting-undo-in-region-p
2215 'undo-tree-repeated-undo-in-region-p)
2218 ;; Return non-nil if redo-in-region between START and END is simply
2219 ;; reverting the last undo-in-region
2220 (defalias 'undo-tree-reverting-redo-in-region-p
2221 'undo-tree-repeated-redo-in-region-p)
2226 ;;; =====================================================================
2227 ;;; Undo-tree commands
2230 (define-minor-mode undo-tree-mode
2231 "Toggle undo-tree mode.
2232 With no argument, this command toggles the mode.
2233 A positive prefix argument turns the mode on.
2234 A negative prefix argument turns it off.
2236 Undo-tree-mode replaces Emacs' standard undo feature with a more
2237 powerful yet easier to use version, that treats the undo history
2238 as what it is: a tree.
2240 The following keys are available in `undo-tree-mode':
2244 Within the undo-tree visualizer, the following keys are available:
2246 \\{undo-tree-visualizer-map}"
2249 undo-tree-mode-lighter ; lighter
2250 undo-tree-map ; keymap
2251 ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
2252 ;; Emacs undo can work
2253 (unless undo-tree-mode
2254 (undo-list-rebuild-from-tree)
2255 (setq buffer-undo-tree nil)))
2258 (defun turn-on-undo-tree-mode (&optional print-message)
2259 "Enable `undo-tree-mode' in the current buffer, when appropriate.
2260 Some major modes implement their own undo system, which should
2261 not normally be overridden by `undo-tree-mode'. This command does
2262 not enable `undo-tree-mode' in such buffers. If you want to force
2263 `undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
2266 The heuristic used to detect major modes in which
2267 `undo-tree-mode' should not be used is to check whether either
2268 the `undo' command has been remapped, or the default undo
2269 keybindings (C-/ and C-_) have been overridden somewhere other
2270 than in the global map. In addition, `undo-tree-mode' will not be
2271 enabled if the buffer's `major-mode' appears in
2272 `undo-tree-incompatible-major-modes'."
2274 (if (or (key-binding [remap undo])
2275 (undo-tree-overridden-undo-bindings-p)
2276 (memq major-mode undo-tree-incompatible-major-modes))
2278 (message "Buffer does not support undo-tree-mode;\
2279 undo-tree-mode NOT enabled"))
2280 (undo-tree-mode 1)))
2283 (defun undo-tree-overridden-undo-bindings-p ()
2284 "Returns t if default undo bindings are overridden, nil otherwise.
2285 Checks if either of the default undo key bindings (\"C-/\" or
2286 \"C-_\") are overridden in the current buffer by any keymap other
2287 than the global one. (So global redefinitions of the default undo
2288 key bindings do not count.)"
2289 (let ((binding1 (lookup-key (current-global-map) [?\C-/]))
2290 (binding2 (lookup-key (current-global-map) [?\C-_])))
2291 (global-set-key [?\C-/] 'undo)
2292 (global-set-key [?\C-_] 'undo)
2294 (or (and (key-binding [?\C-/])
2295 (not (eq (key-binding [?\C-/]) 'undo)))
2296 (and (key-binding [?\C-_])
2297 (not (eq (key-binding [?\C-_]) 'undo))))
2298 (global-set-key [?\C-/] binding1)
2299 (global-set-key [?\C-_] binding2))))
2303 (define-globalized-minor-mode global-undo-tree-mode
2304 undo-tree-mode turn-on-undo-tree-mode)
2308 (defun undo-tree-undo (&optional arg preserve-redo)
2310 Repeat this command to undo more changes.
2311 A numeric ARG serves as a repeat count.
2313 In Transient Mark mode when the mark is active, only undo changes
2314 within the current region. Similarly, when not in Transient Mark
2315 mode, just \\[universal-argument] as an argument limits undo to
2316 changes within the current region.
2318 A non-nil PRESERVE-REDO causes the existing redo record to be
2319 preserved, rather than replacing it with the new one generated by
2322 ;; throw error if undo is disabled in buffer
2323 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2325 (let ((undo-in-progress t)
2326 (undo-in-region (or (region-active-p) (and arg (not (numberp arg)))))
2328 ;; transfer entries accumulated in `buffer-undo-list' to
2329 ;; `buffer-undo-tree'
2330 (undo-list-transfer-to-tree)
2332 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2333 ;; check if at top of undo tree
2334 (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2335 (error "No further undo information"))
2337 ;; if region is active, or a non-numeric prefix argument was supplied,
2338 ;; try to pull out a new branch of changes affecting the region
2339 (when (and undo-in-region
2340 (not (undo-tree-pull-undo-in-region-branch
2341 (region-beginning) (region-end))))
2342 (error "No further undo information for region"))
2344 ;; remove any GC'd elements from node's undo list
2345 (setq current (undo-tree-current buffer-undo-tree))
2346 (decf (undo-tree-size buffer-undo-tree)
2347 (undo-list-byte-size (undo-tree-node-undo current)))
2348 (setf (undo-tree-node-undo current)
2349 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2350 (incf (undo-tree-size buffer-undo-tree)
2351 (undo-list-byte-size (undo-tree-node-undo current)))
2352 ;; undo one record from undo tree
2353 (when undo-in-region
2354 (setq pos (set-marker (make-marker) (point)))
2355 (set-marker-insertion-type pos t))
2356 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
2359 ;; if preserving old redo record, discard new redo entries that
2360 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2361 ;; elements from node's redo list
2364 (undo-list-pop-changeset)
2365 (decf (undo-tree-size buffer-undo-tree)
2366 (undo-list-byte-size (undo-tree-node-redo current)))
2367 (setf (undo-tree-node-redo current)
2368 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2369 (incf (undo-tree-size buffer-undo-tree)
2370 (undo-list-byte-size (undo-tree-node-redo current))))
2371 ;; otherwise, record redo entries that `primitive-undo' has added to
2372 ;; `buffer-undo-list' in current node's redo record, replacing
2373 ;; existing entry if one already exists
2374 (when (undo-tree-node-redo current)
2375 (decf (undo-tree-size buffer-undo-tree)
2376 (undo-list-byte-size (undo-tree-node-redo current))))
2377 (setf (undo-tree-node-redo current)
2378 (undo-list-pop-changeset 'discard-pos))
2379 (incf (undo-tree-size buffer-undo-tree)
2380 (undo-list-byte-size (undo-tree-node-redo current))))
2382 ;; rewind current node and update timestamp
2383 (setf (undo-tree-current buffer-undo-tree)
2384 (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2385 (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
2388 ;; if undoing-in-region, record current node, region and direction so we
2389 ;; can tell if undo-in-region is repeated, and re-activate mark if in
2390 ;; `transient-mark-mode'; if not, erase any leftover data
2391 (if (not undo-in-region)
2392 (undo-tree-node-clear-region-data current)
2394 ;; note: we deliberately want to store the region information in the
2395 ;; node *below* the now current one
2396 (setf (undo-tree-node-undo-beginning current) (region-beginning)
2397 (undo-tree-node-undo-end current) (region-end))
2398 (set-marker pos nil)))
2400 ;; undo deactivates mark unless undoing-in-region
2401 (setq deactivate-mark (not undo-in-region))
2402 ;; inform user if at branch point
2403 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!"))))
2407 (defun undo-tree-redo (&optional arg preserve-undo)
2408 "Redo changes. A numeric ARG serves as a repeat count.
2410 In Transient Mark mode when the mark is active, only redo changes
2411 within the current region. Similarly, when not in Transient Mark
2412 mode, just \\[universal-argument] as an argument limits redo to
2413 changes within the current region.
2415 A non-nil PRESERVE-UNDO causes the existing undo record to be
2416 preserved, rather than replacing it with the new one generated by
2419 ;; throw error if undo is disabled in buffer
2420 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2422 (let ((undo-in-progress t)
2423 (redo-in-region (or (region-active-p) (and arg (not (numberp arg)))))
2425 ;; transfer entries accumulated in `buffer-undo-list' to
2426 ;; `buffer-undo-tree'
2427 (undo-list-transfer-to-tree)
2429 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2430 ;; check if at bottom of undo tree
2431 (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
2432 (error "No further redo information"))
2434 ;; if region is active, or a non-numeric prefix argument was supplied,
2435 ;; try to pull out a new branch of changes affecting the region
2436 (when (and redo-in-region
2437 (not (undo-tree-pull-redo-in-region-branch
2438 (region-beginning) (region-end))))
2439 (error "No further redo information for region"))
2441 ;; advance current node
2442 (setq current (undo-tree-current buffer-undo-tree)
2443 current (setf (undo-tree-current buffer-undo-tree)
2444 (nth (undo-tree-node-branch current)
2445 (undo-tree-node-next current))))
2446 ;; remove any GC'd elements from node's redo list
2447 (decf (undo-tree-size buffer-undo-tree)
2448 (undo-list-byte-size (undo-tree-node-redo current)))
2449 (setf (undo-tree-node-redo current)
2450 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2451 (incf (undo-tree-size buffer-undo-tree)
2452 (undo-list-byte-size (undo-tree-node-redo current)))
2453 ;; redo one record from undo tree
2454 (when redo-in-region
2455 (setq pos (set-marker (make-marker) (point)))
2456 (set-marker-insertion-type pos t))
2457 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
2460 ;; if preserving old undo record, discard new undo entries that
2461 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2462 ;; elements from node's redo list
2465 (undo-list-pop-changeset)
2466 (decf (undo-tree-size buffer-undo-tree)
2467 (undo-list-byte-size (undo-tree-node-undo current)))
2468 (setf (undo-tree-node-undo current)
2469 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2470 (incf (undo-tree-size buffer-undo-tree)
2471 (undo-list-byte-size (undo-tree-node-undo current))))
2472 ;; otherwise, record undo entries that `primitive-undo' has added to
2473 ;; `buffer-undo-list' in current node's undo record, replacing
2474 ;; existing entry if one already exists
2475 (when (undo-tree-node-undo current)
2476 (decf (undo-tree-size buffer-undo-tree)
2477 (undo-list-byte-size (undo-tree-node-undo current))))
2478 (setf (undo-tree-node-undo current)
2479 (undo-list-pop-changeset 'discard-pos))
2480 (incf (undo-tree-size buffer-undo-tree)
2481 (undo-list-byte-size (undo-tree-node-undo current))))
2484 (setf (undo-tree-node-timestamp current) (current-time))
2486 ;; if redoing-in-region, record current node, region and direction so we
2487 ;; can tell if redo-in-region is repeated, and re-activate mark if in
2488 ;; `transient-mark-mode'
2489 (if (not redo-in-region)
2490 (undo-tree-node-clear-region-data current)
2492 (setf (undo-tree-node-redo-beginning current) (region-beginning)
2493 (undo-tree-node-redo-end current) (region-end))
2494 (set-marker pos nil)))
2496 ;; redo deactivates the mark unless redoing-in-region
2497 (setq deactivate-mark (not redo-in-region))
2498 ;; inform user if at branch point
2499 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!"))))
2503 (defun undo-tree-switch-branch (branch)
2504 "Switch to a different BRANCH of the undo tree.
2505 This will affect which branch to descend when *redoing* changes
2506 using `undo-tree-redo'."
2507 (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
2508 (and (not (eq buffer-undo-list t))
2509 (or (undo-list-transfer-to-tree) t)
2510 (> (undo-tree-num-branches) 1)
2512 (format "Branch (0-%d): "
2513 (1- (undo-tree-num-branches))))))))
2514 ;; throw error if undo is disabled in buffer
2515 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2516 ;; sanity check branch number
2517 (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point"))
2518 (when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
2519 (error "Invalid branch number"))
2520 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2521 (undo-list-transfer-to-tree)
2523 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
2527 (defun undo-tree-set (node)
2528 ;; Set buffer to state corresponding to NODE. Returns intersection point
2529 ;; between path back from current node and path back from selected NODE.
2530 (let ((path (make-hash-table :test 'eq))
2532 (puthash (undo-tree-root buffer-undo-tree) t path)
2533 ;; build list of nodes leading back from selected node to root, updating
2534 ;; branches as we go to point down to selected node
2537 (when (undo-tree-node-previous n)
2538 (setf (undo-tree-node-branch (undo-tree-node-previous n))
2540 n (undo-tree-node-next (undo-tree-node-previous n))))
2541 (setq n (undo-tree-node-previous n)))))
2542 ;; work backwards from current node until we intersect path back from
2544 (setq n (undo-tree-current buffer-undo-tree))
2545 (while (not (gethash n path))
2546 (setq n (undo-tree-node-previous n)))
2547 ;; ascend tree until intersection node
2548 (while (not (eq (undo-tree-current buffer-undo-tree) n))
2550 ;; descend tree until selected node
2551 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2553 n)) ; return intersection node
2557 (defun undo-tree-save-state-to-register (register)
2558 "Store current undo-tree state to REGISTER.
2559 The saved state can be restored using
2560 `undo-tree-restore-state-from-register'.
2561 Argument is a character, naming the register."
2562 (interactive "cUndo-tree state to register: ")
2563 ;; throw error if undo is disabled in buffer
2564 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2565 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2566 (undo-list-transfer-to-tree)
2567 ;; save current node to REGISTER
2568 (set-register register (undo-tree-current buffer-undo-tree))
2569 ;; record REGISTER in current node, for visualizer
2570 (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
2575 (defun undo-tree-restore-state-from-register (register)
2576 "Restore undo-tree state from REGISTER.
2577 The state must be saved using `undo-tree-save-state-to-register'.
2578 Argument is a character, naming the register."
2579 (interactive "cRestore undo-tree state from register: ")
2580 ;; throw error if undo is disabled in buffer, or if register doesn't contain
2581 ;; an undo-tree node
2582 (let ((node (get-register register)))
2584 ((eq buffer-undo-list t)
2585 (error "No undo information in this buffer"))
2586 ((not (undo-tree-node-p node))
2587 (error "Register doesn't contain undo-tree state")))
2588 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2589 (undo-list-transfer-to-tree)
2590 ;; restore buffer state corresponding to saved node
2591 (undo-tree-set node)))
2596 ;;; =====================================================================
2597 ;;; Undo-tree visualizer
2599 (defun undo-tree-visualize ()
2600 "Visualize the current buffer's undo tree."
2603 ;; throw error if undo is disabled in buffer
2604 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2605 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2606 (undo-list-transfer-to-tree)
2607 ;; add hook to kill visualizer buffer if original buffer is changed
2608 (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
2609 ;; prepare *undo-tree* buffer, then draw tree in it
2610 (let ((undo-tree buffer-undo-tree)
2611 (buff (current-buffer))
2612 (display-buffer-mark-dedicated 'soft))
2613 (switch-to-buffer-other-window
2614 (get-buffer-create undo-tree-visualizer-buffer-name))
2615 (undo-tree-visualizer-mode)
2616 (setq undo-tree-visualizer-parent-buffer buff)
2617 (setq buffer-undo-tree undo-tree)
2618 (setq buffer-read-only nil)
2619 (undo-tree-draw-tree undo-tree)
2620 (setq buffer-read-only t)))
2623 (defun undo-tree-kill-visualizer (&rest dummy)
2624 ;; Kill visualizer. Added to `before-change-functions' hook of original
2625 ;; buffer when visualizer is invoked.
2626 (unless undo-in-progress
2628 (with-current-buffer undo-tree-visualizer-buffer-name
2629 (undo-tree-visualizer-quit)))))
2633 (defun undo-tree-draw-tree (undo-tree)
2634 ;; Draw UNDO-TREE in current buffer.
2636 (undo-tree-move-down 1) ; top margin
2637 (undo-tree-clear-visualizer-data undo-tree)
2638 (undo-tree-compute-widths undo-tree)
2639 (undo-tree-move-forward
2640 (max (/ (window-width) 2)
2641 (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree))
2642 ;; add space for left part of left-most time-stamp
2643 (if undo-tree-visualizer-timestamps 4 0)
2646 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
2647 (stack (list (undo-tree-root undo-tree)))
2648 (n (undo-tree-root undo-tree)))
2649 ;; link root node to its representation in visualizer
2650 (unless (markerp (undo-tree-node-marker n))
2651 (setf (undo-tree-node-marker n) (make-marker))
2652 (set-marker-insertion-type (undo-tree-node-marker n) nil))
2653 (move-marker (undo-tree-node-marker n) (point))
2654 ;; draw nodes from stack until stack is empty
2656 (setq n (pop stack))
2657 (goto-char (undo-tree-node-marker n))
2658 (setq n (undo-tree-draw-subtree n nil))
2659 (setq stack (append stack n))))
2660 ;; highlight active branch
2661 (goto-char (undo-tree-node-marker (undo-tree-root undo-tree)))
2662 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
2663 (undo-tree-highlight-active-branch (undo-tree-root undo-tree)))
2664 ;; highlight current node
2665 (undo-tree-draw-node (undo-tree-current undo-tree) 'current))
2668 (defun undo-tree-highlight-active-branch (node)
2669 ;; Draw highlighted active branch below NODE in current buffer.
2670 (let ((stack (list node)))
2671 ;; link node to its representation in visualizer
2672 (unless (markerp (undo-tree-node-marker node))
2673 (setf (undo-tree-node-marker node) (make-marker))
2674 (set-marker-insertion-type (undo-tree-node-marker node) nil))
2675 (move-marker (undo-tree-node-marker node) (point))
2676 ;; draw active branch
2678 (setq node (pop stack))
2679 (goto-char (undo-tree-node-marker node))
2680 (setq node (undo-tree-draw-subtree node 'active))
2681 (setq stack (append stack node)))))
2684 (defun undo-tree-draw-node (node &optional current)
2685 ;; Draw symbol representing NODE in visualizer.
2686 (goto-char (undo-tree-node-marker node))
2687 (when undo-tree-visualizer-timestamps (backward-char 5))
2689 (let ((register (undo-tree-node-register node))
2691 (unless (and register (eq node (get-register register)))
2692 (setq register nil))
2693 ;; represent node by differentl symbols, depending on whether it's the
2694 ;; current node or is saved in a register
2697 (undo-tree-visualizer-timestamps
2698 (undo-tree-timestamp-to-string (undo-tree-node-timestamp node)))
2700 (register (char-to-string register))
2702 (when undo-tree-visualizer-timestamps
2704 (concat (if current "*" " ") node-string
2705 (if register (concat "(" (char-to-string register) ")")
2710 (let ((undo-tree-insert-face
2711 (cons 'undo-tree-visualizer-current-face
2712 (and (boundp 'undo-tree-insert-face)
2713 (or (and (consp undo-tree-insert-face)
2714 undo-tree-insert-face)
2715 (list undo-tree-insert-face))))))
2716 (undo-tree-insert node-string)))
2718 (let ((undo-tree-insert-face
2719 (cons 'undo-tree-visualizer-register-face
2720 (and (boundp 'undo-tree-insert-face)
2721 (or (and (consp undo-tree-insert-face)
2722 undo-tree-insert-face)
2723 (list undo-tree-insert-face))))))
2724 (undo-tree-insert node-string)))
2725 (t (undo-tree-insert node-string)))
2727 (backward-char (if undo-tree-visualizer-timestamps 7 1))
2728 (move-marker (undo-tree-node-marker node) (point))
2729 (put-text-property (- (point) (if undo-tree-visualizer-timestamps 3 0))
2730 (+ (point) (if undo-tree-visualizer-timestamps 5 1))
2731 'undo-tree-node node)))
2734 (defun undo-tree-draw-subtree (node &optional active-branch)
2735 ;; Draw subtree rooted at NODE. The subtree will start from point.
2736 ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE.
2737 ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes.
2738 (let ((num-children (length (undo-tree-node-next node)))
2739 node-list pos trunk-pos n)
2741 (undo-tree-draw-node node)
2744 ;; if we're at a leaf node, we're done
2745 ((= num-children 0))
2747 ;; if node has only one child, draw it (not strictly necessary to deal
2748 ;; with this case separately, but as it's by far the most common case
2749 ;; this makes the code clearer and more efficient)
2751 (undo-tree-move-down 1)
2752 (undo-tree-insert ?|)
2754 (undo-tree-move-down 1)
2755 (undo-tree-insert ?|)
2757 (undo-tree-move-down 1)
2758 (setq n (car (undo-tree-node-next node)))
2759 ;; link next node to its representation in visualizer
2760 (unless (markerp (undo-tree-node-marker n))
2761 (setf (undo-tree-node-marker n) (make-marker))
2762 (set-marker-insertion-type (undo-tree-node-marker n) nil))
2763 (move-marker (undo-tree-node-marker n) (point))
2764 ;; add next node to list of nodes to draw next
2767 ;; if node had multiple children, draw branches
2769 (undo-tree-move-down 1)
2770 (undo-tree-insert ?|)
2772 (setq trunk-pos (point))
2775 (- (undo-tree-node-char-lwidth node)
2776 (undo-tree-node-char-lwidth
2777 (car (undo-tree-node-next node)))))
2779 (setq n (cons nil (undo-tree-node-next node)))
2780 (dotimes (i (/ num-children 2))
2782 (when (or (null active-branch)
2784 (nth (undo-tree-node-branch node)
2785 (undo-tree-node-next node))))
2786 (undo-tree-move-forward 2)
2787 (undo-tree-insert ?_ (- trunk-pos pos 2))
2789 (undo-tree-move-forward 1)
2790 (undo-tree-move-down 1)
2791 (undo-tree-insert ?/)
2793 (undo-tree-move-down 1)
2794 ;; link node to its representation in visualizer
2795 (unless (markerp (undo-tree-node-marker (car n)))
2796 (setf (undo-tree-node-marker (car n)) (make-marker))
2797 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
2798 (move-marker (undo-tree-node-marker (car n)) (point))
2799 ;; add node to list of nodes to draw next
2800 (push (car n) node-list))
2802 (undo-tree-move-forward
2803 (+ (undo-tree-node-char-rwidth (car n))
2804 (undo-tree-node-char-lwidth (cadr n))
2805 undo-tree-visualizer-spacing 1))
2807 ;; middle subtree (only when number of children is odd)
2808 (when (= (mod num-children 2) 1)
2810 (when (or (null active-branch)
2812 (nth (undo-tree-node-branch node)
2813 (undo-tree-node-next node))))
2814 (undo-tree-move-down 1)
2815 (undo-tree-insert ?|)
2817 (undo-tree-move-down 1)
2818 ;; link node to its representation in visualizer
2819 (unless (markerp (undo-tree-node-marker (car n)))
2820 (setf (undo-tree-node-marker (car n)) (make-marker))
2821 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
2822 (move-marker (undo-tree-node-marker (car n)) (point))
2823 ;; add node to list of nodes to draw next
2824 (push (car n) node-list))
2826 (undo-tree-move-forward
2827 (+ (undo-tree-node-char-rwidth (car n))
2828 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
2829 undo-tree-visualizer-spacing 1))
2833 (dotimes (i (/ num-children 2))
2835 (when (or (null active-branch)
2837 (nth (undo-tree-node-branch node)
2838 (undo-tree-node-next node))))
2839 (goto-char trunk-pos)
2840 (undo-tree-insert ?_ (- pos trunk-pos 1))
2843 (undo-tree-move-down 1)
2844 (undo-tree-insert ?\\)
2845 (undo-tree-move-down 1)
2846 ;; link node to its representation in visualizer
2847 (unless (markerp (undo-tree-node-marker (car n)))
2848 (setf (undo-tree-node-marker (car n)) (make-marker))
2849 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
2850 (move-marker (undo-tree-node-marker (car n)) (point))
2851 ;; add node to list of nodes to draw next
2852 (push (car n) node-list))
2855 (undo-tree-move-forward
2856 (+ (undo-tree-node-char-rwidth (car n))
2857 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
2858 undo-tree-visualizer-spacing 1))
2859 (setq pos (point))))
2861 ;; return list of nodes to draw next
2862 (nreverse node-list)))
2866 (defun undo-tree-node-char-lwidth (node)
2867 ;; Return left-width of NODE measured in characters.
2868 (if (= (length (undo-tree-node-next node)) 0) 0
2869 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
2870 (if (= (undo-tree-node-cwidth node) 0)
2871 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
2874 (defun undo-tree-node-char-rwidth (node)
2875 ;; Return right-width of NODE measured in characters.
2876 (if (= (length (undo-tree-node-next node)) 0) 0
2877 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
2878 (if (= (undo-tree-node-cwidth node) 0)
2879 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
2882 (defun undo-tree-insert (str &optional arg)
2883 ;; Insert character or string STR ARG times, overwriting, and using
2884 ;; `undo-tree-insert-face'.
2885 (unless arg (setq arg 1))
2886 (when (characterp str)
2887 (setq str (make-string arg str))
2889 (dotimes (i arg) (insert str))
2890 (setq arg (* arg (length str)))
2891 (undo-tree-move-forward arg)
2892 ;; make sure mark isn't active, otherwise `backward-delete-char' might
2893 ;; delete region instead of single char if transient-mark-mode is enabled
2894 (setq mark-active nil)
2895 (backward-delete-char arg)
2896 (when (boundp 'undo-tree-insert-face)
2897 (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
2900 (defun undo-tree-move-down (&optional arg)
2901 ;; Move down, extending buffer if necessary.
2902 (let ((row (line-number-at-pos))
2903 (col (current-column))
2905 (unless arg (setq arg 1))
2907 (setq line (line-number-at-pos))
2908 ;; if buffer doesn't have enough lines, add some
2909 (when (/= line (+ row arg))
2910 (insert (make-string (- arg (- line row)) ?\n)))
2911 (undo-tree-move-forward col)))
2914 (defun undo-tree-move-forward (&optional arg)
2915 ;; Move forward, extending buffer if necessary.
2916 (unless arg (setq arg 1))
2917 (let ((n (- (line-end-position) (point))))
2921 (insert (make-string (- arg n) ? )))))
2924 (defun undo-tree-timestamp-to-string (timestamp)
2925 ;; Convert TIMESTAMP to hh:mm:ss string.
2926 (let ((time (decode-time timestamp)))
2927 (format "%02d:%02d:%02d" (nth 2 time) (nth 1 time) (nth 0 time))))
2932 ;;; =====================================================================
2933 ;;; Visualizer mode commands
2935 (defun undo-tree-visualizer-mode ()
2936 "Major mode used in undo-tree visualizer.
2938 The undo-tree visualizer can only be invoked from a buffer in
2939 which `undo-tree-mode' is enabled. The visualizer displays the
2940 undo history tree graphically, and allows you to browse around
2941 the undo history, undoing or redoing the corresponding changes in
2944 Within the undo-tree visualizer, the following keys are available:
2946 \\{undo-tree-visualizer-map}"
2948 (setq major-mode 'undo-tree-visualizer-mode)
2949 (setq mode-name "undo-tree-visualizer-mode")
2950 (use-local-map undo-tree-visualizer-map)
2951 (setq truncate-lines t)
2952 (setq cursor-type nil)
2953 (setq buffer-read-only t))
2957 (defun undo-tree-visualize-undo (&optional arg)
2958 "Undo changes. A numeric ARG serves as a repeat count."
2960 (setq buffer-read-only nil)
2961 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
2962 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
2963 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
2966 (undo-tree-undo arg)
2967 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
2968 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current)
2969 (setq buffer-read-only t)))
2972 (defun undo-tree-visualize-redo (&optional arg)
2973 "Redo changes. A numeric ARG serves as a repeat count."
2975 (setq buffer-read-only nil)
2976 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
2977 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
2978 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
2981 (undo-tree-redo arg)
2982 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
2983 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
2984 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current)
2985 (setq buffer-read-only t)))
2988 (defun undo-tree-visualize-switch-branch-right (arg)
2989 "Switch to next branch of the undo tree.
2990 This will affect which branch to descend when *redoing* changes
2991 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
2993 ;; un-highlight old active branch below current node
2994 (setq buffer-read-only nil)
2995 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
2996 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face))
2997 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
2999 (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
3000 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
3002 ((>= (+ branch arg) (undo-tree-num-branches))
3003 (1- (undo-tree-num-branches)))
3004 ((<= (+ branch arg) 0) 0)
3005 (t (+ branch arg))))
3006 ;; highlight new active branch below current node
3007 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3008 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3009 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3010 ;; re-highlight current node
3011 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current)
3012 (setq buffer-read-only t)))
3015 (defun undo-tree-visualize-switch-branch-left (arg)
3016 "Switch to previous branch of the undo tree.
3017 This will affect which branch to descend when *redoing* changes
3018 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3020 (undo-tree-visualize-switch-branch-right (- arg)))
3023 (defun undo-tree-visualizer-quit ()
3024 "Quit the undo-tree visualizer."
3026 (undo-tree-clear-visualizer-data buffer-undo-tree)
3027 ;; remove kill visualizer hook from parent buffer
3029 (with-current-buffer undo-tree-visualizer-parent-buffer
3030 (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
3031 (let ((parent undo-tree-visualizer-parent-buffer)
3034 (if (setq window (get-buffer-window parent))
3035 (select-window window)
3036 (switch-to-buffer parent)))))
3039 (defun undo-tree-visualizer-set (&optional pos)
3040 "Set buffer to state corresponding to undo tree node
3041 at POS, or point if POS is nil."
3043 (unless pos (setq pos (point)))
3044 (let ((node (get-text-property pos 'undo-tree-node)))
3046 ;; set parent buffer to state corresponding to node at POS
3047 (set-buffer undo-tree-visualizer-parent-buffer)
3048 (undo-tree-set node)
3049 (set-buffer undo-tree-visualizer-buffer-name)
3050 (setq buffer-read-only nil)
3051 ;; re-draw undo tree
3052 (undo-tree-draw-tree buffer-undo-tree)
3053 (setq buffer-read-only t))))
3056 (defun undo-tree-visualizer-mouse-set (pos)
3057 "Set buffer to state corresponding to undo tree node
3058 at mouse event POS."
3060 (undo-tree-visualizer-set (event-start (nth 1 pos))))
3063 (defun undo-tree-visualizer-toggle-timestamps ()
3064 "Toggle display of time-stamps."
3066 (setq undo-tree-visualizer-spacing
3067 (if (setq undo-tree-visualizer-timestamps
3068 (not undo-tree-visualizer-timestamps))
3069 ;; need sufficient space if displaying timestamps
3070 (max 13 (default-value 'undo-tree-visualizer-spacing))
3071 (default-value 'undo-tree-visualizer-spacing)))
3073 (setq buffer-read-only nil)
3074 (undo-tree-draw-tree buffer-undo-tree)
3075 (setq buffer-read-only t))
3078 (defun undo-tree-visualizer-scroll-left (&optional arg)
3080 (scroll-right (or arg 1) t))
3083 (defun undo-tree-visualizer-scroll-right (&optional arg)
3085 (scroll-left (or arg 1) t))
3090 ;;; =====================================================================
3091 ;;; Visualizer selection mode
3093 (defun undo-tree-visualizer-selection-mode ()
3094 "Major mode used to select nodes in undo-tree visualizer."
3096 (setq major-mode 'undo-tree-visualizer-selection-mode)
3097 (setq mode-name "undo-tree-visualizer-selection-mode")
3098 (use-local-map undo-tree-visualizer-selection-map)
3099 (setq cursor-type 'box))
3102 (defun undo-tree-visualizer-select-previous (&optional arg)
3103 "Move to previous node."
3105 (let ((node (get-text-property (point) 'undo-tree-node)))
3108 (unless (undo-tree-node-previous node) (throw 'top t))
3109 (setq node (undo-tree-node-previous node))))
3110 (goto-char (undo-tree-node-marker node))))
3113 (defun undo-tree-visualizer-select-next (&optional arg)
3114 "Move to next node."
3116 (let ((node (get-text-property (point) 'undo-tree-node)))
3119 (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
3122 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
3123 (goto-char (undo-tree-node-marker node))))
3126 (defun undo-tree-visualizer-select-right (&optional arg)
3127 "Move right to a sibling node."
3130 (end (line-end-position))
3136 (setq node (get-text-property (point) 'undo-tree-node))
3137 (when (= (point) end) (throw 'end t)))))
3138 (goto-char (if node (undo-tree-node-marker node) pos))))
3141 (defun undo-tree-visualizer-select-left (&optional arg)
3142 "Move left to a sibling node."
3145 (beg (line-beginning-position))
3151 (setq node (get-text-property (point) 'undo-tree-node))
3152 (when (= (point) beg) (throw 'beg t)))))
3153 (goto-char (if node (undo-tree-node-marker node) pos))))
3157 (provide 'undo-tree)
3159 ;;; undo-tree.el ends here