.emacs.d.git - Gitblit

Chizi123

2018-11-17 c4001ccd1864293b64aa37d83a9d9457eb875e70

commit \| author \| age
5cb5f7	1	;;; undo-tree.el --- Treat undo history as a tree -- lexical-binding: t; --
C	2
	3	;; Copyright (C) 2009-2013 Free Software Foundation, Inc
	4
	5	;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
	6	;; Version: 0.6.5
	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
	10
	11	;; This file is part of Emacs.
	12	;;
	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)
	16	;; any later version.
	17	;;
	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
	21	;; more details.
	22	;;
	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/>.
	25
	26
	27	;;; Commentary:
	28	;;
	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.
	35	;;
	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.
	45	;;
	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!
	49	;;
	50	;;
	51	;; Installation
	52	;; ============
	53	;;
	54	;; This package has only been tested with Emacs versions 24 and CVS. It should
	55	;; work in Emacs versions 22 and 23 too, but will not work without
	56	;; modifications in earlier versions of Emacs.
	57	;;
	58	;; To install `undo-tree-mode', make sure this file is saved in a directory in
	59	;; your `load-path', and add the line:
	60	;;
	61	;; (require 'undo-tree)
	62	;;
	63	;; to your .emacs file. Byte-compiling undo-tree.el is recommended (e.g. using
	64	;; "M-x byte-compile-file" from within emacs).
	65	;;
	66	;; If you want to replace the standard Emacs' undo system with the
	67	;; `undo-tree-mode' system in all buffers, you can enable it globally by
	68	;; adding:
	69	;;
	70	;; (global-undo-tree-mode)
	71	;;
	72	;; to your .emacs file.
	73	;;
	74	;;
	75	;; Quick-Start
	76	;; ===========
	77	;;
	78	;; If you're the kind of person who likes to jump in the car and drive,
	79	;; without bothering to first figure out whether the button on the left dips
	80	;; the headlights or operates the ejector seat (after all, you'll soon figure
	81	;; it out when you push it), then here's the minimum you need to know:
	82	;;
	83	;; `undo-tree-mode' and `global-undo-tree-mode'
	84	;; Enable undo-tree mode (either in the current buffer or globally).
	85	;;
	86	;; C-_ C-/ (`undo-tree-undo')
	87	;; Undo changes.
	88	;;
	89	;; M-_ C-? (`undo-tree-redo')
	90	;; Redo changes.
	91	;;
	92	;; `undo-tree-switch-branch'
	93	;; Switch undo-tree branch.
	94	;; (What does this mean? Better press the button and see!)
	95	;;
	96	;; C-x u (`undo-tree-visualize')
	97	;; Visualize the undo tree.
	98	;; (Better try pressing this button too!)
	99	;;
	100	;; C-x r u (`undo-tree-save-state-to-register')
	101	;; Save current buffer state to register.
	102	;;
	103	;; C-x r U (`undo-tree-restore-state-from-register')
	104	;; Restore buffer state from register.
	105	;;
	106	;;
	107	;;
	108	;; In the undo-tree visualizer:
	109	;;
	110	;; <up> p C-p (`undo-tree-visualize-undo')
	111	;; Undo changes.
	112	;;
	113	;; <down> n C-n (`undo-tree-visualize-redo')
	114	;; Redo changes.
	115	;;
	116	;; <left> b C-b (`undo-tree-visualize-switch-branch-left')
	117	;; Switch to previous undo-tree branch.
	118	;;
	119	;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
	120	;; Switch to next undo-tree branch.
	121	;;
	122	;; C-<up> M-{ (`undo-tree-visualize-undo-to-x')
	123	;; Undo changes up to last branch point.
	124	;;
	125	;; C-<down> M-} (`undo-tree-visualize-redo-to-x')
	126	;; Redo changes down to next branch point.
	127	;;
	128	;; <down> n C-n (`undo-tree-visualize-redo')
	129	;; Redo changes.
	130	;;
	131	;; <mouse-1> (`undo-tree-visualizer-mouse-set')
	132	;; Set state to node at mouse click.
	133	;;
	134	;; t (`undo-tree-visualizer-toggle-timestamps')
	135	;; Toggle display of time-stamps.
	136	;;
	137	;; d (`undo-tree-visualizer-toggle-diff')
	138	;; Toggle diff display.
	139	;;
	140	;; s (`undo-tree-visualizer-selection-mode')
	141	;; Toggle keyboard selection mode.
	142	;;
	143	;; q (`undo-tree-visualizer-quit')
	144	;; Quit undo-tree-visualizer.
	145	;;
	146	;; C-q (`undo-tree-visualizer-abort')
	147	;; Abort undo-tree-visualizer.
	148	;;
	149	;; , <
	150	;; Scroll left.
	151	;;
	152	;; . >
	153	;; Scroll right.
	154	;;
	155	;; <pgup> M-v
	156	;; Scroll up.
	157	;;
	158	;; <pgdown> C-v
	159	;; Scroll down.
	160	;;
	161	;;
	162	;;
	163	;; In visualizer selection mode:
	164	;;
	165	;; <up> p C-p (`undo-tree-visualizer-select-previous')
	166	;; Select previous node.
	167	;;
	168	;; <down> n C-n (`undo-tree-visualizer-select-next')
	169	;; Select next node.
	170	;;
	171	;; <left> b C-b (`undo-tree-visualizer-select-left')
	172	;; Select left sibling node.
	173	;;
	174	;; <right> f C-f (`undo-tree-visualizer-select-right')
	175	;; Select right sibling node.
	176	;;
	177	;; <pgup> M-v
	178	;; Select node 10 above.
	179	;;
	180	;; <pgdown> C-v
	181	;; Select node 10 below.
	182	;;
	183	;; <enter> (`undo-tree-visualizer-set')
	184	;; Set state to selected node and exit selection mode.
	185	;;
	186	;; s (`undo-tree-visualizer-mode')
	187	;; Exit selection mode.
	188	;;
	189	;; t (`undo-tree-visualizer-toggle-timestamps')
	190	;; Toggle display of time-stamps.
	191	;;
	192	;; d (`undo-tree-visualizer-toggle-diff')
	193	;; Toggle diff display.
	194	;;
	195	;; q (`undo-tree-visualizer-quit')
	196	;; Quit undo-tree-visualizer.
	197	;;
	198	;; C-q (`undo-tree-visualizer-abort')
	199	;; Abort undo-tree-visualizer.
	200	;;
	201	;; , <
	202	;; Scroll left.
	203	;;
	204	;; . >
	205	;; Scroll right.
	206	;;
	207	;;
	208	;;
	209	;; Persistent undo history:
	210	;;
	211	;; Note: Requires Emacs version 24.3 or higher.
	212	;;
	213	;; `undo-tree-auto-save-history' (variable)
	214	;; automatically save and restore undo-tree history along with buffer
	215	;; (disabled by default)
	216	;;
	217	;; `undo-tree-save-history' (command)
	218	;; manually save undo history to file
	219	;;
	220	;; `undo-tree-load-history' (command)
	221	;; manually load undo history from file
	222	;;
	223	;;
	224	;;
	225	;; Compressing undo history:
	226	;;
	227	;; Undo history files cannot grow beyond the maximum undo tree size, which
	228	;; is limited by `undo-limit', `undo-strong-limit' and
	229	;; `undo-outer-limit'. Nevertheless, undo history files can grow quite
	230	;; large. If you want to automatically compress undo history, add the
	231	;; following advice to your .emacs file (replacing ".gz" with the filename
	232	;; extension of your favourite compression algorithm):
	233	;;
	234	;; (defadvice undo-tree-make-history-save-file-name
	235	;; (after undo-tree activate)
	236	;; (setq ad-return-value (concat ad-return-value ".gz")))
	237	;;
	238	;;
	239	;;
	240	;;
	241	;; Undo Systems
	242	;; ============
	243	;;
	244	;; To understand the different undo systems, it's easiest to consider an
	245	;; example. Imagine you make a few edits in a buffer. As you edit, you
	246	;; accumulate a history of changes, which we might visualize as a string of
	247	;; past buffer states, growing downwards:
	248	;;
	249	;; o (initial buffer state)
	250	;; \|
	251	;; \|
	252	;; o (first edit)
	253	;; \|
	254	;; \|
	255	;; o (second edit)
	256	;; \|
	257	;; \|
	258	;; x (current buffer state)
	259	;;
	260	;;
	261	;; Now imagine that you undo the last two changes. We can visualize this as
	262	;; rewinding the current state back two steps:
	263	;;
	264	;; o (initial buffer state)
	265	;; \|
	266	;; \|
	267	;; x (current buffer state)
	268	;; \|
	269	;; \|
	270	;; o
	271	;; \|
	272	;; \|
	273	;; o
	274	;;
	275	;;
	276	;; However, this isn't a good representation of what Emacs' undo system
	277	;; does. Instead, it treats the undos as new changes to the buffer, and adds
	278	;; them to the history:
	279	;;
	280	;; o (initial buffer state)
	281	;; \|
	282	;; \|
	283	;; o (first edit)
	284	;; \|
	285	;; \|
	286	;; o (second edit)
	287	;; \|
	288	;; \|
	289	;; x (buffer state before undo)
	290	;; \|
	291	;; \|
	292	;; o (first undo)
	293	;; \|
	294	;; \|
	295	;; x (second undo)
	296	;;
	297	;;
	298	;; Actually, since the buffer returns to a previous state after an undo,
	299	;; perhaps a better way to visualize it is to imagine the string of changes
	300	;; turning back on itself:
	301	;;
	302	;; (initial buffer state) o
	303	;; \|
	304	;; \|
	305	;; (first edit) o x (second undo)
	306	;; \| \|
	307	;; \| \|
	308	;; (second edit) o o (first undo)
	309	;; \| /
	310	;; \|/
	311	;; o (buffer state before undo)
	312	;;
	313	;; Treating undos as new changes might seem a strange thing to do. But the
	314	;; advantage becomes clear as soon as we imagine what happens when you edit
	315	;; the buffer again. Since you've undone a couple of changes, new edits will
	316	;; branch off from the buffer state that you've rewound to. Conceptually, it
	317	;; looks like this:
	318	;;
	319	;; o (initial buffer state)
	320	;; \|
	321	;; \|
	322	;; o
	323	;; \|\
	324	;; \| \
	325	;; o x (new edit)
	326	;; \|
	327	;; \|
	328	;; o
	329	;;
	330	;; The standard undo/redo system only lets you go backwards and forwards
	331	;; linearly. So as soon as you make that new edit, it discards the old
	332	;; branch. Emacs' undo just keeps adding changes to the end of the string. So
	333	;; the undo history in the two systems now looks like this:
	334	;;
	335	;; Undo/Redo: Emacs' undo
	336	;;
	337	;; o o
	338	;; \| \|
	339	;; \| \|
	340	;; o o o
	341	;; .\ \| \|\
	342	;; . \ \| \| \
	343	;; . x (new edit) o o \|
	344	;; (discarded . \| / \|
	345	;; branch) . \|/ \|
	346	;; . o \|
	347	;; \|
	348	;; \|
	349	;; x (new edit)
	350	;;
	351	;; Now, what if you change your mind about those undos, and decide you did
	352	;; like those other changes you'd made after all? With the standard undo/redo
	353	;; system, you're lost. There's no way to recover them, because that branch
	354	;; was discarded when you made the new edit.
	355	;;
	356	;; However, in Emacs' undo system, those old buffer states are still there in
	357	;; the undo history. You just have to rewind back through the new edit, and
	358	;; back through the changes made by the undos, until you reach them. Of
	359	;; course, since Emacs treats undos (even undos of undos!) as new changes,
	360	;; you're really weaving backwards and forwards through the history, all the
	361	;; time adding new changes to the end of the string as you go:
	362	;;
	363	;; o
	364	;; \|
	365	;; \|
	366	;; o o o (undo new edit)
	367	;; \| \|\ \|\
	368	;; \| \| \ \| \
	369	;; o o \| \| o (undo the undo)
	370	;; \| / \| \| \|
	371	;; \|/ \| \| \|
	372	;; (trying to get o \| \| x (undo the undo)
	373	;; to this state) \| /
	374	;; \|/
	375	;; o
	376	;;
	377	;; So far, this is still reasonably intuitive to use. It doesn't behave so
	378	;; differently to standard undo/redo, except that by going back far enough you
	379	;; can access changes that would be lost in standard undo/redo.
	380	;;
	381	;; However, imagine that after undoing as just described, you decide you
	382	;; actually want to rewind right back to the initial state. If you're lucky,
	383	;; and haven't invoked any command since the last undo, you can just keep on
	384	;; undoing until you get back to the start:
	385	;;
	386	;; (trying to get o x (got there!)
	387	;; to this state) \| \|
	388	;; \| \|
	389	;; o o o o (keep undoing)
	390	;; \| \|\ \|\ \|
	391	;; \| \| \ \| \ \|
	392	;; o o \| \| o o (keep undoing)
	393	;; \| / \| \| \| /
	394	;; \|/ \| \| \|/
	395	;; (already undid o \| \| o (got this far)
	396	;; to this state) \| /
	397	;; \|/
	398	;; o
	399	;;
	400	;; But if you're unlucky, and you happen to have moved the point (say) after
	401	;; getting to the state labelled "got this far", then you've "broken the undo
	402	;; chain". Hold on to something solid, because things are about to get
	403	;; hairy. If you try to undo now, Emacs thinks you're trying to undo the
	404	;; undos! So to get back to the initial state you now have to rewind through
	405	;; all the changes, including the undos you just did:
	406	;;
	407	;; (trying to get o x (finally got there!)
	408	;; to this state) \| \|
	409	;; \| \|
	410	;; o o o o o o
	411	;; \| \|\ \|\ \|\ \|\ \|
	412	;; \| \| \ \| \ \| \ \| \ \|
	413	;; o o \| \| o o o \| o o
	414	;; \| / \| \| \| / \| \| \| /
	415	;; \|/ \| \| \|/ \| \| \|/
	416	;; (already undid o \| \| o<. \| \| o
	417	;; to this state) \| / : \| /
	418	;; \|/ : \|/
	419	;; o : o
	420	;; :
	421	;; (got this far, but
	422	;; broke the undo chain)
	423	;;
	424	;; Confused?
	425	;;
	426	;; In practice you can just hold down the undo key until you reach the buffer
	427	;; state that you want. But whatever you do, don't move around in the buffer
	428	;; to check that you've got back to where you want! Because you'll break the
	429	;; undo chain, and then you'll have to traverse the entire string of undos
	430	;; again, just to get back to the point at which you broke the
	431	;; chain. Undo-in-region and commands such as `undo-only' help to make using
	432	;; Emacs' undo a little easier, but nonetheless it remains confusing for many
	433	;; people.
	434	;;
	435	;;
	436	;; So what does `undo-tree-mode' do? Remember the diagram we drew to represent
	437	;; the history we've been discussing (make a few edits, undo a couple of them,
	438	;; and edit again)? The diagram that conceptually represented our undo
	439	;; history, before we started discussing specific undo systems? It looked like
	440	;; this:
	441	;;
	442	;; o (initial buffer state)
	443	;; \|
	444	;; \|
	445	;; o
	446	;; \|\
	447	;; \| \
	448	;; o x (current state)
	449	;; \|
	450	;; \|
	451	;; o
	452	;;
	453	;; Well, that's exactly what the undo history looks like to
	454	;; `undo-tree-mode'. It doesn't discard the old branch (as standard undo/redo
	455	;; does), nor does it treat undos as new changes to be added to the end of a
	456	;; linear string of buffer states (as Emacs' undo does). It just keeps track
	457	;; of the tree of branching changes that make up the entire undo history.
	458	;;
	459	;; If you undo from this point, you'll rewind back up the tree to the previous
	460	;; state:
	461	;;
	462	;; o
	463	;; \|
	464	;; \|
	465	;; x (undo)
	466	;; \|\
	467	;; \| \
	468	;; o o
	469	;; \|
	470	;; \|
	471	;; o
	472	;;
	473	;; If you were to undo again, you'd rewind back to the initial state. If on
	474	;; the other hand you redo the change, you'll end up back at the bottom of the
	475	;; most recent branch:
	476	;;
	477	;; o (undo takes you here)
	478	;; \|
	479	;; \|
	480	;; o (start here)
	481	;; \|\
	482	;; \| \
	483	;; o x (redo takes you here)
	484	;; \|
	485	;; \|
	486	;; o
	487	;;
	488	;; So far, this is just like the standard undo/redo system. But what if you
	489	;; want to return to a buffer state located on a previous branch of the
	490	;; history? Since `undo-tree-mode' keeps the entire history, you simply need
	491	;; to tell it to switch to a different branch, and then redo the changes you
	492	;; want:
	493	;;
	494	;; o
	495	;; \|
	496	;; \|
	497	;; o (start here, but switch
	498	;; \|\ to the other branch)
	499	;; \| \
	500	;; (redo) o o
	501	;; \|
	502	;; \|
	503	;; (redo) x
	504	;;
	505	;; Now you're on the other branch, if you undo and redo changes you'll stay on
	506	;; that branch, moving up and down through the buffer states located on that
	507	;; branch. Until you decide to switch branches again, of course.
	508	;;
	509	;; Real undo trees might have multiple branches and sub-branches:
	510	;;
	511	;; o
	512	;; ____\|______
	513	;; / \
	514	;; o o
	515	;; ____\|__ __\|
	516	;; / \| \ / \
	517	;; o o o o x
	518	;; \| \|
	519	;; / \ / \
	520	;; o o o o
	521	;;
	522	;; Trying to imagine what Emacs' undo would do as you move about such a tree
	523	;; will likely frazzle your brain circuits! But in `undo-tree-mode', you're
	524	;; just moving around this undo history tree. Most of the time, you'll
	525	;; probably only need to stay on the most recent branch, in which case it
	526	;; behaves like standard undo/redo, and is just as simple to understand. But
	527	;; if you ever need to recover a buffer state on a different branch, the
	528	;; possibility of switching between branches and accessing the full undo
	529	;; history is still there.
	530	;;
	531	;;
	532	;;
	533	;; The Undo-Tree Visualizer
	534	;; ========================
	535	;;
	536	;; Actually, it gets better. You don't have to imagine all these tree
	537	;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
	538	;; draws them for you! In fact, it draws even better diagrams: it highlights
	539	;; the node representing the current buffer state, it highlights the current
	540	;; branch, and you can toggle the display of time-stamps (by hitting "t") and
	541	;; a diff of the undo changes (by hitting "d"). (There's one other tiny
	542	;; difference: the visualizer puts the most recent branch on the left rather
	543	;; than the right.)
	544	;;
	545	;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
	546	;;
	547	;; In the visualizer, the usual keys for moving up and down a buffer instead
	548	;; move up and down the undo history tree (e.g. the up and down arrow keys, or
	549	;; "C-n" and "C-p"). The state of the "parent" buffer (the buffer whose undo
	550	;; history you are visualizing) is updated as you move around the undo tree in
	551	;; the visualizer. If you reach a branch point in the visualizer, the usual
	552	;; keys for moving forward and backward in a buffer instead switch branch
	553	;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
	554	;;
	555	;; Clicking with the mouse on any node in the visualizer will take you
	556	;; directly to that node, resetting the state of the parent buffer to the
	557	;; state represented by that node.
	558	;;
	559	;; You can also select nodes directly using the keyboard, by hitting "s" to
	560	;; toggle selection mode. The usual motion keys now allow you to move around
	561	;; the tree without changing the parent buffer. Hitting <enter> will reset the
	562	;; state of the parent buffer to the state represented by the currently
	563	;; selected node.
	564	;;
	565	;; It can be useful to see how long ago the parent buffer was in the state
	566	;; represented by a particular node in the visualizer. Hitting "t" in the
	567	;; visualizer toggles the display of time-stamps for all the nodes. (Note
	568	;; that, because of the way `undo-tree-mode' works, these time-stamps may be
	569	;; somewhat later than the true times, especially if it's been a long time
	570	;; since you last undid any changes.)
	571	;;
	572	;; To get some idea of what changes are represented by a given node in the
	573	;; tree, it can be useful to see a diff of the changes. Hit "d" in the
	574	;; visualizer to toggle a diff display. This normally displays a diff between
	575	;; the current state and the previous one, i.e. it shows you the changes that
	576	;; will be applied if you undo (move up the tree). However, the diff display
	577	;; really comes into its own in the visualizer's selection mode (see above),
	578	;; where it instead shows a diff between the current state and the currently
	579	;; selected state, i.e. it shows you the changes that will be applied if you
	580	;; reset to the selected state.
	581	;;
	582	;; (Note that the diff is generated by the Emacs `diff' command, and is
	583	;; displayed using `diff-mode'. See the corresponding customization groups if
	584	;; you want to customize the diff display.)
	585	;;
	586	;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
	587	;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
	588	;; returning the parent buffer to whatever state it was originally in when the
	589	;; visualizer was .
	590	;;
	591	;;
	592	;;
	593	;; Undo-in-Region
	594	;; ==============
	595	;;
	596	;; Emacs allows a very useful and powerful method of undoing only selected
	597	;; changes: when a region is active, only changes that affect the text within
	598	;; that region will be undone. With the standard Emacs undo system, changes
	599	;; produced by undoing-in-region naturally get added onto the end of the
	600	;; linear undo history:
	601	;;
	602	;; o
	603	;; \|
	604	;; \| x (second undo-in-region)
	605	;; o \|
	606	;; \| \|
	607	;; \| o (first undo-in-region)
	608	;; o \|
	609	;; \| /
	610	;; \|/
	611	;; o
	612	;;
	613	;; You can of course redo these undos-in-region as usual, by undoing the
	614	;; undos:
	615	;;
	616	;; o
	617	;; \|
	618	;; \| o_
	619	;; o \| \
	620	;; \| \| \|
	621	;; \| o o (undo the undo-in-region)
	622	;; o \| \|
	623	;; \| / \|
	624	;; \|/ \|
	625	;; o x (undo the undo-in-region)
	626	;;
	627	;;
	628	;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
	629	;; region, undoing only undoes changes that affect that region. However, the
	630	;; way these undos-in-region are recorded in the undo history is quite
	631	;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
	632	;; undo history. The new branch consists of an undo step that undoes some of
	633	;; the changes that affect the current region, and another step that undoes
	634	;; the remaining changes needed to rejoin the previous undo history.
	635	;;
	636	;; Previous undo history Undo-in-region
	637	;;
	638	;; o o
	639	;; \| \|
	640	;; \| \|
	641	;; o o
	642	;; \| \|\
	643	;; \| \| \
	644	;; o o x (undo-in-region)
	645	;; \| \| \|
	646	;; \| \| \|
	647	;; x o o
	648	;;
	649	;; As long as you don't change the active region after undoing-in-region,
	650	;; continuing to undo-in-region extends the new branch, pulling more changes
	651	;; that affect the current region into an undo step immediately above your
	652	;; current location in the undo tree, and pushing the point at which the new
	653	;; branch is attached further up the tree:
	654	;;
	655	;; First undo-in-region Second undo-in-region
	656	;;
	657	;; o o
	658	;; \| \|\
	659	;; \| \| \
	660	;; o o x (undo-in-region)
	661	;; \|\ \| \|
	662	;; \| \ \| \|
	663	;; o x o o
	664	;; \| \| \| \|
	665	;; \| \| \| \|
	666	;; o o o o
	667	;;
	668	;; Redoing takes you back down the undo tree, as usual (as long as you haven't
	669	;; changed the active region after undoing-in-region, it doesn't matter if it
	670	;; is still active):
	671	;;
	672	;; o
	673	;; \|\
	674	;; \| \
	675	;; o o
	676	;; \| \|
	677	;; \| \|
	678	;; o o (redo)
	679	;; \| \|
	680	;; \| \|
	681	;; o x (redo)
	682	;;
	683	;;
	684	;; What about redo-in-region? Obviously, this only makes sense if you have
	685	;; already undone some changes, so that there are some changes to redo!
	686	;; Redoing-in-region splits off a new branch of the undo history below your
	687	;; current location in the undo tree. This time, the new branch consists of a
	688	;; redo step that redoes some of the redo changes that affect the current
	689	;; region, followed by all the remaining redo changes.
	690	;;
	691	;; Previous undo history Redo-in-region
	692	;;
	693	;; o o
	694	;; \| \|
	695	;; \| \|
	696	;; x o
	697	;; \| \|\
	698	;; \| \| \
	699	;; o o x (redo-in-region)
	700	;; \| \| \|
	701	;; \| \| \|
	702	;; o o o
	703	;;
	704	;; As long as you don't change the active region after redoing-in-region,
	705	;; continuing to redo-in-region extends the new branch, pulling more redo
	706	;; changes into a redo step immediately below your current location in the
	707	;; undo tree.
	708	;;
	709	;; First redo-in-region Second redo-in-region
	710	;;
	711	;; o o
	712	;; \| \|
	713	;; \| \|
	714	;; o o
	715	;; \|\ \|\
	716	;; \| \ \| \
	717	;; o x (redo-in-region) o o
	718	;; \| \| \| \|
	719	;; \| \| \| \|
	720	;; o o o x (redo-in-region)
	721	;; \|
	722	;; \|
	723	;; o
	724	;;
	725	;; Note that undo-in-region and redo-in-region only ever add new changes to
	726	;; the undo tree, they never modify existing undo history. So you can always
	727	;; return to previous buffer states by switching to a previous branch of the
	728	;; tree.
	729
	730
	731
	732	;;; Code:
	733
	734	(eval-when-compile (require 'cl))
	735	(require 'diff)
	736
	737
	738
	739	;;; =====================================================================
	740	;;; Compatibility hacks for older Emacsen
	741
	742	;; `characterp' isn't defined in Emacs versions < 23
	743	(unless (fboundp 'characterp)
	744	(defalias 'characterp 'char-valid-p))
	745
	746	;; `region-active-p' isn't defined in Emacs versions < 23
	747	(unless (fboundp 'region-active-p)
	748	(defun region-active-p () (and transient-mark-mode mark-active)))
	749
	750
	751	;; `registerv' defstruct isn't defined in Emacs versions < 24
	752	(unless (fboundp 'registerv-make)
	753	(defmacro registerv-make (data &rest _dummy) data))
	754
	755	(unless (fboundp 'registerv-data)
	756	(defmacro registerv-data (data) data))
	757
	758
	759	;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
	760	;; versions < 24 (copied and adapted from Emacs 24)
	761	(unless (fboundp 'diff-no-select)
	762	(defun diff-no-select (old new &optional switches no-async buf)
	763	;; Noninteractive helper for creating and reverting diff buffers
	764	(unless (bufferp new) (setq new (expand-file-name new)))
	765	(unless (bufferp old) (setq old (expand-file-name old)))
	766	(or switches (setq switches diff-switches)) ; If not specified, use default.
	767	(unless (listp switches) (setq switches (list switches)))
	768	(or buf (setq buf (get-buffer-create "Diff")))
	769	(let* ((old-alt (diff-file-local-copy old))
	770	(new-alt (diff-file-local-copy new))
	771	(command
	772	(mapconcat 'identity
	773	`(,diff-command
	774	;; Use explicitly specified switches
	775	,@switches
	776	,@(mapcar #'shell-quote-argument
	777	(nconc
	778	(when (or old-alt new-alt)
	779	(list "-L" (if (stringp old)
	780	old (prin1-to-string old))
	781	"-L" (if (stringp new)
	782	new (prin1-to-string new))))
	783	(list (or old-alt old)
	784	(or new-alt new)))))
	785	" "))
	786	(thisdir default-directory))
	787	(with-current-buffer buf
	788	(setq buffer-read-only t)
	789	(buffer-disable-undo (current-buffer))
	790	(let ((inhibit-read-only t))
	791	(erase-buffer))
	792	(buffer-enable-undo (current-buffer))
	793	(diff-mode)
	794	(set (make-local-variable 'revert-buffer-function)
	795	(lambda (_ignore-auto _noconfirm)
	796	(diff-no-select old new switches no-async (current-buffer))))
	797	(setq default-directory thisdir)
	798	(let ((inhibit-read-only t))
	799	(insert command "\n"))
	800	(if (and (not no-async) (fboundp 'start-process))
	801	(let ((proc (start-process "Diff" buf shell-file-name
	802	shell-command-switch command)))
	803	(set-process-filter proc 'diff-process-filter)
	804	(set-process-sentinel
	805	proc (lambda (proc _msg)
	806	(with-current-buffer (process-buffer proc)
	807	(diff-sentinel (process-exit-status proc))
	808	(if old-alt (delete-file old-alt))
	809	(if new-alt (delete-file new-alt))))))
	810	;; Async processes aren't available.
	811	(let ((inhibit-read-only t))
	812	(diff-sentinel
	813	(call-process shell-file-name nil buf nil
	814	shell-command-switch command))
	815	(if old-alt (delete-file old-alt))
	816	(if new-alt (delete-file new-alt)))))
	817	buf)))
	818
	819	(unless (fboundp 'diff-file-local-copy)
	820	(defun diff-file-local-copy (file-or-buf)
	821	(if (bufferp file-or-buf)
	822	(with-current-buffer file-or-buf
	823	(let ((tempfile (make-temp-file "buffer-content-")))
	824	(write-region nil nil tempfile nil 'nomessage)
	825	tempfile))
	826	(file-local-copy file-or-buf))))
	827
	828
	829	;; `user-error' isn't defined in Emacs < 24.3
	830	(unless (fboundp 'user-error)
	831	(defalias 'user-error 'error)
	832	;; prevent debugger being called on user errors
	833	(add-to-list 'debug-ignored-errors "^No further undo information")
	834	(add-to-list 'debug-ignored-errors "^No further redo information")
	835	(add-to-list 'debug-ignored-errors "^No further redo information for region"))
	836
	837
	838
	839
	840
	841	;;; =====================================================================
	842	;;; Global variables and customization options
	843
	844	(defvar buffer-undo-tree nil
	845	"Tree of undo entries in current buffer.")
	846	(put 'buffer-undo-tree 'permanent-local t)
	847	(make-variable-buffer-local 'buffer-undo-tree)
	848
	849
	850	(defgroup undo-tree nil
	851	"Tree undo/redo."
	852	:group 'undo)
	853
	854	(defcustom undo-tree-mode-lighter " Undo-Tree"
	855	"Lighter displayed in mode line
	856	when `undo-tree-mode' is enabled."
	857	:group 'undo-tree
	858	:type 'string)
	859
	860
	861	(defcustom undo-tree-incompatible-major-modes '(term-mode)
	862	"List of major-modes in which `undo-tree-mode' should not be enabled.
	863	\(See `turn-on-undo-tree-mode'.\)"
	864	:group 'undo-tree
	865	:type '(repeat symbol))
	866
	867
	868	(defcustom undo-tree-enable-undo-in-region t
	869	"When non-nil, enable undo-in-region.
	870
	871	When undo-in-region is enabled, undoing or redoing when the
	872	region is active (in `transient-mark-mode') or with a prefix
	873	argument (not in `transient-mark-mode') only undoes changes
	874	within the current region."
	875	:group 'undo-tree
	876	:type 'boolean)
	877
	878
	879	(defcustom undo-tree-auto-save-history nil
	880	"When non-nil, `undo-tree-mode' will save undo history to file
	881	when a buffer is saved to file.
	882
	883	It will automatically load undo history when a buffer is loaded
	884	from file, if an undo save file exists.
	885
	886	By default, undo-tree history is saved to a file called
	887	\".<buffer-file-name>.~undo-tree~\" in the same directory as the
	888	file itself. To save under a different directory, customize
	889	`undo-tree-history-directory-alist' (see the documentation for
	890	that variable for details).
	891
	892	WARNING! `undo-tree-auto-save-history' will not work properly in
	893	Emacs versions prior to 24.3, so it cannot be enabled via
	894	the customization interface in versions earlier than that one. To
	895	ignore this warning and enable it regardless, set
	896	`undo-tree-auto-save-history' to a non-nil value outside of
	897	customize."
	898	:group 'undo-tree
	899	:type (if (version-list-< (version-to-list emacs-version) '(24 3))
	900	'(choice (const :tag "<disabled>" nil))
	901	'boolean))
	902
	903
	904	(defcustom undo-tree-history-directory-alist nil
	905	"Alist of filename patterns and undo history directory names.
	906	Each element looks like (REGEXP . DIRECTORY). Undo history for
	907	files with names matching REGEXP will be saved in DIRECTORY.
	908	DIRECTORY may be relative or absolute. If it is absolute, so
	909	that all matching files are backed up into the same directory,
	910	the file names in this directory will be the full name of the
	911	file backed up with all directory separators changed to `!' to
	912	prevent clashes. This will not work correctly if your filesystem
	913	truncates the resulting name.
	914
	915	For the common case of all backups going into one directory, the
	916	alist should contain a single element pairing \".\" with the
	917	appropriate directory name.
	918
	919	If this variable is nil, or it fails to match a filename, the
	920	backup is made in the original file's directory.
	921
	922	On MS-DOS filesystems without long names this variable is always
	923	ignored."
	924	:group 'undo-tree
	925	:type '(repeat (cons (regexp :tag "Regexp matching filename")
	926	(directory :tag "Undo history directory name"))))
	927
	928
	929
	930	(defcustom undo-tree-visualizer-relative-timestamps t
	931	"When non-nil, display times relative to current time
	932	when displaying time stamps in visualizer.
	933
	934	Otherwise, display absolute times."
	935	:group 'undo-tree
	936	:type 'boolean)
	937
	938
	939	(defcustom undo-tree-visualizer-timestamps nil
	940	"When non-nil, display time-stamps by default
	941	in undo-tree visualizer.
	942
	943	\\<undo-tree-visualizer-mode-map>You can always toggle time-stamps on and off \
	944	using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
	945	setting of this variable."
	946	:group 'undo-tree
	947	:type 'boolean)
	948
	949
	950	(defcustom undo-tree-visualizer-diff nil
	951	"When non-nil, display diff by default in undo-tree visualizer.
	952
	953	\\<undo-tree-visualizer-mode-map>You can always toggle the diff display \
	954	using \\[undo-tree-visualizer-toggle-diff], regardless of the
	955	setting of this variable."
	956	:group 'undo-tree
	957	:type 'boolean)
	958
	959
	960	(defcustom undo-tree-visualizer-lazy-drawing 100
	961	"When non-nil, use lazy undo-tree drawing in visualizer.
	962
	963	Setting this to a number causes the visualizer to switch to lazy
	964	drawing when the number of nodes in the tree is larger than this
	965	value.
	966
	967	Lazy drawing means that only the visible portion of the tree will
	968	be drawn initially, and the tree will be extended later as
	969	needed. For the most part, the only visible effect of this is to
	970	significantly speed up displaying the visualizer for very large
	971	trees.
	972
	973	There is one potential negative effect of lazy drawing. Other
	974	branches of the tree will only be drawn once the node from which
	975	they branch off becomes visible. So it can happen that certain
	976	portions of the tree that would be shown with lazy drawing
	977	disabled, will not be drawn immediately when it is
	978	enabled. However, this effect is quite rare in practice."
	979	:group 'undo-tree
	980	:type '(choice (const :tag "never" nil)
	981	(const :tag "always" t)
	982	(integer :tag "> size")))
	983
	984
	985	(defface undo-tree-visualizer-default-face
	986	'((((class color)) :foreground "gray"))
	987	"Face used to draw undo-tree in visualizer."
	988	:group 'undo-tree)
	989
	990	(defface undo-tree-visualizer-current-face
	991	'((((class color)) :foreground "red"))
	992	"Face used to highlight current undo-tree node in visualizer."
	993	:group 'undo-tree)
	994
	995	(defface undo-tree-visualizer-active-branch-face
	996	'((((class color) (background dark))
	997	(:foreground "white" :weight bold))
	998	(((class color) (background light))
	999	(:foreground "black" :weight bold)))
	1000	"Face used to highlight active undo-tree branch in visualizer."
	1001	:group 'undo-tree)
	1002
	1003	(defface undo-tree-visualizer-register-face
	1004	'((((class color)) :foreground "yellow"))
	1005	"Face used to highlight undo-tree nodes saved to a register
	1006	in visualizer."
	1007	:group 'undo-tree)
	1008
	1009	(defface undo-tree-visualizer-unmodified-face
	1010	'((((class color)) :foreground "cyan"))
	1011	"Face used to highlight nodes corresponding to unmodified buffers
	1012	in visualizer."
	1013	:group 'undo-tree)
	1014
	1015
	1016	(defvar undo-tree-visualizer-parent-buffer nil
	1017	"Parent buffer in visualizer.")
	1018	(put 'undo-tree-visualizer-parent-buffer 'permanent-local t)
	1019	(make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
	1020
	1021	;; stores modification time of parent buffer's file, if any
	1022	(defvar undo-tree-visualizer-parent-mtime nil)
	1023	(put 'undo-tree-visualizer-parent-mtime 'permanent-local t)
	1024	(make-variable-buffer-local 'undo-tree-visualizer-parent-mtime)
	1025
	1026	;; stores current horizontal spacing needed for drawing undo-tree
	1027	(defvar undo-tree-visualizer-spacing nil)
	1028	(put 'undo-tree-visualizer-spacing 'permanent-local t)
	1029	(make-variable-buffer-local 'undo-tree-visualizer-spacing)
	1030
	1031	;; calculate horizontal spacing required for drawing tree with current
	1032	;; settings
	1033	(defsubst undo-tree-visualizer-calculate-spacing ()
	1034	(if undo-tree-visualizer-timestamps
	1035	(if undo-tree-visualizer-relative-timestamps 9 13)
	1036	3))
	1037
	1038	;; holds node that was current when visualizer was invoked
	1039	(defvar undo-tree-visualizer-initial-node nil)
	1040	(put 'undo-tree-visualizer-initial-node 'permanent-local t)
	1041	(make-variable-buffer-local 'undo-tree-visualizer-initial-node)
	1042
	1043	;; holds currently selected node in visualizer selection mode
	1044	(defvar undo-tree-visualizer-selected-node nil)
	1045	(put 'undo-tree-visualizer-selected-node 'permanent-local t)
	1046	(make-variable-buffer-local 'undo-tree-visualizer-selected)
	1047
	1048	;; used to store nodes at edge of currently drawn portion of tree
	1049	(defvar undo-tree-visualizer-needs-extending-down nil)
	1050	(put 'undo-tree-visualizer-needs-extending-down 'permanent-local t)
	1051	(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-down)
	1052	(defvar undo-tree-visualizer-needs-extending-up nil)
	1053	(put 'undo-tree-visualizer-needs-extending-up 'permanent-local t)
	1054	(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-up)
	1055
	1056	;; dynamically bound to t when undoing from visualizer, to inhibit
	1057	;; `undo-tree-kill-visualizer' hook function in parent buffer
	1058	(defvar undo-tree-inhibit-kill-visualizer nil)
	1059
	1060	;; can be let-bound to a face name, used in drawing functions
	1061	(defvar undo-tree-insert-face nil)
	1062
	1063	;; visualizer buffer names
	1064	(defconst undo-tree-visualizer-buffer-name " undo-tree")
	1065	(defconst undo-tree-diff-buffer-name "undo-tree Diff")
	1066
	1067	;; install history-auto-save hooks
	1068	(add-hook 'write-file-functions 'undo-tree-save-history-hook)
	1069	(add-hook 'find-file-hook 'undo-tree-load-history-hook)
	1070
	1071
	1072
	1073
	1074	;;; =================================================================
	1075	;;; Default keymaps
	1076
	1077	(defvar undo-tree-map nil
	1078	"Keymap used in undo-tree-mode.")
	1079
	1080	(unless undo-tree-map
	1081	(let ((map (make-sparse-keymap)))
	1082	;; remap `undo' and `undo-only' to `undo-tree-undo'
	1083	(define-key map [remap undo] 'undo-tree-undo)
	1084	(define-key map [remap undo-only] 'undo-tree-undo)
	1085	;; bind standard undo bindings (since these match redo counterparts)
	1086	(define-key map (kbd "C-/") 'undo-tree-undo)
	1087	(define-key map "\C-_" 'undo-tree-undo)
	1088	;; redo doesn't exist normally, so define our own keybindings
	1089	(define-key map (kbd "C-?") 'undo-tree-redo)
	1090	(define-key map (kbd "M-_") 'undo-tree-redo)
	1091	;; just in case something has defined `redo'...
	1092	(define-key map [remap redo] 'undo-tree-redo)
	1093	;; we use "C-x u" for the undo-tree visualizer
	1094	(define-key map (kbd "\C-x u") 'undo-tree-visualize)
	1095	;; bind register commands
	1096	(define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
	1097	(define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
	1098	;; set keymap
	1099	(setq undo-tree-map map)))
	1100
	1101
	1102	(defvar undo-tree-visualizer-mode-map nil
	1103	"Keymap used in undo-tree visualizer.")
	1104
	1105	(unless undo-tree-visualizer-mode-map
	1106	(let ((map (make-sparse-keymap)))
	1107	;; vertical motion keys undo/redo
	1108	(define-key map [remap previous-line] 'undo-tree-visualize-undo)
	1109	(define-key map [remap next-line] 'undo-tree-visualize-redo)
	1110	(define-key map [up] 'undo-tree-visualize-undo)
	1111	(define-key map "p" 'undo-tree-visualize-undo)
	1112	(define-key map "\C-p" 'undo-tree-visualize-undo)
	1113	(define-key map [down] 'undo-tree-visualize-redo)
	1114	(define-key map "n" 'undo-tree-visualize-redo)
	1115	(define-key map "\C-n" 'undo-tree-visualize-redo)
	1116	;; horizontal motion keys switch branch
	1117	(define-key map [remap forward-char]
	1118	'undo-tree-visualize-switch-branch-right)
	1119	(define-key map [remap backward-char]
	1120	'undo-tree-visualize-switch-branch-left)
	1121	(define-key map [right] 'undo-tree-visualize-switch-branch-right)
	1122	(define-key map "f" 'undo-tree-visualize-switch-branch-right)
	1123	(define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
	1124	(define-key map [left] 'undo-tree-visualize-switch-branch-left)
	1125	(define-key map "b" 'undo-tree-visualize-switch-branch-left)
	1126	(define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
	1127	;; paragraph motion keys undo/redo to significant points in tree
	1128	(define-key map [remap backward-paragraph] 'undo-tree-visualize-undo-to-x)
	1129	(define-key map [remap forward-paragraph] 'undo-tree-visualize-redo-to-x)
	1130	(define-key map "\M-{" 'undo-tree-visualize-undo-to-x)
	1131	(define-key map "\M-}" 'undo-tree-visualize-redo-to-x)
	1132	(define-key map [C-up] 'undo-tree-visualize-undo-to-x)
	1133	(define-key map [C-down] 'undo-tree-visualize-redo-to-x)
	1134	;; mouse sets buffer state to node at click
	1135	(define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
	1136	;; toggle timestamps
	1137	(define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
	1138	;; toggle diff
	1139	(define-key map "d" 'undo-tree-visualizer-toggle-diff)
	1140	;; toggle selection mode
	1141	(define-key map "s" 'undo-tree-visualizer-selection-mode)
	1142	;; horizontal scrolling may be needed if the tree is very wide
	1143	(define-key map "," 'undo-tree-visualizer-scroll-left)
	1144	(define-key map "." 'undo-tree-visualizer-scroll-right)
	1145	(define-key map "<" 'undo-tree-visualizer-scroll-left)
	1146	(define-key map ">" 'undo-tree-visualizer-scroll-right)
	1147	;; vertical scrolling may be needed if the tree is very tall
	1148	(define-key map [next] 'undo-tree-visualizer-scroll-up)
	1149	(define-key map [prior] 'undo-tree-visualizer-scroll-down)
	1150	;; quit/abort visualizer
	1151	(define-key map "q" 'undo-tree-visualizer-quit)
	1152	(define-key map "\C-q" 'undo-tree-visualizer-abort)
	1153	;; set keymap
	1154	(setq undo-tree-visualizer-mode-map map)))
	1155
	1156
	1157	(defvar undo-tree-visualizer-selection-mode-map nil
	1158	"Keymap used in undo-tree visualizer selection mode.")
	1159
	1160	(unless undo-tree-visualizer-selection-mode-map
	1161	(let ((map (make-sparse-keymap)))
	1162	;; vertical motion keys move up and down tree
	1163	(define-key map [remap previous-line]
	1164	'undo-tree-visualizer-select-previous)
	1165	(define-key map [remap next-line]
	1166	'undo-tree-visualizer-select-next)
	1167	(define-key map [up] 'undo-tree-visualizer-select-previous)
	1168	(define-key map "p" 'undo-tree-visualizer-select-previous)
	1169	(define-key map "\C-p" 'undo-tree-visualizer-select-previous)
	1170	(define-key map [down] 'undo-tree-visualizer-select-next)
	1171	(define-key map "n" 'undo-tree-visualizer-select-next)
	1172	(define-key map "\C-n" 'undo-tree-visualizer-select-next)
	1173	;; vertical scroll keys move up and down quickly
	1174	(define-key map [next]
	1175	(lambda () (interactive) (undo-tree-visualizer-select-next 10)))
	1176	(define-key map [prior]
	1177	(lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
	1178	;; horizontal motion keys move to left and right siblings
	1179	(define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
	1180	(define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
	1181	(define-key map [right] 'undo-tree-visualizer-select-right)
	1182	(define-key map "f" 'undo-tree-visualizer-select-right)
	1183	(define-key map "\C-f" 'undo-tree-visualizer-select-right)
	1184	(define-key map [left] 'undo-tree-visualizer-select-left)
	1185	(define-key map "b" 'undo-tree-visualizer-select-left)
	1186	(define-key map "\C-b" 'undo-tree-visualizer-select-left)
	1187	;; horizontal scroll keys move left or right quickly
	1188	(define-key map ","
	1189	(lambda () (interactive) (undo-tree-visualizer-select-left 10)))
	1190	(define-key map "."
	1191	(lambda () (interactive) (undo-tree-visualizer-select-right 10)))
	1192	(define-key map "<"
	1193	(lambda () (interactive) (undo-tree-visualizer-select-left 10)))
	1194	(define-key map ">"
	1195	(lambda () (interactive) (undo-tree-visualizer-select-right 10)))
	1196	;; <enter> sets buffer state to node at point
	1197	(define-key map "\r" 'undo-tree-visualizer-set)
	1198	;; mouse selects node at click
	1199	(define-key map [mouse-1] 'undo-tree-visualizer-mouse-select)
	1200	;; toggle diff
	1201	(define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
	1202	;; set keymap
	1203	(setq undo-tree-visualizer-selection-mode-map map)))
	1204
	1205
	1206	(defvar undo-tree-old-undo-menu-item nil)
	1207
	1208	(defun undo-tree-update-menu-bar ()
	1209	"Update `undo-tree-mode' Edit menu items."
	1210	(if undo-tree-mode
	1211	(progn
	1212	;; save old undo menu item, and install undo/redo menu items
	1213	(setq undo-tree-old-undo-menu-item
	1214	(cdr (assq 'undo (lookup-key global-map [menu-bar edit]))))
	1215	(define-key (lookup-key global-map [menu-bar edit])
	1216	[undo] '(menu-item "Undo" undo-tree-undo
	1217	:enable (and undo-tree-mode
	1218	(not buffer-read-only)
	1219	(not (eq t buffer-undo-list))
	1220	(undo-tree-node-previous
	1221	(undo-tree-current buffer-undo-tree)))
	1222	:help "Undo last operation"))
	1223	(define-key-after (lookup-key global-map [menu-bar edit])
	1224	[redo] '(menu-item "Redo" undo-tree-redo
	1225	:enable (and undo-tree-mode
	1226	(not buffer-read-only)
	1227	(not (eq t buffer-undo-list))
	1228	(undo-tree-node-next
	1229	(undo-tree-current buffer-undo-tree)))
	1230	:help "Redo last operation")
	1231	'undo))
	1232	;; uninstall undo/redo menu items
	1233	(define-key (lookup-key global-map [menu-bar edit])
	1234	[undo] undo-tree-old-undo-menu-item)
	1235	(define-key (lookup-key global-map [menu-bar edit])
	1236	[redo] nil)))
	1237
	1238	(add-hook 'menu-bar-update-hook 'undo-tree-update-menu-bar)
	1239
	1240
	1241
	1242
	1243
	1244	;;; =====================================================================
	1245	;;; Undo-tree data structure
	1246
	1247	(defstruct
	1248	(undo-tree
	1249	:named
	1250	(:constructor nil)
	1251	(:constructor make-undo-tree
	1252	(&aux
	1253	(root (undo-tree-make-node nil nil))
	1254	(current root)
	1255	(size 0)
	1256	(count 0)
	1257	(object-pool (make-hash-table :test 'eq :weakness 'value))))
	1258	;;(:copier nil)
	1259	)
	1260	root current size count object-pool)
	1261
	1262
	1263
	1264	(defstruct
	1265	(undo-tree-node
	1266	(:type vector) ; create unnamed struct
	1267	(:constructor nil)
	1268	(:constructor undo-tree-make-node
	1269	(previous undo
	1270	&optional redo
	1271	&aux
	1272	(timestamp (current-time))
	1273	(branch 0)))
	1274	(:constructor undo-tree-make-node-backwards
	1275	(next-node undo
	1276	&optional redo
	1277	&aux
	1278	(next (list next-node))
	1279	(timestamp (current-time))
	1280	(branch 0)))
	1281	(:copier nil))
	1282	previous next undo redo timestamp branch meta-data)
	1283
	1284
	1285	(defmacro undo-tree-node-p (n)
	1286	(let ((len (length (undo-tree-make-node nil nil))))
	1287	`(and (vectorp ,n) (= (length ,n) ,len))))
	1288
	1289
	1290
	1291	(defstruct
	1292	(undo-tree-region-data
	1293	(:type vector) ; create unnamed struct
	1294	(:constructor nil)
	1295	(:constructor undo-tree-make-region-data
	1296	(&optional undo-beginning undo-end
	1297	redo-beginning redo-end))
	1298	(:constructor undo-tree-make-undo-region-data
	1299	(undo-beginning undo-end))
	1300	(:constructor undo-tree-make-redo-region-data
	1301	(redo-beginning redo-end))
	1302	(:copier nil))
	1303	undo-beginning undo-end redo-beginning redo-end)
	1304
	1305
	1306	(defmacro undo-tree-region-data-p (r)
	1307	(let ((len (length (undo-tree-make-region-data))))
	1308	`(and (vectorp ,r) (= (length ,r) ,len))))
	1309
	1310	(defmacro undo-tree-node-clear-region-data (node)
	1311	`(setf (undo-tree-node-meta-data ,node)
	1312	(delq nil
	1313	(delq :region
	1314	(plist-put (undo-tree-node-meta-data ,node)
	1315	:region nil)))))
	1316
	1317
	1318	(defmacro undo-tree-node-undo-beginning (node)
	1319	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1320	(when (undo-tree-region-data-p r)
	1321	(undo-tree-region-data-undo-beginning r))))
	1322
	1323	(defmacro undo-tree-node-undo-end (node)
	1324	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1325	(when (undo-tree-region-data-p r)
	1326	(undo-tree-region-data-undo-end r))))
	1327
	1328	(defmacro undo-tree-node-redo-beginning (node)
	1329	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1330	(when (undo-tree-region-data-p r)
	1331	(undo-tree-region-data-redo-beginning r))))
	1332
	1333	(defmacro undo-tree-node-redo-end (node)
	1334	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1335	(when (undo-tree-region-data-p r)
	1336	(undo-tree-region-data-redo-end r))))
	1337
	1338
	1339	(defsetf undo-tree-node-undo-beginning (node) (val)
	1340	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1341	(unless (undo-tree-region-data-p r)
	1342	(setf (undo-tree-node-meta-data ,node)
	1343	(plist-put (undo-tree-node-meta-data ,node) :region
	1344	(setq r (undo-tree-make-region-data)))))
	1345	(setf (undo-tree-region-data-undo-beginning r) ,val)))
	1346
	1347	(defsetf undo-tree-node-undo-end (node) (val)
	1348	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1349	(unless (undo-tree-region-data-p r)
	1350	(setf (undo-tree-node-meta-data ,node)
	1351	(plist-put (undo-tree-node-meta-data ,node) :region
	1352	(setq r (undo-tree-make-region-data)))))
	1353	(setf (undo-tree-region-data-undo-end r) ,val)))
	1354
	1355	(defsetf undo-tree-node-redo-beginning (node) (val)
	1356	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1357	(unless (undo-tree-region-data-p r)
	1358	(setf (undo-tree-node-meta-data ,node)
	1359	(plist-put (undo-tree-node-meta-data ,node) :region
	1360	(setq r (undo-tree-make-region-data)))))
	1361	(setf (undo-tree-region-data-redo-beginning r) ,val)))
	1362
	1363	(defsetf undo-tree-node-redo-end (node) (val)
	1364	`(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
	1365	(unless (undo-tree-region-data-p r)
	1366	(setf (undo-tree-node-meta-data ,node)
	1367	(plist-put (undo-tree-node-meta-data ,node) :region
	1368	(setq r (undo-tree-make-region-data)))))
	1369	(setf (undo-tree-region-data-redo-end r) ,val)))
	1370
	1371
	1372
	1373	(defstruct
	1374	(undo-tree-visualizer-data
	1375	(:type vector) ; create unnamed struct
	1376	(:constructor nil)
	1377	(:constructor undo-tree-make-visualizer-data
	1378	(&optional lwidth cwidth rwidth marker))
	1379	(:copier nil))
	1380	lwidth cwidth rwidth marker)
	1381
	1382
	1383	(defmacro undo-tree-visualizer-data-p (v)
	1384	(let ((len (length (undo-tree-make-visualizer-data))))
	1385	`(and (vectorp ,v) (= (length ,v) ,len))))
	1386
	1387	(defun undo-tree-node-clear-visualizer-data (node)
	1388	(let ((plist (undo-tree-node-meta-data node)))
	1389	(if (eq (car plist) :visualizer)
	1390	(setf (undo-tree-node-meta-data node) (nthcdr 2 plist))
	1391	(while (and plist (not (eq (cadr plist) :visualizer)))
	1392	(setq plist (cdr plist)))
	1393	(if plist (setcdr plist (nthcdr 3 plist))))))
	1394
	1395	(defmacro undo-tree-node-lwidth (node)
	1396	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1397	(when (undo-tree-visualizer-data-p v)
	1398	(undo-tree-visualizer-data-lwidth v))))
	1399
	1400	(defmacro undo-tree-node-cwidth (node)
	1401	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1402	(when (undo-tree-visualizer-data-p v)
	1403	(undo-tree-visualizer-data-cwidth v))))
	1404
	1405	(defmacro undo-tree-node-rwidth (node)
	1406	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1407	(when (undo-tree-visualizer-data-p v)
	1408	(undo-tree-visualizer-data-rwidth v))))
	1409
	1410	(defmacro undo-tree-node-marker (node)
	1411	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1412	(when (undo-tree-visualizer-data-p v)
	1413	(undo-tree-visualizer-data-marker v))))
	1414
	1415
	1416	(defsetf undo-tree-node-lwidth (node) (val)
	1417	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1418	(unless (undo-tree-visualizer-data-p v)
	1419	(setf (undo-tree-node-meta-data ,node)
	1420	(plist-put (undo-tree-node-meta-data ,node) :visualizer
	1421	(setq v (undo-tree-make-visualizer-data)))))
	1422	(setf (undo-tree-visualizer-data-lwidth v) ,val)))
	1423
	1424	(defsetf undo-tree-node-cwidth (node) (val)
	1425	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1426	(unless (undo-tree-visualizer-data-p v)
	1427	(setf (undo-tree-node-meta-data ,node)
	1428	(plist-put (undo-tree-node-meta-data ,node) :visualizer
	1429	(setq v (undo-tree-make-visualizer-data)))))
	1430	(setf (undo-tree-visualizer-data-cwidth v) ,val)))
	1431
	1432	(defsetf undo-tree-node-rwidth (node) (val)
	1433	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1434	(unless (undo-tree-visualizer-data-p v)
	1435	(setf (undo-tree-node-meta-data ,node)
	1436	(plist-put (undo-tree-node-meta-data ,node) :visualizer
	1437	(setq v (undo-tree-make-visualizer-data)))))
	1438	(setf (undo-tree-visualizer-data-rwidth v) ,val)))
	1439
	1440	(defsetf undo-tree-node-marker (node) (val)
	1441	`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
	1442	(unless (undo-tree-visualizer-data-p v)
	1443	(setf (undo-tree-node-meta-data ,node)
	1444	(plist-put (undo-tree-node-meta-data ,node) :visualizer
	1445	(setq v (undo-tree-make-visualizer-data)))))
	1446	(setf (undo-tree-visualizer-data-marker v) ,val)))
	1447
	1448
	1449
	1450	(defstruct
	1451	(undo-tree-register-data
	1452	(:type vector)
	1453	(:constructor nil)
	1454	(:constructor undo-tree-make-register-data (buffer node)))
	1455	buffer node)
	1456
	1457	(defun undo-tree-register-data-p (data)
	1458	(and (vectorp data)
	1459	(= (length data) 2)
	1460	(undo-tree-node-p (undo-tree-register-data-node data))))
	1461
	1462	(defun undo-tree-register-data-print-func (data)
	1463	(princ (format "an undo-tree state for buffer %s"
	1464	(undo-tree-register-data-buffer data))))
	1465
	1466	(defmacro undo-tree-node-register (node)
	1467	`(plist-get (undo-tree-node-meta-data ,node) :register))
	1468
	1469	(defsetf undo-tree-node-register (node) (val)
	1470	`(setf (undo-tree-node-meta-data ,node)
	1471	(plist-put (undo-tree-node-meta-data ,node) :register ,val)))
	1472
	1473
	1474
	1475
	1476	;;; =====================================================================
	1477	;;; Basic undo-tree data structure functions
	1478
	1479	(defun undo-tree-grow (undo)
	1480	"Add an UNDO node to current branch of `buffer-undo-tree'."
	1481	(let* ((current (undo-tree-current buffer-undo-tree))
	1482	(new (undo-tree-make-node current undo)))
	1483	(push new (undo-tree-node-next current))
	1484	(setf (undo-tree-current buffer-undo-tree) new)))
	1485
	1486
	1487	(defun undo-tree-grow-backwards (node undo &optional redo)
	1488	"Add new node above undo-tree NODE, and return new node.
	1489	Note that this will overwrite NODE's \"previous\" link, so should
	1490	only be used on a detached NODE, never on nodes that are already
	1491	part of `buffer-undo-tree'."
	1492	(let ((new (undo-tree-make-node-backwards node undo redo)))
	1493	(setf (undo-tree-node-previous node) new)
	1494	new))
	1495
	1496
	1497	(defun undo-tree-splice-node (node splice)
	1498	"Splice NODE into undo tree, below node SPLICE.
	1499	Note that this will overwrite NODE's \"next\" and \"previous\"
	1500	links, so should only be used on a detached NODE, never on nodes
	1501	that are already part of `buffer-undo-tree'."
	1502	(setf (undo-tree-node-next node) (undo-tree-node-next splice)
	1503	(undo-tree-node-branch node) (undo-tree-node-branch splice)
	1504	(undo-tree-node-previous node) splice
	1505	(undo-tree-node-next splice) (list node)
	1506	(undo-tree-node-branch splice) 0)
	1507	(dolist (n (undo-tree-node-next node))
	1508	(setf (undo-tree-node-previous n) node)))
	1509
	1510
	1511	(defun undo-tree-snip-node (node)
	1512	"Snip NODE out of undo tree."
	1513	(let* ((parent (undo-tree-node-previous node))
	1514	position p)
	1515	;; if NODE is only child, replace parent's next links with NODE's
	1516	(if (= (length (undo-tree-node-next parent)) 0)
	1517	(setf (undo-tree-node-next parent) (undo-tree-node-next node)
	1518	(undo-tree-node-branch parent) (undo-tree-node-branch node))
	1519	;; otherwise...
	1520	(setq position (undo-tree-position node (undo-tree-node-next parent)))
	1521	(cond
	1522	;; if active branch used do go via NODE, set parent's branch to active
	1523	;; branch of NODE
	1524	((= (undo-tree-node-branch parent) position)
	1525	(setf (undo-tree-node-branch parent)
	1526	(+ position (undo-tree-node-branch node))))
	1527	;; if active branch didn't go via NODE, update parent's branch to point
	1528	;; to same node as before
	1529	((> (undo-tree-node-branch parent) position)
	1530	(incf (undo-tree-node-branch parent)
	1531	(1- (length (undo-tree-node-next node))))))
	1532	;; replace NODE in parent's next list with NODE's entire next list
	1533	(if (= position 0)
	1534	(setf (undo-tree-node-next parent)
	1535	(nconc (undo-tree-node-next node)
	1536	(cdr (undo-tree-node-next parent))))
	1537	(setq p (nthcdr (1- position) (undo-tree-node-next parent)))
	1538	(setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
	1539	;; update previous links of NODE's children
	1540	(dolist (n (undo-tree-node-next node))
	1541	(setf (undo-tree-node-previous n) parent))))
	1542
	1543
	1544	(defun undo-tree-mapc (--undo-tree-mapc-function-- node)
	1545	;; Apply FUNCTION to NODE and to each node below it.
	1546	(let ((stack (list node))
	1547	n)
	1548	(while stack
	1549	(setq n (pop stack))
	1550	(funcall --undo-tree-mapc-function-- n)
	1551	(setq stack (append (undo-tree-node-next n) stack)))))
	1552
	1553
	1554	(defmacro undo-tree-num-branches ()
	1555	"Return number of branches at current undo tree node."
	1556	'(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
	1557
	1558
	1559	(defun undo-tree-position (node list)
	1560	"Find the first occurrence of NODE in LIST.
	1561	Return the index of the matching item, or nil of not found.
	1562	Comparison is done with `eq'."
	1563	(let ((i 0))
	1564	(catch 'found
	1565	(while (progn
	1566	(when (eq node (car list)) (throw 'found i))
	1567	(incf i)
	1568	(setq list (cdr list))))
	1569	nil)))
	1570
	1571
	1572	(defvar undo-tree-id-counter 0)
	1573	(make-variable-buffer-local 'undo-tree-id-counter)
	1574
	1575	(defmacro undo-tree-generate-id ()
	1576	;; Generate a new, unique id (uninterned symbol).
	1577	;; The name is made by appending a number to "undo-tree-id".
	1578	;; (Copied from CL package `gensym'.)
	1579	`(let ((num (prog1 undo-tree-id-counter (incf undo-tree-id-counter))))
	1580	(make-symbol (format "undo-tree-id%d" num))))
	1581
	1582
	1583	(defun undo-tree-decircle (undo-tree)
	1584	;; Nullify PREVIOUS links of UNDO-TREE nodes, to make UNDO-TREE data
	1585	;; structure non-circular.
	1586	(undo-tree-mapc
	1587	(lambda (node)
	1588	(dolist (n (undo-tree-node-next node))
	1589	(setf (undo-tree-node-previous n) nil)))
	1590	(undo-tree-root undo-tree)))
	1591
	1592
	1593	(defun undo-tree-recircle (undo-tree)
	1594	;; Recreate PREVIOUS links of UNDO-TREE nodes, to restore circular UNDO-TREE
	1595	;; data structure.
	1596	(undo-tree-mapc
	1597	(lambda (node)
	1598	(dolist (n (undo-tree-node-next node))
	1599	(setf (undo-tree-node-previous n) node)))
	1600	(undo-tree-root undo-tree)))
	1601
	1602
	1603
	1604
	1605	;;; =====================================================================
	1606	;;; Undo list and undo changeset utility functions
	1607
	1608	(defmacro undo-list-marker-elt-p (elt)
	1609	`(markerp (car-safe ,elt)))
	1610
	1611	(defmacro undo-list-GCd-marker-elt-p (elt)
	1612	;; Return t if ELT is a marker element whose marker has been moved to the
	1613	;; object-pool, so may potentially have been garbage-collected.
	1614	;; Note: Valid marker undo elements should be uniquely identified as cons
	1615	;; cells with a symbol in the car (replacing the marker), and a number in
	1616	;; the cdr. However, to guard against future changes to undo element
	1617	;; formats, we perform an additional redundant check on the symbol name.
	1618	`(and (car-safe ,elt)
	1619	(symbolp (car ,elt))
	1620	(let ((str (symbol-name (car ,elt))))
	1621	(and (> (length str) 12)
	1622	(string= (substring str 0 12) "undo-tree-id")))
	1623	(numberp (cdr-safe ,elt))))
	1624
	1625
	1626	(defun undo-tree-move-GC-elts-to-pool (elt)
	1627	;; Move elements that can be garbage-collected into `buffer-undo-tree'
	1628	;; object pool, substituting a unique id that can be used to retrieve them
	1629	;; later. (Only markers require this treatment currently.)
	1630	(when (undo-list-marker-elt-p elt)
	1631	(let ((id (undo-tree-generate-id)))
	1632	(puthash id (car elt) (undo-tree-object-pool buffer-undo-tree))
	1633	(setcar elt id))))
	1634
	1635
	1636	(defun undo-tree-restore-GC-elts-from-pool (elt)
	1637	;; Replace object id's in ELT with corresponding objects from
	1638	;; `buffer-undo-tree' object pool and return modified ELT, or return nil if
	1639	;; any object in ELT has been garbage-collected.
	1640	(if (undo-list-GCd-marker-elt-p elt)
	1641	(when (setcar elt (gethash (car elt)
	1642	(undo-tree-object-pool buffer-undo-tree)))
	1643	elt)
	1644	elt))
	1645
	1646
	1647	(defun undo-list-clean-GCd-elts (undo-list)
	1648	;; Remove object id's from UNDO-LIST that refer to elements that have been
	1649	;; garbage-collected. UNDO-LIST is modified by side-effect.
	1650	(while (undo-list-GCd-marker-elt-p (car undo-list))
	1651	(unless (gethash (caar undo-list)
	1652	(undo-tree-object-pool buffer-undo-tree))
	1653	(setq undo-list (cdr undo-list))))
	1654	(let ((p undo-list))
	1655	(while (cdr p)
	1656	(when (and (undo-list-GCd-marker-elt-p (cadr p))
	1657	(null (gethash (car (cadr p))
	1658	(undo-tree-object-pool buffer-undo-tree))))
	1659	(setcdr p (cddr p)))
	1660	(setq p (cdr p))))
	1661	undo-list)
	1662
	1663
	1664	(defun undo-list-pop-changeset (&optional discard-pos)
	1665	;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
	1666	;; any position entries from changeset.
	1667
	1668	;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
	1669	;; at head of undo list
	1670	(while (or (null (car buffer-undo-list))
	1671	(and discard-pos (integerp (car buffer-undo-list))))
	1672	(setq buffer-undo-list (cdr buffer-undo-list)))
	1673	;; pop elements up to next undo boundary, discarding position entries if
	1674	;; DISCARD-POS is non-nil
	1675	(if (eq (car buffer-undo-list) 'undo-tree-canary)
	1676	(push nil buffer-undo-list)
	1677	(let* ((changeset (list (pop buffer-undo-list)))
	1678	(p changeset))
	1679	(while (progn
	1680	(undo-tree-move-GC-elts-to-pool (car p))
	1681	(while (and discard-pos (integerp (car buffer-undo-list)))
	1682	(setq buffer-undo-list (cdr buffer-undo-list)))
	1683	(and (car buffer-undo-list)
	1684	(not (eq (car buffer-undo-list) 'undo-tree-canary))))
	1685	(setcdr p (list (pop buffer-undo-list)))
	1686	(setq p (cdr p)))
	1687	changeset)))
	1688
	1689
	1690	(defun undo-tree-copy-list (undo-list)
	1691	;; Return a deep copy of first changeset in `undo-list'. Object id's are
	1692	;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
	1693	(when undo-list
	1694	(let (copy p)
	1695	;; if first element contains an object id, replace it with object from
	1696	;; pool, discarding element entirely if it's been GC'd
	1697	(while (null copy)
	1698	(setq copy
	1699	(undo-tree-restore-GC-elts-from-pool (pop undo-list))))
	1700	(setq copy (list copy)
	1701	p copy)
	1702	;; copy remaining elements, replacing object id's with objects from
	1703	;; pool, or discarding them entirely if they've been GC'd
	1704	(while undo-list
	1705	(when (setcdr p (undo-tree-restore-GC-elts-from-pool
	1706	(undo-copy-list-1 (pop undo-list))))
	1707	(setcdr p (list (cdr p)))
	1708	(setq p (cdr p))))
	1709	copy)))
	1710
	1711
	1712
	1713	(defun undo-list-transfer-to-tree ()
	1714	;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
	1715
	1716	;; `undo-list-transfer-to-tree' should never be called when undo is disabled
	1717	;; (i.e. `buffer-undo-tree' is t)
	1718	(assert (not (eq buffer-undo-tree t)))
	1719
	1720	;; if `buffer-undo-tree' is empty, create initial undo-tree
	1721	(when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
	1722	;; make sure there's a canary at end of `buffer-undo-list'
	1723	(when (null buffer-undo-list)
	1724	(setq buffer-undo-list '(nil undo-tree-canary)))
	1725
	1726	(unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
	1727	(eq (car buffer-undo-list) 'undo-tree-canary))
	1728	;; create new node from first changeset in `buffer-undo-list', save old
	1729	;; `buffer-undo-tree' current node, and make new node the current node
	1730	(let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
	1731	(splice (undo-tree-current buffer-undo-tree))
	1732	(size (undo-list-byte-size (undo-tree-node-undo node)))
	1733	(count 1))
	1734	(setf (undo-tree-current buffer-undo-tree) node)
	1735	;; grow tree fragment backwards using `buffer-undo-list' changesets
	1736	(while (and buffer-undo-list
	1737	(not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
	1738	(setq node
	1739	(undo-tree-grow-backwards node (undo-list-pop-changeset)))
	1740	(incf size (undo-list-byte-size (undo-tree-node-undo node)))
	1741	(incf count))
	1742	;; if no undo history has been discarded from `buffer-undo-list' since
	1743	;; last transfer, splice new tree fragment onto end of old
	1744	;; `buffer-undo-tree' current node
	1745	(if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
	1746	(eq (car buffer-undo-list) 'undo-tree-canary))
	1747	(progn
	1748	(setf (undo-tree-node-previous node) splice)
	1749	(push node (undo-tree-node-next splice))
	1750	(setf (undo-tree-node-branch splice) 0)
	1751	(incf (undo-tree-size buffer-undo-tree) size)
	1752	(incf (undo-tree-count buffer-undo-tree) count))
	1753	;; if undo history has been discarded, replace entire
	1754	;; `buffer-undo-tree' with new tree fragment
	1755	(setq node (undo-tree-grow-backwards node nil))
	1756	(setf (undo-tree-root buffer-undo-tree) node)
	1757	(setq buffer-undo-list '(nil undo-tree-canary))
	1758	(setf (undo-tree-size buffer-undo-tree) size)
	1759	(setf (undo-tree-count buffer-undo-tree) count)
	1760	(setq buffer-undo-list '(nil undo-tree-canary))))
	1761	;; discard undo history if necessary
	1762	(undo-tree-discard-history)))
	1763
	1764
	1765	(defun undo-list-byte-size (undo-list)
	1766	;; Return size (in bytes) of UNDO-LIST
	1767	(let ((size 0) (p undo-list))
	1768	(while p
	1769	(incf size 8) ; cons cells use up 8 bytes
	1770	(when (and (consp (car p)) (stringp (caar p)))
	1771	(incf size (string-bytes (caar p))))
	1772	(setq p (cdr p)))
	1773	size))
	1774
	1775
	1776
	1777	(defun undo-list-rebuild-from-tree ()
	1778	"Rebuild `buffer-undo-list' from information in `buffer-undo-tree'."
	1779	(unless (eq buffer-undo-list t)
	1780	(undo-list-transfer-to-tree)
	1781	(setq buffer-undo-list nil)
	1782	(when buffer-undo-tree
	1783	(let ((stack (list (list (undo-tree-root buffer-undo-tree)))))
	1784	(push (sort (mapcar 'identity (undo-tree-node-next (caar stack)))
	1785	(lambda (a b)
	1786	(time-less-p (undo-tree-node-timestamp a)
	1787	(undo-tree-node-timestamp b))))
	1788	stack)
	1789	;; Traverse tree in depth-and-oldest-first order, but add undo records
	1790	;; on the way down, and redo records on the way up.
	1791	(while (or (car stack)
	1792	(not (eq (car (nth 1 stack))
	1793	(undo-tree-current buffer-undo-tree))))
	1794	(if (car stack)
	1795	(progn
	1796	(setq buffer-undo-list
	1797	(append (undo-tree-node-undo (caar stack))
	1798	buffer-undo-list))
	1799	(undo-boundary)
	1800	(push (sort (mapcar 'identity
	1801	(undo-tree-node-next (caar stack)))
	1802	(lambda (a b)
	1803	(time-less-p (undo-tree-node-timestamp a)
	1804	(undo-tree-node-timestamp b))))
	1805	stack))
	1806	(pop stack)
	1807	(setq buffer-undo-list
	1808	(append (undo-tree-node-redo (caar stack))
	1809	buffer-undo-list))
	1810	(undo-boundary)
	1811	(pop (car stack))))))))
	1812
	1813
	1814
	1815
	1816	;;; =====================================================================
	1817	;;; History discarding utility functions
	1818
	1819	(defun undo-tree-oldest-leaf (node)
	1820	;; Return oldest leaf node below NODE.
	1821	(while (undo-tree-node-next node)
	1822	(setq node
	1823	(car (sort (mapcar 'identity (undo-tree-node-next node))
	1824	(lambda (a b)
	1825	(time-less-p (undo-tree-node-timestamp a)
	1826	(undo-tree-node-timestamp b)))))))
	1827	node)
	1828
	1829
	1830	(defun undo-tree-discard-node (node)
	1831	;; Discard NODE from `buffer-undo-tree', and return next in line for
	1832	;; discarding.
	1833
	1834	;; don't discard current node
	1835	(unless (eq node (undo-tree-current buffer-undo-tree))
	1836
	1837	;; discarding root node...
	1838	(if (eq node (undo-tree-root buffer-undo-tree))
	1839	(cond
	1840	;; should always discard branches before root
	1841	((> (length (undo-tree-node-next node)) 1)
	1842	(error "Trying to discard undo-tree root which still\
	1843	has multiple branches"))
	1844	;; don't discard root if current node is only child
	1845	((eq (car (undo-tree-node-next node))
	1846	(undo-tree-current buffer-undo-tree))
	1847	nil)
	1848	;; discard root
	1849	(t
	1850	;; clear any register referring to root
	1851	(let ((r (undo-tree-node-register node)))
	1852	(when (and r (eq (get-register r) node))
	1853	(set-register r nil)))
	1854	;; make child of root into new root
	1855	(setq node (setf (undo-tree-root buffer-undo-tree)
	1856	(car (undo-tree-node-next node))))
	1857	;; update undo-tree size
	1858	(decf (undo-tree-size buffer-undo-tree)
	1859	(+ (undo-list-byte-size (undo-tree-node-undo node))
	1860	(undo-list-byte-size (undo-tree-node-redo node))))
	1861	(decf (undo-tree-count buffer-undo-tree))
	1862	;; discard new root's undo data and PREVIOUS link
	1863	(setf (undo-tree-node-undo node) nil
	1864	(undo-tree-node-redo node) nil
	1865	(undo-tree-node-previous node) nil)
	1866	;; if new root has branches, or new root is current node, next node
	1867	;; to discard is oldest leaf, otherwise it's new root
	1868	(if (or (> (length (undo-tree-node-next node)) 1)
	1869	(eq (car (undo-tree-node-next node))
	1870	(undo-tree-current buffer-undo-tree)))
	1871	(undo-tree-oldest-leaf node)
	1872	node)))
	1873
	1874	;; discarding leaf node...
	1875	(let* ((parent (undo-tree-node-previous node))
	1876	(current (nth (undo-tree-node-branch parent)
	1877	(undo-tree-node-next parent))))
	1878	;; clear any register referring to the discarded node
	1879	(let ((r (undo-tree-node-register node)))
	1880	(when (and r (eq (get-register r) node))
	1881	(set-register r nil)))
	1882	;; update undo-tree size
	1883	(decf (undo-tree-size buffer-undo-tree)
	1884	(+ (undo-list-byte-size (undo-tree-node-undo node))
	1885	(undo-list-byte-size (undo-tree-node-redo node))))
	1886	(decf (undo-tree-count buffer-undo-tree))
	1887	;; discard leaf
	1888	(setf (undo-tree-node-next parent)
	1889	(delq node (undo-tree-node-next parent))
	1890	(undo-tree-node-branch parent)
	1891	(undo-tree-position current (undo-tree-node-next parent)))
	1892	;; if parent has branches, or parent is current node, next node to
	1893	;; discard is oldest leaf, otherwise it's the parent itself
	1894	(if (or (eq parent (undo-tree-current buffer-undo-tree))
	1895	(and (undo-tree-node-next parent)
	1896	(or (not (eq parent (undo-tree-root buffer-undo-tree)))
	1897	(> (length (undo-tree-node-next parent)) 1))))
	1898	(undo-tree-oldest-leaf parent)
	1899	parent)))))
	1900
	1901
	1902
	1903	(defun undo-tree-discard-history ()
	1904	"Discard undo history until we're within memory usage limits
	1905	set by `undo-limit', `undo-strong-limit' and `undo-outer-limit'."
	1906
	1907	(when (> (undo-tree-size buffer-undo-tree) undo-limit)
	1908	;; if there are no branches off root, first node to discard is root;
	1909	;; otherwise it's leaf node at botom of oldest branch
	1910	(let ((node (if (> (length (undo-tree-node-next
	1911	(undo-tree-root buffer-undo-tree))) 1)
	1912	(undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
	1913	(undo-tree-root buffer-undo-tree))))
	1914
	1915	;; discard nodes until memory use is within `undo-strong-limit'
	1916	(while (and node
	1917	(> (undo-tree-size buffer-undo-tree) undo-strong-limit))
	1918	(setq node (undo-tree-discard-node node)))
	1919
	1920	;; discard nodes until next node to discard would bring memory use
	1921	;; within `undo-limit'
	1922	(while (and node
	1923	;; check first if last discard has brought us within
	1924	;; `undo-limit', in case we can avoid more expensive
	1925	;; `undo-strong-limit' calculation
	1926	;; Note: this assumes undo-strong-limit > undo-limit;
	1927	;; if not, effectively undo-strong-limit = undo-limit
	1928	(> (undo-tree-size buffer-undo-tree) undo-limit)
	1929	(> (- (undo-tree-size buffer-undo-tree)
	1930	;; if next node to discard is root, the memory we
	1931	;; free-up comes from discarding changesets from its
	1932	;; only child...
	1933	(if (eq node (undo-tree-root buffer-undo-tree))
	1934	(+ (undo-list-byte-size
	1935	(undo-tree-node-undo
	1936	(car (undo-tree-node-next node))))
	1937	(undo-list-byte-size
	1938	(undo-tree-node-redo
	1939	(car (undo-tree-node-next node)))))
	1940	;; ...otherwise, it comes from discarding changesets
	1941	;; from along with the node itself
	1942	(+ (undo-list-byte-size (undo-tree-node-undo node))
	1943	(undo-list-byte-size (undo-tree-node-redo node)))
	1944	))
	1945	undo-limit))
	1946	(setq node (undo-tree-discard-node node)))
	1947
	1948	;; if we're still over the `undo-outer-limit', discard entire history
	1949	(when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
	1950	;; query first if `undo-ask-before-discard' is set
	1951	(if undo-ask-before-discard
	1952	(when (yes-or-no-p
	1953	(format
	1954	"Buffer `%s' undo info is %d bytes long; discard it? "
	1955	(buffer-name) (undo-tree-size buffer-undo-tree)))
	1956	(setq buffer-undo-tree nil))
	1957	;; otherwise, discard and display warning
	1958	(display-warning
	1959	'(undo discard-info)
	1960	(concat
	1961	(format "Buffer `%s' undo info was %d bytes long.\n"
	1962	(buffer-name) (undo-tree-size buffer-undo-tree))
	1963	"The undo info was discarded because it exceeded\
	1964	`undo-outer-limit'.
	1965
	1966	This is normal if you executed a command that made a huge change
	1967	to the buffer. In that case, to prevent similar problems in the
	1968	future, set `undo-outer-limit' to a value that is large enough to
	1969	cover the maximum size of normal changes you expect a single
	1970	command to make, but not so large that it might exceed the
	1971	maximum memory allotted to Emacs.
	1972
	1973	If you did not execute any such command, the situation is
	1974	probably due to a bug and you should report it.
	1975
	1976	You can disable the popping up of this buffer by adding the entry
	1977	\(undo discard-info) to the user option `warning-suppress-types',
	1978	which is defined in the `warnings' library.\n")
	1979	:warning)
	1980	(setq buffer-undo-tree nil)))
	1981	)))
	1982
	1983
	1984
	1985
	1986	;;; =====================================================================
	1987	;;; Visualizer utility functions
	1988
	1989	(defun undo-tree-compute-widths (node)
	1990	"Recursively compute widths for nodes below NODE."
	1991	(let ((stack (list node))
	1992	res)
	1993	(while stack
	1994	;; try to compute widths for node at top of stack
	1995	(if (undo-tree-node-p
	1996	(setq res (undo-tree-node-compute-widths (car stack))))
	1997	;; if computation fails, it returns a node whose widths still need
	1998	;; computing, which we push onto the stack
	1999	(push res stack)
	2000	;; otherwise, store widths and remove it from stack
	2001	(setf (undo-tree-node-lwidth (car stack)) (aref res 0)
	2002	(undo-tree-node-cwidth (car stack)) (aref res 1)
	2003	(undo-tree-node-rwidth (car stack)) (aref res 2))
	2004	(pop stack)))))
	2005
	2006
	2007	(defun undo-tree-node-compute-widths (node)
	2008	;; Compute NODE's left-, centre-, and right-subtree widths. Returns widths
	2009	;; (in a vector) if successful. Otherwise, returns a node whose widths need
	2010	;; calculating before NODE's can be calculated.
	2011	(let ((num-children (length (undo-tree-node-next node)))
	2012	(lwidth 0) (cwidth 0) (rwidth 0) p)
	2013	(catch 'need-widths
	2014	(cond
	2015	;; leaf nodes have 0 width
	2016	((= 0 num-children)
	2017	(setf cwidth 1
	2018	(undo-tree-node-lwidth node) 0
	2019	(undo-tree-node-cwidth node) 1
	2020	(undo-tree-node-rwidth node) 0))
	2021
	2022	;; odd number of children
	2023	((= (mod num-children 2) 1)
	2024	(setq p (undo-tree-node-next node))
	2025	;; compute left-width
	2026	(dotimes (i (/ num-children 2))
	2027	(if (undo-tree-node-lwidth (car p))
	2028	(incf lwidth (+ (undo-tree-node-lwidth (car p))
	2029	(undo-tree-node-cwidth (car p))
	2030	(undo-tree-node-rwidth (car p))))
	2031	;; if child's widths haven't been computed, return that child
	2032	(throw 'need-widths (car p)))
	2033	(setq p (cdr p)))
	2034	(if (undo-tree-node-lwidth (car p))
	2035	(incf lwidth (undo-tree-node-lwidth (car p)))
	2036	(throw 'need-widths (car p)))
	2037	;; centre-width is inherited from middle child
	2038	(setf cwidth (undo-tree-node-cwidth (car p)))
	2039	;; compute right-width
	2040	(incf rwidth (undo-tree-node-rwidth (car p)))
	2041	(setq p (cdr p))
	2042	(dotimes (i (/ num-children 2))
	2043	(if (undo-tree-node-lwidth (car p))
	2044	(incf rwidth (+ (undo-tree-node-lwidth (car p))
	2045	(undo-tree-node-cwidth (car p))
	2046	(undo-tree-node-rwidth (car p))))
	2047	(throw 'need-widths (car p)))
	2048	(setq p (cdr p))))
	2049
	2050	;; even number of children
	2051	(t
	2052	(setq p (undo-tree-node-next node))
	2053	;; compute left-width
	2054	(dotimes (i (/ num-children 2))
	2055	(if (undo-tree-node-lwidth (car p))
	2056	(incf lwidth (+ (undo-tree-node-lwidth (car p))
	2057	(undo-tree-node-cwidth (car p))
	2058	(undo-tree-node-rwidth (car p))))
	2059	(throw 'need-widths (car p)))
	2060	(setq p (cdr p)))
	2061	;; centre-width is 0 when number of children is even
	2062	(setq cwidth 0)
	2063	;; compute right-width
	2064	(dotimes (i (/ num-children 2))
	2065	(if (undo-tree-node-lwidth (car p))
	2066	(incf rwidth (+ (undo-tree-node-lwidth (car p))
	2067	(undo-tree-node-cwidth (car p))
	2068	(undo-tree-node-rwidth (car p))))
	2069	(throw 'need-widths (car p)))
	2070	(setq p (cdr p)))))
	2071
	2072	;; return left-, centre- and right-widths
	2073	(vector lwidth cwidth rwidth))))
	2074
	2075
	2076	(defun undo-tree-clear-visualizer-data (tree)
	2077	;; Clear visualizer data below NODE.
	2078	(undo-tree-mapc
	2079	(lambda (n) (undo-tree-node-clear-visualizer-data n))
	2080	(undo-tree-root tree)))
	2081
	2082
	2083	(defun undo-tree-node-unmodified-p (node &optional mtime)
	2084	;; Return non-nil if NODE corresponds to a buffer state that once upon a
	2085	;; time was unmodified. If a file modification time MTIME is specified,
	2086	;; return non-nil if the corresponding buffer state really is unmodified.
	2087	(let (changeset ntime)
	2088	(setq changeset
	2089	(or (undo-tree-node-redo node)
	2090	(and (setq changeset (car (undo-tree-node-next node)))
	2091	(undo-tree-node-undo changeset)))
	2092	ntime
	2093	(catch 'found
	2094	(dolist (elt changeset)
	2095	(when (and (consp elt) (eq (car elt) t) (consp (cdr elt))
	2096	(throw 'found (cdr elt)))))))
	2097	(and ntime
	2098	(or (null mtime)
	2099	;; high-precision timestamps
	2100	(if (listp (cdr ntime))
	2101	(equal ntime mtime)
	2102	;; old-style timestamps
	2103	(and (= (car ntime) (car mtime))
	2104	(= (cdr ntime) (cadr mtime))))))))
	2105
	2106
	2107
	2108
	2109	;;; =====================================================================
	2110	;;; Undo-in-region utility functions
	2111
	2112	;; `undo-elt-in-region' uses this as a dynamically-scoped variable
	2113	(defvar undo-adjusted-markers nil)
	2114
	2115
	2116	(defun undo-tree-pull-undo-in-region-branch (start end)
	2117	;; Pull out entries from undo changesets to create a new undo-in-region
	2118	;; branch, which undoes changeset entries lying between START and END first,
	2119	;; followed by remaining entries from the changesets, before rejoining the
	2120	;; existing undo tree history. Repeated calls will, if appropriate, extend
	2121	;; the current undo-in-region branch rather than creating a new one.
	2122
	2123	;; if we're just reverting the last redo-in-region, we don't need to
	2124	;; manipulate the undo tree at all
	2125	(if (undo-tree-reverting-redo-in-region-p start end)
	2126	t ; return t to indicate success
	2127
	2128	;; We build the `region-changeset' and `delta-list' lists forwards, using
	2129	;; pointers `r' and `d' to the penultimate element of the list. So that we
	2130	;; don't have to treat the first element differently, we prepend a dummy
	2131	;; leading nil to the lists, and have the pointers point to that
	2132	;; initially.
	2133	;; Note: using '(nil) instead of (list nil) in the `let*' results in
	2134	;; bizarre errors when the code is byte-compiled, where parts of the
	2135	;; lists appear to survive across different calls to this function.
	2136	;; An obscure byte-compiler bug, perhaps?
	2137	(let* ((region-changeset (list nil))
	2138	(r region-changeset)
	2139	(delta-list (list nil))
	2140	(d delta-list)
	2141	(node (undo-tree-current buffer-undo-tree))
	2142	(repeated-undo-in-region
	2143	(undo-tree-repeated-undo-in-region-p start end))
	2144	undo-adjusted-markers ; `undo-elt-in-region' expects this
	2145	fragment splice original-fragment original-splice original-current
	2146	got-visible-elt undo-list elt)
	2147
	2148	;; --- initialisation ---
	2149	(cond
	2150	;; if this is a repeated undo in the same region, start pulling changes
	2151	;; from NODE at which undo-in-region branch iss attached, and detatch
	2152	;; the branch, using it as initial FRAGMENT of branch being constructed
	2153	(repeated-undo-in-region
	2154	(setq original-current node
	2155	fragment (car (undo-tree-node-next node))
	2156	splice node)
	2157	;; undo up to node at which undo-in-region branch is attached
	2158	;; (recognizable as first node with more than one branch)
	2159	(let ((mark-active nil))
	2160	(while (= (length (undo-tree-node-next node)) 1)
	2161	(undo-tree-undo-1)
	2162	(setq fragment node
	2163	node (undo-tree-current buffer-undo-tree))))
	2164	(when (eq splice node) (setq splice nil))
	2165	;; detatch undo-in-region branch
	2166	(setf (undo-tree-node-next node)
	2167	(delq fragment (undo-tree-node-next node))
	2168	(undo-tree-node-previous fragment) nil
	2169	original-fragment fragment
	2170	original-splice node))
	2171
	2172	;; if this is a new undo-in-region, initial FRAGMENT is a copy of all
	2173	;; nodes below the current one in the active branch
	2174	((undo-tree-node-next node)
	2175	(setq fragment (undo-tree-make-node nil nil)
	2176	splice fragment)
	2177	(while (setq node (nth (undo-tree-node-branch node)
	2178	(undo-tree-node-next node)))
	2179	(push (undo-tree-make-node
	2180	splice
	2181	(undo-copy-list (undo-tree-node-undo node))
	2182	(undo-copy-list (undo-tree-node-redo node)))
	2183	(undo-tree-node-next splice))
	2184	(setq splice (car (undo-tree-node-next splice))))
	2185	(setq fragment (car (undo-tree-node-next fragment))
	2186	splice nil
	2187	node (undo-tree-current buffer-undo-tree))))
	2188
	2189
	2190	;; --- pull undo-in-region elements into branch ---
	2191	;; work backwards up tree, pulling out undo elements within region until
	2192	;; we've got one that undoes a visible change (insertion or deletion)
	2193	(catch 'abort
	2194	(while (and (not got-visible-elt) node (undo-tree-node-undo node))
	2195	;; we cons a dummy nil element on the front of the changeset so that
	2196	;; we can conveniently remove the first (real) element from the
	2197	;; changeset if we need to; the leading nil is removed once we're
	2198	;; done with this changeset
	2199	(setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
	2200	elt (cadr undo-list))
	2201	(if fragment
	2202	(progn
	2203	(setq fragment (undo-tree-grow-backwards fragment undo-list))
	2204	(unless splice (setq splice fragment)))
	2205	(setq fragment (undo-tree-make-node nil undo-list))
	2206	(setq splice fragment))
	2207
	2208	(while elt
	2209	(cond
	2210	;; keep elements within region
	2211	((undo-elt-in-region elt start end)
	2212	;; set flag if kept element is visible (insertion or deletion)
	2213	(when (and (consp elt)
	2214	(or (stringp (car elt)) (integerp (car elt))))
	2215	(setq got-visible-elt t))
	2216	;; adjust buffer positions in elements previously undone before
	2217	;; kept element, as kept element will now be undone first
	2218	(undo-tree-adjust-elements-to-elt splice elt)
	2219	;; move kept element to undo-in-region changeset, adjusting its
	2220	;; buffer position as it will now be undone first
	2221	(setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
	2222	(setq r (cdr r))
	2223	(setcdr undo-list (cddr undo-list)))
	2224
	2225	;; discard "was unmodified" elements
	2226	;; FIXME: deal properly with these
	2227	((and (consp elt) (eq (car elt) t))
	2228	(setcdr undo-list (cddr undo-list)))
	2229
	2230	;; if element crosses region, we can't pull any more elements
	2231	((undo-elt-crosses-region elt start end)
	2232	;; if we've found a visible element, it must be earlier in
	2233	;; current node's changeset; stop pulling elements (null
	2234	;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
	2235	(if got-visible-elt
	2236	(setq undo-list nil)
	2237	;; if we haven't found a visible element yet, pulling
	2238	;; undo-in-region branch has failed
	2239	(setq region-changeset nil)
	2240	(throw 'abort t)))
	2241
	2242	;; if rejecting element, add its delta (if any) to the list
	2243	(t
	2244	(let ((delta (undo-delta elt)))
	2245	(when (/= 0 (cdr delta))
	2246	(setcdr d (list delta))
	2247	(setq d (cdr d))))
	2248	(setq undo-list (cdr undo-list))))
	2249
	2250	;; process next element of current changeset
	2251	(setq elt (cadr undo-list)))
	2252
	2253	;; if there are remaining elements in changeset, remove dummy nil
	2254	;; from front
	2255	(if (cadr (undo-tree-node-undo fragment))
	2256	(pop (undo-tree-node-undo fragment))
	2257	;; otherwise, if we've kept all elements in changeset, discard
	2258	;; empty changeset
	2259	(when (eq splice fragment) (setq splice nil))
	2260	(setq fragment (car (undo-tree-node-next fragment))))
	2261	;; process changeset from next node up the tree
	2262	(setq node (undo-tree-node-previous node))))
	2263
	2264	;; pop dummy nil from front of `region-changeset'
	2265	(setq region-changeset (cdr region-changeset))
	2266
	2267
	2268	;; --- integrate branch into tree ---
	2269	;; if no undo-in-region elements were found, restore undo tree
	2270	(if (null region-changeset)
	2271	(when original-current
	2272	(push original-fragment (undo-tree-node-next original-splice))
	2273	(setf (undo-tree-node-branch original-splice) 0
	2274	(undo-tree-node-previous original-fragment) original-splice)
	2275	(let ((mark-active nil))
	2276	(while (not (eq (undo-tree-current buffer-undo-tree)
	2277	original-current))
	2278	(undo-tree-redo-1)))
	2279	nil) ; return nil to indicate failure
	2280
	2281	;; otherwise...
	2282	;; need to undo up to node where new branch will be attached, to
	2283	;; ensure redo entries are populated, and then redo back to where we
	2284	;; started
	2285	(let ((mark-active nil)
	2286	(current (undo-tree-current buffer-undo-tree)))
	2287	(while (not (eq (undo-tree-current buffer-undo-tree) node))
	2288	(undo-tree-undo-1))
	2289	(while (not (eq (undo-tree-current buffer-undo-tree) current))
	2290	(undo-tree-redo-1)))
	2291
	2292	(cond
	2293	;; if there's no remaining fragment, just create undo-in-region node
	2294	;; and attach it to parent of last node from which elements were
	2295	;; pulled
	2296	((null fragment)
	2297	(setq fragment (undo-tree-make-node node region-changeset))
	2298	(push fragment (undo-tree-node-next node))
	2299	(setf (undo-tree-node-branch node) 0)
	2300	;; set current node to undo-in-region node
	2301	(setf (undo-tree-current buffer-undo-tree) fragment))
	2302
	2303	;; if no splice point has been set, add undo-in-region node to top of
	2304	;; fragment and attach it to parent of last node from which elements
	2305	;; were pulled
	2306	((null splice)
	2307	(setq fragment (undo-tree-grow-backwards fragment region-changeset))
	2308	(push fragment (undo-tree-node-next node))
	2309	(setf (undo-tree-node-branch node) 0
	2310	(undo-tree-node-previous fragment) node)
	2311	;; set current node to undo-in-region node
	2312	(setf (undo-tree-current buffer-undo-tree) fragment))
	2313
	2314	;; if fragment contains nodes, attach fragment to parent of last node
	2315	;; from which elements were pulled, and splice in undo-in-region node
	2316	(t
	2317	(setf (undo-tree-node-previous fragment) node)
	2318	(push fragment (undo-tree-node-next node))
	2319	(setf (undo-tree-node-branch node) 0)
	2320	;; if this is a repeated undo-in-region, then we've left the current
	2321	;; node at the original splice-point; we need to set the current
	2322	;; node to the equivalent node on the undo-in-region branch and redo
	2323	;; back to where we started
	2324	(when repeated-undo-in-region
	2325	(setf (undo-tree-current buffer-undo-tree)
	2326	(undo-tree-node-previous original-fragment))
	2327	(let ((mark-active nil))
	2328	(while (not (eq (undo-tree-current buffer-undo-tree) splice))
	2329	(undo-tree-redo-1 nil 'preserve-undo))))
	2330	;; splice new undo-in-region node into fragment
	2331	(setq node (undo-tree-make-node nil region-changeset))
	2332	(undo-tree-splice-node node splice)
	2333	;; set current node to undo-in-region node
	2334	(setf (undo-tree-current buffer-undo-tree) node)))
	2335
	2336	;; update undo-tree size
	2337	(setq node (undo-tree-node-previous fragment))
	2338	(while (progn
	2339	(and (setq node (car (undo-tree-node-next node)))
	2340	(not (eq node original-fragment))
	2341	(incf (undo-tree-count buffer-undo-tree))
	2342	(incf (undo-tree-size buffer-undo-tree)
	2343	(+ (undo-list-byte-size (undo-tree-node-undo node))
	2344	(undo-list-byte-size (undo-tree-node-redo node)))))))
	2345	t) ; indicate undo-in-region branch was successfully pulled
	2346	)))
	2347
	2348
	2349
	2350	(defun undo-tree-pull-redo-in-region-branch (start end)
	2351	;; Pull out entries from redo changesets to create a new redo-in-region
	2352	;; branch, which redoes changeset entries lying between START and END first,
	2353	;; followed by remaining entries from the changesets. Repeated calls will,
	2354	;; if appropriate, extend the current redo-in-region branch rather than
	2355	;; creating a new one.
	2356
	2357	;; if we're just reverting the last undo-in-region, we don't need to
	2358	;; manipulate the undo tree at all
	2359	(if (undo-tree-reverting-undo-in-region-p start end)
	2360	t ; return t to indicate success
	2361
	2362	;; We build the `region-changeset' and `delta-list' lists forwards, using
	2363	;; pointers `r' and `d' to the penultimate element of the list. So that we
	2364	;; don't have to treat the first element differently, we prepend a dummy
	2365	;; leading nil to the lists, and have the pointers point to that
	2366	;; initially.
	2367	;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
	2368	;; errors when the code is byte-compiled, where parts of the lists
	2369	;; appear to survive across different calls to this function. An
	2370	;; obscure byte-compiler bug, perhaps?
	2371	(let* ((region-changeset (list nil))
	2372	(r region-changeset)
	2373	(delta-list (list nil))
	2374	(d delta-list)
	2375	(node (undo-tree-current buffer-undo-tree))
	2376	(repeated-redo-in-region
	2377	(undo-tree-repeated-redo-in-region-p start end))
	2378	undo-adjusted-markers ; `undo-elt-in-region' expects this
	2379	fragment splice got-visible-elt redo-list elt)
	2380
	2381	;; --- inisitalisation ---
	2382	(cond
	2383	;; if this is a repeated redo-in-region, detach fragment below current
	2384	;; node
	2385	(repeated-redo-in-region
	2386	(when (setq fragment (car (undo-tree-node-next node)))
	2387	(setf (undo-tree-node-previous fragment) nil
	2388	(undo-tree-node-next node)
	2389	(delq fragment (undo-tree-node-next node)))))
	2390	;; if this is a new redo-in-region, initial fragment is a copy of all
	2391	;; nodes below the current one in the active branch
	2392	((undo-tree-node-next node)
	2393	(setq fragment (undo-tree-make-node nil nil)
	2394	splice fragment)
	2395	(while (setq node (nth (undo-tree-node-branch node)
	2396	(undo-tree-node-next node)))
	2397	(push (undo-tree-make-node
	2398	splice nil
	2399	(undo-copy-list (undo-tree-node-redo node)))
	2400	(undo-tree-node-next splice))
	2401	(setq splice (car (undo-tree-node-next splice))))
	2402	(setq fragment (car (undo-tree-node-next fragment)))))
	2403
	2404
	2405	;; --- pull redo-in-region elements into branch ---
	2406	;; work down fragment, pulling out redo elements within region until
	2407	;; we've got one that redoes a visible change (insertion or deletion)
	2408	(setq node fragment)
	2409	(catch 'abort
	2410	(while (and (not got-visible-elt) node (undo-tree-node-redo node))
	2411	;; we cons a dummy nil element on the front of the changeset so that
	2412	;; we can conveniently remove the first (real) element from the
	2413	;; changeset if we need to; the leading nil is removed once we're
	2414	;; done with this changeset
	2415	(setq redo-list (push nil (undo-tree-node-redo node))
	2416	elt (cadr redo-list))
	2417	(while elt
	2418	(cond
	2419	;; keep elements within region
	2420	((undo-elt-in-region elt start end)
	2421	;; set flag if kept element is visible (insertion or deletion)
	2422	(when (and (consp elt)
	2423	(or (stringp (car elt)) (integerp (car elt))))
	2424	(setq got-visible-elt t))
	2425	;; adjust buffer positions in elements previously redone before
	2426	;; kept element, as kept element will now be redone first
	2427	(undo-tree-adjust-elements-to-elt fragment elt t)
	2428	;; move kept element to redo-in-region changeset, adjusting its
	2429	;; buffer position as it will now be redone first
	2430	(setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
	2431	(setq r (cdr r))
	2432	(setcdr redo-list (cddr redo-list)))
	2433
	2434	;; discard "was unmodified" elements
	2435	;; FIXME: deal properly with these
	2436	((and (consp elt) (eq (car elt) t))
	2437	(setcdr redo-list (cddr redo-list)))
	2438
	2439	;; if element crosses region, we can't pull any more elements
	2440	((undo-elt-crosses-region elt start end)
	2441	;; if we've found a visible element, it must be earlier in
	2442	;; current node's changeset; stop pulling elements (null
	2443	;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
	2444	(if got-visible-elt
	2445	(setq redo-list nil)
	2446	;; if we haven't found a visible element yet, pulling
	2447	;; redo-in-region branch has failed
	2448	(setq region-changeset nil)
	2449	(throw 'abort t)))
	2450
	2451	;; if rejecting element, add its delta (if any) to the list
	2452	(t
	2453	(let ((delta (undo-delta elt)))
	2454	(when (/= 0 (cdr delta))
	2455	(setcdr d (list delta))
	2456	(setq d (cdr d))))
	2457	(setq redo-list (cdr redo-list))))
	2458
	2459	;; process next element of current changeset
	2460	(setq elt (cadr redo-list)))
	2461
	2462	;; if there are remaining elements in changeset, remove dummy nil
	2463	;; from front
	2464	(if (cadr (undo-tree-node-redo node))
	2465	(pop (undo-tree-node-undo node))
	2466	;; otherwise, if we've kept all elements in changeset, discard
	2467	;; empty changeset
	2468	(if (eq fragment node)
	2469	(setq fragment (car (undo-tree-node-next fragment)))
	2470	(undo-tree-snip-node node)))
	2471	;; process changeset from next node in fragment
	2472	(setq node (car (undo-tree-node-next node)))))
	2473
	2474	;; pop dummy nil from front of `region-changeset'
	2475	(setq region-changeset (cdr region-changeset))
	2476
	2477
	2478	;; --- integrate branch into tree ---
	2479	(setq node (undo-tree-current buffer-undo-tree))
	2480	;; if no redo-in-region elements were found, restore undo tree
	2481	(if (null (car region-changeset))
	2482	(when (and repeated-redo-in-region fragment)
	2483	(push fragment (undo-tree-node-next node))
	2484	(setf (undo-tree-node-branch node) 0
	2485	(undo-tree-node-previous fragment) node)
	2486	nil) ; return nil to indicate failure
	2487
	2488	;; otherwise, add redo-in-region node to top of fragment, and attach
	2489	;; it below current node
	2490	(setq fragment
	2491	(if fragment
	2492	(undo-tree-grow-backwards fragment nil region-changeset)
	2493	(undo-tree-make-node nil nil region-changeset)))
	2494	(push fragment (undo-tree-node-next node))
	2495	(setf (undo-tree-node-branch node) 0
	2496	(undo-tree-node-previous fragment) node)
	2497	;; update undo-tree size
	2498	(unless repeated-redo-in-region
	2499	(setq node fragment)
	2500	(while (and (setq node (car (undo-tree-node-next node)))
	2501	(incf (undo-tree-count buffer-undo-tree))
	2502	(incf (undo-tree-size buffer-undo-tree)
	2503	(undo-list-byte-size
	2504	(undo-tree-node-redo node))))))
	2505	(incf (undo-tree-size buffer-undo-tree)
	2506	(undo-list-byte-size (undo-tree-node-redo fragment)))
	2507	t) ; indicate redo-in-region branch was successfully pulled
	2508	)))
	2509
	2510
	2511
	2512	(defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
	2513	"Adjust buffer positions of undo elements, starting at NODE's
	2514	and going up the tree (or down the active branch if BELOW is
	2515	non-nil) and through the nodes' undo elements until we reach
	2516	UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
	2517	of either NODE itself or some node above it in the tree."
	2518	(let ((delta (list (undo-delta undo-elt)))
	2519	(undo-list (undo-tree-node-undo node)))
	2520	;; adjust elements until we reach UNDO-ELT
	2521	(while (and (car undo-list)
	2522	(not (eq (car undo-list) undo-elt)))
	2523	(setcar undo-list
	2524	(undo-tree-apply-deltas (car undo-list) delta -1))
	2525	;; move to next undo element in list, or to next node if we've run out
	2526	;; of elements
	2527	(unless (car (setq undo-list (cdr undo-list)))
	2528	(if below
	2529	(setq node (nth (undo-tree-node-branch node)
	2530	(undo-tree-node-next node)))
	2531	(setq node (undo-tree-node-previous node)))
	2532	(setq undo-list (undo-tree-node-undo node))))))
	2533
	2534
	2535
	2536	(defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
	2537	;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
	2538	;; (only useful value for SGN is -1).
	2539	(let (position offset)
	2540	(dolist (delta deltas)
	2541	(setq position (car delta)
	2542	offset (* (cdr delta) (or sgn 1)))
	2543	(cond
	2544	;; POSITION
	2545	((integerp undo-elt)
	2546	(when (>= undo-elt position)
	2547	(setq undo-elt (- undo-elt offset))))
	2548	;; nil (or any other atom)
	2549	((atom undo-elt))
	2550	;; (TEXT . POSITION)
	2551	((stringp (car undo-elt))
	2552	(let ((text-pos (abs (cdr undo-elt)))
	2553	(point-at-end (< (cdr undo-elt) 0)))
	2554	(if (>= text-pos position)
	2555	(setcdr undo-elt (* (if point-at-end -1 1)
	2556	(- text-pos offset))))))
	2557	;; (BEGIN . END)
	2558	((integerp (car undo-elt))
	2559	(when (>= (car undo-elt) position)
	2560	(setcar undo-elt (- (car undo-elt) offset))
	2561	(setcdr undo-elt (- (cdr undo-elt) offset))))
	2562	;; (nil PROPERTY VALUE BEG . END)
	2563	((null (car undo-elt))
	2564	(let ((tail (nthcdr 3 undo-elt)))
	2565	(when (>= (car tail) position)
	2566	(setcar tail (- (car tail) offset))
	2567	(setcdr tail (- (cdr tail) offset)))))
	2568	))
	2569	undo-elt))
	2570
	2571
	2572
	2573	(defun undo-tree-repeated-undo-in-region-p (start end)
	2574	;; Return non-nil if undo-in-region between START and END is a repeated
	2575	;; undo-in-region
	2576	(let ((node (undo-tree-current buffer-undo-tree)))
	2577	(and (setq node
	2578	(nth (undo-tree-node-branch node) (undo-tree-node-next node)))
	2579	(eq (undo-tree-node-undo-beginning node) start)
	2580	(eq (undo-tree-node-undo-end node) end))))
	2581
	2582
	2583	(defun undo-tree-repeated-redo-in-region-p (start end)
	2584	;; Return non-nil if undo-in-region between START and END is a repeated
	2585	;; undo-in-region
	2586	(let ((node (undo-tree-current buffer-undo-tree)))
	2587	(and (eq (undo-tree-node-redo-beginning node) start)
	2588	(eq (undo-tree-node-redo-end node) end))))
	2589
	2590
	2591	;; Return non-nil if undo-in-region between START and END is simply
	2592	;; reverting the last redo-in-region
	2593	(defalias 'undo-tree-reverting-undo-in-region-p
	2594	'undo-tree-repeated-undo-in-region-p)
	2595
	2596
	2597	;; Return non-nil if redo-in-region between START and END is simply
	2598	;; reverting the last undo-in-region
	2599	(defalias 'undo-tree-reverting-redo-in-region-p
	2600	'undo-tree-repeated-redo-in-region-p)
	2601
	2602
	2603
	2604
	2605	;;; =====================================================================
	2606	;;; Undo-tree commands
	2607
	2608	;;;###autoload
	2609	(define-minor-mode undo-tree-mode
	2610	"Toggle undo-tree mode.
	2611	With no argument, this command toggles the mode.
	2612	A positive prefix argument turns the mode on.
	2613	A negative prefix argument turns it off.
	2614
	2615	Undo-tree-mode replaces Emacs' standard undo feature with a more
	2616	powerful yet easier to use version, that treats the undo history
	2617	as what it is: a tree.
	2618
	2619	The following keys are available in `undo-tree-mode':
	2620
	2621	\\{undo-tree-map}
	2622
	2623	Within the undo-tree visualizer, the following keys are available:
	2624
	2625	\\{undo-tree-visualizer-mode-map}"
	2626
	2627	nil ; init value
	2628	undo-tree-mode-lighter ; lighter
	2629	undo-tree-map ; keymap
	2630
	2631	;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
	2632	;; Emacs undo can work
	2633	(when (not undo-tree-mode)
	2634	(undo-list-rebuild-from-tree)
	2635	(setq buffer-undo-tree nil)))
	2636
	2637
	2638	(defun turn-on-undo-tree-mode (&optional print-message)
	2639	"Enable `undo-tree-mode' in the current buffer, when appropriate.
	2640	Some major modes implement their own undo system, which should
	2641	not normally be overridden by `undo-tree-mode'. This command does
	2642	not enable `undo-tree-mode' in such buffers. If you want to force
	2643	`undo-tree-mode' to be enabled regardless, use (undo-tree-mode 1)
	2644	instead.
	2645
	2646	The heuristic used to detect major modes in which
	2647	`undo-tree-mode' should not be used is to check whether either
	2648	the `undo' command has been remapped, or the default undo
	2649	keybindings (C-/ and C-_) have been overridden somewhere other
	2650	than in the global map. In addition, `undo-tree-mode' will not be
	2651	enabled if the buffer's `major-mode' appears in
	2652	`undo-tree-incompatible-major-modes'."
	2653	(interactive "p")
	2654	(if (or (key-binding [remap undo])
	2655	(undo-tree-overridden-undo-bindings-p)
	2656	(memq major-mode undo-tree-incompatible-major-modes))
	2657	(when print-message
	2658	(message "Buffer does not support undo-tree-mode;\
	2659	undo-tree-mode NOT enabled"))
	2660	(undo-tree-mode 1)))
	2661
	2662
	2663	(defun undo-tree-overridden-undo-bindings-p ()
	2664	"Returns t if default undo bindings are overridden, nil otherwise.
	2665	Checks if either of the default undo key bindings (\"C-/\" or
	2666	\"C-_\") are overridden in the current buffer by any keymap other
	2667	than the global one. (So global redefinitions of the default undo
	2668	key bindings do not count.)"
	2669	(let ((binding1 (lookup-key (current-global-map) [?\C-/]))
	2670	(binding2 (lookup-key (current-global-map) [?\C-_])))
	2671	(global-set-key [?\C-/] 'undo)
	2672	(global-set-key [?\C-_] 'undo)
	2673	(unwind-protect
	2674	(or (and (key-binding [?\C-/])
	2675	(not (eq (key-binding [?\C-/]) 'undo)))
	2676	(and (key-binding [?\C-_])
	2677	(not (eq (key-binding [?\C-_]) 'undo))))
	2678	(global-set-key [?\C-/] binding1)
	2679	(global-set-key [?\C-_] binding2))))
	2680
	2681
	2682	;;;###autoload
	2683	(define-globalized-minor-mode global-undo-tree-mode
	2684	undo-tree-mode turn-on-undo-tree-mode)
	2685
	2686
	2687
	2688	(defun undo-tree-undo (&optional arg)
	2689	"Undo changes.
	2690	Repeat this command to undo more changes.
	2691	A numeric ARG serves as a repeat count.
	2692
	2693	In Transient Mark mode when the mark is active, only undo changes
	2694	within the current region. Similarly, when not in Transient Mark
	2695	mode, just \\[universal-argument] as an argument limits undo to
	2696	changes within the current region."
	2697	(interactive "*P")
	2698	;; throw error if undo is disabled in buffer
	2699	(when (eq buffer-undo-list t)
	2700	(user-error "No undo information in this buffer"))
	2701	(undo-tree-undo-1 arg)
	2702	;; inform user if at branch point
	2703	(when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
	2704
	2705
	2706	(defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
	2707	;; Internal undo function. An active mark in `transient-mark-mode', or
	2708	;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
	2709	;; causes the existing redo record to be preserved, rather than replacing it
	2710	;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
	2711	;; disables updating of timestamps in visited undo-tree nodes. (This latter
	2712	;; should only be used when temporarily visiting another undo state and
	2713	;; immediately returning to the original state afterwards. Otherwise, it
	2714	;; could cause history-discarding errors.)
	2715	(let ((undo-in-progress t)
	2716	(undo-in-region (and undo-tree-enable-undo-in-region
	2717	(or (region-active-p)
	2718	(and arg (not (numberp arg))))))
	2719	pos current)
	2720	;; transfer entries accumulated in `buffer-undo-list' to
	2721	;; `buffer-undo-tree'
	2722	(undo-list-transfer-to-tree)
	2723
	2724	(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
	2725	;; check if at top of undo tree
	2726	(unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
	2727	(user-error "No further undo information"))
	2728
	2729	;; if region is active, or a non-numeric prefix argument was supplied,
	2730	;; try to pull out a new branch of changes affecting the region
	2731	(when (and undo-in-region
	2732	(not (undo-tree-pull-undo-in-region-branch
	2733	(region-beginning) (region-end))))
	2734	(user-error "No further undo information for region"))
	2735
	2736	;; remove any GC'd elements from node's undo list
	2737	(setq current (undo-tree-current buffer-undo-tree))
	2738	(decf (undo-tree-size buffer-undo-tree)
	2739	(undo-list-byte-size (undo-tree-node-undo current)))
	2740	(setf (undo-tree-node-undo current)
	2741	(undo-list-clean-GCd-elts (undo-tree-node-undo current)))
	2742	(incf (undo-tree-size buffer-undo-tree)
	2743	(undo-list-byte-size (undo-tree-node-undo current)))
	2744	;; undo one record from undo tree
	2745	(when undo-in-region
	2746	(setq pos (set-marker (make-marker) (point)))
	2747	(set-marker-insertion-type pos t))
	2748	(primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
	2749	(undo-boundary)
	2750
	2751	;; if preserving old redo record, discard new redo entries that
	2752	;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
	2753	;; elements from node's redo list
	2754	(if preserve-redo
	2755	(progn
	2756	(undo-list-pop-changeset)
	2757	(decf (undo-tree-size buffer-undo-tree)
	2758	(undo-list-byte-size (undo-tree-node-redo current)))
	2759	(setf (undo-tree-node-redo current)
	2760	(undo-list-clean-GCd-elts (undo-tree-node-redo current)))
	2761	(incf (undo-tree-size buffer-undo-tree)
	2762	(undo-list-byte-size (undo-tree-node-redo current))))
	2763	;; otherwise, record redo entries that `primitive-undo' has added to
	2764	;; `buffer-undo-list' in current node's redo record, replacing
	2765	;; existing entry if one already exists
	2766	(decf (undo-tree-size buffer-undo-tree)
	2767	(undo-list-byte-size (undo-tree-node-redo current)))
	2768	(setf (undo-tree-node-redo current)
	2769	(undo-list-pop-changeset 'discard-pos))
	2770	(incf (undo-tree-size buffer-undo-tree)
	2771	(undo-list-byte-size (undo-tree-node-redo current))))
	2772
	2773	;; rewind current node and update timestamp
	2774	(setf (undo-tree-current buffer-undo-tree)
	2775	(undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
	2776	(unless preserve-timestamps
	2777	(setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
	2778	(current-time)))
	2779
	2780	;; if undoing-in-region, record current node, region and direction so we
	2781	;; can tell if undo-in-region is repeated, and re-activate mark if in
	2782	;; `transient-mark-mode'; if not, erase any leftover data
	2783	(if (not undo-in-region)
	2784	(undo-tree-node-clear-region-data current)
	2785	(goto-char pos)
	2786	;; note: we deliberately want to store the region information in the
	2787	;; node below the now current one
	2788	(setf (undo-tree-node-undo-beginning current) (region-beginning)
	2789	(undo-tree-node-undo-end current) (region-end))
	2790	(set-marker pos nil)))
	2791
	2792	;; undo deactivates mark unless undoing-in-region
	2793	(setq deactivate-mark (not undo-in-region))))
	2794
	2795
	2796
	2797	(defun undo-tree-redo (&optional arg)
	2798	"Redo changes. A numeric ARG serves as a repeat count.
	2799
	2800	In Transient Mark mode when the mark is active, only redo changes
	2801	within the current region. Similarly, when not in Transient Mark
	2802	mode, just \\[universal-argument] as an argument limits redo to
	2803	changes within the current region."
	2804	(interactive "*P")
	2805	;; throw error if undo is disabled in buffer
	2806	(when (eq buffer-undo-list t)
	2807	(user-error "No undo information in this buffer"))
	2808	(undo-tree-redo-1 arg)
	2809	;; inform user if at branch point
	2810	(when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
	2811
	2812
	2813	(defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
	2814	;; Internal redo function. An active mark in `transient-mark-mode', or
	2815	;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
	2816	;; causes the existing redo record to be preserved, rather than replacing it
	2817	;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
	2818	;; disables updating of timestamps in visited undo-tree nodes. (This latter
	2819	;; should only be used when temporarily visiting another undo state and
	2820	;; immediately returning to the original state afterwards. Otherwise, it
	2821	;; could cause history-discarding errors.)
	2822	(let ((undo-in-progress t)
	2823	(redo-in-region (and undo-tree-enable-undo-in-region
	2824	(or (region-active-p)
	2825	(and arg (not (numberp arg))))))
	2826	pos current)
	2827	;; transfer entries accumulated in `buffer-undo-list' to
	2828	;; `buffer-undo-tree'
	2829	(undo-list-transfer-to-tree)
	2830
	2831	(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
	2832	;; check if at bottom of undo tree
	2833	(when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
	2834	(user-error "No further redo information"))
	2835
	2836	;; if region is active, or a non-numeric prefix argument was supplied,
	2837	;; try to pull out a new branch of changes affecting the region
	2838	(when (and redo-in-region
	2839	(not (undo-tree-pull-redo-in-region-branch
	2840	(region-beginning) (region-end))))
	2841	(user-error "No further redo information for region"))
	2842
	2843	;; get next node (but DON'T advance current node in tree yet, in case
	2844	;; redoing fails)
	2845	(setq current (undo-tree-current buffer-undo-tree)
	2846	current (nth (undo-tree-node-branch current)
	2847	(undo-tree-node-next current)))
	2848	;; remove any GC'd elements from node's redo list
	2849	(decf (undo-tree-size buffer-undo-tree)
	2850	(undo-list-byte-size (undo-tree-node-redo current)))
	2851	(setf (undo-tree-node-redo current)
	2852	(undo-list-clean-GCd-elts (undo-tree-node-redo current)))
	2853	(incf (undo-tree-size buffer-undo-tree)
	2854	(undo-list-byte-size (undo-tree-node-redo current)))
	2855	;; redo one record from undo tree
	2856	(when redo-in-region
	2857	(setq pos (set-marker (make-marker) (point)))
	2858	(set-marker-insertion-type pos t))
	2859	(primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
	2860	(undo-boundary)
	2861	;; advance current node in tree
	2862	(setf (undo-tree-current buffer-undo-tree) current)
	2863
	2864	;; if preserving old undo record, discard new undo entries that
	2865	;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
	2866	;; elements from node's redo list
	2867	(if preserve-undo
	2868	(progn
	2869	(undo-list-pop-changeset)
	2870	(decf (undo-tree-size buffer-undo-tree)
	2871	(undo-list-byte-size (undo-tree-node-undo current)))
	2872	(setf (undo-tree-node-undo current)
	2873	(undo-list-clean-GCd-elts (undo-tree-node-undo current)))
	2874	(incf (undo-tree-size buffer-undo-tree)
	2875	(undo-list-byte-size (undo-tree-node-undo current))))
	2876	;; otherwise, record undo entries that `primitive-undo' has added to
	2877	;; `buffer-undo-list' in current node's undo record, replacing
	2878	;; existing entry if one already exists
	2879	(decf (undo-tree-size buffer-undo-tree)
	2880	(undo-list-byte-size (undo-tree-node-undo current)))
	2881	(setf (undo-tree-node-undo current)
	2882	(undo-list-pop-changeset 'discard-pos))
	2883	(incf (undo-tree-size buffer-undo-tree)
	2884	(undo-list-byte-size (undo-tree-node-undo current))))
	2885
	2886	;; update timestamp
	2887	(unless preserve-timestamps
	2888	(setf (undo-tree-node-timestamp current) (current-time)))
	2889
	2890	;; if redoing-in-region, record current node, region and direction so we
	2891	;; can tell if redo-in-region is repeated, and re-activate mark if in
	2892	;; `transient-mark-mode'
	2893	(if (not redo-in-region)
	2894	(undo-tree-node-clear-region-data current)
	2895	(goto-char pos)
	2896	(setf (undo-tree-node-redo-beginning current) (region-beginning)
	2897	(undo-tree-node-redo-end current) (region-end))
	2898	(set-marker pos nil)))
	2899
	2900	;; redo deactivates the mark unless redoing-in-region
	2901	(setq deactivate-mark (not redo-in-region))))
	2902
	2903
	2904
	2905	(defun undo-tree-switch-branch (branch)
	2906	"Switch to a different BRANCH of the undo tree.
	2907	This will affect which branch to descend when redoing changes
	2908	using `undo-tree-redo'."
	2909	(interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg))
	2910	(and (not (eq buffer-undo-list t))
	2911	(or (undo-list-transfer-to-tree) t)
	2912	(let ((b (undo-tree-node-branch
	2913	(undo-tree-current
	2914	buffer-undo-tree))))
	2915	(cond
	2916	;; switch to other branch if only 2
	2917	((= (undo-tree-num-branches) 2) (- 1 b))
	2918	;; prompt if more than 2
	2919	((> (undo-tree-num-branches) 2)
	2920	(read-number
	2921	(format "Branch (0-%d, on %d): "
	2922	(1- (undo-tree-num-branches)) b)))
	2923	))))))
	2924	;; throw error if undo is disabled in buffer
	2925	(when (eq buffer-undo-list t)
	2926	(user-error "No undo information in this buffer"))
	2927	;; sanity check branch number
	2928	(when (<= (undo-tree-num-branches) 1)
	2929	(user-error "Not at undo branch point"))
	2930	(when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
	2931	(user-error "Invalid branch number"))
	2932	;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
	2933	(undo-list-transfer-to-tree)
	2934	;; switch branch
	2935	(setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
	2936	branch)
	2937	(message "Switched to branch %d" branch))
	2938
	2939
	2940	(defun undo-tree-set (node &optional preserve-timestamps)
	2941	;; Set buffer to state corresponding to NODE. Returns intersection point
	2942	;; between path back from current node and path back from selected NODE.
	2943	;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
	2944	;; undo-tree nodes. (This should only be used when temporarily visiting
	2945	;; another undo state and immediately returning to the original state
	2946	;; afterwards. Otherwise, it could cause history-discarding errors.)
	2947	(let ((path (make-hash-table :test 'eq))
	2948	(n node))
	2949	(puthash (undo-tree-root buffer-undo-tree) t path)
	2950	;; build list of nodes leading back from selected node to root, updating
	2951	;; branches as we go to point down to selected node
	2952	(while (progn
	2953	(puthash n t path)
	2954	(when (undo-tree-node-previous n)
	2955	(setf (undo-tree-node-branch (undo-tree-node-previous n))
	2956	(undo-tree-position
	2957	n (undo-tree-node-next (undo-tree-node-previous n))))
	2958	(setq n (undo-tree-node-previous n)))))
	2959	;; work backwards from current node until we intersect path back from
	2960	;; selected node
	2961	(setq n (undo-tree-current buffer-undo-tree))
	2962	(while (not (gethash n path))
	2963	(setq n (undo-tree-node-previous n)))
	2964	;; ascend tree until intersection node
	2965	(while (not (eq (undo-tree-current buffer-undo-tree) n))
	2966	(undo-tree-undo-1 nil nil preserve-timestamps))
	2967	;; descend tree until selected node
	2968	(while (not (eq (undo-tree-current buffer-undo-tree) node))
	2969	(undo-tree-redo-1 nil nil preserve-timestamps))
	2970	n)) ; return intersection node
	2971
	2972
	2973
	2974	(defun undo-tree-save-state-to-register (register)
	2975	"Store current undo-tree state to REGISTER.
	2976	The saved state can be restored using
	2977	`undo-tree-restore-state-from-register'.
	2978	Argument is a character, naming the register."
	2979	(interactive "cUndo-tree state to register: ")
	2980	;; throw error if undo is disabled in buffer
	2981	(when (eq buffer-undo-list t)
	2982	(user-error "No undo information in this buffer"))
	2983	;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
	2984	(undo-list-transfer-to-tree)
	2985	;; save current node to REGISTER
	2986	(set-register
	2987	register (registerv-make
	2988	(undo-tree-make-register-data
	2989	(current-buffer) (undo-tree-current buffer-undo-tree))
	2990	:print-func 'undo-tree-register-data-print-func))
	2991	;; record REGISTER in current node, for visualizer
	2992	(setf (undo-tree-node-register (undo-tree-current buffer-undo-tree))
	2993	register))
	2994
	2995
	2996
	2997	(defun undo-tree-restore-state-from-register (register)
	2998	"Restore undo-tree state from REGISTER.
	2999	The state must be saved using `undo-tree-save-state-to-register'.
	3000	Argument is a character, naming the register."
	3001	(interactive "*cRestore undo-tree state from register: ")
	3002	;; throw error if undo is disabled in buffer, or if register doesn't contain
	3003	;; an undo-tree node
	3004	(let ((data (registerv-data (get-register register))))
	3005	(cond
	3006	((eq buffer-undo-list t)
	3007	(user-error "No undo information in this buffer"))
	3008	((not (undo-tree-register-data-p data))
	3009	(user-error "Register doesn't contain undo-tree state"))
	3010	((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
	3011	(user-error "Register contains undo-tree state for a different buffer")))
	3012	;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
	3013	(undo-list-transfer-to-tree)
	3014	;; restore buffer state corresponding to saved node
	3015	(undo-tree-set (undo-tree-register-data-node data))))
	3016
	3017
	3018
	3019
	3020	;;; =====================================================================
	3021	;;; Persistent storage commands
	3022
	3023	(defun undo-tree-make-history-save-file-name (file)
	3024	"Create the undo history file name for FILE.
	3025	Normally this is the file's name with \".\" prepended and
	3026	\".~undo-tree~\" appended.
	3027
	3028	A match for FILE is sought in `undo-tree-history-directory-alist'
	3029	\(see the documentation of that variable for details\). If the
	3030	directory for the backup doesn't exist, it is created."
	3031	(let* ((backup-directory-alist undo-tree-history-directory-alist)
	3032	(name (make-backup-file-name-1 file)))
	3033	(concat (file-name-directory name) "." (file-name-nondirectory name)
	3034	".~undo-tree~")))
	3035
	3036
	3037	(defun undo-tree-save-history (&optional filename overwrite)
	3038	"Store undo-tree history to file.
	3039
	3040	If optional argument FILENAME is omitted, default save file is
	3041	\".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
	3042	Otherwise, prompt for one.
	3043
	3044	If OVERWRITE is non-nil, any existing file will be overwritten
	3045	without asking for confirmation."
	3046	(interactive)
	3047	(when (eq buffer-undo-list t)
	3048	(user-error "No undo information in this buffer"))
	3049	(undo-list-transfer-to-tree)
	3050	(when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
	3051	(condition-case nil
	3052	(undo-tree-kill-visualizer)
	3053	(error (undo-tree-clear-visualizer-data buffer-undo-tree)))
	3054	(let ((buff (current-buffer))
	3055	tree)
	3056	;; get filename
	3057	(unless filename
	3058	(setq filename
	3059	(if buffer-file-name
	3060	(undo-tree-make-history-save-file-name buffer-file-name)
	3061	(expand-file-name (read-file-name "File to save in: ") nil))))
	3062	(when (or (not (file-exists-p filename))
	3063	overwrite
	3064	(yes-or-no-p (format "Overwrite \"%s\"? " filename)))
	3065	(unwind-protect
	3066	(progn
	3067	;; transform undo-tree into non-circular structure, and make
	3068	;; temporary copy
	3069	(undo-tree-decircle buffer-undo-tree)
	3070	(setq tree (copy-undo-tree buffer-undo-tree))
	3071	;; discard undo-tree object pool before saving
	3072	(setf (undo-tree-object-pool tree) nil)
	3073	;; print undo-tree to file
	3074	;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
	3075	;; to allow `auto-compression-mode' to take effect, in
	3076	;; case user has overridden or advised the default
	3077	;; `undo-tree-make-history-save-file-name' to add a
	3078	;; compressed file extension.
	3079	(with-auto-compression-mode
	3080	(with-temp-buffer
	3081	(prin1 (sha1 buff) (current-buffer))
	3082	(terpri (current-buffer))
	3083	(let ((print-circle t)) (prin1 tree (current-buffer)))
	3084	(write-region nil nil filename))))
	3085	;; restore circular undo-tree data structure
	3086	(undo-tree-recircle buffer-undo-tree))
	3087	))))
	3088
	3089
	3090
	3091	(defun undo-tree-load-history (&optional filename noerror)
	3092	"Load undo-tree history from file.
	3093
	3094	If optional argument FILENAME is null, default load file is
	3095	\".<buffer-file-name>.~undo-tree\" if buffer is visiting a file.
	3096	Otherwise, prompt for one.
	3097
	3098	If optional argument NOERROR is non-nil, return nil instead of
	3099	signaling an error if file is not found."
	3100	(interactive)
	3101	;; get filename
	3102	(unless filename
	3103	(setq filename
	3104	(if buffer-file-name
	3105	(undo-tree-make-history-save-file-name buffer-file-name)
	3106	(expand-file-name (read-file-name "File to load from: ") nil))))
	3107
	3108	;; attempt to read undo-tree from FILENAME
	3109	(catch 'load-error
	3110	(unless (file-exists-p filename)
	3111	(if noerror
	3112	(throw 'load-error nil)
	3113	(error "File \"%s\" does not exist; could not load undo-tree history"
	3114	filename)))
	3115	(let (buff hash tree)
	3116	(setq buff (current-buffer))
	3117	(with-auto-compression-mode
	3118	(with-temp-buffer
	3119	(insert-file-contents filename)
	3120	(goto-char (point-min))
	3121	(condition-case nil
	3122	(setq hash (read (current-buffer)))
	3123	(error
	3124	(kill-buffer nil)
	3125	(funcall (if noerror 'message 'user-error)
	3126	"Error reading undo-tree history from \"%s\"" filename)
	3127	(throw 'load-error nil)))
	3128	(unless (string= (sha1 buff) hash)
	3129	(kill-buffer nil)
	3130	(funcall (if noerror 'message 'user-error)
	3131	"Buffer has been modified; could not load undo-tree history")
	3132	(throw 'load-error nil))
	3133	(condition-case nil
	3134	(setq tree (read (current-buffer)))
	3135	(error
	3136	(kill-buffer nil)
	3137	(funcall (if noerror 'message 'error)
	3138	"Error reading undo-tree history from \"%s\"" filename)
	3139	(throw 'load-error nil)))
	3140	(kill-buffer nil)))
	3141	;; initialise empty undo-tree object pool
	3142	(setf (undo-tree-object-pool tree)
	3143	(make-hash-table :test 'eq :weakness 'value))
	3144	;; restore circular undo-tree data structure
	3145	(undo-tree-recircle tree)
	3146	(setq buffer-undo-tree tree))))
	3147
	3148
	3149
	3150	;; Versions of save/load functions for use in hooks
	3151	(defun undo-tree-save-history-hook ()
	3152	(when (and undo-tree-mode undo-tree-auto-save-history
	3153	(not (eq buffer-undo-list t)))
	3154	(undo-tree-save-history nil t) nil))
	3155
	3156	(defun undo-tree-load-history-hook ()
	3157	(when (and undo-tree-mode undo-tree-auto-save-history
	3158	(not (eq buffer-undo-list t))
	3159	(not revert-buffer-in-progress-p))
	3160	(undo-tree-load-history nil t)))
	3161
	3162
	3163
	3164
	3165	;;; =====================================================================
	3166	;;; Visualizer drawing functions
	3167
	3168	(defun undo-tree-visualize ()
	3169	"Visualize the current buffer's undo tree."
	3170	(interactive "*")
	3171	(deactivate-mark)
	3172	;; throw error if undo is disabled in buffer
	3173	(when (eq buffer-undo-list t)
	3174	(user-error "No undo information in this buffer"))
	3175	;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
	3176	(undo-list-transfer-to-tree)
	3177	;; add hook to kill visualizer buffer if original buffer is changed
	3178	(add-hook 'before-change-functions 'undo-tree-kill-visualizer nil t)
	3179	;; prepare undo-tree buffer, then draw tree in it
	3180	(let ((undo-tree buffer-undo-tree)
	3181	(buff (current-buffer))
	3182	(display-buffer-mark-dedicated 'soft))
	3183	(switch-to-buffer-other-window
	3184	(get-buffer-create undo-tree-visualizer-buffer-name))
	3185	(setq undo-tree-visualizer-parent-buffer buff)
	3186	(setq undo-tree-visualizer-parent-mtime
	3187	(and (buffer-file-name buff)
	3188	(nth 5 (file-attributes (buffer-file-name buff)))))
	3189	(setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
	3190	(setq undo-tree-visualizer-spacing
	3191	(undo-tree-visualizer-calculate-spacing))
	3192	(make-local-variable 'undo-tree-visualizer-timestamps)
	3193	(make-local-variable 'undo-tree-visualizer-diff)
	3194	(setq buffer-undo-tree undo-tree)
	3195	(undo-tree-visualizer-mode)
	3196	;; FIXME; don't know why `undo-tree-visualizer-mode' clears this
	3197	(setq buffer-undo-tree undo-tree)
	3198	(set (make-local-variable 'undo-tree-visualizer-lazy-drawing)
	3199	(or (eq undo-tree-visualizer-lazy-drawing t)
	3200	(and (numberp undo-tree-visualizer-lazy-drawing)
	3201	(>= (undo-tree-count undo-tree)
	3202	undo-tree-visualizer-lazy-drawing))))
	3203	(when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
	3204	(let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
	3205
	3206
	3207	(defun undo-tree-kill-visualizer (&rest _dummy)
	3208	;; Kill visualizer. Added to `before-change-functions' hook of original
	3209	;; buffer when visualizer is invoked.
	3210	(unless (or undo-tree-inhibit-kill-visualizer
	3211	(null (get-buffer undo-tree-visualizer-buffer-name)))
	3212	(with-current-buffer undo-tree-visualizer-buffer-name
	3213	(undo-tree-visualizer-quit))))
	3214
	3215
	3216
	3217	(defun undo-tree-draw-tree (undo-tree)
	3218	;; Draw undo-tree in current buffer starting from NODE (or root if nil).
	3219	(let ((node (if undo-tree-visualizer-lazy-drawing
	3220	(undo-tree-current undo-tree)
	3221	(undo-tree-root undo-tree))))
	3222	(erase-buffer)
	3223	(setq undo-tree-visualizer-needs-extending-down nil
	3224	undo-tree-visualizer-needs-extending-up nil)
	3225	(undo-tree-clear-visualizer-data undo-tree)
	3226	(undo-tree-compute-widths node)
	3227	;; lazy drawing starts vertically centred and displaced horizontally to
	3228	;; the left (window-width/4), since trees will typically grow right
	3229	(if undo-tree-visualizer-lazy-drawing
	3230	(progn
	3231	(undo-tree-move-down (/ (window-height) 2))
	3232	(undo-tree-move-forward (max 2 (/ (window-width) 4)))) ; left margin
	3233	;; non-lazy drawing starts in centre at top of buffer
	3234	(undo-tree-move-down 1) ; top margin
	3235	(undo-tree-move-forward
	3236	(max (/ (window-width) 2)
	3237	(+ (undo-tree-node-char-lwidth node)
	3238	;; add space for left part of left-most time-stamp
	3239	(if undo-tree-visualizer-timestamps
	3240	(/ (- undo-tree-visualizer-spacing 4) 2)
	3241	0)
	3242	2)))) ; left margin
	3243	;; link starting node to its representation in visualizer
	3244	(setf (undo-tree-node-marker node) (make-marker))
	3245	(set-marker-insertion-type (undo-tree-node-marker node) nil)
	3246	(move-marker (undo-tree-node-marker node) (point))
	3247	;; draw undo-tree
	3248	(let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
	3249	node-list)
	3250	(if (not undo-tree-visualizer-lazy-drawing)
	3251	(undo-tree-extend-down node t)
	3252	(undo-tree-extend-down node)
	3253	(undo-tree-extend-up node)
	3254	(setq node-list undo-tree-visualizer-needs-extending-down
	3255	undo-tree-visualizer-needs-extending-down nil)
	3256	(while node-list (undo-tree-extend-down (pop node-list)))))
	3257	;; highlight active branch
	3258	(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
	3259	(undo-tree-highlight-active-branch
	3260	(or undo-tree-visualizer-needs-extending-up
	3261	(undo-tree-root undo-tree))))
	3262	;; highlight current node
	3263	(undo-tree-draw-node (undo-tree-current undo-tree) 'current)))
	3264
	3265
	3266	(defun undo-tree-extend-down (node &optional bottom)
	3267	;; Extend tree downwards starting from NODE and point. If BOTTOM is t,
	3268	;; extend all the way down to the leaves. If BOTTOM is a node, extend down
	3269	;; as far as that node. If BOTTOM is an integer, extend down as far as that
	3270	;; line. Otherwise, only extend visible portion of tree. NODE is assumed to
	3271	;; already have a node marker. Returns non-nil if anything was actually
	3272	;; extended.
	3273	(let ((extended nil)
	3274	(cur-stack (list node))
	3275	next-stack)
	3276	;; don't bother extending if BOTTOM specifies an already-drawn node
	3277	(unless (and (undo-tree-node-p bottom) (undo-tree-node-marker bottom))
	3278	;; draw nodes layer by layer
	3279	(while (or cur-stack
	3280	(prog1 (setq cur-stack next-stack)
	3281	(setq next-stack nil)))
	3282	(setq node (pop cur-stack))
	3283	;; if node is within range being drawn...
	3284	(if (or (eq bottom t)
	3285	(and (undo-tree-node-p bottom)
	3286	(not (eq (undo-tree-node-previous node) bottom)))
	3287	(and (integerp bottom)
	3288	(>= bottom (line-number-at-pos
	3289	(undo-tree-node-marker node))))
	3290	(and (null bottom)
	3291	(pos-visible-in-window-p (undo-tree-node-marker node)
	3292	nil t)))
	3293	;; ...draw one layer of node's subtree (if not already drawn)
	3294	(progn
	3295	(unless (and (undo-tree-node-next node)
	3296	(undo-tree-node-marker
	3297	(nth (undo-tree-node-branch node)
	3298	(undo-tree-node-next node))))
	3299	(goto-char (undo-tree-node-marker node))
	3300	(undo-tree-draw-subtree node)
	3301	(setq extended t))
	3302	(setq next-stack
	3303	(append (undo-tree-node-next node) next-stack)))
	3304	;; ...otherwise, postpone drawing until later
	3305	(push node undo-tree-visualizer-needs-extending-down))))
	3306	extended))
	3307
	3308
	3309	(defun undo-tree-extend-up (node &optional top)
	3310	;; Extend tree upwards starting from NODE. If TOP is t, extend all the way
	3311	;; to root. If TOP is a node, extend up as far as that node. If TOP is an
	3312	;; integer, extend up as far as that line. Otherwise, only extend visible
	3313	;; portion of tree. NODE is assumed to already have a node marker. Returns
	3314	;; non-nil if anything was actually extended.
	3315	(let ((extended nil) parent)
	3316	;; don't bother extending if TOP specifies an already-drawn node
	3317	(unless (and (undo-tree-node-p top) (undo-tree-node-marker top))
	3318	(while node
	3319	(setq parent (undo-tree-node-previous node))
	3320	;; if we haven't reached root...
	3321	(if parent
	3322	;; ...and node is within range being drawn...
	3323	(if (or (eq top t)
	3324	(and (undo-tree-node-p top) (not (eq node top)))
	3325	(and (integerp top)
	3326	(< top (line-number-at-pos
	3327	(undo-tree-node-marker node))))
	3328	(and (null top)
	3329	;; NOTE: we check point in case window-start is outdated
	3330	(< (min (line-number-at-pos (point))
	3331	(line-number-at-pos (window-start)))
	3332	(line-number-at-pos
	3333	(undo-tree-node-marker node)))))
	3334	;; ...and it hasn't already been drawn
	3335	(when (not (undo-tree-node-marker parent))
	3336	;; link parent node to its representation in visualizer
	3337	(undo-tree-compute-widths parent)
	3338	(undo-tree-move-to-parent node)
	3339	(setf (undo-tree-node-marker parent) (make-marker))
	3340	(set-marker-insertion-type
	3341	(undo-tree-node-marker parent) nil)
	3342	(move-marker (undo-tree-node-marker parent) (point))
	3343	;; draw subtree beneath parent
	3344	(setq undo-tree-visualizer-needs-extending-down
	3345	(nconc (delq node (undo-tree-draw-subtree parent))
	3346	undo-tree-visualizer-needs-extending-down))
	3347	(setq extended t))
	3348	;; ...otherwise, postpone drawing for later and exit
	3349	(setq undo-tree-visualizer-needs-extending-up (when parent node)
	3350	parent nil))
	3351
	3352	;; if we've reached root, stop extending and add top margin
	3353	(setq undo-tree-visualizer-needs-extending-up nil)
	3354	(goto-char (undo-tree-node-marker node))
	3355	(undo-tree-move-up 1) ; top margin
	3356	(delete-region (point-min) (line-beginning-position)))
	3357	;; next iteration
	3358	(setq node parent)))
	3359	extended))
	3360
	3361
	3362	(defun undo-tree-expand-down (from &optional to)
	3363	;; Expand tree downwards. FROM is the node to start expanding from. Stop
	3364	;; expanding at TO if specified. Otherwise, just expand visible portion of
	3365	;; tree and highlight active branch from FROM.
	3366	(when undo-tree-visualizer-needs-extending-down
	3367	(let ((inhibit-read-only t)
	3368	node-list extended)
	3369	;; extend down as far as TO node
	3370	(when to
	3371	(setq extended (undo-tree-extend-down from to))
	3372	(goto-char (undo-tree-node-marker to))
	3373	(redisplay t)) ; force redisplay to scroll buffer if necessary
	3374	;; extend visible portion of tree downwards
	3375	(setq node-list undo-tree-visualizer-needs-extending-down
	3376	undo-tree-visualizer-needs-extending-down nil)
	3377	(when node-list
	3378	(dolist (n node-list)
	3379	(when (undo-tree-extend-down n) (setq extended t)))
	3380	;; highlight active branch in newly-extended-down portion, if any
	3381	(when extended
	3382	(let ((undo-tree-insert-face
	3383	'undo-tree-visualizer-active-branch-face))
	3384	(undo-tree-highlight-active-branch from)))))))
	3385
	3386
	3387	(defun undo-tree-expand-up (from &optional to)
	3388	;; Expand tree upwards. FROM is the node to start expanding from, TO is the
	3389	;; node to stop expanding at. If TO node isn't specified, just expand visible
	3390	;; portion of tree and highlight active branch down to FROM.
	3391	(when undo-tree-visualizer-needs-extending-up
	3392	(let ((inhibit-read-only t)
	3393	extended node-list)
	3394	;; extend up as far as TO node
	3395	(when to
	3396	(setq extended (undo-tree-extend-up from to))
	3397	(goto-char (undo-tree-node-marker to))
	3398	;; simulate auto-scrolling if close to top of buffer
	3399	(when (<= (line-number-at-pos (point)) scroll-margin)
	3400	(undo-tree-move-up (if (= scroll-conservatively 0)
	3401	(/ (window-height) 2) 3))
	3402	(when (undo-tree-extend-up to) (setq extended t))
	3403	(goto-char (undo-tree-node-marker to))
	3404	(unless (= scroll-conservatively 0) (recenter scroll-margin))))
	3405	;; extend visible portion of tree upwards
	3406	(and undo-tree-visualizer-needs-extending-up
	3407	(undo-tree-extend-up undo-tree-visualizer-needs-extending-up)
	3408	(setq extended t))
	3409	;; extend visible portion of tree downwards
	3410	(setq node-list undo-tree-visualizer-needs-extending-down
	3411	undo-tree-visualizer-needs-extending-down nil)
	3412	(dolist (n node-list) (undo-tree-extend-down n))
	3413	;; highlight active branch in newly-extended-up portion, if any
	3414	(when extended
	3415	(let ((undo-tree-insert-face
	3416	'undo-tree-visualizer-active-branch-face))
	3417	(undo-tree-highlight-active-branch
	3418	(or undo-tree-visualizer-needs-extending-up
	3419	(undo-tree-root buffer-undo-tree))
	3420	from))))))
	3421
	3422
	3423
	3424	(defun undo-tree-highlight-active-branch (node &optional end)
	3425	;; Draw highlighted active branch below NODE in current buffer. Stop
	3426	;; highlighting at END node if specified.
	3427	(let ((stack (list node)))
	3428	;; draw active branch
	3429	(while stack
	3430	(setq node (pop stack))
	3431	(unless (or (eq node end)
	3432	(memq node undo-tree-visualizer-needs-extending-down))
	3433	(goto-char (undo-tree-node-marker node))
	3434	(setq node (undo-tree-draw-subtree node 'active)
	3435	stack (nconc stack node))))))
	3436
	3437
	3438	(defun undo-tree-draw-node (node &optional current)
	3439	;; Draw symbol representing NODE in visualizer. If CURRENT is non-nil, node
	3440	;; is current node.
	3441	(goto-char (undo-tree-node-marker node))
	3442	(when undo-tree-visualizer-timestamps
	3443	(undo-tree-move-backward (/ undo-tree-visualizer-spacing 2)))
	3444
	3445	(let* ((undo-tree-insert-face (and undo-tree-insert-face
	3446	(or (and (consp undo-tree-insert-face)
	3447	undo-tree-insert-face)
	3448	(list undo-tree-insert-face))))
	3449	(register (undo-tree-node-register node))
	3450	(unmodified (if undo-tree-visualizer-parent-mtime
	3451	(undo-tree-node-unmodified-p
	3452	node undo-tree-visualizer-parent-mtime)
	3453	(undo-tree-node-unmodified-p node)))
	3454	node-string)
	3455	;; check node's register (if any) still stores appropriate undo-tree state
	3456	(unless (and register
	3457	(undo-tree-register-data-p
	3458	(registerv-data (get-register register)))
	3459	(eq node (undo-tree-register-data-node
	3460	(registerv-data (get-register register)))))
	3461	(setq register nil))
	3462	;; represent node by different symbols, depending on whether it's the
	3463	;; current node, is saved in a register, or corresponds to an unmodified
	3464	;; buffer
	3465	(setq node-string
	3466	(cond
	3467	(undo-tree-visualizer-timestamps
	3468	(undo-tree-timestamp-to-string
	3469	(undo-tree-node-timestamp node)
	3470	undo-tree-visualizer-relative-timestamps
	3471	current register))
	3472	(register (char-to-string register))
	3473	(unmodified "s")
	3474	(current "x")
	3475	(t "o"))
	3476	undo-tree-insert-face
	3477	(nconc
	3478	(cond
	3479	(current '(undo-tree-visualizer-current-face))
	3480	(unmodified '(undo-tree-visualizer-unmodified-face))
	3481	(register '(undo-tree-visualizer-register-face)))
	3482	undo-tree-insert-face))
	3483	;; draw node and link it to its representation in visualizer
	3484	(undo-tree-insert node-string)
	3485	(undo-tree-move-backward (if undo-tree-visualizer-timestamps
	3486	(1+ (/ undo-tree-visualizer-spacing 2))
	3487	1))
	3488	(move-marker (undo-tree-node-marker node) (point))
	3489	(put-text-property (point) (1+ (point)) 'undo-tree-node node)))
	3490
	3491
	3492	(defun undo-tree-draw-subtree (node &optional active-branch)
	3493	;; Draw subtree rooted at NODE. The subtree will start from point.
	3494	;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. Returns
	3495	;; list of nodes below NODE.
	3496	(let ((num-children (length (undo-tree-node-next node)))
	3497	node-list pos trunk-pos n)
	3498	;; draw node itself
	3499	(undo-tree-draw-node node)
	3500
	3501	(cond
	3502	;; if we're at a leaf node, we're done
	3503	((= num-children 0))
	3504
	3505	;; if node has only one child, draw it (not strictly necessary to deal
	3506	;; with this case separately, but as it's by far the most common case
	3507	;; this makes the code clearer and more efficient)
	3508	((= num-children 1)
	3509	(undo-tree-move-down 1)
	3510	(undo-tree-insert ?\|)
	3511	(undo-tree-move-backward 1)
	3512	(undo-tree-move-down 1)
	3513	(undo-tree-insert ?\|)
	3514	(undo-tree-move-backward 1)
	3515	(undo-tree-move-down 1)
	3516	(setq n (car (undo-tree-node-next node)))
	3517	;; link next node to its representation in visualizer
	3518	(unless (markerp (undo-tree-node-marker n))
	3519	(setf (undo-tree-node-marker n) (make-marker))
	3520	(set-marker-insertion-type (undo-tree-node-marker n) nil))
	3521	(move-marker (undo-tree-node-marker n) (point))
	3522	;; add next node to list of nodes to draw next
	3523	(push n node-list))
	3524
	3525	;; if node has multiple children, draw branches
	3526	(t
	3527	(undo-tree-move-down 1)
	3528	(undo-tree-insert ?\|)
	3529	(undo-tree-move-backward 1)
	3530	(move-marker (setq trunk-pos (make-marker)) (point))
	3531	;; left subtrees
	3532	(undo-tree-move-backward
	3533	(- (undo-tree-node-char-lwidth node)
	3534	(undo-tree-node-char-lwidth
	3535	(car (undo-tree-node-next node)))))
	3536	(move-marker (setq pos (make-marker)) (point))
	3537	(setq n (cons nil (undo-tree-node-next node)))
	3538	(dotimes (i (/ num-children 2))
	3539	(setq n (cdr n))
	3540	(when (or (null active-branch)
	3541	(eq (car n)
	3542	(nth (undo-tree-node-branch node)
	3543	(undo-tree-node-next node))))
	3544	(undo-tree-move-forward 2)
	3545	(undo-tree-insert ?_ (- trunk-pos pos 2))
	3546	(goto-char pos)
	3547	(undo-tree-move-forward 1)
	3548	(undo-tree-move-down 1)
	3549	(undo-tree-insert ?/)
	3550	(undo-tree-move-backward 2)
	3551	(undo-tree-move-down 1)
	3552	;; link node to its representation in visualizer
	3553	(unless (markerp (undo-tree-node-marker (car n)))
	3554	(setf (undo-tree-node-marker (car n)) (make-marker))
	3555	(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
	3556	(move-marker (undo-tree-node-marker (car n)) (point))
	3557	;; add node to list of nodes to draw next
	3558	(push (car n) node-list))
	3559	(goto-char pos)
	3560	(undo-tree-move-forward
	3561	(+ (undo-tree-node-char-rwidth (car n))
	3562	(undo-tree-node-char-lwidth (cadr n))
	3563	undo-tree-visualizer-spacing 1))
	3564	(move-marker pos (point)))
	3565	;; middle subtree (only when number of children is odd)
	3566	(when (= (mod num-children 2) 1)
	3567	(setq n (cdr n))
	3568	(when (or (null active-branch)
	3569	(eq (car n)
	3570	(nth (undo-tree-node-branch node)
	3571	(undo-tree-node-next node))))
	3572	(undo-tree-move-down 1)
	3573	(undo-tree-insert ?\|)
	3574	(undo-tree-move-backward 1)
	3575	(undo-tree-move-down 1)
	3576	;; link node to its representation in visualizer
	3577	(unless (markerp (undo-tree-node-marker (car n)))
	3578	(setf (undo-tree-node-marker (car n)) (make-marker))
	3579	(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
	3580	(move-marker (undo-tree-node-marker (car n)) (point))
	3581	;; add node to list of nodes to draw next
	3582	(push (car n) node-list))
	3583	(goto-char pos)
	3584	(undo-tree-move-forward
	3585	(+ (undo-tree-node-char-rwidth (car n))
	3586	(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
	3587	undo-tree-visualizer-spacing 1))
	3588	(move-marker pos (point)))
	3589	;; right subtrees
	3590	(move-marker trunk-pos (1+ trunk-pos))
	3591	(dotimes (i (/ num-children 2))
	3592	(setq n (cdr n))
	3593	(when (or (null active-branch)
	3594	(eq (car n)
	3595	(nth (undo-tree-node-branch node)
	3596	(undo-tree-node-next node))))
	3597	(goto-char trunk-pos)
	3598	(undo-tree-insert ?_ (- pos trunk-pos 1))
	3599	(goto-char pos)
	3600	(undo-tree-move-backward 1)
	3601	(undo-tree-move-down 1)
	3602	(undo-tree-insert ?\\)
	3603	(undo-tree-move-down 1)
	3604	;; link node to its representation in visualizer
	3605	(unless (markerp (undo-tree-node-marker (car n)))
	3606	(setf (undo-tree-node-marker (car n)) (make-marker))
	3607	(set-marker-insertion-type (undo-tree-node-marker (car n)) nil))
	3608	(move-marker (undo-tree-node-marker (car n)) (point))
	3609	;; add node to list of nodes to draw next
	3610	(push (car n) node-list))
	3611	(when (cdr n)
	3612	(goto-char pos)
	3613	(undo-tree-move-forward
	3614	(+ (undo-tree-node-char-rwidth (car n))
	3615	(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
	3616	undo-tree-visualizer-spacing 1))
	3617	(move-marker pos (point))))
	3618	))
	3619	;; return list of nodes to draw next
	3620	(nreverse node-list)))
	3621
	3622
	3623	(defun undo-tree-node-char-lwidth (node)
	3624	;; Return left-width of NODE measured in characters.
	3625	(if (= (length (undo-tree-node-next node)) 0) 0
	3626	(- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-lwidth node))
	3627	(if (= (undo-tree-node-cwidth node) 0)
	3628	(1+ (/ undo-tree-visualizer-spacing 2)) 0))))
	3629
	3630
	3631	(defun undo-tree-node-char-rwidth (node)
	3632	;; Return right-width of NODE measured in characters.
	3633	(if (= (length (undo-tree-node-next node)) 0) 0
	3634	(- (* (+ undo-tree-visualizer-spacing 1) (undo-tree-node-rwidth node))
	3635	(if (= (undo-tree-node-cwidth node) 0)
	3636	(1+ (/ undo-tree-visualizer-spacing 2)) 0))))
	3637
	3638
	3639	(defun undo-tree-insert (str &optional arg)
	3640	;; Insert character or string STR ARG times, overwriting, and using
	3641	;; `undo-tree-insert-face'.
	3642	(unless arg (setq arg 1))
	3643	(when (characterp str)
	3644	(setq str (make-string arg str))
	3645	(setq arg 1))
	3646	(dotimes (i arg) (insert str))
	3647	(setq arg (* arg (length str)))
	3648	(undo-tree-move-forward arg)
	3649	;; make sure mark isn't active, otherwise `backward-delete-char' might
	3650	;; delete region instead of single char if transient-mark-mode is enabled
	3651	(setq mark-active nil)
	3652	(backward-delete-char arg)
	3653	(when undo-tree-insert-face
	3654	(put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
	3655
	3656
	3657	(defun undo-tree-move-down (&optional arg)
	3658	;; Move down, extending buffer if necessary.
	3659	(let ((row (line-number-at-pos))
	3660	(col (current-column))
	3661	line)
	3662	(unless arg (setq arg 1))
	3663	(forward-line arg)
	3664	(setq line (line-number-at-pos))
	3665	;; if buffer doesn't have enough lines, add some
	3666	(when (/= line (+ row arg))
	3667	(cond
	3668	((< arg 0)
	3669	(insert (make-string (- line row arg) ?\n))
	3670	(forward-line (+ arg (- row line))))
	3671	(t (insert (make-string (- arg (- line row)) ?\n)))))
	3672	(undo-tree-move-forward col)))
	3673
	3674
	3675	(defun undo-tree-move-up (&optional arg)
	3676	;; Move up, extending buffer if necessary.
	3677	(unless arg (setq arg 1))
	3678	(undo-tree-move-down (- arg)))
	3679
	3680
	3681	(defun undo-tree-move-forward (&optional arg)
	3682	;; Move forward, extending buffer if necessary.
	3683	(unless arg (setq arg 1))
	3684	(let (n)
	3685	(cond
	3686	((>= arg 0)
	3687	(setq n (- (line-end-position) (point)))
	3688	(if (> n arg)
	3689	(forward-char arg)
	3690	(end-of-line)
	3691	(insert (make-string (- arg n) ? ))))
	3692	((< arg 0)
	3693	(setq arg (- arg))
	3694	(setq n (- (point) (line-beginning-position)))
	3695	(when (< (- n 2) arg) ; -2 to create left-margin
	3696	;; no space left - shift entire buffer contents right!
	3697	(let ((pos (move-marker (make-marker) (point))))
	3698	(set-marker-insertion-type pos t)
	3699	(goto-char (point-min))
	3700	(while (not (eobp))
	3701	(insert-before-markers (make-string (- arg -2 n) ? ))
	3702	(forward-line 1))
	3703	(goto-char pos)))
	3704	(backward-char arg)))))
	3705
	3706
	3707	(defun undo-tree-move-backward (&optional arg)
	3708	;; Move backward, extending buffer if necessary.
	3709	(unless arg (setq arg 1))
	3710	(undo-tree-move-forward (- arg)))
	3711
	3712
	3713	(defun undo-tree-move-to-parent (node)
	3714	;; Move to position of parent of NODE, extending buffer if necessary.
	3715	(let* ((parent (undo-tree-node-previous node))
	3716	(n (undo-tree-node-next parent))
	3717	(l (length n)) p)
	3718	(goto-char (undo-tree-node-marker node))
	3719	(unless (= l 1)
	3720	;; move horizontally
	3721	(setq p (undo-tree-position node n))
	3722	(cond
	3723	;; node in centre subtree: no horizontal movement
	3724	((and (= (mod l 2) 1) (= p (/ l 2))))
	3725	;; node in left subtree: move right
	3726	((< p (/ l 2))
	3727	(setq n (nthcdr p n))
	3728	(undo-tree-move-forward
	3729	(+ (undo-tree-node-char-rwidth (car n))
	3730	(/ undo-tree-visualizer-spacing 2) 1))
	3731	(dotimes (i (- (/ l 2) p 1))
	3732	(setq n (cdr n))
	3733	(undo-tree-move-forward
	3734	(+ (undo-tree-node-char-lwidth (car n))
	3735	(undo-tree-node-char-rwidth (car n))
	3736	undo-tree-visualizer-spacing 1)))
	3737	(when (= (mod l 2) 1)
	3738	(setq n (cdr n))
	3739	(undo-tree-move-forward
	3740	(+ (undo-tree-node-char-lwidth (car n))
	3741	(/ undo-tree-visualizer-spacing 2) 1))))
	3742	(t ;; node in right subtree: move left
	3743	(setq n (nthcdr (/ l 2) n))
	3744	(when (= (mod l 2) 1)
	3745	(undo-tree-move-backward
	3746	(+ (undo-tree-node-char-rwidth (car n))
	3747	(/ undo-tree-visualizer-spacing 2) 1))
	3748	(setq n (cdr n)))
	3749	(dotimes (i (- p (/ l 2) (mod l 2)))
	3750	(undo-tree-move-backward
	3751	(+ (undo-tree-node-char-lwidth (car n))
	3752	(undo-tree-node-char-rwidth (car n))
	3753	undo-tree-visualizer-spacing 1))
	3754	(setq n (cdr n)))
	3755	(undo-tree-move-backward
	3756	(+ (undo-tree-node-char-lwidth (car n))
	3757	(/ undo-tree-visualizer-spacing 2) 1)))))
	3758	;; move vertically
	3759	(undo-tree-move-up 3)))
	3760
	3761
	3762	(defun undo-tree-timestamp-to-string
	3763	(timestamp &optional relative current register)
	3764	;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
	3765	;; if it's the CURRENT node and/or has an associated REGISTER.
	3766	(if relative
	3767	;; relative time
	3768	(let ((time (floor (float-time
	3769	(subtract-time (current-time) timestamp))))
	3770	n)
	3771	(setq time
	3772	;; years
	3773	(if (> (setq n (/ time 315360000)) 0)
	3774	(if (> n 999) "-ages" (format "-%dy" n))
	3775	(setq time (% time 315360000))
	3776	;; days
	3777	(if (> (setq n (/ time 86400)) 0)
	3778	(format "-%dd" n)
	3779	(setq time (% time 86400))
	3780	;; hours
	3781	(if (> (setq n (/ time 3600)) 0)
	3782	(format "-%dh" n)
	3783	(setq time (% time 3600))
	3784	;; mins
	3785	(if (> (setq n (/ time 60)) 0)
	3786	(format "-%dm" n)
	3787	;; secs
	3788	(format "-%ds" (% time 60)))))))
	3789	(setq time (concat
	3790	(if current "*" " ")
	3791	time
	3792	(if register (concat "[" (char-to-string register) "]")
	3793	" ")))
	3794	(setq n (length time))
	3795	(if (< n 9)
	3796	(concat (make-string (- 9 n) ? ) time)
	3797	time))
	3798	;; absolute time
	3799	(concat (if current " *" " ")
	3800	(format-time-string "%H:%M:%S" timestamp)
	3801	(if register
	3802	(concat "[" (char-to-string register) "]")
	3803	" "))))
	3804
	3805
	3806
	3807
	3808	;;; =====================================================================
	3809	;;; Visualizer commands
	3810
	3811	(define-derived-mode
	3812	undo-tree-visualizer-mode special-mode "undo-tree-visualizer"
	3813	"Major mode used in undo-tree visualizer.
	3814
	3815	The undo-tree visualizer can only be invoked from a buffer in
	3816	which `undo-tree-mode' is enabled. The visualizer displays the
	3817	undo history tree graphically, and allows you to browse around
	3818	the undo history, undoing or redoing the corresponding changes in
	3819	the parent buffer.
	3820
	3821	Within the undo-tree visualizer, the following keys are available:
	3822
	3823	\\{undo-tree-visualizer-mode-map}"
	3824	:syntax-table nil
	3825	:abbrev-table nil
	3826	(setq truncate-lines t)
	3827	(setq cursor-type nil)
	3828	(setq undo-tree-visualizer-selected-node nil))
	3829
	3830
	3831
	3832	(defun undo-tree-visualize-undo (&optional arg)
	3833	"Undo changes. A numeric ARG serves as a repeat count."
	3834	(interactive "p")
	3835	(let ((old (undo-tree-current buffer-undo-tree))
	3836	current)
	3837	;; unhighlight old current node
	3838	(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
	3839	(inhibit-read-only t))
	3840	(undo-tree-draw-node old))
	3841	;; undo in parent buffer
	3842	(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
	3843	(deactivate-mark)
	3844	(unwind-protect
	3845	(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo-1 arg))
	3846	(setq current (undo-tree-current buffer-undo-tree))
	3847	(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
	3848	;; when using lazy drawing, extend tree upwards as required
	3849	(when undo-tree-visualizer-lazy-drawing
	3850	(undo-tree-expand-up old current))
	3851	;; highlight new current node
	3852	(let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
	3853	;; update diff display, if any
	3854	(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
	3855
	3856
	3857	(defun undo-tree-visualize-redo (&optional arg)
	3858	"Redo changes. A numeric ARG serves as a repeat count."
	3859	(interactive "p")
	3860	(let ((old (undo-tree-current buffer-undo-tree))
	3861	current)
	3862	;; unhighlight old current node
	3863	(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
	3864	(inhibit-read-only t))
	3865	(undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
	3866	;; redo in parent buffer
	3867	(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
	3868	(deactivate-mark)
	3869	(unwind-protect
	3870	(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo-1 arg))
	3871	(setq current (undo-tree-current buffer-undo-tree))
	3872	(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
	3873	;; when using lazy drawing, extend tree downwards as required
	3874	(when undo-tree-visualizer-lazy-drawing
	3875	(undo-tree-expand-down old current))
	3876	;; highlight new current node
	3877	(let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
	3878	;; update diff display, if any
	3879	(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
	3880
	3881
	3882	(defun undo-tree-visualize-switch-branch-right (arg)
	3883	"Switch to next branch of the undo tree.
	3884	This will affect which branch to descend when redoing changes
	3885	using `undo-tree-redo' or `undo-tree-visualizer-redo'."
	3886	(interactive "p")
	3887	;; un-highlight old active branch below current node
	3888	(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
	3889	(let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
	3890	(inhibit-read-only t))
	3891	(undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
	3892	;; increment branch
	3893	(let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree))))
	3894	(setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
	3895	(cond
	3896	((>= (+ branch arg) (undo-tree-num-branches))
	3897	(1- (undo-tree-num-branches)))
	3898	((<= (+ branch arg) 0) 0)
	3899	(t (+ branch arg))))
	3900	(let ((inhibit-read-only t))
	3901	;; highlight new active branch below current node
	3902	(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
	3903	(let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
	3904	(undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree)))
	3905	;; re-highlight current node
	3906	(undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
	3907
	3908
	3909	(defun undo-tree-visualize-switch-branch-left (arg)
	3910	"Switch to previous branch of the undo tree.
	3911	This will affect which branch to descend when redoing changes
	3912	using `undo-tree-redo' or `undo-tree-visualizer-redo'."
	3913	(interactive "p")
	3914	(undo-tree-visualize-switch-branch-right (- arg)))
	3915
	3916
	3917	(defun undo-tree-visualizer-quit ()
	3918	"Quit the undo-tree visualizer."
	3919	(interactive)
	3920	(undo-tree-clear-visualizer-data buffer-undo-tree)
	3921	;; remove kill visualizer hook from parent buffer
	3922	(unwind-protect
	3923	(with-current-buffer undo-tree-visualizer-parent-buffer
	3924	(remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
	3925	;; kill diff buffer, if any
	3926	(when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
	3927	(let ((parent undo-tree-visualizer-parent-buffer)
	3928	window)
	3929	;; kill visualizer buffer
	3930	(kill-buffer nil)
	3931	;; switch back to parent buffer
	3932	(unwind-protect
	3933	(if (setq window (get-buffer-window parent))
	3934	(select-window window)
	3935	(switch-to-buffer parent))))))
	3936
	3937
	3938	(defun undo-tree-visualizer-abort ()
	3939	"Quit the undo-tree visualizer and return buffer to original state."
	3940	(interactive)
	3941	(let ((node undo-tree-visualizer-initial-node))
	3942	(undo-tree-visualizer-quit)
	3943	(undo-tree-set node)))
	3944
	3945
	3946	(defun undo-tree-visualizer-set (&optional pos)
	3947	"Set buffer to state corresponding to undo tree node
	3948	at POS, or point if POS is nil."
	3949	(interactive)
	3950	(unless pos (setq pos (point)))
	3951	(let ((node (get-text-property pos 'undo-tree-node)))
	3952	(when node
	3953	;; set parent buffer to state corresponding to node at POS
	3954	(switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
	3955	(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
	3956	(switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
	3957	;; re-draw undo tree
	3958	(let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
	3959	(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
	3960
	3961
	3962	(defun undo-tree-visualizer-mouse-set (pos)
	3963	"Set buffer to state corresponding to undo tree node
	3964	at mouse event POS."
	3965	(interactive "@e")
	3966	(undo-tree-visualizer-set (event-start (nth 1 pos))))
	3967
	3968
	3969	(defun undo-tree-visualize-undo-to-x (&optional x)
	3970	"Undo to last branch point, register, or saved state.
	3971	If X is the symbol `branch', undo to last branch point. If X is
	3972	the symbol `register', undo to last register. If X is the sumbol
	3973	`saved', undo to last saved state. If X is null, undo to first of
	3974	these that's encountered.
	3975
	3976	Interactively, a single \\[universal-argument] specifies
	3977	`branch', a double \\[universal-argument] \\[universal-argument]
	3978	specifies `saved', and a negative prefix argument specifies
	3979	`register'."
	3980	(interactive "P")
	3981	(when (and (called-interactively-p 'any) x)
	3982	(setq x (prefix-numeric-value x)
	3983	x (cond
	3984	((< x 0) 'register)
	3985	((<= x 4) 'branch)
	3986	(t 'saved))))
	3987	(let ((current (if undo-tree-visualizer-selection-mode
	3988	undo-tree-visualizer-selected-node
	3989	(undo-tree-current buffer-undo-tree)))
	3990	(diff undo-tree-visualizer-diff)
	3991	r)
	3992	(undo-tree-visualizer-hide-diff)
	3993	(while (and (undo-tree-node-previous current)
	3994	(or (if undo-tree-visualizer-selection-mode
	3995	(progn
	3996	(undo-tree-visualizer-select-previous)
	3997	(setq current undo-tree-visualizer-selected-node))
	3998	(undo-tree-visualize-undo)
	3999	(setq current (undo-tree-current buffer-undo-tree)))
	4000	t)
	4001	;; branch point
	4002	(not (or (and (or (null x) (eq x 'branch))
	4003	(> (undo-tree-num-branches) 1))
	4004	;; register
	4005	(and (or (null x) (eq x 'register))
	4006	(setq r (undo-tree-node-register current))
	4007	(undo-tree-register-data-p
	4008	(setq r (registerv-data (get-register r))))
	4009	(eq current (undo-tree-register-data-node r)))
	4010	;; saved state
	4011	(and (or (null x) (eq x 'saved))
	4012	(undo-tree-node-unmodified-p current))
	4013	))))
	4014	;; update diff display, if any
	4015	(when diff
	4016	(undo-tree-visualizer-show-diff
	4017	(when undo-tree-visualizer-selection-mode
	4018	undo-tree-visualizer-selected-node)))))
	4019
	4020
	4021	(defun undo-tree-visualize-redo-to-x (&optional x)
	4022	"Redo to last branch point, register, or saved state.
	4023	If X is the symbol `branch', redo to last branch point. If X is
	4024	the symbol `register', redo to last register. If X is the sumbol
	4025	`saved', redo to last saved state. If X is null, redo to first of
	4026	these that's encountered.
	4027
	4028	Interactively, a single \\[universal-argument] specifies
	4029	`branch', a double \\[universal-argument] \\[universal-argument]
	4030	specifies `saved', and a negative prefix argument specifies
	4031	`register'."
	4032	(interactive "P")
	4033	(when (and (called-interactively-p 'any) x)
	4034	(setq x (prefix-numeric-value x)
	4035	x (cond
	4036	((< x 0) 'register)
	4037	((<= x 4) 'branch)
	4038	(t 'saved))))
	4039	(let ((current (if undo-tree-visualizer-selection-mode
	4040	undo-tree-visualizer-selected-node
	4041	(undo-tree-current buffer-undo-tree)))
	4042	(diff undo-tree-visualizer-diff)
	4043	r)
	4044	(undo-tree-visualizer-hide-diff)
	4045	(while (and (undo-tree-node-next current)
	4046	(or (if undo-tree-visualizer-selection-mode
	4047	(progn
	4048	(undo-tree-visualizer-select-next)
	4049	(setq current undo-tree-visualizer-selected-node))
	4050	(undo-tree-visualize-redo)
	4051	(setq current (undo-tree-current buffer-undo-tree)))
	4052	t)
	4053	;; branch point
	4054	(not (or (and (or (null x) (eq x 'branch))
	4055	(> (undo-tree-num-branches) 1))
	4056	;; register
	4057	(and (or (null x) (eq x 'register))
	4058	(setq r (undo-tree-node-register current))
	4059	(undo-tree-register-data-p
	4060	(setq r (registerv-data (get-register r))))
	4061	(eq current (undo-tree-register-data-node r)))
	4062	;; saved state
	4063	(and (or (null x) (eq x 'saved))
	4064	(undo-tree-node-unmodified-p current))
	4065	))))
	4066	;; update diff display, if any
	4067	(when diff
	4068	(undo-tree-visualizer-show-diff
	4069	(when undo-tree-visualizer-selection-mode
	4070	undo-tree-visualizer-selected-node)))))
	4071
	4072
	4073	(defun undo-tree-visualizer-toggle-timestamps ()
	4074	"Toggle display of time-stamps."
	4075	(interactive)
	4076	(setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
	4077	(setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
	4078	;; redraw tree
	4079	(let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
	4080
	4081
	4082	(defun undo-tree-visualizer-scroll-left (&optional arg)
	4083	(interactive "p")
	4084	(scroll-left (or arg 1) t))
	4085
	4086
	4087	(defun undo-tree-visualizer-scroll-right (&optional arg)
	4088	(interactive "p")
	4089	(scroll-right (or arg 1) t))
	4090
	4091
	4092	(defun undo-tree-visualizer-scroll-up (&optional arg)
	4093	(interactive "P")
	4094	(if (or (and (numberp arg) (< arg 0)) (eq arg '-))
	4095	(undo-tree-visualizer-scroll-down arg)
	4096	;; scroll up and expand newly-visible portion of tree
	4097	(unwind-protect
	4098	(scroll-up-command arg)
	4099	(undo-tree-expand-down
	4100	(nth (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
	4101	(undo-tree-node-next (undo-tree-current buffer-undo-tree)))))
	4102	;; signal error if at eob
	4103	(when (and (not undo-tree-visualizer-needs-extending-down) (eobp))
	4104	(scroll-up))))
	4105
	4106
	4107	(defun undo-tree-visualizer-scroll-down (&optional arg)
	4108	(interactive "P")
	4109	(if (or (and (numberp arg) (< arg 0)) (eq arg '-))
	4110	(undo-tree-visualizer-scroll-up arg)
	4111	;; ensure there's enough room at top of buffer to scroll
	4112	(let ((scroll-lines
	4113	(or arg (- (window-height) next-screen-context-lines)))
	4114	(window-line (1- (line-number-at-pos (window-start)))))
	4115	(when (and undo-tree-visualizer-needs-extending-up
	4116	(< window-line scroll-lines))
	4117	(let ((inhibit-read-only t))
	4118	(goto-char (point-min))
	4119	(undo-tree-move-up (- scroll-lines window-line)))))
	4120	;; scroll down and expand newly-visible portion of tree
	4121	(unwind-protect
	4122	(scroll-down-command arg)
	4123	(undo-tree-expand-up
	4124	(undo-tree-node-previous (undo-tree-current buffer-undo-tree))))
	4125	;; signal error if at bob
	4126	(when (and (not undo-tree-visualizer-needs-extending-down) (bobp))
	4127	(scroll-down))))
	4128
	4129
	4130
	4131
	4132	;;; =====================================================================
	4133	;;; Visualizer selection mode
	4134
	4135	(define-minor-mode undo-tree-visualizer-selection-mode
	4136	"Toggle mode to select nodes in undo-tree visualizer."
	4137	:lighter "Select"
	4138	:keymap undo-tree-visualizer-selection-mode-map
	4139	:group undo-tree
	4140	(cond
	4141	;; enable selection mode
	4142	(undo-tree-visualizer-selection-mode
	4143	(setq cursor-type 'box)
	4144	(setq undo-tree-visualizer-selected-node
	4145	(undo-tree-current buffer-undo-tree))
	4146	;; erase diff (if any), as initially selected node is identical to current
	4147	(when undo-tree-visualizer-diff
	4148	(let ((buff (get-buffer undo-tree-diff-buffer-name))
	4149	(inhibit-read-only t))
	4150	(when buff (with-current-buffer buff (erase-buffer))))))
	4151	(t ;; disable selection mode
	4152	(setq cursor-type nil)
	4153	(setq undo-tree-visualizer-selected-node nil)
	4154	(goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
	4155	(when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
	4156	))
	4157
	4158
	4159	(defun undo-tree-visualizer-select-previous (&optional arg)
	4160	"Move to previous node."
	4161	(interactive "p")
	4162	(let ((node undo-tree-visualizer-selected-node))
	4163	(catch 'top
	4164	(dotimes (i (or arg 1))
	4165	(unless (undo-tree-node-previous node) (throw 'top t))
	4166	(setq node (undo-tree-node-previous node))))
	4167	;; when using lazy drawing, extend tree upwards as required
	4168	(when undo-tree-visualizer-lazy-drawing
	4169	(undo-tree-expand-up undo-tree-visualizer-selected-node node))
	4170	;; update diff display, if any
	4171	(when (and undo-tree-visualizer-diff
	4172	(not (eq node undo-tree-visualizer-selected-node)))
	4173	(undo-tree-visualizer-update-diff node))
	4174	;; move to selected node
	4175	(goto-char (undo-tree-node-marker node))
	4176	(setq undo-tree-visualizer-selected-node node)))
	4177
	4178
	4179	(defun undo-tree-visualizer-select-next (&optional arg)
	4180	"Move to next node."
	4181	(interactive "p")
	4182	(let ((node undo-tree-visualizer-selected-node))
	4183	(catch 'bottom
	4184	(dotimes (i (or arg 1))
	4185	(unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
	4186	(throw 'bottom t))
	4187	(setq node
	4188	(nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
	4189	;; when using lazy drawing, extend tree downwards as required
	4190	(when undo-tree-visualizer-lazy-drawing
	4191	(undo-tree-expand-down undo-tree-visualizer-selected-node node))
	4192	;; update diff display, if any
	4193	(when (and undo-tree-visualizer-diff
	4194	(not (eq node undo-tree-visualizer-selected-node)))
	4195	(undo-tree-visualizer-update-diff node))
	4196	;; move to selected node
	4197	(goto-char (undo-tree-node-marker node))
	4198	(setq undo-tree-visualizer-selected-node node)))
	4199
	4200
	4201	(defun undo-tree-visualizer-select-right (&optional arg)
	4202	"Move right to a sibling node."
	4203	(interactive "p")
	4204	(let ((node undo-tree-visualizer-selected-node)
	4205	end)
	4206	(goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
	4207	(setq end (line-end-position))
	4208	(catch 'end
	4209	(dotimes (i arg)
	4210	(while (or (null node) (eq node undo-tree-visualizer-selected-node))
	4211	(forward-char)
	4212	(setq node (get-text-property (point) 'undo-tree-node))
	4213	(when (= (point) end) (throw 'end t)))))
	4214	(goto-char (undo-tree-node-marker
	4215	(or node undo-tree-visualizer-selected-node)))
	4216	(when (and undo-tree-visualizer-diff node
	4217	(not (eq node undo-tree-visualizer-selected-node)))
	4218	(undo-tree-visualizer-update-diff node))
	4219	(when node (setq undo-tree-visualizer-selected-node node))))
	4220
	4221
	4222	(defun undo-tree-visualizer-select-left (&optional arg)
	4223	"Move left to a sibling node."
	4224	(interactive "p")
	4225	(let ((node (get-text-property (point) 'undo-tree-node))
	4226	beg)
	4227	(goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
	4228	(setq beg (line-beginning-position))
	4229	(catch 'beg
	4230	(dotimes (i arg)
	4231	(while (or (null node) (eq node undo-tree-visualizer-selected-node))
	4232	(backward-char)
	4233	(setq node (get-text-property (point) 'undo-tree-node))
	4234	(when (= (point) beg) (throw 'beg t)))))
	4235	(goto-char (undo-tree-node-marker
	4236	(or node undo-tree-visualizer-selected-node)))
	4237	(when (and undo-tree-visualizer-diff node
	4238	(not (eq node undo-tree-visualizer-selected-node)))
	4239	(undo-tree-visualizer-update-diff node))
	4240	(when node (setq undo-tree-visualizer-selected-node node))))
	4241
	4242
	4243	(defun undo-tree-visualizer-select (pos)
	4244	(let ((node (get-text-property pos 'undo-tree-node)))
	4245	(when node
	4246	;; select node at POS
	4247	(goto-char (undo-tree-node-marker node))
	4248	;; when using lazy drawing, extend tree up and down as required
	4249	(when undo-tree-visualizer-lazy-drawing
	4250	(undo-tree-expand-up undo-tree-visualizer-selected-node node)
	4251	(undo-tree-expand-down undo-tree-visualizer-selected-node node))
	4252	;; update diff display, if any
	4253	(when (and undo-tree-visualizer-diff
	4254	(not (eq node undo-tree-visualizer-selected-node)))
	4255	(undo-tree-visualizer-update-diff node))
	4256	;; update selected node
	4257	(setq undo-tree-visualizer-selected-node node)
	4258	)))
	4259
	4260
	4261	(defun undo-tree-visualizer-mouse-select (pos)
	4262	"Select undo tree node at mouse event POS."
	4263	(interactive "@e")
	4264	(undo-tree-visualizer-select (event-start (nth 1 pos))))
	4265
	4266
	4267
	4268
	4269	;;; =====================================================================
	4270	;;; Visualizer diff display
	4271
	4272	(defun undo-tree-visualizer-toggle-diff ()
	4273	"Toggle diff display in undo-tree visualizer."
	4274	(interactive)
	4275	(if undo-tree-visualizer-diff
	4276	(undo-tree-visualizer-hide-diff)
	4277	(undo-tree-visualizer-show-diff)))
	4278
	4279
	4280	(defun undo-tree-visualizer-selection-toggle-diff ()
	4281	"Toggle diff display in undo-tree visualizer selection mode."
	4282	(interactive)
	4283	(if undo-tree-visualizer-diff
	4284	(undo-tree-visualizer-hide-diff)
	4285	(let ((node (get-text-property (point) 'undo-tree-node)))
	4286	(when node (undo-tree-visualizer-show-diff node)))))
	4287
	4288
	4289	(defun undo-tree-visualizer-show-diff (&optional node)
	4290	;; show visualizer diff display
	4291	(setq undo-tree-visualizer-diff t)
	4292	(let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
	4293	(undo-tree-diff node)))
	4294	(display-buffer-mark-dedicated 'soft)
	4295	win)
	4296	(setq win (split-window))
	4297	(set-window-buffer win buff)
	4298	(shrink-window-if-larger-than-buffer win)))
	4299
	4300
	4301	(defun undo-tree-visualizer-hide-diff ()
	4302	;; hide visualizer diff display
	4303	(setq undo-tree-visualizer-diff nil)
	4304	(let ((win (get-buffer-window undo-tree-diff-buffer-name)))
	4305	(when win (with-selected-window win (kill-buffer-and-window)))))
	4306
	4307
	4308	(defun undo-tree-diff (&optional node)
	4309	;; Create diff between NODE and current state (or previous state and current
	4310	;; state, if NODE is null). Returns buffer containing diff.
	4311	(let (tmpfile buff)
	4312	;; generate diff
	4313	(let ((undo-tree-inhibit-kill-visualizer t)
	4314	(current (undo-tree-current buffer-undo-tree)))
	4315	(undo-tree-set (or node (undo-tree-node-previous current) current)
	4316	'preserve-timestamps)
	4317	(setq tmpfile (diff-file-local-copy (current-buffer)))
	4318	(undo-tree-set current 'preserve-timestamps))
	4319	(setq buff (diff-no-select
	4320	tmpfile (current-buffer) nil 'noasync
	4321	(get-buffer-create undo-tree-diff-buffer-name)))
	4322	;; delete process messages and useless headers from diff buffer
	4323	(let ((inhibit-read-only t))
	4324	(with-current-buffer buff
	4325	(goto-char (point-min))
	4326	(delete-region (point) (1+ (line-end-position 3)))
	4327	(goto-char (point-max))
	4328	(forward-line -2)
	4329	(delete-region (point) (point-max))
	4330	(setq cursor-type nil)
	4331	(setq buffer-read-only t)))
	4332	buff))
	4333
	4334
	4335	(defun undo-tree-visualizer-update-diff (&optional node)
	4336	;; update visualizer diff display to show diff between current state and
	4337	;; NODE (or previous state, if NODE is null)
	4338	(with-current-buffer undo-tree-visualizer-parent-buffer
	4339	(undo-tree-diff node))
	4340	(let ((win (get-buffer-window undo-tree-diff-buffer-name)))
	4341	(when win
	4342	(balance-windows)
	4343	(shrink-window-if-larger-than-buffer win))))
	4344
	4345	;;;; ChangeLog:
	4346
	4347	;; 2013-12-28 Toby S. Cubitt <tsc25@cantab.net>
	4348	;;
	4349	;; * undo-tree: Update to version 0.6.5.
	4350	;;
	4351	;; 2012-12-05 Toby S. Cubitt <tsc25@cantab.net>
	4352	;;
	4353	;; Update undo-tree to version 0.6.3
	4354	;;
	4355	;; * undo-tree.el: Implement lazy tree drawing to significantly speed up
	4356	;; visualization of large trees + various more minor improvements.
	4357	;;
	4358	;; 2012-09-25 Toby S. Cubitt <tsc25@cantab.net>
	4359	;;
	4360	;; Updated undo-tree package to version 0.5.5.
	4361	;;
	4362	;; Small bug-fix to avoid hooks triggering an error when trying to save
	4363	;; undo history in a buffer where undo is disabled.
	4364	;;
	4365	;; 2012-09-11 Toby S. Cubitt <tsc25@cantab.net>
	4366	;;
	4367	;; Updated undo-tree package to version 0.5.4
	4368	;;
	4369	;; Bug-fixes and improvements to persistent history storage.
	4370	;;
	4371	;; 2012-07-18 Toby S. Cubitt <tsc25@cantab.net>
	4372	;;
	4373	;; Update undo-tree to version 0.5.3
	4374	;;
	4375	;; * undo-tree.el: Cope gracefully with undo boundaries being deleted
	4376	;; (cf. bug#11774). Allow customization of directory to which undo
	4377	;; history is
	4378	;; saved.
	4379	;;
	4380	;; 2012-05-24 Toby S. Cubitt <tsc25@cantab.net>
	4381	;;
	4382	;; updated undo-tree package to version 0.5.2
	4383	;;
	4384	;; * undo-tree.el: add diff view feature in undo-tree visualizer.
	4385	;;
	4386	;; 2012-05-02 Toby S. Cubitt <tsc25@cantab.net>
	4387	;;
	4388	;; undo-tree.el: Update package to version 0.4
	4389	;;
	4390	;; 2012-04-20 Toby S. Cubitt <tsc25@cantab.net>
	4391	;;
	4392	;; undo-tree.el: Update package to version 0.3.4
	4393	;;
	4394	;; * undo-tree.el (undo-list-pop-changeset): fix pernicious bug causing
	4395	;; undo history to be lost.
	4396	;; (buffer-undo-tree): set permanent-local property.
	4397	;; (undo-tree-enable-undo-in-region): add new customization option
	4398	;; allowing undo-in-region to be disabled.
	4399	;;
	4400	;; 2012-01-26 Toby S. Cubitt <tsc25@cantab.net>
	4401	;;
	4402	;; undo-tree.el: Fixed copyright attribution and Emacs status.
	4403	;;
	4404	;; 2012-01-26 Toby S. Cubitt <tsc25@cantab.net>
	4405	;;
	4406	;; undo-tree.el: Update package to version 0.3.3
	4407	;;
	4408	;; 2011-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
	4409	;;
	4410	;; Add undo-tree.el
	4411	;;
	4412
	4413
	4414
	4415
	4416	(provide 'undo-tree)
	4417
	4418	;;; undo-tree.el ends here