[elpa] externals/undo-tree f0a6192 184/195: Proper fix to copy-undo-tree by writing bespoke copier.

[Stefan Monnier]

branch: externals/undo-tree
commit f0a6192210127b3e0375928b6ac18921ff12e8a2
Author: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>
Commit: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>

    Proper fix to copy-undo-tree by writing bespoke copier.
    
    Previous fix didn't copy current node correctly.
---
 undo-tree.el | 36 ++++++++++++++++++++++++++++++++----
 1 file changed, 32 insertions(+), 4 deletions(-)

diff --git a/undo-tree.el b/undo-tree.el
index bf5b5c1..2c23e2b 100644
--- a/undo-tree.el
+++ b/undo-tree.el
@@ -1332,7 +1332,6 @@ in visualizer."
 (defstruct
   (undo-tree
    :named
-   (:type vector)  ; needed for `copy-undo-tree' implementation
    (:constructor nil)
    (:constructor make-undo-tree
                  (&aux
@@ -1345,14 +1344,24 @@ in visualizer."
   root current size count object-pool)
 
 (defun copy-undo-tree (tree)
+  ;; Return a copy of undo-tree TREE.
   (unwind-protect
-      (progn
+      (let ((new (make-undo-tree)))
        (undo-tree-decircle tree)
-       (copy-tree tree 'copy-vectors))
+       (setf (undo-tree-root new)
+             (copy-undo-tree-node (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
   (undo-tree-node
    (:type vector)   ; create unnamed struct
@@ -1378,6 +1387,25 @@ in visualizer."
   (let ((len (length (undo-tree-make-node nil nil))))
     `(and (vectorp ,n) (= (length ,n) ,len))))
 
+(defun copy-undo-tree-node (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-node
+             nil (copy-tree (undo-tree-node-undo node) 'copy-vectors)
+             (copy-tree (undo-tree-node-redo node) 'copy-vectors))))
+    (setf (undo-tree-node-timestamp new)
+         (copy-sequence (undo-tree-node-timestamp node)))
+    (setf (undo-tree-node-branch new)
+         (undo-tree-node-branch node))
+    ;; recursively copy next nodes
+    (setf (undo-tree-node-next new)
+         (mapcar (lambda (n) (copy-undo-tree-node n tree current))
+                 (undo-tree-node-next node)))
+    ;; set (undo-tree-current TREE) to copy if we've found CURRENT
+    (when (and tree (eq node current))
+      (setf (undo-tree-current tree) new))
+    new))
 
 
 (defstruct