X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/2d4ec5d2062d274c201cef8438fb5a66494338fa..37fc4433fb7e0f99a0ff74ddb23075127b7e4656:/packages/undo-tree/undo-tree.el diff --git a/packages/undo-tree/undo-tree.el b/packages/undo-tree/undo-tree.el index c870a2548..cb8a230b4 100644 --- a/packages/undo-tree/undo-tree.el +++ b/packages/undo-tree/undo-tree.el @@ -1,27 +1,27 @@ -;;; undo-tree.el --- Treat undo history as a tree +;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2011 Free Software Foundation, Inc +;; Copyright (C) 2009-2013 Free Software Foundation, Inc ;; Author: Toby Cubitt -;; Version: 0.3.1 +;; Version: 0.6.5 ;; Keywords: convenience, files, undo, redo, history, tree ;; URL: http://www.dr-qubit.org/emacs.php -;; Git Repository: http://www.dr-qubit.org/git/undo-tree.git +;; Repository: http://www.dr-qubit.org/git/undo-tree.git ;; This file is part of Emacs. ;; -;; Emacs is free software: you can redistribute it and/or modify it under +;; This file is free software: you can redistribute it and/or modify it under ;; the terms of the GNU General Public License as published by the Free ;; Software Foundation, either version 3 of the License, or (at your option) ;; any later version. ;; -;; Emacs is distributed in the hope that it will be useful, but WITHOUT +;; This program is distributed in the hope that it will be useful, but WITHOUT ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for ;; more details. ;; ;; You should have received a copy of the GNU General Public License along -;; with GNU Emacs. If not, see . +;; with GNU Emacs. If not, see . ;;; Commentary: @@ -51,8 +51,9 @@ ;; 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: @@ -74,10 +75,10 @@ ;; Quick-Start ;; =========== ;; -;; If you're the kind of person who likes jump in the car and drive, without -;; bothering to first figure out whether the button on the left dips the -;; headlights or operates the ejector seat (after all, you'll soon figure it -;; out when you push it), then here's the minimum you need to know: +;; If you're the kind of person who likes to jump in the car and drive, +;; without bothering to first figure out whether the button on the left dips +;; the headlights or operates the ejector seat (after all, you'll soon figure +;; it out when you push it), then here's the minimum you need to know: ;; ;; `undo-tree-mode' and `global-undo-tree-mode' ;; Enable undo-tree mode (either in the current buffer or globally). @@ -103,6 +104,7 @@ ;; Restore buffer state from register. ;; ;; +;; ;; In the undo-tree visualizer: ;; ;; p C-p (`undo-tree-visualize-undo') @@ -117,26 +119,125 @@ ;; f C-f (`undo-tree-visualize-switch-branch-right') ;; Switch to next undo-tree branch. ;; +;; C- M-{ (`undo-tree-visualize-undo-to-x') +;; Undo changes up to last branch point. +;; +;; C- M-} (`undo-tree-visualize-redo-to-x') +;; Redo changes down to next branch point. +;; +;; n C-n (`undo-tree-visualize-redo') +;; Redo changes. +;; +;; (`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. ;; ;; . > ;; Scroll right. ;; -;; +;; M-v ;; Scroll up. ;; -;; +;; C-v ;; Scroll down. ;; ;; ;; +;; In visualizer selection mode: +;; +;; p C-p (`undo-tree-visualizer-select-previous') +;; Select previous node. +;; +;; n C-n (`undo-tree-visualizer-select-next') +;; Select next node. +;; +;; b C-b (`undo-tree-visualizer-select-left') +;; Select left sibling node. +;; +;; f C-f (`undo-tree-visualizer-select-right') +;; Select right sibling node. +;; +;; M-v +;; Select node 10 above. +;; +;; C-v +;; Select node 10 below. +;; +;; (`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 ;; ============ ;; @@ -436,9 +537,12 @@ ;; 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 @@ -446,10 +550,17 @@ ;; 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 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 @@ -458,8 +569,24 @@ ;; 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 . ;; ;; ;; @@ -468,7 +595,7 @@ ;; ;; Emacs allows a very useful and powerful method of undoing only selected ;; changes: when a region is active, only changes that affect the text within -;; that region will are undone. With the standard Emacs undo system, changes +;; that region will be undone. With the standard Emacs undo system, changes ;; produced by undoing-in-region naturally get added onto the end of the ;; linear undo history: ;; @@ -602,123 +729,121 @@ -;;; Change Log: -;; -;; 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) + + + +;;; ===================================================================== +;;; 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")) + + + + + ;;; ===================================================================== ;;; Global variables and customization options (defvar buffer-undo-tree nil "Tree of undo entries in current buffer.") +(put 'buffer-undo-tree 'permanent-local t) (make-variable-buffer-local 'buffer-undo-tree) @@ -732,32 +857,139 @@ when `undo-tree-mode' is enabled." :group 'undo-tree :type 'string) -(defcustom undo-tree-incompatible-major-modes nil + +(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-visualizer-spacing 3 - "Horizontal spacing in undo-tree visualization. -Must be a postivie odd integer." + +(defcustom undo-tree-enable-undo-in-region t + "When non-nil, enable undo-in-region. + +When undo-in-region is enabled, undoing or redoing when the +region is active (in `transient-mark-mode') or with a prefix +argument (not in `transient-mark-mode') only undoes changes +within the current region." :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-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. + +By default, undo-tree history is saved to a file called +\"..~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.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 3)) + '(choice (const :tag "" nil)) + 'boolean)) + + +(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 (cons (regexp :tag "Regexp matching filename") + (directory :tag "Undo history directory name")))) + + + +(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 'boolean) + + +(defcustom undo-tree-visualizer-timestamps nil + "When non-nil, display time-stamps by default +in undo-tree visualizer. + +\\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. + +\\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 @@ -765,198 +997,250 @@ Must be a postivie odd integer." (: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) -;; prevent debugger being called on "No further redo information" -(add-to-list 'debug-ignored-errors "^No further redo information") +;; 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) + +;; 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 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)) +;;; 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))) + ;; 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) + + + + + ;;; ===================================================================== ;;; Undo-tree data structure @@ -966,12 +1250,14 @@ in visualizer." (:constructor nil) (:constructor make-undo-tree (&aux - (root (make-undo-tree-node nil nil)) + (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) + ;;(:copier nil) + ) + root current size count object-pool) @@ -979,13 +1265,13 @@ in visualizer." (undo-tree-node (:type vector) ; create unnamed struct (:constructor nil) - (:constructor make-undo-tree-node + (:constructor undo-tree-make-node (previous undo &optional redo &aux (timestamp (current-time)) (branch 0))) - (:constructor make-undo-tree-node-backwards + (:constructor undo-tree-make-node-backwards (next-node undo &optional redo &aux @@ -997,7 +1283,7 @@ in visualizer." (defmacro undo-tree-node-p (n) - (let ((len (length (make-undo-tree-node nil nil)))) + (let ((len (length (undo-tree-make-node nil nil)))) `(and (vectorp ,n) (= (length ,n) ,len)))) @@ -1006,19 +1292,19 @@ in visualizer." (undo-tree-region-data (:type vector) ; create unnamed struct (:constructor nil) - (:constructor make-undo-tree-region-data + (:constructor undo-tree-make-region-data (&optional undo-beginning undo-end redo-beginning redo-end)) - (:constructor make-undo-tree-undo-region-data + (:constructor undo-tree-make-undo-region-data (undo-beginning undo-end)) - (:constructor make-undo-tree-redo-region-data + (:constructor undo-tree-make-redo-region-data (redo-beginning redo-end)) (:copier nil)) undo-beginning undo-end redo-beginning redo-end) (defmacro undo-tree-region-data-p (r) - (let ((len (length (make-undo-tree-region-data)))) + (let ((len (length (undo-tree-make-region-data)))) `(and (vectorp ,r) (= (length ,r) ,len)))) (defmacro undo-tree-node-clear-region-data (node) @@ -1055,7 +1341,7 @@ in visualizer." (unless (undo-tree-region-data-p r) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (make-undo-tree-region-data))))) + (setq r (undo-tree-make-region-data))))) (setf (undo-tree-region-data-undo-beginning r) ,val))) (defsetf undo-tree-node-undo-end (node) (val) @@ -1063,7 +1349,7 @@ in visualizer." (unless (undo-tree-region-data-p r) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (make-undo-tree-region-data))))) + (setq r (undo-tree-make-region-data))))) (setf (undo-tree-region-data-undo-end r) ,val))) (defsetf undo-tree-node-redo-beginning (node) (val) @@ -1071,7 +1357,7 @@ in visualizer." (unless (undo-tree-region-data-p r) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (make-undo-tree-region-data))))) + (setq r (undo-tree-make-region-data))))) (setf (undo-tree-region-data-redo-beginning r) ,val))) (defsetf undo-tree-node-redo-end (node) (val) @@ -1079,7 +1365,7 @@ in visualizer." (unless (undo-tree-region-data-p r) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :region - (setq r (make-undo-tree-region-data))))) + (setq r (undo-tree-make-region-data))))) (setf (undo-tree-region-data-redo-end r) ,val))) @@ -1088,23 +1374,23 @@ in visualizer." (undo-tree-visualizer-data (:type vector) ; create unnamed struct (:constructor nil) - (:constructor make-undo-tree-visualizer-data + (:constructor undo-tree-make-visualizer-data (&optional lwidth cwidth rwidth marker)) (:copier nil)) lwidth cwidth rwidth marker) (defmacro undo-tree-visualizer-data-p (v) - (let ((len (length (make-undo-tree-visualizer-data)))) + (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))) @@ -1132,7 +1418,7 @@ in visualizer." (unless (undo-tree-visualizer-data-p v) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (make-undo-tree-visualizer-data))))) + (setq v (undo-tree-make-visualizer-data))))) (setf (undo-tree-visualizer-data-lwidth v) ,val))) (defsetf undo-tree-node-cwidth (node) (val) @@ -1140,7 +1426,7 @@ in visualizer." (unless (undo-tree-visualizer-data-p v) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (make-undo-tree-visualizer-data))))) + (setq v (undo-tree-make-visualizer-data))))) (setf (undo-tree-visualizer-data-cwidth v) ,val))) (defsetf undo-tree-node-rwidth (node) (val) @@ -1148,7 +1434,7 @@ in visualizer." (unless (undo-tree-visualizer-data-p v) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (make-undo-tree-visualizer-data))))) + (setq v (undo-tree-make-visualizer-data))))) (setf (undo-tree-visualizer-data-rwidth v) ,val))) (defsetf undo-tree-node-marker (node) (val) @@ -1156,11 +1442,27 @@ in visualizer." (unless (undo-tree-visualizer-data-p v) (setf (undo-tree-node-meta-data ,node) (plist-put (undo-tree-node-meta-data ,node) :visualizer - (setq v (make-undo-tree-visualizer-data))))) + (setq v (undo-tree-make-visualizer-data))))) (setf (undo-tree-visualizer-data-marker v) ,val))) +(defstruct + (undo-tree-register-data + (:type vector) + (:constructor nil) + (:constructor undo-tree-make-register-data (buffer node))) + buffer node) + +(defun undo-tree-register-data-p (data) + (and (vectorp data) + (= (length data) 2) + (undo-tree-node-p (undo-tree-register-data-node data)))) + +(defun undo-tree-register-data-print-func (data) + (princ (format "an undo-tree state for buffer %s" + (undo-tree-register-data-buffer data)))) + (defmacro undo-tree-node-register (node) `(plist-get (undo-tree-node-meta-data ,node) :register)) @@ -1170,14 +1472,14 @@ in visualizer." - + ;;; ===================================================================== ;;; Basic undo-tree data structure functions (defun undo-tree-grow (undo) "Add an UNDO node to current branch of `buffer-undo-tree'." (let* ((current (undo-tree-current buffer-undo-tree)) - (new (make-undo-tree-node current undo))) + (new (undo-tree-make-node current undo))) (push new (undo-tree-node-next current)) (setf (undo-tree-current buffer-undo-tree) new))) @@ -1187,7 +1489,7 @@ in visualizer." Note that this will overwrite NODE's \"previous\" link, so should only be used on a detached NODE, never on nodes that are already part of `buffer-undo-tree'." - (let ((new (make-undo-tree-node-backwards node undo redo))) + (let ((new (undo-tree-make-node-backwards node undo redo))) (setf (undo-tree-node-previous node) new) new)) @@ -1239,14 +1541,14 @@ that are already part of `buffer-undo-tree'." (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 () @@ -1278,16 +1580,47 @@ Comparison is done with `eq'." (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))) + + ;;; ===================================================================== -;;; 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))) (defmacro undo-list-GCd-marker-elt-p (elt) - `(and (symbolp (car-safe ,elt)) (numberp (cdr-safe ,elt)))) + ;; Return t if ELT is a marker element whose marker has been moved to the + ;; object-pool, so may potentially have been garbage-collected. + ;; Note: Valid marker undo elements should be uniquely identified as cons + ;; cells with a symbol in the car (replacing the marker), and a number in + ;; the cdr. However, to guard against future changes to undo element + ;; formats, we perform an additional redundant check on the symbol name. + `(and (car-safe ,elt) + (symbolp (car ,elt)) + (let ((str (symbol-name (car ,elt)))) + (and (> (length str) 12) + (string= (substring str 0 12) "undo-tree-id"))) + (numberp (cdr-safe ,elt)))) (defun undo-tree-move-GC-elts-to-pool (elt) @@ -1337,17 +1670,18 @@ Comparison is done with `eq'." (while (or (null (car buffer-undo-list)) (and discard-pos (integerp (car buffer-undo-list)))) (setq buffer-undo-list (cdr buffer-undo-list))) - ;; pop elements up to next undo boundary - (unless (eq (car buffer-undo-list) 'undo-tree-canary) + ;; pop elements up to next undo boundary, discarding position entries if + ;; DISCARD-POS is non-nil + (if (eq (car buffer-undo-list) 'undo-tree-canary) + (push nil buffer-undo-list) (let* ((changeset (list (pop buffer-undo-list))) (p changeset)) (while (progn (undo-tree-move-GC-elts-to-pool (car p)) - (car buffer-undo-list)) - ;; discard position entries at head of undo list - (when discard-pos - (while (and discard-pos (integerp (car buffer-undo-list))) - (setq buffer-undo-list (cdr buffer-undo-list)))) + (while (and discard-pos (integerp (car buffer-undo-list))) + (setq buffer-undo-list (cdr 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))) @@ -1356,13 +1690,13 @@ Comparison is done with `eq'." (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 @@ -1379,43 +1713,51 @@ Comparison is done with `eq'." (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' - (if (null buffer-undo-list) - (setq buffer-undo-list '(nil undo-tree-canary)) - (let ((elt (last buffer-undo-list))) - (unless (eq (car elt) 'undo-tree-canary) - (setcdr elt '(nil undo-tree-canary))))) + (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 (make-undo-tree-node nil (undo-list-pop-changeset))) + (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-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))) @@ -1470,9 +1812,9 @@ Comparison is done with `eq'." - + ;;; ===================================================================== -;;; History discarding functions +;;; History discarding utility functions (defun undo-tree-oldest-leaf (node) ;; Return oldest leaf node below NODE. @@ -1505,6 +1847,10 @@ Comparison is done with `eq'." nil) ;; discard root (t + ;; clear any register referring to root + (let ((r (undo-tree-node-register node))) + (when (and r (eq (get-register r) node)) + (set-register r nil))) ;; make child of root into new root (setq node (setf (undo-tree-root buffer-undo-tree) (car (undo-tree-node-next node)))) @@ -1512,9 +1858,11 @@ Comparison is done with `eq'." (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) @@ -1527,16 +1875,22 @@ Comparison is done with `eq'." (let* ((parent (undo-tree-node-previous node)) (current (nth (undo-tree-node-branch parent) (undo-tree-node-next parent)))) + ;; clear any register referring to the discarded node + (let ((r (undo-tree-node-register node))) + (when (and r (eq (get-register r) node)) + (set-register r nil))) ;; update undo-tree size (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))) @@ -1628,13 +1982,13 @@ which is defined in the `warnings' library.\n") - + ;;; ===================================================================== -;;; 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 @@ -1655,8 +2009,7 @@ which is defined in the `warnings' library.\n") ;; (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 @@ -1720,17 +2073,45 @@ which is defined in the `warnings' library.\n") (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)))))))) + + + + +;;; ===================================================================== +;;; 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 @@ -1777,7 +2158,7 @@ which is defined in the `warnings' library.\n") ;; (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)) @@ -1791,11 +2172,11 @@ which is defined in the `warnings' library.\n") ;; if this is a new undo-in-region, initial FRAGMENT is a copy of all ;; nodes below the current one in the active branch ((undo-tree-node-next node) - (setq fragment (make-undo-tree-node nil nil) + (setq fragment (undo-tree-make-node nil nil) splice fragment) (while (setq node (nth (undo-tree-node-branch node) (undo-tree-node-next node))) - (push (make-undo-tree-node + (push (undo-tree-make-node splice (undo-copy-list (undo-tree-node-undo node)) (undo-copy-list (undo-tree-node-redo node))) @@ -1821,7 +2202,7 @@ which is defined in the `warnings' library.\n") (progn (setq fragment (undo-tree-grow-backwards fragment undo-list)) (unless splice (setq splice fragment))) - (setq fragment (make-undo-tree-node nil undo-list)) + (setq fragment (undo-tree-make-node nil undo-list)) (setq splice fragment)) (while elt @@ -1881,7 +2262,7 @@ which is defined in the `warnings' library.\n") (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 --- @@ -1894,7 +2275,7 @@ which is defined in the `warnings' library.\n") (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... @@ -1904,16 +2285,16 @@ which is defined in the `warnings' library.\n") (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 ;; and attach it to parent of last node from which elements were ;; pulled ((null fragment) - (setq fragment (make-undo-tree-node node region-changeset)) + (setq fragment (undo-tree-make-node node region-changeset)) (push fragment (undo-tree-node-next node)) (setf (undo-tree-node-branch node) 0) ;; set current node to undo-in-region node @@ -1945,9 +2326,9 @@ which is defined in the `warnings' library.\n") (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 (make-undo-tree-node nil region-changeset)) + (setq node (undo-tree-make-node nil region-changeset)) (undo-tree-splice-node node splice) ;; set current node to undo-in-region node (setf (undo-tree-current buffer-undo-tree) node))) @@ -1957,12 +2338,10 @@ which is defined in the `warnings' library.\n") (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 ))) @@ -2011,11 +2390,11 @@ which is defined in the `warnings' library.\n") ;; if this is a new redo-in-region, initial fragment is a copy of all ;; nodes below the current one in the active branch ((undo-tree-node-next node) - (setq fragment (make-undo-tree-node nil nil) + (setq fragment (undo-tree-make-node nil nil) splice fragment) (while (setq node (nth (undo-tree-node-branch node) (undo-tree-node-next node))) - (push (make-undo-tree-node + (push (undo-tree-make-node splice nil (undo-copy-list (undo-tree-node-redo node))) (undo-tree-node-next splice)) @@ -2093,7 +2472,7 @@ which is defined in the `warnings' library.\n") (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 --- @@ -2111,21 +2490,21 @@ which is defined in the `warnings' library.\n") (setq fragment (if fragment (undo-tree-grow-backwards fragment nil region-changeset) - (make-undo-tree-node nil nil region-changeset))) + (undo-tree-make-node nil nil region-changeset))) (push fragment (undo-tree-node-next node)) (setf (undo-tree-node-branch node) 0 (undo-tree-node-previous fragment) node) ;; 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 ))) @@ -2222,7 +2601,7 @@ of either NODE itself or some node above it in the tree." - + ;;; ===================================================================== ;;; Undo-tree commands @@ -2243,14 +2622,15 @@ The following keys are available in `undo-tree-mode': 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 + ;; if disabling `undo-tree-mode', rebuild `buffer-undo-list' from tree so ;; Emacs undo can work - (unless undo-tree-mode + (when (not undo-tree-mode) (undo-list-rebuild-from-tree) (setq buffer-undo-tree nil))) @@ -2305,7 +2685,7 @@ key bindings do not count.)" -(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. @@ -2313,17 +2693,29 @@ 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 (or (region-active-p) (and arg (not (numberp arg))))) + (undo-in-region (and undo-tree-enable-undo-in-region + (or (region-active-p) + (and arg (not (numberp arg)))))) pos current) ;; transfer entries accumulated in `buffer-undo-list' to ;; `buffer-undo-tree' @@ -2332,14 +2724,14 @@ undoing." (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)) @@ -2371,9 +2763,8 @@ undoing." ;; 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) @@ -2381,9 +2772,10 @@ undoing." ;; 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 @@ -2398,29 +2790,39 @@ undoing." (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 (> (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." - (interactive "p") +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 (or (region-active-p) (and arg (not (numberp arg))))) + (redo-in-region (and undo-tree-enable-undo-in-region + (or (region-active-p) + (and arg (not (numberp arg)))))) pos current) ;; transfer entries accumulated in `buffer-undo-list' to ;; `buffer-undo-tree' @@ -2429,20 +2831,20 @@ redoing." (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))) @@ -2456,6 +2858,8 @@ redoing." (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 @@ -2472,16 +2876,16 @@ redoing." ;; 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 @@ -2494,9 +2898,7 @@ redoing." (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 (> (undo-tree-num-branches) 1) (message "Undo branch point!")))) + (setq deactivate-mark (not redo-in-region)))) @@ -2507,26 +2909,41 @@ using `undo-tree-redo'." (interactive (list (or (and prefix-arg (prefix-numeric-value prefix-arg)) (and (not (eq buffer-undo-list t)) (or (undo-list-transfer-to-tree) t) - (> (undo-tree-num-branches) 1) - (read-number - (format "Branch (0-%d): " - (1- (undo-tree-num-branches)))))))) + (let ((b (undo-tree-node-branch + (undo-tree-current + buffer-undo-tree)))) + (cond + ;; switch to other branch if only 2 + ((= (undo-tree-num-branches) 2) (- 1 b)) + ;; prompt if more than 2 + ((> (undo-tree-num-branches) 2) + (read-number + (format "Branch (0-%d, on %d): " + (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 (setf (undo-tree-node-branch (undo-tree-current buffer-undo-tree)) - branch)) + 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) @@ -2546,10 +2963,10 @@ using `undo-tree-redo'." (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 @@ -2561,11 +2978,16 @@ The saved state can be restored using 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 - (set-register register (undo-tree-current buffer-undo-tree)) + (set-register + register (registerv-make + (undo-tree-make-register-data + (current-buffer) (undo-tree-current buffer-undo-tree)) + :print-func 'undo-tree-register-data-print-func)) ;; record REGISTER in current node, for visualizer (setf (undo-tree-node-register (undo-tree-current buffer-undo-tree)) register)) @@ -2576,32 +2998,180 @@ Argument is a character, naming the register." "Restore undo-tree state from REGISTER. The state must be saved using `undo-tree-save-state-to-register'. Argument is a character, naming the register." - (interactive "cRestore undo-tree state from register: ") + (interactive "*cRestore undo-tree state from register: ") ;; throw error if undo is disabled in buffer, or if register doesn't contain ;; an undo-tree node - (let ((node (get-register register))) + (let ((data (registerv-data (get-register register)))) (cond ((eq buffer-undo-list t) - (error "No undo information in this buffer")) - ((not (undo-tree-node-p node)) - (error "Register doesn't contain undo-tree state"))) + (user-error "No undo information in this buffer")) + ((not (undo-tree-register-data-p data)) + (user-error "Register doesn't contain undo-tree state")) + ((not (eq (current-buffer) (undo-tree-register-data-buffer data))) + (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 - (undo-tree-set node))) + (undo-tree-set (undo-tree-register-data-node data)))) + + + + +;;; ===================================================================== +;;; 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) + "Store undo-tree history to file. +If optional argument FILENAME is omitted, default save file is +\"..~undo-tree\" if buffer is visiting a file. +Otherwise, prompt for one. + +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) + (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)) + )))) + + + +(defun undo-tree-load-history (&optional filename noerror) + "Load undo-tree history from file. + +If optional argument FILENAME is null, default load file is +\"..~undo-tree\" if buffer is visiting a file. +Otherwise, prompt for one. + +If optional argument NOERROR is non-nil, return nil instead of +signaling an error if file is not found." + (interactive) + ;; 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 load from: ") nil)))) + + ;; attempt to read undo-tree from FILENAME + (catch 'load-error + (unless (file-exists-p filename) + (if noerror + (throw 'load-error nil) + (error "File \"%s\" does not exist; could not load undo-tree history" + filename))) + (let (buff hash tree) + (setq buff (current-buffer)) + (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 () + (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 () + (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))) + + + + ;;; ===================================================================== -;;; Undo-tree visualizer +;;; Visualizer drawing functions (defun undo-tree-visualize () "Visualize the current buffer's undo tree." - (interactive) + (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 @@ -2612,129 +3182,317 @@ Argument is a character, naming the register." (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) - (setq buffer-read-only nil) - (undo-tree-draw-tree undo-tree) - (setq buffer-read-only t))) + (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-in-progress - (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 @@ -2750,10 +3508,10 @@ Argument is a character, naming the register." ((= 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 @@ -2764,18 +3522,18 @@ Argument is a character, naming the register." ;; 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)) @@ -2789,7 +3547,7 @@ Argument is a character, naming the register." (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))) @@ -2803,7 +3561,7 @@ Argument is a character, naming the register." (+ (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)) @@ -2813,7 +3571,7 @@ Argument is a character, naming the register." (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))) @@ -2827,9 +3585,9 @@ Argument is a character, naming the register." (+ (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) @@ -2839,7 +3597,7 @@ Argument is a character, naming the register." (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) @@ -2856,13 +3614,12 @@ Argument is a character, naming the register." (+ (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 @@ -2893,7 +3650,7 @@ Argument is a character, naming the register." ;; 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))) @@ -2907,32 +3664,152 @@ Argument is a character, naming the register." (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) "]") + " ")))) + + + + ;;; ===================================================================== -;;; 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 @@ -2943,46 +3820,63 @@ the parent buffer. 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") - (setq buffer-read-only nil) - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) - (undo-tree-draw-node (undo-tree-current buffer-undo-tree))) - (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) - (deactivate-mark) - (unwind-protect - (undo-tree-undo arg) - (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) - (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) - (setq buffer-read-only t))) + (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") - (setq buffer-read-only nil) - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) - (undo-tree-draw-node (undo-tree-current buffer-undo-tree))) - (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) - (deactivate-mark) - (unwind-protect - (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))) - (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) - (setq buffer-read-only t))) + (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) @@ -2991,9 +3885,9 @@ This will affect which branch to descend when *redoing* changes using `undo-tree-redo' or `undo-tree-visualizer-redo'." (interactive "p") ;; un-highlight old active branch below current node - (setq buffer-read-only nil) (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) - (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face)) + (let ((undo-tree-insert-face 'undo-tree-visualizer-default-face) + (inhibit-read-only t)) (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) ;; increment branch (let ((branch (undo-tree-node-branch (undo-tree-current buffer-undo-tree)))) @@ -3003,13 +3897,13 @@ using `undo-tree-redo' or `undo-tree-visualizer-redo'." (1- (undo-tree-num-branches))) ((<= (+ branch arg) 0) 0) (t (+ branch arg)))) - ;; highlight new active branch below current node - (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) - (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) - (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) - ;; re-highlight current node - (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current) - (setq buffer-read-only t))) + (let ((inhibit-read-only t)) + ;; highlight new active branch below current node + (goto-char (undo-tree-node-marker (undo-tree-current buffer-undo-tree))) + (let ((undo-tree-insert-face 'undo-tree-visualizer-active-branch-face)) + (undo-tree-highlight-active-branch (undo-tree-current buffer-undo-tree))) + ;; re-highlight current node + (undo-tree-draw-node (undo-tree-current buffer-undo-tree) 'current)))) (defun undo-tree-visualize-switch-branch-left (arg) @@ -3028,12 +3922,25 @@ using `undo-tree-redo' or `undo-tree-visualizer-redo'." (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) @@ -3044,13 +3951,12 @@ at POS, or point if POS is nil." (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) - (undo-tree-set node) - (set-buffer undo-tree-visualizer-buffer-name) - (setq buffer-read-only nil) + (switch-to-buffer-other-window undo-tree-visualizer-parent-buffer) + (let ((undo-tree-inhibit-kill-visualizer t)) (undo-tree-set node)) + (switch-to-buffer-other-window undo-tree-visualizer-buffer-name) ;; re-draw undo tree - (undo-tree-draw-tree buffer-undo-tree) - (setq buffer-read-only t)))) + (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) @@ -3060,97 +3966,381 @@ at mouse event 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 - (setq buffer-read-only nil) - (undo-tree-draw-tree buffer-undo-tree) - (setq buffer-read-only t)) + (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)))) + + ;;; ===================================================================== ;;; 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)))) + + + + +;;; ===================================================================== +;;; 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))))