branch: master
commit c13bd781f9349ff6d82b8ca60ac71a7427a80cc8
Author: Toby S. Cubitt
Commit: Toby S. Cubitt
Undo-tree bug-fix release.
---
packages/undo-tree/undo-tree.el | 124 ++--
1 file changed, 93 insertions(+), 31 deletions(-)
diff --git a/packages/undo-tree/undo-tree.el b/packages/undo-tree/undo-tree.el
index defe1d2..de15a3b 100644
--- a/packages/undo-tree/undo-tree.el
+++ b/packages/undo-tree/undo-tree.el
@@ -1343,8 +1343,25 @@ in visualizer."
(:copier nil))
root current size count object-pool)
-(defun copy-undo-tree (tree)
- (copy-tree tree 'copy-vectors))
+(defun undo-tree-copy (tree)
+ ;; Return a copy of undo-tree TREE.
+ (unwind-protect
+ (let ((new (make-undo-tree)))
+ (undo-tree-decircle tree)
+ (let ((max-lisp-eval-depth (* 100 (undo-tree-count tree)))
+ (max-specpdl-size (* 100 (undo-tree-count tree
+ (setf (undo-tree-root new)
+ (undo-tree-node-copy (undo-tree-root tree)
+new (undo-tree-current tree
+ (setf (undo-tree-size new)
+ (undo-tree-size tree))
+ (setf (undo-tree-count new)
+ (undo-tree-count tree))
+ (setf (undo-tree-object-pool new)
+ (copy-hash-table (undo-tree-object-pool tree)))
+ (undo-tree-recircle new)
+ new)
+(undo-tree-recircle tree)))
(defstruct
@@ -1364,6 +1381,7 @@ in visualizer."
(next (list next-node))
(timestamp (current-time))
(branch 0)))
+ (:constructor undo-tree-make-empty-node ())
(:copier nil))
previous next undo redo timestamp branch meta-data)
@@ -1372,6 +1390,34 @@ in visualizer."
(let ((len (length (undo-tree-make-node nil nil
`(and (vectorp ,n) (= (length ,n) ,len
+(defun undo-tree-node-copy (node &optional tree current)
+ ;; Return a copy of undo-tree NODE, sans previous link or meta-data.
+ ;; If TREE and CURRENT are supplied, set (undo-tree-current TREE) to the
+ ;; copy of CURRENT node, if found.
+ (let* ((new (undo-tree-make-empty-node))
+(stack (list (cons node new)))
+n)
+(while (setq n (pop stack))
+ (setf (undo-tree-node-undo (cdr n))
+ (copy-tree (undo-tree-node-undo (car n)) 'copy-vectors))
+ (setf (undo-tree-node-redo (cdr n))
+ (copy-tree (undo-tree-node-redo (car n)) 'copy-vectors))
+ (setf (undo-tree-node-timestamp (cdr n))
+ (copy-sequence (undo-tree-node-timestamp (car n
+ (setf (undo-tree-node-branch (cdr n))
+ (undo-tree-node-branch (car n)))
+ (setf (undo-tree-node-next (cdr n))
+ (mapcar (lambda (_) (undo-tree-make-empty-node))
+ (make-list (length (undo-tree-node-next (car n))) nil)))
+;; set (undo-tree-current TREE) to copy if we've found CURRENT
+(when (and tree (eq (car n) current))
+ (setf (undo-tree-current tree) (cdr n)))
+;; recursively copy next nodes
+(let ((next0 (undo-tree-node-next (car n)))
+ (next1 (undo-tree-node-next (cdr n
+ (while (and next0 next1)
+ (push (cons (pop next0) (pop next1)) stack
+new))
(defstruct
@@ -1631,8 +1677,7 @@ that are already part of `buffer-undo-tree'."
;; Apply FUNCTION to NODE and to each node below it.
(let ((stack (list node))
n)
-(while stack
- (setq n (pop stack))
+(while (setq n (pop stack))
(funcall --undo-tree-mapc-function-- n)
(setq stack (append (undo-tree-node-next n) stack)
@@ -2009,12 +2054,14 @@ set by `undo-limit', `undo-strong-limit' and
`undo-outer-limit'."
(let ((node (if (> (length (undo-tree-node-next
(undo-tree-root buffer-undo-tree))) 1)
(undo-tree-oldest-leaf (undo-tree-root buffer-undo-tree))
- (undo-tree-root buffer-undo-tree
+ (undo-tree-root buffer-undo-tree)))
+ discarded)
;; discard nodes until memory use is within `undo-strong-limit'
(while (and node
(> (undo-tree-size buffer-undo-tree) undo-strong-limit))
-(setq node (undo-tree-discard-node node)))
+(setq node (undo-tree-discard-node node)
+ discarded t))
;; discard nodes until next node to discard would bring memory use
;; within `undo-limit'
@@ -2042,8 +2089,11 @@ set by `undo-limit', `undo-strong-limit' and
`undo-outer-limit'."
(undo-list-byte-size (undo-tree-node-redo node)))
))
undo-limit))
-(setq node (undo-tree-discard-node node)))
- (message "Undo history discarded by undo-tree (see `undo-tree-limit')")
+(setq node (undo-tree-discard-node node)
+ discarded t))
+
+ (when discarded
+ (message "Undo history discarded by undo-tree (see `undo-tree-limit')"))
;; if we
