1 ;;; undo-tree.el --- Treat undo history as a tree
3 ;; Copyright (C) 2009-2012 Free Software Foundation, Inc
5 ;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
7 ;; Keywords: convenience, files, undo, redo, history, tree
8 ;; URL: http://www.dr-qubit.org/emacs.php
9 ;; Repository: http://www.dr-qubit.org/git/undo-tree.git
11 ;; This file is part of Emacs.
13 ;; This file is free software: you can redistribute it and/or modify it under
14 ;; the terms of the GNU General Public License as published by the Free
15 ;; Software Foundation, either version 3 of the License, or (at your option)
18 ;; This program is distributed in the hope that it will be useful, but WITHOUT
19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
20 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
23 ;; You should have received a copy of the GNU General Public License along
24 ;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;; Emacs has a powerful undo system. Unlike the standard undo/redo system in
30 ;; most software, it allows you to recover *any* past state of a buffer
31 ;; (whereas the standard undo/redo system can lose past states as soon as you
32 ;; redo). However, this power comes at a price: many people find Emacs' undo
33 ;; system confusing and difficult to use, spawning a number of packages that
34 ;; replace it with the less powerful but more intuitive undo/redo system.
36 ;; Both the loss of data with standard undo/redo, and the confusion of Emacs'
37 ;; undo, stem from trying to treat undo history as a linear sequence of
38 ;; changes. It's not. The `undo-tree-mode' provided by this package replaces
39 ;; Emacs' undo system with a system that treats undo history as what it is: a
40 ;; branching tree of changes. This simple idea allows the more intuitive
41 ;; behaviour of the standard undo/redo system to be combined with the power of
42 ;; never losing any history. An added side bonus is that undo history can in
43 ;; some cases be stored more efficiently, allowing more changes to accumulate
44 ;; before Emacs starts discarding history.
46 ;; The only downside to this more advanced yet simpler undo system is that it
47 ;; was inspired by Vim. But, after all, most successful religions steal the
48 ;; best ideas from their competitors!
54 ;; This package has only been tested with Emacs versions 22, 23 and CVS. It
55 ;; will not work without modifications in earlier versions of Emacs.
57 ;; To install `undo-tree-mode', make sure this file is saved in a directory in
58 ;; your `load-path', and add the line:
60 ;; (require 'undo-tree)
62 ;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using
63 ;; "M-x byte-compile-file" from within emacs).
65 ;; If you want to replace the standard Emacs' undo system with the
66 ;; `undo-tree-mode' system in all buffers, you can enable it globally by
69 ;; (global-undo-tree-mode)
71 ;; to your .emacs file.
77 ;; If you're the kind of person who likes to jump in the car and drive,
78 ;; without bothering to first figure out whether the button on the left dips
79 ;; the headlights or operates the ejector seat (after all, you'll soon figure
80 ;; it out when you push it), then here's the minimum you need to know:
82 ;; `undo-tree-mode' and `global-undo-tree-mode'
83 ;; Enable undo-tree mode (either in the current buffer or globally).
85 ;; C-_ C-/ (`undo-tree-undo')
88 ;; M-_ C-? (`undo-tree-redo')
91 ;; `undo-tree-switch-branch'
92 ;; Switch undo-tree branch.
93 ;; (What does this mean? Better press the button and see!)
95 ;; C-x u (`undo-tree-visualize')
96 ;; Visualize the undo tree.
97 ;; (Better try pressing this button too!)
99 ;; C-x r u (`undo-tree-save-state-to-register')
100 ;; Save current buffer state to register.
102 ;; C-x r U (`undo-tree-restore-state-from-register')
103 ;; Restore buffer state from register.
107 ;; In the undo-tree visualizer:
109 ;; <up> p C-p (`undo-tree-visualize-undo')
112 ;; <down> n C-n (`undo-tree-visualize-redo')
115 ;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
116 ;; Switch to previous undo-tree branch.
118 ;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
119 ;; Switch to next undo-tree branch.
121 ;; <mouse-1> (`undo-tree-visualizer-mouse-set')
122 ;; Set state to node at mouse click.
124 ;; t (`undo-tree-visualizer-toggle-timestamps')
125 ;; Toggle display of time-stamps.
127 ;; d (`undo-tree-visualizer-toggle-diff')
128 ;; Toggle diff display.
130 ;; s (`undo-tree-visualizer-selection-mode')
131 ;; Toggle keyboard selection mode.
133 ;; q (`undo-tree-visualizer-quit')
134 ;; Quit undo-tree-visualizer.
136 ;; C-q (`undo-tree-visualizer-abort')
137 ;; Abort undo-tree-visualizer.
153 ;; In visualizer selection mode:
155 ;; <up> p C-p (`undo-tree-visualizer-select-previous')
156 ;; Select previous node.
158 ;; <down> n C-n (`undo-tree-visualizer-select-next')
161 ;; <left> b C-b (`undo-tree-visualizer-select-left')
162 ;; Select left sibling node.
164 ;; <right> f C-f (`undo-tree-visualizer-select-right')
165 ;; Select right sibling node.
168 ;; Select node 10 above.
171 ;; Select node 10 below.
173 ;; <enter> (`undo-tree-visualizer-set')
174 ;; Set state to selected node and exit selection mode.
176 ;; s (`undo-tree-visualizer-mode')
177 ;; Exit selection mode.
179 ;; t (`undo-tree-visualizer-toggle-timestamps')
180 ;; Toggle display of time-stamps.
182 ;; d (`undo-tree-visualizer-toggle-diff')
183 ;; Toggle diff display.
185 ;; q (`undo-tree-visualizer-quit')
186 ;; Quit undo-tree-visualizer.
188 ;; C-q (`undo-tree-visualizer-abort')
189 ;; Abort undo-tree-visualizer.
199 ;; Persistent undo history:
201 ;; Note: Requires a recent development version of Emacs checked out out from
202 ;; the Emacs bzr repository. All stable versions of Emacs currently
203 ;; break this feature.
205 ;; `undo-tree-auto-save-history' (variable)
206 ;; automatically save and restore undo-tree history along with buffer
207 ;; (disabled by default)
209 ;; `undo-tree-save-history' (command)
210 ;; manually save undo history to file
212 ;; `undo-tree-load-history' (command)
213 ;; manually load undo history from file
217 ;; Compressing undo history:
219 ;; Undo history files cannot grow beyond the maximum undo tree size, which
220 ;; is limited by `undo-limit', `undo-strong-limit' and
221 ;; `undo-outer-limit'. Nevertheless, undo history files can grow quite
222 ;; large. If you want to automatically compress undo history, add the
223 ;; following advice to your .emacs file (replacing ".gz" with the filename
224 ;; extension of your favourite compression algorithm):
226 ;; (defadvice undo-tree-make-history-save-file-name
227 ;; (after undo-tree activate)
228 ;; (setq concat ad-return-value ".gz"))
236 ;; To understand the different undo systems, it's easiest to consider an
237 ;; example. Imagine you make a few edits in a buffer. As you edit, you
238 ;; accumulate a history of changes, which we might visualize as a string of
239 ;; past buffer states, growing downwards:
241 ;; o (initial buffer state)
250 ;; x (current buffer state)
253 ;; Now imagine that you undo the last two changes. We can visualize this as
254 ;; rewinding the current state back two steps:
256 ;; o (initial buffer state)
259 ;; x (current buffer state)
268 ;; However, this isn't a good representation of what Emacs' undo system
269 ;; does. Instead, it treats the undos as *new* changes to the buffer, and adds
270 ;; them to the history:
272 ;; o (initial buffer state)
281 ;; x (buffer state before undo)
290 ;; Actually, since the buffer returns to a previous state after an undo,
291 ;; perhaps a better way to visualize it is to imagine the string of changes
292 ;; turning back on itself:
294 ;; (initial buffer state) o
297 ;; (first edit) o x (second undo)
300 ;; (second edit) o o (first undo)
303 ;; o (buffer state before undo)
305 ;; Treating undos as new changes might seem a strange thing to do. But the
306 ;; advantage becomes clear as soon as we imagine what happens when you edit
307 ;; the buffer again. Since you've undone a couple of changes, new edits will
308 ;; branch off from the buffer state that you've rewound to. Conceptually, it
311 ;; o (initial buffer state)
322 ;; The standard undo/redo system only lets you go backwards and forwards
323 ;; linearly. So as soon as you make that new edit, it discards the old
324 ;; branch. Emacs' undo just keeps adding changes to the end of the string. So
325 ;; the undo history in the two systems now looks like this:
327 ;; Undo/Redo: Emacs' undo
335 ;; . x (new edit) o o |
336 ;; (discarded . | / |
343 ;; Now, what if you change your mind about those undos, and decide you did
344 ;; like those other changes you'd made after all? With the standard undo/redo
345 ;; system, you're lost. There's no way to recover them, because that branch
346 ;; was discarded when you made the new edit.
348 ;; However, in Emacs' undo system, those old buffer states are still there in
349 ;; the undo history. You just have to rewind back through the new edit, and
350 ;; back through the changes made by the undos, until you reach them. Of
351 ;; course, since Emacs treats undos (even undos of undos!) as new changes,
352 ;; you're really weaving backwards and forwards through the history, all the
353 ;; time adding new changes to the end of the string as you go:
358 ;; o o o (undo new edit)
361 ;; o o | | o (undo the undo)
364 ;; (trying to get o | | x (undo the undo)
365 ;; to this state) | /
369 ;; So far, this is still reasonably intuitive to use. It doesn't behave so
370 ;; differently to standard undo/redo, except that by going back far enough you
371 ;; can access changes that would be lost in standard undo/redo.
373 ;; However, imagine that after undoing as just described, you decide you
374 ;; actually want to rewind right back to the initial state. If you're lucky,
375 ;; and haven't invoked any command since the last undo, you can just keep on
376 ;; undoing until you get back to the start:
378 ;; (trying to get o x (got there!)
379 ;; to this state) | |
381 ;; o o o o (keep undoing)
384 ;; o o | | o o (keep undoing)
387 ;; (already undid o | | o (got this far)
388 ;; to this state) | /
392 ;; But if you're unlucky, and you happen to have moved the point (say) after
393 ;; getting to the state labelled "got this far", then you've "broken the undo
394 ;; chain". Hold on to something solid, because things are about to get
395 ;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
396 ;; undos! So to get back to the initial state you now have to rewind through
397 ;; *all* the changes, including the undos you just did:
399 ;; (trying to get o x (finally got there!)
400 ;; to this state) | |
404 ;; | | \ | \ | \ | \ |
405 ;; o o | | o o o | o o
406 ;; | / | | | / | | | /
408 ;; (already undid o | | o<. | | o
409 ;; to this state) | / : | /
413 ;; (got this far, but
414 ;; broke the undo chain)
418 ;; In practice you can just hold down the undo key until you reach the buffer
419 ;; state that you want. But whatever you do, don't move around in the buffer
420 ;; to *check* that you've got back to where you want! Because you'll break the
421 ;; undo chain, and then you'll have to traverse the entire string of undos
422 ;; again, just to get back to the point at which you broke the
423 ;; chain. Undo-in-region and commands such as `undo-only' help to make using
424 ;; Emacs' undo a little easier, but nonetheless it remains confusing for many
428 ;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
429 ;; the history we've been discussing (make a few edits, undo a couple of them,
430 ;; and edit again)? The diagram that conceptually represented our undo
431 ;; history, before we started discussing specific undo systems? It looked like
434 ;; o (initial buffer state)
440 ;; o x (current state)
445 ;; Well, that's *exactly* what the undo history looks like to
446 ;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
447 ;; does), nor does it treat undos as new changes to be added to the end of a
448 ;; linear string of buffer states (as Emacs' undo does). It just keeps track
449 ;; of the tree of branching changes that make up the entire undo history.
451 ;; If you undo from this point, you'll rewind back up the tree to the previous
465 ;; If you were to undo again, you'd rewind back to the initial state. If on
466 ;; the other hand you redo the change, you'll end up back at the bottom of the
467 ;; most recent branch:
469 ;; o (undo takes you here)
475 ;; o x (redo takes you here)
480 ;; So far, this is just like the standard undo/redo system. But what if you
481 ;; want to return to a buffer state located on a previous branch of the
482 ;; history? Since `undo-tree-mode' keeps the entire history, you simply need
483 ;; to tell it to switch to a different branch, and then redo the changes you
489 ;; o (start here, but switch
490 ;; |\ to the other branch)
497 ;; Now you're on the other branch, if you undo and redo changes you'll stay on
498 ;; that branch, moving up and down through the buffer states located on that
499 ;; branch. Until you decide to switch branches again, of course.
501 ;; Real undo trees might have multiple branches and sub-branches:
514 ;; Trying to imagine what Emacs' undo would do as you move about such a tree
515 ;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
516 ;; just moving around this undo history tree. Most of the time, you'll
517 ;; probably only need to stay on the most recent branch, in which case it
518 ;; behaves like standard undo/redo, and is just as simple to understand. But
519 ;; if you ever need to recover a buffer state on a different branch, the
520 ;; possibility of switching between branches and accessing the full undo
521 ;; history is still there.
525 ;; The Undo-Tree Visualizer
526 ;; ========================
528 ;; Actually, it gets better. You don't have to imagine all these tree
529 ;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
530 ;; draws them for you! In fact, it draws even better diagrams: it highlights
531 ;; the node representing the current buffer state, it highlights the current
532 ;; branch, and you can toggle the display of time-stamps (by hitting "t") and
533 ;; a diff of the undo changes (by hitting "d"). (There's one other tiny
534 ;; difference: the visualizer puts the most recent branch on the left rather
537 ;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
539 ;; In the visualizer, the usual keys for moving up and down a buffer instead
540 ;; move up and down the undo history tree (e.g. the up and down arrow keys, or
541 ;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
542 ;; history you are visualizing) is updated as you move around the undo tree in
543 ;; the visualizer. If you reach a branch point in the visualizer, the usual
544 ;; keys for moving forward and backward in a buffer instead switch branch
545 ;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
547 ;; Clicking with the mouse on any node in the visualizer will take you
548 ;; directly to that node, resetting the state of the parent buffer to the
549 ;; state represented by that node.
551 ;; You can also select nodes directly using the keyboard, by hitting "s" to
552 ;; toggle selection mode. The usual motion keys now allow you to move around
553 ;; the tree without changing the parent buffer. Hitting <enter> will reset the
554 ;; state of the parent buffer to the state represented by the currently
557 ;; It can be useful to see how long ago the parent buffer was in the state
558 ;; represented by a particular node in the visualizer. Hitting "t" in the
559 ;; visualizer toggles the display of time-stamps for all the nodes. (Note
560 ;; that, because of the way `undo-tree-mode' works, these time-stamps may be
561 ;; somewhat later than the true times, especially if it's been a long time
562 ;; since you last undid any changes.)
564 ;; To get some idea of what changes are represented by a given node in the
565 ;; tree, it can be useful to see a diff of the changes. Hit "d" in the
566 ;; visualizer to toggle a diff display. This normally displays a diff between
567 ;; the current state and the previous one, i.e. it shows you the changes that
568 ;; will be applied if you undo (move up the tree). However, the diff display
569 ;; really comes into its own in the visualizer's selection mode (see above),
570 ;; where it instead shows a diff between the current state and the currently
571 ;; selected state, i.e. it shows you the changes that will be applied if you
572 ;; reset to the selected state.
574 ;; (Note that the diff is generated by the Emacs `diff' command, and is
575 ;; displayed using `diff-mode'. See the corresponding customization groups if
576 ;; you want to customize the diff display.)
578 ;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
579 ;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
580 ;; returning the parent buffer to whatever state it was originally in when the
588 ;; Emacs allows a very useful and powerful method of undoing only selected
589 ;; changes: when a region is active, only changes that affect the text within
590 ;; that region will be undone. With the standard Emacs undo system, changes
591 ;; produced by undoing-in-region naturally get added onto the end of the
592 ;; linear undo history:
596 ;; | x (second undo-in-region)
599 ;; | o (first undo-in-region)
605 ;; You can of course redo these undos-in-region as usual, by undoing the
613 ;; | o o (undo the undo-in-region)
617 ;; o x (undo the undo-in-region)
620 ;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
621 ;; region, undoing only undoes changes that affect that region. However, the
622 ;; way these undos-in-region are recorded in the undo history is quite
623 ;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
624 ;; undo history. The new branch consists of an undo step that undoes some of
625 ;; the changes that affect the current region, and another step that undoes
626 ;; the remaining changes needed to rejoin the previous undo history.
628 ;; Previous undo history Undo-in-region
636 ;; o o x (undo-in-region)
641 ;; As long as you don't change the active region after undoing-in-region,
642 ;; continuing to undo-in-region extends the new branch, pulling more changes
643 ;; that affect the current region into an undo step immediately above your
644 ;; current location in the undo tree, and pushing the point at which the new
645 ;; branch is attached further up the tree:
647 ;; First undo-in-region Second undo-in-region
652 ;; o o x (undo-in-region)
660 ;; Redoing takes you back down the undo tree, as usual (as long as you haven't
661 ;; changed the active region after undoing-in-region, it doesn't matter if it
676 ;; What about redo-in-region? Obviously, this only makes sense if you have
677 ;; already undone some changes, so that there are some changes to redo!
678 ;; Redoing-in-region splits off a new branch of the undo history below your
679 ;; current location in the undo tree. This time, the new branch consists of a
680 ;; redo step that redoes some of the redo changes that affect the current
681 ;; region, followed by all the remaining redo changes.
683 ;; Previous undo history Redo-in-region
691 ;; o o x (redo-in-region)
696 ;; As long as you don't change the active region after redoing-in-region,
697 ;; continuing to redo-in-region extends the new branch, pulling more redo
698 ;; changes into a redo step immediately below your current location in the
701 ;; First redo-in-region Second redo-in-region
709 ;; o x (redo-in-region) o o
712 ;; o o o x (redo-in-region)
717 ;; Note that undo-in-region and redo-in-region only ever add new changes to
718 ;; the undo tree, they *never* modify existing undo history. So you can always
719 ;; return to previous buffer states by switching to a previous branch of the
726 (eval-when-compile (require 'cl))
731 ;;; =====================================================================
732 ;;; Compatibility hacks for older Emacsen
734 ;; `characterp' isn't defined in Emacs versions < 23
735 (unless (fboundp 'characterp)
736 (defalias 'characterp 'char-valid-p))
738 ;; `region-active-p' isn't defined in Emacs versions < 23
739 (unless (fboundp 'region-active-p)
740 (defun region-active-p () (and transient-mark-mode mark-active)))
743 ;; `registerv' defstruct isn't defined in Emacs versions < 24
744 (unless (fboundp 'registerv-make)
745 (defmacro registerv-make (data &rest dummy) data))
747 (unless (fboundp 'registerv-data)
748 (defmacro registerv-data (data) data))
751 ;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
752 ;; versions < 24 (copied and adapted from Emacs 24)
753 (unless (fboundp 'diff-no-select)
754 (defun diff-no-select (old new &optional switches no-async buf)
755 ;; Noninteractive helper for creating and reverting diff buffers
756 (unless (bufferp new) (setq new (expand-file-name new)))
757 (unless (bufferp old) (setq old (expand-file-name old)))
758 (or switches (setq switches diff-switches)) ; If not specified, use default.
759 (unless (listp switches) (setq switches (list switches)))
760 (or buf (setq buf (get-buffer-create "*Diff*")))
761 (let* ((old-alt (diff-file-local-copy old))
762 (new-alt (diff-file-local-copy new))
766 ;; Use explicitly specified switches
768 ,@(mapcar #'shell-quote-argument
770 (when (or old-alt new-alt)
771 (list "-L" (if (stringp old)
772 old (prin1-to-string old))
773 "-L" (if (stringp new)
774 new (prin1-to-string new))))
775 (list (or old-alt old)
778 (thisdir default-directory))
779 (with-current-buffer buf
780 (setq buffer-read-only t)
781 (buffer-disable-undo (current-buffer))
782 (let ((inhibit-read-only t))
784 (buffer-enable-undo (current-buffer))
786 (set (make-local-variable 'revert-buffer-function)
787 (lambda (_ignore-auto _noconfirm)
788 (diff-no-select old new switches no-async (current-buffer))))
789 (setq default-directory thisdir)
790 (let ((inhibit-read-only t))
791 (insert command "\n"))
792 (if (and (not no-async) (fboundp 'start-process))
793 (let ((proc (start-process "Diff" buf shell-file-name
794 shell-command-switch command)))
795 (set-process-filter proc 'diff-process-filter)
796 (set-process-sentinel
797 proc (lambda (proc _msg)
798 (with-current-buffer (process-buffer proc)
799 (diff-sentinel (process-exit-status proc))
800 (if old-alt (delete-file old-alt))
801 (if new-alt (delete-file new-alt))))))
802 ;; Async processes aren't available.
803 (let ((inhibit-read-only t))
805 (call-process shell-file-name nil buf nil
806 shell-command-switch command))
807 (if old-alt (delete-file old-alt))
808 (if new-alt (delete-file new-alt)))))
811 (unless (fboundp 'diff-file-local-copy)
812 (defun diff-file-local-copy (file-or-buf)
813 (if (bufferp file-or-buf)
814 (with-current-buffer file-or-buf
815 (let ((tempfile (make-temp-file "buffer-content-")))
816 (write-region nil nil tempfile nil 'nomessage)
818 (file-local-copy file-or-buf))))
823 ;;; =====================================================================
824 ;;; Global variables and customization options
826 (defvar buffer-undo-tree nil
827 "Tree of undo entries in current buffer.")
828 (make-variable-buffer-local 'buffer-undo-tree)
829 (put 'buffer-undo-tree 'permanent-local t)
832 (defgroup undo-tree nil
836 (defcustom undo-tree-mode-lighter " Undo-Tree"
837 "Lighter displayed in mode line
838 when `undo-tree-mode' is enabled."
843 (defcustom undo-tree-auto-save-history nil
844 "When non-nil, `undo-tree-mode' will save undo history to file
845 when a buffer is saved to file.
847 It will automatically load undo history when a buffer is loaded
848 from file, if an undo save file exists.
850 Undo-tree history is saved to a file called
851 \".<buffer-file-name>.~undo-tree\" in the same directory as the
854 WARNING! `undo-tree-auto-save-history' will not work properly in
855 Emacs versions prior to 24.1.50.1, so it cannot be enabled via
856 the customization interface in versions earlier than that one. To
857 ignore this warning and enable it regardless, set
858 `undo-tree-auto-save-history' to a non-nil value outside of
861 :type (if (version-list-< (version-to-list emacs-version) '(24 1 50 1))
862 '(choice (const :tag "<disabled>" nil))
866 (defcustom undo-tree-history-directory-alist nil
867 "Alist of filename patterns and undo history directory names.
868 Each element looks like (REGEXP . DIRECTORY). Undo history for
869 files with names matching REGEXP will be saved in DIRECTORY.
870 DIRECTORY may be relative or absolute. If it is absolute, so
871 that all matching files are backed up into the same directory,
872 the file names in this directory will be the full name of the
873 file backed up with all directory separators changed to `!' to
874 prevent clashes. This will not work correctly if your filesystem
875 truncates the resulting name.
877 For the common case of all backups going into one directory, the
878 alist should contain a single element pairing \".\" with the
879 appropriate directory name.
881 If this variable is nil, or it fails to match a filename, the
882 backup is made in the original file's directory.
884 On MS-DOS filesystems without long names this variable is always
887 :type '(repeat (cons (regexp :tag "Regexp matching filename")
888 (directory :tag "Undo history directory name"))))
891 (defcustom undo-tree-visualizer-relative-timestamps t
892 "When non-nil, display times relative to current time
893 when displaying time stamps in visualizer.
895 Otherwise, display absolute times."
900 (defcustom undo-tree-visualizer-timestamps nil
901 "When non-nil, display time-stamps by default
902 in undo-tree visualizer.
904 \\<undo-tree-visualizer-map>You can always toggle time-stamps on and off \
905 using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
906 setting of this variable."
909 (make-variable-buffer-local 'undo-tree-visualizer-timestamps)
912 (defcustom undo-tree-visualizer-diff nil
913 "When non-nil, display diff by default in undo-tree visualizer.
915 \\<undo-tree-visualizer-map>You can always toggle the diff display \
916 using \\[undo-tree-visualizer-toggle-diff], regardless of the
917 setting of this variable."
920 (make-variable-buffer-local 'undo-tree-visualizer-diff)
923 (defcustom undo-tree-incompatible-major-modes '(term-mode)
924 "List of major-modes in which `undo-tree-mode' should not be enabled.
925 \(See `turn-on-undo-tree-mode'.\)"
927 :type '(repeat symbol))
930 (defcustom undo-tree-enable-undo-in-region t
931 "When non-nil, enable undo-in-region.
933 When undo-in-region is enabled, undoing or redoing when the
934 region is active (in `transient-mark-mode') or with a prefix
935 argument (not in `transient-mark-mode') only undoes changes
936 within the current region."
941 (defface undo-tree-visualizer-default-face
942 '((((class color)) :foreground "gray"))
943 "Face used to draw undo-tree in visualizer."
946 (defface undo-tree-visualizer-current-face
947 '((((class color)) :foreground "red"))
948 "Face used to highlight current undo-tree node in visualizer."
951 (defface undo-tree-visualizer-active-branch-face
952 '((((class color) (background dark))
953 (:foreground "white" :weight bold))
954 (((class color) (background light))
955 (:foreground "black" :weight bold)))
956 "Face used to highlight active undo-tree branch in visualizer."
959 (defface undo-tree-visualizer-register-face
960 '((((class color)) :foreground "yellow"))
961 "Face used to highlight undo-tree nodes saved to a register
966 (defvar undo-tree-visualizer-parent-buffer nil
967 "Parent buffer in visualizer.")
968 (make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
970 ;; stores current horizontal spacing needed for drawing undo-tree
971 (defvar undo-tree-visualizer-spacing nil)
972 (make-variable-buffer-local 'undo-tree-visualizer-spacing)
974 ;; calculate horizontal spacing required for drawing undo-tree with current
976 (defsubst undo-tree-visualizer-calculate-spacing ()
977 (if undo-tree-visualizer-timestamps
978 (if undo-tree-visualizer-relative-timestamps 9 13)
981 ;; holds node that was current when visualizer was invoked
982 (defvar undo-tree-visualizer-initial-node nil)
983 (make-variable-buffer-local 'undo-tree-visualizer-initial-node)
985 ;; holds currently selected node in visualizer selection mode
986 (defvar undo-tree-visualizer-selected-node nil)
987 (make-variable-buffer-local 'undo-tree-visualizer-selected)
989 ;; dynamically bound to t when undoing from visualizer, to inhibit
990 ;; `undo-tree-kill-visualizer' hook function in parent buffer
991 (defvar undo-tree-inhibit-kill-visualizer nil)
994 (defconst undo-tree-visualizer-buffer-name " *undo-tree*")
995 (defconst undo-tree-diff-buffer-name "*undo-tree Diff*")
997 ;; prevent debugger being called on "No further redo information"
998 (add-to-list 'debug-ignored-errors "^No further redo information")
1003 ;;; =================================================================
1004 ;;; Install history-auto-save hooks
1006 (add-hook 'write-file-functions 'undo-tree-save-history-hook)
1007 (add-hook 'find-file-hook 'undo-tree-load-history-hook)
1012 ;;; =================================================================
1013 ;;; Setup default keymaps
1015 (defvar undo-tree-map nil
1016 "Keymap used in undo-tree-mode.")
1018 (unless undo-tree-map
1019 (let ((map (make-sparse-keymap)))
1020 ;; remap `undo' and `undo-only' to `undo-tree-undo'
1021 (define-key map [remap undo] 'undo-tree-undo)
1022 (define-key map [remap undo-only] 'undo-tree-undo)
1023 ;; bind standard undo bindings (since these match redo counterparts)
1024 (define-key map (kbd "C-/") 'undo-tree-undo)
1025 (define-key map "\C-_" 'undo-tree-undo)
1026 ;; redo doesn't exist normally, so define our own keybindings
1027 (define-key map (kbd "C-?") 'undo-tree-redo)
1028 (define-key map (kbd "M-_") 'undo-tree-redo)
1029 ;; just in case something has defined `redo'...
1030 (define-key map [remap redo] 'undo-tree-redo)
1031 ;; we use "C-x u" for the undo-tree visualizer
1032 (define-key map (kbd "\C-x u") 'undo-tree-visualize)
1033 ;; bind register commands
1034 (define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
1035 (define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
1037 (setq undo-tree-map map)))
1040 (defvar undo-tree-visualizer-map nil
1041 "Keymap used in undo-tree visualizer.")
1043 (unless undo-tree-visualizer-map
1044 (let ((map (make-sparse-keymap)))
1045 ;; vertical motion keys undo/redo
1046 (define-key map [remap previous-line] 'undo-tree-visualize-undo)
1047 (define-key map [remap next-line] 'undo-tree-visualize-redo)
1048 (define-key map [up] 'undo-tree-visualize-undo)
1049 (define-key map "p" 'undo-tree-visualize-undo)
1050 (define-key map "\C-p" 'undo-tree-visualize-undo)
1051 (define-key map [down] 'undo-tree-visualize-redo)
1052 (define-key map "n" 'undo-tree-visualize-redo)
1053 (define-key map "\C-n" 'undo-tree-visualize-redo)
1054 ;; horizontal motion keys switch branch
1055 (define-key map [remap forward-char]
1056 'undo-tree-visualize-switch-branch-right)
1057 (define-key map [remap backward-char]
1058 'undo-tree-visualize-switch-branch-left)
1059 (define-key map [right] 'undo-tree-visualize-switch-branch-right)
1060 (define-key map "f" 'undo-tree-visualize-switch-branch-right)
1061 (define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
1062 (define-key map [left] 'undo-tree-visualize-switch-branch-left)
1063 (define-key map "b" 'undo-tree-visualize-switch-branch-left)
1064 (define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
1065 ;; mouse sets buffer state to node at click
1066 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
1067 ;; toggle timestamps
1068 (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
1070 (define-key map "d" 'undo-tree-visualizer-toggle-diff)
1072 (define-key map "s" 'undo-tree-visualizer-selection-mode)
1073 ;; horizontal scrolling may be needed if the tree is very wide
1074 (define-key map "," 'undo-tree-visualizer-scroll-left)
1075 (define-key map "." 'undo-tree-visualizer-scroll-right)
1076 (define-key map "<" 'undo-tree-visualizer-scroll-left)
1077 (define-key map ">" 'undo-tree-visualizer-scroll-right)
1078 ;; vertical scrolling may be needed if the tree is very tall
1079 (define-key map [next] 'scroll-up)
1080 (define-key map [prior] 'scroll-down)
1081 ;; quit/abort visualizer
1082 (define-key map "q" 'undo-tree-visualizer-quit)
1083 (define-key map "\C-q" 'undo-tree-visualizer-abort)
1085 (setq undo-tree-visualizer-map map)))
1088 (defvar undo-tree-visualizer-selection-map nil
1089 "Keymap used in undo-tree visualizer selection mode.")
1091 (unless undo-tree-visualizer-selection-map
1092 (let ((map (make-sparse-keymap)))
1093 ;; vertical motion keys move up and down tree
1094 (define-key map [remap previous-line]
1095 'undo-tree-visualizer-select-previous)
1096 (define-key map [remap next-line]
1097 'undo-tree-visualizer-select-next)
1098 (define-key map [up] 'undo-tree-visualizer-select-previous)
1099 (define-key map "p" 'undo-tree-visualizer-select-previous)
1100 (define-key map "\C-p" 'undo-tree-visualizer-select-previous)
1101 (define-key map [down] 'undo-tree-visualizer-select-next)
1102 (define-key map "n" 'undo-tree-visualizer-select-next)
1103 (define-key map "\C-n" 'undo-tree-visualizer-select-next)
1104 ;; vertical scroll keys move up and down quickly
1105 (define-key map [next]
1106 (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
1107 (define-key map [prior]
1108 (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
1109 ;; horizontal motion keys move to left and right siblings
1110 (define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
1111 (define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
1112 (define-key map [right] 'undo-tree-visualizer-select-right)
1113 (define-key map "f" 'undo-tree-visualizer-select-right)
1114 (define-key map "\C-f" 'undo-tree-visualizer-select-right)
1115 (define-key map [left] 'undo-tree-visualizer-select-left)
1116 (define-key map "b" 'undo-tree-visualizer-select-left)
1117 (define-key map "\C-b" 'undo-tree-visualizer-select-left)
1118 ;; horizontal scroll keys move left or right quickly
1120 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1122 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1124 (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
1126 (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
1127 ;; mouse or <enter> sets buffer state to node at point/click
1128 (define-key map "\r" 'undo-tree-visualizer-set)
1129 (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
1130 ;; toggle timestamps
1131 (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
1133 (define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
1134 ;; quit visualizer selection mode
1135 (define-key map "s" 'undo-tree-visualizer-mode)
1137 (define-key map "q" 'undo-tree-visualizer-quit)
1138 (define-key map "\C-q" 'undo-tree-visualizer-abort)
1140 (setq undo-tree-visualizer-selection-map map)))
1145 ;;; =====================================================================
1146 ;;; Undo-tree data structure
1152 (:constructor make-undo-tree
1154 (root (undo-tree-make-node nil nil))
1157 (object-pool (make-hash-table :test 'eq :weakness 'value))))
1160 root current size object-pool)
1166 (:type vector) ; create unnamed struct
1168 (:constructor undo-tree-make-node
1172 (timestamp (current-time))
1174 (:constructor undo-tree-make-node-backwards
1178 (next (list next-node))
1179 (timestamp (current-time))
1182 previous next undo redo timestamp branch meta-data)
1185 (defmacro undo-tree-node-p (n)
1186 (let ((len (length (undo-tree-make-node nil nil))))
1187 `(and (vectorp ,n) (= (length ,n) ,len))))
1192 (undo-tree-region-data
1193 (:type vector) ; create unnamed struct
1195 (:constructor undo-tree-make-region-data
1196 (&optional undo-beginning undo-end
1197 redo-beginning redo-end))
1198 (:constructor undo-tree-make-undo-region-data
1199 (undo-beginning undo-end))
1200 (:constructor undo-tree-make-redo-region-data
1201 (redo-beginning redo-end))
1203 undo-beginning undo-end redo-beginning redo-end)
1206 (defmacro undo-tree-region-data-p (r)
1207 (let ((len (length (undo-tree-make-region-data))))
1208 `(and (vectorp ,r) (= (length ,r) ,len))))
1210 (defmacro undo-tree-node-clear-region-data (node)
1211 `(setf (undo-tree-node-meta-data ,node)
1214 (plist-put (undo-tree-node-meta-data ,node)
1218 (defmacro undo-tree-node-undo-beginning (node)
1219 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1220 (when (undo-tree-region-data-p r)
1221 (undo-tree-region-data-undo-beginning r))))
1223 (defmacro undo-tree-node-undo-end (node)
1224 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1225 (when (undo-tree-region-data-p r)
1226 (undo-tree-region-data-undo-end r))))
1228 (defmacro undo-tree-node-redo-beginning (node)
1229 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1230 (when (undo-tree-region-data-p r)
1231 (undo-tree-region-data-redo-beginning r))))
1233 (defmacro undo-tree-node-redo-end (node)
1234 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1235 (when (undo-tree-region-data-p r)
1236 (undo-tree-region-data-redo-end r))))
1239 (defsetf undo-tree-node-undo-beginning (node) (val)
1240 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1241 (unless (undo-tree-region-data-p r)
1242 (setf (undo-tree-node-meta-data ,node)
1243 (plist-put (undo-tree-node-meta-data ,node) :region
1244 (setq r (undo-tree-make-region-data)))))
1245 (setf (undo-tree-region-data-undo-beginning r) ,val)))
1247 (defsetf undo-tree-node-undo-end (node) (val)
1248 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1249 (unless (undo-tree-region-data-p r)
1250 (setf (undo-tree-node-meta-data ,node)
1251 (plist-put (undo-tree-node-meta-data ,node) :region
1252 (setq r (undo-tree-make-region-data)))))
1253 (setf (undo-tree-region-data-undo-end r) ,val)))
1255 (defsetf undo-tree-node-redo-beginning (node) (val)
1256 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1257 (unless (undo-tree-region-data-p r)
1258 (setf (undo-tree-node-meta-data ,node)
1259 (plist-put (undo-tree-node-meta-data ,node) :region
1260 (setq r (undo-tree-make-region-data)))))
1261 (setf (undo-tree-region-data-redo-beginning r) ,val)))
1263 (defsetf undo-tree-node-redo-end (node) (val)
1264 `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
1265 (unless (undo-tree-region-data-p r)
1266 (setf (undo-tree-node-meta-data ,node)
1267 (plist-put (undo-tree-node-meta-data ,node) :region
1268 (setq r (undo-tree-make-region-data)))))
1269 (setf (undo-tree-region-data-redo-end r) ,val)))
1274 (undo-tree-visualizer-data
1275 (:type vector) ; create unnamed struct
1277 (:constructor undo-tree-make-visualizer-data
1278 (&optional lwidth cwidth rwidth marker))
1280 lwidth cwidth rwidth marker)
1283 (defmacro undo-tree-visualizer-data-p (v)
1284 (let ((len (length (undo-tree-make-visualizer-data))))
1285 `(and (vectorp ,v) (= (length ,v) ,len))))
1287 (defmacro undo-tree-node-clear-visualizer-data (node)
1288 `(setf (undo-tree-node-meta-data ,node)
1291 (plist-put (undo-tree-node-meta-data ,node)
1292 :visualizer nil)))))
1295 (defmacro undo-tree-node-lwidth (node)
1296 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1297 (when (undo-tree-visualizer-data-p v)
1298 (undo-tree-visualizer-data-lwidth v))))
1300 (defmacro undo-tree-node-cwidth (node)
1301 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1302 (when (undo-tree-visualizer-data-p v)
1303 (undo-tree-visualizer-data-cwidth v))))
1305 (defmacro undo-tree-node-rwidth (node)
1306 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1307 (when (undo-tree-visualizer-data-p v)
1308 (undo-tree-visualizer-data-rwidth v))))
1310 (defmacro undo-tree-node-marker (node)
1311 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1312 (when (undo-tree-visualizer-data-p v)
1313 (undo-tree-visualizer-data-marker v))))
1316 (defsetf undo-tree-node-lwidth (node) (val)
1317 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1318 (unless (undo-tree-visualizer-data-p v)
1319 (setf (undo-tree-node-meta-data ,node)
1320 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1321 (setq v (undo-tree-make-visualizer-data)))))
1322 (setf (undo-tree-visualizer-data-lwidth v) ,val)))
1324 (defsetf undo-tree-node-cwidth (node) (val)
1325 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1326 (unless (undo-tree-visualizer-data-p v)
1327 (setf (undo-tree-node-meta-data ,node)
1328 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1329 (setq v (undo-tree-make-visualizer-data)))))
1330 (setf (undo-tree-visualizer-data-cwidth v) ,val)))
1332 (defsetf undo-tree-node-rwidth (node) (val)
1333 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1334 (unless (undo-tree-visualizer-data-p v)
1335 (setf (undo-tree-node-meta-data ,node)
1336 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1337 (setq v (undo-tree-make-visualizer-data)))))
1338 (setf (undo-tree-visualizer-data-rwidth v) ,val)))
1340 (defsetf undo-tree-node-marker (node) (val)
1341 `(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
1342 (unless (undo-tree-visualizer-data-p v)
1343 (setf (undo-tree-node-meta-data ,node)
1344 (plist-put (undo-tree-node-meta-data ,node) :visualizer
1345 (setq v (undo-tree-make-visualizer-data)))))
1346 (setf (undo-tree-visualizer-data-marker v) ,val)))
1351 (undo-tree-register-data
1354 (:constructor undo-tree-make-register-data (buffer node)))
1357 (defun undo-tree-register-data-p (data)
1360 (undo-tree-node-p (undo-tree-register-data-node data))))
1362 (defun undo-tree-register-data-print-func (data)
1363 (princ (format "an undo-tree state for buffer %s"
1364 (undo-tree-register-data-buffer data))))
1366 (defmacro undo-tree-node-register (node)
1367 `(plist-get (undo-tree-node-meta-data ,node) :register))
1369 (defsetf undo-tree-node-register (node) (val)
1370 `(setf (undo-tree-node-meta-data ,node)
1371 (plist-put (undo-tree-node-meta-data ,node) :register ,val)))
1376 ;;; =====================================================================
1377 ;;; Basic undo-tree data structure functions
1379 (defun undo-tree-grow (undo)
1380 "Add an UNDO node to current branch of `buffer-undo-tree'."
1381 (let* ((current (undo-tree-current buffer-undo-tree))
1382 (new (undo-tree-make-node current undo)))
1383 (push new (undo-tree-node-next current))
1384 (setf (undo-tree-current buffer-undo-tree) new)))
1387 (defun undo-tree-grow-backwards (node undo &optional redo)
1388 "Add new node *above* undo-tree NODE, and return new node.
1389 Note that this will overwrite NODE's \"previous\" link, so should
1390 only be used on a detached NODE, never on nodes that are already
1391 part of `buffer-undo-tree'."
1392 (let ((new (undo-tree-make-node-backwards node undo redo)))
1393 (setf (undo-tree-node-previous node) new)
1397 (defun undo-tree-splice-node (node splice)
1398 "Splice NODE into undo tree, below node SPLICE.
1399 Note that this will overwrite NODE's \"next\" and \"previous\"
1400 links, so should only be used on a detached NODE, never on nodes
1401 that are already part of `buffer-undo-tree'."
1402 (setf (undo-tree-node-next node) (undo-tree-node-next splice)
1403 (undo-tree-node-branch node) (undo-tree-node-branch splice)
1404 (undo-tree-node-previous node) splice
1405 (undo-tree-node-next splice) (list node)
1406 (undo-tree-node-branch splice) 0)
1407 (dolist (n (undo-tree-node-next node))
1408 (setf (undo-tree-node-previous n) node)))
1411 (defun undo-tree-snip-node (node)
1412 "Snip NODE out of undo tree."
1413 (let* ((parent (undo-tree-node-previous node))
1415 ;; if NODE is only child, replace parent's next links with NODE's
1416 (if (= (length (undo-tree-node-next parent)) 0)
1417 (setf (undo-tree-node-next parent) (undo-tree-node-next node)
1418 (undo-tree-node-branch parent) (undo-tree-node-branch node))
1420 (setq position (undo-tree-position node (undo-tree-node-next parent)))
1422 ;; if active branch used do go via NODE, set parent's branch to active
1424 ((= (undo-tree-node-branch parent) position)
1425 (setf (undo-tree-node-branch parent)
1426 (+ position (undo-tree-node-branch node))))
1427 ;; if active branch didn't go via NODE, update parent's branch to point
1428 ;; to same node as before
1429 ((> (undo-tree-node-branch parent) position)
1430 (incf (undo-tree-node-branch parent)
1431 (1- (length (undo-tree-node-next node))))))
1432 ;; replace NODE in parent's next list with NODE's entire next list
1434 (setf (undo-tree-node-next parent)
1435 (nconc (undo-tree-node-next node)
1436 (cdr (undo-tree-node-next parent))))
1437 (setq p (nthcdr (1- position) (undo-tree-node-next parent)))
1438 (setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
1439 ;; update previous links of NODE's children
1440 (dolist (n (undo-tree-node-next node))
1441 (setf (undo-tree-node-previous n) parent))))
1444 (defun undo-tree-mapc (--undo-tree-mapc-function-- undo-tree)
1445 ;; Apply FUNCTION to each node in UNDO-TREE.
1446 (let ((stack (list (undo-tree-root undo-tree)))
1449 (setq node (pop stack))
1450 (funcall --undo-tree-mapc-function-- node)
1451 (setq stack (append (undo-tree-node-next node) stack)))))
1454 (defmacro undo-tree-num-branches ()
1455 "Return number of branches at current undo tree node."
1456 '(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
1459 (defun undo-tree-position (node list)
1460 "Find the first occurrence of NODE in LIST.
1461 Return the index of the matching item, or nil of not found.
1462 Comparison is done with `eq'."
1466 (when (eq node (car list)) (throw 'found i))
1468 (setq list (cdr list))))
1472 (defvar *undo-tree-id-counter* 0)
1473 (make-variable-buffer-local '*undo-tree-id-counter*)
1475 (defmacro undo-tree-generate-id ()
1476 ;; Generate a new, unique id (uninterned symbol).
1477 ;; The name is made by appending a number to "undo-tree-id".
1478 ;; (Copied from CL package `gensym'.)
1479 `(let ((num (prog1 *undo-tree-id-counter* (incf *undo-tree-id-counter*))))
1480 (make-symbol (format "undo-tree-id%d" num))))
1483 (defun undo-tree-decircle (tree)
1484 ;; Nullify PREVIOUS links of undo-tree-nodes, to make undo-tree data
1485 ;; structure non-circular.
1488 (dolist (n (undo-tree-node-next node))
1489 (setf (undo-tree-node-previous n) nil)))
1493 (defun undo-tree-recircle (tree)
1494 ;; Recreate PREVIOUS links of undo-tree-nodes, to restore circular undo-tree
1498 (dolist (n (undo-tree-node-next node))
1499 (setf (undo-tree-node-previous n) node)))
1505 ;;; =====================================================================
1506 ;;; Utility functions for handling `buffer-undo-list' and changesets
1508 (defmacro undo-list-marker-elt-p (elt)
1509 `(markerp (car-safe ,elt)))
1511 (defmacro undo-list-GCd-marker-elt-p (elt)
1512 ;; Return t if ELT is a marker element whose marker has been moved to the
1513 ;; object-pool, so may potentially have been garbage-collected.
1514 ;; Note: Valid marker undo elements should be uniquely identified as cons
1515 ;; cells with a symbol in the car (replacing the marker), and a number in
1516 ;; the cdr. However, to guard against future changes to undo element
1517 ;; formats, we perform an additional redundant check on the symbol name.
1518 `(and (car-safe ,elt)
1519 (symbolp (car ,elt))
1520 (let ((str (symbol-name (car ,elt))))
1521 (and (> (length str) 12)
1522 (string= (substring str 0 12) "undo-tree-id")))
1523 (numberp (cdr-safe ,elt))))
1526 (defun undo-tree-move-GC-elts-to-pool (elt)
1527 ;; Move elements that can be garbage-collected into `buffer-undo-tree'
1528 ;; object pool, substituting a unique id that can be used to retrieve them
1529 ;; later. (Only markers require this treatment currently.)
1530 (when (undo-list-marker-elt-p elt)
1531 (let ((id (undo-tree-generate-id)))
1532 (puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
1536 (defun undo-tree-restore-GC-elts-from-pool (elt)
1537 ;; Replace object id's in ELT with corresponding objects from
1538 ;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
1539 ;; any object in ELT has been garbage-collected.
1540 (if (undo-list-GCd-marker-elt-p elt)
1541 (when (setcar elt (gethash (car elt)
1542 (undo-tree-object-pool buffer-undo-tree)))
1547 (defun undo-list-clean-GCd-elts (undo-list)
1548 ;; Remove object id's from UNDO-LIST that refer to elements that have been
1549 ;; garbage-collected. UNDO-LIST is modified by side-effect.
1550 (while (undo-list-GCd-marker-elt-p (car undo-list))
1551 (unless (gethash (caar undo-list)
1552 (undo-tree-object-pool buffer-undo-tree))
1553 (setq undo-list (cdr undo-list))))
1554 (let ((p undo-list))
1556 (when (and (undo-list-GCd-marker-elt-p (cadr p))
1557 (null (gethash (car (cadr p))
1558 (undo-tree-object-pool buffer-undo-tree))))
1559 (setcdr p (cddr p)))
1564 (defun undo-list-pop-changeset (&optional discard-pos)
1565 ;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
1566 ;; any position entries from changeset.
1568 ;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
1569 ;; at head of undo list
1570 (while (or (null (car buffer-undo-list))
1571 (and discard-pos (integerp (car buffer-undo-list))))
1572 (setq buffer-undo-list (cdr buffer-undo-list)))
1573 ;; pop elements up to next undo boundary, discarding position entries if
1574 ;; DISCARD-POS is non-nil
1575 (if (eq (car buffer-undo-list) 'undo-tree-canary)
1576 (push nil buffer-undo-list)
1577 (let* ((changeset (list (pop buffer-undo-list)))
1580 (undo-tree-move-GC-elts-to-pool (car p))
1581 (while (and discard-pos (integerp (car buffer-undo-list)))
1582 (setq buffer-undo-list (cdr buffer-undo-list)))
1583 (and (car buffer-undo-list)
1584 (not (eq (car buffer-undo-list) 'undo-tree-canary))))
1585 (setcdr p (list (pop buffer-undo-list)))
1590 (defun undo-tree-copy-list (undo-list)
1591 ;; Return a deep copy of first changeset in `undo-list'. Object id's are
1592 ;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
1595 ;; if first element contains an object id, replace it with object from
1596 ;; pool, discarding element entirely if it's been GC'd
1599 (undo-tree-restore-GC-elts-from-pool (pop undo-list))))
1600 (setq copy (list copy)
1602 ;; copy remaining elements, replacing object id's with objects from
1603 ;; pool, or discarding them entirely if they've been GC'd
1605 (when (setcdr p (undo-tree-restore-GC-elts-from-pool
1606 (undo-copy-list-1 (pop undo-list))))
1607 (setcdr p (list (cdr p)))
1613 (defun undo-list-transfer-to-tree ()
1614 ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
1616 ;; if `buffer-undo-tree' is empty, create initial undo-tree
1617 (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
1618 ;; make sure there's a canary at end of `buffer-undo-list'
1619 (when (null buffer-undo-list)
1620 (setq buffer-undo-list '(nil undo-tree-canary)))
1622 (unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1623 (eq (car buffer-undo-list) 'undo-tree-canary))
1624 ;; create new node from first changeset in `buffer-undo-list', save old
1625 ;; `buffer-undo-tree' current node, and make new node the current node
1626 (let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
1627 (splice (undo-tree-current buffer-undo-tree))
1628 (size (undo-list-byte-size (undo-tree-node-undo node))))
1629 (setf (undo-tree-current buffer-undo-tree) node)
1630 ;; grow tree fragment backwards using `buffer-undo-list' changesets
1631 (while (and buffer-undo-list
1632 (not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
1634 (undo-tree-grow-backwards node (undo-list-pop-changeset)))
1635 (incf size (undo-list-byte-size (undo-tree-node-undo node))))
1636 ;; if no undo history has been discarded from `buffer-undo-list' since
1637 ;; last transfer, splice new tree fragment onto end of old
1638 ;; `buffer-undo-tree' current node
1639 (if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1640 (eq (car buffer-undo-list) 'undo-tree-canary))
1642 (setf (undo-tree-node-previous node) splice)
1643 (push node (undo-tree-node-next splice))
1644 (setf (undo-tree-node-branch splice) 0)
1645 (incf (undo-tree-size buffer-undo-tree) size))
1646 ;; if undo history has been discarded, replace entire
1647 ;; `buffer-undo-tree' with new tree fragment
1648 (setq node (undo-tree-grow-backwards node nil))
1649 (setf (undo-tree-root buffer-undo-tree) node)
1650 (setq buffer-undo-list '(nil undo-tree-canary))
1651 (setf (undo-tree-size buffer-undo-tree) size)
1652 (setq buffer-undo-list '(nil undo-tree-canary))))
1653 ;; discard undo history if necessary
1654 (undo-tree-discard-history)))
1657 (defun undo-list-byte-size (undo-list)
1658 ;; Return size (in bytes) of UNDO-LIST
1659 (let ((size 0) (p undo-list))
1661 (incf size 8) ; cons cells use up 8 bytes
1662 (when (and (consp (car p)) (stringp (caar p)))
1663 (incf size (string-bytes (caar p))))
1669 (defun undo-list-rebuild-from-tree ()
1670 "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
1671 (unless (eq buffer-undo-list t)
1672 (undo-list-transfer-to-tree)
1673 (setq buffer-undo-list nil)
1674 (when buffer-undo-tree
1675 (let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
1676 (push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
1678 (time-less-p (undo-tree-node-timestamp a)
1679 (undo-tree-node-timestamp b))))
1681 ;; Traverse tree in depth-and-oldest-first order, but add undo records
1682 ;; on the way down, and redo records on the way up.
1683 (while (or (car stack)
1684 (not (eq (car (nth 1 stack))
1685 (undo-tree-current buffer-undo-tree))))
1688 (setq buffer-undo-list
1689 (append (undo-tree-node-undo (caar stack))
1692 (push (sort (mapcar 'identity
1693 (undo-tree-node-next (caar stack)))
1695 (time-less-p (undo-tree-node-timestamp a)
1696 (undo-tree-node-timestamp b))))
1699 (setq buffer-undo-list
1700 (append (undo-tree-node-redo (caar stack))
1703 (pop (car stack))))))))
1708 ;;; =====================================================================
1709 ;;; History discarding functions
1711 (defun undo-tree-oldest-leaf (node)
1712 ;; Return oldest leaf node below NODE.
1713 (while (undo-tree-node-next node)
1715 (car (sort (mapcar 'identity (undo-tree-node-next node))
1717 (time-less-p (undo-tree-node-timestamp a)
1718 (undo-tree-node-timestamp b)))))))
1722 (defun undo-tree-discard-node (node)
1723 ;; Discard NODE from `buffer-undo-tree', and return next in line for
1726 ;; don't discard current node
1727 (unless (eq node (undo-tree-current buffer-undo-tree))
1729 ;; discarding root node...
1730 (if (eq node (undo-tree-root buffer-undo-tree))
1732 ;; should always discard branches before root
1733 ((> (length (undo-tree-node-next node)) 1)
1734 (error "Trying to discard undo-tree root which still\
1735 has multiple branches"))
1736 ;; don't discard root if current node is only child
1737 ((eq (car (undo-tree-node-next node))
1738 (undo-tree-current buffer-undo-tree))
1742 ;; clear any register referring to root
1743 (let ((r (undo-tree-node-register node)))
1744 (when (and r (eq (get-register r) node))
1745 (set-register r nil)))
1746 ;; make child of root into new root
1747 (setq node (setf (undo-tree-root buffer-undo-tree)
1748 (car (undo-tree-node-next node))))
1749 ;; update undo-tree size
1750 (decf (undo-tree-size buffer-undo-tree)
1751 (+ (undo-list-byte-size (undo-tree-node-undo node))
1752 (undo-list-byte-size (undo-tree-node-redo node))))
1753 ;; discard new root's undo data and PREVIOUS link
1754 (setf (undo-tree-node-undo node) nil
1755 (undo-tree-node-redo node) nil
1756 (undo-tree-node-previous node) nil)
1757 ;; if new root has branches, or new root is current node, next node
1758 ;; to discard is oldest leaf, otherwise it's new root
1759 (if (or (> (length (undo-tree-node-next node)) 1)
1760 (eq (car (undo-tree-node-next node))
1761 (undo-tree-current buffer-undo-tree)))
1762 (undo-tree-oldest-leaf node)
1765 ;; discarding leaf node...
1766 (let* ((parent (undo-tree-node-previous node))
1767 (current (nth (undo-tree-node-branch parent)
1768 (undo-tree-node-next parent))))
1769 ;; clear any register referring to the discarded node
1770 (let ((r (undo-tree-node-register node)))
1771 (when (and r (eq (get-register r) node))
1772 (set-register r nil)))
1773 ;; update undo-tree size
1774 (decf (undo-tree-size buffer-undo-tree)
1775 (+ (undo-list-byte-size (undo-tree-node-undo node))
1776 (undo-list-byte-size (undo-tree-node-redo node))))
1777 (setf (undo-tree-node-next parent)
1778 (delq node (undo-tree-node-next parent))
1779 (undo-tree-node-branch parent)
1780 (undo-tree-position current (undo-tree-node-next parent)))
1781 ;; if parent has branches, or parent is current node, next node to
1782 ;; discard is oldest leaf, otherwise it's parent
1783 (if (or (eq parent (undo-tree-current buffer-undo-tree))
1784 (and (undo-tree-node-next parent)
1785 (or (not (eq parent (undo-tree-root buffer-undo-tree)))
1786 (> (length (undo-tree-node-next parent)) 1))))
1787 (undo-tree-oldest-leaf parent)
1792 (defun undo-tree-discard-history ()
1793 "Discard undo history until we're within memory usage limits
1794 set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
1796 (when (> (undo-tree-size buffer-undo-tree) undo-limit)
1797 ;; if there are no branches off root, first node to discard is root;
1798 ;; otherwise it's leaf node at botom of oldest branch
1799 (let ((node (if (> (length (undo-tree-node-next
1800 (undo-tree-root buffer-undo-tree))) 1)
1801 (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
1802 (undo-tree-root buffer-undo-tree))))
1804 ;; discard nodes until memory use is within `undo-strong-limit'
1806 (> (undo-tree-size buffer-undo-tree) undo-strong-limit))
1807 (setq node (undo-tree-discard-node node)))
1809 ;; discard nodes until next node to discard would bring memory use
1810 ;; within `undo-limit'
1812 ;; check first if last discard has brought us within
1813 ;; `undo-limit', in case we can avoid more expensive
1814 ;; `undo-strong-limit' calculation
1815 ;; Note: this assumes undo-strong-limit > undo-limit;
1816 ;; if not, effectively undo-strong-limit = undo-limit
1817 (> (undo-tree-size buffer-undo-tree) undo-limit)
1818 (> (- (undo-tree-size buffer-undo-tree)
1819 ;; if next node to discard is root, the memory we
1820 ;; free-up comes from discarding changesets from its
1822 (if (eq node (undo-tree-root buffer-undo-tree))
1823 (+ (undo-list-byte-size
1824 (undo-tree-node-undo
1825 (car (undo-tree-node-next node))))
1826 (undo-list-byte-size
1827 (undo-tree-node-redo
1828 (car (undo-tree-node-next node)))))
1829 ;; ...otherwise, it comes from discarding changesets
1830 ;; from along with the node itself
1831 (+ (undo-list-byte-size (undo-tree-node-undo node))
1832 (undo-list-byte-size (undo-tree-node-redo node)))
1835 (setq node (undo-tree-discard-node node)))
1837 ;; if we're still over the `undo-outer-limit', discard entire history
1838 (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
1839 ;; query first if `undo-ask-before-discard' is set
1840 (if undo-ask-before-discard
1843 "Buffer `%s' undo info is %d bytes long; discard it? "
1844 (buffer-name) (undo-tree-size buffer-undo-tree)))
1845 (setq buffer-undo-tree nil))
1846 ;; otherwise, discard and display warning
1848 '(undo discard-info)
1850 (format "Buffer `%s' undo info was %d bytes long.\n"
1851 (buffer-name) (undo-tree-size buffer-undo-tree))
1852 "The undo info was discarded because it exceeded\
1855 This is normal if you executed a command that made a huge change
1856 to the buffer. In that case, to prevent similar problems in the
1857 future, set `undo-outer-limit' to a value that is large enough to
1858 cover the maximum size of normal changes you expect a single
1859 command to make, but not so large that it might exceed the
1860 maximum memory allotted to Emacs.
1862 If you did not execute any such command, the situation is
1863 probably due to a bug and you should report it.
1865 You can disable the popping up of this buffer by adding the entry
1866 \(undo discard-info) to the user option `warning-suppress-types',
1867 which is defined in the `warnings' library.\n")
1869 (setq buffer-undo-tree nil)))
1875 ;;; =====================================================================
1876 ;;; Visualizer-related functions
1878 (defun undo-tree-compute-widths (undo-tree)
1879 "Recursively compute widths for all UNDO-TREE's nodes."
1880 (let ((stack (list (undo-tree-root undo-tree)))
1883 ;; try to compute widths for node at top of stack
1884 (if (undo-tree-node-p
1885 (setq res (undo-tree-node-compute-widths (car stack))))
1886 ;; if computation fails, it returns a node whose widths still need
1887 ;; computing, which we push onto the stack
1889 ;; otherwise, store widths and remove it from stack
1890 (setf (undo-tree-node-lwidth (car stack)) (aref res 0)
1891 (undo-tree-node-cwidth (car stack)) (aref res 1)
1892 (undo-tree-node-rwidth (car stack)) (aref res 2))
1896 (defun undo-tree-node-compute-widths (node)
1897 ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
1898 ;; (in a vector) if successful. Otherwise, returns a node whose widths need
1899 ;; calculating before NODE's can be calculated.
1900 (let ((num-children (length (undo-tree-node-next node)))
1901 (lwidth 0) (cwidth 0) (rwidth 0)
1905 ;; leaf nodes have 0 width
1908 (undo-tree-node-lwidth node) 0
1909 (undo-tree-node-cwidth node) 1
1910 (undo-tree-node-rwidth node) 0))
1912 ;; odd number of children
1913 ((= (mod num-children 2) 1)
1914 (setq p (undo-tree-node-next node))
1915 ;; compute left-width
1916 (dotimes (i (/ num-children 2))
1917 (if (undo-tree-node-lwidth (car p))
1918 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1919 (undo-tree-node-cwidth (car p))
1920 (undo-tree-node-rwidth (car p))))
1921 ;; if child's widths haven't been computed, return that child
1922 (throw 'need-widths (car p)))
1924 (if (undo-tree-node-lwidth (car p))
1925 (incf lwidth (undo-tree-node-lwidth (car p)))
1926 (throw 'need-widths (car p)))
1927 ;; centre-width is inherited from middle child
1928 (setf cwidth (undo-tree-node-cwidth (car p)))
1929 ;; compute right-width
1930 (incf rwidth (undo-tree-node-rwidth (car p)))
1932 (dotimes (i (/ num-children 2))
1933 (if (undo-tree-node-lwidth (car p))
1934 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1935 (undo-tree-node-cwidth (car p))
1936 (undo-tree-node-rwidth (car p))))
1937 (throw 'need-widths (car p)))
1940 ;; even number of children
1942 (setq p (undo-tree-node-next node))
1943 ;; compute left-width
1944 (dotimes (i (/ num-children 2))
1945 (if (undo-tree-node-lwidth (car p))
1946 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1947 (undo-tree-node-cwidth (car p))
1948 (undo-tree-node-rwidth (car p))))
1949 (throw 'need-widths (car p)))
1951 ;; centre-width is 0 when number of children is even
1953 ;; compute right-width
1954 (dotimes (i (/ num-children 2))
1955 (if (undo-tree-node-lwidth (car p))
1956 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1957 (undo-tree-node-cwidth (car p))
1958 (undo-tree-node-rwidth (car p))))
1959 (throw 'need-widths (car p)))
1962 ;; return left-, centre- and right-widths
1963 (vector lwidth cwidth rwidth))))
1966 (defun undo-tree-clear-visualizer-data (undo-tree)
1967 ;; Clear visualizer data from UNDO-TREE.
1969 (lambda (node) (undo-tree-node-clear-visualizer-data node))
1975 ;;; =====================================================================
1976 ;;; Undo-in-region functions
1978 (defun undo-tree-pull-undo-in-region-branch (start end)
1979 ;; Pull out entries from undo changesets to create a new undo-in-region
1980 ;; branch, which undoes changeset entries lying between START and END first,
1981 ;; followed by remaining entries from the changesets, before rejoining the
1982 ;; existing undo tree history. Repeated calls will, if appropriate, extend
1983 ;; the current undo-in-region branch rather than creating a new one.
1985 ;; if we're just reverting the last redo-in-region, we don't need to
1986 ;; manipulate the undo tree at all
1987 (if (undo-tree-reverting-redo-in-region-p start end)
1988 t ; return t to indicate success
1990 ;; We build the `region-changeset' and `delta-list' lists forwards, using
1991 ;; pointers `r' and `d' to the penultimate element of the list. So that we
1992 ;; don't have to treat the first element differently, we prepend a dummy
1993 ;; leading nil to the lists, and have the pointers point to that
1995 ;; Note: using '(nil) instead of (list nil) in the `let*' results in
1996 ;; bizarre errors when the code is byte-compiled, where parts of the
1997 ;; lists appear to survive across different calls to this function.
1998 ;; An obscure byte-compiler bug, perhaps?
1999 (let* ((region-changeset (list nil))
2000 (r region-changeset)
2001 (delta-list (list nil))
2003 (node (undo-tree-current buffer-undo-tree))
2004 (repeated-undo-in-region
2005 (undo-tree-repeated-undo-in-region-p start end))
2006 undo-adjusted-markers ; `undo-elt-in-region' expects this
2007 fragment splice original-fragment original-splice original-current
2008 got-visible-elt undo-list elt)
2010 ;; --- initialisation ---
2012 ;; if this is a repeated undo in the same region, start pulling changes
2013 ;; from NODE at which undo-in-region branch iss attached, and detatch
2014 ;; the branch, using it as initial FRAGMENT of branch being constructed
2015 (repeated-undo-in-region
2016 (setq original-current node
2017 fragment (car (undo-tree-node-next node))
2019 ;; undo up to node at which undo-in-region branch is attached
2020 ;; (recognizable as first node with more than one branch)
2021 (let ((mark-active nil))
2022 (while (= (length (undo-tree-node-next node)) 1)
2025 node (undo-tree-current buffer-undo-tree))))
2026 (when (eq splice node) (setq splice nil))
2027 ;; detatch undo-in-region branch
2028 (setf (undo-tree-node-next node)
2029 (delq fragment (undo-tree-node-next node))
2030 (undo-tree-node-previous fragment) nil
2031 original-fragment fragment
2032 original-splice node))
2034 ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
2035 ;; nodes below the current one in the active branch
2036 ((undo-tree-node-next node)
2037 (setq fragment (undo-tree-make-node nil nil)
2039 (while (setq node (nth (undo-tree-node-branch node)
2040 (undo-tree-node-next node)))
2041 (push (undo-tree-make-node
2043 (undo-copy-list (undo-tree-node-undo node))
2044 (undo-copy-list (undo-tree-node-redo node)))
2045 (undo-tree-node-next splice))
2046 (setq splice (car (undo-tree-node-next splice))))
2047 (setq fragment (car (undo-tree-node-next fragment))
2049 node (undo-tree-current buffer-undo-tree))))
2052 ;; --- pull undo-in-region elements into branch ---
2053 ;; work backwards up tree, pulling out undo elements within region until
2054 ;; we've got one that undoes a visible change (insertion or deletion)
2056 (while (and (not got-visible-elt) node (undo-tree-node-undo node))
2057 ;; we cons a dummy nil element on the front of the changeset so that
2058 ;; we can conveniently remove the first (real) element from the
2059 ;; changeset if we need to; the leading nil is removed once we're
2060 ;; done with this changeset
2061 (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
2062 elt (cadr undo-list))
2065 (setq fragment (undo-tree-grow-backwards fragment undo-list))
2066 (unless splice (setq splice fragment)))
2067 (setq fragment (undo-tree-make-node nil undo-list))
2068 (setq splice fragment))
2072 ;; keep elements within region
2073 ((undo-elt-in-region elt start end)
2074 ;; set flag if kept element is visible (insertion or deletion)
2075 (when (and (consp elt)
2076 (or (stringp (car elt)) (integerp (car elt))))
2077 (setq got-visible-elt t))
2078 ;; adjust buffer positions in elements previously undone before
2079 ;; kept element, as kept element will now be undone first
2080 (undo-tree-adjust-elements-to-elt splice elt)
2081 ;; move kept element to undo-in-region changeset, adjusting its
2082 ;; buffer position as it will now be undone first
2083 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
2085 (setcdr undo-list (cddr undo-list)))
2087 ;; discard "was unmodified" elements
2088 ;; FIXME: deal properly with these
2089 ((and (consp elt) (eq (car elt) t))
2090 (setcdr undo-list (cddr undo-list)))
2092 ;; if element crosses region, we can't pull any more elements
2093 ((undo-elt-crosses-region elt start end)
2094 ;; if we've found a visible element, it must be earlier in
2095 ;; current node's changeset; stop pulling elements (null
2096 ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
2098 (setq undo-list nil)
2099 ;; if we haven't found a visible element yet, pulling
2100 ;; undo-in-region branch has failed
2101 (setq region-changeset nil)
2104 ;; if rejecting element, add its delta (if any) to the list
2106 (let ((delta (undo-delta elt)))
2107 (when (/= 0 (cdr delta))
2108 (setcdr d (list delta))
2110 (setq undo-list (cdr undo-list))))
2112 ;; process next element of current changeset
2113 (setq elt (cadr undo-list)))
2115 ;; if there are remaining elements in changeset, remove dummy nil
2117 (if (cadr (undo-tree-node-undo fragment))
2118 (pop (undo-tree-node-undo fragment))
2119 ;; otherwise, if we've kept all elements in changeset, discard
2121 (when (eq splice fragment) (setq splice nil))
2122 (setq fragment (car (undo-tree-node-next fragment))))
2123 ;; process changeset from next node up the tree
2124 (setq node (undo-tree-node-previous node))))
2126 ;; pop dummy nil from front of `region-changeset'
2127 (pop region-changeset)
2130 ;; --- integrate branch into tree ---
2131 ;; if no undo-in-region elements were found, restore undo tree
2132 (if (null region-changeset)
2133 (when original-current
2134 (push original-fragment (undo-tree-node-next original-splice))
2135 (setf (undo-tree-node-branch original-splice) 0
2136 (undo-tree-node-previous original-fragment) original-splice)
2137 (let ((mark-active nil))
2138 (while (not (eq (undo-tree-current buffer-undo-tree)
2140 (undo-tree-redo-1)))
2141 nil) ; return nil to indicate failure
2144 ;; need to undo up to node where new branch will be attached, to
2145 ;; ensure redo entries are populated, and then redo back to where we
2147 (let ((mark-active nil)
2148 (current (undo-tree-current buffer-undo-tree)))
2149 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2151 (while (not (eq (undo-tree-current buffer-undo-tree) current))
2152 (undo-tree-redo-1)))
2155 ;; if there's no remaining fragment, just create undo-in-region node
2156 ;; and attach it to parent of last node from which elements were
2159 (setq fragment (undo-tree-make-node node region-changeset))
2160 (push fragment (undo-tree-node-next node))
2161 (setf (undo-tree-node-branch node) 0)
2162 ;; set current node to undo-in-region node
2163 (setf (undo-tree-current buffer-undo-tree) fragment))
2165 ;; if no splice point has been set, add undo-in-region node to top of
2166 ;; fragment and attach it to parent of last node from which elements
2169 (setq fragment (undo-tree-grow-backwards fragment region-changeset))
2170 (push fragment (undo-tree-node-next node))
2171 (setf (undo-tree-node-branch node) 0
2172 (undo-tree-node-previous fragment) node)
2173 ;; set current node to undo-in-region node
2174 (setf (undo-tree-current buffer-undo-tree) fragment))
2176 ;; if fragment contains nodes, attach fragment to parent of last node
2177 ;; from which elements were pulled, and splice in undo-in-region node
2179 (setf (undo-tree-node-previous fragment) node)
2180 (push fragment (undo-tree-node-next node))
2181 (setf (undo-tree-node-branch node) 0)
2182 ;; if this is a repeated undo-in-region, then we've left the current
2183 ;; node at the original splice-point; we need to set the current
2184 ;; node to the equivalent node on the undo-in-region branch and redo
2185 ;; back to where we started
2186 (when repeated-undo-in-region
2187 (setf (undo-tree-current buffer-undo-tree)
2188 (undo-tree-node-previous original-fragment))
2189 (let ((mark-active nil))
2190 (while (not (eq (undo-tree-current buffer-undo-tree) splice))
2191 (undo-tree-redo-1 nil 'preserve-undo))))
2192 ;; splice new undo-in-region node into fragment
2193 (setq node (undo-tree-make-node nil region-changeset))
2194 (undo-tree-splice-node node splice)
2195 ;; set current node to undo-in-region node
2196 (setf (undo-tree-current buffer-undo-tree) node)))
2198 ;; update undo-tree size
2199 (setq node (undo-tree-node-previous fragment))
2201 (and (setq node (car (undo-tree-node-next node)))
2202 (not (eq node original-fragment))
2203 (incf (undo-tree-size buffer-undo-tree)
2204 (undo-list-byte-size (undo-tree-node-undo node)))
2205 (when (undo-tree-node-redo node)
2206 (incf (undo-tree-size buffer-undo-tree)
2207 (undo-list-byte-size (undo-tree-node-redo node))))
2209 t) ; indicate undo-in-region branch was successfully pulled
2214 (defun undo-tree-pull-redo-in-region-branch (start end)
2215 ;; Pull out entries from redo changesets to create a new redo-in-region
2216 ;; branch, which redoes changeset entries lying between START and END first,
2217 ;; followed by remaining entries from the changesets. Repeated calls will,
2218 ;; if appropriate, extend the current redo-in-region branch rather than
2219 ;; creating a new one.
2221 ;; if we're just reverting the last undo-in-region, we don't need to
2222 ;; manipulate the undo tree at all
2223 (if (undo-tree-reverting-undo-in-region-p start end)
2224 t ; return t to indicate success
2226 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2227 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2228 ;; don't have to treat the first element differently, we prepend a dummy
2229 ;; leading nil to the lists, and have the pointers point to that
2231 ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
2232 ;; errors when the code is byte-compiled, where parts of the lists
2233 ;; appear to survive across different calls to this function. An
2234 ;; obscure byte-compiler bug, perhaps?
2235 (let* ((region-changeset (list nil))
2236 (r region-changeset)
2237 (delta-list (list nil))
2239 (node (undo-tree-current buffer-undo-tree))
2240 (repeated-redo-in-region
2241 (undo-tree-repeated-redo-in-region-p start end))
2242 undo-adjusted-markers ; `undo-elt-in-region' expects this
2243 fragment splice got-visible-elt redo-list elt)
2245 ;; --- inisitalisation ---
2247 ;; if this is a repeated redo-in-region, detach fragment below current
2249 (repeated-redo-in-region
2250 (when (setq fragment (car (undo-tree-node-next node)))
2251 (setf (undo-tree-node-previous fragment) nil
2252 (undo-tree-node-next node)
2253 (delq fragment (undo-tree-node-next node)))))
2254 ;; if this is a new redo-in-region, initial fragment is a copy of all
2255 ;; nodes below the current one in the active branch
2256 ((undo-tree-node-next node)
2257 (setq fragment (undo-tree-make-node nil nil)
2259 (while (setq node (nth (undo-tree-node-branch node)
2260 (undo-tree-node-next node)))
2261 (push (undo-tree-make-node
2263 (undo-copy-list (undo-tree-node-redo node)))
2264 (undo-tree-node-next splice))
2265 (setq splice (car (undo-tree-node-next splice))))
2266 (setq fragment (car (undo-tree-node-next fragment)))))
2269 ;; --- pull redo-in-region elements into branch ---
2270 ;; work down fragment, pulling out redo elements within region until
2271 ;; we've got one that redoes a visible change (insertion or deletion)
2272 (setq node fragment)
2274 (while (and (not got-visible-elt) node (undo-tree-node-redo node))
2275 ;; we cons a dummy nil element on the front of the changeset so that
2276 ;; we can conveniently remove the first (real) element from the
2277 ;; changeset if we need to; the leading nil is removed once we're
2278 ;; done with this changeset
2279 (setq redo-list (push nil (undo-tree-node-redo node))
2280 elt (cadr redo-list))
2283 ;; keep elements within region
2284 ((undo-elt-in-region elt start end)
2285 ;; set flag if kept element is visible (insertion or deletion)
2286 (when (and (consp elt)
2287 (or (stringp (car elt)) (integerp (car elt))))
2288 (setq got-visible-elt t))
2289 ;; adjust buffer positions in elements previously redone before
2290 ;; kept element, as kept element will now be redone first
2291 (undo-tree-adjust-elements-to-elt fragment elt t)
2292 ;; move kept element to redo-in-region changeset, adjusting its
2293 ;; buffer position as it will now be redone first
2294 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
2296 (setcdr redo-list (cddr redo-list)))
2298 ;; discard "was unmodified" elements
2299 ;; FIXME: deal properly with these
2300 ((and (consp elt) (eq (car elt) t))
2301 (setcdr redo-list (cddr redo-list)))
2303 ;; if element crosses region, we can't pull any more elements
2304 ((undo-elt-crosses-region elt start end)
2305 ;; if we've found a visible element, it must be earlier in
2306 ;; current node's changeset; stop pulling elements (null
2307 ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
2309 (setq redo-list nil)
2310 ;; if we haven't found a visible element yet, pulling
2311 ;; redo-in-region branch has failed
2312 (setq region-changeset nil)
2315 ;; if rejecting element, add its delta (if any) to the list
2317 (let ((delta (undo-delta elt)))
2318 (when (/= 0 (cdr delta))
2319 (setcdr d (list delta))
2321 (setq redo-list (cdr redo-list))))
2323 ;; process next element of current changeset
2324 (setq elt (cadr redo-list)))
2326 ;; if there are remaining elements in changeset, remove dummy nil
2328 (if (cadr (undo-tree-node-redo node))
2329 (pop (undo-tree-node-undo node))
2330 ;; otherwise, if we've kept all elements in changeset, discard
2332 (if (eq fragment node)
2333 (setq fragment (car (undo-tree-node-next fragment)))
2334 (undo-tree-snip-node node)))
2335 ;; process changeset from next node in fragment
2336 (setq node (car (undo-tree-node-next node)))))
2338 ;; pop dummy nil from front of `region-changeset'
2339 (pop region-changeset)
2342 ;; --- integrate branch into tree ---
2343 (setq node (undo-tree-current buffer-undo-tree))
2344 ;; if no redo-in-region elements were found, restore undo tree
2345 (if (null (car region-changeset))
2346 (when (and repeated-redo-in-region fragment)
2347 (push fragment (undo-tree-node-next node))
2348 (setf (undo-tree-node-branch node) 0
2349 (undo-tree-node-previous fragment) node)
2350 nil) ; return nil to indicate failure
2352 ;; otherwise, add redo-in-region node to top of fragment, and attach
2353 ;; it below current node
2356 (undo-tree-grow-backwards fragment nil region-changeset)
2357 (undo-tree-make-node nil nil region-changeset)))
2358 (push fragment (undo-tree-node-next node))
2359 (setf (undo-tree-node-branch node) 0
2360 (undo-tree-node-previous fragment) node)
2361 ;; update undo-tree size
2362 (unless repeated-redo-in-region
2363 (setq node fragment)
2365 (and (setq node (car (undo-tree-node-next node)))
2366 (incf (undo-tree-size buffer-undo-tree)
2367 (undo-list-byte-size
2368 (undo-tree-node-redo node)))))))
2369 (incf (undo-tree-size buffer-undo-tree)
2370 (undo-list-byte-size (undo-tree-node-redo fragment)))
2371 t) ; indicate undo-in-region branch was successfully pulled
2376 (defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
2377 "Adjust buffer positions of undo elements, starting at NODE's
2378 and going up the tree (or down the active branch if BELOW is
2379 non-nil) and through the nodes' undo elements until we reach
2380 UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
2381 of either NODE itself or some node above it in the tree."
2382 (let ((delta (list (undo-delta undo-elt)))
2383 (undo-list (undo-tree-node-undo node)))
2384 ;; adjust elements until we reach UNDO-ELT
2385 (while (and (car undo-list)
2386 (not (eq (car undo-list) undo-elt)))
2388 (undo-tree-apply-deltas (car undo-list) delta -1))
2389 ;; move to next undo element in list, or to next node if we've run out
2391 (unless (car (setq undo-list (cdr undo-list)))
2393 (setq node (nth (undo-tree-node-branch node)
2394 (undo-tree-node-next node)))
2395 (setq node (undo-tree-node-previous node)))
2396 (setq undo-list (undo-tree-node-undo node))))))
2400 (defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
2401 ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
2402 ;; (only useful value for SGN is -1).
2403 (let (position offset)
2404 (dolist (delta deltas)
2405 (setq position (car delta)
2406 offset (* (cdr delta) (or sgn 1)))
2409 ((integerp undo-elt)
2410 (when (>= undo-elt position)
2411 (setq undo-elt (- undo-elt offset))))
2412 ;; nil (or any other atom)
2414 ;; (TEXT . POSITION)
2415 ((stringp (car undo-elt))
2416 (let ((text-pos (abs (cdr undo-elt)))
2417 (point-at-end (< (cdr undo-elt) 0)))
2418 (if (>= text-pos position)
2419 (setcdr undo-elt (* (if point-at-end -1 1)
2420 (- text-pos offset))))))
2422 ((integerp (car undo-elt))
2423 (when (>= (car undo-elt) position)
2424 (setcar undo-elt (- (car undo-elt) offset))
2425 (setcdr undo-elt (- (cdr undo-elt) offset))))
2426 ;; (nil PROPERTY VALUE BEG . END)
2427 ((null (car undo-elt))
2428 (let ((tail (nthcdr 3 undo-elt)))
2429 (when (>= (car tail) position)
2430 (setcar tail (- (car tail) offset))
2431 (setcdr tail (- (cdr tail) offset)))))
2437 (defun undo-tree-repeated-undo-in-region-p (start end)
2438 ;; Return non-nil if undo-in-region between START and END is a repeated
2440 (let ((node (undo-tree-current buffer-undo-tree)))
2442 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
2443 (eq (undo-tree-node-undo-beginning node) start)
2444 (eq (undo-tree-node-undo-end node) end))))
2447 (defun undo-tree-repeated-redo-in-region-p (start end)
2448 ;; Return non-nil if undo-in-region between START and END is a repeated
2450 (let ((node (undo-tree-current buffer-undo-tree)))
2451 (and (eq (undo-tree-node-redo-beginning node) start)
2452 (eq (undo-tree-node-redo-end node) end))))
2455 ;; Return non-nil if undo-in-region between START and END is simply
2456 ;; reverting the last redo-in-region
2457 (defalias 'undo-tree-reverting-undo-in-region-p
2458 'undo-tree-repeated-undo-in-region-p)
2461 ;; Return non-nil if redo-in-region between START and END is simply
2462 ;; reverting the last undo-in-region
2463 (defalias 'undo-tree-reverting-redo-in-region-p
2464 'undo-tree-repeated-redo-in-region-p)
2469 ;;; =====================================================================
2470 ;;; Undo-tree commands
2473 (define-minor-mode undo-tree-mode
2474 "Toggle undo-tree mode.
2475 With no argument, this command toggles the mode.
2476 A positive prefix argument turns the mode on.
2477 A negative prefix argument turns it off.
2479 Undo-tree-mode replaces Emacs' standard undo feature with a more
2480 powerful yet easier to use version, that treats the undo history
2481 as what it is: a tree.
2483 The following keys are available in `undo-tree-mode':
2487 Within the undo-tree visualizer, the following keys are available:
2489 \\{undo-tree-visualizer-map}"
2492 undo-tree-mode-lighter ; lighter
2493 undo-tree-map ; keymap
2495 ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
2496 ;; Emacs undo can work
2497 (if (not undo-tree-mode)
2498 (undo-list-rebuild-from-tree)
2499 (setq buffer-undo-tree nil)))
2502 (defun turn-on-undo-tree-mode (&optional print-message)
2503 "Enable `undo-tree-mode' in the current buffer, when appropriate.
2504 Some major modes implement their own undo system, which should
2505 not normally be overridden by `undo-tree-mode'. This command does
2506 not enable `undo-tree-mode' in such buffers. If you want to force
2507 `undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
2510 The heuristic used to detect major modes in which
2511 `undo-tree-mode' should not be used is to check whether either
2512 the `undo' command has been remapped, or the default undo
2513 keybindings (C-/ and C-_) have been overridden somewhere other
2514 than in the global map. In addition, `undo-tree-mode' will not be
2515 enabled if the buffer's `major-mode' appears in
2516 `undo-tree-incompatible-major-modes'."
2518 (if (or (key-binding [remap undo])
2519 (undo-tree-overridden-undo-bindings-p)
2520 (memq major-mode undo-tree-incompatible-major-modes))
2522 (message "Buffer does not support undo-tree-mode;\
2523 undo-tree-mode NOT enabled"))
2524 (undo-tree-mode 1)))
2527 (defun undo-tree-overridden-undo-bindings-p ()
2528 "Returns t if default undo bindings are overridden, nil otherwise.
2529 Checks if either of the default undo key bindings (\"C-/\" or
2530 \"C-_\") are overridden in the current buffer by any keymap other
2531 than the global one. (So global redefinitions of the default undo
2532 key bindings do not count.)"
2533 (let ((binding1 (lookup-key (current-global-map) [?\C-/]))
2534 (binding2 (lookup-key (current-global-map) [?\C-_])))
2535 (global-set-key [?\C-/] 'undo)
2536 (global-set-key [?\C-_] 'undo)
2538 (or (and (key-binding [?\C-/])
2539 (not (eq (key-binding [?\C-/]) 'undo)))
2540 (and (key-binding [?\C-_])
2541 (not (eq (key-binding [?\C-_]) 'undo))))
2542 (global-set-key [?\C-/] binding1)
2543 (global-set-key [?\C-_] binding2))))
2547 (define-globalized-minor-mode global-undo-tree-mode
2548 undo-tree-mode turn-on-undo-tree-mode)
2552 (defun undo-tree-undo (&optional arg)
2554 Repeat this command to undo more changes.
2555 A numeric ARG serves as a repeat count.
2557 In Transient Mark mode when the mark is active, only undo changes
2558 within the current region. Similarly, when not in Transient Mark
2559 mode, just \\[universal-argument] as an argument limits undo to
2560 changes within the current region."
2562 ;; throw error if undo is disabled in buffer
2563 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2564 (undo-tree-undo-1 arg)
2565 ;; inform user if at branch point
2566 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2569 (defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
2570 ;; Internal undo function. An active mark in `transient-mark-mode', or
2571 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
2572 ;; causes the existing redo record to be preserved, rather than replacing it
2573 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2574 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2575 ;; should *only* be used when temporarily visiting another undo state and
2576 ;; immediately returning to the original state afterwards. Otherwise, it
2577 ;; could cause history-discarding errors.)
2578 (let ((undo-in-progress t)
2579 (undo-in-region (and undo-tree-enable-undo-in-region
2580 (or (region-active-p)
2581 (and arg (not (numberp arg))))))
2583 ;; transfer entries accumulated in `buffer-undo-list' to
2584 ;; `buffer-undo-tree'
2585 (undo-list-transfer-to-tree)
2587 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2588 ;; check if at top of undo tree
2589 (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2590 (error "No further undo information"))
2592 ;; if region is active, or a non-numeric prefix argument was supplied,
2593 ;; try to pull out a new branch of changes affecting the region
2594 (when (and undo-in-region
2595 (not (undo-tree-pull-undo-in-region-branch
2596 (region-beginning) (region-end))))
2597 (error "No further undo information for region"))
2599 ;; remove any GC'd elements from node's undo list
2600 (setq current (undo-tree-current buffer-undo-tree))
2601 (decf (undo-tree-size buffer-undo-tree)
2602 (undo-list-byte-size (undo-tree-node-undo current)))
2603 (setf (undo-tree-node-undo current)
2604 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2605 (incf (undo-tree-size buffer-undo-tree)
2606 (undo-list-byte-size (undo-tree-node-undo current)))
2607 ;; undo one record from undo tree
2608 (when undo-in-region
2609 (setq pos (set-marker (make-marker) (point)))
2610 (set-marker-insertion-type pos t))
2611 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
2614 ;; if preserving old redo record, discard new redo entries that
2615 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2616 ;; elements from node's redo list
2619 (undo-list-pop-changeset)
2620 (decf (undo-tree-size buffer-undo-tree)
2621 (undo-list-byte-size (undo-tree-node-redo current)))
2622 (setf (undo-tree-node-redo current)
2623 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2624 (incf (undo-tree-size buffer-undo-tree)
2625 (undo-list-byte-size (undo-tree-node-redo current))))
2626 ;; otherwise, record redo entries that `primitive-undo' has added to
2627 ;; `buffer-undo-list' in current node's redo record, replacing
2628 ;; existing entry if one already exists
2629 (when (undo-tree-node-redo current)
2630 (decf (undo-tree-size buffer-undo-tree)
2631 (undo-list-byte-size (undo-tree-node-redo current))))
2632 (setf (undo-tree-node-redo current)
2633 (undo-list-pop-changeset 'discard-pos))
2634 (incf (undo-tree-size buffer-undo-tree)
2635 (undo-list-byte-size (undo-tree-node-redo current))))
2637 ;; rewind current node and update timestamp
2638 (setf (undo-tree-current buffer-undo-tree)
2639 (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
2640 (unless preserve-timestamps
2641 (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
2644 ;; if undoing-in-region, record current node, region and direction so we
2645 ;; can tell if undo-in-region is repeated, and re-activate mark if in
2646 ;; `transient-mark-mode'; if not, erase any leftover data
2647 (if (not undo-in-region)
2648 (undo-tree-node-clear-region-data current)
2650 ;; note: we deliberately want to store the region information in the
2651 ;; node *below* the now current one
2652 (setf (undo-tree-node-undo-beginning current) (region-beginning)
2653 (undo-tree-node-undo-end current) (region-end))
2654 (set-marker pos nil)))
2656 ;; undo deactivates mark unless undoing-in-region
2657 (setq deactivate-mark (not undo-in-region))))
2661 (defun undo-tree-redo (&optional arg)
2662 "Redo changes. A numeric ARG serves as a repeat count.
2664 In Transient Mark mode when the mark is active, only redo changes
2665 within the current region. Similarly, when not in Transient Mark
2666 mode, just \\[universal-argument] as an argument limits redo to
2667 changes within the current region."
2669 ;; throw error if undo is disabled in buffer
2670 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2671 (undo-tree-redo-1 arg)
2672 ;; inform user if at branch point
2673 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2676 (defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
2677 ;; Internal redo function. An active mark in `transient-mark-mode', or
2678 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
2679 ;; causes the existing redo record to be preserved, rather than replacing it
2680 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2681 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2682 ;; should *only* be used when temporarily visiting another undo state and
2683 ;; immediately returning to the original state afterwards. Otherwise, it
2684 ;; could cause history-discarding errors.)
2685 (let ((undo-in-progress t)
2686 (redo-in-region (and undo-tree-enable-undo-in-region
2687 (or (region-active-p)
2688 (and arg (not (numberp arg))))))
2690 ;; transfer entries accumulated in `buffer-undo-list' to
2691 ;; `buffer-undo-tree'
2692 (undo-list-transfer-to-tree)
2694 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2695 ;; check if at bottom of undo tree
2696 (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
2697 (error "No further redo information"))
2699 ;; if region is active, or a non-numeric prefix argument was supplied,
2700 ;; try to pull out a new branch of changes affecting the region
2701 (when (and redo-in-region
2702 (not (undo-tree-pull-redo-in-region-branch
2703 (region-beginning) (region-end))))
2704 (error "No further redo information for region"))
2706 ;; advance current node
2707 (setq current (undo-tree-current buffer-undo-tree)
2708 current (setf (undo-tree-current buffer-undo-tree)
2709 (nth (undo-tree-node-branch current)
2710 (undo-tree-node-next current))))
2711 ;; remove any GC'd elements from node's redo list
2712 (decf (undo-tree-size buffer-undo-tree)
2713 (undo-list-byte-size (undo-tree-node-redo current)))
2714 (setf (undo-tree-node-redo current)
2715 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2716 (incf (undo-tree-size buffer-undo-tree)
2717 (undo-list-byte-size (undo-tree-node-redo current)))
2718 ;; redo one record from undo tree
2719 (when redo-in-region
2720 (setq pos (set-marker (make-marker) (point)))
2721 (set-marker-insertion-type pos t))
2722 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
2725 ;; if preserving old undo record, discard new undo entries that
2726 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2727 ;; elements from node's redo list
2730 (undo-list-pop-changeset)
2731 (decf (undo-tree-size buffer-undo-tree)
2732 (undo-list-byte-size (undo-tree-node-undo current)))
2733 (setf (undo-tree-node-undo current)
2734 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2735 (incf (undo-tree-size buffer-undo-tree)
2736 (undo-list-byte-size (undo-tree-node-undo current))))
2737 ;; otherwise, record undo entries that `primitive-undo' has added to
2738 ;; `buffer-undo-list' in current node's undo record, replacing
2739 ;; existing entry if one already exists
2740 (when (undo-tree-node-undo current)
2741 (decf (undo-tree-size buffer-undo-tree)
2742 (undo-list-byte-size (undo-tree-node-undo current))))
2743 (setf (undo-tree-node-undo current)
2744 (undo-list-pop-changeset 'discard-pos))
2745 (incf (undo-tree-size buffer-undo-tree)
2746 (undo-list-byte-size (undo-tree-node-undo current))))
2749 (unless preserve-timestamps
2750 (setf (undo-tree-node-timestamp current) (current-time)))
2752 ;; if redoing-in-region, record current node, region and direction so we
2753 ;; can tell if redo-in-region is repeated, and re-activate mark if in
2754 ;; `transient-mark-mode'
2755 (if (not redo-in-region)
2756 (undo-tree-node-clear-region-data current)
2758 (setf (undo-tree-node-redo-beginning current) (region-beginning)
2759 (undo-tree-node-redo-end current) (region-end))
2760 (set-marker pos nil)))
2762 ;; redo deactivates the mark unless redoing-in-region
2763 (setq deactivate-mark (not redo-in-region))))
2767 (defun undo-tree-switch-branch (branch)
2768 "Switch to a different BRANCH of the undo tree.
2769 This will affect which branch to descend when *redoing* changes
2770 using `undo-tree-redo'."
2771 (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
2772 (and (not (eq buffer-undo-list t))
2773 (or (undo-list-transfer-to-tree) t)
2774 (let ((b (undo-tree-node-branch
2776 buffer-undo-tree))))
2778 ;; switch to other branch if only 2
2779 ((= (undo-tree-num-branches) 2) (- 1 b))
2780 ;; prompt if more than 2
2781 ((> (undo-tree-num-branches) 2)
2783 (format "Branch (0-%d, on %d): "
2784 (1- (undo-tree-num-branches)) b)))
2786 ;; throw error if undo is disabled in buffer
2787 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2788 ;; sanity check branch number
2789 (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point"))
2790 (when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
2791 (error "Invalid branch number"))
2792 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2793 (undo-list-transfer-to-tree)
2795 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
2797 (message "Switched to branch %d" branch))
2800 (defun undo-tree-set (node &optional preserve-timestamps)
2801 ;; Set buffer to state corresponding to NODE. Returns intersection point
2802 ;; between path back from current node and path back from selected NODE.
2803 ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
2804 ;; undo-tree nodes. (This should *only* be used when temporarily visiting
2805 ;; another undo state and immediately returning to the original state
2806 ;; afterwards. Otherwise, it could cause history-discarding errors.)
2807 (let ((path (make-hash-table :test 'eq))
2809 (puthash (undo-tree-root buffer-undo-tree) t path)
2810 ;; build list of nodes leading back from selected node to root, updating
2811 ;; branches as we go to point down to selected node
2814 (when (undo-tree-node-previous n)
2815 (setf (undo-tree-node-branch (undo-tree-node-previous n))
2817 n (undo-tree-node-next (undo-tree-node-previous n))))
2818 (setq n (undo-tree-node-previous n)))))
2819 ;; work backwards from current node until we intersect path back from
2821 (setq n (undo-tree-current buffer-undo-tree))
2822 (while (not (gethash n path))
2823 (setq n (undo-tree-node-previous n)))
2824 ;; ascend tree until intersection node
2825 (while (not (eq (undo-tree-current buffer-undo-tree) n))
2827 ;; descend tree until selected node
2828 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2830 n)) ; return intersection node
2834 (defun undo-tree-save-state-to-register (register)
2835 "Store current undo-tree state to REGISTER.
2836 The saved state can be restored using
2837 `undo-tree-restore-state-from-register'.
2838 Argument is a character, naming the register."
2839 (interactive "cUndo-tree state to register: ")
2840 ;; throw error if undo is disabled in buffer
2841 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2842 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2843 (undo-list-transfer-to-tree)
2844 ;; save current node to REGISTER
2846 register (registerv-make
2847 (undo-tree-make-register-data
2848 (current-buffer) (undo-tree-current buffer-undo-tree))
2849 :print-func 'undo-tree-register-data-print-func))
2850 ;; record REGISTER in current node, for visualizer
2851 (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
2856 (defun undo-tree-restore-state-from-register (register)
2857 "Restore undo-tree state from REGISTER.
2858 The state must be saved using `undo-tree-save-state-to-register'.
2859 Argument is a character, naming the register."
2860 (interactive "*cRestore undo-tree state from register: ")
2861 ;; throw error if undo is disabled in buffer, or if register doesn't contain
2862 ;; an undo-tree node
2863 (let ((data (registerv-data (get-register register))))
2865 ((eq buffer-undo-list t)
2866 (error "No undo information in this buffer"))
2867 ((not (undo-tree-register-data-p data))
2868 (error "Register doesn't contain undo-tree state"))
2869 ((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
2870 (error "Register contains undo-tree state for a different buffer")))
2871 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2872 (undo-list-transfer-to-tree)
2873 ;; restore buffer state corresponding to saved node
2874 (undo-tree-set (undo-tree-register-data-node data))))
2879 ;;; =====================================================================
2880 ;;; Persistent storage
2882 (defun undo-tree-make-history-save-file-name (file)
2883 "Create the undo history file name for FILE.
2884 Normally this is the file's name with `.' prepended and
2885 `~undo-tree~' appended.
2887 A match for FILE is sought in `undo-tree-history-directory-alist';
2888 see the documentation of that variable. If the directory for the
2889 backup doesn't exist, it is created."
2890 (let* ((backup-directory-alist undo-tree-history-directory-alist)
2891 (name (make-backup-file-name-1 file)))
2892 (concat (file-name-directory name) "." (file-name-nondirectory name)
2896 (defun undo-tree-save-history (&optional filename overwrite)
2897 "Store undo-tree history to file.
2899 If optional argument FILENAME is omitted, default save file is
2900 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
2901 Otherwise, prompt for one.
2903 If OVERWRITE is non-nil, any existing file will be overwritten
2904 without asking for confirmation."
2906 (undo-list-transfer-to-tree)
2907 (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
2909 (undo-tree-kill-visualizer)
2910 (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
2911 (let ((buff (current-buffer))
2916 (if buffer-file-name
2917 (undo-tree-make-history-save-file-name buffer-file-name)
2918 (expand-file-name (read-file-name "File to save in: ") nil))))
2919 (when (or (not (file-exists-p filename))
2921 (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
2924 ;; transform undo-tree into non-circular structure, and make
2926 (undo-tree-decircle buffer-undo-tree)
2927 (setq tree (copy-undo-tree buffer-undo-tree))
2928 ;; discard undo-tree object pool before saving
2929 (setf (undo-tree-object-pool tree) nil)
2930 ;; print undo-tree to file
2931 ;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
2932 ;; to allow `auto-compression-mode' to take effect, in
2933 ;; case user has overridden or advised the default
2934 ;; `undo-tree-make-history-save-file-name' to add a
2935 ;; compressed file extension.
2936 (with-auto-compression-mode
2938 (prin1 (sha1 buff) (current-buffer))
2939 (terpri (current-buffer))
2940 (let ((print-circle t)) (prin1 tree (current-buffer)))
2941 (write-region nil nil filename))))
2942 ;; restore circular undo-tree data structure
2943 (undo-tree-recircle buffer-undo-tree))
2948 (defun undo-tree-load-history (&optional filename noerror)
2949 "Load undo-tree history from file.
2951 If optional argument FILENAME is null, default load file is
2952 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
2953 Otherwise, prompt for one.
2955 If optional argument NOERROR is non-nil, return nil instead of
2956 signaling an error if file is not found."
2961 (if buffer-file-name
2962 (undo-tree-make-history-save-file-name buffer-file-name)
2963 (expand-file-name (read-file-name "File to load from: ") nil))))
2965 ;; attempt to read undo-tree from FILENAME
2967 (unless (file-exists-p filename)
2969 (throw 'load-error nil)
2970 (error "File \"%s\" does not exist; could not load undo-tree history"
2972 (let (buff tmp hash tree)
2973 (setq buff (current-buffer))
2974 (with-auto-compression-mode
2976 (insert-file-contents filename)
2977 (goto-char (point-min))
2979 (setq hash (read (current-buffer)))
2982 (funcall (if noerror 'message 'error)
2983 "Error reading undo-tree history from \"%s\"" filename)
2984 (throw 'load-error nil)))
2985 (unless (string= (sha1 buff) hash)
2987 (funcall (if noerror 'message 'error)
2988 "Buffer has been modified; could not load undo-tree history")
2989 (throw 'load-error nil))
2991 (setq tree (read (current-buffer)))
2994 (funcall (if noerror 'message 'error)
2995 "Error reading undo-tree history from \"%s\"" filename)
2996 (throw 'load-error nil)))
2998 ;; initialise empty undo-tree object pool
2999 (setf (undo-tree-object-pool tree)
3000 (make-hash-table :test 'eq :weakness 'value))
3001 ;; restore circular undo-tree data structure
3002 (undo-tree-recircle tree)
3003 (setq buffer-undo-tree tree))))
3007 ;; Versions of save/load functions for use in hooks
3008 (defun undo-tree-save-history-hook ()
3009 (when (and undo-tree-mode undo-tree-auto-save-history)
3010 (undo-tree-save-history nil t) nil))
3012 (defun undo-tree-load-history-hook ()
3013 (when (and undo-tree-mode undo-tree-auto-save-history)
3014 (undo-tree-load-history nil t)))
3019 ;;; =====================================================================
3020 ;;; Undo-tree visualizer
3022 (defun undo-tree-visualize ()
3023 "Visualize the current buffer's undo tree."
3026 ;; throw error if undo is disabled in buffer
3027 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
3028 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3029 (undo-list-transfer-to-tree)
3030 ;; add hook to kill visualizer buffer if original buffer is changed
3031 (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
3032 ;; prepare *undo-tree* buffer, then draw tree in it
3033 (let ((undo-tree buffer-undo-tree)
3034 (buff (current-buffer))
3035 (display-buffer-mark-dedicated 'soft))
3036 (switch-to-buffer-other-window
3037 (get-buffer-create undo-tree-visualizer-buffer-name))
3038 (setq undo-tree-visualizer-parent-buffer buff)
3039 (setq buffer-undo-tree undo-tree)
3040 (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
3041 (setq undo-tree-visualizer-spacing
3042 (undo-tree-visualizer-calculate-spacing))
3043 (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
3044 (undo-tree-visualizer-mode)
3045 (let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
3048 (defun undo-tree-kill-visualizer (&rest dummy)
3049 ;; Kill visualizer. Added to `before-change-functions' hook of original
3050 ;; buffer when visualizer is invoked.
3051 (unless undo-tree-inhibit-kill-visualizer
3053 (with-current-buffer undo-tree-visualizer-buffer-name
3054 (undo-tree-visualizer-quit)))))
3058 (defun undo-tree-draw-tree (undo-tree)
3059 ;; Draw UNDO-TREE in current buffer.
3061 (undo-tree-move-down 1) ; top margin
3062 (undo-tree-clear-visualizer-data undo-tree)
3063 (undo-tree-compute-widths undo-tree)
3064 (undo-tree-move-forward
3065 (max (/ (window-width) 2)
3066 (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree))
3067 ;; add space for left part of left-most time-stamp
3068 (if undo-tree-visualizer-timestamps
3069 (/ (- undo-tree-visualizer-spacing 4) 2)
3073 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3074 (stack (list (undo-tree-root undo-tree)))
3075 (n (undo-tree-root undo-tree)))
3076 ;; link root node to its representation in visualizer
3077 (unless (markerp (undo-tree-node-marker n))
3078 (setf (undo-tree-node-marker n) (make-marker))
3079 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3080 (move-marker (undo-tree-node-marker n) (point))
3081 ;; draw nodes from stack until stack is empty
3083 (setq n (pop stack))
3084 (goto-char (undo-tree-node-marker n))
3085 (setq n (undo-tree-draw-subtree n nil))
3086 (setq stack (append stack n))))
3087 ;; highlight active branch
3088 (goto-char (undo-tree-node-marker (undo-tree-root undo-tree)))
3089 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3090 (undo-tree-highlight-active-branch (undo-tree-root undo-tree)))
3091 ;; highlight current node
3092 (undo-tree-draw-node (undo-tree-current undo-tree) 'current))
3095 (defun undo-tree-highlight-active-branch (node)
3096 ;; Draw highlighted active branch below NODE in current buffer.
3097 (let ((stack (list node)))
3098 ;; link node to its representation in visualizer
3099 (unless (markerp (undo-tree-node-marker node))
3100 (setf (undo-tree-node-marker node) (make-marker))
3101 (set-marker-insertion-type (undo-tree-node-marker node) nil))
3102 (move-marker (undo-tree-node-marker node) (point))
3103 ;; draw active branch
3105 (setq node (pop stack))
3106 (goto-char (undo-tree-node-marker node))
3107 (setq node (undo-tree-draw-subtree node 'active))
3108 (setq stack (append stack node)))))
3111 (defun undo-tree-draw-node (node &optional current)
3112 ;; Draw symbol representing NODE in visualizer.
3113 (goto-char (undo-tree-node-marker node))
3114 (when undo-tree-visualizer-timestamps
3115 (backward-char (/ undo-tree-visualizer-spacing 2)))
3117 (let ((register (undo-tree-node-register node))
3119 (unless (and register
3120 (eq node (undo-tree-register-data-node
3121 (registerv-data (get-register register)))))
3122 (setq register nil))
3123 ;; represent node by differentl symbols, depending on whether it's the
3124 ;; current node or is saved in a register
3127 (undo-tree-visualizer-timestamps
3128 (undo-tree-timestamp-to-string
3129 (undo-tree-node-timestamp node)
3130 undo-tree-visualizer-relative-timestamps
3133 (register (char-to-string register))
3138 (let ((undo-tree-insert-face
3139 (cons 'undo-tree-visualizer-current-face
3140 (and (boundp 'undo-tree-insert-face)
3141 (or (and (consp undo-tree-insert-face)
3142 undo-tree-insert-face)
3143 (list undo-tree-insert-face))))))
3144 (undo-tree-insert node-string)))
3146 (let ((undo-tree-insert-face
3147 (cons 'undo-tree-visualizer-register-face
3148 (and (boundp 'undo-tree-insert-face)
3149 (or (and (consp undo-tree-insert-face)
3150 undo-tree-insert-face)
3151 (list undo-tree-insert-face))))))
3152 (undo-tree-insert node-string)))
3153 (t (undo-tree-insert node-string)))
3155 (backward-char (if undo-tree-visualizer-timestamps
3156 (1+ (/ undo-tree-visualizer-spacing 2))
3158 (move-marker (undo-tree-node-marker node) (point))
3159 (put-text-property (point) (1+ (point)) 'undo-tree-node node)))
3162 (defun undo-tree-draw-subtree (node &optional active-branch)
3163 ;; Draw subtree rooted at NODE. The subtree will start from point.
3164 ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE.
3165 ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes.
3166 (let ((num-children (length (undo-tree-node-next node)))
3167 node-list pos trunk-pos n)
3169 (undo-tree-draw-node node)
3172 ;; if we're at a leaf node, we're done
3173 ((= num-children 0))
3175 ;; if node has only one child, draw it (not strictly necessary to deal
3176 ;; with this case separately, but as it's by far the most common case
3177 ;; this makes the code clearer and more efficient)
3179 (undo-tree-move-down 1)
3180 (undo-tree-insert ?|)
3182 (undo-tree-move-down 1)
3183 (undo-tree-insert ?|)
3185 (undo-tree-move-down 1)
3186 (setq n (car (undo-tree-node-next node)))
3187 ;; link next node to its representation in visualizer
3188 (unless (markerp (undo-tree-node-marker n))
3189 (setf (undo-tree-node-marker n) (make-marker))
3190 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3191 (move-marker (undo-tree-node-marker n) (point))
3192 ;; add next node to list of nodes to draw next
3195 ;; if node had multiple children, draw branches
3197 (undo-tree-move-down 1)
3198 (undo-tree-insert ?|)
3200 (setq trunk-pos (point))
3203 (- (undo-tree-node-char-lwidth node)
3204 (undo-tree-node-char-lwidth
3205 (car (undo-tree-node-next node)))))
3207 (setq n (cons nil (undo-tree-node-next node)))
3208 (dotimes (i (/ num-children 2))
3210 (when (or (null active-branch)
3212 (nth (undo-tree-node-branch node)
3213 (undo-tree-node-next node))))
3214 (undo-tree-move-forward 2)
3215 (undo-tree-insert ?_ (- trunk-pos pos 2))
3217 (undo-tree-move-forward 1)
3218 (undo-tree-move-down 1)
3219 (undo-tree-insert ?/)
3221 (undo-tree-move-down 1)
3222 ;; link node to its representation in visualizer
3223 (unless (markerp (undo-tree-node-marker (car n)))
3224 (setf (undo-tree-node-marker (car n)) (make-marker))
3225 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3226 (move-marker (undo-tree-node-marker (car n)) (point))
3227 ;; add node to list of nodes to draw next
3228 (push (car n) node-list))
3230 (undo-tree-move-forward
3231 (+ (undo-tree-node-char-rwidth (car n))
3232 (undo-tree-node-char-lwidth (cadr n))
3233 undo-tree-visualizer-spacing 1))
3235 ;; middle subtree (only when number of children is odd)
3236 (when (= (mod num-children 2) 1)
3238 (when (or (null active-branch)
3240 (nth (undo-tree-node-branch node)
3241 (undo-tree-node-next node))))
3242 (undo-tree-move-down 1)
3243 (undo-tree-insert ?|)
3245 (undo-tree-move-down 1)
3246 ;; link node to its representation in visualizer
3247 (unless (markerp (undo-tree-node-marker (car n)))
3248 (setf (undo-tree-node-marker (car n)) (make-marker))
3249 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3250 (move-marker (undo-tree-node-marker (car n)) (point))
3251 ;; add node to list of nodes to draw next
3252 (push (car n) node-list))
3254 (undo-tree-move-forward
3255 (+ (undo-tree-node-char-rwidth (car n))
3256 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3257 undo-tree-visualizer-spacing 1))
3261 (dotimes (i (/ num-children 2))
3263 (when (or (null active-branch)
3265 (nth (undo-tree-node-branch node)
3266 (undo-tree-node-next node))))
3267 (goto-char trunk-pos)
3268 (undo-tree-insert ?_ (- pos trunk-pos 1))
3271 (undo-tree-move-down 1)
3272 (undo-tree-insert ?\\)
3273 (undo-tree-move-down 1)
3274 ;; link node to its representation in visualizer
3275 (unless (markerp (undo-tree-node-marker (car n)))
3276 (setf (undo-tree-node-marker (car n)) (make-marker))
3277 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3278 (move-marker (undo-tree-node-marker (car n)) (point))
3279 ;; add node to list of nodes to draw next
3280 (push (car n) node-list))
3283 (undo-tree-move-forward
3284 (+ (undo-tree-node-char-rwidth (car n))
3285 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3286 undo-tree-visualizer-spacing 1))
3287 (setq pos (point))))
3289 ;; return list of nodes to draw next
3290 (nreverse node-list)))
3294 (defun undo-tree-node-char-lwidth (node)
3295 ;; Return left-width of NODE measured in characters.
3296 (if (= (length (undo-tree-node-next node)) 0) 0
3297 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
3298 (if (= (undo-tree-node-cwidth node) 0)
3299 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3302 (defun undo-tree-node-char-rwidth (node)
3303 ;; Return right-width of NODE measured in characters.
3304 (if (= (length (undo-tree-node-next node)) 0) 0
3305 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
3306 (if (= (undo-tree-node-cwidth node) 0)
3307 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3310 (defun undo-tree-insert (str &optional arg)
3311 ;; Insert character or string STR ARG times, overwriting, and using
3312 ;; `undo-tree-insert-face'.
3313 (unless arg (setq arg 1))
3314 (when (characterp str)
3315 (setq str (make-string arg str))
3317 (dotimes (i arg) (insert str))
3318 (setq arg (* arg (length str)))
3319 (undo-tree-move-forward arg)
3320 ;; make sure mark isn't active, otherwise `backward-delete-char' might
3321 ;; delete region instead of single char if transient-mark-mode is enabled
3322 (setq mark-active nil)
3323 (backward-delete-char arg)
3324 (when (boundp 'undo-tree-insert-face)
3325 (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
3328 (defun undo-tree-move-down (&optional arg)
3329 ;; Move down, extending buffer if necessary.
3330 (let ((row (line-number-at-pos))
3331 (col (current-column))
3333 (unless arg (setq arg 1))
3335 (setq line (line-number-at-pos))
3336 ;; if buffer doesn't have enough lines, add some
3337 (when (/= line (+ row arg))
3338 (insert (make-string (- arg (- line row)) ?\n)))
3339 (undo-tree-move-forward col)))
3342 (defun undo-tree-move-forward (&optional arg)
3343 ;; Move forward, extending buffer if necessary.
3344 (unless arg (setq arg 1))
3345 (let ((n (- (line-end-position) (point))))
3349 (insert (make-string (- arg n) ? )))))
3352 (defun undo-tree-timestamp-to-string
3353 (timestamp &optional relative current register)
3354 ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
3355 ;; if it's the CURRENT node and/or has an associated REGISTER.
3358 (let ((time (floor (float-time
3359 (subtract-time (current-time) timestamp))))
3363 (if (> (setq n (/ time 315360000)) 0)
3364 (if (> n 999) "-ages" (format "-%dy" n))
3365 (setq time (% time 315360000))
3367 (if (> (setq n (/ time 86400)) 0)
3369 (setq time (% time 86400))
3371 (if (> (setq n (/ time 3600)) 0)
3373 (setq time (% time 3600))
3375 (if (> (setq n (/ time 60)) 0)
3378 (format "-%ds" (% time 60)))))))
3380 (if current "*" " ")
3382 (if register (concat "[" (char-to-string register) "]")
3384 (setq n (length time))
3386 (concat (make-string (- 9 n) ? ) time)
3389 (concat (if current "*" " ")
3390 (format-time-string "%H:%M:%S" timestamp)
3392 (concat "[" (char-to-string register) "]")
3398 ;;; =====================================================================
3399 ;;; Visualizer mode commands
3401 (defun undo-tree-visualizer-mode ()
3402 "Major mode used in undo-tree visualizer.
3404 The undo-tree visualizer can only be invoked from a buffer in
3405 which `undo-tree-mode' is enabled. The visualizer displays the
3406 undo history tree graphically, and allows you to browse around
3407 the undo history, undoing or redoing the corresponding changes in
3410 Within the undo-tree visualizer, the following keys are available:
3412 \\{undo-tree-visualizer-map}"
3414 (setq major-mode 'undo-tree-visualizer-mode)
3415 (setq mode-name "undo-tree-visualizer-mode")
3416 (use-local-map undo-tree-visualizer-map)
3417 (setq truncate-lines t)
3418 (setq cursor-type nil)
3419 (setq buffer-read-only t)
3420 (setq undo-tree-visualizer-selected-node nil)
3421 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
3425 (defun undo-tree-visualize-undo (&optional arg)
3426 "Undo changes. A numeric ARG serves as a repeat count."
3428 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3429 (inhibit-read-only t))
3430 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3431 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3434 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo arg))
3435 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3436 (let ((inhibit-read-only t))
3437 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3438 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3441 (defun undo-tree-visualize-redo (&optional arg)
3442 "Redo changes. A numeric ARG serves as a repeat count."
3444 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3445 (inhibit-read-only t))
3446 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3447 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3450 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo arg))
3451 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3452 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3453 (let ((inhibit-read-only t))
3454 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3455 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3458 (defun undo-tree-visualize-switch-branch-right (arg)
3459 "Switch to next branch of the undo tree.
3460 This will affect which branch to descend when *redoing* changes
3461 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3463 ;; un-highlight old active branch below current node
3464 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3465 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3466 (inhibit-read-only t))
3467 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3469 (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
3470 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
3472 ((>= (+ branch arg) (undo-tree-num-branches))
3473 (1- (undo-tree-num-branches)))
3474 ((<= (+ branch arg) 0) 0)
3475 (t (+ branch arg))))
3476 (let ((inhibit-read-only t))
3477 ;; highlight new active branch below current node
3478 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3479 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3480 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3481 ;; re-highlight current node
3482 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
3485 (defun undo-tree-visualize-switch-branch-left (arg)
3486 "Switch to previous branch of the undo tree.
3487 This will affect which branch to descend when *redoing* changes
3488 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3490 (undo-tree-visualize-switch-branch-right (- arg)))
3493 (defun undo-tree-visualizer-quit ()
3494 "Quit the undo-tree visualizer."
3496 (undo-tree-clear-visualizer-data buffer-undo-tree)
3497 ;; remove kill visualizer hook from parent buffer
3499 (with-current-buffer undo-tree-visualizer-parent-buffer
3500 (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
3501 ;; kill diff buffer, if any
3502 (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
3503 (let ((parent undo-tree-visualizer-parent-buffer)
3505 ;; kill visualizer buffer
3507 ;; switch back to parent buffer
3509 (if (setq window (get-buffer-window parent))
3510 (select-window window)
3511 (switch-to-buffer parent))))))
3514 (defun undo-tree-visualizer-abort ()
3515 "Quit the undo-tree visualizer and return buffer to original state."
3517 (let ((node undo-tree-visualizer-initial-node))
3518 (undo-tree-visualizer-quit)
3519 (undo-tree-set node)))
3522 (defun undo-tree-visualizer-set (&optional pos)
3523 "Set buffer to state corresponding to undo tree node
3524 at POS, or point if POS is nil."
3526 (unless pos (setq pos (point)))
3527 (let ((node (get-text-property pos 'undo-tree-node)))
3529 ;; set parent buffer to state corresponding to node at POS
3530 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3531 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
3532 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3533 ;; re-draw undo tree
3534 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
3535 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3538 (defun undo-tree-visualizer-mouse-set (pos)
3539 "Set buffer to state corresponding to undo tree node
3540 at mouse event POS."
3542 (undo-tree-visualizer-set (event-start (nth 1 pos))))
3545 (defun undo-tree-visualizer-toggle-timestamps ()
3546 "Toggle display of time-stamps."
3548 (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
3549 (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
3551 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
3554 (defun undo-tree-visualizer-scroll-left (&optional arg)
3556 (scroll-right (or arg 1) t))
3559 (defun undo-tree-visualizer-scroll-right (&optional arg)
3561 (scroll-left (or arg 1) t))
3566 ;;; =====================================================================
3567 ;;; Visualizer selection mode
3569 (defun undo-tree-visualizer-selection-mode ()
3570 "Major mode used to select nodes in undo-tree visualizer."
3572 (setq major-mode 'undo-tree-visualizer-selection-mode)
3573 (setq mode-name "undo-tree-visualizer-selection-mode")
3574 (use-local-map undo-tree-visualizer-selection-map)
3575 (setq cursor-type 'box)
3576 (setq undo-tree-visualizer-selected-node
3577 (undo-tree-current buffer-undo-tree))
3578 ;; erase diff (if any), as initially selected node is identical to current
3579 (when undo-tree-visualizer-diff
3580 (let ((buff (get-buffer undo-tree-diff-buffer-name))
3581 (inhibit-read-only t))
3582 (when buff (with-current-buffer buff (erase-buffer))))))
3585 (defun undo-tree-visualizer-select-previous (&optional arg)
3586 "Move to previous node."
3588 (let ((node undo-tree-visualizer-selected-node))
3591 (unless (undo-tree-node-previous node) (throw 'top t))
3592 (setq node (undo-tree-node-previous node))))
3593 (goto-char (undo-tree-node-marker node))
3594 (when (and undo-tree-visualizer-diff
3595 (not (eq node undo-tree-visualizer-selected-node)))
3596 (undo-tree-visualizer-update-diff node))
3597 (setq undo-tree-visualizer-selected-node node)))
3600 (defun undo-tree-visualizer-select-next (&optional arg)
3601 "Move to next node."
3603 (let ((node undo-tree-visualizer-selected-node))
3606 (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
3609 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
3610 (goto-char (undo-tree-node-marker node))
3611 (when (and undo-tree-visualizer-diff
3612 (not (eq node undo-tree-visualizer-selected-node)))
3613 (undo-tree-visualizer-update-diff node))
3614 (setq undo-tree-visualizer-selected-node node)))
3617 (defun undo-tree-visualizer-select-right (&optional arg)
3618 "Move right to a sibling node."
3620 (let ((node undo-tree-visualizer-selected-node)
3622 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3623 (setq end (line-end-position))
3626 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3628 (setq node (get-text-property (point) 'undo-tree-node))
3629 (when (= (point) end) (throw 'end t)))))
3630 (goto-char (undo-tree-node-marker
3631 (or node undo-tree-visualizer-selected-node)))
3632 (when (and undo-tree-visualizer-diff node
3633 (not (eq node undo-tree-visualizer-selected-node)))
3634 (undo-tree-visualizer-update-diff node))
3635 (setq undo-tree-visualizer-selected-node node)))
3638 (defun undo-tree-visualizer-select-left (&optional arg)
3639 "Move left to a sibling node."
3641 (let ((node (get-text-property (point) 'undo-tree-node))
3643 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3644 (setq beg (line-beginning-position))
3647 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3649 (setq node (get-text-property (point) 'undo-tree-node))
3650 (when (= (point) beg) (throw 'beg t)))))
3651 (goto-char (undo-tree-node-marker
3652 (or node undo-tree-visualizer-selected-node)))
3653 (when (and undo-tree-visualizer-diff node
3654 (not (eq node undo-tree-visualizer-selected-node)))
3655 (undo-tree-visualizer-update-diff node))
3656 (setq undo-tree-visualizer-selected-node node)))
3660 ;;; =====================================================================
3661 ;;; Visualizer diff display
3663 (defun undo-tree-visualizer-toggle-diff ()
3664 "Toggle diff display in undo-tree visualizer."
3666 (if undo-tree-visualizer-diff
3667 (undo-tree-visualizer-hide-diff)
3668 (undo-tree-visualizer-show-diff)))
3671 (defun undo-tree-visualizer-selection-toggle-diff ()
3672 "Toggle diff display in undo-tree visualizer selection mode."
3674 (if undo-tree-visualizer-diff
3675 (undo-tree-visualizer-hide-diff)
3676 (let ((node (get-text-property (point) 'undo-tree-node)))
3677 (when node (undo-tree-visualizer-show-diff node)))))
3680 (defun undo-tree-visualizer-show-diff (&optional node)
3681 ;; show visualizer diff display
3682 (setq undo-tree-visualizer-diff t)
3683 (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
3684 (undo-tree-diff node)))
3685 (display-buffer-mark-dedicated 'soft)
3687 (setq win (split-window))
3688 (set-window-buffer win buff)
3689 (shrink-window-if-larger-than-buffer win)))
3692 (defun undo-tree-visualizer-hide-diff ()
3693 ;; hide visualizer diff display
3694 (setq undo-tree-visualizer-diff nil)
3695 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3696 (when win (with-selected-window win (kill-buffer-and-window)))))
3699 (defun undo-tree-diff (&optional node)
3700 ;; Create diff between current state and NODE (or previous state, if NODE is
3701 ;; null). Returns buffer containing diff.
3704 (let ((undo-tree-inhibit-kill-visualizer t)
3705 (current (undo-tree-current buffer-undo-tree)))
3706 (undo-tree-set (or node (undo-tree-node-previous current) current)
3707 'preserve-timestamps)
3708 (setq tmpfile (diff-file-local-copy (current-buffer)))
3709 (undo-tree-set current 'preserve-timestamps))
3710 (setq buff (diff-no-select
3711 (current-buffer) tmpfile nil 'noasync
3712 (get-buffer-create undo-tree-diff-buffer-name)))
3713 ;; delete process messages and useless headers from diff buffer
3714 (with-current-buffer buff
3715 (goto-char (point-min))
3716 (delete-region (point) (1+ (line-end-position 3)))
3717 (goto-char (point-max))
3719 (delete-region (point) (point-max))
3720 (setq cursor-type nil)
3721 (setq buffer-read-only t))
3725 (defun undo-tree-visualizer-update-diff (&optional node)
3726 ;; update visualizer diff display to show diff between current state and
3727 ;; NODE (or previous state, if NODE is null)
3728 (with-current-buffer undo-tree-visualizer-parent-buffer
3729 (undo-tree-diff node))
3730 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3733 (shrink-window-if-larger-than-buffer win))))
3737 (provide 'undo-tree)
3739 ;;; undo-tree.el ends here