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 ;; `undo-list-transfer-to-tree' should never be called when undo is disabled
1617 ;; (i.e. `buffer-undo-tree' is t)
1618 (assert (not (eq buffer-undo-tree t)))
1620 ;; if `buffer-undo-tree' is empty, create initial undo-tree
1621 (when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
1622 ;; make sure there's a canary at end of `buffer-undo-list'
1623 (when (null buffer-undo-list)
1624 (setq buffer-undo-list '(nil undo-tree-canary)))
1626 (unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1627 (eq (car buffer-undo-list) 'undo-tree-canary))
1628 ;; create new node from first changeset in `buffer-undo-list', save old
1629 ;; `buffer-undo-tree' current node, and make new node the current node
1630 (let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
1631 (splice (undo-tree-current buffer-undo-tree))
1632 (size (undo-list-byte-size (undo-tree-node-undo node))))
1633 (setf (undo-tree-current buffer-undo-tree) node)
1634 ;; grow tree fragment backwards using `buffer-undo-list' changesets
1635 (while (and buffer-undo-list
1636 (not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
1638 (undo-tree-grow-backwards node (undo-list-pop-changeset)))
1639 (incf size (undo-list-byte-size (undo-tree-node-undo node))))
1640 ;; if no undo history has been discarded from `buffer-undo-list' since
1641 ;; last transfer, splice new tree fragment onto end of old
1642 ;; `buffer-undo-tree' current node
1643 (if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
1644 (eq (car buffer-undo-list) 'undo-tree-canary))
1646 (setf (undo-tree-node-previous node) splice)
1647 (push node (undo-tree-node-next splice))
1648 (setf (undo-tree-node-branch splice) 0)
1649 (incf (undo-tree-size buffer-undo-tree) size))
1650 ;; if undo history has been discarded, replace entire
1651 ;; `buffer-undo-tree' with new tree fragment
1652 (setq node (undo-tree-grow-backwards node nil))
1653 (setf (undo-tree-root buffer-undo-tree) node)
1654 (setq buffer-undo-list '(nil undo-tree-canary))
1655 (setf (undo-tree-size buffer-undo-tree) size)
1656 (setq buffer-undo-list '(nil undo-tree-canary))))
1657 ;; discard undo history if necessary
1658 (undo-tree-discard-history)))
1661 (defun undo-list-byte-size (undo-list)
1662 ;; Return size (in bytes) of UNDO-LIST
1663 (let ((size 0) (p undo-list))
1665 (incf size 8) ; cons cells use up 8 bytes
1666 (when (and (consp (car p)) (stringp (caar p)))
1667 (incf size (string-bytes (caar p))))
1673 (defun undo-list-rebuild-from-tree ()
1674 "Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
1675 (unless (eq buffer-undo-list t)
1676 (undo-list-transfer-to-tree)
1677 (setq buffer-undo-list nil)
1678 (when buffer-undo-tree
1679 (let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
1680 (push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
1682 (time-less-p (undo-tree-node-timestamp a)
1683 (undo-tree-node-timestamp b))))
1685 ;; Traverse tree in depth-and-oldest-first order, but add undo records
1686 ;; on the way down, and redo records on the way up.
1687 (while (or (car stack)
1688 (not (eq (car (nth 1 stack))
1689 (undo-tree-current buffer-undo-tree))))
1692 (setq buffer-undo-list
1693 (append (undo-tree-node-undo (caar stack))
1696 (push (sort (mapcar 'identity
1697 (undo-tree-node-next (caar stack)))
1699 (time-less-p (undo-tree-node-timestamp a)
1700 (undo-tree-node-timestamp b))))
1703 (setq buffer-undo-list
1704 (append (undo-tree-node-redo (caar stack))
1707 (pop (car stack))))))))
1712 ;;; =====================================================================
1713 ;;; History discarding functions
1715 (defun undo-tree-oldest-leaf (node)
1716 ;; Return oldest leaf node below NODE.
1717 (while (undo-tree-node-next node)
1719 (car (sort (mapcar 'identity (undo-tree-node-next node))
1721 (time-less-p (undo-tree-node-timestamp a)
1722 (undo-tree-node-timestamp b)))))))
1726 (defun undo-tree-discard-node (node)
1727 ;; Discard NODE from `buffer-undo-tree', and return next in line for
1730 ;; don't discard current node
1731 (unless (eq node (undo-tree-current buffer-undo-tree))
1733 ;; discarding root node...
1734 (if (eq node (undo-tree-root buffer-undo-tree))
1736 ;; should always discard branches before root
1737 ((> (length (undo-tree-node-next node)) 1)
1738 (error "Trying to discard undo-tree root which still\
1739 has multiple branches"))
1740 ;; don't discard root if current node is only child
1741 ((eq (car (undo-tree-node-next node))
1742 (undo-tree-current buffer-undo-tree))
1746 ;; clear any register referring to root
1747 (let ((r (undo-tree-node-register node)))
1748 (when (and r (eq (get-register r) node))
1749 (set-register r nil)))
1750 ;; make child of root into new root
1751 (setq node (setf (undo-tree-root buffer-undo-tree)
1752 (car (undo-tree-node-next node))))
1753 ;; update undo-tree size
1754 (decf (undo-tree-size buffer-undo-tree)
1755 (+ (undo-list-byte-size (undo-tree-node-undo node))
1756 (undo-list-byte-size (undo-tree-node-redo node))))
1757 ;; discard new root's undo data and PREVIOUS link
1758 (setf (undo-tree-node-undo node) nil
1759 (undo-tree-node-redo node) nil
1760 (undo-tree-node-previous node) nil)
1761 ;; if new root has branches, or new root is current node, next node
1762 ;; to discard is oldest leaf, otherwise it's new root
1763 (if (or (> (length (undo-tree-node-next node)) 1)
1764 (eq (car (undo-tree-node-next node))
1765 (undo-tree-current buffer-undo-tree)))
1766 (undo-tree-oldest-leaf node)
1769 ;; discarding leaf node...
1770 (let* ((parent (undo-tree-node-previous node))
1771 (current (nth (undo-tree-node-branch parent)
1772 (undo-tree-node-next parent))))
1773 ;; clear any register referring to the discarded node
1774 (let ((r (undo-tree-node-register node)))
1775 (when (and r (eq (get-register r) node))
1776 (set-register r nil)))
1777 ;; update undo-tree size
1778 (decf (undo-tree-size buffer-undo-tree)
1779 (+ (undo-list-byte-size (undo-tree-node-undo node))
1780 (undo-list-byte-size (undo-tree-node-redo node))))
1781 (setf (undo-tree-node-next parent)
1782 (delq node (undo-tree-node-next parent))
1783 (undo-tree-node-branch parent)
1784 (undo-tree-position current (undo-tree-node-next parent)))
1785 ;; if parent has branches, or parent is current node, next node to
1786 ;; discard is oldest leaf, otherwise it's parent
1787 (if (or (eq parent (undo-tree-current buffer-undo-tree))
1788 (and (undo-tree-node-next parent)
1789 (or (not (eq parent (undo-tree-root buffer-undo-tree)))
1790 (> (length (undo-tree-node-next parent)) 1))))
1791 (undo-tree-oldest-leaf parent)
1796 (defun undo-tree-discard-history ()
1797 "Discard undo history until we're within memory usage limits
1798 set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
1800 (when (> (undo-tree-size buffer-undo-tree) undo-limit)
1801 ;; if there are no branches off root, first node to discard is root;
1802 ;; otherwise it's leaf node at botom of oldest branch
1803 (let ((node (if (> (length (undo-tree-node-next
1804 (undo-tree-root buffer-undo-tree))) 1)
1805 (undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
1806 (undo-tree-root buffer-undo-tree))))
1808 ;; discard nodes until memory use is within `undo-strong-limit'
1810 (> (undo-tree-size buffer-undo-tree) undo-strong-limit))
1811 (setq node (undo-tree-discard-node node)))
1813 ;; discard nodes until next node to discard would bring memory use
1814 ;; within `undo-limit'
1816 ;; check first if last discard has brought us within
1817 ;; `undo-limit', in case we can avoid more expensive
1818 ;; `undo-strong-limit' calculation
1819 ;; Note: this assumes undo-strong-limit > undo-limit;
1820 ;; if not, effectively undo-strong-limit = undo-limit
1821 (> (undo-tree-size buffer-undo-tree) undo-limit)
1822 (> (- (undo-tree-size buffer-undo-tree)
1823 ;; if next node to discard is root, the memory we
1824 ;; free-up comes from discarding changesets from its
1826 (if (eq node (undo-tree-root buffer-undo-tree))
1827 (+ (undo-list-byte-size
1828 (undo-tree-node-undo
1829 (car (undo-tree-node-next node))))
1830 (undo-list-byte-size
1831 (undo-tree-node-redo
1832 (car (undo-tree-node-next node)))))
1833 ;; ...otherwise, it comes from discarding changesets
1834 ;; from along with the node itself
1835 (+ (undo-list-byte-size (undo-tree-node-undo node))
1836 (undo-list-byte-size (undo-tree-node-redo node)))
1839 (setq node (undo-tree-discard-node node)))
1841 ;; if we're still over the `undo-outer-limit', discard entire history
1842 (when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
1843 ;; query first if `undo-ask-before-discard' is set
1844 (if undo-ask-before-discard
1847 "Buffer `%s' undo info is %d bytes long; discard it? "
1848 (buffer-name) (undo-tree-size buffer-undo-tree)))
1849 (setq buffer-undo-tree nil))
1850 ;; otherwise, discard and display warning
1852 '(undo discard-info)
1854 (format "Buffer `%s' undo info was %d bytes long.\n"
1855 (buffer-name) (undo-tree-size buffer-undo-tree))
1856 "The undo info was discarded because it exceeded\
1859 This is normal if you executed a command that made a huge change
1860 to the buffer. In that case, to prevent similar problems in the
1861 future, set `undo-outer-limit' to a value that is large enough to
1862 cover the maximum size of normal changes you expect a single
1863 command to make, but not so large that it might exceed the
1864 maximum memory allotted to Emacs.
1866 If you did not execute any such command, the situation is
1867 probably due to a bug and you should report it.
1869 You can disable the popping up of this buffer by adding the entry
1870 \(undo discard-info) to the user option `warning-suppress-types',
1871 which is defined in the `warnings' library.\n")
1873 (setq buffer-undo-tree nil)))
1879 ;;; =====================================================================
1880 ;;; Visualizer-related functions
1882 (defun undo-tree-compute-widths (undo-tree)
1883 "Recursively compute widths for all UNDO-TREE's nodes."
1884 (let ((stack (list (undo-tree-root undo-tree)))
1887 ;; try to compute widths for node at top of stack
1888 (if (undo-tree-node-p
1889 (setq res (undo-tree-node-compute-widths (car stack))))
1890 ;; if computation fails, it returns a node whose widths still need
1891 ;; computing, which we push onto the stack
1893 ;; otherwise, store widths and remove it from stack
1894 (setf (undo-tree-node-lwidth (car stack)) (aref res 0)
1895 (undo-tree-node-cwidth (car stack)) (aref res 1)
1896 (undo-tree-node-rwidth (car stack)) (aref res 2))
1900 (defun undo-tree-node-compute-widths (node)
1901 ;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
1902 ;; (in a vector) if successful. Otherwise, returns a node whose widths need
1903 ;; calculating before NODE's can be calculated.
1904 (let ((num-children (length (undo-tree-node-next node)))
1905 (lwidth 0) (cwidth 0) (rwidth 0)
1909 ;; leaf nodes have 0 width
1912 (undo-tree-node-lwidth node) 0
1913 (undo-tree-node-cwidth node) 1
1914 (undo-tree-node-rwidth node) 0))
1916 ;; odd number of children
1917 ((= (mod num-children 2) 1)
1918 (setq p (undo-tree-node-next node))
1919 ;; compute left-width
1920 (dotimes (i (/ num-children 2))
1921 (if (undo-tree-node-lwidth (car p))
1922 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1923 (undo-tree-node-cwidth (car p))
1924 (undo-tree-node-rwidth (car p))))
1925 ;; if child's widths haven't been computed, return that child
1926 (throw 'need-widths (car p)))
1928 (if (undo-tree-node-lwidth (car p))
1929 (incf lwidth (undo-tree-node-lwidth (car p)))
1930 (throw 'need-widths (car p)))
1931 ;; centre-width is inherited from middle child
1932 (setf cwidth (undo-tree-node-cwidth (car p)))
1933 ;; compute right-width
1934 (incf rwidth (undo-tree-node-rwidth (car p)))
1936 (dotimes (i (/ num-children 2))
1937 (if (undo-tree-node-lwidth (car p))
1938 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1939 (undo-tree-node-cwidth (car p))
1940 (undo-tree-node-rwidth (car p))))
1941 (throw 'need-widths (car p)))
1944 ;; even number of children
1946 (setq p (undo-tree-node-next node))
1947 ;; compute left-width
1948 (dotimes (i (/ num-children 2))
1949 (if (undo-tree-node-lwidth (car p))
1950 (incf lwidth (+ (undo-tree-node-lwidth (car p))
1951 (undo-tree-node-cwidth (car p))
1952 (undo-tree-node-rwidth (car p))))
1953 (throw 'need-widths (car p)))
1955 ;; centre-width is 0 when number of children is even
1957 ;; compute right-width
1958 (dotimes (i (/ num-children 2))
1959 (if (undo-tree-node-lwidth (car p))
1960 (incf rwidth (+ (undo-tree-node-lwidth (car p))
1961 (undo-tree-node-cwidth (car p))
1962 (undo-tree-node-rwidth (car p))))
1963 (throw 'need-widths (car p)))
1966 ;; return left-, centre- and right-widths
1967 (vector lwidth cwidth rwidth))))
1970 (defun undo-tree-clear-visualizer-data (undo-tree)
1971 ;; Clear visualizer data from UNDO-TREE.
1973 (lambda (node) (undo-tree-node-clear-visualizer-data node))
1979 ;;; =====================================================================
1980 ;;; Undo-in-region functions
1982 (defun undo-tree-pull-undo-in-region-branch (start end)
1983 ;; Pull out entries from undo changesets to create a new undo-in-region
1984 ;; branch, which undoes changeset entries lying between START and END first,
1985 ;; followed by remaining entries from the changesets, before rejoining the
1986 ;; existing undo tree history. Repeated calls will, if appropriate, extend
1987 ;; the current undo-in-region branch rather than creating a new one.
1989 ;; if we're just reverting the last redo-in-region, we don't need to
1990 ;; manipulate the undo tree at all
1991 (if (undo-tree-reverting-redo-in-region-p start end)
1992 t ; return t to indicate success
1994 ;; We build the `region-changeset' and `delta-list' lists forwards, using
1995 ;; pointers `r' and `d' to the penultimate element of the list. So that we
1996 ;; don't have to treat the first element differently, we prepend a dummy
1997 ;; leading nil to the lists, and have the pointers point to that
1999 ;; Note: using '(nil) instead of (list nil) in the `let*' results in
2000 ;; bizarre errors when the code is byte-compiled, where parts of the
2001 ;; lists appear to survive across different calls to this function.
2002 ;; An obscure byte-compiler bug, perhaps?
2003 (let* ((region-changeset (list nil))
2004 (r region-changeset)
2005 (delta-list (list nil))
2007 (node (undo-tree-current buffer-undo-tree))
2008 (repeated-undo-in-region
2009 (undo-tree-repeated-undo-in-region-p start end))
2010 undo-adjusted-markers ; `undo-elt-in-region' expects this
2011 fragment splice original-fragment original-splice original-current
2012 got-visible-elt undo-list elt)
2014 ;; --- initialisation ---
2016 ;; if this is a repeated undo in the same region, start pulling changes
2017 ;; from NODE at which undo-in-region branch iss attached, and detatch
2018 ;; the branch, using it as initial FRAGMENT of branch being constructed
2019 (repeated-undo-in-region
2020 (setq original-current node
2021 fragment (car (undo-tree-node-next node))
2023 ;; undo up to node at which undo-in-region branch is attached
2024 ;; (recognizable as first node with more than one branch)
2025 (let ((mark-active nil))
2026 (while (= (length (undo-tree-node-next node)) 1)
2029 node (undo-tree-current buffer-undo-tree))))
2030 (when (eq splice node) (setq splice nil))
2031 ;; detatch undo-in-region branch
2032 (setf (undo-tree-node-next node)
2033 (delq fragment (undo-tree-node-next node))
2034 (undo-tree-node-previous fragment) nil
2035 original-fragment fragment
2036 original-splice node))
2038 ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
2039 ;; nodes below the current one in the active branch
2040 ((undo-tree-node-next node)
2041 (setq fragment (undo-tree-make-node nil nil)
2043 (while (setq node (nth (undo-tree-node-branch node)
2044 (undo-tree-node-next node)))
2045 (push (undo-tree-make-node
2047 (undo-copy-list (undo-tree-node-undo node))
2048 (undo-copy-list (undo-tree-node-redo node)))
2049 (undo-tree-node-next splice))
2050 (setq splice (car (undo-tree-node-next splice))))
2051 (setq fragment (car (undo-tree-node-next fragment))
2053 node (undo-tree-current buffer-undo-tree))))
2056 ;; --- pull undo-in-region elements into branch ---
2057 ;; work backwards up tree, pulling out undo elements within region until
2058 ;; we've got one that undoes a visible change (insertion or deletion)
2060 (while (and (not got-visible-elt) node (undo-tree-node-undo node))
2061 ;; we cons a dummy nil element on the front of the changeset so that
2062 ;; we can conveniently remove the first (real) element from the
2063 ;; changeset if we need to; the leading nil is removed once we're
2064 ;; done with this changeset
2065 (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
2066 elt (cadr undo-list))
2069 (setq fragment (undo-tree-grow-backwards fragment undo-list))
2070 (unless splice (setq splice fragment)))
2071 (setq fragment (undo-tree-make-node nil undo-list))
2072 (setq splice fragment))
2076 ;; keep elements within region
2077 ((undo-elt-in-region elt start end)
2078 ;; set flag if kept element is visible (insertion or deletion)
2079 (when (and (consp elt)
2080 (or (stringp (car elt)) (integerp (car elt))))
2081 (setq got-visible-elt t))
2082 ;; adjust buffer positions in elements previously undone before
2083 ;; kept element, as kept element will now be undone first
2084 (undo-tree-adjust-elements-to-elt splice elt)
2085 ;; move kept element to undo-in-region changeset, adjusting its
2086 ;; buffer position as it will now be undone first
2087 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
2089 (setcdr undo-list (cddr undo-list)))
2091 ;; discard "was unmodified" elements
2092 ;; FIXME: deal properly with these
2093 ((and (consp elt) (eq (car elt) t))
2094 (setcdr undo-list (cddr undo-list)))
2096 ;; if element crosses region, we can't pull any more elements
2097 ((undo-elt-crosses-region elt start end)
2098 ;; if we've found a visible element, it must be earlier in
2099 ;; current node's changeset; stop pulling elements (null
2100 ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
2102 (setq undo-list nil)
2103 ;; if we haven't found a visible element yet, pulling
2104 ;; undo-in-region branch has failed
2105 (setq region-changeset nil)
2108 ;; if rejecting element, add its delta (if any) to the list
2110 (let ((delta (undo-delta elt)))
2111 (when (/= 0 (cdr delta))
2112 (setcdr d (list delta))
2114 (setq undo-list (cdr undo-list))))
2116 ;; process next element of current changeset
2117 (setq elt (cadr undo-list)))
2119 ;; if there are remaining elements in changeset, remove dummy nil
2121 (if (cadr (undo-tree-node-undo fragment))
2122 (pop (undo-tree-node-undo fragment))
2123 ;; otherwise, if we've kept all elements in changeset, discard
2125 (when (eq splice fragment) (setq splice nil))
2126 (setq fragment (car (undo-tree-node-next fragment))))
2127 ;; process changeset from next node up the tree
2128 (setq node (undo-tree-node-previous node))))
2130 ;; pop dummy nil from front of `region-changeset'
2131 (pop region-changeset)
2134 ;; --- integrate branch into tree ---
2135 ;; if no undo-in-region elements were found, restore undo tree
2136 (if (null region-changeset)
2137 (when original-current
2138 (push original-fragment (undo-tree-node-next original-splice))
2139 (setf (undo-tree-node-branch original-splice) 0
2140 (undo-tree-node-previous original-fragment) original-splice)
2141 (let ((mark-active nil))
2142 (while (not (eq (undo-tree-current buffer-undo-tree)
2144 (undo-tree-redo-1)))
2145 nil) ; return nil to indicate failure
2148 ;; need to undo up to node where new branch will be attached, to
2149 ;; ensure redo entries are populated, and then redo back to where we
2151 (let ((mark-active nil)
2152 (current (undo-tree-current buffer-undo-tree)))
2153 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2155 (while (not (eq (undo-tree-current buffer-undo-tree) current))
2156 (undo-tree-redo-1)))
2159 ;; if there's no remaining fragment, just create undo-in-region node
2160 ;; and attach it to parent of last node from which elements were
2163 (setq fragment (undo-tree-make-node node region-changeset))
2164 (push fragment (undo-tree-node-next node))
2165 (setf (undo-tree-node-branch node) 0)
2166 ;; set current node to undo-in-region node
2167 (setf (undo-tree-current buffer-undo-tree) fragment))
2169 ;; if no splice point has been set, add undo-in-region node to top of
2170 ;; fragment and attach it to parent of last node from which elements
2173 (setq fragment (undo-tree-grow-backwards fragment region-changeset))
2174 (push fragment (undo-tree-node-next node))
2175 (setf (undo-tree-node-branch node) 0
2176 (undo-tree-node-previous fragment) node)
2177 ;; set current node to undo-in-region node
2178 (setf (undo-tree-current buffer-undo-tree) fragment))
2180 ;; if fragment contains nodes, attach fragment to parent of last node
2181 ;; from which elements were pulled, and splice in undo-in-region node
2183 (setf (undo-tree-node-previous fragment) node)
2184 (push fragment (undo-tree-node-next node))
2185 (setf (undo-tree-node-branch node) 0)
2186 ;; if this is a repeated undo-in-region, then we've left the current
2187 ;; node at the original splice-point; we need to set the current
2188 ;; node to the equivalent node on the undo-in-region branch and redo
2189 ;; back to where we started
2190 (when repeated-undo-in-region
2191 (setf (undo-tree-current buffer-undo-tree)
2192 (undo-tree-node-previous original-fragment))
2193 (let ((mark-active nil))
2194 (while (not (eq (undo-tree-current buffer-undo-tree) splice))
2195 (undo-tree-redo-1 nil 'preserve-undo))))
2196 ;; splice new undo-in-region node into fragment
2197 (setq node (undo-tree-make-node nil region-changeset))
2198 (undo-tree-splice-node node splice)
2199 ;; set current node to undo-in-region node
2200 (setf (undo-tree-current buffer-undo-tree) node)))
2202 ;; update undo-tree size
2203 (setq node (undo-tree-node-previous fragment))
2205 (and (setq node (car (undo-tree-node-next node)))
2206 (not (eq node original-fragment))
2207 (incf (undo-tree-size buffer-undo-tree)
2208 (undo-list-byte-size (undo-tree-node-undo node)))
2209 (when (undo-tree-node-redo node)
2210 (incf (undo-tree-size buffer-undo-tree)
2211 (undo-list-byte-size (undo-tree-node-redo node))))
2213 t) ; indicate undo-in-region branch was successfully pulled
2218 (defun undo-tree-pull-redo-in-region-branch (start end)
2219 ;; Pull out entries from redo changesets to create a new redo-in-region
2220 ;; branch, which redoes changeset entries lying between START and END first,
2221 ;; followed by remaining entries from the changesets. Repeated calls will,
2222 ;; if appropriate, extend the current redo-in-region branch rather than
2223 ;; creating a new one.
2225 ;; if we're just reverting the last undo-in-region, we don't need to
2226 ;; manipulate the undo tree at all
2227 (if (undo-tree-reverting-undo-in-region-p start end)
2228 t ; return t to indicate success
2230 ;; We build the `region-changeset' and `delta-list' lists forwards, using
2231 ;; pointers `r' and `d' to the penultimate element of the list. So that we
2232 ;; don't have to treat the first element differently, we prepend a dummy
2233 ;; leading nil to the lists, and have the pointers point to that
2235 ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
2236 ;; errors when the code is byte-compiled, where parts of the lists
2237 ;; appear to survive across different calls to this function. An
2238 ;; obscure byte-compiler bug, perhaps?
2239 (let* ((region-changeset (list nil))
2240 (r region-changeset)
2241 (delta-list (list nil))
2243 (node (undo-tree-current buffer-undo-tree))
2244 (repeated-redo-in-region
2245 (undo-tree-repeated-redo-in-region-p start end))
2246 undo-adjusted-markers ; `undo-elt-in-region' expects this
2247 fragment splice got-visible-elt redo-list elt)
2249 ;; --- inisitalisation ---
2251 ;; if this is a repeated redo-in-region, detach fragment below current
2253 (repeated-redo-in-region
2254 (when (setq fragment (car (undo-tree-node-next node)))
2255 (setf (undo-tree-node-previous fragment) nil
2256 (undo-tree-node-next node)
2257 (delq fragment (undo-tree-node-next node)))))
2258 ;; if this is a new redo-in-region, initial fragment is a copy of all
2259 ;; nodes below the current one in the active branch
2260 ((undo-tree-node-next node)
2261 (setq fragment (undo-tree-make-node nil nil)
2263 (while (setq node (nth (undo-tree-node-branch node)
2264 (undo-tree-node-next node)))
2265 (push (undo-tree-make-node
2267 (undo-copy-list (undo-tree-node-redo node)))
2268 (undo-tree-node-next splice))
2269 (setq splice (car (undo-tree-node-next splice))))
2270 (setq fragment (car (undo-tree-node-next fragment)))))
2273 ;; --- pull redo-in-region elements into branch ---
2274 ;; work down fragment, pulling out redo elements within region until
2275 ;; we've got one that redoes a visible change (insertion or deletion)
2276 (setq node fragment)
2278 (while (and (not got-visible-elt) node (undo-tree-node-redo node))
2279 ;; we cons a dummy nil element on the front of the changeset so that
2280 ;; we can conveniently remove the first (real) element from the
2281 ;; changeset if we need to; the leading nil is removed once we're
2282 ;; done with this changeset
2283 (setq redo-list (push nil (undo-tree-node-redo node))
2284 elt (cadr redo-list))
2287 ;; keep elements within region
2288 ((undo-elt-in-region elt start end)
2289 ;; set flag if kept element is visible (insertion or deletion)
2290 (when (and (consp elt)
2291 (or (stringp (car elt)) (integerp (car elt))))
2292 (setq got-visible-elt t))
2293 ;; adjust buffer positions in elements previously redone before
2294 ;; kept element, as kept element will now be redone first
2295 (undo-tree-adjust-elements-to-elt fragment elt t)
2296 ;; move kept element to redo-in-region changeset, adjusting its
2297 ;; buffer position as it will now be redone first
2298 (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
2300 (setcdr redo-list (cddr redo-list)))
2302 ;; discard "was unmodified" elements
2303 ;; FIXME: deal properly with these
2304 ((and (consp elt) (eq (car elt) t))
2305 (setcdr redo-list (cddr redo-list)))
2307 ;; if element crosses region, we can't pull any more elements
2308 ((undo-elt-crosses-region elt start end)
2309 ;; if we've found a visible element, it must be earlier in
2310 ;; current node's changeset; stop pulling elements (null
2311 ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
2313 (setq redo-list nil)
2314 ;; if we haven't found a visible element yet, pulling
2315 ;; redo-in-region branch has failed
2316 (setq region-changeset nil)
2319 ;; if rejecting element, add its delta (if any) to the list
2321 (let ((delta (undo-delta elt)))
2322 (when (/= 0 (cdr delta))
2323 (setcdr d (list delta))
2325 (setq redo-list (cdr redo-list))))
2327 ;; process next element of current changeset
2328 (setq elt (cadr redo-list)))
2330 ;; if there are remaining elements in changeset, remove dummy nil
2332 (if (cadr (undo-tree-node-redo node))
2333 (pop (undo-tree-node-undo node))
2334 ;; otherwise, if we've kept all elements in changeset, discard
2336 (if (eq fragment node)
2337 (setq fragment (car (undo-tree-node-next fragment)))
2338 (undo-tree-snip-node node)))
2339 ;; process changeset from next node in fragment
2340 (setq node (car (undo-tree-node-next node)))))
2342 ;; pop dummy nil from front of `region-changeset'
2343 (pop region-changeset)
2346 ;; --- integrate branch into tree ---
2347 (setq node (undo-tree-current buffer-undo-tree))
2348 ;; if no redo-in-region elements were found, restore undo tree
2349 (if (null (car region-changeset))
2350 (when (and repeated-redo-in-region fragment)
2351 (push fragment (undo-tree-node-next node))
2352 (setf (undo-tree-node-branch node) 0
2353 (undo-tree-node-previous fragment) node)
2354 nil) ; return nil to indicate failure
2356 ;; otherwise, add redo-in-region node to top of fragment, and attach
2357 ;; it below current node
2360 (undo-tree-grow-backwards fragment nil region-changeset)
2361 (undo-tree-make-node nil nil region-changeset)))
2362 (push fragment (undo-tree-node-next node))
2363 (setf (undo-tree-node-branch node) 0
2364 (undo-tree-node-previous fragment) node)
2365 ;; update undo-tree size
2366 (unless repeated-redo-in-region
2367 (setq node fragment)
2369 (and (setq node (car (undo-tree-node-next node)))
2370 (incf (undo-tree-size buffer-undo-tree)
2371 (undo-list-byte-size
2372 (undo-tree-node-redo node)))))))
2373 (incf (undo-tree-size buffer-undo-tree)
2374 (undo-list-byte-size (undo-tree-node-redo fragment)))
2375 t) ; indicate undo-in-region branch was successfully pulled
2380 (defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
2381 "Adjust buffer positions of undo elements, starting at NODE's
2382 and going up the tree (or down the active branch if BELOW is
2383 non-nil) and through the nodes' undo elements until we reach
2384 UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
2385 of either NODE itself or some node above it in the tree."
2386 (let ((delta (list (undo-delta undo-elt)))
2387 (undo-list (undo-tree-node-undo node)))
2388 ;; adjust elements until we reach UNDO-ELT
2389 (while (and (car undo-list)
2390 (not (eq (car undo-list) undo-elt)))
2392 (undo-tree-apply-deltas (car undo-list) delta -1))
2393 ;; move to next undo element in list, or to next node if we've run out
2395 (unless (car (setq undo-list (cdr undo-list)))
2397 (setq node (nth (undo-tree-node-branch node)
2398 (undo-tree-node-next node)))
2399 (setq node (undo-tree-node-previous node)))
2400 (setq undo-list (undo-tree-node-undo node))))))
2404 (defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
2405 ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
2406 ;; (only useful value for SGN is -1).
2407 (let (position offset)
2408 (dolist (delta deltas)
2409 (setq position (car delta)
2410 offset (* (cdr delta) (or sgn 1)))
2413 ((integerp undo-elt)
2414 (when (>= undo-elt position)
2415 (setq undo-elt (- undo-elt offset))))
2416 ;; nil (or any other atom)
2418 ;; (TEXT . POSITION)
2419 ((stringp (car undo-elt))
2420 (let ((text-pos (abs (cdr undo-elt)))
2421 (point-at-end (< (cdr undo-elt) 0)))
2422 (if (>= text-pos position)
2423 (setcdr undo-elt (* (if point-at-end -1 1)
2424 (- text-pos offset))))))
2426 ((integerp (car undo-elt))
2427 (when (>= (car undo-elt) position)
2428 (setcar undo-elt (- (car undo-elt) offset))
2429 (setcdr undo-elt (- (cdr undo-elt) offset))))
2430 ;; (nil PROPERTY VALUE BEG . END)
2431 ((null (car undo-elt))
2432 (let ((tail (nthcdr 3 undo-elt)))
2433 (when (>= (car tail) position)
2434 (setcar tail (- (car tail) offset))
2435 (setcdr tail (- (cdr tail) offset)))))
2441 (defun undo-tree-repeated-undo-in-region-p (start end)
2442 ;; Return non-nil if undo-in-region between START and END is a repeated
2444 (let ((node (undo-tree-current buffer-undo-tree)))
2446 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
2447 (eq (undo-tree-node-undo-beginning node) start)
2448 (eq (undo-tree-node-undo-end node) end))))
2451 (defun undo-tree-repeated-redo-in-region-p (start end)
2452 ;; Return non-nil if undo-in-region between START and END is a repeated
2454 (let ((node (undo-tree-current buffer-undo-tree)))
2455 (and (eq (undo-tree-node-redo-beginning node) start)
2456 (eq (undo-tree-node-redo-end node) end))))
2459 ;; Return non-nil if undo-in-region between START and END is simply
2460 ;; reverting the last redo-in-region
2461 (defalias 'undo-tree-reverting-undo-in-region-p
2462 'undo-tree-repeated-undo-in-region-p)
2465 ;; Return non-nil if redo-in-region between START and END is simply
2466 ;; reverting the last undo-in-region
2467 (defalias 'undo-tree-reverting-redo-in-region-p
2468 'undo-tree-repeated-redo-in-region-p)
2473 ;;; =====================================================================
2474 ;;; Undo-tree commands
2477 (define-minor-mode undo-tree-mode
2478 "Toggle undo-tree mode.
2479 With no argument, this command toggles the mode.
2480 A positive prefix argument turns the mode on.
2481 A negative prefix argument turns it off.
2483 Undo-tree-mode replaces Emacs' standard undo feature with a more
2484 powerful yet easier to use version, that treats the undo history
2485 as what it is: a tree.
2487 The following keys are available in `undo-tree-mode':
2491 Within the undo-tree visualizer, the following keys are available:
2493 \\{undo-tree-visualizer-map}"
2496 undo-tree-mode-lighter ; lighter
2497 undo-tree-map ; keymap
2499 ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
2500 ;; Emacs undo can work
2501 (if (not undo-tree-mode)
2502 (undo-list-rebuild-from-tree)
2503 (setq buffer-undo-tree nil)))
2506 (defun turn-on-undo-tree-mode (&optional print-message)
2507 "Enable `undo-tree-mode' in the current buffer, when appropriate.
2508 Some major modes implement their own undo system, which should
2509 not normally be overridden by `undo-tree-mode'. This command does
2510 not enable `undo-tree-mode' in such buffers. If you want to force
2511 `undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
2514 The heuristic used to detect major modes in which
2515 `undo-tree-mode' should not be used is to check whether either
2516 the `undo' command has been remapped, or the default undo
2517 keybindings (C-/ and C-_) have been overridden somewhere other
2518 than in the global map. In addition, `undo-tree-mode' will not be
2519 enabled if the buffer's `major-mode' appears in
2520 `undo-tree-incompatible-major-modes'."
2522 (if (or (key-binding [remap undo])
2523 (undo-tree-overridden-undo-bindings-p)
2524 (memq major-mode undo-tree-incompatible-major-modes))
2526 (message "Buffer does not support undo-tree-mode;\
2527 undo-tree-mode NOT enabled"))
2528 (undo-tree-mode 1)))
2531 (defun undo-tree-overridden-undo-bindings-p ()
2532 "Returns t if default undo bindings are overridden, nil otherwise.
2533 Checks if either of the default undo key bindings (\"C-/\" or
2534 \"C-_\") are overridden in the current buffer by any keymap other
2535 than the global one. (So global redefinitions of the default undo
2536 key bindings do not count.)"
2537 (let ((binding1 (lookup-key (current-global-map) [?\C-/]))
2538 (binding2 (lookup-key (current-global-map) [?\C-_])))
2539 (global-set-key [?\C-/] 'undo)
2540 (global-set-key [?\C-_] 'undo)
2542 (or (and (key-binding [?\C-/])
2543 (not (eq (key-binding [?\C-/]) 'undo)))
2544 (and (key-binding [?\C-_])
2545 (not (eq (key-binding [?\C-_]) 'undo))))
2546 (global-set-key [?\C-/] binding1)
2547 (global-set-key [?\C-_] binding2))))
2551 (define-globalized-minor-mode global-undo-tree-mode
2552 undo-tree-mode turn-on-undo-tree-mode)
2556 (defun undo-tree-undo (&optional arg)
2558 Repeat this command to undo more changes.
2559 A numeric ARG serves as a repeat count.
2561 In Transient Mark mode when the mark is active, only undo changes
2562 within the current region. Similarly, when not in Transient Mark
2563 mode, just \\[universal-argument] as an argument limits undo to
2564 changes within the current region."
2566 ;; throw error if undo is disabled in buffer
2567 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2568 (undo-tree-undo-1 arg)
2569 ;; inform user if at branch point
2570 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2573 (defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
2574 ;; Internal undo function. An active mark in `transient-mark-mode', or
2575 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
2576 ;; causes the existing redo record to be preserved, rather than replacing it
2577 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2578 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2579 ;; should *only* be used when temporarily visiting another undo state and
2580 ;; immediately returning to the original state afterwards. Otherwise, it
2581 ;; could cause history-discarding errors.)
2582 (let ((undo-in-progress t)
2583 (undo-in-region (and undo-tree-enable-undo-in-region
2584 (or (region-active-p)
2585 (and arg (not (numberp arg))))))
2587 ;; transfer entries accumulated in `buffer-undo-list' to
2588 ;; `buffer-undo-tree'
2589 (undo-list-transfer-to-tree)
2591 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2592 ;; check if at top of undo tree
2593 (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
2594 (error "No further undo information"))
2596 ;; if region is active, or a non-numeric prefix argument was supplied,
2597 ;; try to pull out a new branch of changes affecting the region
2598 (when (and undo-in-region
2599 (not (undo-tree-pull-undo-in-region-branch
2600 (region-beginning) (region-end))))
2601 (error "No further undo information for region"))
2603 ;; remove any GC'd elements from node's undo list
2604 (setq current (undo-tree-current buffer-undo-tree))
2605 (decf (undo-tree-size buffer-undo-tree)
2606 (undo-list-byte-size (undo-tree-node-undo current)))
2607 (setf (undo-tree-node-undo current)
2608 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2609 (incf (undo-tree-size buffer-undo-tree)
2610 (undo-list-byte-size (undo-tree-node-undo current)))
2611 ;; undo one record from undo tree
2612 (when undo-in-region
2613 (setq pos (set-marker (make-marker) (point)))
2614 (set-marker-insertion-type pos t))
2615 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
2618 ;; if preserving old redo record, discard new redo entries that
2619 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2620 ;; elements from node's redo list
2623 (undo-list-pop-changeset)
2624 (decf (undo-tree-size buffer-undo-tree)
2625 (undo-list-byte-size (undo-tree-node-redo current)))
2626 (setf (undo-tree-node-redo current)
2627 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2628 (incf (undo-tree-size buffer-undo-tree)
2629 (undo-list-byte-size (undo-tree-node-redo current))))
2630 ;; otherwise, record redo entries that `primitive-undo' has added to
2631 ;; `buffer-undo-list' in current node's redo record, replacing
2632 ;; existing entry if one already exists
2633 (when (undo-tree-node-redo current)
2634 (decf (undo-tree-size buffer-undo-tree)
2635 (undo-list-byte-size (undo-tree-node-redo current))))
2636 (setf (undo-tree-node-redo current)
2637 (undo-list-pop-changeset 'discard-pos))
2638 (incf (undo-tree-size buffer-undo-tree)
2639 (undo-list-byte-size (undo-tree-node-redo current))))
2641 ;; rewind current node and update timestamp
2642 (setf (undo-tree-current buffer-undo-tree)
2643 (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
2644 (unless preserve-timestamps
2645 (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
2648 ;; if undoing-in-region, record current node, region and direction so we
2649 ;; can tell if undo-in-region is repeated, and re-activate mark if in
2650 ;; `transient-mark-mode'; if not, erase any leftover data
2651 (if (not undo-in-region)
2652 (undo-tree-node-clear-region-data current)
2654 ;; note: we deliberately want to store the region information in the
2655 ;; node *below* the now current one
2656 (setf (undo-tree-node-undo-beginning current) (region-beginning)
2657 (undo-tree-node-undo-end current) (region-end))
2658 (set-marker pos nil)))
2660 ;; undo deactivates mark unless undoing-in-region
2661 (setq deactivate-mark (not undo-in-region))))
2665 (defun undo-tree-redo (&optional arg)
2666 "Redo changes. A numeric ARG serves as a repeat count.
2668 In Transient Mark mode when the mark is active, only redo changes
2669 within the current region. Similarly, when not in Transient Mark
2670 mode, just \\[universal-argument] as an argument limits redo to
2671 changes within the current region."
2673 ;; throw error if undo is disabled in buffer
2674 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2675 (undo-tree-redo-1 arg)
2676 ;; inform user if at branch point
2677 (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
2680 (defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
2681 ;; Internal redo function. An active mark in `transient-mark-mode', or
2682 ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
2683 ;; causes the existing redo record to be preserved, rather than replacing it
2684 ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
2685 ;; disables updating of timestamps in visited undo-tree nodes. (This latter
2686 ;; should *only* be used when temporarily visiting another undo state and
2687 ;; immediately returning to the original state afterwards. Otherwise, it
2688 ;; could cause history-discarding errors.)
2689 (let ((undo-in-progress t)
2690 (redo-in-region (and undo-tree-enable-undo-in-region
2691 (or (region-active-p)
2692 (and arg (not (numberp arg))))))
2694 ;; transfer entries accumulated in `buffer-undo-list' to
2695 ;; `buffer-undo-tree'
2696 (undo-list-transfer-to-tree)
2698 (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
2699 ;; check if at bottom of undo tree
2700 (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
2701 (error "No further redo information"))
2703 ;; if region is active, or a non-numeric prefix argument was supplied,
2704 ;; try to pull out a new branch of changes affecting the region
2705 (when (and redo-in-region
2706 (not (undo-tree-pull-redo-in-region-branch
2707 (region-beginning) (region-end))))
2708 (error "No further redo information for region"))
2710 ;; advance current node
2711 (setq current (undo-tree-current buffer-undo-tree)
2712 current (setf (undo-tree-current buffer-undo-tree)
2713 (nth (undo-tree-node-branch current)
2714 (undo-tree-node-next current))))
2715 ;; remove any GC'd elements from node's redo list
2716 (decf (undo-tree-size buffer-undo-tree)
2717 (undo-list-byte-size (undo-tree-node-redo current)))
2718 (setf (undo-tree-node-redo current)
2719 (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
2720 (incf (undo-tree-size buffer-undo-tree)
2721 (undo-list-byte-size (undo-tree-node-redo current)))
2722 ;; redo one record from undo tree
2723 (when redo-in-region
2724 (setq pos (set-marker (make-marker) (point)))
2725 (set-marker-insertion-type pos t))
2726 (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
2729 ;; if preserving old undo record, discard new undo entries that
2730 ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
2731 ;; elements from node's redo list
2734 (undo-list-pop-changeset)
2735 (decf (undo-tree-size buffer-undo-tree)
2736 (undo-list-byte-size (undo-tree-node-undo current)))
2737 (setf (undo-tree-node-undo current)
2738 (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
2739 (incf (undo-tree-size buffer-undo-tree)
2740 (undo-list-byte-size (undo-tree-node-undo current))))
2741 ;; otherwise, record undo entries that `primitive-undo' has added to
2742 ;; `buffer-undo-list' in current node's undo record, replacing
2743 ;; existing entry if one already exists
2744 (when (undo-tree-node-undo current)
2745 (decf (undo-tree-size buffer-undo-tree)
2746 (undo-list-byte-size (undo-tree-node-undo current))))
2747 (setf (undo-tree-node-undo current)
2748 (undo-list-pop-changeset 'discard-pos))
2749 (incf (undo-tree-size buffer-undo-tree)
2750 (undo-list-byte-size (undo-tree-node-undo current))))
2753 (unless preserve-timestamps
2754 (setf (undo-tree-node-timestamp current) (current-time)))
2756 ;; if redoing-in-region, record current node, region and direction so we
2757 ;; can tell if redo-in-region is repeated, and re-activate mark if in
2758 ;; `transient-mark-mode'
2759 (if (not redo-in-region)
2760 (undo-tree-node-clear-region-data current)
2762 (setf (undo-tree-node-redo-beginning current) (region-beginning)
2763 (undo-tree-node-redo-end current) (region-end))
2764 (set-marker pos nil)))
2766 ;; redo deactivates the mark unless redoing-in-region
2767 (setq deactivate-mark (not redo-in-region))))
2771 (defun undo-tree-switch-branch (branch)
2772 "Switch to a different BRANCH of the undo tree.
2773 This will affect which branch to descend when *redoing* changes
2774 using `undo-tree-redo'."
2775 (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
2776 (and (not (eq buffer-undo-list t))
2777 (or (undo-list-transfer-to-tree) t)
2778 (let ((b (undo-tree-node-branch
2780 buffer-undo-tree))))
2782 ;; switch to other branch if only 2
2783 ((= (undo-tree-num-branches) 2) (- 1 b))
2784 ;; prompt if more than 2
2785 ((> (undo-tree-num-branches) 2)
2787 (format "Branch (0-%d, on %d): "
2788 (1- (undo-tree-num-branches)) b)))
2790 ;; throw error if undo is disabled in buffer
2791 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2792 ;; sanity check branch number
2793 (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point"))
2794 (when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
2795 (error "Invalid branch number"))
2796 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2797 (undo-list-transfer-to-tree)
2799 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
2801 (message "Switched to branch %d" branch))
2804 (defun undo-tree-set (node &optional preserve-timestamps)
2805 ;; Set buffer to state corresponding to NODE. Returns intersection point
2806 ;; between path back from current node and path back from selected NODE.
2807 ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
2808 ;; undo-tree nodes. (This should *only* be used when temporarily visiting
2809 ;; another undo state and immediately returning to the original state
2810 ;; afterwards. Otherwise, it could cause history-discarding errors.)
2811 (let ((path (make-hash-table :test 'eq))
2813 (puthash (undo-tree-root buffer-undo-tree) t path)
2814 ;; build list of nodes leading back from selected node to root, updating
2815 ;; branches as we go to point down to selected node
2818 (when (undo-tree-node-previous n)
2819 (setf (undo-tree-node-branch (undo-tree-node-previous n))
2821 n (undo-tree-node-next (undo-tree-node-previous n))))
2822 (setq n (undo-tree-node-previous n)))))
2823 ;; work backwards from current node until we intersect path back from
2825 (setq n (undo-tree-current buffer-undo-tree))
2826 (while (not (gethash n path))
2827 (setq n (undo-tree-node-previous n)))
2828 ;; ascend tree until intersection node
2829 (while (not (eq (undo-tree-current buffer-undo-tree) n))
2831 ;; descend tree until selected node
2832 (while (not (eq (undo-tree-current buffer-undo-tree) node))
2834 n)) ; return intersection node
2838 (defun undo-tree-save-state-to-register (register)
2839 "Store current undo-tree state to REGISTER.
2840 The saved state can be restored using
2841 `undo-tree-restore-state-from-register'.
2842 Argument is a character, naming the register."
2843 (interactive "cUndo-tree state to register: ")
2844 ;; throw error if undo is disabled in buffer
2845 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2846 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2847 (undo-list-transfer-to-tree)
2848 ;; save current node to REGISTER
2850 register (registerv-make
2851 (undo-tree-make-register-data
2852 (current-buffer) (undo-tree-current buffer-undo-tree))
2853 :print-func 'undo-tree-register-data-print-func))
2854 ;; record REGISTER in current node, for visualizer
2855 (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
2860 (defun undo-tree-restore-state-from-register (register)
2861 "Restore undo-tree state from REGISTER.
2862 The state must be saved using `undo-tree-save-state-to-register'.
2863 Argument is a character, naming the register."
2864 (interactive "*cRestore undo-tree state from register: ")
2865 ;; throw error if undo is disabled in buffer, or if register doesn't contain
2866 ;; an undo-tree node
2867 (let ((data (registerv-data (get-register register))))
2869 ((eq buffer-undo-list t)
2870 (error "No undo information in this buffer"))
2871 ((not (undo-tree-register-data-p data))
2872 (error "Register doesn't contain undo-tree state"))
2873 ((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
2874 (error "Register contains undo-tree state for a different buffer")))
2875 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
2876 (undo-list-transfer-to-tree)
2877 ;; restore buffer state corresponding to saved node
2878 (undo-tree-set (undo-tree-register-data-node data))))
2883 ;;; =====================================================================
2884 ;;; Persistent storage
2886 (defun undo-tree-make-history-save-file-name (file)
2887 "Create the undo history file name for FILE.
2888 Normally this is the file's name with `.' prepended and
2889 `~undo-tree~' appended.
2891 A match for FILE is sought in `undo-tree-history-directory-alist';
2892 see the documentation of that variable. If the directory for the
2893 backup doesn't exist, it is created."
2894 (let* ((backup-directory-alist undo-tree-history-directory-alist)
2895 (name (make-backup-file-name-1 file)))
2896 (concat (file-name-directory name) "." (file-name-nondirectory name)
2900 (defun undo-tree-save-history (&optional filename overwrite)
2901 "Store undo-tree history to file.
2903 If optional argument FILENAME is omitted, default save file is
2904 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
2905 Otherwise, prompt for one.
2907 If OVERWRITE is non-nil, any existing file will be overwritten
2908 without asking for confirmation."
2910 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
2911 (undo-list-transfer-to-tree)
2912 (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
2914 (undo-tree-kill-visualizer)
2915 (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
2916 (let ((buff (current-buffer))
2921 (if buffer-file-name
2922 (undo-tree-make-history-save-file-name buffer-file-name)
2923 (expand-file-name (read-file-name "File to save in: ") nil))))
2924 (when (or (not (file-exists-p filename))
2926 (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
2929 ;; transform undo-tree into non-circular structure, and make
2931 (undo-tree-decircle buffer-undo-tree)
2932 (setq tree (copy-undo-tree buffer-undo-tree))
2933 ;; discard undo-tree object pool before saving
2934 (setf (undo-tree-object-pool tree) nil)
2935 ;; print undo-tree to file
2936 ;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
2937 ;; to allow `auto-compression-mode' to take effect, in
2938 ;; case user has overridden or advised the default
2939 ;; `undo-tree-make-history-save-file-name' to add a
2940 ;; compressed file extension.
2941 (with-auto-compression-mode
2943 (prin1 (sha1 buff) (current-buffer))
2944 (terpri (current-buffer))
2945 (let ((print-circle t)) (prin1 tree (current-buffer)))
2946 (write-region nil nil filename))))
2947 ;; restore circular undo-tree data structure
2948 (undo-tree-recircle buffer-undo-tree))
2953 (defun undo-tree-load-history (&optional filename noerror)
2954 "Load undo-tree history from file.
2956 If optional argument FILENAME is null, default load file is
2957 \".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
2958 Otherwise, prompt for one.
2960 If optional argument NOERROR is non-nil, return nil instead of
2961 signaling an error if file is not found."
2966 (if buffer-file-name
2967 (undo-tree-make-history-save-file-name buffer-file-name)
2968 (expand-file-name (read-file-name "File to load from: ") nil))))
2970 ;; attempt to read undo-tree from FILENAME
2972 (unless (file-exists-p filename)
2974 (throw 'load-error nil)
2975 (error "File \"%s\" does not exist; could not load undo-tree history"
2977 (let (buff tmp hash tree)
2978 (setq buff (current-buffer))
2979 (with-auto-compression-mode
2981 (insert-file-contents filename)
2982 (goto-char (point-min))
2984 (setq hash (read (current-buffer)))
2987 (funcall (if noerror 'message 'error)
2988 "Error reading undo-tree history from \"%s\"" filename)
2989 (throw 'load-error nil)))
2990 (unless (string= (sha1 buff) hash)
2992 (funcall (if noerror 'message 'error)
2993 "Buffer has been modified; could not load undo-tree history")
2994 (throw 'load-error nil))
2996 (setq tree (read (current-buffer)))
2999 (funcall (if noerror 'message 'error)
3000 "Error reading undo-tree history from \"%s\"" filename)
3001 (throw 'load-error nil)))
3003 ;; initialise empty undo-tree object pool
3004 (setf (undo-tree-object-pool tree)
3005 (make-hash-table :test 'eq :weakness 'value))
3006 ;; restore circular undo-tree data structure
3007 (undo-tree-recircle tree)
3008 (setq buffer-undo-tree tree))))
3012 ;; Versions of save/load functions for use in hooks
3013 (defun undo-tree-save-history-hook ()
3014 (when (and undo-tree-mode undo-tree-auto-save-history
3015 (not (eq buffer-undo-list t)))
3016 (undo-tree-save-history nil t) nil))
3018 (defun undo-tree-load-history-hook ()
3019 (when (and undo-tree-mode undo-tree-auto-save-history
3020 (not (eq buffer-undo-list t)))
3021 (undo-tree-load-history nil t)))
3026 ;;; =====================================================================
3027 ;;; Undo-tree visualizer
3029 (defun undo-tree-visualize ()
3030 "Visualize the current buffer's undo tree."
3033 ;; throw error if undo is disabled in buffer
3034 (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
3035 ;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
3036 (undo-list-transfer-to-tree)
3037 ;; add hook to kill visualizer buffer if original buffer is changed
3038 (add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
3039 ;; prepare *undo-tree* buffer, then draw tree in it
3040 (let ((undo-tree buffer-undo-tree)
3041 (buff (current-buffer))
3042 (display-buffer-mark-dedicated 'soft))
3043 (switch-to-buffer-other-window
3044 (get-buffer-create undo-tree-visualizer-buffer-name))
3045 (setq undo-tree-visualizer-parent-buffer buff)
3046 (setq buffer-undo-tree undo-tree)
3047 (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
3048 (setq undo-tree-visualizer-spacing
3049 (undo-tree-visualizer-calculate-spacing))
3050 (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
3051 (undo-tree-visualizer-mode)
3052 (let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
3055 (defun undo-tree-kill-visualizer (&rest dummy)
3056 ;; Kill visualizer. Added to `before-change-functions' hook of original
3057 ;; buffer when visualizer is invoked.
3058 (unless undo-tree-inhibit-kill-visualizer
3060 (with-current-buffer undo-tree-visualizer-buffer-name
3061 (undo-tree-visualizer-quit)))))
3065 (defun undo-tree-draw-tree (undo-tree)
3066 ;; Draw UNDO-TREE in current buffer.
3068 (undo-tree-move-down 1) ; top margin
3069 (undo-tree-clear-visualizer-data undo-tree)
3070 (undo-tree-compute-widths undo-tree)
3071 (undo-tree-move-forward
3072 (max (/ (window-width) 2)
3073 (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree))
3074 ;; add space for left part of left-most time-stamp
3075 (if undo-tree-visualizer-timestamps
3076 (/ (- undo-tree-visualizer-spacing 4) 2)
3080 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3081 (stack (list (undo-tree-root undo-tree)))
3082 (n (undo-tree-root undo-tree)))
3083 ;; link root node to its representation in visualizer
3084 (unless (markerp (undo-tree-node-marker n))
3085 (setf (undo-tree-node-marker n) (make-marker))
3086 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3087 (move-marker (undo-tree-node-marker n) (point))
3088 ;; draw nodes from stack until stack is empty
3090 (setq n (pop stack))
3091 (goto-char (undo-tree-node-marker n))
3092 (setq n (undo-tree-draw-subtree n nil))
3093 (setq stack (append stack n))))
3094 ;; highlight active branch
3095 (goto-char (undo-tree-node-marker (undo-tree-root undo-tree)))
3096 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3097 (undo-tree-highlight-active-branch (undo-tree-root undo-tree)))
3098 ;; highlight current node
3099 (undo-tree-draw-node (undo-tree-current undo-tree) 'current))
3102 (defun undo-tree-highlight-active-branch (node)
3103 ;; Draw highlighted active branch below NODE in current buffer.
3104 (let ((stack (list node)))
3105 ;; link node to its representation in visualizer
3106 (unless (markerp (undo-tree-node-marker node))
3107 (setf (undo-tree-node-marker node) (make-marker))
3108 (set-marker-insertion-type (undo-tree-node-marker node) nil))
3109 (move-marker (undo-tree-node-marker node) (point))
3110 ;; draw active branch
3112 (setq node (pop stack))
3113 (goto-char (undo-tree-node-marker node))
3114 (setq node (undo-tree-draw-subtree node 'active))
3115 (setq stack (append stack node)))))
3118 (defun undo-tree-draw-node (node &optional current)
3119 ;; Draw symbol representing NODE in visualizer.
3120 (goto-char (undo-tree-node-marker node))
3121 (when undo-tree-visualizer-timestamps
3122 (backward-char (/ undo-tree-visualizer-spacing 2)))
3124 (let ((register (undo-tree-node-register node))
3126 (unless (and register
3127 (eq node (undo-tree-register-data-node
3128 (registerv-data (get-register register)))))
3129 (setq register nil))
3130 ;; represent node by differentl symbols, depending on whether it's the
3131 ;; current node or is saved in a register
3134 (undo-tree-visualizer-timestamps
3135 (undo-tree-timestamp-to-string
3136 (undo-tree-node-timestamp node)
3137 undo-tree-visualizer-relative-timestamps
3140 (register (char-to-string register))
3145 (let ((undo-tree-insert-face
3146 (cons 'undo-tree-visualizer-current-face
3147 (and (boundp 'undo-tree-insert-face)
3148 (or (and (consp undo-tree-insert-face)
3149 undo-tree-insert-face)
3150 (list undo-tree-insert-face))))))
3151 (undo-tree-insert node-string)))
3153 (let ((undo-tree-insert-face
3154 (cons 'undo-tree-visualizer-register-face
3155 (and (boundp 'undo-tree-insert-face)
3156 (or (and (consp undo-tree-insert-face)
3157 undo-tree-insert-face)
3158 (list undo-tree-insert-face))))))
3159 (undo-tree-insert node-string)))
3160 (t (undo-tree-insert node-string)))
3162 (backward-char (if undo-tree-visualizer-timestamps
3163 (1+ (/ undo-tree-visualizer-spacing 2))
3165 (move-marker (undo-tree-node-marker node) (point))
3166 (put-text-property (point) (1+ (point)) 'undo-tree-node node)))
3169 (defun undo-tree-draw-subtree (node &optional active-branch)
3170 ;; Draw subtree rooted at NODE. The subtree will start from point.
3171 ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE.
3172 ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes.
3173 (let ((num-children (length (undo-tree-node-next node)))
3174 node-list pos trunk-pos n)
3176 (undo-tree-draw-node node)
3179 ;; if we're at a leaf node, we're done
3180 ((= num-children 0))
3182 ;; if node has only one child, draw it (not strictly necessary to deal
3183 ;; with this case separately, but as it's by far the most common case
3184 ;; this makes the code clearer and more efficient)
3186 (undo-tree-move-down 1)
3187 (undo-tree-insert ?|)
3189 (undo-tree-move-down 1)
3190 (undo-tree-insert ?|)
3192 (undo-tree-move-down 1)
3193 (setq n (car (undo-tree-node-next node)))
3194 ;; link next node to its representation in visualizer
3195 (unless (markerp (undo-tree-node-marker n))
3196 (setf (undo-tree-node-marker n) (make-marker))
3197 (set-marker-insertion-type (undo-tree-node-marker n) nil))
3198 (move-marker (undo-tree-node-marker n) (point))
3199 ;; add next node to list of nodes to draw next
3202 ;; if node had multiple children, draw branches
3204 (undo-tree-move-down 1)
3205 (undo-tree-insert ?|)
3207 (setq trunk-pos (point))
3210 (- (undo-tree-node-char-lwidth node)
3211 (undo-tree-node-char-lwidth
3212 (car (undo-tree-node-next node)))))
3214 (setq n (cons nil (undo-tree-node-next node)))
3215 (dotimes (i (/ num-children 2))
3217 (when (or (null active-branch)
3219 (nth (undo-tree-node-branch node)
3220 (undo-tree-node-next node))))
3221 (undo-tree-move-forward 2)
3222 (undo-tree-insert ?_ (- trunk-pos pos 2))
3224 (undo-tree-move-forward 1)
3225 (undo-tree-move-down 1)
3226 (undo-tree-insert ?/)
3228 (undo-tree-move-down 1)
3229 ;; link node to its representation in visualizer
3230 (unless (markerp (undo-tree-node-marker (car n)))
3231 (setf (undo-tree-node-marker (car n)) (make-marker))
3232 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3233 (move-marker (undo-tree-node-marker (car n)) (point))
3234 ;; add node to list of nodes to draw next
3235 (push (car n) node-list))
3237 (undo-tree-move-forward
3238 (+ (undo-tree-node-char-rwidth (car n))
3239 (undo-tree-node-char-lwidth (cadr n))
3240 undo-tree-visualizer-spacing 1))
3242 ;; middle subtree (only when number of children is odd)
3243 (when (= (mod num-children 2) 1)
3245 (when (or (null active-branch)
3247 (nth (undo-tree-node-branch node)
3248 (undo-tree-node-next node))))
3249 (undo-tree-move-down 1)
3250 (undo-tree-insert ?|)
3252 (undo-tree-move-down 1)
3253 ;; link node to its representation in visualizer
3254 (unless (markerp (undo-tree-node-marker (car n)))
3255 (setf (undo-tree-node-marker (car n)) (make-marker))
3256 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3257 (move-marker (undo-tree-node-marker (car n)) (point))
3258 ;; add node to list of nodes to draw next
3259 (push (car n) node-list))
3261 (undo-tree-move-forward
3262 (+ (undo-tree-node-char-rwidth (car n))
3263 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3264 undo-tree-visualizer-spacing 1))
3268 (dotimes (i (/ num-children 2))
3270 (when (or (null active-branch)
3272 (nth (undo-tree-node-branch node)
3273 (undo-tree-node-next node))))
3274 (goto-char trunk-pos)
3275 (undo-tree-insert ?_ (- pos trunk-pos 1))
3278 (undo-tree-move-down 1)
3279 (undo-tree-insert ?\\)
3280 (undo-tree-move-down 1)
3281 ;; link node to its representation in visualizer
3282 (unless (markerp (undo-tree-node-marker (car n)))
3283 (setf (undo-tree-node-marker (car n)) (make-marker))
3284 (set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
3285 (move-marker (undo-tree-node-marker (car n)) (point))
3286 ;; add node to list of nodes to draw next
3287 (push (car n) node-list))
3290 (undo-tree-move-forward
3291 (+ (undo-tree-node-char-rwidth (car n))
3292 (if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
3293 undo-tree-visualizer-spacing 1))
3294 (setq pos (point))))
3296 ;; return list of nodes to draw next
3297 (nreverse node-list)))
3301 (defun undo-tree-node-char-lwidth (node)
3302 ;; Return left-width of NODE measured in characters.
3303 (if (= (length (undo-tree-node-next node)) 0) 0
3304 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
3305 (if (= (undo-tree-node-cwidth node) 0)
3306 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3309 (defun undo-tree-node-char-rwidth (node)
3310 ;; Return right-width of NODE measured in characters.
3311 (if (= (length (undo-tree-node-next node)) 0) 0
3312 (- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
3313 (if (= (undo-tree-node-cwidth node) 0)
3314 (1+ (/ undo-tree-visualizer-spacing 2)) 0))))
3317 (defun undo-tree-insert (str &optional arg)
3318 ;; Insert character or string STR ARG times, overwriting, and using
3319 ;; `undo-tree-insert-face'.
3320 (unless arg (setq arg 1))
3321 (when (characterp str)
3322 (setq str (make-string arg str))
3324 (dotimes (i arg) (insert str))
3325 (setq arg (* arg (length str)))
3326 (undo-tree-move-forward arg)
3327 ;; make sure mark isn't active, otherwise `backward-delete-char' might
3328 ;; delete region instead of single char if transient-mark-mode is enabled
3329 (setq mark-active nil)
3330 (backward-delete-char arg)
3331 (when (boundp 'undo-tree-insert-face)
3332 (put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
3335 (defun undo-tree-move-down (&optional arg)
3336 ;; Move down, extending buffer if necessary.
3337 (let ((row (line-number-at-pos))
3338 (col (current-column))
3340 (unless arg (setq arg 1))
3342 (setq line (line-number-at-pos))
3343 ;; if buffer doesn't have enough lines, add some
3344 (when (/= line (+ row arg))
3345 (insert (make-string (- arg (- line row)) ?\n)))
3346 (undo-tree-move-forward col)))
3349 (defun undo-tree-move-forward (&optional arg)
3350 ;; Move forward, extending buffer if necessary.
3351 (unless arg (setq arg 1))
3352 (let ((n (- (line-end-position) (point))))
3356 (insert (make-string (- arg n) ? )))))
3359 (defun undo-tree-timestamp-to-string
3360 (timestamp &optional relative current register)
3361 ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
3362 ;; if it's the CURRENT node and/or has an associated REGISTER.
3365 (let ((time (floor (float-time
3366 (subtract-time (current-time) timestamp))))
3370 (if (> (setq n (/ time 315360000)) 0)
3371 (if (> n 999) "-ages" (format "-%dy" n))
3372 (setq time (% time 315360000))
3374 (if (> (setq n (/ time 86400)) 0)
3376 (setq time (% time 86400))
3378 (if (> (setq n (/ time 3600)) 0)
3380 (setq time (% time 3600))
3382 (if (> (setq n (/ time 60)) 0)
3385 (format "-%ds" (% time 60)))))))
3387 (if current "*" " ")
3389 (if register (concat "[" (char-to-string register) "]")
3391 (setq n (length time))
3393 (concat (make-string (- 9 n) ? ) time)
3396 (concat (if current "*" " ")
3397 (format-time-string "%H:%M:%S" timestamp)
3399 (concat "[" (char-to-string register) "]")
3405 ;;; =====================================================================
3406 ;;; Visualizer mode commands
3408 (defun undo-tree-visualizer-mode ()
3409 "Major mode used in undo-tree visualizer.
3411 The undo-tree visualizer can only be invoked from a buffer in
3412 which `undo-tree-mode' is enabled. The visualizer displays the
3413 undo history tree graphically, and allows you to browse around
3414 the undo history, undoing or redoing the corresponding changes in
3417 Within the undo-tree visualizer, the following keys are available:
3419 \\{undo-tree-visualizer-map}"
3421 (setq major-mode 'undo-tree-visualizer-mode)
3422 (setq mode-name "undo-tree-visualizer-mode")
3423 (use-local-map undo-tree-visualizer-map)
3424 (setq truncate-lines t)
3425 (setq cursor-type nil)
3426 (setq buffer-read-only t)
3427 (setq undo-tree-visualizer-selected-node nil)
3428 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
3432 (defun undo-tree-visualize-undo (&optional arg)
3433 "Undo changes. A numeric ARG serves as a repeat count."
3435 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3436 (inhibit-read-only t))
3437 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3438 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3441 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo arg))
3442 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3443 (let ((inhibit-read-only t))
3444 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3445 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3448 (defun undo-tree-visualize-redo (&optional arg)
3449 "Redo changes. A numeric ARG serves as a repeat count."
3451 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
3452 (inhibit-read-only t))
3453 (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
3454 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3457 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo arg))
3458 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3459 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3460 (let ((inhibit-read-only t))
3461 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))
3462 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff))))
3465 (defun undo-tree-visualize-switch-branch-right (arg)
3466 "Switch to next branch of the undo tree.
3467 This will affect which branch to descend when *redoing* changes
3468 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3470 ;; un-highlight old active branch below current node
3471 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3472 (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
3473 (inhibit-read-only t))
3474 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3476 (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
3477 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
3479 ((>= (+ branch arg) (undo-tree-num-branches))
3480 (1- (undo-tree-num-branches)))
3481 ((<= (+ branch arg) 0) 0)
3482 (t (+ branch arg))))
3483 (let ((inhibit-read-only t))
3484 ;; highlight new active branch below current node
3485 (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
3486 (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
3487 (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
3488 ;; re-highlight current node
3489 (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
3492 (defun undo-tree-visualize-switch-branch-left (arg)
3493 "Switch to previous branch of the undo tree.
3494 This will affect which branch to descend when *redoing* changes
3495 using `undo-tree-redo' or `undo-tree-visualizer-redo'."
3497 (undo-tree-visualize-switch-branch-right (- arg)))
3500 (defun undo-tree-visualizer-quit ()
3501 "Quit the undo-tree visualizer."
3503 (undo-tree-clear-visualizer-data buffer-undo-tree)
3504 ;; remove kill visualizer hook from parent buffer
3506 (with-current-buffer undo-tree-visualizer-parent-buffer
3507 (remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
3508 ;; kill diff buffer, if any
3509 (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
3510 (let ((parent undo-tree-visualizer-parent-buffer)
3512 ;; kill visualizer buffer
3514 ;; switch back to parent buffer
3516 (if (setq window (get-buffer-window parent))
3517 (select-window window)
3518 (switch-to-buffer parent))))))
3521 (defun undo-tree-visualizer-abort ()
3522 "Quit the undo-tree visualizer and return buffer to original state."
3524 (let ((node undo-tree-visualizer-initial-node))
3525 (undo-tree-visualizer-quit)
3526 (undo-tree-set node)))
3529 (defun undo-tree-visualizer-set (&optional pos)
3530 "Set buffer to state corresponding to undo tree node
3531 at POS, or point if POS is nil."
3533 (unless pos (setq pos (point)))
3534 (let ((node (get-text-property pos 'undo-tree-node)))
3536 ;; set parent buffer to state corresponding to node at POS
3537 (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
3538 (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
3539 (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
3540 ;; re-draw undo tree
3541 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
3542 (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
3545 (defun undo-tree-visualizer-mouse-set (pos)
3546 "Set buffer to state corresponding to undo tree node
3547 at mouse event POS."
3549 (undo-tree-visualizer-set (event-start (nth 1 pos))))
3552 (defun undo-tree-visualizer-toggle-timestamps ()
3553 "Toggle display of time-stamps."
3555 (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
3556 (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
3558 (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
3561 (defun undo-tree-visualizer-scroll-left (&optional arg)
3563 (scroll-right (or arg 1) t))
3566 (defun undo-tree-visualizer-scroll-right (&optional arg)
3568 (scroll-left (or arg 1) t))
3573 ;;; =====================================================================
3574 ;;; Visualizer selection mode
3576 (defun undo-tree-visualizer-selection-mode ()
3577 "Major mode used to select nodes in undo-tree visualizer."
3579 (setq major-mode 'undo-tree-visualizer-selection-mode)
3580 (setq mode-name "undo-tree-visualizer-selection-mode")
3581 (use-local-map undo-tree-visualizer-selection-map)
3582 (setq cursor-type 'box)
3583 (setq undo-tree-visualizer-selected-node
3584 (undo-tree-current buffer-undo-tree))
3585 ;; erase diff (if any), as initially selected node is identical to current
3586 (when undo-tree-visualizer-diff
3587 (let ((buff (get-buffer undo-tree-diff-buffer-name))
3588 (inhibit-read-only t))
3589 (when buff (with-current-buffer buff (erase-buffer))))))
3592 (defun undo-tree-visualizer-select-previous (&optional arg)
3593 "Move to previous node."
3595 (let ((node undo-tree-visualizer-selected-node))
3598 (unless (undo-tree-node-previous node) (throw 'top t))
3599 (setq node (undo-tree-node-previous node))))
3600 (goto-char (undo-tree-node-marker node))
3601 (when (and undo-tree-visualizer-diff
3602 (not (eq node undo-tree-visualizer-selected-node)))
3603 (undo-tree-visualizer-update-diff node))
3604 (setq undo-tree-visualizer-selected-node node)))
3607 (defun undo-tree-visualizer-select-next (&optional arg)
3608 "Move to next node."
3610 (let ((node undo-tree-visualizer-selected-node))
3613 (unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
3616 (nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
3617 (goto-char (undo-tree-node-marker node))
3618 (when (and undo-tree-visualizer-diff
3619 (not (eq node undo-tree-visualizer-selected-node)))
3620 (undo-tree-visualizer-update-diff node))
3621 (setq undo-tree-visualizer-selected-node node)))
3624 (defun undo-tree-visualizer-select-right (&optional arg)
3625 "Move right to a sibling node."
3627 (let ((node undo-tree-visualizer-selected-node)
3629 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3630 (setq end (line-end-position))
3633 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3635 (setq node (get-text-property (point) 'undo-tree-node))
3636 (when (= (point) end) (throw 'end t)))))
3637 (goto-char (undo-tree-node-marker
3638 (or node undo-tree-visualizer-selected-node)))
3639 (when (and undo-tree-visualizer-diff node
3640 (not (eq node undo-tree-visualizer-selected-node)))
3641 (undo-tree-visualizer-update-diff node))
3642 (setq undo-tree-visualizer-selected-node node)))
3645 (defun undo-tree-visualizer-select-left (&optional arg)
3646 "Move left to a sibling node."
3648 (let ((node (get-text-property (point) 'undo-tree-node))
3650 (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
3651 (setq beg (line-beginning-position))
3654 (while (or (null node) (eq node undo-tree-visualizer-selected-node))
3656 (setq node (get-text-property (point) 'undo-tree-node))
3657 (when (= (point) beg) (throw 'beg t)))))
3658 (goto-char (undo-tree-node-marker
3659 (or node undo-tree-visualizer-selected-node)))
3660 (when (and undo-tree-visualizer-diff node
3661 (not (eq node undo-tree-visualizer-selected-node)))
3662 (undo-tree-visualizer-update-diff node))
3663 (setq undo-tree-visualizer-selected-node node)))
3667 ;;; =====================================================================
3668 ;;; Visualizer diff display
3670 (defun undo-tree-visualizer-toggle-diff ()
3671 "Toggle diff display in undo-tree visualizer."
3673 (if undo-tree-visualizer-diff
3674 (undo-tree-visualizer-hide-diff)
3675 (undo-tree-visualizer-show-diff)))
3678 (defun undo-tree-visualizer-selection-toggle-diff ()
3679 "Toggle diff display in undo-tree visualizer selection mode."
3681 (if undo-tree-visualizer-diff
3682 (undo-tree-visualizer-hide-diff)
3683 (let ((node (get-text-property (point) 'undo-tree-node)))
3684 (when node (undo-tree-visualizer-show-diff node)))))
3687 (defun undo-tree-visualizer-show-diff (&optional node)
3688 ;; show visualizer diff display
3689 (setq undo-tree-visualizer-diff t)
3690 (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
3691 (undo-tree-diff node)))
3692 (display-buffer-mark-dedicated 'soft)
3694 (setq win (split-window))
3695 (set-window-buffer win buff)
3696 (shrink-window-if-larger-than-buffer win)))
3699 (defun undo-tree-visualizer-hide-diff ()
3700 ;; hide visualizer diff display
3701 (setq undo-tree-visualizer-diff nil)
3702 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3703 (when win (with-selected-window win (kill-buffer-and-window)))))
3706 (defun undo-tree-diff (&optional node)
3707 ;; Create diff between current state and NODE (or previous state, if NODE is
3708 ;; null). Returns buffer containing diff.
3711 (let ((undo-tree-inhibit-kill-visualizer t)
3712 (current (undo-tree-current buffer-undo-tree)))
3713 (undo-tree-set (or node (undo-tree-node-previous current) current)
3714 'preserve-timestamps)
3715 (setq tmpfile (diff-file-local-copy (current-buffer)))
3716 (undo-tree-set current 'preserve-timestamps))
3717 (setq buff (diff-no-select
3718 (current-buffer) tmpfile nil 'noasync
3719 (get-buffer-create undo-tree-diff-buffer-name)))
3720 ;; delete process messages and useless headers from diff buffer
3721 (with-current-buffer buff
3722 (goto-char (point-min))
3723 (delete-region (point) (1+ (line-end-position 3)))
3724 (goto-char (point-max))
3726 (delete-region (point) (point-max))
3727 (setq cursor-type nil)
3728 (setq buffer-read-only t))
3732 (defun undo-tree-visualizer-update-diff (&optional node)
3733 ;; update visualizer diff display to show diff between current state and
3734 ;; NODE (or previous state, if NODE is null)
3735 (with-current-buffer undo-tree-visualizer-parent-buffer
3736 (undo-tree-diff node))
3737 (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
3740 (shrink-window-if-larger-than-buffer win))))
3744 (provide 'undo-tree)
3746 ;;; undo-tree.el ends here