-;;; undo-tree.el --- Treat undo history as a tree
+;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc
;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
-;; Version: 0.4
+;; Version: 0.6.5
;; Keywords: convenience, files, undo, redo, history, tree
;; URL: http://www.dr-qubit.org/emacs.php
;; Repository: http://www.dr-qubit.org/git/undo-tree.git
;; Installation
;; ============
;;
-;; This package has only been tested with Emacs versions 22, 23 and CVS. It
-;; will not work without modifications in earlier versions of Emacs.
+;; This package has only been tested with Emacs versions 24 and CVS. It should
+;; work in Emacs versions 22 and 23 too, but will not work without
+;; modifications in earlier versions of Emacs.
;;
;; To install `undo-tree-mode', make sure this file is saved in a directory in
;; your `load-path', and add the line:
;; Restore buffer state from register.
;;
;;
+;;
;; In the undo-tree visualizer:
;;
;; <up> p C-p (`undo-tree-visualize-undo')
;; <right> f C-f (`undo-tree-visualize-switch-branch-right')
;; Switch to next undo-tree branch.
;;
+;; C-<up> M-{ (`undo-tree-visualize-undo-to-x')
+;; Undo changes up to last branch point.
+;;
+;; C-<down> M-} (`undo-tree-visualize-redo-to-x')
+;; Redo changes down to next branch point.
+;;
+;; <down> n C-n (`undo-tree-visualize-redo')
+;; Redo changes.
+;;
+;; <mouse-1> (`undo-tree-visualizer-mouse-set')
+;; Set state to node at mouse click.
+;;
;; t (`undo-tree-visualizer-toggle-timestamps')
;; Toggle display of time-stamps.
;;
-;; q C-q (`undo-tree-visualizer-quit')
+;; d (`undo-tree-visualizer-toggle-diff')
+;; Toggle diff display.
+;;
+;; s (`undo-tree-visualizer-selection-mode')
+;; Toggle keyboard selection mode.
+;;
+;; q (`undo-tree-visualizer-quit')
;; Quit undo-tree-visualizer.
;;
+;; C-q (`undo-tree-visualizer-abort')
+;; Abort undo-tree-visualizer.
+;;
;; , <
;; Scroll left.
;;
;;
;;
;;
+;; In visualizer selection mode:
+;;
+;; <up> p C-p (`undo-tree-visualizer-select-previous')
+;; Select previous node.
+;;
+;; <down> n C-n (`undo-tree-visualizer-select-next')
+;; Select next node.
+;;
+;; <left> b C-b (`undo-tree-visualizer-select-left')
+;; Select left sibling node.
+;;
+;; <right> f C-f (`undo-tree-visualizer-select-right')
+;; Select right sibling node.
+;;
+;; <pgup> M-v
+;; Select node 10 above.
+;;
+;; <pgdown> C-v
+;; Select node 10 below.
+;;
+;; <enter> (`undo-tree-visualizer-set')
+;; Set state to selected node and exit selection mode.
+;;
+;; s (`undo-tree-visualizer-mode')
+;; Exit selection mode.
+;;
+;; t (`undo-tree-visualizer-toggle-timestamps')
+;; Toggle display of time-stamps.
+;;
+;; d (`undo-tree-visualizer-toggle-diff')
+;; Toggle diff display.
+;;
+;; q (`undo-tree-visualizer-quit')
+;; Quit undo-tree-visualizer.
+;;
+;; C-q (`undo-tree-visualizer-abort')
+;; Abort undo-tree-visualizer.
+;;
+;; , <
+;; Scroll left.
+;;
+;; . >
+;; Scroll right.
+;;
+;;
+;;
+;; Persistent undo history:
+;;
+;; Note: Requires Emacs version 24.3 or higher.
+;;
+;; `undo-tree-auto-save-history' (variable)
+;; automatically save and restore undo-tree history along with buffer
+;; (disabled by default)
+;;
+;; `undo-tree-save-history' (command)
+;; manually save undo history to file
+;;
+;; `undo-tree-load-history' (command)
+;; manually load undo history from file
+;;
+;;
+;;
+;; Compressing undo history:
+;;
+;; Undo history files cannot grow beyond the maximum undo tree size, which
+;; is limited by `undo-limit', `undo-strong-limit' and
+;; `undo-outer-limit'. Nevertheless, undo history files can grow quite
+;; large. If you want to automatically compress undo history, add the
+;; following advice to your .emacs file (replacing ".gz" with the filename
+;; extension of your favourite compression algorithm):
+;;
+;; (defadvice undo-tree-make-history-save-file-name
+;; (after undo-tree activate)
+;; (setq ad-return-value (concat ad-return-value ".gz")))
+;;
+;;
+;;
+;;
;; Undo Systems
;; ============
;;
;; diagrams, because `undo-tree-mode' includes an undo-tree visualizer which
;; draws them for you! In fact, it draws even better diagrams: it highlights
;; the node representing the current buffer state, it highlights the current
-;; branch, and (by hitting "t") you can toggle the display of
-;; time-stamps. (There's one other tiny difference: the visualizer puts the
-;; most recent branch on the left rather than the right.)
+;; branch, and you can toggle the display of time-stamps (by hitting "t") and
+;; a diff of the undo changes (by hitting "d"). (There's one other tiny
+;; difference: the visualizer puts the most recent branch on the left rather
+;; than the right.)
+;;
+;; Bring up the undo tree visualizer whenever you want by hitting "C-x u".
;;
;; In the visualizer, the usual keys for moving up and down a buffer instead
;; move up and down the undo history tree (e.g. the up and down arrow keys, or
;; history you are visualizing) is updated as you move around the undo tree in
;; the visualizer. If you reach a branch point in the visualizer, the usual
;; keys for moving forward and backward in a buffer instead switch branch
-;; (e.g. the left and right arrow keys, or "C-f" and "C-b"). And clicking with
-;; the mouse on any node in the visualizer will take you directly to that
-;; node, resetting the state of the parent buffer to the state represented by
-;; that node.
+;; (e.g. the left and right arrow keys, or "C-f" and "C-b").
+;;
+;; Clicking with the mouse on any node in the visualizer will take you
+;; directly to that node, resetting the state of the parent buffer to the
+;; state represented by that node.
+;;
+;; You can also select nodes directly using the keyboard, by hitting "s" to
+;; toggle selection mode. The usual motion keys now allow you to move around
+;; the tree without changing the parent buffer. Hitting <enter> will reset the
+;; state of the parent buffer to the state represented by the currently
+;; selected node.
;;
;; It can be useful to see how long ago the parent buffer was in the state
;; represented by a particular node in the visualizer. Hitting "t" in the
;; somewhat later than the true times, especially if it's been a long time
;; since you last undid any changes.)
;;
+;; To get some idea of what changes are represented by a given node in the
+;; tree, it can be useful to see a diff of the changes. Hit "d" in the
+;; visualizer to toggle a diff display. This normally displays a diff between
+;; the current state and the previous one, i.e. it shows you the changes that
+;; will be applied if you undo (move up the tree). However, the diff display
+;; really comes into its own in the visualizer's selection mode (see above),
+;; where it instead shows a diff between the current state and the currently
+;; selected state, i.e. it shows you the changes that will be applied if you
+;; reset to the selected state.
+;;
+;; (Note that the diff is generated by the Emacs `diff' command, and is
+;; displayed using `diff-mode'. See the corresponding customization groups if
+;; you want to customize the diff display.)
+;;
;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
-;; whatever state you ended at.
+;; whatever state you ended at. Hitting "C-q" will abort the visualizer,
+;; returning the parent buffer to whatever state it was originally in when the
+;; visualizer was .
;;
;;
;;
-;;; Change Log:
-;;
-;; Version 0.4
-;; * implemented persistent history storage: `undo-tree-save-history' and
-;; `undo-tree-load-history' save and restore an undo tree to file, enabling
-;; `undo-tree-auto-save-history' causes history to be saved and restored
-;; automatically when saving or loading files
-;; * renamed internal `make-undo-tree-<struct>' functions to
-;; `undo-tree-make-<struct>' to avoid polluting name-space
-;; * create proper registerv structure using `registerv-make' when storing
-;; undo state in registers in `undo-tree-save-state-to-register' (and
-;; `undo-tree-restore-state-from-register')
-;; * suppress branch point messages when undo/redoing from `undo-tree-set'
-;; * make various interactive commands signal an error if buffer is read-only
-;; * let-bind `inhibit-read-only' instead of setting and restoring
-;; `buffer-read-only'
-;; * use non-nil `undo-tree-inhibit-kill-visualizer' instead of
-;; `undo-in-progress' to inhibit `undo-tree-kill-visualizer', so that
-;; undoing and redoing in parent buffer also kill visualizer
-;;
-;; Version 0.3.5
-;; * improved `undo-tree-switch-branch': display current branch number in
-;; prompt, switch to other branch without prompting when there are only two,
-;; and display message indicating new branch number after switching
-;;
-;; Version 0.3.4
-;; * set `permanent-local' property on `buffer-undo-tree', to prevent history
-;; being discarded when switching major-mode
-;; * added `undo-tree-enable-undo-in-region' customization option to allow
-;; undo-in-region to be disabled.
-;; * fixed bug in `undo-list-pop-changeset' which, through a subtle chain of
-;; consequences, occasionally caused undo-tree-mode to lose large amounts of
-;; undo history (thanks to Magnar Sveen for his sterling efforts in helping
-;; track this down!)
-;;
-;; Version 0.3.3;
-;; * added `term-mode' to `undo-tree-incompatible-major-modes'
-;;
-;; Version 0.3.2
-;; * added additional check in `undo-list-GCd-marker-elt-p' to guard against
-;; undo elements being mis-identified as marker elements
-;; * fixed bug in `undo-list-transfer-to-tree'
-;;
-;; Version 0.3.1
-;; * use `get-buffer-create' when creating the visualizer buffer in
-;; `undo-tree-visualize', to fix bug caused by `global-undo-tree-mode' being
-;; enabled in the visualizer when `default-major-mode' is set to something
-;; other than `fundamental-mode' (thanks to Michael Heerdegen for suggesting
-;; this fix)
-;; * modified `turn-on-undo-tree-mode' to avoid turning on `undo-tree-mode' if
-;; the buffer's `major-mode' implements its own undo system, by checking
-;; whether `undo' is remapped, the default "C-/" or "C-_" bindings have been
-;; overridden, or the `major-mode' is listed in
-;; `undo-tree-incompatible-major-modes'
-;; * discard position entries from `buffer-undo-list' changesets created by
-;; undoing or redoing, to ensure point is always moved to where the change
-;; is (standard Emacs `undo' also does this)
-;; * fixed `undo-tree-draw-node' to use correct faces and indicate registers
-;; when displaying timestamps in visualizer
-;;
-;; Version 0.3
-;; * implemented undo-in-region
-;; * fixed bugs in `undo-list-transfer-to-tree' and
-;; `undo-list-rebuild-from-tree' which caused errors when undo history was
-;; empty or disabled
-;; * defun `region-active-p' if not already defined, for compatibility with
-;; older Emacsen
-;;
-;; Version 0.2.1
-;; * modified `undo-tree-node' defstruct and macros to allow arbitrary
-;; meta-data to be stored in a plist associated with a node, and
-;; reimplemented storage of visualizer data on top of this
-;; * display registers storing undo-tree state in visualizer
-;; * implemented keyboard selection in visualizer
-;; * rebuild `buffer-undo-list' from tree when disabling `undo-tree-mode'
-;;
-;; Version 0.2
-;; * added support for marker undo entries
-;;
-;; Version 0.1.7
-;; * pass null argument to `kill-buffer' call in `undo-tree-visualizer-quit',
-;; since the argument's not optional in earlier Emacs versions
-;; * added match for "No further redo information" to
-;; `debug-ignored-errors' to prevent debugger being called on this error
-;; * made `undo-tree-visualizer-quit' select the window displaying the
-;; visualizer's parent buffer, or switch to the parent buffer if no window
-;; is displaying it
-;; * fixed bug in `undo-tree-switch-branch'
-;; * general code tidying and reorganisation
-;; * fixed bugs in history-discarding logic
-;; * fixed bug in `undo-tree-insert' triggered by `undo-tree-visualizer-set'
-;; by ensuring mark is deactivated
-;;
-;; Version 0.1.6
-;; * added `undo-tree-mode-lighter' customization option to allow the
-;; mode-line lighter to be changed
-;; * bug-fix in `undo-tree-discard-node'
-;; * added `undo-tree-save-state-to-register' and
-;; `undo-tree-restore-state-from-register' commands and keybindings for
-;; saving/restoring undo-tree states using registers
-;;
-;; Version 0.1.5
-;; * modified `undo-tree-visualize' to mark the visualizer window as
-;; soft-dedicated, and changed `undo-tree-visualizer-quit' to use
-;; `kill-buffer', so that the visualizer window is deleted along with its
-;; buffer if the visualizer buffer was displayed in a new window, but not if
-;; it was displayed in an existing window.
-;;
-;; Version 0.1.4
-;; * modified `undo-tree-undo' and `undo-tree-redo' to always replace
-;; redo/undo entries with new ones generated by `primitive-undo', as the new
-;; changesets will restore the point more reliably
-;;
-;; Version 0.1.3
-;; * fixed `undo-tree-visualizer-quit' to remove `after-change-functions'
-;; hook there, rather than in `undo-tree-kill-visualizer'
-;;
-;; Version 0.1.2
-;; * fixed keybindings
-;; * renamed `undo-tree-visualizer-switch-previous-branch' and
-;; `undo-tree-visualizer-switch-next-branch' to
-;; `undo-tree-visualizer-switch-branch-left' and
-;; `undo-tree-visualizer-switch-branch-right'
-;;
-;; Version 0.1.1
-;; * prevented `undo-tree-kill-visualizer' from killing visualizer when
-;; undoing/redoing from the visualizer, which completely broke the
-;; visualizer!
-;; * changed one redo binding, so that at least one set of undo/redo bindings
-;; works in a terminal
-;; * bound vertical scrolling commands in `undo-tree-visualizer-map', in case
-;; they aren't bound globally
-;; * added missing :group argument to `defface's
-;;
-;; Version 0.1
-;; * initial release
-
-
-
;;; Code:
(eval-when-compile (require 'cl))
+(require 'diff)
+
+
+\f
+;;; =====================================================================
+;;; Compatibility hacks for older Emacsen
-;; `characterp' isn't defined in Emacs versions <= 22
+;; `characterp' isn't defined in Emacs versions < 23
(unless (fboundp 'characterp)
(defalias 'characterp 'char-valid-p))
-;; `region-active-p' isn't defined in Emacs versions <= 22
+;; `region-active-p' isn't defined in Emacs versions < 23
(unless (fboundp 'region-active-p)
(defun region-active-p () (and transient-mark-mode mark-active)))
-
+;; `registerv' defstruct isn't defined in Emacs versions < 24
+(unless (fboundp 'registerv-make)
+ (defmacro registerv-make (data &rest _dummy) data))
+
+(unless (fboundp 'registerv-data)
+ (defmacro registerv-data (data) data))
+
+
+;; `diff-no-select' and `diff-file-local-copy' aren't defined in Emacs
+;; versions < 24 (copied and adapted from Emacs 24)
+(unless (fboundp 'diff-no-select)
+ (defun diff-no-select (old new &optional switches no-async buf)
+ ;; Noninteractive helper for creating and reverting diff buffers
+ (unless (bufferp new) (setq new (expand-file-name new)))
+ (unless (bufferp old) (setq old (expand-file-name old)))
+ (or switches (setq switches diff-switches)) ; If not specified, use default.
+ (unless (listp switches) (setq switches (list switches)))
+ (or buf (setq buf (get-buffer-create "*Diff*")))
+ (let* ((old-alt (diff-file-local-copy old))
+ (new-alt (diff-file-local-copy new))
+ (command
+ (mapconcat 'identity
+ `(,diff-command
+ ;; Use explicitly specified switches
+ ,@switches
+ ,@(mapcar #'shell-quote-argument
+ (nconc
+ (when (or old-alt new-alt)
+ (list "-L" (if (stringp old)
+ old (prin1-to-string old))
+ "-L" (if (stringp new)
+ new (prin1-to-string new))))
+ (list (or old-alt old)
+ (or new-alt new)))))
+ " "))
+ (thisdir default-directory))
+ (with-current-buffer buf
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (buffer-enable-undo (current-buffer))
+ (diff-mode)
+ (set (make-local-variable 'revert-buffer-function)
+ (lambda (_ignore-auto _noconfirm)
+ (diff-no-select old new switches no-async (current-buffer))))
+ (setq default-directory thisdir)
+ (let ((inhibit-read-only t))
+ (insert command "\n"))
+ (if (and (not no-async) (fboundp 'start-process))
+ (let ((proc (start-process "Diff" buf shell-file-name
+ shell-command-switch command)))
+ (set-process-filter proc 'diff-process-filter)
+ (set-process-sentinel
+ proc (lambda (proc _msg)
+ (with-current-buffer (process-buffer proc)
+ (diff-sentinel (process-exit-status proc))
+ (if old-alt (delete-file old-alt))
+ (if new-alt (delete-file new-alt))))))
+ ;; Async processes aren't available.
+ (let ((inhibit-read-only t))
+ (diff-sentinel
+ (call-process shell-file-name nil buf nil
+ shell-command-switch command))
+ (if old-alt (delete-file old-alt))
+ (if new-alt (delete-file new-alt)))))
+ buf)))
+
+(unless (fboundp 'diff-file-local-copy)
+ (defun diff-file-local-copy (file-or-buf)
+ (if (bufferp file-or-buf)
+ (with-current-buffer file-or-buf
+ (let ((tempfile (make-temp-file "buffer-content-")))
+ (write-region nil nil tempfile nil 'nomessage)
+ tempfile))
+ (file-local-copy file-or-buf))))
+
+
+;; `user-error' isn't defined in Emacs < 24.3
+(unless (fboundp 'user-error)
+ (defalias 'user-error 'error)
+ ;; prevent debugger being called on user errors
+ (add-to-list 'debug-ignored-errors "^No further undo information")
+ (add-to-list 'debug-ignored-errors "^No further redo information")
+ (add-to-list 'debug-ignored-errors "^No further redo information for region"))
+
+
+
+
+\f
;;; =====================================================================
;;; Global variables and customization options
(defvar buffer-undo-tree nil
"Tree of undo entries in current buffer.")
-(make-variable-buffer-local 'buffer-undo-tree)
(put 'buffer-undo-tree 'permanent-local t)
+(make-variable-buffer-local 'buffer-undo-tree)
(defgroup undo-tree nil
:group 'undo-tree
:type 'string)
+
+(defcustom undo-tree-incompatible-major-modes '(term-mode)
+ "List of major-modes in which `undo-tree-mode' should not be enabled.
+\(See `turn-on-undo-tree-mode'.\)"
+ :group 'undo-tree
+ :type '(repeat symbol))
+
+
(defcustom undo-tree-enable-undo-in-region t
"When non-nil, enable undo-in-region.
:group 'undo-tree
:type 'boolean)
+
(defcustom undo-tree-auto-save-history nil
"When non-nil, `undo-tree-mode' will save undo history to file
when a buffer is saved to file.
It will automatically load undo history when a buffer is loaded
from file, if an undo save file exists.
-Undo-tree history is saved to a file called
-\".<buffer-file-name>.~undo-tree\" in the same directory as the
-file itself.
+By default, undo-tree history is saved to a file called
+\".<buffer-file-name>.~undo-tree~\" in the same directory as the
+file itself. To save under a different directory, customize
+`undo-tree-history-directory-alist' (see the documentation for
+that variable for details).
WARNING! `undo-tree-auto-save-history' will not work properly in
-Emacs versions prior to 24.1.50.1, so it cannot be enabled via
+Emacs versions prior to 24.3, so it cannot be enabled via
the customization interface in versions earlier than that one. To
ignore this warning and enable it regardless, set
`undo-tree-auto-save-history' to a non-nil value outside of
customize."
:group 'undo-tree
- :type (if (version-list-< (version-to-list emacs-version) '(24 1 50 1))
+ :type (if (version-list-< (version-to-list emacs-version) '(24 3))
'(choice (const :tag "<disabled>" nil))
'boolean))
-(defcustom undo-tree-incompatible-major-modes '(term-mode)
- "List of major-modes in which `undo-tree-mode' should not be enabled.
-\(See `turn-on-undo-tree-mode'.\)"
+
+(defcustom undo-tree-history-directory-alist nil
+ "Alist of filename patterns and undo history directory names.
+Each element looks like (REGEXP . DIRECTORY). Undo history for
+files with names matching REGEXP will be saved in DIRECTORY.
+DIRECTORY may be relative or absolute. If it is absolute, so
+that all matching files are backed up into the same directory,
+the file names in this directory will be the full name of the
+file backed up with all directory separators changed to `!' to
+prevent clashes. This will not work correctly if your filesystem
+truncates the resulting name.
+
+For the common case of all backups going into one directory, the
+alist should contain a single element pairing \".\" with the
+appropriate directory name.
+
+If this variable is nil, or it fails to match a filename, the
+backup is made in the original file's directory.
+
+On MS-DOS filesystems without long names this variable is always
+ignored."
:group 'undo-tree
- :type '(repeat symbol))
+ :type '(repeat (cons (regexp :tag "Regexp matching filename")
+ (directory :tag "Undo history directory name"))))
+
+
-(defcustom undo-tree-visualizer-spacing 3
- "Horizontal spacing in undo-tree visualization.
-Must be a postivie odd integer."
+(defcustom undo-tree-visualizer-relative-timestamps t
+ "When non-nil, display times relative to current time
+when displaying time stamps in visualizer.
+
+Otherwise, display absolute times."
:group 'undo-tree
- :type '(integer
- :match (lambda (w n) (and (integerp n) (> n 0) (= (mod n 2) 1)))))
-(make-variable-buffer-local 'undo-tree-visualizer-spacing)
+ :type 'boolean)
-(defvar undo-tree-map nil
- "Keymap used in undo-tree-mode.")
+
+(defcustom undo-tree-visualizer-timestamps nil
+ "When non-nil, display time-stamps by default
+in undo-tree visualizer.
+
+\\<undo-tree-visualizer-mode-map>You can always toggle time-stamps on and off \
+using \\[undo-tree-visualizer-toggle-timestamps], regardless of the
+setting of this variable."
+ :group 'undo-tree
+ :type 'boolean)
+
+
+(defcustom undo-tree-visualizer-diff nil
+ "When non-nil, display diff by default in undo-tree visualizer.
+
+\\<undo-tree-visualizer-mode-map>You can always toggle the diff display \
+using \\[undo-tree-visualizer-toggle-diff], regardless of the
+setting of this variable."
+ :group 'undo-tree
+ :type 'boolean)
+
+
+(defcustom undo-tree-visualizer-lazy-drawing 100
+ "When non-nil, use lazy undo-tree drawing in visualizer.
+
+Setting this to a number causes the visualizer to switch to lazy
+drawing when the number of nodes in the tree is larger than this
+value.
+
+Lazy drawing means that only the visible portion of the tree will
+be drawn initially, and the tree will be extended later as
+needed. For the most part, the only visible effect of this is to
+significantly speed up displaying the visualizer for very large
+trees.
+
+There is one potential negative effect of lazy drawing. Other
+branches of the tree will only be drawn once the node from which
+they branch off becomes visible. So it can happen that certain
+portions of the tree that would be shown with lazy drawing
+disabled, will not be drawn immediately when it is
+enabled. However, this effect is quite rare in practice."
+ :group 'undo-tree
+ :type '(choice (const :tag "never" nil)
+ (const :tag "always" t)
+ (integer :tag "> size")))
(defface undo-tree-visualizer-default-face
'((((class color)) :foreground "gray"))
- "*Face used to draw undo-tree in visualizer."
+ "Face used to draw undo-tree in visualizer."
:group 'undo-tree)
(defface undo-tree-visualizer-current-face
'((((class color)) :foreground "red"))
- "*Face used to highlight current undo-tree node in visualizer."
+ "Face used to highlight current undo-tree node in visualizer."
:group 'undo-tree)
(defface undo-tree-visualizer-active-branch-face
(:foreground "white" :weight bold))
(((class color) (background light))
(:foreground "black" :weight bold)))
- "*Face used to highlight active undo-tree branch
-in visualizer."
+ "Face used to highlight active undo-tree branch in visualizer."
:group 'undo-tree)
(defface undo-tree-visualizer-register-face
'((((class color)) :foreground "yellow"))
- "*Face used to highlight undo-tree nodes saved to a register
+ "Face used to highlight undo-tree nodes saved to a register
in visualizer."
:group 'undo-tree)
-(defvar undo-tree-visualizer-map nil
- "Keymap used in undo-tree visualizer.")
-
-(defvar undo-tree-visualizer-selection-map nil
- "Keymap used in undo-tree visualizer selection mode.")
+(defface undo-tree-visualizer-unmodified-face
+ '((((class color)) :foreground "cyan"))
+ "Face used to highlight nodes corresponding to unmodified buffers
+in visualizer."
+ :group 'undo-tree)
(defvar undo-tree-visualizer-parent-buffer nil
"Parent buffer in visualizer.")
+(put 'undo-tree-visualizer-parent-buffer 'permanent-local t)
(make-variable-buffer-local 'undo-tree-visualizer-parent-buffer)
-(defvar undo-tree-visualizer-timestamps nil
- "Non-nil when visualizer is displaying time-stamps.")
-(make-variable-buffer-local 'undo-tree-visualizer-timestamps)
+;; stores modification time of parent buffer's file, if any
+(defvar undo-tree-visualizer-parent-mtime nil)
+(put 'undo-tree-visualizer-parent-mtime 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-parent-mtime)
-(defconst undo-tree-visualizer-buffer-name " *undo-tree*")
+;; stores current horizontal spacing needed for drawing undo-tree
+(defvar undo-tree-visualizer-spacing nil)
+(put 'undo-tree-visualizer-spacing 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-spacing)
+
+;; calculate horizontal spacing required for drawing tree with current
+;; settings
+(defsubst undo-tree-visualizer-calculate-spacing ()
+ (if undo-tree-visualizer-timestamps
+ (if undo-tree-visualizer-relative-timestamps 9 13)
+ 3))
+
+;; holds node that was current when visualizer was invoked
+(defvar undo-tree-visualizer-initial-node nil)
+(put 'undo-tree-visualizer-initial-node 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-initial-node)
+
+;; holds currently selected node in visualizer selection mode
+(defvar undo-tree-visualizer-selected-node nil)
+(put 'undo-tree-visualizer-selected-node 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-selected)
+
+;; used to store nodes at edge of currently drawn portion of tree
+(defvar undo-tree-visualizer-needs-extending-down nil)
+(put 'undo-tree-visualizer-needs-extending-down 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-down)
+(defvar undo-tree-visualizer-needs-extending-up nil)
+(put 'undo-tree-visualizer-needs-extending-up 'permanent-local t)
+(make-variable-buffer-local 'undo-tree-visualizer-needs-extending-up)
;; dynamically bound to t when undoing from visualizer, to inhibit
;; `undo-tree-kill-visualizer' hook function in parent buffer
(defvar undo-tree-inhibit-kill-visualizer nil)
-;; prevent debugger being called on "No further redo information"
-(add-to-list 'debug-ignored-errors "^No further redo information")
+;; can be let-bound to a face name, used in drawing functions
+(defvar undo-tree-insert-face nil)
+;; visualizer buffer names
+(defconst undo-tree-visualizer-buffer-name " *undo-tree*")
+(defconst undo-tree-diff-buffer-name "*undo-tree Diff*")
+;; install history-auto-save hooks
+(add-hook 'write-file-functions 'undo-tree-save-history-hook)
+(add-hook 'find-file-hook 'undo-tree-load-history-hook)
-;;; =================================================================
-;;; Setup default keymaps
-(unless undo-tree-map
- (setq undo-tree-map (make-sparse-keymap))
- ;; remap `undo' and `undo-only' to `undo-tree-undo'
- (define-key undo-tree-map [remap undo] 'undo-tree-undo)
- (define-key undo-tree-map [remap undo-only] 'undo-tree-undo)
- ;; bind standard undo bindings (since these match redo counterparts)
- (define-key undo-tree-map (kbd "C-/") 'undo-tree-undo)
- (define-key undo-tree-map "\C-_" 'undo-tree-undo)
- ;; redo doesn't exist normally, so define our own keybindings
- (define-key undo-tree-map (kbd "C-?") 'undo-tree-redo)
- (define-key undo-tree-map (kbd "M-_") 'undo-tree-redo)
- ;; just in case something has defined `redo'...
- (define-key undo-tree-map [remap redo] 'undo-tree-redo)
- ;; we use "C-x u" for the undo-tree visualizer
- (define-key undo-tree-map (kbd "\C-x u") 'undo-tree-visualize)
- ;; bind register commands
- (define-key undo-tree-map (kbd "C-x r u")
- 'undo-tree-save-state-to-register)
- (define-key undo-tree-map (kbd "C-x r U")
- 'undo-tree-restore-state-from-register))
-
-
-(unless undo-tree-visualizer-map
- (setq undo-tree-visualizer-map (make-keymap))
- ;; vertical motion keys undo/redo
- (define-key undo-tree-visualizer-map [remap previous-line]
- 'undo-tree-visualize-undo)
- (define-key undo-tree-visualizer-map [remap next-line]
- 'undo-tree-visualize-redo)
- (define-key undo-tree-visualizer-map [up]
- 'undo-tree-visualize-undo)
- (define-key undo-tree-visualizer-map "p"
- 'undo-tree-visualize-undo)
- (define-key undo-tree-visualizer-map "\C-p"
- 'undo-tree-visualize-undo)
- (define-key undo-tree-visualizer-map [down]
- 'undo-tree-visualize-redo)
- (define-key undo-tree-visualizer-map "n"
- 'undo-tree-visualize-redo)
- (define-key undo-tree-visualizer-map "\C-n"
- 'undo-tree-visualize-redo)
- ;; horizontal motion keys switch branch
- (define-key undo-tree-visualizer-map [remap forward-char]
- 'undo-tree-visualize-switch-branch-right)
- (define-key undo-tree-visualizer-map [remap backward-char]
- 'undo-tree-visualize-switch-branch-left)
- (define-key undo-tree-visualizer-map [right]
- 'undo-tree-visualize-switch-branch-right)
- (define-key undo-tree-visualizer-map "f"
- 'undo-tree-visualize-switch-branch-right)
- (define-key undo-tree-visualizer-map "\C-f"
- 'undo-tree-visualize-switch-branch-right)
- (define-key undo-tree-visualizer-map [left]
- 'undo-tree-visualize-switch-branch-left)
- (define-key undo-tree-visualizer-map "b"
- 'undo-tree-visualize-switch-branch-left)
- (define-key undo-tree-visualizer-map "\C-b"
- 'undo-tree-visualize-switch-branch-left)
- ;; mouse sets buffer state to node at click
- (define-key undo-tree-visualizer-map [mouse-1]
- 'undo-tree-visualizer-mouse-set)
- ;; toggle timestamps
- (define-key undo-tree-visualizer-map "t"
- 'undo-tree-visualizer-toggle-timestamps)
- ;; selection mode
- (define-key undo-tree-visualizer-map "s"
- 'undo-tree-visualizer-selection-mode)
- ;; horizontal scrolling may be needed if the tree is very wide
- (define-key undo-tree-visualizer-map ","
- 'undo-tree-visualizer-scroll-left)
- (define-key undo-tree-visualizer-map "."
- 'undo-tree-visualizer-scroll-right)
- (define-key undo-tree-visualizer-map "<"
- 'undo-tree-visualizer-scroll-left)
- (define-key undo-tree-visualizer-map ">"
- 'undo-tree-visualizer-scroll-right)
- ;; vertical scrolling may be needed if the tree is very tall
- (define-key undo-tree-visualizer-map [next] 'scroll-up)
- (define-key undo-tree-visualizer-map [prior] 'scroll-down)
- ;; quit visualizer
- (define-key undo-tree-visualizer-map "q"
- 'undo-tree-visualizer-quit)
- (define-key undo-tree-visualizer-map "\C-q"
- 'undo-tree-visualizer-quit))
-
-
-(unless undo-tree-visualizer-selection-map
- (setq undo-tree-visualizer-selection-map (make-keymap))
- ;; vertical motion keys move up and down tree
- (define-key undo-tree-visualizer-selection-map [remap previous-line]
- 'undo-tree-visualizer-select-previous)
- (define-key undo-tree-visualizer-selection-map [remap next-line]
- 'undo-tree-visualizer-select-next)
- (define-key undo-tree-visualizer-selection-map [up]
- 'undo-tree-visualizer-select-previous)
- (define-key undo-tree-visualizer-selection-map "p"
- 'undo-tree-visualizer-select-previous)
- (define-key undo-tree-visualizer-selection-map "\C-p"
- 'undo-tree-visualizer-select-previous)
- (define-key undo-tree-visualizer-selection-map [down]
- 'undo-tree-visualizer-select-next)
- (define-key undo-tree-visualizer-selection-map "n"
- 'undo-tree-visualizer-select-next)
- (define-key undo-tree-visualizer-selection-map "\C-n"
- 'undo-tree-visualizer-select-next)
- ;; vertical scroll keys move up and down quickly
- (define-key undo-tree-visualizer-selection-map [next]
- (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
- (define-key undo-tree-visualizer-selection-map [prior]
- (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
- ;; horizontal motion keys move to left and right siblings
- (define-key undo-tree-visualizer-selection-map [remap forward-char]
- 'undo-tree-visualizer-select-right)
- (define-key undo-tree-visualizer-selection-map [remap backward-char]
- 'undo-tree-visualizer-select-left)
- (define-key undo-tree-visualizer-selection-map [right]
- 'undo-tree-visualizer-select-right)
- (define-key undo-tree-visualizer-selection-map "f"
- 'undo-tree-visualizer-select-right)
- (define-key undo-tree-visualizer-selection-map "\C-f"
- 'undo-tree-visualizer-select-right)
- (define-key undo-tree-visualizer-selection-map [left]
- 'undo-tree-visualizer-select-left)
- (define-key undo-tree-visualizer-selection-map "b"
- 'undo-tree-visualizer-select-left)
- (define-key undo-tree-visualizer-selection-map "\C-b"
- 'undo-tree-visualizer-select-left)
- ;; horizontal scroll keys move left or right quickly
- (define-key undo-tree-visualizer-selection-map ","
- (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
- (define-key undo-tree-visualizer-selection-map "."
- (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
- (define-key undo-tree-visualizer-selection-map "<"
- (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
- (define-key undo-tree-visualizer-selection-map ">"
- (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
- ;; mouse or <enter> sets buffer state to node at point/click
- (define-key undo-tree-visualizer-selection-map "\r"
- 'undo-tree-visualizer-set)
- (define-key undo-tree-visualizer-selection-map [mouse-1]
- 'undo-tree-visualizer-mouse-set)
- ;; toggle timestamps
- (define-key undo-tree-visualizer-selection-map "t"
- 'undo-tree-visualizer-toggle-timestamps)
- ;; quit visualizer selection mode
- (define-key undo-tree-visualizer-selection-map "s"
- 'undo-tree-visualizer-mode)
- ;; quit visualizer
- (define-key undo-tree-visualizer-selection-map "q"
- 'undo-tree-visualizer-quit)
- (define-key undo-tree-visualizer-selection-map "\C-q"
- 'undo-tree-visualizer-quit))
+\f
+;;; =================================================================
+;;; Default keymaps
+(defvar undo-tree-map nil
+ "Keymap used in undo-tree-mode.")
+(unless undo-tree-map
+ (let ((map (make-sparse-keymap)))
+ ;; remap `undo' and `undo-only' to `undo-tree-undo'
+ (define-key map [remap undo] 'undo-tree-undo)
+ (define-key map [remap undo-only] 'undo-tree-undo)
+ ;; bind standard undo bindings (since these match redo counterparts)
+ (define-key map (kbd "C-/") 'undo-tree-undo)
+ (define-key map "\C-_" 'undo-tree-undo)
+ ;; redo doesn't exist normally, so define our own keybindings
+ (define-key map (kbd "C-?") 'undo-tree-redo)
+ (define-key map (kbd "M-_") 'undo-tree-redo)
+ ;; just in case something has defined `redo'...
+ (define-key map [remap redo] 'undo-tree-redo)
+ ;; we use "C-x u" for the undo-tree visualizer
+ (define-key map (kbd "\C-x u") 'undo-tree-visualize)
+ ;; bind register commands
+ (define-key map (kbd "C-x r u") 'undo-tree-save-state-to-register)
+ (define-key map (kbd "C-x r U") 'undo-tree-restore-state-from-register)
+ ;; set keymap
+ (setq undo-tree-map map)))
+
+
+(defvar undo-tree-visualizer-mode-map nil
+ "Keymap used in undo-tree visualizer.")
+(unless undo-tree-visualizer-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; vertical motion keys undo/redo
+ (define-key map [remap previous-line] 'undo-tree-visualize-undo)
+ (define-key map [remap next-line] 'undo-tree-visualize-redo)
+ (define-key map [up] 'undo-tree-visualize-undo)
+ (define-key map "p" 'undo-tree-visualize-undo)
+ (define-key map "\C-p" 'undo-tree-visualize-undo)
+ (define-key map [down] 'undo-tree-visualize-redo)
+ (define-key map "n" 'undo-tree-visualize-redo)
+ (define-key map "\C-n" 'undo-tree-visualize-redo)
+ ;; horizontal motion keys switch branch
+ (define-key map [remap forward-char]
+ 'undo-tree-visualize-switch-branch-right)
+ (define-key map [remap backward-char]
+ 'undo-tree-visualize-switch-branch-left)
+ (define-key map [right] 'undo-tree-visualize-switch-branch-right)
+ (define-key map "f" 'undo-tree-visualize-switch-branch-right)
+ (define-key map "\C-f" 'undo-tree-visualize-switch-branch-right)
+ (define-key map [left] 'undo-tree-visualize-switch-branch-left)
+ (define-key map "b" 'undo-tree-visualize-switch-branch-left)
+ (define-key map "\C-b" 'undo-tree-visualize-switch-branch-left)
+ ;; paragraph motion keys undo/redo to significant points in tree
+ (define-key map [remap backward-paragraph] 'undo-tree-visualize-undo-to-x)
+ (define-key map [remap forward-paragraph] 'undo-tree-visualize-redo-to-x)
+ (define-key map "\M-{" 'undo-tree-visualize-undo-to-x)
+ (define-key map "\M-}" 'undo-tree-visualize-redo-to-x)
+ (define-key map [C-up] 'undo-tree-visualize-undo-to-x)
+ (define-key map [C-down] 'undo-tree-visualize-redo-to-x)
+ ;; mouse sets buffer state to node at click
+ (define-key map [mouse-1] 'undo-tree-visualizer-mouse-set)
+ ;; toggle timestamps
+ (define-key map "t" 'undo-tree-visualizer-toggle-timestamps)
+ ;; toggle diff
+ (define-key map "d" 'undo-tree-visualizer-toggle-diff)
+ ;; toggle selection mode
+ (define-key map "s" 'undo-tree-visualizer-selection-mode)
+ ;; horizontal scrolling may be needed if the tree is very wide
+ (define-key map "," 'undo-tree-visualizer-scroll-left)
+ (define-key map "." 'undo-tree-visualizer-scroll-right)
+ (define-key map "<" 'undo-tree-visualizer-scroll-left)
+ (define-key map ">" 'undo-tree-visualizer-scroll-right)
+ ;; vertical scrolling may be needed if the tree is very tall
+ (define-key map [next] 'undo-tree-visualizer-scroll-up)
+ (define-key map [prior] 'undo-tree-visualizer-scroll-down)
+ ;; quit/abort visualizer
+ (define-key map "q" 'undo-tree-visualizer-quit)
+ (define-key map "\C-q" 'undo-tree-visualizer-abort)
+ ;; set keymap
+ (setq undo-tree-visualizer-mode-map map)))
+
+
+(defvar undo-tree-visualizer-selection-mode-map nil
+ "Keymap used in undo-tree visualizer selection mode.")
+(unless undo-tree-visualizer-selection-mode-map
+ (let ((map (make-sparse-keymap)))
+ ;; vertical motion keys move up and down tree
+ (define-key map [remap previous-line]
+ 'undo-tree-visualizer-select-previous)
+ (define-key map [remap next-line]
+ 'undo-tree-visualizer-select-next)
+ (define-key map [up] 'undo-tree-visualizer-select-previous)
+ (define-key map "p" 'undo-tree-visualizer-select-previous)
+ (define-key map "\C-p" 'undo-tree-visualizer-select-previous)
+ (define-key map [down] 'undo-tree-visualizer-select-next)
+ (define-key map "n" 'undo-tree-visualizer-select-next)
+ (define-key map "\C-n" 'undo-tree-visualizer-select-next)
+ ;; vertical scroll keys move up and down quickly
+ (define-key map [next]
+ (lambda () (interactive) (undo-tree-visualizer-select-next 10)))
+ (define-key map [prior]
+ (lambda () (interactive) (undo-tree-visualizer-select-previous 10)))
+ ;; horizontal motion keys move to left and right siblings
+ (define-key map [remap forward-char] 'undo-tree-visualizer-select-right)
+ (define-key map [remap backward-char] 'undo-tree-visualizer-select-left)
+ (define-key map [right] 'undo-tree-visualizer-select-right)
+ (define-key map "f" 'undo-tree-visualizer-select-right)
+ (define-key map "\C-f" 'undo-tree-visualizer-select-right)
+ (define-key map [left] 'undo-tree-visualizer-select-left)
+ (define-key map "b" 'undo-tree-visualizer-select-left)
+ (define-key map "\C-b" 'undo-tree-visualizer-select-left)
+ ;; horizontal scroll keys move left or right quickly
+ (define-key map ","
+ (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
+ (define-key map "."
+ (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
+ (define-key map "<"
+ (lambda () (interactive) (undo-tree-visualizer-select-left 10)))
+ (define-key map ">"
+ (lambda () (interactive) (undo-tree-visualizer-select-right 10)))
+ ;; <enter> sets buffer state to node at point
+ (define-key map "\r" 'undo-tree-visualizer-set)
+ ;; mouse selects node at click
+ (define-key map [mouse-1] 'undo-tree-visualizer-mouse-select)
+ ;; toggle diff
+ (define-key map "d" 'undo-tree-visualizer-selection-toggle-diff)
+ ;; set keymap
+ (setq undo-tree-visualizer-selection-mode-map map)))
+
+
+(defvar undo-tree-old-undo-menu-item nil)
+
+(defun undo-tree-update-menu-bar ()
+ "Update `undo-tree-mode' Edit menu items."
+ (if undo-tree-mode
+ (progn
+ ;; save old undo menu item, and install undo/redo menu items
+ (setq undo-tree-old-undo-menu-item
+ (cdr (assq 'undo (lookup-key global-map [menu-bar edit]))))
+ (define-key (lookup-key global-map [menu-bar edit])
+ [undo] '(menu-item "Undo" undo-tree-undo
+ :enable (and undo-tree-mode
+ (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (undo-tree-node-previous
+ (undo-tree-current buffer-undo-tree)))
+ :help "Undo last operation"))
+ (define-key-after (lookup-key global-map [menu-bar edit])
+ [redo] '(menu-item "Redo" undo-tree-redo
+ :enable (and undo-tree-mode
+ (not buffer-read-only)
+ (not (eq t buffer-undo-list))
+ (undo-tree-node-next
+ (undo-tree-current buffer-undo-tree)))
+ :help "Redo last operation")
+ 'undo))
+ ;; uninstall undo/redo menu items
+ (define-key (lookup-key global-map [menu-bar edit])
+ [undo] undo-tree-old-undo-menu-item)
+ (define-key (lookup-key global-map [menu-bar edit])
+ [redo] nil)))
+
+(add-hook 'menu-bar-update-hook 'undo-tree-update-menu-bar)
+
+
+
+
+\f
;;; =====================================================================
;;; Undo-tree data structure
(root (undo-tree-make-node nil nil))
(current root)
(size 0)
+ (count 0)
(object-pool (make-hash-table :test 'eq :weakness 'value))))
;;(:copier nil)
)
- root current size object-pool)
+ root current size count object-pool)
(let ((len (length (undo-tree-make-visualizer-data))))
`(and (vectorp ,v) (= (length ,v) ,len))))
-(defmacro undo-tree-node-clear-visualizer-data (node)
- `(setf (undo-tree-node-meta-data ,node)
- (delq nil
- (delq :visualizer
- (plist-put (undo-tree-node-meta-data ,node)
- :visualizer nil)))))
-
+(defun undo-tree-node-clear-visualizer-data (node)
+ (let ((plist (undo-tree-node-meta-data node)))
+ (if (eq (car plist) :visualizer)
+ (setf (undo-tree-node-meta-data node) (nthcdr 2 plist))
+ (while (and plist (not (eq (cadr plist) :visualizer)))
+ (setq plist (cdr plist)))
+ (if plist (setcdr plist (nthcdr 3 plist))))))
(defmacro undo-tree-node-lwidth (node)
`(let ((v (plist-get (undo-tree-node-meta-data ,node) :visualizer)))
-
+\f
;;; =====================================================================
;;; Basic undo-tree data structure functions
(setf (undo-tree-node-previous n) parent))))
-(defun undo-tree-mapc (--undo-tree-mapc-function-- undo-tree)
- ;; Apply FUNCTION to each node in UNDO-TREE.
- (let ((stack (list (undo-tree-root undo-tree)))
- node)
+(defun undo-tree-mapc (--undo-tree-mapc-function-- node)
+ ;; Apply FUNCTION to NODE and to each node below it.
+ (let ((stack (list node))
+ n)
(while stack
- (setq node (pop stack))
- (funcall --undo-tree-mapc-function-- node)
- (setq stack (append (undo-tree-node-next node) stack)))))
+ (setq n (pop stack))
+ (funcall --undo-tree-mapc-function-- n)
+ (setq stack (append (undo-tree-node-next n) stack)))))
(defmacro undo-tree-num-branches ()
(make-symbol (format "undo-tree-id%d" num))))
+(defun undo-tree-decircle (undo-tree)
+ ;; Nullify PREVIOUS links of UNDO-TREE nodes, to make UNDO-TREE data
+ ;; structure non-circular.
+ (undo-tree-mapc
+ (lambda (node)
+ (dolist (n (undo-tree-node-next node))
+ (setf (undo-tree-node-previous n) nil)))
+ (undo-tree-root undo-tree)))
+
+(defun undo-tree-recircle (undo-tree)
+ ;; Recreate PREVIOUS links of UNDO-TREE nodes, to restore circular UNDO-TREE
+ ;; data structure.
+ (undo-tree-mapc
+ (lambda (node)
+ (dolist (n (undo-tree-node-next node))
+ (setf (undo-tree-node-previous n) node)))
+ (undo-tree-root undo-tree)))
+
+
+\f
;;; =====================================================================
-;;; Utility functions for handling `buffer-undo-list' and changesets
+;;; Undo list and undo changeset utility functions
(defmacro undo-list-marker-elt-p (elt)
`(markerp (car-safe ,elt)))
(undo-tree-move-GC-elts-to-pool (car p))
(while (and discard-pos (integerp (car buffer-undo-list)))
(setq buffer-undo-list (cdr buffer-undo-list)))
- (car buffer-undo-list))
+ (and (car buffer-undo-list)
+ (not (eq (car buffer-undo-list) 'undo-tree-canary))))
(setcdr p (list (pop buffer-undo-list)))
(setq p (cdr p)))
changeset)))
(defun undo-tree-copy-list (undo-list)
;; Return a deep copy of first changeset in `undo-list'. Object id's are
;; replaced by corresponding objects from `buffer-undo-tree' object-pool.
- (when undo-list
(let (copy p)
;; if first element contains an object id, replace it with object from
;; pool, discarding element entirely if it's been GC'd
- (while (null copy)
+ (while (and undo-list (null copy))
(setq copy
(undo-tree-restore-GC-elts-from-pool (pop undo-list))))
+ (when copy
(setq copy (list copy)
p copy)
;; copy remaining elements, replacing object id's with objects from
(defun undo-list-transfer-to-tree ()
;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
+ ;; `undo-list-transfer-to-tree' should never be called when undo is disabled
+ ;; (i.e. `buffer-undo-tree' is t)
+ (assert (not (eq buffer-undo-tree t)))
+
;; if `buffer-undo-tree' is empty, create initial undo-tree
(when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
;; make sure there's a canary at end of `buffer-undo-list'
(when (null buffer-undo-list)
(setq buffer-undo-list '(nil undo-tree-canary)))
- (unless (eq (cadr buffer-undo-list) 'undo-tree-canary)
+ (unless (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
+ (eq (car buffer-undo-list) 'undo-tree-canary))
;; create new node from first changeset in `buffer-undo-list', save old
;; `buffer-undo-tree' current node, and make new node the current node
(let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
(splice (undo-tree-current buffer-undo-tree))
- (size (undo-list-byte-size (undo-tree-node-undo node))))
+ (size (undo-list-byte-size (undo-tree-node-undo node)))
+ (count 1))
(setf (undo-tree-current buffer-undo-tree) node)
;; grow tree fragment backwards using `buffer-undo-list' changesets
(while (and buffer-undo-list
(not (eq (cadr buffer-undo-list) 'undo-tree-canary)))
(setq node
(undo-tree-grow-backwards node (undo-list-pop-changeset)))
- (incf size (undo-list-byte-size (undo-tree-node-undo node))))
+ (incf size (undo-list-byte-size (undo-tree-node-undo node)))
+ (incf count))
;; if no undo history has been discarded from `buffer-undo-list' since
;; last transfer, splice new tree fragment onto end of old
;; `buffer-undo-tree' current node
- (if (eq (cadr buffer-undo-list) 'undo-tree-canary)
+ (if (or (eq (cadr buffer-undo-list) 'undo-tree-canary)
+ (eq (car buffer-undo-list) 'undo-tree-canary))
(progn
(setf (undo-tree-node-previous node) splice)
(push node (undo-tree-node-next splice))
(setf (undo-tree-node-branch splice) 0)
- (incf (undo-tree-size buffer-undo-tree) size))
+ (incf (undo-tree-size buffer-undo-tree) size)
+ (incf (undo-tree-count buffer-undo-tree) count))
;; if undo history has been discarded, replace entire
;; `buffer-undo-tree' with new tree fragment
(setq node (undo-tree-grow-backwards node nil))
(setf (undo-tree-root buffer-undo-tree) node)
(setq buffer-undo-list '(nil undo-tree-canary))
(setf (undo-tree-size buffer-undo-tree) size)
+ (setf (undo-tree-count buffer-undo-tree) count)
(setq buffer-undo-list '(nil undo-tree-canary))))
;; discard undo history if necessary
(undo-tree-discard-history)))
-
+\f
;;; =====================================================================
-;;; History discarding functions
+;;; History discarding utility functions
(defun undo-tree-oldest-leaf (node)
;; Return oldest leaf node below NODE.
(decf (undo-tree-size buffer-undo-tree)
(+ (undo-list-byte-size (undo-tree-node-undo node))
(undo-list-byte-size (undo-tree-node-redo node))))
- ;; discard new root's undo data
+ (decf (undo-tree-count buffer-undo-tree))
+ ;; discard new root's undo data and PREVIOUS link
(setf (undo-tree-node-undo node) nil
- (undo-tree-node-redo node) nil)
+ (undo-tree-node-redo node) nil
+ (undo-tree-node-previous node) nil)
;; if new root has branches, or new root is current node, next node
;; to discard is oldest leaf, otherwise it's new root
(if (or (> (length (undo-tree-node-next node)) 1)
(decf (undo-tree-size buffer-undo-tree)
(+ (undo-list-byte-size (undo-tree-node-undo node))
(undo-list-byte-size (undo-tree-node-redo node))))
+ (decf (undo-tree-count buffer-undo-tree))
+ ;; discard leaf
(setf (undo-tree-node-next parent)
(delq node (undo-tree-node-next parent))
(undo-tree-node-branch parent)
(undo-tree-position current (undo-tree-node-next parent)))
;; if parent has branches, or parent is current node, next node to
- ;; discard is oldest leaf, otherwise it's parent
+ ;; discard is oldest leaf, otherwise it's the parent itself
(if (or (eq parent (undo-tree-current buffer-undo-tree))
(and (undo-tree-node-next parent)
(or (not (eq parent (undo-tree-root buffer-undo-tree)))
-
+\f
;;; =====================================================================
-;;; Visualizer-related functions
+;;; Visualizer utility functions
-(defun undo-tree-compute-widths (undo-tree)
- "Recursively compute widths for all UNDO-TREE's nodes."
- (let ((stack (list (undo-tree-root undo-tree)))
+(defun undo-tree-compute-widths (node)
+ "Recursively compute widths for nodes below NODE."
+ (let ((stack (list node))
res)
(while stack
;; try to compute widths for node at top of stack
;; (in a vector) if successful. Otherwise, returns a node whose widths need
;; calculating before NODE's can be calculated.
(let ((num-children (length (undo-tree-node-next node)))
- (lwidth 0) (cwidth 0) (rwidth 0)
- p w)
+ (lwidth 0) (cwidth 0) (rwidth 0) p)
(catch 'need-widths
(cond
;; leaf nodes have 0 width
(vector lwidth cwidth rwidth))))
-(defun undo-tree-clear-visualizer-data (undo-tree)
- ;; Clear visualizer data from UNDO-TREE.
+(defun undo-tree-clear-visualizer-data (tree)
+ ;; Clear visualizer data below NODE.
(undo-tree-mapc
- (lambda (node) (undo-tree-node-clear-visualizer-data node))
- undo-tree))
-
-
+ (lambda (n) (undo-tree-node-clear-visualizer-data n))
+ (undo-tree-root tree)))
+
+
+(defun undo-tree-node-unmodified-p (node &optional mtime)
+ ;; Return non-nil if NODE corresponds to a buffer state that once upon a
+ ;; time was unmodified. If a file modification time MTIME is specified,
+ ;; return non-nil if the corresponding buffer state really is unmodified.
+ (let (changeset ntime)
+ (setq changeset
+ (or (undo-tree-node-redo node)
+ (and (setq changeset (car (undo-tree-node-next node)))
+ (undo-tree-node-undo changeset)))
+ ntime
+ (catch 'found
+ (dolist (elt changeset)
+ (when (and (consp elt) (eq (car elt) t) (consp (cdr elt))
+ (throw 'found (cdr elt)))))))
+ (and ntime
+ (or (null mtime)
+ ;; high-precision timestamps
+ (if (listp (cdr ntime))
+ (equal ntime mtime)
+ ;; old-style timestamps
+ (and (= (car ntime) (car mtime))
+ (= (cdr ntime) (cadr mtime))))))))
+
+
+
+\f
+;;; =====================================================================
+;;; Undo-in-region utility functions
+;; `undo-elt-in-region' uses this as a dynamically-scoped variable
+(defvar undo-adjusted-markers nil)
-;;; =====================================================================
-;;; Undo-in-region functions
(defun undo-tree-pull-undo-in-region-branch (start end)
;; Pull out entries from undo changesets to create a new undo-in-region
;; (recognizable as first node with more than one branch)
(let ((mark-active nil))
(while (= (length (undo-tree-node-next node)) 1)
- (undo-tree-undo)
+ (undo-tree-undo-1)
(setq fragment node
node (undo-tree-current buffer-undo-tree))))
(when (eq splice node) (setq splice nil))
(setq node (undo-tree-node-previous node))))
;; pop dummy nil from front of `region-changeset'
- (pop region-changeset)
+ (setq region-changeset (cdr region-changeset))
;; --- integrate branch into tree ---
(let ((mark-active nil))
(while (not (eq (undo-tree-current buffer-undo-tree)
original-current))
- (undo-tree-redo)))
+ (undo-tree-redo-1)))
nil) ; return nil to indicate failure
;; otherwise...
(let ((mark-active nil)
(current (undo-tree-current buffer-undo-tree)))
(while (not (eq (undo-tree-current buffer-undo-tree) node))
- (undo-tree-undo))
+ (undo-tree-undo-1))
(while (not (eq (undo-tree-current buffer-undo-tree) current))
- (undo-tree-redo)))
+ (undo-tree-redo-1)))
(cond
;; if there's no remaining fragment, just create undo-in-region node
(undo-tree-node-previous original-fragment))
(let ((mark-active nil))
(while (not (eq (undo-tree-current buffer-undo-tree) splice))
- (undo-tree-redo nil 'preserve-undo))))
+ (undo-tree-redo-1 nil 'preserve-undo))))
;; splice new undo-in-region node into fragment
(setq node (undo-tree-make-node nil region-changeset))
(undo-tree-splice-node node splice)
(while (progn
(and (setq node (car (undo-tree-node-next node)))
(not (eq node original-fragment))
+ (incf (undo-tree-count buffer-undo-tree))
(incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-undo node)))
- (when (undo-tree-node-redo node)
- (incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-redo node))))
- )))
+ (+ (undo-list-byte-size (undo-tree-node-undo node))
+ (undo-list-byte-size (undo-tree-node-redo node)))))))
t) ; indicate undo-in-region branch was successfully pulled
)))
(setq node (car (undo-tree-node-next node)))))
;; pop dummy nil from front of `region-changeset'
- (pop region-changeset)
+ (setq region-changeset (cdr region-changeset))
;; --- integrate branch into tree ---
;; update undo-tree size
(unless repeated-redo-in-region
(setq node fragment)
- (while (progn
- (and (setq node (car (undo-tree-node-next node)))
- (incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size
- (undo-tree-node-redo node)))))))
+ (while (and (setq node (car (undo-tree-node-next node)))
+ (incf (undo-tree-count buffer-undo-tree))
+ (incf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size
+ (undo-tree-node-redo node))))))
(incf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-redo fragment)))
- t) ; indicate undo-in-region branch was successfully pulled
+ t) ; indicate redo-in-region branch was successfully pulled
)))
-
+\f
;;; =====================================================================
;;; Undo-tree commands
Within the undo-tree visualizer, the following keys are available:
- \\{undo-tree-visualizer-map}"
+ \\{undo-tree-visualizer-mode-map}"
nil ; init value
undo-tree-mode-lighter ; lighter
undo-tree-map ; keymap
- (cond
- ;; if enabling `undo-tree-mode', set up history-saving hooks if
- ;; `undo-tree-auto-save-history' is enabled
- (undo-tree-mode
- (when undo-tree-auto-save-history
- (add-hook 'write-file-functions 'undo-tree-save-history-hook nil t)
- (add-hook 'find-file-hook 'undo-tree-load-history-hook nil t)))
- ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
- ;; Emacs undo can work
- (t
+ ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so
+ ;; Emacs undo can work
+ (when (not undo-tree-mode)
(undo-list-rebuild-from-tree)
- (setq buffer-undo-tree nil)
- (when undo-tree-auto-save-history
- (remove-hook 'write-file-functions 'undo-tree-save-history-hook t)
- (remove-hook 'find-file-hook 'undo-tree-load-history-hook t)))))
+ (setq buffer-undo-tree nil)))
(defun turn-on-undo-tree-mode (&optional print-message)
-(defun undo-tree-undo (&optional arg preserve-redo)
+(defun undo-tree-undo (&optional arg)
"Undo changes.
Repeat this command to undo more changes.
A numeric ARG serves as a repeat count.
In Transient Mark mode when the mark is active, only undo changes
within the current region. Similarly, when not in Transient Mark
mode, just \\[universal-argument] as an argument limits undo to
-changes within the current region.
-
-A non-nil PRESERVE-REDO causes the existing redo record to be
-preserved, rather than replacing it with the new one generated by
-undoing."
+changes within the current region."
(interactive "*P")
;; throw error if undo is disabled in buffer
- (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
-
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
+ (undo-tree-undo-1 arg)
+ ;; inform user if at branch point
+ (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
+
+
+(defun undo-tree-undo-1 (&optional arg preserve-redo preserve-timestamps)
+ ;; Internal undo function. An active mark in `transient-mark-mode', or
+ ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-REDO
+ ;; causes the existing redo record to be preserved, rather than replacing it
+ ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
+ ;; disables updating of timestamps in visited undo-tree nodes. (This latter
+ ;; should *only* be used when temporarily visiting another undo state and
+ ;; immediately returning to the original state afterwards. Otherwise, it
+ ;; could cause history-discarding errors.)
(let ((undo-in-progress t)
(undo-in-region (and undo-tree-enable-undo-in-region
(or (region-active-p)
(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
;; check if at top of undo tree
(unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
- (error "No further undo information"))
+ (user-error "No further undo information"))
;; if region is active, or a non-numeric prefix argument was supplied,
;; try to pull out a new branch of changes affecting the region
(when (and undo-in-region
(not (undo-tree-pull-undo-in-region-branch
(region-beginning) (region-end))))
- (error "No further undo information for region"))
+ (user-error "No further undo information for region"))
;; remove any GC'd elements from node's undo list
(setq current (undo-tree-current buffer-undo-tree))
;; otherwise, record redo entries that `primitive-undo' has added to
;; `buffer-undo-list' in current node's redo record, replacing
;; existing entry if one already exists
- (when (undo-tree-node-redo current)
- (decf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-redo current))))
+ (decf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-redo current)))
(setf (undo-tree-node-redo current)
(undo-list-pop-changeset 'discard-pos))
(incf (undo-tree-size buffer-undo-tree)
;; rewind current node and update timestamp
(setf (undo-tree-current buffer-undo-tree)
- (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
- (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
- (current-time))
+ (undo-tree-node-previous (undo-tree-current buffer-undo-tree)))
+ (unless preserve-timestamps
+ (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
+ (current-time)))
;; if undoing-in-region, record current node, region and direction so we
;; can tell if undo-in-region is repeated, and re-activate mark if in
(set-marker pos nil)))
;; undo deactivates mark unless undoing-in-region
- (setq deactivate-mark (not undo-in-region))
- ;; inform user if at branch point
- (when (and (called-interactively-p 'interactive)
- (> (undo-tree-num-branches) 1))
- (message "Undo branch point!"))))
+ (setq deactivate-mark (not undo-in-region))))
-(defun undo-tree-redo (&optional arg preserve-undo)
+(defun undo-tree-redo (&optional arg)
"Redo changes. A numeric ARG serves as a repeat count.
In Transient Mark mode when the mark is active, only redo changes
within the current region. Similarly, when not in Transient Mark
mode, just \\[universal-argument] as an argument limits redo to
-changes within the current region.
-
-A non-nil PRESERVE-UNDO causes the existing undo record to be
-preserved, rather than replacing it with the new one generated by
-redoing."
+changes within the current region."
(interactive "*P")
;; throw error if undo is disabled in buffer
- (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
-
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
+ (undo-tree-redo-1 arg)
+ ;; inform user if at branch point
+ (when (> (undo-tree-num-branches) 1) (message "Undo branch point!")))
+
+
+(defun undo-tree-redo-1 (&optional arg preserve-undo preserve-timestamps)
+ ;; Internal redo function. An active mark in `transient-mark-mode', or
+ ;; non-nil ARG otherwise, enables undo-in-region. Non-nil PRESERVE-UNDO
+ ;; causes the existing redo record to be preserved, rather than replacing it
+ ;; with the new one generated by undoing. Non-nil PRESERVE-TIMESTAMPS
+ ;; disables updating of timestamps in visited undo-tree nodes. (This latter
+ ;; should *only* be used when temporarily visiting another undo state and
+ ;; immediately returning to the original state afterwards. Otherwise, it
+ ;; could cause history-discarding errors.)
(let ((undo-in-progress t)
(redo-in-region (and undo-tree-enable-undo-in-region
(or (region-active-p)
(dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
;; check if at bottom of undo tree
(when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
- (error "No further redo information"))
+ (user-error "No further redo information"))
;; if region is active, or a non-numeric prefix argument was supplied,
;; try to pull out a new branch of changes affecting the region
(when (and redo-in-region
(not (undo-tree-pull-redo-in-region-branch
(region-beginning) (region-end))))
- (error "No further redo information for region"))
+ (user-error "No further redo information for region"))
- ;; advance current node
+ ;; get next node (but DON'T advance current node in tree yet, in case
+ ;; redoing fails)
(setq current (undo-tree-current buffer-undo-tree)
- current (setf (undo-tree-current buffer-undo-tree)
- (nth (undo-tree-node-branch current)
- (undo-tree-node-next current))))
+ current (nth (undo-tree-node-branch current)
+ (undo-tree-node-next current)))
;; remove any GC'd elements from node's redo list
(decf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-redo current)))
(set-marker-insertion-type pos t))
(primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
(undo-boundary)
+ ;; advance current node in tree
+ (setf (undo-tree-current buffer-undo-tree) current)
;; if preserving old undo record, discard new undo entries that
;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
;; otherwise, record undo entries that `primitive-undo' has added to
;; `buffer-undo-list' in current node's undo record, replacing
;; existing entry if one already exists
- (when (undo-tree-node-undo current)
- (decf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-undo current))))
+ (decf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-undo current)))
(setf (undo-tree-node-undo current)
(undo-list-pop-changeset 'discard-pos))
(incf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-undo current))))
;; update timestamp
- (setf (undo-tree-node-timestamp current) (current-time))
+ (unless preserve-timestamps
+ (setf (undo-tree-node-timestamp current) (current-time)))
;; if redoing-in-region, record current node, region and direction so we
;; can tell if redo-in-region is repeated, and re-activate mark if in
(set-marker pos nil)))
;; redo deactivates the mark unless redoing-in-region
- (setq deactivate-mark (not redo-in-region))
- ;; inform user if at branch point
- (when (and (called-interactively-p 'interactive)
- (> (undo-tree-num-branches) 1))
- (message "Undo branch point!"))))
+ (setq deactivate-mark (not redo-in-region))))
(1- (undo-tree-num-branches)) b)))
))))))
;; throw error if undo is disabled in buffer
- (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
;; sanity check branch number
- (when (<= (undo-tree-num-branches) 1) (error "Not at undo branch point"))
+ (when (<= (undo-tree-num-branches) 1)
+ (user-error "Not at undo branch point"))
(when (or (< branch 0) (> branch (1- (undo-tree-num-branches))))
- (error "Invalid branch number"))
+ (user-error "Invalid branch number"))
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
(undo-list-transfer-to-tree)
;; switch branch
(message "Switched to branch %d" branch))
-(defun undo-tree-set (node)
+(defun undo-tree-set (node &optional preserve-timestamps)
;; Set buffer to state corresponding to NODE. Returns intersection point
;; between path back from current node and path back from selected NODE.
+ ;; Non-nil PRESERVE-TIMESTAMPS disables updating of timestamps in visited
+ ;; undo-tree nodes. (This should *only* be used when temporarily visiting
+ ;; another undo state and immediately returning to the original state
+ ;; afterwards. Otherwise, it could cause history-discarding errors.)
(let ((path (make-hash-table :test 'eq))
(n node))
(puthash (undo-tree-root buffer-undo-tree) t path)
(setq n (undo-tree-node-previous n)))
;; ascend tree until intersection node
(while (not (eq (undo-tree-current buffer-undo-tree) n))
- (undo-tree-undo))
+ (undo-tree-undo-1 nil nil preserve-timestamps))
;; descend tree until selected node
(while (not (eq (undo-tree-current buffer-undo-tree) node))
- (undo-tree-redo))
+ (undo-tree-redo-1 nil nil preserve-timestamps))
n)) ; return intersection node
Argument is a character, naming the register."
(interactive "cUndo-tree state to register: ")
;; throw error if undo is disabled in buffer
- (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
(undo-list-transfer-to-tree)
;; save current node to REGISTER
(let ((data (registerv-data (get-register register))))
(cond
((eq buffer-undo-list t)
- (error "No undo information in this buffer"))
+ (user-error "No undo information in this buffer"))
((not (undo-tree-register-data-p data))
- (error "Register doesn't contain undo-tree state"))
+ (user-error "Register doesn't contain undo-tree state"))
((not (eq (current-buffer) (undo-tree-register-data-buffer data)))
- (error "Register contains undo-tree state for a different buffer")))
+ (user-error "Register contains undo-tree state for a different buffer")))
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
(undo-list-transfer-to-tree)
;; restore buffer state corresponding to saved node
-(defmacro undo-tree-history-save-file (file)
- `(concat (file-name-directory ,file)
- "." (file-name-nondirectory ,file)
- ".~undo-tree"))
+\f
+;;; =====================================================================
+;;; Persistent storage commands
+
+(defun undo-tree-make-history-save-file-name (file)
+ "Create the undo history file name for FILE.
+Normally this is the file's name with \".\" prepended and
+\".~undo-tree~\" appended.
+
+A match for FILE is sought in `undo-tree-history-directory-alist'
+\(see the documentation of that variable for details\). If the
+directory for the backup doesn't exist, it is created."
+ (let* ((backup-directory-alist undo-tree-history-directory-alist)
+ (name (make-backup-file-name-1 file)))
+ (concat (file-name-directory name) "." (file-name-nondirectory name)
+ ".~undo-tree~")))
(defun undo-tree-save-history (&optional filename overwrite)
If OVERWRITE is non-nil, any existing file will be overwritten
without asking for confirmation."
(interactive)
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
(undo-list-transfer-to-tree)
- (let ((buff (current-buffer))
- (tree (copy-undo-tree buffer-undo-tree)))
- ;; get filename
- (unless filename
- (setq filename
- (if buffer-file-name
- (undo-tree-history-save-file buffer-file-name)
- (expand-file-name (read-file-name "File to save in: ") nil))))
- (when (or (not (file-exists-p filename))
- overwrite
- (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
- ;; discard undo-tree object pool before saving
- (setf (undo-tree-object-pool tree) nil)
- ;; print undo-tree to file
- (with-temp-file filename
- (prin1 (sha1 buff) (current-buffer))
- (terpri (current-buffer))
- (let ((print-circle t)) (prin1 tree (current-buffer)))))))
+ (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
+ (condition-case nil
+ (undo-tree-kill-visualizer)
+ (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
+ (let ((buff (current-buffer))
+ tree)
+ ;; get filename
+ (unless filename
+ (setq filename
+ (if buffer-file-name
+ (undo-tree-make-history-save-file-name buffer-file-name)
+ (expand-file-name (read-file-name "File to save in: ") nil))))
+ (when (or (not (file-exists-p filename))
+ overwrite
+ (yes-or-no-p (format "Overwrite \"%s\"? " filename)))
+ (unwind-protect
+ (progn
+ ;; transform undo-tree into non-circular structure, and make
+ ;; temporary copy
+ (undo-tree-decircle buffer-undo-tree)
+ (setq tree (copy-undo-tree buffer-undo-tree))
+ ;; discard undo-tree object pool before saving
+ (setf (undo-tree-object-pool tree) nil)
+ ;; print undo-tree to file
+ ;; NOTE: We use `with-temp-buffer' instead of `with-temp-file'
+ ;; to allow `auto-compression-mode' to take effect, in
+ ;; case user has overridden or advised the default
+ ;; `undo-tree-make-history-save-file-name' to add a
+ ;; compressed file extension.
+ (with-auto-compression-mode
+ (with-temp-buffer
+ (prin1 (sha1 buff) (current-buffer))
+ (terpri (current-buffer))
+ (let ((print-circle t)) (prin1 tree (current-buffer)))
+ (write-region nil nil filename))))
+ ;; restore circular undo-tree data structure
+ (undo-tree-recircle buffer-undo-tree))
+ ))))
(unless filename
(setq filename
(if buffer-file-name
- (undo-tree-history-save-file buffer-file-name)
+ (undo-tree-make-history-save-file-name buffer-file-name)
(expand-file-name (read-file-name "File to load from: ") nil))))
;; attempt to read undo-tree from FILENAME
(throw 'load-error nil)
(error "File \"%s\" does not exist; could not load undo-tree history"
filename)))
- (let (buff tmp hash tree)
+ (let (buff hash tree)
(setq buff (current-buffer))
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (condition-case nil
- (setq hash (read (current-buffer)))
- (error
- (kill-buffer nil)
- (funcall (if noerror 'message 'error)
- "Error reading undo-tree history from \"%s\"" filename)
- (throw 'load-error nil)))
- (unless (string= (sha1 buff) hash)
- (kill-buffer nil)
- (funcall (if noerror 'message 'error)
- "Buffer has been modified; could not load undo-tree history")
- (throw 'load-error nil))
- (condition-case nil
- (setq tree (read (current-buffer)))
- (error
- (kill-buffer nil)
- (funcall (if noerror 'message 'error)
- "Error reading undo-tree history from \"%s\"" filename)
- (throw 'load-error nil)))
- (kill-buffer nil))
+ (with-auto-compression-mode
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (condition-case nil
+ (setq hash (read (current-buffer)))
+ (error
+ (kill-buffer nil)
+ (funcall (if noerror 'message 'user-error)
+ "Error reading undo-tree history from \"%s\"" filename)
+ (throw 'load-error nil)))
+ (unless (string= (sha1 buff) hash)
+ (kill-buffer nil)
+ (funcall (if noerror 'message 'user-error)
+ "Buffer has been modified; could not load undo-tree history")
+ (throw 'load-error nil))
+ (condition-case nil
+ (setq tree (read (current-buffer)))
+ (error
+ (kill-buffer nil)
+ (funcall (if noerror 'message 'error)
+ "Error reading undo-tree history from \"%s\"" filename)
+ (throw 'load-error nil)))
+ (kill-buffer nil)))
;; initialise empty undo-tree object pool
(setf (undo-tree-object-pool tree)
(make-hash-table :test 'eq :weakness 'value))
+ ;; restore circular undo-tree data structure
+ (undo-tree-recircle tree)
(setq buffer-undo-tree tree))))
;; Versions of save/load functions for use in hooks
(defun undo-tree-save-history-hook ()
- (undo-tree-save-history nil t) nil)
+ (when (and undo-tree-mode undo-tree-auto-save-history
+ (not (eq buffer-undo-list t)))
+ (undo-tree-save-history nil t) nil))
(defun undo-tree-load-history-hook ()
- (undo-tree-load-history nil t))
-
+ (when (and undo-tree-mode undo-tree-auto-save-history
+ (not (eq buffer-undo-list t))
+ (not revert-buffer-in-progress-p))
+ (undo-tree-load-history nil t)))
+\f
;;; =====================================================================
-;;; Undo-tree visualizer
+;;; Visualizer drawing functions
(defun undo-tree-visualize ()
"Visualize the current buffer's undo tree."
(interactive "*")
(deactivate-mark)
;; throw error if undo is disabled in buffer
- (when (eq buffer-undo-list t) (error "No undo information in this buffer"))
+ (when (eq buffer-undo-list t)
+ (user-error "No undo information in this buffer"))
;; transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'
(undo-list-transfer-to-tree)
;; add hook to kill visualizer buffer if original buffer is changed
(display-buffer-mark-dedicated 'soft))
(switch-to-buffer-other-window
(get-buffer-create undo-tree-visualizer-buffer-name))
- (undo-tree-visualizer-mode)
(setq undo-tree-visualizer-parent-buffer buff)
+ (setq undo-tree-visualizer-parent-mtime
+ (and (buffer-file-name buff)
+ (nth 5 (file-attributes (buffer-file-name buff)))))
+ (setq undo-tree-visualizer-initial-node (undo-tree-current undo-tree))
+ (setq undo-tree-visualizer-spacing
+ (undo-tree-visualizer-calculate-spacing))
+ (make-local-variable 'undo-tree-visualizer-timestamps)
+ (make-local-variable 'undo-tree-visualizer-diff)
+ (setq buffer-undo-tree undo-tree)
+ (undo-tree-visualizer-mode)
+ ;; FIXME; don't know why `undo-tree-visualizer-mode' clears this
(setq buffer-undo-tree undo-tree)
+ (set (make-local-variable 'undo-tree-visualizer-lazy-drawing)
+ (or (eq undo-tree-visualizer-lazy-drawing t)
+ (and (numberp undo-tree-visualizer-lazy-drawing)
+ (>= (undo-tree-count undo-tree)
+ undo-tree-visualizer-lazy-drawing))))
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-show-diff))
(let ((inhibit-read-only t)) (undo-tree-draw-tree undo-tree))))
-(defun undo-tree-kill-visualizer (&rest dummy)
+(defun undo-tree-kill-visualizer (&rest _dummy)
;; Kill visualizer. Added to `before-change-functions' hook of original
;; buffer when visualizer is invoked.
- (unless undo-tree-inhibit-kill-visualizer
- (unwind-protect
- (with-current-buffer undo-tree-visualizer-buffer-name
- (undo-tree-visualizer-quit)))))
+ (unless (or undo-tree-inhibit-kill-visualizer
+ (null (get-buffer undo-tree-visualizer-buffer-name)))
+ (with-current-buffer undo-tree-visualizer-buffer-name
+ (undo-tree-visualizer-quit))))
(defun undo-tree-draw-tree (undo-tree)
- ;; Draw UNDO-TREE in current buffer.
- (erase-buffer)
- (undo-tree-move-down 1) ; top margin
- (undo-tree-clear-visualizer-data undo-tree)
- (undo-tree-compute-widths undo-tree)
- (undo-tree-move-forward
- (max (/ (window-width) 2)
- (+ (undo-tree-node-char-lwidth (undo-tree-root undo-tree))
- ;; add space for left part of left-most time-stamp
- (if undo-tree-visualizer-timestamps 4 0)
- 2))) ; left margin
- ;; draw undo-tree
- (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
- (stack (list (undo-tree-root undo-tree)))
- (n (undo-tree-root undo-tree)))
- ;; link root node to its representation in visualizer
- (unless (markerp (undo-tree-node-marker n))
- (setf (undo-tree-node-marker n) (make-marker))
- (set-marker-insertion-type (undo-tree-node-marker n) nil))
- (move-marker (undo-tree-node-marker n) (point))
- ;; draw nodes from stack until stack is empty
- (while stack
- (setq n (pop stack))
- (goto-char (undo-tree-node-marker n))
- (setq n (undo-tree-draw-subtree n nil))
- (setq stack (append stack n))))
- ;; highlight active branch
- (goto-char (undo-tree-node-marker (undo-tree-root undo-tree)))
- (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
- (undo-tree-highlight-active-branch (undo-tree-root undo-tree)))
- ;; highlight current node
- (undo-tree-draw-node (undo-tree-current undo-tree) 'current))
-
-
-(defun undo-tree-highlight-active-branch (node)
- ;; Draw highlighted active branch below NODE in current buffer.
- (let ((stack (list node)))
- ;; link node to its representation in visualizer
- (unless (markerp (undo-tree-node-marker node))
- (setf (undo-tree-node-marker node) (make-marker))
- (set-marker-insertion-type (undo-tree-node-marker node) nil))
+ ;; Draw undo-tree in current buffer starting from NODE (or root if nil).
+ (let ((node (if undo-tree-visualizer-lazy-drawing
+ (undo-tree-current undo-tree)
+ (undo-tree-root undo-tree))))
+ (erase-buffer)
+ (setq undo-tree-visualizer-needs-extending-down nil
+ undo-tree-visualizer-needs-extending-up nil)
+ (undo-tree-clear-visualizer-data undo-tree)
+ (undo-tree-compute-widths node)
+ ;; lazy drawing starts vertically centred and displaced horizontally to
+ ;; the left (window-width/4), since trees will typically grow right
+ (if undo-tree-visualizer-lazy-drawing
+ (progn
+ (undo-tree-move-down (/ (window-height) 2))
+ (undo-tree-move-forward (max 2 (/ (window-width) 4)))) ; left margin
+ ;; non-lazy drawing starts in centre at top of buffer
+ (undo-tree-move-down 1) ; top margin
+ (undo-tree-move-forward
+ (max (/ (window-width) 2)
+ (+ (undo-tree-node-char-lwidth node)
+ ;; add space for left part of left-most time-stamp
+ (if undo-tree-visualizer-timestamps
+ (/ (- undo-tree-visualizer-spacing 4) 2)
+ 0)
+ 2)))) ; left margin
+ ;; link starting node to its representation in visualizer
+ (setf (undo-tree-node-marker node) (make-marker))
+ (set-marker-insertion-type (undo-tree-node-marker node) nil)
(move-marker (undo-tree-node-marker node) (point))
+ ;; draw undo-tree
+ (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)
+ node-list)
+ (if (not undo-tree-visualizer-lazy-drawing)
+ (undo-tree-extend-down node t)
+ (undo-tree-extend-down node)
+ (undo-tree-extend-up node)
+ (setq node-list undo-tree-visualizer-needs-extending-down
+ undo-tree-visualizer-needs-extending-down nil)
+ (while node-list (undo-tree-extend-down (pop node-list)))))
+ ;; highlight active branch
+ (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face))
+ (undo-tree-highlight-active-branch
+ (or undo-tree-visualizer-needs-extending-up
+ (undo-tree-root undo-tree))))
+ ;; highlight current node
+ (undo-tree-draw-node (undo-tree-current undo-tree) 'current)))
+
+
+(defun undo-tree-extend-down (node &optional bottom)
+ ;; Extend tree downwards starting from NODE and point. If BOTTOM is t,
+ ;; extend all the way down to the leaves. If BOTTOM is a node, extend down
+ ;; as far as that node. If BOTTOM is an integer, extend down as far as that
+ ;; line. Otherwise, only extend visible portion of tree. NODE is assumed to
+ ;; already have a node marker. Returns non-nil if anything was actually
+ ;; extended.
+ (let ((extended nil)
+ (cur-stack (list node))
+ next-stack)
+ ;; don't bother extending if BOTTOM specifies an already-drawn node
+ (unless (and (undo-tree-node-p bottom) (undo-tree-node-marker bottom))
+ ;; draw nodes layer by layer
+ (while (or cur-stack
+ (prog1 (setq cur-stack next-stack)
+ (setq next-stack nil)))
+ (setq node (pop cur-stack))
+ ;; if node is within range being drawn...
+ (if (or (eq bottom t)
+ (and (undo-tree-node-p bottom)
+ (not (eq (undo-tree-node-previous node) bottom)))
+ (and (integerp bottom)
+ (>= bottom (line-number-at-pos
+ (undo-tree-node-marker node))))
+ (and (null bottom)
+ (pos-visible-in-window-p (undo-tree-node-marker node)
+ nil t)))
+ ;; ...draw one layer of node's subtree (if not already drawn)
+ (progn
+ (unless (and (undo-tree-node-next node)
+ (undo-tree-node-marker
+ (nth (undo-tree-node-branch node)
+ (undo-tree-node-next node))))
+ (goto-char (undo-tree-node-marker node))
+ (undo-tree-draw-subtree node)
+ (setq extended t))
+ (setq next-stack
+ (append (undo-tree-node-next node) next-stack)))
+ ;; ...otherwise, postpone drawing until later
+ (push node undo-tree-visualizer-needs-extending-down))))
+ extended))
+
+
+(defun undo-tree-extend-up (node &optional top)
+ ;; Extend tree upwards starting from NODE. If TOP is t, extend all the way
+ ;; to root. If TOP is a node, extend up as far as that node. If TOP is an
+ ;; integer, extend up as far as that line. Otherwise, only extend visible
+ ;; portion of tree. NODE is assumed to already have a node marker. Returns
+ ;; non-nil if anything was actually extended.
+ (let ((extended nil) parent)
+ ;; don't bother extending if TOP specifies an already-drawn node
+ (unless (and (undo-tree-node-p top) (undo-tree-node-marker top))
+ (while node
+ (setq parent (undo-tree-node-previous node))
+ ;; if we haven't reached root...
+ (if parent
+ ;; ...and node is within range being drawn...
+ (if (or (eq top t)
+ (and (undo-tree-node-p top) (not (eq node top)))
+ (and (integerp top)
+ (< top (line-number-at-pos
+ (undo-tree-node-marker node))))
+ (and (null top)
+ ;; NOTE: we check point in case window-start is outdated
+ (< (min (line-number-at-pos (point))
+ (line-number-at-pos (window-start)))
+ (line-number-at-pos
+ (undo-tree-node-marker node)))))
+ ;; ...and it hasn't already been drawn
+ (when (not (undo-tree-node-marker parent))
+ ;; link parent node to its representation in visualizer
+ (undo-tree-compute-widths parent)
+ (undo-tree-move-to-parent node)
+ (setf (undo-tree-node-marker parent) (make-marker))
+ (set-marker-insertion-type
+ (undo-tree-node-marker parent) nil)
+ (move-marker (undo-tree-node-marker parent) (point))
+ ;; draw subtree beneath parent
+ (setq undo-tree-visualizer-needs-extending-down
+ (nconc (delq node (undo-tree-draw-subtree parent))
+ undo-tree-visualizer-needs-extending-down))
+ (setq extended t))
+ ;; ...otherwise, postpone drawing for later and exit
+ (setq undo-tree-visualizer-needs-extending-up (when parent node)
+ parent nil))
+
+ ;; if we've reached root, stop extending and add top margin
+ (setq undo-tree-visualizer-needs-extending-up nil)
+ (goto-char (undo-tree-node-marker node))
+ (undo-tree-move-up 1) ; top margin
+ (delete-region (point-min) (line-beginning-position)))
+ ;; next iteration
+ (setq node parent)))
+ extended))
+
+
+(defun undo-tree-expand-down (from &optional to)
+ ;; Expand tree downwards. FROM is the node to start expanding from. Stop
+ ;; expanding at TO if specified. Otherwise, just expand visible portion of
+ ;; tree and highlight active branch from FROM.
+ (when undo-tree-visualizer-needs-extending-down
+ (let ((inhibit-read-only t)
+ node-list extended)
+ ;; extend down as far as TO node
+ (when to
+ (setq extended (undo-tree-extend-down from to))
+ (goto-char (undo-tree-node-marker to))
+ (redisplay t)) ; force redisplay to scroll buffer if necessary
+ ;; extend visible portion of tree downwards
+ (setq node-list undo-tree-visualizer-needs-extending-down
+ undo-tree-visualizer-needs-extending-down nil)
+ (when node-list
+ (dolist (n node-list)
+ (when (undo-tree-extend-down n) (setq extended t)))
+ ;; highlight active branch in newly-extended-down portion, if any
+ (when extended
+ (let ((undo-tree-insert-face
+ 'undo-tree-visualizer-active-branch-face))
+ (undo-tree-highlight-active-branch from)))))))
+
+
+(defun undo-tree-expand-up (from &optional to)
+ ;; Expand tree upwards. FROM is the node to start expanding from, TO is the
+ ;; node to stop expanding at. If TO node isn't specified, just expand visible
+ ;; portion of tree and highlight active branch down to FROM.
+ (when undo-tree-visualizer-needs-extending-up
+ (let ((inhibit-read-only t)
+ extended node-list)
+ ;; extend up as far as TO node
+ (when to
+ (setq extended (undo-tree-extend-up from to))
+ (goto-char (undo-tree-node-marker to))
+ ;; simulate auto-scrolling if close to top of buffer
+ (when (<= (line-number-at-pos (point)) scroll-margin)
+ (undo-tree-move-up (if (= scroll-conservatively 0)
+ (/ (window-height) 2) 3))
+ (when (undo-tree-extend-up to) (setq extended t))
+ (goto-char (undo-tree-node-marker to))
+ (unless (= scroll-conservatively 0) (recenter scroll-margin))))
+ ;; extend visible portion of tree upwards
+ (and undo-tree-visualizer-needs-extending-up
+ (undo-tree-extend-up undo-tree-visualizer-needs-extending-up)
+ (setq extended t))
+ ;; extend visible portion of tree downwards
+ (setq node-list undo-tree-visualizer-needs-extending-down
+ undo-tree-visualizer-needs-extending-down nil)
+ (dolist (n node-list) (undo-tree-extend-down n))
+ ;; highlight active branch in newly-extended-up portion, if any
+ (when extended
+ (let ((undo-tree-insert-face
+ 'undo-tree-visualizer-active-branch-face))
+ (undo-tree-highlight-active-branch
+ (or undo-tree-visualizer-needs-extending-up
+ (undo-tree-root buffer-undo-tree))
+ from))))))
+
+
+
+(defun undo-tree-highlight-active-branch (node &optional end)
+ ;; Draw highlighted active branch below NODE in current buffer. Stop
+ ;; highlighting at END node if specified.
+ (let ((stack (list node)))
;; draw active branch
(while stack
(setq node (pop stack))
- (goto-char (undo-tree-node-marker node))
- (setq node (undo-tree-draw-subtree node 'active))
- (setq stack (append stack node)))))
+ (unless (or (eq node end)
+ (memq node undo-tree-visualizer-needs-extending-down))
+ (goto-char (undo-tree-node-marker node))
+ (setq node (undo-tree-draw-subtree node 'active)
+ stack (nconc stack node))))))
(defun undo-tree-draw-node (node &optional current)
- ;; Draw symbol representing NODE in visualizer.
+ ;; Draw symbol representing NODE in visualizer. If CURRENT is non-nil, node
+ ;; is current node.
(goto-char (undo-tree-node-marker node))
- (when undo-tree-visualizer-timestamps (backward-char 5))
-
- (let ((register (undo-tree-node-register node))
+ (when undo-tree-visualizer-timestamps
+ (undo-tree-move-backward (/ undo-tree-visualizer-spacing 2)))
+
+ (let* ((undo-tree-insert-face (and undo-tree-insert-face
+ (or (and (consp undo-tree-insert-face)
+ undo-tree-insert-face)
+ (list undo-tree-insert-face))))
+ (register (undo-tree-node-register node))
+ (unmodified (if undo-tree-visualizer-parent-mtime
+ (undo-tree-node-unmodified-p
+ node undo-tree-visualizer-parent-mtime)
+ (undo-tree-node-unmodified-p node)))
node-string)
- (unless (and register (eq node (get-register register)))
+ ;; check node's register (if any) still stores appropriate undo-tree state
+ (unless (and register
+ (undo-tree-register-data-p
+ (registerv-data (get-register register)))
+ (eq node (undo-tree-register-data-node
+ (registerv-data (get-register register)))))
(setq register nil))
- ;; represent node by differentl symbols, depending on whether it's the
- ;; current node or is saved in a register
+ ;; represent node by different symbols, depending on whether it's the
+ ;; current node, is saved in a register, or corresponds to an unmodified
+ ;; buffer
(setq node-string
- (cond
- (undo-tree-visualizer-timestamps
- (undo-tree-timestamp-to-string (undo-tree-node-timestamp node)))
- (current "x")
- (register (char-to-string register))
- (t "o")))
- (when undo-tree-visualizer-timestamps
- (setq node-string
- (concat (if current "*" " ") node-string
- (if register (concat "(" (char-to-string register) ")")
- " "))))
-
- (cond
- (current
- (let ((undo-tree-insert-face
- (cons 'undo-tree-visualizer-current-face
- (and (boundp 'undo-tree-insert-face)
- (or (and (consp undo-tree-insert-face)
- undo-tree-insert-face)
- (list undo-tree-insert-face))))))
- (undo-tree-insert node-string)))
- (register
- (let ((undo-tree-insert-face
- (cons 'undo-tree-visualizer-register-face
- (and (boundp 'undo-tree-insert-face)
- (or (and (consp undo-tree-insert-face)
- undo-tree-insert-face)
- (list undo-tree-insert-face))))))
- (undo-tree-insert node-string)))
- (t (undo-tree-insert node-string)))
-
- (backward-char (if undo-tree-visualizer-timestamps 7 1))
+ (cond
+ (undo-tree-visualizer-timestamps
+ (undo-tree-timestamp-to-string
+ (undo-tree-node-timestamp node)
+ undo-tree-visualizer-relative-timestamps
+ current register))
+ (register (char-to-string register))
+ (unmodified "s")
+ (current "x")
+ (t "o"))
+ undo-tree-insert-face
+ (nconc
+ (cond
+ (current '(undo-tree-visualizer-current-face))
+ (unmodified '(undo-tree-visualizer-unmodified-face))
+ (register '(undo-tree-visualizer-register-face)))
+ undo-tree-insert-face))
+ ;; draw node and link it to its representation in visualizer
+ (undo-tree-insert node-string)
+ (undo-tree-move-backward (if undo-tree-visualizer-timestamps
+ (1+ (/ undo-tree-visualizer-spacing 2))
+ 1))
(move-marker (undo-tree-node-marker node) (point))
- (put-text-property (- (point) (if undo-tree-visualizer-timestamps 3 0))
- (+ (point) (if undo-tree-visualizer-timestamps 5 1))
- 'undo-tree-node node)))
+ (put-text-property (point) (1+ (point)) 'undo-tree-node node)))
(defun undo-tree-draw-subtree (node &optional active-branch)
;; Draw subtree rooted at NODE. The subtree will start from point.
- ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE.
- ;; If TIMESTAP is non-nil, draw time-stamps instead of "o" at nodes.
+ ;; If ACTIVE-BRANCH is non-nil, just draw active branch below NODE. Returns
+ ;; list of nodes below NODE.
(let ((num-children (length (undo-tree-node-next node)))
node-list pos trunk-pos n)
;; draw node itself
((= num-children 1)
(undo-tree-move-down 1)
(undo-tree-insert ?|)
- (backward-char 1)
+ (undo-tree-move-backward 1)
(undo-tree-move-down 1)
(undo-tree-insert ?|)
- (backward-char 1)
+ (undo-tree-move-backward 1)
(undo-tree-move-down 1)
(setq n (car (undo-tree-node-next node)))
;; link next node to its representation in visualizer
;; add next node to list of nodes to draw next
(push n node-list))
- ;; if node had multiple children, draw branches
+ ;; if node has multiple children, draw branches
(t
(undo-tree-move-down 1)
(undo-tree-insert ?|)
- (backward-char 1)
- (setq trunk-pos (point))
+ (undo-tree-move-backward 1)
+ (move-marker (setq trunk-pos (make-marker)) (point))
;; left subtrees
- (backward-char
+ (undo-tree-move-backward
(- (undo-tree-node-char-lwidth node)
(undo-tree-node-char-lwidth
(car (undo-tree-node-next node)))))
- (setq pos (point))
+ (move-marker (setq pos (make-marker)) (point))
(setq n (cons nil (undo-tree-node-next node)))
(dotimes (i (/ num-children 2))
(setq n (cdr n))
(undo-tree-move-forward 1)
(undo-tree-move-down 1)
(undo-tree-insert ?/)
- (backward-char 2)
+ (undo-tree-move-backward 2)
(undo-tree-move-down 1)
;; link node to its representation in visualizer
(unless (markerp (undo-tree-node-marker (car n)))
(+ (undo-tree-node-char-rwidth (car n))
(undo-tree-node-char-lwidth (cadr n))
undo-tree-visualizer-spacing 1))
- (setq pos (point)))
+ (move-marker pos (point)))
;; middle subtree (only when number of children is odd)
(when (= (mod num-children 2) 1)
(setq n (cdr n))
(undo-tree-node-next node))))
(undo-tree-move-down 1)
(undo-tree-insert ?|)
- (backward-char 1)
+ (undo-tree-move-backward 1)
(undo-tree-move-down 1)
;; link node to its representation in visualizer
(unless (markerp (undo-tree-node-marker (car n)))
(+ (undo-tree-node-char-rwidth (car n))
(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
undo-tree-visualizer-spacing 1))
- (setq pos (point)))
+ (move-marker pos (point)))
;; right subtrees
- (incf trunk-pos)
+ (move-marker trunk-pos (1+ trunk-pos))
(dotimes (i (/ num-children 2))
(setq n (cdr n))
(when (or (null active-branch)
(goto-char trunk-pos)
(undo-tree-insert ?_ (- pos trunk-pos 1))
(goto-char pos)
- (backward-char 1)
+ (undo-tree-move-backward 1)
(undo-tree-move-down 1)
(undo-tree-insert ?\\)
(undo-tree-move-down 1)
(+ (undo-tree-node-char-rwidth (car n))
(if (cadr n) (undo-tree-node-char-lwidth (cadr n)) 0)
undo-tree-visualizer-spacing 1))
- (setq pos (point))))
+ (move-marker pos (point))))
))
;; return list of nodes to draw next
(nreverse node-list)))
-
(defun undo-tree-node-char-lwidth (node)
;; Return left-width of NODE measured in characters.
(if (= (length (undo-tree-node-next node)) 0) 0
;; delete region instead of single char if transient-mark-mode is enabled
(setq mark-active nil)
(backward-delete-char arg)
- (when (boundp 'undo-tree-insert-face)
+ (when undo-tree-insert-face
(put-text-property (- (point) arg) (point) 'face undo-tree-insert-face)))
(setq line (line-number-at-pos))
;; if buffer doesn't have enough lines, add some
(when (/= line (+ row arg))
- (insert (make-string (- arg (- line row)) ?\n)))
+ (cond
+ ((< arg 0)
+ (insert (make-string (- line row arg) ?\n))
+ (forward-line (+ arg (- row line))))
+ (t (insert (make-string (- arg (- line row)) ?\n)))))
(undo-tree-move-forward col)))
-(defun undo-tree-move-forward (&optional arg)
- ;; Move forward, extending buffer if necessary.
+(defun undo-tree-move-up (&optional arg)
+ ;; Move up, extending buffer if necessary.
(unless arg (setq arg 1))
- (let ((n (- (line-end-position) (point))))
- (if (> n arg)
- (forward-char arg)
- (end-of-line)
- (insert (make-string (- arg n) ? )))))
-
-
-(defun undo-tree-timestamp-to-string (timestamp)
- ;; Convert TIMESTAMP to hh:mm:ss string.
- (let ((time (decode-time timestamp)))
- (format "%02d:%02d:%02d" (nth 2 time) (nth 1 time) (nth 0 time))))
+ (undo-tree-move-down (- arg)))
+(defun undo-tree-move-forward (&optional arg)
+ ;; Move forward, extending buffer if necessary.
+ (unless arg (setq arg 1))
+ (let (n)
+ (cond
+ ((>= arg 0)
+ (setq n (- (line-end-position) (point)))
+ (if (> n arg)
+ (forward-char arg)
+ (end-of-line)
+ (insert (make-string (- arg n) ? ))))
+ ((< arg 0)
+ (setq arg (- arg))
+ (setq n (- (point) (line-beginning-position)))
+ (when (< (- n 2) arg) ; -2 to create left-margin
+ ;; no space left - shift entire buffer contents right!
+ (let ((pos (move-marker (make-marker) (point))))
+ (set-marker-insertion-type pos t)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert-before-markers (make-string (- arg -2 n) ? ))
+ (forward-line 1))
+ (goto-char pos)))
+ (backward-char arg)))))
+
+
+(defun undo-tree-move-backward (&optional arg)
+ ;; Move backward, extending buffer if necessary.
+ (unless arg (setq arg 1))
+ (undo-tree-move-forward (- arg)))
+(defun undo-tree-move-to-parent (node)
+ ;; Move to position of parent of NODE, extending buffer if necessary.
+ (let* ((parent (undo-tree-node-previous node))
+ (n (undo-tree-node-next parent))
+ (l (length n)) p)
+ (goto-char (undo-tree-node-marker node))
+ (unless (= l 1)
+ ;; move horizontally
+ (setq p (undo-tree-position node n))
+ (cond
+ ;; node in centre subtree: no horizontal movement
+ ((and (= (mod l 2) 1) (= p (/ l 2))))
+ ;; node in left subtree: move right
+ ((< p (/ l 2))
+ (setq n (nthcdr p n))
+ (undo-tree-move-forward
+ (+ (undo-tree-node-char-rwidth (car n))
+ (/ undo-tree-visualizer-spacing 2) 1))
+ (dotimes (i (- (/ l 2) p 1))
+ (setq n (cdr n))
+ (undo-tree-move-forward
+ (+ (undo-tree-node-char-lwidth (car n))
+ (undo-tree-node-char-rwidth (car n))
+ undo-tree-visualizer-spacing 1)))
+ (when (= (mod l 2) 1)
+ (setq n (cdr n))
+ (undo-tree-move-forward
+ (+ (undo-tree-node-char-lwidth (car n))
+ (/ undo-tree-visualizer-spacing 2) 1))))
+ (t ;; node in right subtree: move left
+ (setq n (nthcdr (/ l 2) n))
+ (when (= (mod l 2) 1)
+ (undo-tree-move-backward
+ (+ (undo-tree-node-char-rwidth (car n))
+ (/ undo-tree-visualizer-spacing 2) 1))
+ (setq n (cdr n)))
+ (dotimes (i (- p (/ l 2) (mod l 2)))
+ (undo-tree-move-backward
+ (+ (undo-tree-node-char-lwidth (car n))
+ (undo-tree-node-char-rwidth (car n))
+ undo-tree-visualizer-spacing 1))
+ (setq n (cdr n)))
+ (undo-tree-move-backward
+ (+ (undo-tree-node-char-lwidth (car n))
+ (/ undo-tree-visualizer-spacing 2) 1)))))
+ ;; move vertically
+ (undo-tree-move-up 3)))
+
+
+(defun undo-tree-timestamp-to-string
+ (timestamp &optional relative current register)
+ ;; Convert TIMESTAMP to string (either absolute or RELATVE time), indicating
+ ;; if it's the CURRENT node and/or has an associated REGISTER.
+ (if relative
+ ;; relative time
+ (let ((time (floor (float-time
+ (subtract-time (current-time) timestamp))))
+ n)
+ (setq time
+ ;; years
+ (if (> (setq n (/ time 315360000)) 0)
+ (if (> n 999) "-ages" (format "-%dy" n))
+ (setq time (% time 315360000))
+ ;; days
+ (if (> (setq n (/ time 86400)) 0)
+ (format "-%dd" n)
+ (setq time (% time 86400))
+ ;; hours
+ (if (> (setq n (/ time 3600)) 0)
+ (format "-%dh" n)
+ (setq time (% time 3600))
+ ;; mins
+ (if (> (setq n (/ time 60)) 0)
+ (format "-%dm" n)
+ ;; secs
+ (format "-%ds" (% time 60)))))))
+ (setq time (concat
+ (if current "*" " ")
+ time
+ (if register (concat "[" (char-to-string register) "]")
+ " ")))
+ (setq n (length time))
+ (if (< n 9)
+ (concat (make-string (- 9 n) ? ) time)
+ time))
+ ;; absolute time
+ (concat (if current " *" " ")
+ (format-time-string "%H:%M:%S" timestamp)
+ (if register
+ (concat "[" (char-to-string register) "]")
+ " "))))
+
+
+
+\f
;;; =====================================================================
-;;; Visualizer mode commands
+;;; Visualizer commands
-(defun undo-tree-visualizer-mode ()
+(define-derived-mode
+ undo-tree-visualizer-mode special-mode "undo-tree-visualizer"
"Major mode used in undo-tree visualizer.
The undo-tree visualizer can only be invoked from a buffer in
Within the undo-tree visualizer, the following keys are available:
- \\{undo-tree-visualizer-map}"
- (interactive)
- (setq major-mode 'undo-tree-visualizer-mode)
- (setq mode-name "undo-tree-visualizer-mode")
- (use-local-map undo-tree-visualizer-map)
+ \\{undo-tree-visualizer-mode-map}"
+ :syntax-table nil
+ :abbrev-table nil
(setq truncate-lines t)
(setq cursor-type nil)
- (setq buffer-read-only t))
+ (setq undo-tree-visualizer-selected-node nil))
(defun undo-tree-visualize-undo (&optional arg)
"Undo changes. A numeric ARG serves as a repeat count."
(interactive "p")
- (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
- (inhibit-read-only t))
- (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
- (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
- (deactivate-mark)
- (unwind-protect
- (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo arg))
- (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
- (let ((inhibit-read-only t))
- (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
+ (let ((old (undo-tree-current buffer-undo-tree))
+ current)
+ ;; unhighlight old current node
+ (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
+ (inhibit-read-only t))
+ (undo-tree-draw-node old))
+ ;; undo in parent buffer
+ (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
+ (deactivate-mark)
+ (unwind-protect
+ (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-undo-1 arg))
+ (setq current (undo-tree-current buffer-undo-tree))
+ (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
+ ;; when using lazy drawing, extend tree upwards as required
+ (when undo-tree-visualizer-lazy-drawing
+ (undo-tree-expand-up old current))
+ ;; highlight new current node
+ (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
+ ;; update diff display, if any
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
(defun undo-tree-visualize-redo (&optional arg)
"Redo changes. A numeric ARG serves as a repeat count."
(interactive "p")
- (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
- (inhibit-read-only t))
- (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
- (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
- (deactivate-mark)
- (unwind-protect
- (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo arg))
- (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
- (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
- (let ((inhibit-read-only t))
- (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current))))
+ (let ((old (undo-tree-current buffer-undo-tree))
+ current)
+ ;; unhighlight old current node
+ (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)
+ (inhibit-read-only t))
+ (undo-tree-draw-node (undo-tree-current buffer-undo-tree)))
+ ;; redo in parent buffer
+ (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
+ (deactivate-mark)
+ (unwind-protect
+ (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-redo-1 arg))
+ (setq current (undo-tree-current buffer-undo-tree))
+ (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
+ ;; when using lazy drawing, extend tree downwards as required
+ (when undo-tree-visualizer-lazy-drawing
+ (undo-tree-expand-down old current))
+ ;; highlight new current node
+ (let ((inhibit-read-only t)) (undo-tree-draw-node current 'current))
+ ;; update diff display, if any
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
(defun undo-tree-visualize-switch-branch-right (arg)
(unwind-protect
(with-current-buffer undo-tree-visualizer-parent-buffer
(remove-hook 'before-change-functions 'undo-tree-kill-visualizer t))
+ ;; kill diff buffer, if any
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-hide-diff))
(let ((parent undo-tree-visualizer-parent-buffer)
window)
+ ;; kill visualizer buffer
(kill-buffer nil)
- (if (setq window (get-buffer-window parent))
- (select-window window)
- (switch-to-buffer parent)))))
+ ;; switch back to parent buffer
+ (unwind-protect
+ (if (setq window (get-buffer-window parent))
+ (select-window window)
+ (switch-to-buffer parent))))))
+
+
+(defun undo-tree-visualizer-abort ()
+ "Quit the undo-tree visualizer and return buffer to original state."
+ (interactive)
+ (let ((node undo-tree-visualizer-initial-node))
+ (undo-tree-visualizer-quit)
+ (undo-tree-set node)))
(defun undo-tree-visualizer-set (&optional pos)
(let ((node (get-text-property pos 'undo-tree-node)))
(when node
;; set parent buffer to state corresponding to node at POS
- (set-buffer undo-tree-visualizer-parent-buffer)
+ (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer)
(let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node))
- (set-buffer undo-tree-visualizer-buffer-name)
+ (switch-to-buffer-other-window undo-tree-visualizer-buffer-name)
;; re-draw undo tree
- (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))))
+ (let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree))
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))))
(defun undo-tree-visualizer-mouse-set (pos)
(undo-tree-visualizer-set (event-start (nth 1 pos))))
+(defun undo-tree-visualize-undo-to-x (&optional x)
+ "Undo to last branch point, register, or saved state.
+If X is the symbol `branch', undo to last branch point. If X is
+the symbol `register', undo to last register. If X is the sumbol
+`saved', undo to last saved state. If X is null, undo to first of
+these that's encountered.
+
+Interactively, a single \\[universal-argument] specifies
+`branch', a double \\[universal-argument] \\[universal-argument]
+specifies `saved', and a negative prefix argument specifies
+`register'."
+ (interactive "P")
+ (when (and (called-interactively-p 'any) x)
+ (setq x (prefix-numeric-value x)
+ x (cond
+ ((< x 0) 'register)
+ ((<= x 4) 'branch)
+ (t 'saved))))
+ (let ((current (if undo-tree-visualizer-selection-mode
+ undo-tree-visualizer-selected-node
+ (undo-tree-current buffer-undo-tree)))
+ (diff undo-tree-visualizer-diff)
+ r)
+ (undo-tree-visualizer-hide-diff)
+ (while (and (undo-tree-node-previous current)
+ (or (if undo-tree-visualizer-selection-mode
+ (progn
+ (undo-tree-visualizer-select-previous)
+ (setq current undo-tree-visualizer-selected-node))
+ (undo-tree-visualize-undo)
+ (setq current (undo-tree-current buffer-undo-tree)))
+ t)
+ ;; branch point
+ (not (or (and (or (null x) (eq x 'branch))
+ (> (undo-tree-num-branches) 1))
+ ;; register
+ (and (or (null x) (eq x 'register))
+ (setq r (undo-tree-node-register current))
+ (undo-tree-register-data-p
+ (setq r (registerv-data (get-register r))))
+ (eq current (undo-tree-register-data-node r)))
+ ;; saved state
+ (and (or (null x) (eq x 'saved))
+ (undo-tree-node-unmodified-p current))
+ ))))
+ ;; update diff display, if any
+ (when diff
+ (undo-tree-visualizer-show-diff
+ (when undo-tree-visualizer-selection-mode
+ undo-tree-visualizer-selected-node)))))
+
+
+(defun undo-tree-visualize-redo-to-x (&optional x)
+ "Redo to last branch point, register, or saved state.
+If X is the symbol `branch', redo to last branch point. If X is
+the symbol `register', redo to last register. If X is the sumbol
+`saved', redo to last saved state. If X is null, redo to first of
+these that's encountered.
+
+Interactively, a single \\[universal-argument] specifies
+`branch', a double \\[universal-argument] \\[universal-argument]
+specifies `saved', and a negative prefix argument specifies
+`register'."
+ (interactive "P")
+ (when (and (called-interactively-p 'any) x)
+ (setq x (prefix-numeric-value x)
+ x (cond
+ ((< x 0) 'register)
+ ((<= x 4) 'branch)
+ (t 'saved))))
+ (let ((current (if undo-tree-visualizer-selection-mode
+ undo-tree-visualizer-selected-node
+ (undo-tree-current buffer-undo-tree)))
+ (diff undo-tree-visualizer-diff)
+ r)
+ (undo-tree-visualizer-hide-diff)
+ (while (and (undo-tree-node-next current)
+ (or (if undo-tree-visualizer-selection-mode
+ (progn
+ (undo-tree-visualizer-select-next)
+ (setq current undo-tree-visualizer-selected-node))
+ (undo-tree-visualize-redo)
+ (setq current (undo-tree-current buffer-undo-tree)))
+ t)
+ ;; branch point
+ (not (or (and (or (null x) (eq x 'branch))
+ (> (undo-tree-num-branches) 1))
+ ;; register
+ (and (or (null x) (eq x 'register))
+ (setq r (undo-tree-node-register current))
+ (undo-tree-register-data-p
+ (setq r (registerv-data (get-register r))))
+ (eq current (undo-tree-register-data-node r)))
+ ;; saved state
+ (and (or (null x) (eq x 'saved))
+ (undo-tree-node-unmodified-p current))
+ ))))
+ ;; update diff display, if any
+ (when diff
+ (undo-tree-visualizer-show-diff
+ (when undo-tree-visualizer-selection-mode
+ undo-tree-visualizer-selected-node)))))
+
+
(defun undo-tree-visualizer-toggle-timestamps ()
"Toggle display of time-stamps."
(interactive)
- (setq undo-tree-visualizer-spacing
- (if (setq undo-tree-visualizer-timestamps
- (not undo-tree-visualizer-timestamps))
- ;; need sufficient space if displaying timestamps
- (max 13 (default-value 'undo-tree-visualizer-spacing))
- (default-value 'undo-tree-visualizer-spacing)))
+ (setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
+ (setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
;; redraw tree
(let ((inhibit-read-only t)) (undo-tree-draw-tree buffer-undo-tree)))
(defun undo-tree-visualizer-scroll-left (&optional arg)
(interactive "p")
- (scroll-right (or arg 1) t))
+ (scroll-left (or arg 1) t))
(defun undo-tree-visualizer-scroll-right (&optional arg)
(interactive "p")
- (scroll-left (or arg 1) t))
+ (scroll-right (or arg 1) t))
+
+(defun undo-tree-visualizer-scroll-up (&optional arg)
+ (interactive "P")
+ (if (or (and (numberp arg) (< arg 0)) (eq arg '-))
+ (undo-tree-visualizer-scroll-down arg)
+ ;; scroll up and expand newly-visible portion of tree
+ (unwind-protect
+ (scroll-up-command arg)
+ (undo-tree-expand-down
+ (nth (undo-tree-node-branch (undo-tree-current buffer-undo-tree))
+ (undo-tree-node-next (undo-tree-current buffer-undo-tree)))))
+ ;; signal error if at eob
+ (when (and (not undo-tree-visualizer-needs-extending-down) (eobp))
+ (scroll-up))))
+
+
+(defun undo-tree-visualizer-scroll-down (&optional arg)
+ (interactive "P")
+ (if (or (and (numberp arg) (< arg 0)) (eq arg '-))
+ (undo-tree-visualizer-scroll-up arg)
+ ;; ensure there's enough room at top of buffer to scroll
+ (let ((scroll-lines
+ (or arg (- (window-height) next-screen-context-lines)))
+ (window-line (1- (line-number-at-pos (window-start)))))
+ (when (and undo-tree-visualizer-needs-extending-up
+ (< window-line scroll-lines))
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (undo-tree-move-up (- scroll-lines window-line)))))
+ ;; scroll down and expand newly-visible portion of tree
+ (unwind-protect
+ (scroll-down-command arg)
+ (undo-tree-expand-up
+ (undo-tree-node-previous (undo-tree-current buffer-undo-tree))))
+ ;; signal error if at bob
+ (when (and (not undo-tree-visualizer-needs-extending-down) (bobp))
+ (scroll-down))))
+\f
;;; =====================================================================
;;; Visualizer selection mode
-(defun undo-tree-visualizer-selection-mode ()
- "Major mode used to select nodes in undo-tree visualizer."
- (interactive)
- (setq major-mode 'undo-tree-visualizer-selection-mode)
- (setq mode-name "undo-tree-visualizer-selection-mode")
- (use-local-map undo-tree-visualizer-selection-map)
- (setq cursor-type 'box))
+(define-minor-mode undo-tree-visualizer-selection-mode
+ "Toggle mode to select nodes in undo-tree visualizer."
+ :lighter "Select"
+ :keymap undo-tree-visualizer-selection-mode-map
+ :group undo-tree
+ (cond
+ ;; enable selection mode
+ (undo-tree-visualizer-selection-mode
+ (setq cursor-type 'box)
+ (setq undo-tree-visualizer-selected-node
+ (undo-tree-current buffer-undo-tree))
+ ;; erase diff (if any), as initially selected node is identical to current
+ (when undo-tree-visualizer-diff
+ (let ((buff (get-buffer undo-tree-diff-buffer-name))
+ (inhibit-read-only t))
+ (when buff (with-current-buffer buff (erase-buffer))))))
+ (t ;; disable selection mode
+ (setq cursor-type nil)
+ (setq undo-tree-visualizer-selected-node nil)
+ (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree)))
+ (when undo-tree-visualizer-diff (undo-tree-visualizer-update-diff)))
+ ))
(defun undo-tree-visualizer-select-previous (&optional arg)
"Move to previous node."
(interactive "p")
- (let ((node (get-text-property (point) 'undo-tree-node)))
+ (let ((node undo-tree-visualizer-selected-node))
(catch 'top
- (dotimes (i arg)
+ (dotimes (i (or arg 1))
(unless (undo-tree-node-previous node) (throw 'top t))
(setq node (undo-tree-node-previous node))))
- (goto-char (undo-tree-node-marker node))))
+ ;; when using lazy drawing, extend tree upwards as required
+ (when undo-tree-visualizer-lazy-drawing
+ (undo-tree-expand-up undo-tree-visualizer-selected-node node))
+ ;; update diff display, if any
+ (when (and undo-tree-visualizer-diff
+ (not (eq node undo-tree-visualizer-selected-node)))
+ (undo-tree-visualizer-update-diff node))
+ ;; move to selected node
+ (goto-char (undo-tree-node-marker node))
+ (setq undo-tree-visualizer-selected-node node)))
(defun undo-tree-visualizer-select-next (&optional arg)
"Move to next node."
(interactive "p")
- (let ((node (get-text-property (point) 'undo-tree-node)))
+ (let ((node undo-tree-visualizer-selected-node))
(catch 'bottom
- (dotimes (i arg)
+ (dotimes (i (or arg 1))
(unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
(throw 'bottom t))
(setq node
(nth (undo-tree-node-branch node) (undo-tree-node-next node)))))
- (goto-char (undo-tree-node-marker node))))
+ ;; when using lazy drawing, extend tree downwards as required
+ (when undo-tree-visualizer-lazy-drawing
+ (undo-tree-expand-down undo-tree-visualizer-selected-node node))
+ ;; update diff display, if any
+ (when (and undo-tree-visualizer-diff
+ (not (eq node undo-tree-visualizer-selected-node)))
+ (undo-tree-visualizer-update-diff node))
+ ;; move to selected node
+ (goto-char (undo-tree-node-marker node))
+ (setq undo-tree-visualizer-selected-node node)))
(defun undo-tree-visualizer-select-right (&optional arg)
"Move right to a sibling node."
(interactive "p")
- (let ((pos (point))
- (end (line-end-position))
- node)
+ (let ((node undo-tree-visualizer-selected-node)
+ end)
+ (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
+ (setq end (line-end-position))
(catch 'end
(dotimes (i arg)
- (while (not node)
+ (while (or (null node) (eq node undo-tree-visualizer-selected-node))
(forward-char)
(setq node (get-text-property (point) 'undo-tree-node))
(when (= (point) end) (throw 'end t)))))
- (goto-char (if node (undo-tree-node-marker node) pos))))
+ (goto-char (undo-tree-node-marker
+ (or node undo-tree-visualizer-selected-node)))
+ (when (and undo-tree-visualizer-diff node
+ (not (eq node undo-tree-visualizer-selected-node)))
+ (undo-tree-visualizer-update-diff node))
+ (when node (setq undo-tree-visualizer-selected-node node))))
(defun undo-tree-visualizer-select-left (&optional arg)
"Move left to a sibling node."
(interactive "p")
- (let ((pos (point))
- (beg (line-beginning-position))
- node)
+ (let ((node (get-text-property (point) 'undo-tree-node))
+ beg)
+ (goto-char (undo-tree-node-marker undo-tree-visualizer-selected-node))
+ (setq beg (line-beginning-position))
(catch 'beg
(dotimes (i arg)
- (while (not node)
+ (while (or (null node) (eq node undo-tree-visualizer-selected-node))
(backward-char)
(setq node (get-text-property (point) 'undo-tree-node))
(when (= (point) beg) (throw 'beg t)))))
- (goto-char (if node (undo-tree-node-marker node) pos))))
+ (goto-char (undo-tree-node-marker
+ (or node undo-tree-visualizer-selected-node)))
+ (when (and undo-tree-visualizer-diff node
+ (not (eq node undo-tree-visualizer-selected-node)))
+ (undo-tree-visualizer-update-diff node))
+ (when node (setq undo-tree-visualizer-selected-node node))))
+
+
+(defun undo-tree-visualizer-select (pos)
+ (let ((node (get-text-property pos 'undo-tree-node)))
+ (when node
+ ;; select node at POS
+ (goto-char (undo-tree-node-marker node))
+ ;; when using lazy drawing, extend tree up and down as required
+ (when undo-tree-visualizer-lazy-drawing
+ (undo-tree-expand-up undo-tree-visualizer-selected-node node)
+ (undo-tree-expand-down undo-tree-visualizer-selected-node node))
+ ;; update diff display, if any
+ (when (and undo-tree-visualizer-diff
+ (not (eq node undo-tree-visualizer-selected-node)))
+ (undo-tree-visualizer-update-diff node))
+ ;; update selected node
+ (setq undo-tree-visualizer-selected-node node)
+ )))
+
+
+(defun undo-tree-visualizer-mouse-select (pos)
+ "Select undo tree node at mouse event POS."
+ (interactive "@e")
+ (undo-tree-visualizer-select (event-start (nth 1 pos))))
+
+
+
+\f
+;;; =====================================================================
+;;; Visualizer diff display
+
+(defun undo-tree-visualizer-toggle-diff ()
+ "Toggle diff display in undo-tree visualizer."
+ (interactive)
+ (if undo-tree-visualizer-diff
+ (undo-tree-visualizer-hide-diff)
+ (undo-tree-visualizer-show-diff)))
+
+
+(defun undo-tree-visualizer-selection-toggle-diff ()
+ "Toggle diff display in undo-tree visualizer selection mode."
+ (interactive)
+ (if undo-tree-visualizer-diff
+ (undo-tree-visualizer-hide-diff)
+ (let ((node (get-text-property (point) 'undo-tree-node)))
+ (when node (undo-tree-visualizer-show-diff node)))))
+
+
+(defun undo-tree-visualizer-show-diff (&optional node)
+ ;; show visualizer diff display
+ (setq undo-tree-visualizer-diff t)
+ (let ((buff (with-current-buffer undo-tree-visualizer-parent-buffer
+ (undo-tree-diff node)))
+ (display-buffer-mark-dedicated 'soft)
+ win)
+ (setq win (split-window))
+ (set-window-buffer win buff)
+ (shrink-window-if-larger-than-buffer win)))
+
+
+(defun undo-tree-visualizer-hide-diff ()
+ ;; hide visualizer diff display
+ (setq undo-tree-visualizer-diff nil)
+ (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
+ (when win (with-selected-window win (kill-buffer-and-window)))))
+
+
+(defun undo-tree-diff (&optional node)
+ ;; Create diff between NODE and current state (or previous state and current
+ ;; state, if NODE is null). Returns buffer containing diff.
+ (let (tmpfile buff)
+ ;; generate diff
+ (let ((undo-tree-inhibit-kill-visualizer t)
+ (current (undo-tree-current buffer-undo-tree)))
+ (undo-tree-set (or node (undo-tree-node-previous current) current)
+ 'preserve-timestamps)
+ (setq tmpfile (diff-file-local-copy (current-buffer)))
+ (undo-tree-set current 'preserve-timestamps))
+ (setq buff (diff-no-select
+ tmpfile (current-buffer) nil 'noasync
+ (get-buffer-create undo-tree-diff-buffer-name)))
+ ;; delete process messages and useless headers from diff buffer
+ (let ((inhibit-read-only t))
+ (with-current-buffer buff
+ (goto-char (point-min))
+ (delete-region (point) (1+ (line-end-position 3)))
+ (goto-char (point-max))
+ (forward-line -2)
+ (delete-region (point) (point-max))
+ (setq cursor-type nil)
+ (setq buffer-read-only t)))
+ buff))
+
+
+(defun undo-tree-visualizer-update-diff (&optional node)
+ ;; update visualizer diff display to show diff between current state and
+ ;; NODE (or previous state, if NODE is null)
+ (with-current-buffer undo-tree-visualizer-parent-buffer
+ (undo-tree-diff node))
+ (let ((win (get-buffer-window undo-tree-diff-buffer-name)))
+ (when win
+ (balance-windows)
+ (shrink-window-if-larger-than-buffer win))))