branch: master
commit ebd8979eecca8f554b40db624ba649d513d737f3
Author: Toby S. Cubitt <ts...@cantab.net>
Commit: Toby S. Cubitt <ts...@cantab.net>
New undo-tree package release.
---
packages/undo-tree/undo-tree.el | 595 ++++++++++++++++++++++++++++------------
1 file changed, 412 insertions(+), 183 deletions(-)
diff --git a/packages/undo-tree/undo-tree.el b/packages/undo-tree/undo-tree.el
index cb8a230..defe1d2 100644
--- a/packages/undo-tree/undo-tree.el
+++ b/packages/undo-tree/undo-tree.el
@@ -1,9 +1,10 @@
;;; undo-tree.el --- Treat undo history as a tree -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc
+;; Copyright (C) 2009-2020 Free Software Foundation, Inc
;; Author: Toby Cubitt <toby-undo-t...@dr-qubit.org>
-;; Version: 0.6.5
+;; Maintainer: Toby Cubitt <toby-undo-t...@dr-qubit.org>
+;; Version: 0.7
;; Keywords: convenience, files, undo, redo, history, tree
;; URL: http://www.dr-qubit.org/emacs.php
;; Repository: http://www.dr-qubit.org/git/undo-tree.git
@@ -410,7 +411,7 @@
;; o o o o o o
;; | |\ |\ |\ |\ |
;; | | \ | \ | \ | \ |
-;; o o | | o o o | o o
+;; o o | | o o | | o o
;; | / | | | / | | | /
;; |/ | | |/ | | |/
;; (already undid o | | o<. | | o
@@ -586,7 +587,7 @@
;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
;; 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 .
+;; visualizer was invoked.
;;
;;
;;
@@ -625,24 +626,37 @@
;; o x (undo the undo-in-region)
;;
;;
-;; In `undo-tree-mode', undo-in-region works similarly: when there's an active
-;; region, undoing only undoes changes that affect that region. However, the
-;; way these undos-in-region are recorded in the undo history is quite
-;; different. In `undo-tree-mode', undo-in-region creates a new branch in the
-;; undo history. The new branch consists of an undo step that undoes some of
-;; the changes that affect the current region, and another step that undoes
-;; the remaining changes needed to rejoin the previous undo history.
+;; In `undo-tree-mode', undo-in-region works much the same way: when there's
+;; an active region, undoing only undoes changes that affect that region. In
+;; `undo-tree-mode', redoing when there's an active region similarly only
+;; redoes changes that affect that region.
+;;
+;; However, the way these undo- and redo-in-region changes are recorded in the
+;; undo history is quite different. The good news is, you don't need to
+;; understand this to use undo- and redo-in-region in `undo-tree-mode' - just
+;; go ahead and use them! They'll probably work as you expect. But if you're
+;; masochistic enough to want to understand conceptually what's happening to
+;; the undo tree as you undo- and redo-in-region, then read on...
+;;
+;;
+;; Undo-in-region creates a new branch in the undo history. The new branch
+;; consists of an undo step that undoes some of the changes that affect the
+;; current region, and another step that undoes the remaining changes needed
+;; to rejoin the previous undo history.
;;
;; Previous undo history Undo-in-region
;;
;; o o
;; | |
;; | |
+;; | |
;; o o
-;; | |\
+;; | |
+;; | |
+;; | |
+;; o o_
;; | | \
-;; o o x (undo-in-region)
-;; | | |
+;; | | x (undo-in-region)
;; | | |
;; x o o
;;
@@ -655,48 +669,57 @@
;; First undo-in-region Second undo-in-region
;;
;; o o
-;; | |\
+;; | |
+;; | |
+;; | |
+;; o o_
;; | | \
-;; o o x (undo-in-region)
-;; |\ | |
+;; | | x (undo-in-region)
+;; | | |
+;; o_ o |
;; | \ | |
-;; o x o o
-;; | | | |
-;; | | | |
-;; o o o o
+;; | x | o
+;; | | | |
+;; o o o o
;;
;; Redoing takes you back down the undo tree, as usual (as long as you haven't
;; changed the active region after undoing-in-region, it doesn't matter if it
;; is still active):
;;
;; o
-;; |\
+;; |
+;; |
+;; |
+;; o_
;; | \
-;; o o
-;; | |
+;; | o
;; | |
-;; o o (redo)
+;; o |
;; | |
+;; | o (redo)
;; | |
;; o x (redo)
;;
;;
-;; What about redo-in-region? Obviously, this only makes sense if you have
-;; already undone some changes, so that there are some changes to redo!
-;; Redoing-in-region splits off a new branch of the undo history below your
-;; current location in the undo tree. This time, the new branch consists of a
-;; redo step that redoes some of the redo changes that affect the current
-;; region, followed by all the remaining redo changes.
+;; What about redo-in-region? Obviously, redo-in-region only makes sense if
+;; you have already undone some changes, so that there are some changes to
+;; redo! Redoing-in-region splits off a new branch of the undo history below
+;; your current location in the undo tree. This time, the new branch consists
+;; of a first redo step that redoes some of the redo changes that affect the
+;; current region, followed by *all* the remaining redo changes.
;;
;; Previous undo history Redo-in-region
;;
;; o o
;; | |
;; | |
-;; x o
-;; | |\
+;; | |
+;; x o_
;; | | \
-;; o o x (redo-in-region)
+;; | | x (redo-in-region)
+;; | | |
+;; o o |
+;; | | |
;; | | |
;; | | |
;; o o o
@@ -708,19 +731,19 @@
;;
;; First redo-in-region Second redo-in-region
;;
-;; o o
-;; | |
-;; | |
-;; o o
-;; |\ |\
-;; | \ | \
-;; o x (redo-in-region) o o
-;; | | | |
-;; | | | |
-;; o o o x (redo-in-region)
-;; |
-;; |
-;; o
+;; o o
+;; | |
+;; | |
+;; | |
+;; o_ o_
+;; | \ | \
+;; | x | o
+;; | | | |
+;; o | o |
+;; | | | |
+;; | | | x (redo-in-region)
+;; | | | |
+;; o o o o
;;
;; Note that undo-in-region and redo-in-region only ever add new changes to
;; the undo tree, they *never* modify existing undo history. So you can always
@@ -851,6 +874,45 @@
"Tree undo/redo."
:group 'undo)
+
+(defcustom undo-tree-limit 80000000
+ "Value of `undo-limit' used in `undo-tree-mode'.
+
+If `undo-limit' is larger than `undo-tree-limit', the larger of
+the two values will be used.
+
+See also `undo-tree-strong-limit' and `undo-tree-outer-limit'.
+
+Setting this to nil prevents `undo-tree-mode' ever discarding
+undo history. (As far as possible. In principle, it is still
+possible for Emacs to discard undo history behind
+`undo-tree-mode's back.) USE THIS SETTING AT YOUR OWN RISK! Emacs
+may crash if undo history exceeds Emacs' available memory. This
+is particularly risky if `undo-tree-auto-save-history' is
+enabled, as in that case undo history is preserved even between
+Emacs sessions."
+ :group 'undo-tree
+ :type '(choice integer (const nil)))
+
+
+(defcustom undo-tree-strong-limit 120000000
+ "Value of `undo-strong-limit' used in `undo-tree-mode'.
+
+If `undo-strong-limit' is larger than `undo-tree-strong-limit'
+the larger of the two values will be used."
+ :group 'undo-tree
+ :type 'integer)
+
+
+(defcustom undo-tree-outer-limit 360000000
+ "Value of `undo-outer-limit' used in `undo-tree-mode'.
+
+If `undo-outer-limit' is larger than `undo-tree-outer-limit' the
+larger of the two values will be used."
+ :group 'undo-tree
+ :type 'integer)
+
+
(defcustom undo-tree-mode-lighter " Undo-Tree"
"Lighter displayed in mode line
when `undo-tree-mode' is enabled."
@@ -865,7 +927,7 @@ when `undo-tree-mode' is enabled."
:type '(repeat symbol))
-(defcustom undo-tree-enable-undo-in-region t
+(defcustom undo-tree-enable-undo-in-region nil
"When non-nil, enable undo-in-region.
When undo-in-region is enabled, undoing or redoing when the
@@ -982,6 +1044,26 @@ enabled. However, this effect is quite rare in practice."
(integer :tag "> size")))
+(defvar undo-tree-pre-save-element-functions '()
+ "Special hook to modify undo-tree elements prior to saving.
+Each function on this hook is called in turn on each undo element
+in the tree by `undo-tree-save-history' prior to writing the undo
+history to file. It should return either nil, which removes that
+undo element from the saved history, or a replacement element to
+use instead (which should be identical to the original element if
+that element should be saved unchanged).")
+
+
+(defvar undo-tree-post-load-element-functions '()
+ "Special hook to modify undo-tree undo elements after loading.
+Each function on this hook is called in turn on each undo element
+in the tree by `undo-tree-load-history' after loading the undo
+history from file. It should return either nil, which removes that
+undo element from the loaded history, or a replacement element to
+use instead (which should be identical to the original element if
+that element should be loaded unchanged).")
+
+
(defface undo-tree-visualizer-default-face
'((((class color)) :foreground "gray"))
"Face used to draw undo-tree in visualizer."
@@ -1065,8 +1147,9 @@ in visualizer."
(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)
+(add-hook 'write-file-functions 'undo-tree-save-history-from-hook)
+(add-hook 'kill-buffer-hook 'undo-tree-save-history-from-hook)
+(add-hook 'find-file-hook 'undo-tree-load-history-from-hook)
@@ -1217,6 +1300,7 @@ in visualizer."
:enable (and undo-tree-mode
(not buffer-read-only)
(not (eq t buffer-undo-list))
+ (not (eq nil buffer-undo-tree))
(undo-tree-node-previous
(undo-tree-current
buffer-undo-tree)))
:help "Undo last operation"))
@@ -1225,6 +1309,7 @@ in visualizer."
:enable (and undo-tree-mode
(not buffer-read-only)
(not (eq t buffer-undo-list))
+ (not (eq nil buffer-undo-tree))
(undo-tree-node-next
(undo-tree-current
buffer-undo-tree)))
:help "Redo last operation")
@@ -1255,10 +1340,11 @@ in visualizer."
(size 0)
(count 0)
(object-pool (make-hash-table :test 'eq :weakness 'value))))
- ;;(:copier nil)
- )
+ (:copier nil))
root current size count object-pool)
+(defun copy-undo-tree (tree)
+ (copy-tree tree 'copy-vectors))
(defstruct
@@ -1661,30 +1747,29 @@ Comparison is done with `eq'."
undo-list)
-(defun undo-list-pop-changeset (&optional discard-pos)
- ;; Pop changeset from `buffer-undo-list'. If DISCARD-POS is non-nil, discard
- ;; any position entries from changeset.
+(defun undo-list-found-canary-p (undo-list)
+ (or (eq (car undo-list) 'undo-tree-canary)
+ (and (null (car undo-list))
+ (eq (cadr undo-list) 'undo-tree-canary))))
- ;; discard undo boundaries and (if DISCARD-POS is non-nil) position entries
- ;; at head of undo list
- (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, 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))
- (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)))
+
+(defmacro undo-list-pop-changeset (undo-list &optional discard-pos)
+ ;; Pop changeset from `undo-list'. If DISCARD-POS is non-nil, discard
+ ;; any position entries from changeset.
+ `(when (and ,undo-list (not (undo-list-found-canary-p ,undo-list)))
+ (let (changeset)
+ ;; discard initial undo boundary(ies)
+ (while (null (car ,undo-list)) (setq ,undo-list (cdr ,undo-list)))
+ ;; pop elements up to next undo boundary, discarding position entries
+ ;; if DISCARD-POS is non-nil
+ (while (null changeset)
+ (while (and ,undo-list (car ,undo-list)
+ (not (undo-list-found-canary-p ,undo-list)))
+ (if (and ,discard-pos (integerp (car ,undo-list)))
+ (setq ,undo-list (cdr ,undo-list))
+ (push (pop ,undo-list) changeset)
+ (undo-tree-move-GC-elts-to-pool (car changeset)))))
+ (nreverse changeset))))
(defun undo-tree-copy-list (undo-list)
@@ -1709,9 +1794,14 @@ Comparison is done with `eq'."
copy)))
+(defvar undo-tree-gc-flag nil)
+
+(defun undo-tree-post-gc ()
+ (setq undo-tree-gc-flag t))
+
(defun undo-list-transfer-to-tree ()
- ;; Transfer entries accumulated in `buffer-undo-list' to `buffer-undo-tree'.
+ ;; Transfer entries accumulated in `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)
@@ -1719,57 +1809,66 @@ Comparison is done with `eq'."
;; if `buffer-undo-tree' is empty, create initial undo-tree
(when (null buffer-undo-tree) (setq buffer-undo-tree (make-undo-tree)))
- ;; make sure there's a canary at end of `buffer-undo-list'
- (when (null buffer-undo-list)
- (setq buffer-undo-list '(nil undo-tree-canary)))
- (unless (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
+ ;; garbage-collect then repeatedly try to deep-copy `buffer-undo-list' until
+ ;; we succeed without GC running, in an attempt to mitigate race conditions
+ ;; with garbage collector corrupting undo history (is this even a thing?!)
+ (unless (or (null buffer-undo-list)
+ (undo-list-found-canary-p buffer-undo-list))
+ (garbage-collect))
+ (let (undo-list changeset)
+ (setq undo-tree-gc-flag t)
+ (while undo-tree-gc-flag
+ (setq undo-tree-gc-flag nil
+ undo-list (copy-tree buffer-undo-list)))
+ (setq buffer-undo-list '(nil undo-tree-canary))
+
+ ;; create new node from first changeset in `undo-list', save old
;; `buffer-undo-tree' current node, and make new node the current node
- (let* ((node (undo-tree-make-node nil (undo-list-pop-changeset)))
- (splice (undo-tree-current buffer-undo-tree))
- (size (undo-list-byte-size (undo-tree-node-undo node)))
- (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 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 (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-count buffer-undo-tree) count))
- ;; if undo history has been discarded, replace entire
- ;; `buffer-undo-tree' with new tree fragment
- (setq node (undo-tree-grow-backwards node nil))
- (setf (undo-tree-root buffer-undo-tree) node)
- (setq buffer-undo-list '(nil undo-tree-canary))
- (setf (undo-tree-size buffer-undo-tree) size)
- (setf (undo-tree-count buffer-undo-tree) count)
- (setq buffer-undo-list '(nil undo-tree-canary))))
- ;; discard undo history if necessary
- (undo-tree-discard-history)))
+ (when (setq changeset (undo-list-pop-changeset undo-list))
+ (let* ((node (undo-tree-make-node nil changeset))
+ (splice (undo-tree-current buffer-undo-tree))
+ (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 `undo-list' changesets
+ (while (setq changeset (undo-list-pop-changeset undo-list))
+ (setq node (undo-tree-grow-backwards node changeset))
+ (incf size (undo-list-byte-size (undo-tree-node-undo node)))
+ (incf count))
+
+ ;; if no undo history has been discarded from `undo-list' since last
+ ;; transfer, splice new tree fragment onto end of old
+ ;; `buffer-undo-tree' current node
+ (if (undo-list-found-canary-p undo-list)
+ (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-count buffer-undo-tree) count))
+
+ ;; if undo history has been discarded, replace entire
+ ;; `buffer-undo-tree' with new tree fragment
+ (unless (= (undo-tree-size buffer-undo-tree) 0)
+ (message "Undo history discarded by Emacs (see `undo-limit') -
rebuilding undo-tree"))
+ (setq node (undo-tree-grow-backwards node nil))
+ (setf (undo-tree-root buffer-undo-tree) node)
+ (setf (undo-tree-size buffer-undo-tree) size)
+ (setf (undo-tree-count buffer-undo-tree) count)
+ (setq undo-list '(nil undo-tree-canary))))))
+
+ ;; discard undo history if necessary
+ (undo-tree-discard-history))
(defun undo-list-byte-size (undo-list)
;; Return size (in bytes) of UNDO-LIST
- (let ((size 0) (p undo-list))
- (while p
+ (let ((size 0))
+ (dolist (elt undo-list)
(incf size 8) ; cons cells use up 8 bytes
- (when (and (consp (car p)) (stringp (caar p)))
- (incf size (string-bytes (caar p))))
- (setq p (cdr p)))
+ (when (stringp (car-safe elt))
+ (incf size (string-bytes (car elt)))))
size))
@@ -1944,6 +2043,7 @@ set by `undo-limit', `undo-strong-limit' and
`undo-outer-limit'."
))
undo-limit))
(setq node (undo-tree-discard-node node)))
+ (message "Undo history discarded by undo-tree (see `undo-tree-limit')")
;; if we're still over the `undo-outer-limit', discard entire history
(when (> (undo-tree-size buffer-undo-tree) undo-outer-limit)
@@ -2023,7 +2123,7 @@ which is defined in the `warnings' library.\n")
((= (mod num-children 2) 1)
(setq p (undo-tree-node-next node))
;; compute left-width
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(if (undo-tree-node-lwidth (car p))
(incf lwidth (+ (undo-tree-node-lwidth (car p))
(undo-tree-node-cwidth (car p))
@@ -2039,7 +2139,7 @@ which is defined in the `warnings' library.\n")
;; compute right-width
(incf rwidth (undo-tree-node-rwidth (car p)))
(setq p (cdr p))
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(if (undo-tree-node-lwidth (car p))
(incf rwidth (+ (undo-tree-node-lwidth (car p))
(undo-tree-node-cwidth (car p))
@@ -2051,7 +2151,7 @@ which is defined in the `warnings' library.\n")
(t
(setq p (undo-tree-node-next node))
;; compute left-width
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(if (undo-tree-node-lwidth (car p))
(incf lwidth (+ (undo-tree-node-lwidth (car p))
(undo-tree-node-cwidth (car p))
@@ -2061,7 +2161,7 @@ which is defined in the `warnings' library.\n")
;; centre-width is 0 when number of children is even
(setq cwidth 0)
;; compute right-width
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(if (undo-tree-node-lwidth (car p))
(incf rwidth (+ (undo-tree-node-lwidth (car p))
(undo-tree-node-cwidth (car p))
@@ -2605,6 +2705,8 @@ of either NODE itself or some node above it in the tree."
;;; =====================================================================
;;; Undo-tree commands
+(defvar undo-tree-timer nil)
+
;;;###autoload
(define-minor-mode undo-tree-mode
"Toggle undo-tree mode.
@@ -2628,11 +2730,34 @@ Within the undo-tree visualizer, the following keys are
available:
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
- (when (not undo-tree-mode)
+ (cond
+ (undo-tree-mode ; enabling `undo-tree-mode'
+ (set (make-local-variable 'undo-limit)
+ (if undo-tree-limit
+ (max undo-limit undo-tree-limit)
+ most-positive-fixnum))
+ (set (make-local-variable 'undo-strong-limit)
+ (if undo-tree-limit
+ (max undo-strong-limit undo-tree-strong-limit)
+ most-positive-fixnum))
+ (set (make-local-variable 'undo-outer-limit)
+ (if undo-tree-limit
+ (max undo-outer-limit undo-tree-outer-limit)
+ most-positive-fixnum))
+ (when (null undo-tree-limit)
+ (setq undo-tree-timer
+ (run-with-idle-timer 5 'repeat #'undo-list-transfer-to-tree)))
+ (add-hook 'post-gc-hook #'undo-tree-post-gc nil))
+
+ (t ; disabling `undo-tree-mode'
+ ;; rebuild `buffer-undo-list' from tree so Emacs undo can work
(undo-list-rebuild-from-tree)
- (setq buffer-undo-tree nil)))
+ (setq buffer-undo-tree nil)
+ (remove-hook 'post-gc-hook #'undo-tree-post-gc 'local)
+ (when (timerp undo-tree-timer) (cancel-timer undo-tree-timer))
+ (kill-local-variable 'undo-limit)
+ (kill-local-variable 'undo-strong-limit)
+ (kill-local-variable 'undo-outer-limit))))
(defun turn-on-undo-tree-mode (&optional print-message)
@@ -2695,6 +2820,8 @@ 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."
(interactive "*P")
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t)
(user-error "No undo information in this buffer"))
@@ -2721,7 +2848,7 @@ changes within the current region."
;; `buffer-undo-tree'
(undo-list-transfer-to-tree)
- (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
+ (dotimes (_ (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))
(user-error "No further undo information"))
@@ -2753,7 +2880,7 @@ changes within the current region."
;; elements from node's redo list
(if preserve-redo
(progn
- (undo-list-pop-changeset)
+ (undo-list-pop-changeset buffer-undo-list)
(decf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-redo current)))
(setf (undo-tree-node-redo current)
@@ -2766,7 +2893,7 @@ changes within the current region."
(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))
+ (undo-list-pop-changeset buffer-undo-list 'discard-pos))
(incf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-redo current))))
@@ -2802,6 +2929,8 @@ 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."
(interactive "*P")
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t)
(user-error "No undo information in this buffer"))
@@ -2828,7 +2957,7 @@ changes within the current region."
;; `buffer-undo-tree'
(undo-list-transfer-to-tree)
- (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
+ (dotimes (_ (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)))
(user-error "No further redo information"))
@@ -2866,7 +2995,7 @@ changes within the current region."
;; elements from node's redo list
(if preserve-undo
(progn
- (undo-list-pop-changeset)
+ (undo-list-pop-changeset buffer-undo-list)
(decf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-undo current)))
(setf (undo-tree-node-undo current)
@@ -2879,7 +3008,7 @@ changes within the current region."
(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))
+ (undo-list-pop-changeset buffer-undo-list 'discard-pos))
(incf (undo-tree-size buffer-undo-tree)
(undo-list-byte-size (undo-tree-node-undo current))))
@@ -2908,7 +3037,7 @@ This will affect which branch to descend when *redoing*
changes
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-list-transfer-to-tree)
(let ((b (undo-tree-node-branch
(undo-tree-current
buffer-undo-tree))))
@@ -2921,6 +3050,8 @@ using `undo-tree-redo'."
(format "Branch (0-%d, on %d): "
(1- (undo-tree-num-branches)) b)))
))))))
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t)
(user-error "No undo information in this buffer"))
@@ -2977,6 +3108,8 @@ The saved state can be restored using
`undo-tree-restore-state-from-register'.
Argument is a character, naming the register."
(interactive "cUndo-tree state to register: ")
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t)
(user-error "No undo information in this buffer"))
@@ -2999,6 +3132,8 @@ Argument is a character, naming the 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: ")
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; throw error if undo is disabled in buffer, or if register doesn't contain
;; an undo-tree node
(let ((data (registerv-data (get-register register))))
@@ -3044,13 +3179,16 @@ Otherwise, prompt for one.
If OVERWRITE is non-nil, any existing file will be overwritten
without asking for confirmation."
(interactive)
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
(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)))
+ (undo-tree-kill-visualizer)
+ ;; should be cleared already by killing the visualizer, but writes
+ ;; unreasable data if not for some reason, so just in case...
+ (undo-tree-clear-visualizer-data buffer-undo-tree)
(let ((buff (current-buffer))
tree)
;; get filename
@@ -3062,42 +3200,57 @@ without asking for confirmation."
(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))
- ))))
+ ;; transform undo-tree into non-circular structure, and make tmp copy
+ (setq tree (copy-undo-tree buffer-undo-tree))
+ (undo-tree-decircle tree)
+ ;; discard undo-tree object pool before saving
+ (setf (undo-tree-object-pool tree) nil)
+ ;; run pre-save transformer functions
+ (when undo-tree-pre-save-element-functions
+ (undo-tree-mapc
+ (lambda (node)
+ (let ((changeset (undo-tree-node-undo node)))
+ (run-hook-wrapped
+ 'undo-tree-pre-save-element-functions
+ (lambda (fun)
+ (setq changeset (delq nil (mapcar fun changeset)))))
+ (setf (undo-tree-node-undo node) changeset))
+ (let ((changeset (undo-tree-node-redo node)))
+ (run-hook-wrapped
+ 'undo-tree-pre-save-element-functions
+ (lambda (fun)
+ (setq changeset (delq nil (mapcar fun changeset)))))
+ (setf (undo-tree-node-redo node) changeset)))
+ (undo-tree-root tree)))
+ ;; 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)))))))
(defun undo-tree-load-history (&optional filename noerror)
- "Load undo-tree history from file.
+ "Load undo-tree history from file, for the current buffer.
If optional argument FILENAME is null, default load file is
\".<buffer-file-name>.~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."
+signaling an error if file is not found.
+
+Note this will overwrite any existing undo history."
(interactive)
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
;; get filename
(unless filename
(setq filename
@@ -3122,7 +3275,7 @@ signaling an error if file is not found."
(setq hash (read (current-buffer)))
(error
(kill-buffer nil)
- (funcall (if noerror 'message 'user-error)
+ (funcall (if noerror #'message #'user-error)
"Error reading undo-tree history from \"%s\"" filename)
(throw 'load-error nil)))
(unless (string= (sha1 buff) hash)
@@ -3134,30 +3287,62 @@ signaling an error if file is not found."
(setq tree (read (current-buffer)))
(error
(kill-buffer nil)
- (funcall (if noerror 'message 'error)
+ (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
+ ;; run post-load transformer functions
+ (when undo-tree-post-load-element-functions
+ (undo-tree-mapc
+ (lambda (node)
+ (let ((changeset (undo-tree-node-undo node)))
+ (run-hook-wrapped
+ 'undo-tree-post-load-element-functions
+ (lambda (fun)
+ (setq changeset (delq nil (mapcar fun changeset)))))
+ (setf (undo-tree-node-undo node) changeset))
+ (let ((changeset (undo-tree-node-redo node)))
+ (run-hook-wrapped
+ 'undo-tree-post-load-element-functions
+ (lambda (fun)
+ (setq changeset (delq nil (mapcar fun changeset)))))
+ (setf (undo-tree-node-redo node) changeset)))
+ (undo-tree-root tree))) ;; 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))))
+ ;; create undo-tree object pool
+ (setf (undo-tree-object-pool tree)
+ (make-hash-table :test 'eq :weakness 'value))
+ (setq buffer-undo-tree tree
+ buffer-undo-list '(nil undo-tree-canary)))))
;; Versions of save/load functions for use in hooks
-(defun undo-tree-save-history-hook ()
+(defun undo-tree-save-history-from-hook ()
(when (and undo-tree-mode undo-tree-auto-save-history
- (not (eq buffer-undo-list t)))
- (undo-tree-save-history nil t) nil))
+ (not (eq buffer-undo-list t))
+ buffer-file-name)
+ (undo-tree-save-history nil 'overwrite) nil))
-(defun undo-tree-load-history-hook ()
+(define-obsolete-function-alias
+ 'undo-tree-save-history-hook 'undo-tree-save-history-from-hook
+ "`undo-tree-save-history-hook' is obsolete since undo-tree
+ version 0.6.6. Use `undo-tree-save-history-from-hook' instead.")
+
+
+(defun undo-tree-load-history-from-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-load-history nil 'noerror)))
+
+(define-obsolete-function-alias
+ 'undo-tree-load-history-hook 'undo-tree-load-history-from-hook
+ "`undo-tree-load-history-hook' is obsolete since undo-tree
+ version 0.6.6. Use `undo-tree-load-history-from-hook' instead.")
@@ -3168,6 +3353,8 @@ signaling an error if file is not found."
(defun undo-tree-visualize ()
"Visualize the current buffer's undo tree."
(interactive "*")
+ (unless undo-tree-mode
+ (user-error "Undo-tree mode not enabled in buffer"))
(deactivate-mark)
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t)
@@ -3535,7 +3722,7 @@ signaling an error if file is not found."
(car (undo-tree-node-next node)))))
(move-marker (setq pos (make-marker)) (point))
(setq n (cons nil (undo-tree-node-next node)))
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(setq n (cdr n))
(when (or (null active-branch)
(eq (car n)
@@ -3588,7 +3775,7 @@ signaling an error if file is not found."
(move-marker pos (point)))
;; right subtrees
(move-marker trunk-pos (1+ trunk-pos))
- (dotimes (i (/ num-children 2))
+ (dotimes (_ (/ num-children 2))
(setq n (cdr n))
(when (or (null active-branch)
(eq (car n)
@@ -3643,7 +3830,7 @@ signaling an error if file is not found."
(when (characterp str)
(setq str (make-string arg str))
(setq arg 1))
- (dotimes (i arg) (insert str))
+ (dotimes (_ arg) (insert str))
(setq arg (* arg (length str)))
(undo-tree-move-forward arg)
;; make sure mark isn't active, otherwise `backward-delete-char' might
@@ -3728,7 +3915,7 @@ signaling an error if file is not found."
(undo-tree-move-forward
(+ (undo-tree-node-char-rwidth (car n))
(/ undo-tree-visualizer-spacing 2) 1))
- (dotimes (i (- (/ l 2) p 1))
+ (dotimes (_ (- (/ l 2) p 1))
(setq n (cdr n))
(undo-tree-move-forward
(+ (undo-tree-node-char-lwidth (car n))
@@ -3746,7 +3933,7 @@ signaling an error if file is not found."
(+ (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)))
+ (dotimes (_ (- p (/ l 2) (mod l 2)))
(undo-tree-move-backward
(+ (undo-tree-node-char-lwidth (car n))
(undo-tree-node-char-rwidth (car n))
@@ -3766,7 +3953,7 @@ signaling an error if file is not found."
(if relative
;; relative time
(let ((time (floor (float-time
- (subtract-time (current-time) timestamp))))
+ (time-subtract (current-time) timestamp))))
n)
(setq time
;; years
@@ -3832,6 +4019,8 @@ Within the undo-tree visualizer, the following keys are
available:
(defun undo-tree-visualize-undo (&optional arg)
"Undo changes. A numeric ARG serves as a repeat count."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(let ((old (undo-tree-current buffer-undo-tree))
current)
;; unhighlight old current node
@@ -3857,6 +4046,8 @@ Within the undo-tree visualizer, the following keys are
available:
(defun undo-tree-visualize-redo (&optional arg)
"Redo changes. A numeric ARG serves as a repeat count."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(let ((old (undo-tree-current buffer-undo-tree))
current)
;; unhighlight old current node
@@ -3884,6 +4075,8 @@ Within the undo-tree visualizer, the following keys are
available:
This will affect which branch to descend when *redoing* changes
using `undo-tree-redo' or `undo-tree-visualizer-redo'."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
;; un-highlight old 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-default-face)
@@ -3917,6 +4110,8 @@ using `undo-tree-redo' or `undo-tree-visualizer-redo'."
(defun undo-tree-visualizer-quit ()
"Quit the undo-tree visualizer."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(undo-tree-clear-visualizer-data buffer-undo-tree)
;; remove kill visualizer hook from parent buffer
(unwind-protect
@@ -3938,6 +4133,8 @@ using `undo-tree-redo' or `undo-tree-visualizer-redo'."
(defun undo-tree-visualizer-abort ()
"Quit the undo-tree visualizer and return buffer to original state."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(let ((node undo-tree-visualizer-initial-node))
(undo-tree-visualizer-quit)
(undo-tree-set node)))
@@ -3947,6 +4144,8 @@ using `undo-tree-redo' or `undo-tree-visualizer-redo'."
"Set buffer to state corresponding to undo tree node
at POS, or point if POS is nil."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(unless pos (setq pos (point)))
(let ((node (get-text-property pos 'undo-tree-node)))
(when node
@@ -3963,13 +4162,15 @@ at POS, or point if POS is nil."
"Set buffer to state corresponding to undo tree node
at mouse event POS."
(interactive "@e")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(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
+the symbol `register', undo to last register. If X is the symbol
`saved', undo to last saved state. If X is null, undo to first of
these that's encountered.
@@ -3978,6 +4179,8 @@ Interactively, a single \\[universal-argument] specifies
specifies `saved', and a negative prefix argument specifies
`register'."
(interactive "P")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(when (and (called-interactively-p 'any) x)
(setq x (prefix-numeric-value x)
x (cond
@@ -4030,6 +4233,8 @@ Interactively, a single \\[universal-argument] specifies
specifies `saved', and a negative prefix argument specifies
`register'."
(interactive "P")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(when (and (called-interactively-p 'any) x)
(setq x (prefix-numeric-value x)
x (cond
@@ -4073,6 +4278,8 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-toggle-timestamps ()
"Toggle display of time-stamps."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(setq undo-tree-visualizer-timestamps (not undo-tree-visualizer-timestamps))
(setq undo-tree-visualizer-spacing (undo-tree-visualizer-calculate-spacing))
;; redraw tree
@@ -4081,16 +4288,22 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-scroll-left (&optional arg)
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(scroll-left (or arg 1) t))
(defun undo-tree-visualizer-scroll-right (&optional arg)
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(scroll-right (or arg 1) t))
(defun undo-tree-visualizer-scroll-up (&optional arg)
(interactive "P")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(if (or (and (numberp arg) (< arg 0)) (eq arg '-))
(undo-tree-visualizer-scroll-down arg)
;; scroll up and expand newly-visible portion of tree
@@ -4106,6 +4319,8 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-scroll-down (&optional arg)
(interactive "P")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(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
@@ -4159,9 +4374,11 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-select-previous (&optional arg)
"Move to previous node."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(let ((node undo-tree-visualizer-selected-node))
(catch 'top
- (dotimes (i (or arg 1))
+ (dotimes (_ (or arg 1))
(unless (undo-tree-node-previous node) (throw 'top t))
(setq node (undo-tree-node-previous node))))
;; when using lazy drawing, extend tree upwards as required
@@ -4179,9 +4396,11 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-select-next (&optional arg)
"Move to next node."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(let ((node undo-tree-visualizer-selected-node))
(catch 'bottom
- (dotimes (i (or arg 1))
+ (dotimes (_ (or arg 1))
(unless (nth (undo-tree-node-branch node) (undo-tree-node-next node))
(throw 'bottom t))
(setq node
@@ -4201,12 +4420,14 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-select-right (&optional arg)
"Move right to a sibling node."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(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)
+ (dotimes (_ arg)
(while (or (null node) (eq node undo-tree-visualizer-selected-node))
(forward-char)
(setq node (get-text-property (point) 'undo-tree-node))
@@ -4222,12 +4443,14 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-select-left (&optional arg)
"Move left to a sibling node."
(interactive "p")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(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)
+ (dotimes (_ arg)
(while (or (null node) (eq node undo-tree-visualizer-selected-node))
(backward-char)
(setq node (get-text-property (point) 'undo-tree-node))
@@ -4261,6 +4484,8 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-mouse-select (pos)
"Select undo tree node at mouse event POS."
(interactive "@e")
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(undo-tree-visualizer-select (event-start (nth 1 pos))))
@@ -4272,6 +4497,8 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-toggle-diff ()
"Toggle diff display in undo-tree visualizer."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(if undo-tree-visualizer-diff
(undo-tree-visualizer-hide-diff)
(undo-tree-visualizer-show-diff)))
@@ -4280,6 +4507,8 @@ specifies `saved', and a negative prefix argument
specifies
(defun undo-tree-visualizer-selection-toggle-diff ()
"Toggle diff display in undo-tree visualizer selection mode."
(interactive)
+ (unless (eq major-mode 'undo-tree-visualizer-mode)
+ (user-error "Undo-tree mode not enabled in buffer"))
(if undo-tree-visualizer-diff
(undo-tree-visualizer-hide-diff)
(let ((node (get-text-property (point) 'undo-tree-node)))
