1 ;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2009-2013 Free Software Foundation, Inc
5 ;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
7 ;; Keywords: convenience, files, undo, redo, history, tree
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/undo-tree.git
11 ;; This file is part of Emacs.
13 ;; This file is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; Emacs has a powerful undo system. Unlike the standard undo/redo system in
30 ;; most software, it allows you to recover *any* past state of a buffer
31 ;; (whereas the standard undo/redo system can lose past states as soon as you
32 ;; redo). However, this power comes at a price: many people find Emacs' undo
33 ;; system confusing and difficult to use, spawning a number of packages that
34 ;; replace it with the less powerful but more intuitive undo/redo system.
36 ;; Both the loss of data with standard undo/redo, and the confusion of Emacs'
37 ;; undo, stem from trying to treat undo history as a linear sequence of
38 ;; changes. It's not. The `undo-tree-mode' provided by this package replaces
39 ;; Emacs' undo system with a system that treats undo history as what it is: a
40 ;; branching tree of changes. This simple idea allows the more intuitive
41 ;; behaviour of the standard undo/redo system to be combined with the power of
42 ;; never losing any history. An added side bonus is that undo history can in
43 ;; some cases be stored more efficiently, allowing more changes to accumulate
44 ;; before Emacs starts discarding history.
46 ;; The only downside to this more advanced yet simpler undo system is that it
47 ;; was inspired by Vim. But, after all, most successful religions steal the
48 ;; best ideas from their competitors!
54 ;; This package has only been tested with Emacs versions 24 and CVS. It should
55 ;; work in Emacs versions 22 and 23 too, but will not work without
56 ;; modifications in earlier versions of Emacs.
58 ;; To install `undo-tree-mode', make sure this file is saved in a directory in
59 ;; your `load-path', and add the line:
61 ;; (require 'undo-tree)
63 ;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using
64 ;; "M-x byte-compile-file" from within emacs).
66 ;; If you want to replace the standard Emacs' undo system with the
67 ;; `undo-tree-mode' system in all buffers, you can enable it globally by
70 ;; (global-undo-tree-mode)
72 ;; to your .emacs file.
78 ;; If you're the kind of person who likes to jump in the car and drive,
79 ;; without bothering to first figure out whether the button on the left dips
80 ;; the headlights or operates the ejector seat (after all, you'll soon figure
81 ;; it out when you push it), then here's the minimum you need to know:
83 ;; `undo-tree-mode' and `global-undo-tree-mode'
84 ;; Enable undo-tree mode (either in the current buffer or globally).
86 ;; C-_ C-/ (`undo-tree-undo')
89 ;; M-_ C-? (`undo-tree-redo')
92 ;; `undo-tree-switch-branch'
93 ;; Switch undo-tree branch.
94 ;; (What does this mean? Better press the button and see!)
96 ;; C-x u (`undo-tree-visualize')
97 ;; Visualize the undo tree.
98 ;; (Better try pressing this button too!)
100 ;; C-x r u (`undo-tree-save-state-to-register')
101 ;; Save current buffer state to register.
103 ;; C-x r U (`undo-tree-restore-state-from-register')
104 ;; Restore buffer state from register.
108 ;; In the undo-tree visualizer:
110 ;; <up> p C-p (`undo-tree-visualize-undo')
113 ;; <down> n C-n (`undo-tree-visualize-redo')
116 ;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
117 ;; Switch to previous undo-tree branch.
119 ;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
120 ;; Switch to next undo-tree branch.
122 ;; C-<up> M-{ (`undo-tree-visualize-undo-to-x')
123 ;; Undo changes up to last branch point.
125 ;; C-<down> M-} (`undo-tree-visualize-redo-to-x')
126 ;; Redo changes down to next branch point.
128 ;; <down> n C-n (`undo-tree-visualize-redo')
131 ;; <mouse-1> (`undo-tree-visualizer-mouse-set')
132 ;; Set state to node at mouse click.
134 ;; t (`undo-tree-visualizer-toggle-timestamps')
135 ;; Toggle display of time-stamps.
137 ;; d (`undo-tree-visualizer-toggle-diff')
138 ;; Toggle diff display.
140 ;; s (`undo-tree-visualizer-selection-mode')
141 ;; Toggle keyboard selection mode.
143 ;; q (`undo-tree-visualizer-quit')
144 ;; Quit undo-tree-visualizer.
146 ;; C-q (`undo-tree-visualizer-abort')
147 ;; Abort undo-tree-visualizer.
163 ;; In visualizer selection mode:
165 ;; <up> p C-p (`undo-tree-visualizer-select-previous')
166 ;; Select previous node.
168 ;; <down> n C-n (`undo-tree-visualizer-select-next')
171 ;; <left> b C-b (`undo-tree-visualizer-select-left')
172 ;; Select left sibling node.
174 ;; <right> f C-f (`undo-tree-visualizer-select-right')
175 ;; Select right sibling node.
178 ;; Select node 10 above.
181 ;; Select node 10 below.
183 ;; <enter> (`undo-tree-visualizer-set')
184 ;; Set state to selected node and exit selection mode.
186 ;; s (`undo-tree-visualizer-mode')
187 ;; Exit selection mode.
189 ;; t (`undo-tree-visualizer-toggle-timestamps')
190 ;; Toggle display of time-stamps.
192 ;; d (`undo-tree-visualizer-toggle-diff')
193 ;; Toggle diff display.
195 ;; q (`undo-tree-visualizer-quit')
196 ;; Quit undo-tree-visualizer.
198 ;; C-q (`undo-tree-visualizer-abort')
199 ;; Abort undo-tree-visualizer.
209 ;; Persistent undo history:
211 ;; Note: Requires Emacs version 24.3 or higher.
213 ;; `undo-tree-auto-save-history' (variable)
214 ;; automatically save and restore undo-tree history along with buffer
215 ;; (disabled by default)
217 ;; `undo-tree-save-history' (command)
218 ;; manually save undo history to file
220 ;; `undo-tree-load-history' (command)
221 ;; manually load undo history from file
225 ;; Compressing undo history:
227 ;; Undo history files cannot grow beyond the maximum undo tree size, which
228 ;; is limited by `undo-limit', `undo-strong-limit' and
229 ;; `undo-outer-limit'. Nevertheless, undo history files can grow quite
230 ;; large. If you want to automatically compress undo history, add the
231 ;; following advice to your .emacs file (replacing ".gz" with the filename
232 ;; extension of your favourite compression algorithm):
234 ;; (defadvice undo-tree-make-history-save-file-name
235 ;; (after undo-tree activate)
236 ;; (setq ad-return-value (concat ad-return-value ".gz")))
244 ;; To understand the different undo systems, it's easiest to consider an
245 ;; example. Imagine you make a few edits in a buffer. As you edit, you
246 ;; accumulate a history of changes, which we might visualize as a string of
247 ;; past buffer states, growing downwards:
249 ;; o (initial buffer state)
258 ;; x (current buffer state)
261 ;; Now imagine that you undo the last two changes. We can visualize this as
262 ;; rewinding the current state back two steps:
264 ;; o (initial buffer state)
267 ;; x (current buffer state)
276 ;; However, this isn't a good representation of what Emacs' undo system
277 ;; does. Instead, it treats the undos as *new* changes to the buffer, and adds
278 ;; them to the history:
280 ;; o (initial buffer state)
289 ;; x (buffer state before undo)
298 ;; Actually, since the buffer returns to a previous state after an undo,
299 ;; perhaps a better way to visualize it is to imagine the string of changes
300 ;; turning back on itself:
302 ;; (initial buffer state) o
305 ;; (first edit) o x (second undo)
308 ;; (second edit) o o (first undo)
311 ;; o (buffer state before undo)
313 ;; Treating undos as new changes might seem a strange thing to do. But the
314 ;; advantage becomes clear as soon as we imagine what happens when you edit
315 ;; the buffer again. Since you've undone a couple of changes, new edits will
316 ;; branch off from the buffer state that you've rewound to. Conceptually, it
319 ;; o (initial buffer state)
330 ;; The standard undo/redo system only lets you go backwards and forwards
331 ;; linearly. So as soon as you make that new edit, it discards the old
332 ;; branch. Emacs' undo just keeps adding changes to the end of the string. So
333 ;; the undo history in the two systems now looks like this:
335 ;; Undo/Redo: Emacs' undo
343 ;; . x (new edit) o o |
344 ;; (discarded . | / |
351 ;; Now, what if you change your mind about those undos, and decide you did
352 ;; like those other changes you'd made after all? With the standard undo/redo
353 ;; system, you're lost. There's no way to recover them, because that branch
354 ;; was discarded when you made the new edit.
356 ;; However, in Emacs' undo system, those old buffer states are still there in
357 ;; the undo history. You just have to rewind back through the new edit, and
358 ;; back through the changes made by the undos, until you reach them. Of
359 ;; course, since Emacs treats undos (even undos of undos!) as new changes,
360 ;; you're really weaving backwards and forwards through the history, all the
361 ;; time adding new changes to the end of the string as you go:
366 ;; o o o (undo new edit)
369 ;; o o | | o (undo the undo)
372 ;; (trying to get o | | x (undo the undo)
373 ;; to this state) | /
377 ;; So far, this is still reasonably intuitive to use. It doesn't behave so
378 ;; differently to standard undo/redo, except that by going back far enough you
379 ;; can access changes that would be lost in standard undo/redo.
381 ;; However, imagine that after undoing as just described, you decide you
382 ;; actually want to rewind right back to the initial state. If you're lucky,
383 ;; and haven't invoked any command since the last undo, you can just keep on
384 ;; undoing until you get back to the start:
386 ;; (trying to get o x (got there!)
387 ;; to this state) | |
389 ;; o o o o (keep undoing)
392 ;; o o | | o o (keep undoing)
395 ;; (already undid o | | o (got this far)
396 ;; to this state) | /
400 ;; But if you're unlucky, and you happen to have moved the point (say) after
401 ;; getting to the state labelled "got this far", then you've "broken the undo
402 ;; chain". Hold on to something solid, because things are about to get
403 ;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
404 ;; undos! So to get back to the initial state you now have to rewind through
405 ;; *all* the changes, including the undos you just did:
407 ;; (trying to get o x (finally got there!)
408 ;; to this state) | |
412 ;; | | \ | \ | \ | \ |
413 ;; o o | | o o o | o o
414 ;; | / | | | / | | | /
416 ;; (already undid o | | o<. | | o
417 ;; to this state) | / : | /
421 ;; (got this far, but
422 ;; broke the undo chain)
426 ;; In practice you can just hold down the undo key until you reach the buffer
427 ;; state that you want. But whatever you do, don't move around in the buffer
428 ;; to *check* that you've got back to where you want! Because you'll break the
429 ;; undo chain, and then you'll have to traverse the entire string of undos
430 ;; again, just to get back to the point at which you broke the
431 ;; chain. Undo-in-region and commands such as `undo-only' help to make using
432 ;; Emacs' undo a little easier, but nonetheless it remains confusing for many
436 ;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
437 ;; the history we've been discussing (make a few edits, undo a couple of them,
438 ;; and edit again)? The diagram that conceptually represented our undo
439 ;; history, before we started discussing specific undo systems? It looked like
442 ;; o (initial buffer state)
448 ;; o x (current state)
453 ;; Well, that's *exactly* what the undo history looks like to
454 ;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
455 ;; does), nor does it treat undos as new changes to be added to the end of a
456 ;; linear string of buffer states (as Emacs' undo does). It just keeps track
457 ;; of the tree of branching changes that make up the entire undo history.
459 ;; If you undo from this point, you'll rewind back up the tree to the previous
473 ;; If you were to undo again, you'd rewind back to the initial state. If on
474 ;; the other hand you redo the change, you'll end up back at the bottom of the
475 ;; most recent branch:
477 ;; o (undo takes you here)
483 ;; o x (redo takes you here)
488 ;; So far, this is just like the standard undo/redo system. But what if you
489 ;; want to return to a buffer state located on a previous branch of the
490 ;; history? Since `undo-tree-mode' keeps the entire history, you simply need
491 ;; to tell it to switch to a different branch, and then redo the changes you
497 ;; o (start here, but switch
498 ;; |\ to the other branch)
505 ;; Now you're on the other branch, if you undo and redo changes you'll stay on
506 ;; that branch, moving up and down through the buffer states located on that
507 ;; branch. Until you decide to switch branches again, of course.
509 ;; Real undo trees might have multiple branches and sub-branches:
522 ;; Trying to imagine what Emacs' undo would do as you move about such a tree
523 ;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
524 ;; just moving around this undo history tree. Most of the time, you'll
525 ;; probably only need to stay on the most recent branch, in which case it
526 ;; behaves like standard undo/redo, and is just as simple to understand. But
527 ;; if you ever need to recover a buffer state on a different branch, the
528 ;; possibility of switching between branches and accessing the full undo
529 ;; history is still there.
533 ;; The Undo-Tree Visualizer
534 ;; ========================
536 ;; Actually, it gets better. You don't have to imagine all these tree
537 ;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
538 ;; draws them for you! In fact, it draws even better diagrams: it highlights
539 ;; the node representing the current buffer state, it highlights the current
540 ;; branch, and you can toggle the display of time-stamps (by hitting "t") and
541 ;; a diff of the undo changes (by hitting "d"). (There's one other tiny
542 ;; difference: the visualizer puts the most recent branch on the left rather
545 ;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
547 ;; In the visualizer, the usual keys for moving up and down a buffer instead
548 ;; move up and down the undo history tree (e.g. the up and down arrow keys, or
549 ;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
550 ;; history you are visualizing) is updated as you move around the undo tree in
551 ;; the visualizer. If you reach a branch point in the visualizer, the usual
552 ;; keys for moving forward and backward in a buffer instead switch branch
553 ;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
555 ;; Clicking with the mouse on any node in the visualizer will take you
556 ;; directly to that node, resetting the state of the parent buffer to the
557 ;; state represented by that node.
559 ;; You can also select nodes directly using the keyboard, by hitting "s" to
560 ;; toggle selection mode. The usual motion keys now allow you to move around
561 ;; the tree without changing the parent buffer. Hitting <enter> will reset the
562 ;; state of the parent buffer to the state represented by the currently
565 ;; It can be useful to see how long ago the parent buffer was in the state
566 ;; represented by a particular node in the visualizer. Hitting "t" in the
567 ;; visualizer toggles the display of time-stamps for all the nodes. (Note
568 ;; that, because of the way `undo-tree-mode' works, these time-stamps may be
569 ;; somewhat later than the true times, especially if it's been a long time
570 ;; since you last undid any changes.)
572 ;; To get some idea of what changes are represented by a given node in the
573 ;; tree, it can be useful to see a diff of the changes. Hit "d" in the
574 ;; visualizer to toggle a diff display. This normally displays a diff between
575 ;; the current state and the previous one, i.e. it shows you the changes that
576 ;; will be applied if you undo (move up the tree). However, the diff display
577 ;; really comes into its own in the visualizer's selection mode (see above),
578 ;; where it instead shows a diff between the current state and the currently
579 ;; selected state, i.e. it shows you the changes that will be applied if you
580 ;; reset to the selected state.
582 ;; (Note that the diff is generated by the Emacs `diff' command, and is
583 ;; displayed using `diff-mode'. See the corresponding customization groups if
584 ;; you want to customize the diff display.)
586 ;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
587 ;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
588 ;; returning the parent buffer to whatever state it was originally in when the
596 ;; Emacs allows a very useful and powerful method of undoing only selected
597 ;; changes: when a region is active, only changes that affect the text within
598 ;; that region will be undone. With the standard Emacs undo system, changes
599 ;; produced by undoing-in-region naturally get added onto the end of the
600 ;; linear undo history:
604 ;; | x (second undo-in-region)
607 ;; | o (first undo-in-region)
613 ;; You can of course redo these undos-in-region as usual, by undoing the
621 ;; | o o (undo the undo-in-region)
625 ;; o x (undo the undo-in-region)
628 ;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
629 ;; region, undoing only undoes changes that affect that region. However, the
630 ;; way these undos-in-region are recorded in the undo history is quite
631 ;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
632 ;; undo history. The new branch consists of an undo step that undoes some of
633 ;; the changes that affect the current region, and another step that undoes
634 ;; the remaining changes needed to rejoin the previous undo history.
636 ;; Previous undo history Undo-in-region
644 ;; o o x (undo-in-region)
649 ;; As long as you don't change the active region after undoing-in-region,
650 ;; continuing to undo-in-region extends the new branch, pulling more changes
651 ;; that affect the current region into an undo step immediately above your
652 ;; current location in the undo tree, and pushing the point at which the new
653 ;; branch is attached further up the tree:
655 ;; First undo-in-region Second undo-in-region
660 ;; o o x (undo-in-region)
668 ;; Redoing takes you back down the undo tree, as usual (as long as you haven't
669 ;; changed the active region after undoing-in-region, it doesn't matter if it
684 ;; What about redo-in-region? Obviously, this only makes sense if you have
685 ;; already undone some changes, so that there are some changes to redo!
686 ;; Redoing-in-region splits off a new branch of the undo history below your
687 ;; current location in the undo tree. This time, the new branch consists of a
688 ;; redo step that redoes some of the redo changes that affect the current
689 ;; region, followed by all the remaining redo changes.
691 ;; Previous undo history Redo-in-region
699 ;; o o x (redo-in-region)
704 ;; As long as you don't change the active region after redoing-in-region,
705 ;; continuing to redo-in-region extends the new branch, pulling more redo
706 ;; changes into a redo step immediately below your current location in the
709 ;; First redo-in-region Second redo-in-region
717 ;; o x (redo-in-region) o o
720 ;; o o o x (redo-in-region)
725 ;; Note that undo-in-region and redo-in-region only ever add new changes to
726 ;; the undo tree, they *never* modify existing undo history. So you can always
727 ;; return to previous buffer states by switching to a previous branch of the
734 (eval-when-compile (require 'cl))
739 ;;; =====================================================================
740 ;;; Compatibility hacks for older Emacsen
742 ;; `characterp' isn't defined in Emacs versions < 23
743 (unless (fboundp 'characterp)
744 (defalias 'characterp 'char-valid-p))
746 ;; `region-active-p' isn't defined in Emacs versions < 23
747 (unless (fboundp 'region-active-p)
748 (defun region-active-p () (and transient-mark-mode mark-active)))
751 ;; `registerv' defstruct isn't defined in Emacs versions < 24
752 (unless (fboundp 'registerv-make)
753 (defmacro registerv-make (data &rest _dummy) data))
755 (unless (fboundp 'registerv-data)
756 (defmacro registerv-data (data) data))
759 ;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
760 ;; versions < 24 (copied and adapted from Emacs 24)
761 (unless (fboundp 'diff-no-select)
762 (defun diff-no-select (old new &optional switches no-async buf)
763 ;; Noninteractive helper for creating and reverting diff buffers
764 (unless (bufferp new) (setq new (expand-file-name new)))
765 (unless (bufferp old) (setq old (expand-file-name old)))
766 (or switches (setq switches diff-switches)) ; If not specified, use default.
767 (unless (listp switches) (setq switches (list switches)))
768 (or buf (setq buf (get-buffer-create "*Diff*")))
769 (let* ((old-alt (diff-file-local-copy old))
770 (new-alt (diff-file-local-copy new))
774 ;; Use explicitly specified switches
776 ,@(mapcar #'shell-quote-argument
778 (when (or old-alt new-alt)
779 (list "-L" (if (stringp old)
780 old (prin1-to-string old))
781 "-L" (if (stringp new)
782 new (prin1-to-string new))))
783 (list (or old-alt old)
786 (thisdir default-directory))
787 (with-current-buffer buf
788 (setq buffer-read-only t)
789 (buffer-disable-undo (current-buffer))
790 (let ((inhibit-read-only t))
792 (buffer-enable-undo (current-buffer))
794 (set (make-local-variable 'revert-buffer-function)
795 (lambda (_ignore-auto _noconfirm)
796 (diff-no-select old new switches no-async (current-buffer))))
797 (setq default-directory thisdir)
798 (let ((inhibit-read-only t))
799 (insert command "\n"))
800 (if (and (not no-async) (fboundp 'start-process))
801 (let ((proc (start-process "Diff" buf shell-file-name
802 shell-command-switch command)))
803 (set-process-filter proc 'diff-process-filter)
804 (set-process-sentinel
805 proc (lambda (proc _msg)
806 (with-current-buffer (process-buffer proc)
807 (diff-sentinel (process-exit-status proc))
808 (if old-alt (delete-file old-alt))
809 (if new-alt (delete-file new-alt))))))
810 ;; Async processes aren't available.
811 (let ((inhibit-read-only t))
813 (call-process shell-file-name nil buf nil
814 shell-command-switch command))
815 (if old-alt (delete-file old-alt))
816 (if new-alt (delete-file new-alt)))))
819 (unless (fboundp 'diff-file-local-copy)
820 (defun diff-file-local-copy (file-or-buf)
821 (if (bufferp file-or-buf)
822 (with-current-buffer file-or-buf
823 (let ((tempfile (make-temp-file "buffer-content-")))
824 (write-region nil nil tempfile nil 'nomessage)
826 (file-local-copy file-or-buf))))
829 ;; `user-error' isn't defined in Emacs < 24.3
830 (unless (fboundp 'user-error)
831 (defalias 'user-error 'error)
832 ;; prevent debugger being called on user errors
833 (add-to-list 'debug-ignored-errors "^No further undo information")
834 (add-to-list 'debug-ignored-errors "^No further redo information")
835 (add-to-list 'debug-ignored-errors "^No further redo information for region"))
841 ;;; =====================================================================
842 ;;; Global variables and customization options
844 (defvar buffer-undo-tree nil
845 "Tree of undo entries in current buffer.")
846 (put 'buffer-undo-tree 'permanent-local t)
847 (make-variable-buffer-local 'buffer-undo-tree)
850 (defgroup undo-tree nil
854 (defcustom undo-tree-mode-lighter " Undo-Tree"
855 "Lighter displayed in mode line
856 when `undo-tree-mode' is enabled."
861 (defcustom undo-tree-incompatible-major-modes '(term-mode)
862 "List of major-modes in which `undo-tree-mode' should not be enabled.
863 \(See `turn-on-undo-tree-mode'.\)"
865 :type '(repeat symbol))
868 (defcustom undo-tree-enable-undo-in-region t
869 "When non-nil, enable undo-in-region.
871 When undo-in-region is enabled, undoing or redoing when the
872 region is active (in `transient-mark-mode') or with a prefix
873 argument (not in `transient-mark-mode') only undoes changes
874 within the current region."
879 (defcustom undo-tree-auto-save-history nil
880 "When non-nil, `undo-tree-mode' will save undo history to file
881 when a buffer is saved to file.
883 It will automatically load undo history when a buffer is loaded
884 from file, if an undo save file exists.
886 By default, undo-tree history is saved to a file called
887 \".<buffer-file-name>.~undo-tree~\" in the same directory as the
888 file itself. To save under a different directory, customize
889 `undo-tree-history-directory-alist' (see the documentation for
890 that variable for details).
892 WARNING! `undo-tree-auto-save-history' will not work properly in
893 Emacs versions prior to 24.3, so it cannot be enabled via
894 the customization interface in versions earlier than that one. To
895 ignore this warning and enable it regardless, set
896 `undo-tree-auto-save-history' to a non-nil value outside of
899 :type (if (version-list-< (version-to-list emacs-version) '(24 3))
900 '(choice (const :tag "<disabled>" nil))
904 (defcustom undo-tree-history-directory-alist nil
905 "Alist of filename patterns and undo history directory names.
906 Each element looks like (REGEXP . DIRECTORY). Undo history for
907 files with names matching REGEXP will be saved in DIRECTORY.
908 DIRECTORY may be relative or absolute. If it is absolute, so
909 that all matching files are backed up into the same directory,
910 the file names in this directory will be the full name of the
911 file backed up with all directory separators changed to `!' to
912 prevent clashes. This will not work correctly if your filesystem
913 truncates the resulting name.
915 For the common case of all backups going into one directory, the
916 alist should contain a single element pairing \".\" with the
917 appropriate directory name.
919 If this variable is nil, or it fails to match a filename, the
920 backup is made in the original file's directory.
922 On MS-DOS filesystems without long names this variable is always
925 :type '(repeat (cons (regexp :tag "Regexp matching filename")
926 (directory :tag "Undo history directory name"))))
930 (defcustom undo-tree-visualizer-relative-timestamps t
931 "When non-nil, display times relative to current time
932 when displaying time stamps in visualizer.
934 Otherwise, display absolute times."
939 (defcustom undo-tree-visualizer-timestamps nil
940 "When non-nil, display time-stamps by default
941 in undo-tree visualizer.
943 \\<undo-tree-visualizer-mode-map>You can always toggle time-stamps on and off \
944 using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
945 setting of this variable."
950 (defcustom undo-tree-visualizer-diff nil
951 "When non-nil, display diff by default in undo-tree visualizer.
953 \\<undo-tree-visualizer-mode-map>You can always toggle the diff display \
954 using \\[undo-tree-visualizer-toggle-diff], regardless of the
955 setting of this variable."
960 (defcustom undo-tree-visualizer-lazy-drawing 100
961 "When non-nil, use lazy undo-tree drawing in visualizer.
963 Setting this to a number causes the visualizer to switch to lazy
964 drawing when the number of nodes in the tree is larger than this
967 Lazy drawing means that only the visible portion of the tree will
968 be drawn initially, and the tree will be extended later as
969 needed. For the most part, the only visible effect of this is to
970 significantly speed up displaying the visualizer for very large
973 There is one potential negative effect of lazy drawing. Other
974 branches of the tree will only be drawn once the node from which
975 they branch off becomes visible. So it can happen that certain
976 portions of the tree that would be shown with lazy drawing
977 disabled, will not be drawn immediately when it is
978 enabled. However, this effect is quite rare in practice."
980 :type '(choice (const :tag "never" nil)
981 (const :tag "always" t)
982 (integer :tag "> size")))
985 (defface undo-tree-visualizer-default-face
986 '((((class color)) :foreground "gray"))
987 "Face used to draw undo-tree in visualizer."
990 (defface undo-tree-visualizer-current-face
991 '((((class color)) :foreground "red"))
992 "Face used to highlight current undo-tree node in visualizer."
995 (defface undo-tree-visualizer-active-branch-face
996 '((((class color) (background dark))
997 (:foreground "white" :weight bold))
998 (((class color) (background light))
999 (:foreground "black" :weight bold)))
1000 "Face used to highlight active undo-tree branch in visualizer."
1003 (defface undo-tree-visualizer-register-face
1004 '((((class color)) :foreground "yellow"))
1005 "Face used to highlight undo-tree nodes saved to a register
1009 (defface undo-tree-visualizer-unmodified-face
1010 '((((class color)) :foreground "cyan"))
1011 "Face used to highlight nodes corresponding to unmodified buffers
1016 (defvar undo-tree-visualizer-parent-buffer nil
1017 "Parent buffer in visualizer.")
1018 (put 'undo-tree-visualizer-parent-buffer 'permanent-local t)
1019 (make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
1021 ;; stores modification time of parent buffer's file, if any
1022 (defvar undo-tree-visualizer-parent-mtime nil)
1023 (put 'undo-tree-visualizer-parent-mtime 'permanent-local t)
1024 (make-variable-buffer-local 'undo-tree-visualizer-parent-mtime)
1026 ;; stores current horizontal spacing needed for drawing undo-tree
1027 (defvar undo-tree-visualizer-spacing nil)
1028 (put 'undo-tree-visualizer-spacing 'permanent-local t)
1029 (make-variable-buffer-local 'undo-tree-visualizer-spacing)
1031 ;; calculate horizontal spacing required for drawing tree with current
1033 (defsubst undo-tree-visualizer-calculate-spacing ()
1034 (if undo-tree-visualizer-timestamps
1035 (if undo-tree-visualizer-relative-timestamps 9 13)
1038 ;; holds node that was current when visualizer was invoked
1039 (defvar undo-tree-visualizer-initial-node nil)
1040 (put 'undo-tree-visualizer-initial-node 'permanent-local t)
1041 (make-variable-buffer-local 'undo-tree-visualizer-initial-node)
1043 ;; holds currently selected node in visualizer selection mode
1044 (defvar undo-tree-visualizer-selected-node nil)
1045 (put 'undo-tree-visualizer-selected-node 'permanent-local t)
1046 (make-variable-buffer-local 'undo-tree-visualizer-selected)
1048 ;; used to store nodes at edge of currently drawn portion of tree
1049 (defvar undo-tree-visualizer-needs-extending-down nil)
1050 (put 'undo-tree-visualizer-needs-extending-down 'permanent-local t)
1051 (make-variable-buffer-local 'undo-tree-visualizer-needs-extending-down)
1052 (defvar undo-tree-visualizer-needs-extending-up nil)
1053 (put 'undo-tree-visualizer-needs-extending-up 'permanent-local t)
1054 (make-variable-buffer-local 'undo-tree-visualizer-needs-extending-up)
1056 ;; dynamically bound to t when undoing from visualizer, to inhibit
1057 ;; `undo-tree-kill-visualizer' hook function in parent buffer
1058 (defvar undo-tree-inhibit-kill-visualizer nil)
1060 ;; can be let-bound to a face name, used in drawing functions
1061 (defvar undo-tree-insert-face nil)
1063 ;; visualizer buffer names
1064 (defconst undo-tree-visualizer-buffer-name " *undo-tree*")
1065 (defconst undo-tree-diff-buffer-name "*undo-tree Diff*")
1067 ;; install history-auto-save hooks
1068 (add-hook 'write-file-functions 'undo-tree-save-history-hook)
1069 (add-hook 'find-file-hook 'undo-tree-load-history-hook)
1074 ;;; =================================================================
1077 (defvar undo-tree-map nil
1078 "Keymap used in undo-tree-mode.")
1080 (unless undo-tree-map
1081 (let ((map (make-sparse-keymap)))
1082 ;; remap `undo' and `undo-only' to `undo-tree-undo'
1083 (define-key map [remap undo] 'undo-tree-undo)
1084 (define-key map [remap undo-only] 'undo-tree-undo)
1085 ;; bind standard undo bindings (since these match redo counterparts)
1086 (define-key map (kbd "C-/") 'undo-tree-undo)
1087 (define-key map "\C-_" 'undo-tree-undo)
1088 ;; redo doesn't exist normally, so define our own keybindings
1089 (define-key map (kbd "C-?") 'undo-tree-redo)
1090 (define-key map (kbd "M-_") 'undo-tree-redo)
1091 ;; just in case something has defined `redo'...
1092 (define-key map [remap redo] 'undo-tree-redo)
1093 ;; we use "C-x u" for the undo-tree visualizer
1094 (define-key map (kbd "\C-x u") 'undo-tree-visualize)
1095 ;; bind register commands
1096 (define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
1097 (define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
1099 (setq undo-tree-map map)))
1102 (defvar undo-tree-visualizer-mode-map nil
1103 "Keymap used in undo-tree visualizer.")
1105 (unless undo-tree-visualizer-mode-map
1106 (let ((map (make-sparse-keymap)))
1107 ;; vertical motion keys undo/redo
1108 (define-key map [remap previous-line] 'undo-tree-visualize-undo)
1109 (define-key map [remap next-line] 'undo-tree-visualize-redo)
1110 (define-key map [up] 'undo-tree-visualize-undo)
1111 (define-key map "p" 'undo-tree-visualize-undo)
1112 (define-key map "\C-p" 'undo-tree-visualize-undo)
1113 (define-key map [down] 'undo-tree-visualize-redo)
1114 (define-key map "n" 'undo-tree-visualize-redo)
1115 (define-key map "\C-n" 'undo-tree-visualize-redo)
1116 ;; horizontal motion keys switch branch
1117 (define-key map [remap forward-char]
1118 'undo-tree-visualize-switch-branch-right)
1119 (define-key map [remap backward-char]
1120 'undo-tree-visualize-switch-branch-left)
1121 (define-key map [right] 'undo-tree-visualize-switch-branch-right)
1122 (define-key map "f" 'undo-tree-visualize-switch-branch-right)
1123 (define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
1124 (define-key map [left] 'undo-tree-visualize-switch-branch-left)
1125 (define-key map "b" 'undo-tree-visualize-switch-branch-left)
1126 (define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
1127 ;; paragraph motion keys undo/redo to significant points in tree
1128 (define-key map [remap backward-paragraph] 'undo-tree-visualize-undo-to-x)
1129 (define-key map [remap forward-paragraph] 'undo-tree-visualize-redo-to-x)
1130 (define-key map "\M-{" 'undo-tree-visualize-undo-to-x)
1131 (define-key map "\M-}" 'undo-tree-visualize-redo-to-x)
1132 (define-key map [C-up] 'undo-tree-visualize-undo-to-x)
1133 (define-key map [C-down] 'undo-tree-visualize-redo-to-x)
1134 ;; mouse sets buffer state to node at click
1135 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
1136 ;; toggle timestamps
1137 (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
1139 (define-key map "d" 'undo-tree-visualizer-toggle-diff)
1140 ;; toggle selection mode
1141 (define-key map "s" 'undo-tree-visualizer-selection-mode)
1142 ;; horizontal scrolling may be needed if the tree is very wide
1143 (define-key map "," 'undo-tree-visualizer-scroll-left)
1144 (define-key map "." 'undo-tree-visualizer-scroll-right)
1145 (define-key map "<" 'undo-tree-visualizer-scroll-left)
1146 (define-key map ">" 'undo-tree-visualizer-scroll-right)
1147 ;; vertical scrolling may be needed if the tree is very tall
1148 (define-key map [next] 'undo-tree-visualizer-scroll-up)
1149 (define-key map [prior] 'undo-tree-visualizer-scroll-down)
1150 ;; quit/abort visualizer
1151 (define-key map "q" 'undo-tree-visualizer-quit)
1152 (define-key map "\C-q" 'undo-tree-visualizer-abort)
1154 (setq undo-tree-visualizer-mode-map map)))
1157 (defvar undo-tree-visualizer-selection-mode-map nil
1158 "Keymap used in undo-tree visualizer selection mode.")
1160 (unless undo-tree-visualizer-selection-mode-map
1161 (let ((map (make-sparse-keymap)))
1162 ;; vertical motion keys move up and down tree
1163 (define-key map [remap previous-line]
1164 'undo-tree-visualizer-select-previous)
1165 (define-key map [remap next-line]
1166 'undo-tree-visualizer-select-next)
1167 (define-key map [up] 'undo-tree-visualizer-select-previous)
1168 (define-key map "p" 'undo-tree-visualizer-select-previous)
1169 (define-key map "\C-p" 'undo-tree-visualizer-select-previous)
1170 (define-key map [down] 'undo-tree-visualizer-select-next)
1171 (define-key map "n" 'undo-tree-visualizer-select-next)
1172 (define-key map "\C-n" 'undo-tree-visualizer-select-next)
1173 ;; vertical scroll keys move up and down quickly
1174 (define-key map [next]
1175 (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
1176 (define-key map [prior]
1177 (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
1178 ;; horizontal motion keys move to left and right siblings
1179 (define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
1180 (define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
1181 (define-key map [right] 'undo-tree-visualizer-select-right)
1182 (define-key map "f" 'undo-tree-visualizer-select-right)
1183 (define-key map "\C-f" 'undo-tree-visualizer-select-right)
1184 (define-key map [left] 'undo-tree-visualizer-select-left)
1185 (define-key map "b" 'undo-tree-visualizer-select-left)
1186 (define-key map "\C-b" 'undo-tree-visualizer-select-left)
1187 ;; horizontal scroll keys move left or right quickly
1189 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1191 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1193 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1195 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1196 ;; <enter> sets buffer state to node at point
1197 (define-key map "\r" 'undo-tree-visualizer-set)
1198 ;; mouse selects node at click
1199 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-select)
1201 (define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
1203 (setq undo-tree-visualizer-selection-mode-map map)))
1206 (defvar undo-tree-old-undo-menu-item nil)
1208 (defun undo-tree-update-menu-bar ()
1209 "Update `undo-tree-mode' Edit menu items."
1212 ;; save old undo menu item, and install undo/redo menu items
1213 (setq undo-tree-old-undo-menu-item
1214 (cdr (assq 'undo (lookup-key global-map [menu-bar edit]))))
1215 (define-key (lookup-key global-map [menu-bar edit])
1216 [undo] '(menu-item "Undo" undo-tree-undo
1217 :enable (and undo-tree-mode
1218 (not buffer-read-only)
1219 (not (eq t buffer-undo-list))
1220 (undo-tree-node-previous
1221 (undo-tree-current buffer-undo-tree)))
1222 :help "Undo last operation"))
1223 (define-key-after (lookup-key global-map [menu-bar edit])
1224 [redo] '(menu-item "Redo" undo-tree-redo
1225 :enable (and undo-tree-mode
1226 (not buffer-read-only)
1227 (not (eq t buffer-undo-list))
1228 (undo-tree-node-next
1229 (undo-tree-current buffer-undo-tree)))
1230 :help "Redo last operation")
1232 ;; uninstall undo/redo menu items
1233 (define-key (lookup-key global-map [menu-bar edit])
1234 [undo] undo-tree-old-undo-menu-item)
1235 (define-key (lookup-key global-map [menu-bar edit])
1238 (add-hook 'menu-bar-update-hook 'undo-tree-update-menu-bar)
1244 ;;; =====================================================================
1245 ;;; Undo-tree data structure
1251 (:constructor make-undo-tree
1253 (root (undo-tree-make-node nil nil))
1257 (object-pool (make-hash-table :test 'eq :weakness 'value))))
1260 root current size count object-pool)
1266 (:type vector) ; create unnamed struct
1268 (:constructor undo-tree-make-node
1272 (timestamp (current-time))
1274 (:constructor undo-tree-make-node-backwards
1278 (next (list next-node))
1279 (timestamp (current-time))
1282 previous next undo redo timestamp branch meta-data)
1285 (defmacro undo-tree-node-p (n)
1286 (let ((len (length (undo-tree-make-node nil nil))))
1287 `(and (vectorp ,n) (= (length ,n) ,len))))
1292 (undo-tree-region-data
1293 (:type vector) ; create unnamed struct
1295 (:constructor undo-tree-make-region-data
1296 (&optional undo-beginning undo-end
1297 redo-beginning redo-end))
1298 (:constructor undo-tree-make-undo-region-data
1299 (undo-beginning undo-end))
1300 (:constructor undo-tree-make-redo-region-data
1301 (redo-beginning redo-end))
1303 undo-beginning undo-end redo-beginning redo-end)
1306 (defmacro undo-tree-region-data-p (r)
1307 (let ((len (length (undo-tree-make-region-data))))
1308 `(and (vectorp ,r) (= (length ,r) ,len))))
1310 (defmacro undo-tree-node-clear-region-data (node)
1311 `(setf (undo-tree-node-meta-data ,node)
1314 (plist-put (undo-tree-node-meta-data ,node)
1318 (defmacro undo-tree-node-undo-beginning (node)
1319 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1320 (when (undo-tree-region-data-p r)
1321 (undo-tree-region-data-undo-beginning r))))
1323 (defmacro undo-tree-node-undo-end (node)
1324 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1325 (when (undo-tree-region-data-p r)
1326 (undo-tree-region-data-undo-end r))))
1328 (defmacro undo-tree-node-redo-beginning (node)
1329 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1330 (when (undo-tree-region-data-p r)
1331 (undo-tree-region-data-redo-beginning r))))
1333 (defmacro undo-tree-node-redo-end (node)
1334 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1335 (when (undo-tree-region-data-p r)
1336 (undo-tree-region-data-redo-end r))))
1339 (defsetf undo-tree-node-undo-beginning (node) (val)
1340 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1341 (unless (undo-tree-region-data-p r)
1342 (setf (undo-tree-node-meta-data ,node)
1343 (plist-put (undo-tree-node-meta-data ,node) :region
1344 (setq r (undo-tree-make-region-data)))))
1345 (setf (undo-tree-region-data-undo-beginning r) ,val)))
1347 (defsetf undo-tree-node-undo-end (node) (val)
1348 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1349 (unless (undo-tree-region-data-p r)
1350 (setf (undo-tree-node-meta-data ,node)
1351 (plist-put (undo-tree-node-meta-data ,node) :region
1352 (setq r (undo-tree-make-region-data)))))
1353 (setf (undo-tree-region-data-undo-end r) ,val)))
1355 (defsetf undo-tree-node-redo-beginning (node) (val)
1356 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1357 (unless (undo-tree-region-data-p r)
1358 (setf (undo-tree-node-meta-data ,node)
1359 (plist-put (undo-tree-node-meta-data ,node) :region
1360 (setq r (undo-tree-make-region-data)))))
1361 (setf (undo-tree-region-data-redo-beginning r) ,val)))
1363 (defsetf undo-tree-node-redo-end (node) (val)
1364 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1365 (unless (undo-tree-region-data-p r)
1366 (setf (undo-tree-node-meta-data ,node)
1367 (plist-put (undo-tree-node-meta-data ,node) :region
1368 (setq r (undo-tree-make-region-data)))))
1369 (setf (undo-tree-region-data-redo-end r) ,val)))
1374 (undo-tree-visualizer-data
1375 (:type vector) ; create unnamed struct
1377 (:constructor undo-tree-make-visualizer-data
1378 (&optional lwidth cwidth rwidth marker))
1380 lwidth cwidth rwidth marker)
1383 (defmacro undo-tree-visualizer-data-p (v)
1384 (let ((len (length (undo-tree-make-visualizer-data))))
1385 `(and (vectorp ,v) (= (length ,v) ,len))))
1387 (defun undo-tree-node-clear-visualizer-data (node)
1388 (let ((plist (undo-tree-node-meta-data node)))
1389 (if (eq (car plist) :visualizer)
1390 (setf (undo-tree-node-meta-data node) (nthcdr 2 plist))
1391 (while (and plist (not (eq (cadr plist) :visualizer)))
1392 (setq plist (cdr plist)))
1393 (if plist (setcdr plist (nthcdr 3 plist))))))
1395 (defmacro undo-tree-node-lwidth (node)
1396 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1397 (when (undo-tree-visualizer-data-p v)
1398 (undo-tree-visualizer-data-lwidth v))))
1400 (defmacro undo-tree-node-cwidth (node)
1401 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1402 (when (undo-tree-visualizer-data-p v)
1403 (undo-tree-visualizer-data-cwidth v))))
1405 (defmacro undo-tree-node-rwidth (node)
1406 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1407 (when (undo-tree-visualizer-data-p v)
1408 (undo-tree-visualizer-data-rwidth v))))
1410 (defmacro undo-tree-node-marker (node)
1411 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1412 (when (undo-tree-visualizer-data-p v)
1413 (undo-tree-visualizer-data-marker v))))
1416 (defsetf undo-tree-node-lwidth (node) (val)
1417 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1418 (unless (undo-tree-visualizer-data-p v)
1419 (setf (undo-tree-node-meta-data ,node)
1420 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1421 (setq v (undo-tree-make-visualizer-data)))))
1422 (setf (undo-tree-visualizer-data-lwidth v) ,val)))
1424 (defsetf undo-tree-node-cwidth (node) (val)
1425 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1426 (unless (undo-tree-visualizer-data-p v)
1427 (setf (undo-tree-node-meta-data ,node)
1428 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1429 (setq v (undo-tree-make-visualizer-data)))))
1430 (setf (undo-tree-visualizer-data-cwidth v) ,val)))
1432 (defsetf undo-tree-node-rwidth (node) (val)
1433 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1434 (unless (undo-tree-visualizer-data-p v)
1435 (setf (undo-tree-node-meta-data ,node)
1436 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1437 (setq v (undo-tree-make-visualizer-data)))))
1438 (setf (undo-tree-visualizer-data-rwidth v) ,val)))
1440 (defsetf undo-tree-node-marker (node) (val)
1441 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1442 (unless (undo-tree-visualizer-data-p v)
1443 (setf (undo-tree-node-meta-data ,node)
1444 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1445 (setq v (undo-tree-make-visualizer-data)))))
1446 (setf (undo-tree-visualizer-data-marker v) ,val)))
1451 (undo-tree-register-data
1454 (:constructor undo-tree-make-register-data (buffer node)))
1457 (defun undo-tree-register-data-p (data)
1460 (undo-tree-node-p (undo-tree-register-data-node data))))
1462 (defun undo-tree-register-data-print-func (data)
1463 (princ (format "an undo-tree state for buffer %s"
1464 (undo-tree-register-data-buffer data))))
1466 (defmacro undo-tree-node-register (node)
1467 `(plist-get (undo-tree-node-meta-data ,node) :register))
1469 (defsetf undo-tree-node-register (node) (val)
1470 `(setf (undo-tree-node-meta-data ,node)
1471 (plist-put (undo-tree-node-meta-data ,node) :register ,val)))
1476 ;;; =====================================================================
1477 ;;; Basic undo-tree data structure functions
1479 (defun undo-tree-grow (undo)
1480 "Add an UNDO node to current branch of `buffer-undo-tree'."
1481 (let* ((current (undo-tree-current buffer-undo-tree))
1482 (new (undo-tree-make-node current undo)))
1483 (push new (undo-tree-node-next current))
1484 (setf (undo-tree-current buffer-undo-tree) new)))
1487 (defun undo-tree-grow-backwards (node undo &optional redo)
1488 "Add new node *above* undo-tree NODE, and return new node.
1489 Note that this will overwrite NODE's \"previous\" link, so should
1490 only be used on a detached NODE, never on nodes that are already
1491 part of `buffer-undo-tree'."
1492 (let ((new (undo-tree-make-node-backwards node undo redo)))
1493 (setf (undo-tree-node-previous node) new)
1497 (defun undo-tree-splice-node (node splice)
1498 "Splice NODE into undo tree, below node SPLICE.
1499 Note that this will overwrite NODE's \"next\" and \"previous\"
1500 links, so should only be used on a detached NODE, never on nodes
1501 that are already part of `buffer-undo-tree'."
1502 (setf (undo-tree-node-next node) (undo-tree-node-next splice)
1503 (undo-tree-node-branch node) (undo-tree-node-branch splice)
1504 (undo-tree-node-previous node) splice
1505 (undo-tree-node-next splice) (list node)
1506 (undo-tree-node-branch splice) 0)
1507 (dolist (n (undo-tree-node-next node))
1508 (setf (undo-tree-node-previous n) node)))
1511 (defun undo-tree-snip-node (node)
1512 "Snip NODE out of undo tree."
1513 (let* ((parent (undo-tree-node-previous node))
1515 ;; if NODE is only child, replace parent's next links with NODE's
1516 (if (= (length (undo-tree-node-next parent)) 0)
1517 (setf (undo-tree-node-next parent) (undo-tree-node-next node)
1518 (undo-tree-node-branch parent) (undo-tree-node-branch node))
1520 (setq position (undo-tree-position node (undo-tree-node-next parent)))
1522 ;; if active branch used do go via NODE, set parent's branch to active
1524 ((= (undo-tree-node-branch parent) position)
1525 (setf (undo-tree-node-branch parent)
1526 (+ position (undo-tree-node-branch node))))
1527 ;; if active branch didn't go via NODE, update parent's branch to point
1528 ;; to same node as before
1529 ((> (undo-tree-node-branch parent) position)
1530 (incf (undo-tree-node-branch parent)
1531 (1- (length (undo-tree-node-next node))))))
1532 ;; replace NODE in parent's next list with NODE's entire next list
1534 (setf (undo-tree-node-next parent)
1535 (nconc (undo-tree-node-next node)
1536 (cdr (undo-tree-node-next parent))))
1537 (setq p (nthcdr (1- position) (undo-tree-node-next parent)))
1538 (setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
1539 ;; update previous links of NODE's children
1540 (dolist (n (undo-tree-node-next node))
1541 (setf (undo-tree-node-previous n) parent))))
1544 (defun undo-tree-mapc (--undo-tree-mapc-function-- node)
1545 ;; Apply FUNCTION to NODE and to each node below it.
1546 (let ((stack (list node))
1549 (setq n (pop stack))
1550 (funcall --undo-tree-mapc-function-- n)
1551 (setq stack (append (undo-tree-node-next n) stack)))))
1554 (defmacro undo-tree-num-branches ()
1555 "Return number of branches at current undo tree node."
1556 '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
1559 (defun undo-tree-position (node list)
1560 "Find the first occurrence of NODE in LIST.
1561 Return the index of the matching item, or nil of not found.
1562 Comparison is done with `eq'."
1566 (when (eq node (car list)) (throw 'found i))
1568 (setq list (cdr list))))
1572 (defvar *undo-tree-id-counter* 0)
1573 (make-variable-buffer-local '*undo-tree-id-counter*)
1575 (defmacro undo-tree-generate-id ()
1576 ;; Generate a new, unique id (uninterned symbol).
1577 ;; The name is made by appending a number to "undo-tree-id".
1578 ;; (Copied from CL package `gensym'.)
1579 `(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*))))
1580 (make-symbol (format "undo-tree-id%d" num))))
1583 (defun undo-tree-decircle (undo-tree)
1584 ;; Nullify PREVIOUS links of UNDO-TREE nodes, to make UNDO-TREE data
1585 ;; structure non-circular.
1588 (dolist (n (undo-tree-node-next node))
1589 (setf (undo-tree-node-previous n) nil)))
1590 (undo-tree-root undo-tree)))
1593 (defun undo-tree-recircle (undo-tree)
1594 ;; Recreate PREVIOUS links of UNDO-TREE nodes, to restore circular UNDO-TREE
1598 (dolist (n (undo-tree-node-next node))
1599 (setf (undo-tree-node-previous n) node)))
1600 (undo-tree-root undo-tree)))
1605 ;;; =====================================================================
1606 ;;; Undo list and undo changeset utility functions
1608 (defmacro undo-list-marker-elt-p (elt)
1609 `(markerp (car-safe ,elt)))
1611 (defmacro undo-list-GCd-marker-elt-p (elt)
1612 ;; Return t if ELT is a marker element whose marker has been moved to the
1613 ;; object-pool, so may potentially have been garbage-collected.
1614 ;; Note: Valid marker undo elements should be uniquely identified as cons
1615 ;; cells with a symbol in the car (replacing the marker), and a number in
1616 ;; the cdr. However, to guard against future changes to undo element
1617 ;; formats, we perform an additional redundant check on the symbol name.
1618 `(and (car-safe ,elt)
1619 (symbolp (car ,elt))
1620 (let ((str (symbol-name (car ,elt))))
1621 (and (> (length str) 12)
1622 (string= (substring str 0 12) "undo-tree-id")))
1623 (numberp (cdr-safe ,elt))))
1626 (defun undo-tree-move-GC-elts-to-pool (elt)
1627 ;; Move elements that can be garbage-collected into `buffer-undo-tree'
1628 ;; object pool, substituting a unique id that can be used to retrieve them
1629 ;; later. (Only markers require this treatment currently.)
1630 (when (undo-list-marker-elt-p elt)
1631 (let ((id (undo-tree-generate-id)))
1632 (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
1636 (defun undo-tree-restore-GC-elts-from-pool (elt)
1637 ;; Replace object id's in ELT with corresponding objects from
1638 ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
1639 ;; any object in ELT has been garbage-collected.
1640 (if (undo-list-GCd-marker-elt-p elt)
1641 (when (setcar elt (gethash (car elt)
1642 (undo-tree-object-pool buffer-undo-tree)))
1647 (defun undo-list-clean-GCd-elts (undo-list)
1648 ;; Remove object id's from UNDO-LIST that refer to elements that have been
1649 ;; garbage-collected. UNDO-LIST is modified by side-effect.
1650 (while (undo-list-GCd-marker-elt-p (car undo-list))
1651 (unless (gethash (caar undo-list)
1652 (undo-tree-object-pool buffer-undo-tree))
1653 (setq undo-list (cdr undo-list))))
1654 (let ((p undo-list))
1656 (when (and (undo-list-GCd-marker-elt-p (cadr p))
1657 (null (gethash (car (cadr p))
1658 (undo-tree-object-pool buffer-undo-tree))))
1659 (setcdr p (cddr p)))
1664 (defun undo-list-pop-changeset (&optional discard-pos)
1665 ;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
1666 ;; any position entries from changeset.
1668 ;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
1669 ;; at head of undo list
1670 (while (or (null (car buffer-undo-list))
1671 (and discard-pos (integerp (car buffer-undo-list))))
1672 (setq buffer-undo-list (cdr buffer-undo-list)))
1673 ;; pop elements up to next undo boundary, discarding position entries if
1674 ;; DISCARD-POS is non-nil
1675 (if (eq (car buffer-undo-list) 'undo-tree-canary)
1676 (push nil buffer-undo-list)
1677 (let* ((changeset (list (pop buffer-undo-list)))
1680 (undo-tree-move-GC-elts-to-pool (car p))
1681 (while (and discard-pos (integerp (car buffer-undo-list)))
1682 (setq buffer-undo-list (cdr buffer-undo-list)))
1683 (and (car buffer-undo-list)
1684 (not (eq (car buffer-undo-list) 'undo-tree-canary))))
1685 (setcdr p (list (pop buffer-undo-list)))
1690 (defun undo-tree-copy-list (undo-list)
1691 ;; Return a deep copy of first changeset in `undo-list'. Object id's are
1692 ;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
1694 ;; if first element contains an object id, replace it with object from
1695 ;; pool, discarding element entirely if it's been GC'd
1696 (while (and undo-list (null copy))
1698 (undo-tree-restore-GC-elts-from-pool (pop undo-list))))
1700 (setq copy (list copy)
1702 ;; copy remaining elements, replacing object id's with objects from
1703 ;; pool, or discarding them entirely if they've been GC'd
1705 (when (setcdr p (undo-tree-restore-GC-elts-from-pool
1706 (undo-copy-list-1 (pop undo-list))))
1707 (setcdr p (list (cdr p)))
1713 (defun undo-list-transfer-to-tree ()
1714 ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
1716 ;; `undo-list-transfer-to-tree' should never be called when undo is disabled
1717 ;; (i.e. `buffer-undo-tree' is t)
1718 (assert (not (eq buffer-undo-tree t)))
1720 ;; if `buffer-undo-tree' is empty, create initial undo-tree
1721 (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
1722 ;; make sure there's a canary at end of `buffer-undo-list'
1723 (when (null buffer-undo-list)
1724 (setq buffer-undo-list '(nil undo-tree-canary)))
1726 (unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1727 (eq (car buffer-undo-list) 'undo-tree-canary))
1728 ;; create new node from first changeset in `buffer-undo-list', save old
1729 ;; `buffer-undo-tree' current node, and make new node the current node
1730 (let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
1731 (splice (undo-tree-current buffer-undo-tree))
1732 (size (undo-list-byte-size (undo-tree-node-undo node)))
1734 (setf (undo-tree-current buffer-undo-tree) node)
1735 ;; grow tree fragment backwards using `buffer-undo-list' changesets
1736 (while (and buffer-undo-list
1737 (not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
1739 (undo-tree-grow-backwards node (undo-list-pop-changeset)))
1740 (incf size (undo-list-byte-size (undo-tree-node-undo node)))
1742 ;; if no undo history has been discarded from `buffer-undo-list' since
1743 ;; last transfer, splice new tree fragment onto end of old
1744 ;; `buffer-undo-tree' current node
1745 (if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1746 (eq (car buffer-undo-list) 'undo-tree-canary))
1748 (setf (undo-tree-node-previous node) splice)
1749 (push node (undo-tree-node-next splice))
1750 (setf (undo-tree-node-branch splice) 0)
1751 (incf (undo-tree-size buffer-undo-tree) size)
1752 (incf (undo-tree-count buffer-undo-tree) count))
1753 ;; if undo history has been discarded, replace entire
1754 ;; `buffer-undo-tree' with new tree fragment
1755 (setq node (undo-tree-grow-backwards node nil))
1756 (setf (undo-tree-root buffer-undo-tree) node)
1757 (setq buffer-undo-list '(nil undo-tree-canary))
1758 (setf (undo-tree-size buffer-undo-tree) size)
1759 (setf (undo-tree-count buffer-undo-tree) count)
1760 (setq buffer-undo-list '(nil undo-tree-canary))))
1761 ;; discard undo history if necessary
1762 (undo-tree-discard-history)))
1765 (defun undo-list-byte-size (undo-list)
1766 ;; Return size (in bytes) of UNDO-LIST
1767 (let ((size 0) (p undo-list))
1769 (incf size 8) ; cons cells use up 8 bytes
1770 (when (and (consp (car p)) (stringp (caar p)))
1771 (incf size (string-bytes (caar p))))
1777 (defun undo-list-rebuild-from-tree ()
1778 "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
1779 (unless (eq buffer-undo-list t)
1780 (undo-list-transfer-to-tree)
1781 (setq buffer-undo-list nil)
1782 (when buffer-undo-tree
1783 (let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
1784 (push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
1786 (time-less-p (undo-tree-node-timestamp a)
1787 (undo-tree-node-timestamp b))))
1789 ;; Traverse tree in depth-and-oldest-first order, but add undo records
1790 ;; on the way down, and redo records on the way up.
1791 (while (or (car stack)
1792 (not (eq (car (nth 1 stack))
1793 (undo-tree-current buffer-undo-tree))))
1796 (setq buffer-undo-list
1797 (append (undo-tree-node-undo (caar stack))
1800 (push (sort (mapcar 'identity
1801 (undo-tree-node-next (caar stack)))
1803 (time-less-p (undo-tree-node-timestamp a)
1804 (undo-tree-node-timestamp b))))
1807 (setq buffer-undo-list
1808 (append (undo-tree-node-redo (caar stack))
1811 (pop (car stack))))))))
1816 ;;; =====================================================================
1817 ;;; History discarding utility functions
1819 (defun undo-tree-oldest-leaf (node)
1820 ;; Return oldest leaf node below NODE.
1821 (while (undo-tree-node-next node)
1823 (car (sort (mapcar 'identity (undo-tree-node-next node))
1825 (time-less-p (undo-tree-node-timestamp a)
1826 (undo-tree-node-timestamp b)))))))
1830 (defun undo-tree-discard-node (node)
1831 ;; Discard NODE from `buffer-undo-tree', and return next in line for
1834 ;; don't discard current node
1835 (unless (eq node (undo-tree-current buffer-undo-tree))
1837 ;; discarding root node...
1838 (if (eq node (undo-tree-root buffer-undo-tree))
1840 ;; should always discard branches before root
1841 ((> (length (undo-tree-node-next node)) 1)
1842 (error "Trying to discard undo-tree root which still\
1843 has multiple branches"))
1844 ;; don't discard root if current node is only child
1845 ((eq (car (undo-tree-node-next node))
1846 (undo-tree-current buffer-undo-tree))
1850 ;; clear any register referring to root
1851 (let ((r (undo-tree-node-register node)))
1852 (when (and r (eq (get-register r) node))
1853 (set-register r nil)))
1854 ;; make child of root into new root
1855 (setq node (setf (undo-tree-root buffer-undo-tree)
1856 (car (undo-tree-node-next node))))
1857 ;; update undo-tree size
1858 (decf (undo-tree-size buffer-undo-tree)
1859 (+ (undo-list-byte-size (undo-tree-node-undo node))
1860 (undo-list-byte-size (undo-tree-node-redo node))))
1861 (decf (undo-tree-count buffer-undo-tree))
1862 ;; discard new root's undo data and PREVIOUS link
1863 (setf (undo-tree-node-undo node) nil
1864 (undo-tree-node-redo node) nil
1865 (undo-tree-node-previous node) nil)
1866 ;; if new root has branches, or new root is current node, next node
1867 ;; to discard is oldest leaf, otherwise it's new root
1868 (if (or (> (length (undo-tree-node-next node)) 1)
1869 (eq (car (undo-tree-node-next node))
1870 (undo-tree-current buffer-undo-tree)))
1871 (undo-tree-oldest-leaf node)
1874 ;; discarding leaf node...
1875 (let* ((parent (undo-tree-node-previous node))
1876 (current (nth (undo-tree-node-branch parent)
1877 (undo-tree-node-next parent))))
1878 ;; clear any register referring to the discarded node
1879 (let ((r (undo-tree-node-register node)))
1880 (when (and r (eq (get-register r) node))
1881 (set-register r nil)))
1882 ;; update undo-tree size
1883 (decf (undo-tree-size buffer-undo-tree)
1884 (+ (undo-list-byte-size (undo-tree-node-undo node))
1885 (undo-list-byte-size (undo-tree-node-redo node))))
1886 (decf (undo-tree-count buffer-undo-tree))
1888 (setf (undo-tree-node-next parent)
1889 (delq node (undo-tree-node-next parent))
1890 (undo-tree-node-branch parent)
1891 (undo-tree-position current (undo-tree-node-next parent)))
1892 ;; if parent has branches, or parent is current node, next node to
1893 ;; discard is oldest leaf, otherwise it's the parent itself
1894 (if (or (eq parent (undo-tree-current buffer-undo-tree))
1895 (and (undo-tree-node-next parent)
1896 (or (not (eq parent (undo-tree-root buffer-undo-tree)))
1897 (> (length (undo-tree-node-next parent)) 1))))
1898 (undo-tree-oldest-leaf parent)
1903 (defun undo-tree-discard-history ()
1904 "Discard undo history until we're within memory usage limits
1905 set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
1907 (when (> (undo-tree-size buffer-undo-tree) undo-limit)
1908 ;; if there are no branches off root, first node to discard is root;
1909 ;; otherwise it's leaf node at botom of oldest branch
1910 (let ((node (if (> (length (undo-tree-node-next
1911 (undo-tree-root buffer-undo-tree))) 1)
1912 (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
1913 (undo-tree-root buffer-undo-tree))))
1915 ;; discard nodes until memory use is within `undo-strong-limit'
1917 (> (undo-tree-size buffer-undo-tree) undo-strong-limit))
1918 (setq node (undo-tree-discard-node node)))
1920 ;; discard nodes until next node to discard would bring memory use
1921 ;; within `undo-limit'
1923 ;; check first if last discard has brought us within
1924 ;; `undo-limit', in case we can avoid more expensive
1925 ;; `undo-strong-limit' calculation
1926 ;; Note: this assumes undo-strong-limit > undo-limit;
1927 ;; if not, effectively undo-strong-limit = undo-limit
1928 (> (undo-tree-size buffer-undo-tree) undo-limit)
1929 (> (- (undo-tree-size buffer-undo-tree)
1930 ;; if next node to discard is root, the memory we
1931 ;; free-up comes from discarding changesets from its
1933 (if (eq node (undo-tree-root buffer-undo-tree))
1934 (+ (undo-list-byte-size
1935 (undo-tree-node-undo
1936 (car (undo-tree-node-next node))))
1937 (undo-list-byte-size
1938 (undo-tree-node-redo
1939 (car (undo-tree-node-next node)))))
1940 ;; ...otherwise, it comes from discarding changesets
1941 ;; from along with the node itself
1942 (+ (undo-list-byte-size (undo-tree-node-undo node))
1943 (undo-list-byte-size (undo-tree-node-redo node)))
1946 (setq node (undo-tree-discard-node node)))
1948 ;; if we're still over the `undo-outer-limit', discard entire history
1949 (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
1950 ;; query first if `undo-ask-before-discard' is set
1951 (if undo-ask-before-discard
1954 "Buffer `%s' undo info is %d bytes long; discard it? "
1955 (buffer-name) (undo-tree-size buffer-undo-tree)))
1956 (setq buffer-undo-tree nil))
1957 ;; otherwise, discard and display warning
1959 '(undo discard-info)
1961 (format "Buffer `%s' undo info was %d bytes long.\n"
1962 (buffer-name) (undo-tree-size buffer-undo-tree))
1963 "The undo info was discarded because it exceeded\
1966 This is normal if you executed a command that made a huge change
1967 to the buffer. In that case, to prevent similar problems in the
1968 future, set `undo-outer-limit' to a value that is large enough to
1969 cover the maximum size of normal changes you expect a single
1970 command to make, but not so large that it might exceed the
1971 maximum memory allotted to Emacs.
1973 If you did not execute any such command, the situation is
1974 probably due to a bug and you should report it.
1976 You can disable the popping up of this buffer by adding the entry
1977 \(undo discard-info) to the user option `warning-suppress-types',
1978 which is defined in the `warnings' library.\n")
1980 (setq buffer-undo-tree nil)))
1986 ;;; =====================================================================
1987 ;;; Visualizer utility functions
1989 (defun undo-tree-compute-widths (node)
1990 "Recursively compute widths for nodes below NODE."
1991 (let ((stack (list node))
1994 ;; try to compute widths for node at top of stack
1995 (if (undo-tree-node-p
1996 (setq res (undo-tree-node-compute-widths (car stack))))
1997 ;; if computation fails, it returns a node whose widths still need
1998 ;; computing, which we push onto the stack
2000 ;; otherwise, store widths and remove it from stack
2001 (setf (undo-tree-node-lwidth (car stack)) (aref res 0)
2002 (undo-tree-node-cwidth (car stack)) (aref res 1)
2003 (undo-tree-node-rwidth (car stack)) (aref res 2))
2007 (defun undo-tree-node-compute-widths (node)
2008 ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
2009 ;; (in a vector) if successful. Otherwise, returns a node whose widths need
2010 ;; calculating before NODE's can be calculated.
2011 (let ((num-children (length (undo-tree-node-next node)))
2012 (lwidth 0) (cwidth 0) (rwidth 0) p)
2015 ;; leaf nodes have 0 width
2018 (undo-tree-node-lwidth node) 0
2019 (undo-tree-node-cwidth node) 1
2020 (undo-tree-node-rwidth node) 0))
2022 ;; odd number of children
2023 ((= (mod num-children 2) 1)
2024 (setq p (undo-tree-node-next node))
2025 ;; compute left-width
2026 (dotimes (i (/ num-children 2))
2027 (if (undo-tree-node-lwidth (car p))
2028 (incf lwidth (+ (undo-tree-node-lwidth (car p))
2029 (undo-tree-node-cwidth (car p))
2030 (undo-tree-node-rwidth (car p))))
2031 ;; if child's widths haven't been computed, return that child
2032 (throw 'need-widths (car p)))
2034 (if (undo-tree-node-lwidth (car p))
2035 (incf lwidth (undo-tree-node-lwidth (car p)))
2036 (throw 'need-widths (car p)))
2037 ;; centre-width is inherited from middle child
2038 (setf cwidth (undo-tree-node-cwidth (car p)))
2039 ;; compute right-width
2040 (incf rwidth (undo-tree-node-rwidth (car p)))
2042 (dotimes (i (/ num-children 2))
2043 (if (undo-tree-node-lwidth (car p))
2044 (incf rwidth (+ (undo-tree-node-lwidth (car p))
2045 (undo-tree-node-cwidth (car p))
2046 (undo-tree-node-rwidth (car p))))
2047 (throw 'need-widths (car p)))
2050 ;; even number of children
2052 (setq p (undo-tree-node-next node))
2053 ;; compute left-width
2054 (dotimes (i (/ num-children 2))
2055 (if (undo-tree-node-lwidth (car p))
2056 (incf lwidth (+ (undo-tree-node-lwidth (car p))
2057 (undo-tree-node-cwidth (car p))
2058 (undo-tree-node-rwidth (car p))))
2059 (throw 'need-widths (car p)))
2061 ;; centre-width is 0 when number of children is even
2063 ;; compute right-width
2064 (dotimes (i (/ num-children 2))
2065 (if (undo-tree-node-lwidth (car p))
2066 (incf rwidth (+ (undo-tree-node-lwidth (car p))
2067 (undo-tree-node-cwidth (car p))
2068 (undo-tree-node-rwidth (car p))))
2069 (throw 'need-widths (car p)))
2072 ;; return left-, centre- and right-widths
2073 (vector lwidth cwidth rwidth))))
2076 (defun undo-tree-clear-visualizer-data (tree)
2077 ;; Clear visualizer data below NODE.
2079 (lambda (n) (undo-tree-node-clear-visualizer-data n))
2080 (undo-tree-root tree)))
2083 (defun undo-tree-node-unmodified-p (node &optional mtime)
2084 ;; Return non-nil if NODE corresponds to a buffer state that once upon a
2085 ;; time was unmodified. If a file modification time MTIME is specified,
2086 ;; return non-nil if the corresponding buffer state really is unmodified.
2087 (let (changeset ntime)
2089 (or (undo-tree-node-redo node)
2090 (and (setq changeset (car (undo-tree-node-next node)))
2091 (undo-tree-node-undo changeset)))
2094 (dolist (elt changeset)
2095 (when (and (consp elt) (eq (car elt) t) (consp (cdr elt))
2096 (throw 'found (cdr elt)))))))
2099 ;; high-precision timestamps
2100 (if (listp (cdr ntime))
2102 ;; old-style timestamps
2103 (and (= (car ntime) (car mtime))
2104 (= (cdr ntime) (cadr mtime))))))))
2109 ;;; =====================================================================
2110 ;;; Undo-in-region utility functions
2112 ;; `undo-elt-in-region' uses this as a dynamically-scoped variable
2113 (defvar undo-adjusted-markers nil)
2116 (defun undo-tree-pull-undo-in-region-branch (start end)
2117 ;; Pull out entries from undo changesets to create a new undo-in-region
2118 ;; branch, which undoes changeset entries lying between START and END first,
2119 ;; followed by remaining entries from the changesets, before rejoining the
2120 ;; existing undo tree history. Repeated calls will, if appropriate, extend
2121 ;; the current undo-in-region branch rather than creating a new one.
2123 ;; if we're just reverting the last redo-in-region, we don't need to
2124 ;; manipulate the undo tree at all
2125 (if (undo-tree-reverting-redo-in-region-p start end)
2126 t ; return t to indicate success
2128 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2129 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2130 ;; don't have to treat the first element differently, we prepend a dummy
2131 ;; leading nil to the lists, and have the pointers point to that
2133 ;; Note: using '(nil) instead of (list nil) in the `let*' results in
2134 ;; bizarre errors when the code is byte-compiled, where parts of the
2135 ;; lists appear to survive across different calls to this function.
2136 ;; An obscure byte-compiler bug, perhaps?
2137 (let* ((region-changeset (list nil))
2138 (r region-changeset)
2139 (delta-list (list nil))
2141 (node (undo-tree-current buffer-undo-tree))
2142 (repeated-undo-in-region
2143 (undo-tree-repeated-undo-in-region-p start end))
2144 undo-adjusted-markers ; `undo-elt-in-region' expects this
2145 fragment splice original-fragment original-splice original-current
2146 got-visible-elt undo-list elt)
2148 ;; --- initialisation ---
2150 ;; if this is a repeated undo in the same region, start pulling changes
2151 ;; from NODE at which undo-in-region branch iss attached, and detatch
2152 ;; the branch, using it as initial FRAGMENT of branch being constructed
2153 (repeated-undo-in-region
2154 (setq original-current node
2155 fragment (car (undo-tree-node-next node))
2157 ;; undo up to node at which undo-in-region branch is attached
2158 ;; (recognizable as first node with more than one branch)
2159 (let ((mark-active nil))
2160 (while (= (length (undo-tree-node-next node)) 1)
2163 node (undo-tree-current buffer-undo-tree))))
2164 (when (eq splice node) (setq splice nil))
2165 ;; detatch undo-in-region branch
2166 (setf (undo-tree-node-next node)
2167 (delq fragment (undo-tree-node-next node))
2168 (undo-tree-node-previous fragment) nil
2169 original-fragment fragment
2170 original-splice node))
2172 ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
2173 ;; nodes below the current one in the active branch
2174 ((undo-tree-node-next node)
2175 (setq fragment (undo-tree-make-node nil nil)
2177 (while (setq node (nth (undo-tree-node-branch node)
2178 (undo-tree-node-next node)))
2179 (push (undo-tree-make-node
2181 (undo-copy-list (undo-tree-node-undo node))
2182 (undo-copy-list (undo-tree-node-redo node)))
2183 (undo-tree-node-next splice))
2184 (setq splice (car (undo-tree-node-next splice))))
2185 (setq fragment (car (undo-tree-node-next fragment))
2187 node (undo-tree-current buffer-undo-tree))))
2190 ;; --- pull undo-in-region elements into branch ---
2191 ;; work backwards up tree, pulling out undo elements within region until
2192 ;; we've got one that undoes a visible change (insertion or deletion)
2194 (while (and (not got-visible-elt) node (undo-tree-node-undo node))
2195 ;; we cons a dummy nil element on the front of the changeset so that
2196 ;; we can conveniently remove the first (real) element from the
2197 ;; changeset if we need to; the leading nil is removed once we're
2198 ;; done with this changeset
2199 (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
2200 elt (cadr undo-list))
2203 (setq fragment (undo-tree-grow-backwards fragment undo-list))
2204 (unless splice (setq splice fragment)))
2205 (setq fragment (undo-tree-make-node nil undo-list))
2206 (setq splice fragment))
2210 ;; keep elements within region
2211 ((undo-elt-in-region elt start end)
2212 ;; set flag if kept element is visible (insertion or deletion)
2213 (when (and (consp elt)
2214 (or (stringp (car elt)) (integerp (car elt))))
2215 (setq got-visible-elt t))
2216 ;; adjust buffer positions in elements previously undone before
2217 ;; kept element, as kept element will now be undone first
2218 (undo-tree-adjust-elements-to-elt splice elt)
2219 ;; move kept element to undo-in-region changeset, adjusting its
2220 ;; buffer position as it will now be undone first
2221 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
2223 (setcdr undo-list (cddr undo-list)))
2225 ;; discard "was unmodified" elements
2226 ;; FIXME: deal properly with these
2227 ((and (consp elt) (eq (car elt) t))
2228 (setcdr undo-list (cddr undo-list)))
2230 ;; if element crosses region, we can't pull any more elements
2231 ((undo-elt-crosses-region elt start end)
2232 ;; if we've found a visible element, it must be earlier in
2233 ;; current node's changeset; stop pulling elements (null
2234 ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
2236 (setq undo-list nil)
2237 ;; if we haven't found a visible element yet, pulling
2238 ;; undo-in-region branch has failed
2239 (setq region-changeset nil)
2242 ;; if rejecting element, add its delta (if any) to the list
2244 (let ((delta (undo-delta elt)))
2245 (when (/= 0 (cdr delta))
2246 (setcdr d (list delta))
2248 (setq undo-list (cdr undo-list))))
2250 ;; process next element of current changeset
2251 (setq elt (cadr undo-list)))
2253 ;; if there are remaining elements in changeset, remove dummy nil
2255 (if (cadr (undo-tree-node-undo fragment))
2256 (pop (undo-tree-node-undo fragment))
2257 ;; otherwise, if we've kept all elements in changeset, discard
2259 (when (eq splice fragment) (setq splice nil))
2260 (setq fragment (car (undo-tree-node-next fragment))))
2261 ;; process changeset from next node up the tree
2262 (setq node (undo-tree-node-previous node))))
2264 ;; pop dummy nil from front of `region-changeset'
2265 (setq region-changeset (cdr region-changeset))
2268 ;; --- integrate branch into tree ---
2269 ;; if no undo-in-region elements were found, restore undo tree
2270 (if (null region-changeset)
2271 (when original-current
2272 (push original-fragment (undo-tree-node-next original-splice))
2273 (setf (undo-tree-node-branch original-splice) 0
2274 (undo-tree-node-previous original-fragment) original-splice)
2275 (let ((mark-active nil))
2276 (while (not (eq (undo-tree-current buffer-undo-tree)
2278 (undo-tree-redo-1)))
2279 nil) ; return nil to indicate failure
2282 ;; need to undo up to node where new branch will be attached, to
2283 ;; ensure redo entries are populated, and then redo back to where we
2285 (let ((mark-active nil)
2286 (current (undo-tree-current buffer-undo-tree)))
2287 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2289 (while (not (eq (undo-tree-current buffer-undo-tree) current))
2290 (undo-tree-redo-1)))
2293 ;; if there's no remaining fragment, just create undo-in-region node
2294 ;; and attach it to parent of last node from which elements were
2297 (setq fragment (undo-tree-make-node node region-changeset))
2298 (push fragment (undo-tree-node-next node))
2299 (setf (undo-tree-node-branch node) 0)
2300 ;; set current node to undo-in-region node
2301 (setf (undo-tree-current buffer-undo-tree) fragment))
2303 ;; if no splice point has been set, add undo-in-region node to top of
2304 ;; fragment and attach it to parent of last node from which elements
2307 (setq fragment (undo-tree-grow-backwards fragment region-changeset))
2308 (push fragment (undo-tree-node-next node))
2309 (setf (undo-tree-node-branch node) 0
2310 (undo-tree-node-previous fragment) node)
2311 ;; set current node to undo-in-region node
2312 (setf (undo-tree-current buffer-undo-tree) fragment))
2314 ;; if fragment contains nodes, attach fragment to parent of last node
2315 ;; from which elements were pulled, and splice in undo-in-region node
2317 (setf (undo-tree-node-previous fragment) node)
2318 (push fragment (undo-tree-node-next node))
2319 (setf (undo-tree-node-branch node) 0)
2320 ;; if this is a repeated undo-in-region, then we've left the current
2321 ;; node at the original splice-point; we need to set the current
2322 ;; node to the equivalent node on the undo-in-region branch and redo
2323 ;; back to where we started
2324 (when repeated-undo-in-region
2325 (setf (undo-tree-current buffer-undo-tree)
2326 (undo-tree-node-previous original-fragment))
2327 (let ((mark-active nil))
2328 (while (not (eq (undo-tree-current buffer-undo-tree) splice))
2329 (undo-tree-redo-1 nil 'preserve-undo))))
2330 ;; splice new undo-in-region node into fragment
2331 (setq node (undo-tree-make-node nil region-changeset))
2332 (undo-tree-splice-node node splice)
2333 ;; set current node to undo-in-region node
2334 (setf (undo-tree-current buffer-undo-tree) node)))
2336 ;; update undo-tree size
2337 (setq node (undo-tree-node-previous fragment))
2339 (and (setq node (car (undo-tree-node-next node)))
2340 (not (eq node original-fragment))
2341 (incf (undo-tree-count buffer-undo-tree))
2342 (incf (undo-tree-size buffer-undo-tree)
2343 (+ (undo-list-byte-size (undo-tree-node-undo node))
2344 (undo-list-byte-size (undo-tree-node-redo node)))))))
2345 t) ; indicate undo-in-region branch was successfully pulled
2350 (defun undo-tree-pull-redo-in-region-branch (start end)
2351 ;; Pull out entries from redo changesets to create a new redo-in-region
2352 ;; branch, which redoes changeset entries lying between START and END first,
2353 ;; followed by remaining entries from the changesets. Repeated calls will,
2354 ;; if appropriate, extend the current redo-in-region branch rather than
2355 ;; creating a new one.
2357 ;; if we're just reverting the last undo-in-region, we don't need to
2358 ;; manipulate the undo tree at all
2359 (if (undo-tree-reverting-undo-in-region-p start end)
2360 t ; return t to indicate success
2362 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2363 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2364 ;; don't have to treat the first element differently, we prepend a dummy
2365 ;; leading nil to the lists, and have the pointers point to that
2367 ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
2368 ;; errors when the code is byte-compiled, where parts of the lists
2369 ;; appear to survive across different calls to this function. An
2370 ;; obscure byte-compiler bug, perhaps?
2371 (let* ((region-changeset (list nil))
2372 (r region-changeset)
2373 (delta-list (list nil))
2375 (node (undo-tree-current buffer-undo-tree))
2376 (repeated-redo-in-region
2377 (undo-tree-repeated-redo-in-region-p start end))
2378 undo-adjusted-markers ; `undo-elt-in-region' expects this
2379 fragment splice got-visible-elt redo-list elt)
2381 ;; --- inisitalisation ---
2383 ;; if this is a repeated redo-in-region, detach fragment below current
2385 (repeated-redo-in-region
2386 (when (setq fragment (car (undo-tree-node-next node)))
2387 (setf (undo-tree-node-previous fragment) nil
2388 (undo-tree-node-next node)
2389 (delq fragment (undo-tree-node-next node)))))
2390 ;; if this is a new redo-in-region, initial fragment is a copy of all
2391 ;; nodes below the current one in the active branch
2392 ((undo-tree-node-next node)
2393 (setq fragment (undo-tree-make-node nil nil)
2395 (while (setq node (nth (undo-tree-node-branch node)
2396 (undo-tree-node-next node)))
2397 (push (undo-tree-make-node
2399 (undo-copy-list (undo-tree-node-redo node)))
2400 (undo-tree-node-next splice))
2401 (setq splice (car (undo-tree-node-next splice))))
2402 (setq fragment (car (undo-tree-node-next fragment)))))
2405 ;; --- pull redo-in-region elements into branch ---
2406 ;; work down fragment, pulling out redo elements within region until
2407 ;; we've got one that redoes a visible change (insertion or deletion)
2408 (setq node fragment)
2410 (while (and (not got-visible-elt) node (undo-tree-node-redo node))
2411 ;; we cons a dummy nil element on the front of the changeset so that
2412 ;; we can conveniently remove the first (real) element from the
2413 ;; changeset if we need to; the leading nil is removed once we're
2414 ;; done with this changeset
2415 (setq redo-list (push nil (undo-tree-node-redo node))
2416 elt (cadr redo-list))
2419 ;; keep elements within region
2420 ((undo-elt-in-region elt start end)
2421 ;; set flag if kept element is visible (insertion or deletion)
2422 (when (and (consp elt)
2423 (or (stringp (car elt)) (integerp (car elt))))
2424 (setq got-visible-elt t))
2425 ;; adjust buffer positions in elements previously redone before
2426 ;; kept element, as kept element will now be redone first
2427 (undo-tree-adjust-elements-to-elt fragment elt t)
2428 ;; move kept element to redo-in-region changeset, adjusting its
2429 ;; buffer position as it will now be redone first
2430 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
2432 (setcdr redo-list (cddr redo-list)))
2434 ;; discard "was unmodified" elements
2435 ;; FIXME: deal properly with these
2436 ((and (consp elt) (eq (car elt) t))
2437 (setcdr redo-list (cddr redo-list)))
2439 ;; if element crosses region, we can't pull any more elements
2440 ((undo-elt-crosses-region elt start end)
2441 ;; if we've found a visible element, it must be earlier in
2442 ;; current node's changeset; stop pulling elements (null
2443 ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
2445 (setq redo-list nil)
2446 ;; if we haven't found a visible element yet, pulling
2447 ;; redo-in-region branch has failed
2448 (setq region-changeset nil)
2451 ;; if rejecting element, add its delta (if any) to the list
2453 (let ((delta (undo-delta elt)))
2454 (when (/= 0 (cdr delta))
2455 (setcdr d (list delta))
2457 (setq redo-list (cdr redo-list))))
2459 ;; process next element of current changeset
2460 (setq elt (cadr redo-list)))
2462 ;; if there are remaining elements in changeset, remove dummy nil
2464 (if (cadr (undo-tree-node-redo node))
2465 (pop (undo-tree-node-undo node))
2466 ;; otherwise, if we've kept all elements in changeset, discard
2468 (if (eq fragment node)
2469 (setq fragment (car (undo-tree-node-next fragment)))
2470 (undo-tree-snip-node node)))
2471 ;; process changeset from next node in fragment
2472 (setq node (car (undo-tree-node-next node)))))
2474 ;; pop dummy nil from front of `region-changeset'
2475 (setq region-changeset (cdr region-changeset))
2478 ;; --- integrate branch into tree ---
2479 (setq node (undo-tree-current buffer-undo-tree))
2480 ;; if no redo-in-region elements were found, restore undo tree
2481 (if (null (car region-changeset))
2482 (when (and repeated-redo-in-region fragment)
2483 (push fragment (undo-tree-node-next node))
2484 (setf (undo-tree-node-branch node) 0
2485 (undo-tree-node-previous fragment) node)
2486 nil) ; return nil to indicate failure
2488 ;; otherwise, add redo-in-region node to top of fragment, and attach
2489 ;; it below current node
2492 (undo-tree-grow-backwards fragment nil region-changeset)
2493 (undo-tree-make-node nil nil region-changeset)))
2494 (push fragment (undo-tree-node-next node))
2495 (setf (undo-tree-node-branch node) 0
2496 (undo-tree-node-previous fragment) node)
2497 ;; update undo-tree size
2498 (unless repeated-redo-in-region
2499 (setq node fragment)
2500 (while (and (setq node (car (undo-tree-node-next node)))
2501 (incf (undo-tree-count buffer-undo-tree))
2502 (incf (undo-tree-size buffer-undo-tree)
2503 (undo-list-byte-size
2504 (undo-tree-node-redo node))))))
2505 (incf (undo-tree-size buffer-undo-tree)
2506 (undo-list-byte-size (undo-tree-node-redo fragment)))
2507 t) ; indicate redo-in-region branch was successfully pulled
2512 (defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
2513 "Adjust buffer positions of undo elements, starting at NODE's
2514 and going up the tree (or down the active branch if BELOW is
2515 non-nil) and through the nodes' undo elements until we reach
2516 UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
2517 of either NODE itself or some node above it in the tree."
2518 (let ((delta (list (undo-delta undo-elt)))
2519 (undo-list (undo-tree-node-undo node)))
2520 ;; adjust elements until we reach UNDO-ELT
2521 (while (and (car undo-list)
2522 (not (eq (car undo-list) undo-elt)))
2524 (undo-tree-apply-deltas (car undo-list) delta -1))
2525 ;; move to next undo element in list, or to next node if we've run out
2527 (unless (car (setq undo-list (cdr undo-list)))
2529 (setq node (nth (undo-tree-node-branch node)
2530 (undo-tree-node-next node)))
2531 (setq node (undo-tree-node-previous node)))
2532 (setq undo-list (undo-tree-node-undo node))))))
2536 (defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
2537 ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
2538 ;; (only useful value for SGN is -1).
2539 (let (position offset)
2540 (dolist (delta deltas)
2541 (setq position (car delta)
2542 offset (* (cdr delta) (or sgn 1)))
2545 ((integerp undo-elt)
2546 (when (>= undo-elt position)
2547 (setq undo-elt (- undo-elt offset))))
2548 ;; nil (or any other atom)
2550 ;; (TEXT . POSITION)
2551 ((stringp (car undo-elt))
2552 (let ((text-pos (abs (cdr undo-elt)))
2553 (point-at-end (< (cdr undo-elt) 0)))
2554 (if (>= text-pos position)
2555 (setcdr undo-elt (* (if point-at-end -1 1)
2556 (- text-pos offset))))))
2558 ((integerp (car undo-elt))
2559 (when (>= (car undo-elt) position)
2560 (setcar undo-elt (- (car undo-elt) offset))
2561 (setcdr undo-elt (- (cdr undo-elt) offset))))
2562 ;; (nil PROPERTY VALUE BEG . END)
2563 ((null (car undo-elt))
2564 (let ((tail (nthcdr 3 undo-elt)))
2565 (when (>= (car tail) position)
2566 (setcar tail (- (car tail) offset))
2567 (setcdr tail (- (cdr tail) offset)))))
2573 (defun undo-tree-repeated-undo-in-region-p (start end)
2574 ;; Return non-nil if undo-in-region between START and END is a repeated
2576 (let ((node (undo-tree-current buffer-undo-tree)))
2578 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
2579 (eq (undo-tree-node-undo-beginning node) start)
2580 (eq (undo-tree-node-undo-end node) end))))
2583 (defun undo-tree-repeated-redo-in-region-p (start end)
2584 ;; Return non-nil if undo-in-region between START and END is a repeated
2586 (let ((node (undo-tree-current buffer-undo-tree)))
2587 (and (eq (undo-tree-node-redo-beginning node) start)
2588 (eq (undo-tree-node-redo-end node) end))))
2591 ;; Return non-nil if undo-in-region between START and END is simply
2592 ;; reverting the last redo-in-region
2593 (defalias 'undo-tree-reverting-undo-in-region-p
2594 'undo-tree-repeated-undo-in-region-p)
2597 ;; Return non-nil if redo-in-region between START and END is simply
2598 ;; reverting the last undo-in-region
2599 (defalias 'undo-tree-reverting-redo-in-region-p
2600 'undo-tree-repeated-redo-in-region-p)
2605 ;;; =====================================================================
2606 ;;; Undo-tree commands
2609 (define-minor-mode undo-tree-mode
2610 "Toggle undo-tree mode.
2611 With no argument, this command toggles the mode.
2612 A positive prefix argument turns the mode on.
2613 A negative prefix argument turns it off.
2615 Undo-tree-mode replaces Emacs' standard undo feature with a more
2616 powerful yet easier to use version, that treats the undo history
2617 as what it is: a tree.
2619 The following keys are available in `undo-tree-mode':
2623 Within the undo-tree visualizer, the following keys are available:
2625 \\{undo-tree-visualizer-mode-map}"
2628 undo-tree-mode-lighter ; lighter
2629 undo-tree-map ; keymap
2631 ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
2632 ;; Emacs undo can work
2633 (when (not undo-tree-mode)
2634 (undo-list-rebuild-from-tree)
2635 (setq buffer-undo-tree nil)))
2638 (defun turn-on-undo-tree-mode (&optional print-message)
2639 "Enable `undo-tree-mode' in the current buffer, when appropriate.
2640 Some major modes implement their own undo system, which should
2641 not normally be overridden by `undo-tree-mode'. This command does
2642 not enable `undo-tree-mode' in such buffers. If you want to force
2643 `undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
2646 The heuristic used to detect major modes in which
2647 `undo-tree-mode' should not be used is to check whether either
2648 the `undo' command has been remapped, or the default undo
2649 keybindings (C-/ and C-_) have been overridden somewhere other
2650 than in the global map. In addition, `undo-tree-mode' will not be
2651 enabled if the buffer's `major-mode' appears in
2652 `undo-tree-incompatible-major-modes'."
2654 (if (or (key-binding [remap undo])
2655 (undo-tree-overridden-undo-bindings-p)
2656 (memq major-mode undo-tree-incompatible-major-modes))
2658 (message "Buffer does not support undo-tree-mode;\
2659 undo-tree-mode NOT enabled"))
2660 (undo-tree-mode 1)))
2663 (defun undo-tree-overridden-undo-bindings-p ()
2664 "Returns t if default undo bindings are overridden, nil otherwise.
2665 Checks if either of the default undo key bindings (\"C-/\" or
2666 \"C-_\") are overridden in the current buffer by any keymap other
2667 than the global one. (So global redefinitions of the default undo
2668 key bindings do not count.)"
2669 (let ((binding1 (lookup-key (current-global-map) [?\C-/]))
2670 (binding2 (lookup-key (current-global-map) [?\C-_])))
2671 (global-set-key [?\C-/] 'undo)
2672 (global-set-key [?\C-_] 'undo)
2674 (or (and (key-binding [?\C-/])
2675 (not (eq (key-binding [?\C-/]) 'undo)))
2676 (and (key-binding [?\C-_])
2677 (not (eq (key-binding [?\C-_]) 'undo))))
2678 (global-set-key [?\C-/] binding1)
2679 (global-set-key [?\C-_] binding2))))
2683 (define-globalized-minor-mode global-undo-tree-mode
2684 undo-tree-mode turn-on-undo-tree-mode)
2688 (defun undo-tree-undo (&optional arg)
2690 Repeat this command to undo more changes.
2691 A numeric ARG serves as a repeat count.
2693 In Transient Mark mode when the mark is active, only undo changes
2694 within the current region. Similarly, when not in Transient Mark
2695 mode, just \\[universal-argument] as an argument limits undo to
2696 changes within the current region."
2698 ;; throw error if undo is disabled in buffer
2699 (when (eq buffer-undo-list t)
2700 (user-error "No undo information in this buffer"))
2701 (undo-tree-undo-1 arg)
2702 ;; inform user if at branch point
2703 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2706 (defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
2707 ;; Internal undo function. An active mark in `transient-mark-mode', or
2708 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
2709 ;; causes the existing redo record to be preserved, rather than replacing it
2710 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2711 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2712 ;; should *only* be used when temporarily visiting another undo state and
2713 ;; immediately returning to the original state afterwards. Otherwise, it
2714 ;; could cause history-discarding errors.)
2715 (let ((undo-in-progress t)
2716 (undo-in-region (and undo-tree-enable-undo-in-region
2717 (or (region-active-p)
2718 (and arg (not (numberp arg))))))
2720 ;; transfer entries accumulated in `buffer-undo-list' to
2721 ;; `buffer-undo-tree'
2722 (undo-list-transfer-to-tree)
2724 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2725 ;; check if at top of undo tree
2726 (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2727 (user-error "No further undo information"))
2729 ;; if region is active, or a non-numeric prefix argument was supplied,
2730 ;; try to pull out a new branch of changes affecting the region
2731 (when (and undo-in-region
2732 (not (undo-tree-pull-undo-in-region-branch
2733 (region-beginning) (region-end))))
2734 (user-error "No further undo information for region"))
2736 ;; remove any GC'd elements from node's undo list
2737 (setq current (undo-tree-current buffer-undo-tree))
2738 (decf (undo-tree-size buffer-undo-tree)
2739 (undo-list-byte-size (undo-tree-node-undo current)))
2740 (setf (undo-tree-node-undo current)
2741 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2742 (incf (undo-tree-size buffer-undo-tree)
2743 (undo-list-byte-size (undo-tree-node-undo current)))
2744 ;; undo one record from undo tree
2745 (when undo-in-region
2746 (setq pos (set-marker (make-marker) (point)))
2747 (set-marker-insertion-type pos t))
2748 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
2751 ;; if preserving old redo record, discard new redo entries that
2752 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2753 ;; elements from node's redo list
2756 (undo-list-pop-changeset)
2757 (decf (undo-tree-size buffer-undo-tree)
2758 (undo-list-byte-size (undo-tree-node-redo current)))
2759 (setf (undo-tree-node-redo current)
2760 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2761 (incf (undo-tree-size buffer-undo-tree)
2762 (undo-list-byte-size (undo-tree-node-redo current))))
2763 ;; otherwise, record redo entries that `primitive-undo' has added to
2764 ;; `buffer-undo-list' in current node's redo record, replacing
2765 ;; existing entry if one already exists
2766 (decf (undo-tree-size buffer-undo-tree)
2767 (undo-list-byte-size (undo-tree-node-redo current)))
2768 (setf (undo-tree-node-redo current)
2769 (undo-list-pop-changeset 'discard-pos))
2770 (incf (undo-tree-size buffer-undo-tree)
2771 (undo-list-byte-size (undo-tree-node-redo current))))
2773 ;; rewind current node and update timestamp
2774 (setf (undo-tree-current buffer-undo-tree)
2775 (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
2776 (unless preserve-timestamps
2777 (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
2780 ;; if undoing-in-region, record current node, region and direction so we
2781 ;; can tell if undo-in-region is repeated, and re-activate mark if in
2782 ;; `transient-mark-mode'; if not, erase any leftover data
2783 (if (not undo-in-region)
2784 (undo-tree-node-clear-region-data current)
2786 ;; note: we deliberately want to store the region information in the
2787 ;; node *below* the now current one
2788 (setf (undo-tree-node-undo-beginning current) (region-beginning)
2789 (undo-tree-node-undo-end current) (region-end))
2790 (set-marker pos nil)))
2792 ;; undo deactivates mark unless undoing-in-region
2793 (setq deactivate-mark (not undo-in-region))))
2797 (defun undo-tree-redo (&optional arg)
2798 "Redo changes. A numeric ARG serves as a repeat count.
2800 In Transient Mark mode when the mark is active, only redo changes
2801 within the current region. Similarly, when not in Transient Mark
2802 mode, just \\[universal-argument] as an argument limits redo to
2803 changes within the current region."
2805 ;; throw error if undo is disabled in buffer
2806 (when (eq buffer-undo-list t)
2807 (user-error "No undo information in this buffer"))
2808 (undo-tree-redo-1 arg)
2809 ;; inform user if at branch point
2810 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2813 (defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
2814 ;; Internal redo function. An active mark in `transient-mark-mode', or
2815 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
2816 ;; causes the existing redo record to be preserved, rather than replacing it
2817 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2818 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2819 ;; should *only* be used when temporarily visiting another undo state and
2820 ;; immediately returning to the original state afterwards. Otherwise, it
2821 ;; could cause history-discarding errors.)
2822 (let ((undo-in-progress t)
2823 (redo-in-region (and undo-tree-enable-undo-in-region
2824 (or (region-active-p)
2825 (and arg (not (numberp arg))))))
2827 ;; transfer entries accumulated in `buffer-undo-list' to
2828 ;; `buffer-undo-tree'
2829 (undo-list-transfer-to-tree)
2831 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2832 ;; check if at bottom of undo tree
2833 (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
2834 (user-error "No further redo information"))
2836 ;; if region is active, or a non-numeric prefix argument was supplied,
2837 ;; try to pull out a new branch of changes affecting the region
2838 (when (and redo-in-region
2839 (not (undo-tree-pull-redo-in-region-branch
2840 (region-beginning) (region-end))))
2841 (user-error "No further redo information for region"))
2843 ;; get next node (but DON'T advance current node in tree yet, in case
2845 (setq current (undo-tree-current buffer-undo-tree)
2846 current (nth (undo-tree-node-branch current)
2847 (undo-tree-node-next current)))
2848 ;; remove any GC'd elements from node's redo list
2849 (decf (undo-tree-size buffer-undo-tree)
2850 (undo-list-byte-size (undo-tree-node-redo current)))
2851 (setf (undo-tree-node-redo current)
2852 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2853 (incf (undo-tree-size buffer-undo-tree)
2854 (undo-list-byte-size (undo-tree-node-redo current)))
2855 ;; redo one record from undo tree
2856 (when redo-in-region
2857 (setq pos (set-marker (make-marker) (point)))
2858 (set-marker-insertion-type pos t))
2859 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
2861 ;; advance current node in tree
2862 (setf (undo-tree-current buffer-undo-tree) current)
2864 ;; if preserving old undo record, discard new undo entries that
2865 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2866 ;; elements from node's redo list
2869 (undo-list-pop-changeset)
2870 (decf (undo-tree-size buffer-undo-tree)
2871 (undo-list-byte-size (undo-tree-node-undo current)))
2872 (setf (undo-tree-node-undo current)
2873 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2874 (incf (undo-tree-size buffer-undo-tree)
2875 (undo-list-byte-size (undo-tree-node-undo current))))
2876 ;; otherwise, record undo entries that `primitive-undo' has added to
2877 ;; `buffer-undo-list' in current node's undo record, replacing
2878 ;; existing entry if one already exists
2879 (decf (undo-tree-size buffer-undo-tree)
2880 (undo-list-byte-size (undo-tree-node-undo current)))
2881 (setf (undo-tree-node-undo current)
2882 (undo-list-pop-changeset 'discard-pos))
2883 (incf (undo-tree-size buffer-undo-tree)
2884 (undo-list-byte-size (undo-tree-node-undo current))))
2887 (unless preserve-timestamps
2888 (setf (undo-tree-node-timestamp current) (current-time)))
2890 ;; if redoing-in-region, record current node, region and direction so we
2891 ;; can tell if redo-in-region is repeated, and re-activate mark if in
2892 ;; `transient-mark-mode'
2893 (if (not redo-in-region)
2894 (undo-tree-node-clear-region-data current)
2896 (setf (undo-tree-node-redo-beginning current) (region-beginning)
2897 (undo-tree-node-redo-end current) (region-end))
2898 (set-marker pos nil)))
2900 ;; redo deactivates the mark unless redoing-in-region
2901 (setq deactivate-mark (not redo-in-region))))
2905 (defun undo-tree-switch-branch (branch)
2906 "Switch to a different BRANCH of the undo tree.
2907 This will affect which branch to descend when *redoing* changes
2908 using `undo-tree-redo'."
2909 (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
2910 (and (not (eq buffer-undo-list t))
2911 (or (undo-list-transfer-to-tree) t)
2912 (let ((b (undo-tree-node-branch
2914 buffer-undo-tree))))
2916 ;; switch to other branch if only 2
2917 ((= (undo-tree-num-branches) 2) (- 1 b))
2918 ;; prompt if more than 2
2919 ((> (undo-tree-num-branches) 2)
2921 (format "Branch (0-%d, on %d): "
2922 (1- (undo-tree-num-branches)) b)))
2924 ;; throw error if undo is disabled in buffer
2925 (when (eq buffer-undo-list t)
2926 (user-error "No undo information in this buffer"))
2927 ;; sanity check branch number
2928 (when (<= (undo-tree-num-branches) 1)
2929 (user-error "Not at undo branch point"))
2930 (when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
2931 (user-error "Invalid branch number"))
2932 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2933 (undo-list-transfer-to-tree)
2935 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
2937 (message "Switched to branch %d" branch))
2940 (defun undo-tree-set (node &optional preserve-timestamps)
2941 ;; Set buffer to state corresponding to NODE. Returns intersection point
2942 ;; between path back from current node and path back from selected NODE.
2943 ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
2944 ;; undo-tree nodes. (This should *only* be used when temporarily visiting
2945 ;; another undo state and immediately returning to the original state
2946 ;; afterwards. Otherwise, it could cause history-discarding errors.)
2947 (let ((path (make-hash-table :test 'eq))
2949 (puthash (undo-tree-root buffer-undo-tree) t path)
2950 ;; build list of nodes leading back from selected node to root, updating
2951 ;; branches as we go to point down to selected node
2954 (when (undo-tree-node-previous n)
2955 (setf (undo-tree-node-branch (undo-tree-node-previous n))
2957 n (undo-tree-node-next (undo-tree-node-previous n))))
2958 (setq n (undo-tree-node-previous n)))))
2959 ;; work backwards from current node until we intersect path back from
2961 (setq n (undo-tree-current buffer-undo-tree))
2962 (while (not (gethash n path))
2963 (setq n (undo-tree-node-previous n)))
2964 ;; ascend tree until intersection node
2965 (while (not (eq (undo-tree-current buffer-undo-tree) n))
2966 (undo-tree-undo-1 nil nil preserve-timestamps))
2967 ;; descend tree until selected node
2968 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2969 (undo-tree-redo-1 nil nil preserve-timestamps))
2970 n)) ; return intersection node
2974 (defun undo-tree-save-state-to-register (register)
2975 "Store current undo-tree state to REGISTER.
2976 The saved state can be restored using
2977 `undo-tree-restore-state-from-register'.
2978 Argument is a character, naming the register."
2979 (interactive "cUndo-tree state to register: ")
2980 ;; throw error if undo is disabled in buffer
2981 (when (eq buffer-undo-list t)
2982 (user-error "No undo information in this buffer"))
2983 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2984 (undo-list-transfer-to-tree)
2985 ;; save current node to REGISTER
2987 register (registerv-make
2988 (undo-tree-make-register-data
2989 (current-buffer) (undo-tree-current buffer-undo-tree))
2990 :print-func 'undo-tree-register-data-print-func))
2991 ;; record REGISTER in current node, for visualizer
2992 (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
2997 (defun undo-tree-restore-state-from-register (register)
2998 "Restore undo-tree state from REGISTER.
2999 The state must be saved using `undo-tree-save-state-to-register'.
3000 Argument is a character, naming the register."
3001 (interactive "*cRestore undo-tree state from register: ")
3002 ;; throw error if undo is disabled in buffer, or if register doesn't contain
3003 ;; an undo-tree node
3004 (let ((data (registerv-data (get-register register))))
3006 ((eq buffer-undo-list t)
3007 (user-error "No undo information in this buffer"))
3008 ((not (undo-tree-register-data-p data))
3009 (user-error "Register doesn't contain undo-tree state"))
3010 ((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
3011 (user-error "Register contains undo-tree state for a different buffer")))
3012 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3013 (undo-list-transfer-to-tree)
3014 ;; restore buffer state corresponding to saved node
3015 (undo-tree-set (undo-tree-register-data-node data))))
3020 ;;; =====================================================================
3021 ;;; Persistent storage commands
3023 (defun undo-tree-make-history-save-file-name (file)
3024 "Create the undo history file name for FILE.
3025 Normally this is the file's name with \".\" prepended and
3026 \".~undo-tree~\" appended.
3028 A match for FILE is sought in `undo-tree-history-directory-alist'
3029 \(see the documentation of that variable for details\). If the
3030 directory for the backup doesn't exist, it is created."
3031 (let* ((backup-directory-alist undo-tree-history-directory-alist)
3032 (name (make-backup-file-name-1 file)))
3033 (concat (file-name-directory name) "." (file-name-nondirectory name)
3037 (defun undo-tree-save-history (&optional filename overwrite)
3038 "Store undo-tree history to file.
3040 If optional argument FILENAME is omitted, default save file is
3041 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
3042 Otherwise, prompt for one.
3044 If OVERWRITE is non-nil, any existing file will be overwritten
3045 without asking for confirmation."
3047 (when (eq buffer-undo-list t)
3048 (user-error "No undo information in this buffer"))
3049 (undo-list-transfer-to-tree)
3050 (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
3052 (undo-tree-kill-visualizer)
3053 (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
3054 (let ((buff (current-buffer))
3059 (if buffer-file-name
3060 (undo-tree-make-history-save-file-name buffer-file-name)
3061 (expand-file-name (read-file-name "File to save in: ") nil))))
3062 (when (or (not (file-exists-p filename))
3064 (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
3067 ;; transform undo-tree into non-circular structure, and make
3069 (undo-tree-decircle buffer-undo-tree)
3070 (setq tree (copy-undo-tree buffer-undo-tree))
3071 ;; discard undo-tree object pool before saving
3072 (setf (undo-tree-object-pool tree) nil)
3073 ;; print undo-tree to file
3074 ;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
3075 ;; to allow `auto-compression-mode' to take effect, in
3076 ;; case user has overridden or advised the default
3077 ;; `undo-tree-make-history-save-file-name' to add a
3078 ;; compressed file extension.
3079 (with-auto-compression-mode
3081 (prin1 (sha1 buff) (current-buffer))
3082 (terpri (current-buffer))
3083 (let ((print-circle t)) (prin1 tree (current-buffer)))
3084 (write-region nil nil filename))))
3085 ;; restore circular undo-tree data structure
3086 (undo-tree-recircle buffer-undo-tree))
3091 (defun undo-tree-load-history (&optional filename noerror)
3092 "Load undo-tree history from file.
3094 If optional argument FILENAME is null, default load file is
3095 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
3096 Otherwise, prompt for one.
3098 If optional argument NOERROR is non-nil, return nil instead of
3099 signaling an error if file is not found."
3104 (if buffer-file-name
3105 (undo-tree-make-history-save-file-name buffer-file-name)
3106 (expand-file-name (read-file-name "File to load from: ") nil))))
3108 ;; attempt to read undo-tree from FILENAME
3110 (unless (file-exists-p filename)
3112 (throw 'load-error nil)
3113 (error "File \"%s\" does not exist; could not load undo-tree history"
3115 (let (buff hash tree)
3116 (setq buff (current-buffer))
3117 (with-auto-compression-mode
3119 (insert-file-contents filename)
3120 (goto-char (point-min))
3122 (setq hash (read (current-buffer)))
3125 (funcall (if noerror 'message 'user-error)
3126 "Error reading undo-tree history from \"%s\"" filename)
3127 (throw 'load-error nil)))
3128 (unless (string= (sha1 buff) hash)
3130 (funcall (if noerror 'message 'user-error)
3131 "Buffer has been modified; could not load undo-tree history")
3132 (throw 'load-error nil))
3134 (setq tree (read (current-buffer)))
3137 (funcall (if noerror 'message 'error)
3138 "Error reading undo-tree history from \"%s\"" filename)
3139 (throw 'load-error nil)))
3141 ;; initialise empty undo-tree object pool
3142 (setf (undo-tree-object-pool tree)
3143 (make-hash-table :test 'eq :weakness 'value))
3144 ;; restore circular undo-tree data structure
3145 (undo-tree-recircle tree)
3146 (setq buffer-undo-tree tree))))
3150 ;; Versions of save/load functions for use in hooks
3151 (defun undo-tree-save-history-hook ()
3152 (when (and undo-tree-mode undo-tree-auto-save-history
3153 (not (eq buffer-undo-list t)))
3154 (undo-tree-save-history nil t) nil))
3156 (defun undo-tree-load-history-hook ()
3157 (when (and undo-tree-mode undo-tree-auto-save-history
3158 (not (eq buffer-undo-list t))
3159 (not revert-buffer-in-progress-p))
3160 (undo-tree-load-history nil t)))
3165 ;;; =====================================================================
3166 ;;; Visualizer drawing functions
3168 (defun undo-tree-visualize ()
3169 "Visualize the current buffer's undo tree."
3172 ;; throw error if undo is disabled in buffer
3173 (when (eq buffer-undo-list t)
3174 (user-error "No undo information in this buffer"))
3175 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3176 (undo-list-transfer-to-tree)
3177 ;; add hook to kill visualizer buffer if original buffer is changed
3178 (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
3179 ;; prepare *undo-tree* buffer, then draw tree in it
3180 (let ((undo-tree buffer-undo-tree)
3181 (buff (current-buffer))
3182 (display-buffer-mark-dedicated 'soft))
3183 (switch-to-buffer-other-window
3184 (get-buffer-create undo-tree-visualizer-buffer-name))
3185 (setq undo-tree-visualizer-parent-buffer buff)
3186 (setq undo-tree-visualizer-parent-mtime
3187 (and (buffer-file-name buff)
3188 (nth 5 (file-attributes (buffer-file-name buff)))))
3189 (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
3190 (setq undo-tree-visualizer-spacing
3191 (undo-tree-visualizer-calculate-spacing))
3192 (make-local-variable 'undo-tree-visualizer-timestamps)
3193 (make-local-variable 'undo-tree-visualizer-diff)
3194 (setq buffer-undo-tree undo-tree)
3195 (undo-tree-visualizer-mode)
3196 ;; FIXME; don't know why `undo-tree-visualizer-mode' clears this
3197 (setq buffer-undo-tree undo-tree)
3198 (set (make-local-variable 'undo-tree-visualizer-lazy-drawing)
3199 (or (eq undo-tree-visualizer-lazy-drawing t)
3200 (and (numberp undo-tree-visualizer-lazy-drawing)
3201 (>= (undo-tree-count undo-tree)
3202 undo-tree-visualizer-lazy-drawing))))
3203 (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
3204 (let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
3207 (defun undo-tree-kill-visualizer (&rest _dummy)
3208 ;; Kill visualizer. Added to `before-change-functions' hook of original
3209 ;; buffer when visualizer is invoked.
3210 (unless (or undo-tree-inhibit-kill-visualizer
3211 (null (get-buffer undo-tree-visualizer-buffer-name)))
3212 (with-current-buffer undo-tree-visualizer-buffer-name
3213 (undo-tree-visualizer-quit))))
3217 (defun undo-tree-draw-tree (undo-tree)
3218 ;; Draw undo-tree in current buffer starting from NODE (or root if nil).
3219 (let ((node (if undo-tree-visualizer-lazy-drawing
3220 (undo-tree-current undo-tree)
3221 (undo-tree-root undo-tree))))
3223 (setq undo-tree-visualizer-needs-extending-down nil
3224 undo-tree-visualizer-needs-extending-up nil)
3225 (undo-tree-clear-visualizer-data undo-tree)
3226 (undo-tree-compute-widths node)
3227 ;; lazy drawing starts vertically centred and displaced horizontally to
3228 ;; the left (window-width/4), since trees will typically grow right
3229 (if undo-tree-visualizer-lazy-drawing
3231 (undo-tree-move-down (/ (window-height) 2))
3232 (undo-tree-move-forward (max 2 (/ (window-width) 4)))) ; left margin
3233 ;; non-lazy drawing starts in centre at top of buffer
3234 (undo-tree-move-down 1) ; top margin
3235 (undo-tree-move-forward
3236 (max (/ (window-width) 2)
3237 (+ (undo-tree-node-char-lwidth node)
3238 ;; add space for left part of left-most time-stamp
3239 (if undo-tree-visualizer-timestamps
3240 (/ (- undo-tree-visualizer-spacing 4) 2)
3243 ;; link starting node to its representation in visualizer
3244 (setf (undo-tree-node-marker node) (make-marker))
3245 (set-marker-insertion-type (undo-tree-node-marker node) nil)
3246 (move-marker (undo-tree-node-marker node) (point))
3248 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3250 (if (not undo-tree-visualizer-lazy-drawing)
3251 (undo-tree-extend-down node t)
3252 (undo-tree-extend-down node)
3253 (undo-tree-extend-up node)
3254 (setq node-list undo-tree-visualizer-needs-extending-down
3255 undo-tree-visualizer-needs-extending-down nil)
3256 (while node-list (undo-tree-extend-down (pop node-list)))))
3257 ;; highlight active branch
3258 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3259 (undo-tree-highlight-active-branch
3260 (or undo-tree-visualizer-needs-extending-up
3261 (undo-tree-root undo-tree))))
3262 ;; highlight current node
3263 (undo-tree-draw-node (undo-tree-current undo-tree) 'current)))
3266 (defun undo-tree-extend-down (node &optional bottom)
3267 ;; Extend tree downwards starting from NODE and point. If BOTTOM is t,
3268 ;; extend all the way down to the leaves. If BOTTOM is a node, extend down
3269 ;; as far as that node. If BOTTOM is an integer, extend down as far as that
3270 ;; line. Otherwise, only extend visible portion of tree. NODE is assumed to
3271 ;; already have a node marker. Returns non-nil if anything was actually
3273 (let ((extended nil)
3274 (cur-stack (list node))
3276 ;; don't bother extending if BOTTOM specifies an already-drawn node
3277 (unless (and (undo-tree-node-p bottom) (undo-tree-node-marker bottom))
3278 ;; draw nodes layer by layer
3279 (while (or cur-stack
3280 (prog1 (setq cur-stack next-stack)
3281 (setq next-stack nil)))
3282 (setq node (pop cur-stack))
3283 ;; if node is within range being drawn...
3284 (if (or (eq bottom t)
3285 (and (undo-tree-node-p bottom)
3286 (not (eq (undo-tree-node-previous node) bottom)))
3287 (and (integerp bottom)
3288 (>= bottom (line-number-at-pos
3289 (undo-tree-node-marker node))))
3291 (pos-visible-in-window-p (undo-tree-node-marker node)
3293 ;; ...draw one layer of node's subtree (if not already drawn)
3295 (unless (and (undo-tree-node-next node)
3296 (undo-tree-node-marker
3297 (nth (undo-tree-node-branch node)
3298 (undo-tree-node-next node))))
3299 (goto-char (undo-tree-node-marker node))
3300 (undo-tree-draw-subtree node)
3303 (append (undo-tree-node-next node) next-stack)))
3304 ;; ...otherwise, postpone drawing until later
3305 (push node undo-tree-visualizer-needs-extending-down))))
3309 (defun undo-tree-extend-up (node &optional top)
3310 ;; Extend tree upwards starting from NODE. If TOP is t, extend all the way
3311 ;; to root. If TOP is a node, extend up as far as that node. If TOP is an
3312 ;; integer, extend up as far as that line. Otherwise, only extend visible
3313 ;; portion of tree. NODE is assumed to already have a node marker. Returns
3314 ;; non-nil if anything was actually extended.
3315 (let ((extended nil) parent)
3316 ;; don't bother extending if TOP specifies an already-drawn node
3317 (unless (and (undo-tree-node-p top) (undo-tree-node-marker top))
3319 (setq parent (undo-tree-node-previous node))
3320 ;; if we haven't reached root...
3322 ;; ...and node is within range being drawn...
3324 (and (undo-tree-node-p top) (not (eq node top)))
3326 (< top (line-number-at-pos
3327 (undo-tree-node-marker node))))
3329 ;; NOTE: we check point in case window-start is outdated
3330 (< (min (line-number-at-pos (point))
3331 (line-number-at-pos (window-start)))
3333 (undo-tree-node-marker node)))))
3334 ;; ...and it hasn't already been drawn
3335 (when (not (undo-tree-node-marker parent))
3336 ;; link parent node to its representation in visualizer
3337 (undo-tree-compute-widths parent)
3338 (undo-tree-move-to-parent node)
3339 (setf (undo-tree-node-marker parent) (make-marker))
3340 (set-marker-insertion-type
3341 (undo-tree-node-marker parent) nil)
3342 (move-marker (undo-tree-node-marker parent) (point))
3343 ;; draw subtree beneath parent
3344 (setq undo-tree-visualizer-needs-extending-down
3345 (nconc (delq node (undo-tree-draw-subtree parent))
3346 undo-tree-visualizer-needs-extending-down))
3348 ;; ...otherwise, postpone drawing for later and exit
3349 (setq undo-tree-visualizer-needs-extending-up (when parent node)
3352 ;; if we've reached root, stop extending and add top margin
3353 (setq undo-tree-visualizer-needs-extending-up nil)
3354 (goto-char (undo-tree-node-marker node))
3355 (undo-tree-move-up 1) ; top margin
3356 (delete-region (point-min) (line-beginning-position)))
3358 (setq node parent)))
3362 (defun undo-tree-expand-down (from &optional to)
3363 ;; Expand tree downwards. FROM is the node to start expanding from. Stop
3364 ;; expanding at TO if specified. Otherwise, just expand visible portion of
3365 ;; tree and highlight active branch from FROM.
3366 (when undo-tree-visualizer-needs-extending-down
3367 (let ((inhibit-read-only t)
3369 ;; extend down as far as TO node
3371 (setq extended (undo-tree-extend-down from to))
3372 (goto-char (undo-tree-node-marker to))
3373 (redisplay t)) ; force redisplay to scroll buffer if necessary
3374 ;; extend visible portion of tree downwards
3375 (setq node-list undo-tree-visualizer-needs-extending-down
3376 undo-tree-visualizer-needs-extending-down nil)
3378 (dolist (n node-list)
3379 (when (undo-tree-extend-down n) (setq extended t)))
3380 ;; highlight active branch in newly-extended-down portion, if any
3382 (let ((undo-tree-insert-face
3383 'undo-tree-visualizer-active-branch-face))
3384 (undo-tree-highlight-active-branch from)))))))
3387 (defun undo-tree-expand-up (from &optional to)
3388 ;; Expand tree upwards. FROM is the node to start expanding from, TO is the
3389 ;; node to stop expanding at. If TO node isn't specified, just expand visible
3390 ;; portion of tree and highlight active branch down to FROM.
3391 (when undo-tree-visualizer-needs-extending-up
3392 (let ((inhibit-read-only t)
3394 ;; extend up as far as TO node
3396 (setq extended (undo-tree-extend-up from to))
3397 (goto-char (undo-tree-node-marker to))
3398 ;; simulate auto-scrolling if close to top of buffer
3399 (when (<= (line-number-at-pos (point)) scroll-margin)
3400 (undo-tree-move-up (if (= scroll-conservatively 0)
3401 (/ (window-height) 2) 3))
3402 (when (undo-tree-extend-up to) (setq extended t))
3403 (goto-char (undo-tree-node-marker to))
3404 (unless (= scroll-conservatively 0) (recenter scroll-margin))))
3405 ;; extend visible portion of tree upwards
3406 (and undo-tree-visualizer-needs-extending-up
3407 (undo-tree-extend-up undo-tree-visualizer-needs-extending-up)
3409 ;; extend visible portion of tree downwards
3410 (setq node-list undo-tree-visualizer-needs-extending-down
3411 undo-tree-visualizer-needs-extending-down nil)
3412 (dolist (n node-list) (undo-tree-extend-down n))
3413 ;; highlight active branch in newly-extended-up portion, if any
3415 (let ((undo-tree-insert-face
3416 'undo-tree-visualizer-active-branch-face))
3417 (undo-tree-highlight-active-branch
3418 (or undo-tree-visualizer-needs-extending-up
3419 (undo-tree-root buffer-undo-tree))
3424 (defun undo-tree-highlight-active-branch (node &optional end)
3425 ;; Draw highlighted active branch below NODE in current buffer. Stop
3426 ;; highlighting at END node if specified.
3427 (let ((stack (list node)))
3428 ;; draw active branch
3430 (setq node (pop stack))
3431 (unless (or (eq node end)
3432 (memq node undo-tree-visualizer-needs-extending-down))
3433 (goto-char (undo-tree-node-marker node))
3434 (setq node (undo-tree-draw-subtree node 'active)
3435 stack (nconc stack node))))))
3438 (defun undo-tree-draw-node (node &optional current)
3439 ;; Draw symbol representing NODE in visualizer. If CURRENT is non-nil, node
3441 (goto-char (undo-tree-node-marker node))
3442 (when undo-tree-visualizer-timestamps
3443 (undo-tree-move-backward (/ undo-tree-visualizer-spacing 2)))
3445 (let* ((undo-tree-insert-face (and undo-tree-insert-face
3446 (or (and (consp undo-tree-insert-face)
3447 undo-tree-insert-face)
3448 (list undo-tree-insert-face))))
3449 (register (undo-tree-node-register node))
3450 (unmodified (if undo-tree-visualizer-parent-mtime
3451 (undo-tree-node-unmodified-p
3452 node undo-tree-visualizer-parent-mtime)
3453 (undo-tree-node-unmodified-p node)))
3455 ;; check node's register (if any) still stores appropriate undo-tree state
3456 (unless (and register
3457 (undo-tree-register-data-p
3458 (registerv-data (get-register register)))
3459 (eq node (undo-tree-register-data-node
3460 (registerv-data (get-register register)))))
3461 (setq register nil))
3462 ;; represent node by different symbols, depending on whether it's the
3463 ;; current node, is saved in a register, or corresponds to an unmodified
3467 (undo-tree-visualizer-timestamps
3468 (undo-tree-timestamp-to-string
3469 (undo-tree-node-timestamp node)
3470 undo-tree-visualizer-relative-timestamps
3472 (register (char-to-string register))
3476 undo-tree-insert-face
3479 (current '(undo-tree-visualizer-current-face))
3480 (unmodified '(undo-tree-visualizer-unmodified-face))
3481 (register '(undo-tree-visualizer-register-face)))
3482 undo-tree-insert-face))
3483 ;; draw node and link it to its representation in visualizer
3484 (undo-tree-insert node-string)
3485 (undo-tree-move-backward (if undo-tree-visualizer-timestamps
3486 (1+ (/ undo-tree-visualizer-spacing 2))
3488 (move-marker (undo-tree-node-marker node) (point))
3489 (put-text-property (point) (1+ (point)) 'undo-tree-node node)))
3492 (defun undo-tree-draw-subtree (node &optional active-branch)
3493 ;; Draw subtree rooted at NODE. The subtree will start from point.
3494 ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. Returns
3495 ;; list of nodes below NODE.
3496 (let ((num-children (length (undo-tree-node-next node)))
3497 node-list pos trunk-pos n)
3499 (undo-tree-draw-node node)
3502 ;; if we're at a leaf node, we're done
3503 ((= num-children 0))
3505 ;; if node has only one child, draw it (not strictly necessary to deal
3506 ;; with this case separately, but as it's by far the most common case
3507 ;; this makes the code clearer and more efficient)
3509 (undo-tree-move-down 1)
3510 (undo-tree-insert ?|)
3511 (undo-tree-move-backward 1)
3512 (undo-tree-move-down 1)
3513 (undo-tree-insert ?|)
3514 (undo-tree-move-backward 1)
3515 (undo-tree-move-down 1)
3516 (setq n (car (undo-tree-node-next node)))
3517 ;; link next node to its representation in visualizer
3518 (unless (markerp (undo-tree-node-marker n))
3519 (setf (undo-tree-node-marker n) (make-marker))
3520 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3521 (move-marker (undo-tree-node-marker n) (point))
3522 ;; add next node to list of nodes to draw next
3525 ;; if node has multiple children, draw branches
3527 (undo-tree-move-down 1)
3528 (undo-tree-insert ?|)
3529 (undo-tree-move-backward 1)
3530 (move-marker (setq trunk-pos (make-marker)) (point))
3532 (undo-tree-move-backward
3533 (- (undo-tree-node-char-lwidth node)
3534 (undo-tree-node-char-lwidth
3535 (car (undo-tree-node-next node)))))
3536 (move-marker (setq pos (make-marker)) (point))
3537 (setq n (cons nil (undo-tree-node-next node)))
3538 (dotimes (i (/ num-children 2))
3540 (when (or (null active-branch)
3542 (nth (undo-tree-node-branch node)
3543 (undo-tree-node-next node))))
3544 (undo-tree-move-forward 2)
3545 (undo-tree-insert ?_ (- trunk-pos pos 2))
3547 (undo-tree-move-forward 1)
3548 (undo-tree-move-down 1)
3549 (undo-tree-insert ?/)
3550 (undo-tree-move-backward 2)
3551 (undo-tree-move-down 1)
3552 ;; link node to its representation in visualizer
3553 (unless (markerp (undo-tree-node-marker (car n)))
3554 (setf (undo-tree-node-marker (car n)) (make-marker))
3555 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3556 (move-marker (undo-tree-node-marker (car n)) (point))
3557 ;; add node to list of nodes to draw next
3558 (push (car n) node-list))
3560 (undo-tree-move-forward
3561 (+ (undo-tree-node-char-rwidth (car n))
3562 (undo-tree-node-char-lwidth (cadr n))
3563 undo-tree-visualizer-spacing 1))
3564 (move-marker pos (point)))
3565 ;; middle subtree (only when number of children is odd)
3566 (when (= (mod num-children 2) 1)
3568 (when (or (null active-branch)
3570 (nth (undo-tree-node-branch node)
3571 (undo-tree-node-next node))))
3572 (undo-tree-move-down 1)
3573 (undo-tree-insert ?|)
3574 (undo-tree-move-backward 1)
3575 (undo-tree-move-down 1)
3576 ;; link node to its representation in visualizer
3577 (unless (markerp (undo-tree-node-marker (car n)))
3578 (setf (undo-tree-node-marker (car n)) (make-marker))
3579 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3580 (move-marker (undo-tree-node-marker (car n)) (point))
3581 ;; add node to list of nodes to draw next
3582 (push (car n) node-list))
3584 (undo-tree-move-forward
3585 (+ (undo-tree-node-char-rwidth (car n))
3586 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3587 undo-tree-visualizer-spacing 1))
3588 (move-marker pos (point)))
3590 (move-marker trunk-pos (1+ trunk-pos))
3591 (dotimes (i (/ num-children 2))
3593 (when (or (null active-branch)
3595 (nth (undo-tree-node-branch node)
3596 (undo-tree-node-next node))))
3597 (goto-char trunk-pos)
3598 (undo-tree-insert ?_ (- pos trunk-pos 1))
3600 (undo-tree-move-backward 1)
3601 (undo-tree-move-down 1)
3602 (undo-tree-insert ?\\)
3603 (undo-tree-move-down 1)
3604 ;; link node to its representation in visualizer
3605 (unless (markerp (undo-tree-node-marker (car n)))
3606 (setf (undo-tree-node-marker (car n)) (make-marker))
3607 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3608 (move-marker (undo-tree-node-marker (car n)) (point))
3609 ;; add node to list of nodes to draw next
3610 (push (car n) node-list))
3613 (undo-tree-move-forward
3614 (+ (undo-tree-node-char-rwidth (car n))
3615 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3616 undo-tree-visualizer-spacing 1))
3617 (move-marker pos (point))))
3619 ;; return list of nodes to draw next
3620 (nreverse node-list)))
3623 (defun undo-tree-node-char-lwidth (node)
3624 ;; Return left-width of NODE measured in characters.
3625 (if (= (length (undo-tree-node-next node)) 0) 0
3626 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
3627 (if (= (undo-tree-node-cwidth node) 0)
3628 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3631 (defun undo-tree-node-char-rwidth (node)
3632 ;; Return right-width of NODE measured in characters.
3633 (if (= (length (undo-tree-node-next node)) 0) 0
3634 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
3635 (if (= (undo-tree-node-cwidth node) 0)
3636 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3639 (defun undo-tree-insert (str &optional arg)
3640 ;; Insert character or string STR ARG times, overwriting, and using
3641 ;; `undo-tree-insert-face'.
3642 (unless arg (setq arg 1))
3643 (when (characterp str)
3644 (setq str (make-string arg str))
3646 (dotimes (i arg) (insert str))
3647 (setq arg (* arg (length str)))
3648 (undo-tree-move-forward arg)
3649 ;; make sure mark isn't active, otherwise `backward-delete-char' might
3650 ;; delete region instead of single char if transient-mark-mode is enabled
3651 (setq mark-active nil)
3652 (backward-delete-char arg)
3653 (when undo-tree-insert-face
3654 (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
3657 (defun undo-tree-move-down (&optional arg)
3658 ;; Move down, extending buffer if necessary.
3659 (let ((row (line-number-at-pos))
3660 (col (current-column))
3662 (unless arg (setq arg 1))
3664 (setq line (line-number-at-pos))
3665 ;; if buffer doesn't have enough lines, add some
3666 (when (/= line (+ row arg))
3669 (insert (make-string (- line row arg) ?\n))
3670 (forward-line (+ arg (- row line))))
3671 (t (insert (make-string (- arg (- line row)) ?\n)))))
3672 (undo-tree-move-forward col)))
3675 (defun undo-tree-move-up (&optional arg)
3676 ;; Move up, extending buffer if necessary.
3677 (unless arg (setq arg 1))
3678 (undo-tree-move-down (- arg)))
3681 (defun undo-tree-move-forward (&optional arg)
3682 ;; Move forward, extending buffer if necessary.
3683 (unless arg (setq arg 1))
3687 (setq n (- (line-end-position) (point)))
3691 (insert (make-string (- arg n) ? ))))
3694 (setq n (- (point) (line-beginning-position)))
3695 (when (< (- n 2) arg) ; -2 to create left-margin
3696 ;; no space left - shift entire buffer contents right!
3697 (let ((pos (move-marker (make-marker) (point))))
3698 (set-marker-insertion-type pos t)
3699 (goto-char (point-min))
3701 (insert-before-markers (make-string (- arg -2 n) ? ))
3704 (backward-char arg)))))
3707 (defun undo-tree-move-backward (&optional arg)
3708 ;; Move backward, extending buffer if necessary.
3709 (unless arg (setq arg 1))
3710 (undo-tree-move-forward (- arg)))
3713 (defun undo-tree-move-to-parent (node)
3714 ;; Move to position of parent of NODE, extending buffer if necessary.
3715 (let* ((parent (undo-tree-node-previous node))
3716 (n (undo-tree-node-next parent))
3718 (goto-char (undo-tree-node-marker node))
3720 ;; move horizontally
3721 (setq p (undo-tree-position node n))
3723 ;; node in centre subtree: no horizontal movement
3724 ((and (= (mod l 2) 1) (= p (/ l 2))))
3725 ;; node in left subtree: move right
3727 (setq n (nthcdr p n))
3728 (undo-tree-move-forward
3729 (+ (undo-tree-node-char-rwidth (car n))
3730 (/ undo-tree-visualizer-spacing 2) 1))
3731 (dotimes (i (- (/ l 2) p 1))
3733 (undo-tree-move-forward
3734 (+ (undo-tree-node-char-lwidth (car n))
3735 (undo-tree-node-char-rwidth (car n))
3736 undo-tree-visualizer-spacing 1)))
3737 (when (= (mod l 2) 1)
3739 (undo-tree-move-forward
3740 (+ (undo-tree-node-char-lwidth (car n))
3741 (/ undo-tree-visualizer-spacing 2) 1))))
3742 (t ;; node in right subtree: move left
3743 (setq n (nthcdr (/ l 2) n))
3744 (when (= (mod l 2) 1)
3745 (undo-tree-move-backward
3746 (+ (undo-tree-node-char-rwidth (car n))
3747 (/ undo-tree-visualizer-spacing 2) 1))
3749 (dotimes (i (- p (/ l 2) (mod l 2)))
3750 (undo-tree-move-backward
3751 (+ (undo-tree-node-char-lwidth (car n))
3752 (undo-tree-node-char-rwidth (car n))
3753 undo-tree-visualizer-spacing 1))
3755 (undo-tree-move-backward
3756 (+ (undo-tree-node-char-lwidth (car n))
3757 (/ undo-tree-visualizer-spacing 2) 1)))))
3759 (undo-tree-move-up 3)))
3762 (defun undo-tree-timestamp-to-string
3763 (timestamp &optional relative current register)
3764 ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
3765 ;; if it's the CURRENT node and/or has an associated REGISTER.
3768 (let ((time (floor (float-time
3769 (subtract-time (current-time) timestamp))))
3773 (if (> (setq n (/ time 315360000)) 0)
3774 (if (> n 999) "-ages" (format "-%dy" n))
3775 (setq time (% time 315360000))
3777 (if (> (setq n (/ time 86400)) 0)
3779 (setq time (% time 86400))
3781 (if (> (setq n (/ time 3600)) 0)
3783 (setq time (% time 3600))
3785 (if (> (setq n (/ time 60)) 0)
3788 (format "-%ds" (% time 60)))))))
3790 (if current "*" " ")
3792 (if register (concat "[" (char-to-string register) "]")
3794 (setq n (length time))
3796 (concat (make-string (- 9 n) ? ) time)
3799 (concat (if current " *" " ")
3800 (format-time-string "%H:%M:%S" timestamp)
3802 (concat "[" (char-to-string register) "]")
3808 ;;; =====================================================================
3809 ;;; Visualizer commands
3811 (define-derived-mode
3812 undo-tree-visualizer-mode special-mode "undo-tree-visualizer"
3813 "Major mode used in undo-tree visualizer.
3815 The undo-tree visualizer can only be invoked from a buffer in
3816 which `undo-tree-mode' is enabled. The visualizer displays the
3817 undo history tree graphically, and allows you to browse around
3818 the undo history, undoing or redoing the corresponding changes in
3821 Within the undo-tree visualizer, the following keys are available:
3823 \\{undo-tree-visualizer-mode-map}"
3826 (setq truncate-lines t)
3827 (setq cursor-type nil)
3828 (setq undo-tree-visualizer-selected-node nil))
3832 (defun undo-tree-visualize-undo (&optional arg)
3833 "Undo changes. A numeric ARG serves as a repeat count."
3835 (let ((old (undo-tree-current buffer-undo-tree))
3837 ;; unhighlight old current node
3838 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3839 (inhibit-read-only t))
3840 (undo-tree-draw-node old))
3841 ;; undo in parent buffer
3842 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3845 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo-1 arg))
3846 (setq current (undo-tree-current buffer-undo-tree))
3847 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3848 ;; when using lazy drawing, extend tree upwards as required
3849 (when undo-tree-visualizer-lazy-drawing
3850 (undo-tree-expand-up old current))
3851 ;; highlight new current node
3852 (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
3853 ;; update diff display, if any
3854 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3857 (defun undo-tree-visualize-redo (&optional arg)
3858 "Redo changes. A numeric ARG serves as a repeat count."
3860 (let ((old (undo-tree-current buffer-undo-tree))
3862 ;; unhighlight old current node
3863 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3864 (inhibit-read-only t))
3865 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3866 ;; redo in parent buffer
3867 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3870 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo-1 arg))
3871 (setq current (undo-tree-current buffer-undo-tree))
3872 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3873 ;; when using lazy drawing, extend tree downwards as required
3874 (when undo-tree-visualizer-lazy-drawing
3875 (undo-tree-expand-down old current))
3876 ;; highlight new current node
3877 (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
3878 ;; update diff display, if any
3879 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3882 (defun undo-tree-visualize-switch-branch-right (arg)
3883 "Switch to next branch of the undo tree.
3884 This will affect which branch to descend when *redoing* changes
3885 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3887 ;; un-highlight old active branch below current node
3888 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3889 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3890 (inhibit-read-only t))
3891 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3893 (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
3894 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
3896 ((>= (+ branch arg) (undo-tree-num-branches))
3897 (1- (undo-tree-num-branches)))
3898 ((<= (+ branch arg) 0) 0)
3899 (t (+ branch arg))))
3900 (let ((inhibit-read-only t))
3901 ;; highlight new active branch below current node
3902 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3903 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3904 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3905 ;; re-highlight current node
3906 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
3909 (defun undo-tree-visualize-switch-branch-left (arg)
3910 "Switch to previous branch of the undo tree.
3911 This will affect which branch to descend when *redoing* changes
3912 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3914 (undo-tree-visualize-switch-branch-right (- arg)))
3917 (defun undo-tree-visualizer-quit ()
3918 "Quit the undo-tree visualizer."
3920 (undo-tree-clear-visualizer-data buffer-undo-tree)
3921 ;; remove kill visualizer hook from parent buffer
3923 (with-current-buffer undo-tree-visualizer-parent-buffer
3924 (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
3925 ;; kill diff buffer, if any
3926 (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
3927 (let ((parent undo-tree-visualizer-parent-buffer)
3929 ;; kill visualizer buffer
3931 ;; switch back to parent buffer
3933 (if (setq window (get-buffer-window parent))
3934 (select-window window)
3935 (switch-to-buffer parent))))))
3938 (defun undo-tree-visualizer-abort ()
3939 "Quit the undo-tree visualizer and return buffer to original state."
3941 (let ((node undo-tree-visualizer-initial-node))
3942 (undo-tree-visualizer-quit)
3943 (undo-tree-set node)))
3946 (defun undo-tree-visualizer-set (&optional pos)
3947 "Set buffer to state corresponding to undo tree node
3948 at POS, or point if POS is nil."
3950 (unless pos (setq pos (point)))
3951 (let ((node (get-text-property pos 'undo-tree-node)))
3953 ;; set parent buffer to state corresponding to node at POS
3954 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3955 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
3956 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3957 ;; re-draw undo tree
3958 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
3959 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3962 (defun undo-tree-visualizer-mouse-set (pos)
3963 "Set buffer to state corresponding to undo tree node
3964 at mouse event POS."
3966 (undo-tree-visualizer-set (event-start (nth 1 pos))))
3969 (defun undo-tree-visualize-undo-to-x (&optional x)
3970 "Undo to last branch point, register, or saved state.
3971 If X is the symbol `branch', undo to last branch point. If X is
3972 the symbol `register', undo to last register. If X is the sumbol
3973 `saved', undo to last saved state. If X is null, undo to first of
3974 these that's encountered.
3976 Interactively, a single \\[universal-argument] specifies
3977 `branch', a double \\[universal-argument] \\[universal-argument]
3978 specifies `saved', and a negative prefix argument specifies
3981 (when (and (called-interactively-p 'any) x)
3982 (setq x (prefix-numeric-value x)
3987 (let ((current (if undo-tree-visualizer-selection-mode
3988 undo-tree-visualizer-selected-node
3989 (undo-tree-current buffer-undo-tree)))
3990 (diff undo-tree-visualizer-diff)
3992 (undo-tree-visualizer-hide-diff)
3993 (while (and (undo-tree-node-previous current)
3994 (or (if undo-tree-visualizer-selection-mode
3996 (undo-tree-visualizer-select-previous)
3997 (setq current undo-tree-visualizer-selected-node))
3998 (undo-tree-visualize-undo)
3999 (setq current (undo-tree-current buffer-undo-tree)))
4002 (not (or (and (or (null x) (eq x 'branch))
4003 (> (undo-tree-num-branches) 1))
4005 (and (or (null x) (eq x 'register))
4006 (setq r (undo-tree-node-register current))
4007 (undo-tree-register-data-p
4008 (setq r (registerv-data (get-register r))))
4009 (eq current (undo-tree-register-data-node r)))
4011 (and (or (null x) (eq x 'saved))
4012 (undo-tree-node-unmodified-p current))
4014 ;; update diff display, if any
4016 (undo-tree-visualizer-show-diff
4017 (when undo-tree-visualizer-selection-mode
4018 undo-tree-visualizer-selected-node)))))
4021 (defun undo-tree-visualize-redo-to-x (&optional x)
4022 "Redo to last branch point, register, or saved state.
4023 If X is the symbol `branch', redo to last branch point. If X is
4024 the symbol `register', redo to last register. If X is the sumbol
4025 `saved', redo to last saved state. If X is null, redo to first of
4026 these that's encountered.
4028 Interactively, a single \\[universal-argument] specifies
4029 `branch', a double \\[universal-argument] \\[universal-argument]
4030 specifies `saved', and a negative prefix argument specifies
4033 (when (and (called-interactively-p 'any) x)
4034 (setq x (prefix-numeric-value x)
4039 (let ((current (if undo-tree-visualizer-selection-mode
4040 undo-tree-visualizer-selected-node
4041 (undo-tree-current buffer-undo-tree)))
4042 (diff undo-tree-visualizer-diff)
4044 (undo-tree-visualizer-hide-diff)
4045 (while (and (undo-tree-node-next current)
4046 (or (if undo-tree-visualizer-selection-mode
4048 (undo-tree-visualizer-select-next)
4049 (setq current undo-tree-visualizer-selected-node))
4050 (undo-tree-visualize-redo)
4051 (setq current (undo-tree-current buffer-undo-tree)))
4054 (not (or (and (or (null x) (eq x 'branch))
4055 (> (undo-tree-num-branches) 1))
4057 (and (or (null x) (eq x 'register))
4058 (setq r (undo-tree-node-register current))
4059 (undo-tree-register-data-p
4060 (setq r (registerv-data (get-register r))))
4061 (eq current (undo-tree-register-data-node r)))
4063 (and (or (null x) (eq x 'saved))
4064 (undo-tree-node-unmodified-p current))
4066 ;; update diff display, if any
4068 (undo-tree-visualizer-show-diff
4069 (when undo-tree-visualizer-selection-mode
4070 undo-tree-visualizer-selected-node)))))
4073 (defun undo-tree-visualizer-toggle-timestamps ()
4074 "Toggle display of time-stamps."
4076 (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
4077 (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
4079 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
4082 (defun undo-tree-visualizer-scroll-left (&optional arg)
4084 (scroll-left (or arg 1) t))
4087 (defun undo-tree-visualizer-scroll-right (&optional arg)
4089 (scroll-right (or arg 1) t))
4092 (defun undo-tree-visualizer-scroll-up (&optional arg)
4094 (if (or (and (numberp arg) (< arg 0)) (eq arg '-))
4095 (undo-tree-visualizer-scroll-down arg)
4096 ;; scroll up and expand newly-visible portion of tree
4098 (scroll-up-command arg)
4099 (undo-tree-expand-down
4100 (nth (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
4101 (undo-tree-node-next (undo-tree-current buffer-undo-tree)))))
4102 ;; signal error if at eob
4103 (when (and (not undo-tree-visualizer-needs-extending-down) (eobp))
4107 (defun undo-tree-visualizer-scroll-down (&optional arg)
4109 (if (or (and (numberp arg) (< arg 0)) (eq arg '-))
4110 (undo-tree-visualizer-scroll-up arg)
4111 ;; ensure there's enough room at top of buffer to scroll
4113 (or arg (- (window-height) next-screen-context-lines)))
4114 (window-line (1- (line-number-at-pos (window-start)))))
4115 (when (and undo-tree-visualizer-needs-extending-up
4116 (< window-line scroll-lines))
4117 (let ((inhibit-read-only t))
4118 (goto-char (point-min))
4119 (undo-tree-move-up (- scroll-lines window-line)))))
4120 ;; scroll down and expand newly-visible portion of tree
4122 (scroll-down-command arg)
4123 (undo-tree-expand-up
4124 (undo-tree-node-previous (undo-tree-current buffer-undo-tree))))
4125 ;; signal error if at bob
4126 (when (and (not undo-tree-visualizer-needs-extending-down) (bobp))
4132 ;;; =====================================================================
4133 ;;; Visualizer selection mode
4135 (define-minor-mode undo-tree-visualizer-selection-mode
4136 "Toggle mode to select nodes in undo-tree visualizer."
4138 :keymap undo-tree-visualizer-selection-mode-map
4141 ;; enable selection mode
4142 (undo-tree-visualizer-selection-mode
4143 (setq cursor-type 'box)
4144 (setq undo-tree-visualizer-selected-node
4145 (undo-tree-current buffer-undo-tree))
4146 ;; erase diff (if any), as initially selected node is identical to current
4147 (when undo-tree-visualizer-diff
4148 (let ((buff (get-buffer undo-tree-diff-buffer-name))
4149 (inhibit-read-only t))
4150 (when buff (with-current-buffer buff (erase-buffer))))))
4151 (t ;; disable selection mode
4152 (setq cursor-type nil)
4153 (setq undo-tree-visualizer-selected-node nil)
4154 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
4155 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
4159 (defun undo-tree-visualizer-select-previous (&optional arg)
4160 "Move to previous node."
4162 (let ((node undo-tree-visualizer-selected-node))
4164 (dotimes (i (or arg 1))
4165 (unless (undo-tree-node-previous node) (throw 'top t))
4166 (setq node (undo-tree-node-previous node))))
4167 ;; when using lazy drawing, extend tree upwards as required
4168 (when undo-tree-visualizer-lazy-drawing
4169 (undo-tree-expand-up undo-tree-visualizer-selected-node node))
4170 ;; update diff display, if any
4171 (when (and undo-tree-visualizer-diff
4172 (not (eq node undo-tree-visualizer-selected-node)))
4173 (undo-tree-visualizer-update-diff node))
4174 ;; move to selected node
4175 (goto-char (undo-tree-node-marker node))
4176 (setq undo-tree-visualizer-selected-node node)))
4179 (defun undo-tree-visualizer-select-next (&optional arg)
4180 "Move to next node."
4182 (let ((node undo-tree-visualizer-selected-node))
4184 (dotimes (i (or arg 1))
4185 (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
4188 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
4189 ;; when using lazy drawing, extend tree downwards as required
4190 (when undo-tree-visualizer-lazy-drawing
4191 (undo-tree-expand-down undo-tree-visualizer-selected-node node))
4192 ;; update diff display, if any
4193 (when (and undo-tree-visualizer-diff
4194 (not (eq node undo-tree-visualizer-selected-node)))
4195 (undo-tree-visualizer-update-diff node))
4196 ;; move to selected node
4197 (goto-char (undo-tree-node-marker node))
4198 (setq undo-tree-visualizer-selected-node node)))
4201 (defun undo-tree-visualizer-select-right (&optional arg)
4202 "Move right to a sibling node."
4204 (let ((node undo-tree-visualizer-selected-node)
4206 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
4207 (setq end (line-end-position))
4210 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
4212 (setq node (get-text-property (point) 'undo-tree-node))
4213 (when (= (point) end) (throw 'end t)))))
4214 (goto-char (undo-tree-node-marker
4215 (or node undo-tree-visualizer-selected-node)))
4216 (when (and undo-tree-visualizer-diff node
4217 (not (eq node undo-tree-visualizer-selected-node)))
4218 (undo-tree-visualizer-update-diff node))
4219 (when node (setq undo-tree-visualizer-selected-node node))))
4222 (defun undo-tree-visualizer-select-left (&optional arg)
4223 "Move left to a sibling node."
4225 (let ((node (get-text-property (point) 'undo-tree-node))
4227 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
4228 (setq beg (line-beginning-position))
4231 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
4233 (setq node (get-text-property (point) 'undo-tree-node))
4234 (when (= (point) beg) (throw 'beg t)))))
4235 (goto-char (undo-tree-node-marker
4236 (or node undo-tree-visualizer-selected-node)))
4237 (when (and undo-tree-visualizer-diff node
4238 (not (eq node undo-tree-visualizer-selected-node)))
4239 (undo-tree-visualizer-update-diff node))
4240 (when node (setq undo-tree-visualizer-selected-node node))))
4243 (defun undo-tree-visualizer-select (pos)
4244 (let ((node (get-text-property pos 'undo-tree-node)))
4246 ;; select node at POS
4247 (goto-char (undo-tree-node-marker node))
4248 ;; when using lazy drawing, extend tree up and down as required
4249 (when undo-tree-visualizer-lazy-drawing
4250 (undo-tree-expand-up undo-tree-visualizer-selected-node node)
4251 (undo-tree-expand-down undo-tree-visualizer-selected-node node))
4252 ;; update diff display, if any
4253 (when (and undo-tree-visualizer-diff
4254 (not (eq node undo-tree-visualizer-selected-node)))
4255 (undo-tree-visualizer-update-diff node))
4256 ;; update selected node
4257 (setq undo-tree-visualizer-selected-node node)
4261 (defun undo-tree-visualizer-mouse-select (pos)
4262 "Select undo tree node at mouse event POS."
4264 (undo-tree-visualizer-select (event-start (nth 1 pos))))
4269 ;;; =====================================================================
4270 ;;; Visualizer diff display
4272 (defun undo-tree-visualizer-toggle-diff ()
4273 "Toggle diff display in undo-tree visualizer."
4275 (if undo-tree-visualizer-diff
4276 (undo-tree-visualizer-hide-diff)
4277 (undo-tree-visualizer-show-diff)))
4280 (defun undo-tree-visualizer-selection-toggle-diff ()
4281 "Toggle diff display in undo-tree visualizer selection mode."
4283 (if undo-tree-visualizer-diff
4284 (undo-tree-visualizer-hide-diff)
4285 (let ((node (get-text-property (point) 'undo-tree-node)))
4286 (when node (undo-tree-visualizer-show-diff node)))))
4289 (defun undo-tree-visualizer-show-diff (&optional node)
4290 ;; show visualizer diff display
4291 (setq undo-tree-visualizer-diff t)
4292 (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
4293 (undo-tree-diff node)))
4294 (display-buffer-mark-dedicated 'soft)
4296 (setq win (split-window))
4297 (set-window-buffer win buff)
4298 (shrink-window-if-larger-than-buffer win)))
4301 (defun undo-tree-visualizer-hide-diff ()
4302 ;; hide visualizer diff display
4303 (setq undo-tree-visualizer-diff nil)
4304 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
4305 (when win (with-selected-window win (kill-buffer-and-window)))))
4308 (defun undo-tree-diff (&optional node)
4309 ;; Create diff between NODE and current state (or previous state and current
4310 ;; state, if NODE is null). Returns buffer containing diff.
4313 (let ((undo-tree-inhibit-kill-visualizer t)
4314 (current (undo-tree-current buffer-undo-tree)))
4315 (undo-tree-set (or node (undo-tree-node-previous current) current)
4316 'preserve-timestamps)
4317 (setq tmpfile (diff-file-local-copy (current-buffer)))
4318 (undo-tree-set current 'preserve-timestamps))
4319 (setq buff (diff-no-select
4320 tmpfile (current-buffer) nil 'noasync
4321 (get-buffer-create undo-tree-diff-buffer-name)))
4322 ;; delete process messages and useless headers from diff buffer
4323 (let ((inhibit-read-only t))
4324 (with-current-buffer buff
4325 (goto-char (point-min))
4326 (delete-region (point) (1+ (line-end-position 3)))
4327 (goto-char (point-max))
4329 (delete-region (point) (point-max))
4330 (setq cursor-type nil)
4331 (setq buffer-read-only t)))
4335 (defun undo-tree-visualizer-update-diff (&optional node)
4336 ;; update visualizer diff display to show diff between current state and
4337 ;; NODE (or previous state, if NODE is null)
4338 (with-current-buffer undo-tree-visualizer-parent-buffer
4339 (undo-tree-diff node))
4340 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
4343 (shrink-window-if-larger-than-buffer win))))
4347 (provide 'undo-tree)
4349 ;;; undo-tree.el ends here