[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/undo-tree 0ed621d 062/195: Implemented undo-in-region.
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/undo-tree 0ed621d 062/195: Implemented undo-in-region. |
|
Date: |
Sat, 28 Nov 2020 13:41:22 -0500 (EST) |
branch: externals/undo-tree
commit 0ed621df81dedd675f24c87c3e827b7fbe88cbd6
Author: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>
Commit: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>
Implemented undo-in-region.
---
undo-tree.el | 876 +++++++++++++++++++++++++++++++++++++++++++++++++++++------
1 file changed, 798 insertions(+), 78 deletions(-)
diff --git a/undo-tree.el b/undo-tree.el
index 9d54c54..a621556 100644
--- a/undo-tree.el
+++ b/undo-tree.el
@@ -5,7 +5,7 @@
;; Copyright (C) 2009-2010 Toby Cubitt
;; Author: Toby Cubitt <toby-undo-tree@dr-qubit.org>
-;; Version: 0.2.1
+;; Version: 0.3
;; Keywords: undo, redo, history, tree
;; URL: http://www.dr-qubit.org/emacs.php
;; Git Repository: http://www.dr-qubit.org/git/undo-tree.git
@@ -462,20 +462,14 @@
;;
;; Finally, hitting "q" will quit the visualizer, leaving the parent buffer in
;; whatever state you ended at.
-;;
-;;
-;;
-;; Drawbacks
-;; =========
-;;
-;; `undo-tree-mode' doesn't support "undo in region", i.e. selectively undoing
-;; only the changes that affect the region. Support for this is planned for a
-;; future version.
;;; Change Log:
;;
+;; Version 0.3
+;; * implemented undo-in-region
+;;
;; 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
@@ -735,11 +729,13 @@ in visualizer."
(:constructor nil)
(:constructor make-undo-tree-node
(previous undo
+ &optional redo
&aux
(timestamp (current-time))
(branch 0)))
(:constructor make-undo-tree-node-backwards
(next-node undo
+ &optional redo
&aux
(next (list next-node))
(timestamp (current-time))
@@ -755,6 +751,88 @@ in visualizer."
(defstruct
+ (undo-tree-region-data
+ (:type vector) ; create unnamed struct
+ (:constructor nil)
+ (:constructor make-undo-tree-region-data
+ (&optional undo-beginning undo-end
+ redo-beginning redo-end))
+ (:constructor make-undo-tree-undo-region-data
+ (undo-beginning undo-end))
+ (:constructor make-undo-tree-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))))
+ `(and (vectorp ,r) (= (length ,r) ,len))))
+
+(defmacro undo-tree-node-clear-region-data (node)
+ `(setf (undo-tree-node-meta-data ,node)
+ (delq nil
+ (delq :region
+ (plist-put (undo-tree-node-meta-data ,node)
+ :region nil)))))
+
+
+(defmacro undo-tree-node-undo-beginning (node)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (when (undo-tree-region-data-p r)
+ (undo-tree-region-data-undo-beginning r))))
+
+(defmacro undo-tree-node-undo-end (node)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (when (undo-tree-region-data-p r)
+ (undo-tree-region-data-undo-end r))))
+
+(defmacro undo-tree-node-redo-beginning (node)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (when (undo-tree-region-data-p r)
+ (undo-tree-region-data-redo-beginning r))))
+
+(defmacro undo-tree-node-redo-end (node)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (when (undo-tree-region-data-p r)
+ (undo-tree-region-data-redo-end r))))
+
+
+(defsetf undo-tree-node-undo-beginning (node) (val)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (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)))))
+ (setf (undo-tree-region-data-undo-beginning r) ,val)))
+
+(defsetf undo-tree-node-undo-end (node) (val)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (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)))))
+ (setf (undo-tree-region-data-undo-end r) ,val)))
+
+(defsetf undo-tree-node-redo-beginning (node) (val)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (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)))))
+ (setf (undo-tree-region-data-redo-beginning r) ,val)))
+
+(defsetf undo-tree-node-redo-end (node) (val)
+ `(let ((r (plist-get (undo-tree-node-meta-data ,node) :region)))
+ (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)))))
+ (setf (undo-tree-region-data-redo-end r) ,val)))
+
+
+
+(defstruct
(undo-tree-visualizer-data
(:type vector) ; create unnamed struct
(:constructor nil)
@@ -843,16 +921,74 @@ in visualizer."
(setf (undo-tree-current buffer-undo-tree) new)))
-(defun undo-tree-grow-backwards (node undo)
- "Add an UNDO node *above* undo-tree NODE, and return new node.
+(defun undo-tree-grow-backwards (node undo &optional redo)
+ "Add new node *above* undo-tree NODE, and return new node.
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)))
+ (let ((new (make-undo-tree-node-backwards node undo redo)))
(setf (undo-tree-node-previous node) new)
new))
+(defun undo-tree-splice-node (node splice)
+ "Splice NODE into undo tree, below node SPLICE.
+Note that this will overwrite NODE's \"next\" and \"previous\"
+links, so should only be used on a detached NODE, never on nodes
+that are already part of `buffer-undo-tree'."
+ (setf (undo-tree-node-next node) (undo-tree-node-next splice)
+ (undo-tree-node-branch node) (undo-tree-node-branch splice)
+ (undo-tree-node-previous node) splice
+ (undo-tree-node-next splice) (list node)
+ (undo-tree-node-branch splice) 0)
+ (dolist (n (undo-tree-node-next node))
+ (setf (undo-tree-node-previous n) node)))
+
+
+(defun undo-tree-snip-node (node)
+ "Snip NODE out of undo tree."
+ (let* ((parent (undo-tree-node-previous node))
+ position p)
+ ;; if NODE is only child, replace parent's next links with NODE's
+ (if (= (length (undo-tree-node-next parent)) 0)
+ (setf (undo-tree-node-next parent) (undo-tree-node-next node)
+ (undo-tree-node-branch parent) (undo-tree-node-branch node))
+ ;; otherwise...
+ (setq position (undo-tree-position node (undo-tree-node-next parent)))
+ (cond
+ ;; if active branch used do go via NODE, set parent's branch to active
+ ;; branch of NODE
+ ((= (undo-tree-node-branch parent) position)
+ (setf (undo-tree-node-branch parent)
+ (+ position (undo-tree-node-branch node))))
+ ;; if active branch didn't go via NODE, update parent's branch to point
+ ;; to same node as before
+ ((> (undo-tree-node-branch parent) position)
+ (incf (undo-tree-node-branch parent)
+ (1- (length (undo-tree-node-next node))))))
+ ;; replace NODE in parent's next list with NODE's entire next list
+ (if (= position 0)
+ (setf (undo-tree-node-next parent)
+ (nconc (undo-tree-node-next node)
+ (cdr (undo-tree-node-next parent))))
+ (setq p (nthcdr (1- position) (undo-tree-node-next parent)))
+ (setcdr p (nconc (undo-tree-node-next node) (cddr p)))))
+ ;; update previous links of NODE's children
+ (dolist (n (undo-tree-node-next node))
+ (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)
+ (while stack
+ (setq node (pop stack))
+ (funcall --undo-tree-mapc-function-- node)
+ (dolist (n (undo-tree-node-next node))
+ (push n stack)))))
+
+
(defmacro undo-tree-num-branches ()
"Return number of branches at current undo tree node."
'(length (undo-tree-node-next (undo-tree-current buffer-undo-tree))))
@@ -1290,6 +1426,500 @@ which is defined in the `warnings' library.\n")
;;; =====================================================================
+;;; 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
+ ;; branch, which undoes changeset entries lying between START and END first,
+ ;; followed by remaining entries from the changesets, before rejoining the
+ ;; existing undo tree history. Repeated calls will, if appropriate, extend
+ ;; the current undo-in-region branch rather than creating a new one.
+
+ ;; if we're just reverting the last redo-in-region, we don't need to
+ ;; manipulate the undo tree at all
+ (if (undo-tree-reverting-redo-in-region-p start end)
+ t ; return t to indicate success
+
+ ;; We build the `region-changeset' and `delta-list' lists forwards, using
+ ;; pointers `r' and `d' to the penultimate element of the list. So that we
+ ;; don't have to treat the first element differently, we prepend a dummy
+ ;; leading nil to the lists, and have the pointers point to that
+ ;; initially.
+ ;; Note: using '(nil) instead of (list nil) in the `let*' results in
+ ;; bizarre errors when the code is byte-compiled, where parts of the
+ ;; lists appear to survive across different calls to this function.
+ ;; An obscure byte-compiler bug, perhaps?
+ (let* ((region-changeset (list nil))
+ (r region-changeset)
+ (delta-list (list nil))
+ (d delta-list)
+ (node (undo-tree-current buffer-undo-tree))
+ (repeated-undo-in-region
+ (undo-tree-repeated-undo-in-region-p start end))
+ undo-adjusted-markers ; `undo-elt-in-region' expects this
+ fragment splice original-fragment original-splice original-current
+ got-visible-elt undo-list elt)
+
+ ;; --- initialisation ---
+ (cond
+ ;; if this is a repeated undo in the same region, start pulling changes
+ ;; from NODE at which undo-in-region branch iss attached, and detatch
+ ;; the branch, using it as initial FRAGMENT of branch being constructed
+ (repeated-undo-in-region
+ (setq original-current node
+ fragment (car (undo-tree-node-next node))
+ splice node)
+ ;; undo up to node at which undo-in-region branch is attached
+ ;; (recognizable as first node with more than one branch)
+ (let ((mark-active nil))
+ (while (= (length (undo-tree-node-next node)) 1)
+ (undo-tree-undo)
+ (setq fragment node
+ node (undo-tree-current buffer-undo-tree))))
+ (when (eq splice node) (setq splice nil))
+ ;; detatch undo-in-region branch
+ (setf (undo-tree-node-next node)
+ (delq fragment (undo-tree-node-next node))
+ (undo-tree-node-previous fragment) nil
+ original-fragment fragment
+ original-splice node))
+
+ ;; 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)
+ splice fragment)
+ (while (setq node (nth (undo-tree-node-branch node)
+ (undo-tree-node-next node)))
+ (push (make-undo-tree-node
+ splice
+ (undo-copy-list (undo-tree-node-undo node))
+ (undo-copy-list (undo-tree-node-redo node)))
+ (undo-tree-node-next splice))
+ (setq splice (car (undo-tree-node-next splice))))
+ (setq fragment (car (undo-tree-node-next fragment))
+ splice nil
+ node (undo-tree-current buffer-undo-tree))))
+
+
+ ;; --- pull undo-in-region elements into branch ---
+ ;; work backwards up tree, pulling out undo elements within region until
+ ;; we've got one that undoes a visible change (insertion or deletion)
+ (catch 'abort
+ (while (and (not got-visible-elt) node (undo-tree-node-undo node))
+ ;; we cons a dummy nil element on the front of the changeset so that
+ ;; we can conveniently remove the first (real) element from the
+ ;; changeset if we need to; the leading nil is removed once we're
+ ;; done with this changeset
+ (setq undo-list (cons nil (undo-copy-list (undo-tree-node-undo node)))
+ elt (cadr undo-list))
+ (if fragment
+ (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 splice fragment))
+
+ (while elt
+ (cond
+ ;; keep elements within region
+ ((undo-elt-in-region elt start end)
+ ;; set flag if kept element is visible (insertion or deletion)
+ (when (and (consp elt)
+ (or (stringp (car elt)) (integerp (car elt))))
+ (setq got-visible-elt t))
+ ;; adjust buffer positions in elements previously undone before
+ ;; kept element, as kept element will now be undone first
+ (undo-tree-adjust-elements-to-elt splice elt)
+ ;; move kept element to undo-in-region changeset, adjusting its
+ ;; buffer position as it will now be undone first
+ (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list))))
+ (setq r (cdr r))
+ (setcdr undo-list (cddr undo-list)))
+
+ ;; discard "was unmodified" elements
+ ;; FIXME: deal properly with these
+ ((and (consp elt) (eq (car elt) t))
+ (setcdr undo-list (cddr undo-list)))
+
+ ;; if element crosses region, we can't pull any more elements
+ ((undo-elt-crosses-region elt start end)
+ ;; if we've found a visible element, it must be earlier in
+ ;; current node's changeset; stop pulling elements (null
+ ;; `undo-list' and non-nil `got-visible-elt' cause loop to exit)
+ (if got-visible-elt
+ (setq undo-list nil)
+ ;; if we haven't found a visible element yet, pulling
+ ;; undo-in-region branch has failed
+ (setq region-changeset nil)
+ (throw 'abort t)))
+
+ ;; if rejecting element, add its delta (if any) to the list
+ (t
+ (let ((delta (undo-delta elt)))
+ (when (/= 0 (cdr delta))
+ (setcdr d (list delta))
+ (setq d (cdr d))))
+ (setq undo-list (cdr undo-list))))
+
+ ;; process next element of current changeset
+ (setq elt (cadr undo-list)))
+
+ ;; if there are remaining elements in changeset, remove dummy nil
+ ;; from front
+ (if (cadr (undo-tree-node-undo fragment))
+ (pop (undo-tree-node-undo fragment))
+ ;; otherwise, if we've kept all elements in changeset, discard
+ ;; empty changeset
+ (when (eq splice fragment) (setq splice nil))
+ (setq fragment (car (undo-tree-node-next fragment))))
+ ;; process changeset from next node up the tree
+ (setq node (undo-tree-node-previous node))))
+
+ ;; pop dummy nil from front of `region-changeset'
+ (pop region-changeset)
+
+
+ ;; --- integrate branch into tree ---
+ ;; if no undo-in-region elements were found, restore undo tree
+ (if (null region-changeset)
+ (when original-current
+ (push original-fragment (undo-tree-node-next original-splice))
+ (setf (undo-tree-node-branch original-splice) 0
+ (undo-tree-node-previous original-fragment) original-splice)
+ (let ((mark-active nil))
+ (while (not (eq (undo-tree-current buffer-undo-tree)
+ original-current))
+ (undo-tree-redo)))
+ nil) ; return nil to indicate failure
+
+ ;; otherwise...
+ ;; need to undo up to node where new branch will be attached, to
+ ;; ensure redo entries are populated, and then redo back to where we
+ ;; started
+ (let ((mark-active nil)
+ (current (undo-tree-current buffer-undo-tree)))
+ (while (not (eq (undo-tree-current buffer-undo-tree) node))
+ (undo-tree-undo))
+ (while (not (eq (undo-tree-current buffer-undo-tree) current))
+ (undo-tree-redo)))
+
+ (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))
+ (push fragment (undo-tree-node-next node))
+ (setf (undo-tree-node-branch node) 0)
+ ;; set current node to undo-in-region node
+ (setf (undo-tree-current buffer-undo-tree) fragment))
+
+ ;; if no splice point has been set, add undo-in-region node to top of
+ ;; fragment and attach it to parent of last node from which elements
+ ;; were pulled
+ ((null splice)
+ (setq fragment (undo-tree-grow-backwards fragment region-changeset))
+ (push fragment (undo-tree-node-next node))
+ (setf (undo-tree-node-branch node) 0
+ (undo-tree-node-previous fragment) node)
+ ;; set current node to undo-in-region node
+ (setf (undo-tree-current buffer-undo-tree) fragment))
+
+ ;; if fragment contains nodes, attach fragment to parent of last node
+ ;; from which elements were pulled, and splice in undo-in-region node
+ (t
+ (setf (undo-tree-node-previous fragment) node)
+ (push fragment (undo-tree-node-next node))
+ (setf (undo-tree-node-branch node) 0)
+ ;; if this is a repeated undo-in-region, then we've left the current
+ ;; node at the original splice-point; we need to set the current
+ ;; node to the equivalent node on the undo-in-region branch and redo
+ ;; back to where we started
+ (when repeated-undo-in-region
+ (setf (undo-tree-current buffer-undo-tree)
+ (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))))
+ ;; splice new undo-in-region node into fragment
+ (setq node (make-undo-tree-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)))
+
+ ;; update undo-tree size
+ (setq node (undo-tree-node-previous fragment))
+ (while (progn
+ (and (setq node (car (undo-tree-node-next node)))
+ (not (eq node original-fragment))
+ (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))))
+ )))
+ t) ; indicate undo-in-region branch was successfully pulled
+ )))
+
+
+
+(defun undo-tree-pull-redo-in-region-branch (start end)
+ ;; Pull out entries from redo changesets to create a new redo-in-region
+ ;; branch, which redoes changeset entries lying between START and END first,
+ ;; followed by remaining entries from the changesets. Repeated calls will,
+ ;; if appropriate, extend the current redo-in-region branch rather than
+ ;; creating a new one.
+
+ ;; if we're just reverting the last undo-in-region, we don't need to
+ ;; manipulate the undo tree at all
+ (if (undo-tree-reverting-undo-in-region-p start end)
+ t ; return t to indicate success
+
+ ;; We build the `region-changeset' and `delta-list' lists forwards, using
+ ;; pointers `r' and `d' to the penultimate element of the list. So that we
+ ;; don't have to treat the first element differently, we prepend a dummy
+ ;; leading nil to the lists, and have the pointers point to that
+ ;; initially.
+ ;; Note: using '(nil) instead of (list nil) in the `let*' causes bizarre
+ ;; errors when the code is byte-compiled, where parts of the lists
+ ;; appear to survive across different calls to this function. An
+ ;; obscure byte-compiler bug, perhaps?
+ (let* ((region-changeset (list nil))
+ (r region-changeset)
+ (delta-list (list nil))
+ (d delta-list)
+ (node (undo-tree-current buffer-undo-tree))
+ (repeated-redo-in-region
+ (undo-tree-repeated-redo-in-region-p start end))
+ undo-adjusted-markers ; `undo-elt-in-region' expects this
+ fragment splice got-visible-elt redo-list elt)
+
+ ;; --- inisitalisation ---
+ (cond
+ ;; if this is a repeated redo-in-region, detach fragment below current
+ ;; node
+ (repeated-redo-in-region
+ (when (setq fragment (car (undo-tree-node-next node)))
+ (setf (undo-tree-node-previous fragment) nil
+ (undo-tree-node-next node)
+ (delq fragment (undo-tree-node-next node)))))
+ ;; 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)
+ splice fragment)
+ (while (setq node (nth (undo-tree-node-branch node)
+ (undo-tree-node-next node)))
+ (push (make-undo-tree-node
+ splice nil
+ (undo-copy-list (undo-tree-node-redo node)))
+ (undo-tree-node-next splice))
+ (setq splice (car (undo-tree-node-next splice))))
+ (setq fragment (car (undo-tree-node-next fragment)))))
+
+
+ ;; --- pull redo-in-region elements into branch ---
+ ;; work down fragment, pulling out redo elements within region until
+ ;; we've got one that redoes a visible change (insertion or deletion)
+ (setq node fragment)
+ (catch 'abort
+ (while (and (not got-visible-elt) node (undo-tree-node-redo node))
+ ;; we cons a dummy nil element on the front of the changeset so that
+ ;; we can conveniently remove the first (real) element from the
+ ;; changeset if we need to; the leading nil is removed once we're
+ ;; done with this changeset
+ (setq redo-list (push nil (undo-tree-node-redo node))
+ elt (cadr redo-list))
+ (while elt
+ (cond
+ ;; keep elements within region
+ ((undo-elt-in-region elt start end)
+ ;; set flag if kept element is visible (insertion or deletion)
+ (when (and (consp elt)
+ (or (stringp (car elt)) (integerp (car elt))))
+ (setq got-visible-elt t))
+ ;; adjust buffer positions in elements previously redone before
+ ;; kept element, as kept element will now be redone first
+ (undo-tree-adjust-elements-to-elt fragment elt t)
+ ;; move kept element to redo-in-region changeset, adjusting its
+ ;; buffer position as it will now be redone first
+ (setcdr r (list (undo-tree-apply-deltas elt (cdr delta-list) -1)))
+ (setq r (cdr r))
+ (setcdr redo-list (cddr redo-list)))
+
+ ;; discard "was unmodified" elements
+ ;; FIXME: deal properly with these
+ ((and (consp elt) (eq (car elt) t))
+ (setcdr redo-list (cddr redo-list)))
+
+ ;; if element crosses region, we can't pull any more elements
+ ((undo-elt-crosses-region elt start end)
+ ;; if we've found a visible element, it must be earlier in
+ ;; current node's changeset; stop pulling elements (null
+ ;; `redo-list' and non-nil `got-visible-elt' cause loop to exit)
+ (if got-visible-elt
+ (setq redo-list nil)
+ ;; if we haven't found a visible element yet, pulling
+ ;; redo-in-region branch has failed
+ (setq region-changeset nil)
+ (throw 'abort t)))
+
+ ;; if rejecting element, add its delta (if any) to the list
+ (t
+ (let ((delta (undo-delta elt)))
+ (when (/= 0 (cdr delta))
+ (setcdr d (list delta))
+ (setq d (cdr d))))
+ (setq redo-list (cdr redo-list))))
+
+ ;; process next element of current changeset
+ (setq elt (cadr redo-list)))
+
+ ;; if there are remaining elements in changeset, remove dummy nil
+ ;; from front
+ (if (cadr (undo-tree-node-redo node))
+ (pop (undo-tree-node-undo node))
+ ;; otherwise, if we've kept all elements in changeset, discard
+ ;; empty changeset
+ (if (eq fragment node)
+ (setq fragment (car (undo-tree-node-next fragment)))
+ (undo-tree-snip-node node)))
+ ;; process changeset from next node in fragment
+ (setq node (car (undo-tree-node-next node)))))
+
+ ;; pop dummy nil from front of `region-changeset'
+ (pop region-changeset)
+
+
+ ;; --- integrate branch into tree ---
+ (setq node (undo-tree-current buffer-undo-tree))
+ ;; if no redo-in-region elements were found, restore undo tree
+ (if (null (car region-changeset))
+ (when (and repeated-redo-in-region fragment)
+ (push fragment (undo-tree-node-next node))
+ (setf (undo-tree-node-branch node) 0
+ (undo-tree-node-previous fragment) node)
+ nil) ; return nil to indicate failure
+
+ ;; otherwise, add redo-in-region node to top of fragment, and attach
+ ;; it below current node
+ (setq fragment
+ (if fragment
+ (undo-tree-grow-backwards fragment nil region-changeset)
+ (make-undo-tree-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)))))))
+ (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
+ )))
+
+
+
+(defun undo-tree-adjust-elements-to-elt (node undo-elt &optional below)
+ "Adjust buffer positions of undo elements, starting at NODE's
+and going up the tree (or down the active branch if BELOW is
+non-nil) and through the nodes' undo elements until we reach
+UNDO-ELT. UNDO-ELT must appear somewhere in the undo changeset
+of either NODE itself or some node above it in the tree."
+ (let ((delta (list (undo-delta undo-elt)))
+ (undo-list (undo-tree-node-undo node)))
+ ;; adjust elements until we reach UNDO-ELT
+ (while (and (car undo-list)
+ (not (eq (car undo-list) undo-elt)))
+ (setcar undo-list
+ (undo-tree-apply-deltas (car undo-list) delta -1))
+ ;; move to next undo element in list, or to next node if we've run out
+ ;; of elements
+ (unless (car (setq undo-list (cdr undo-list)))
+ (if below
+ (setq node (nth (undo-tree-node-branch node)
+ (undo-tree-node-next node)))
+ (setq node (undo-tree-node-previous node)))
+ (setq undo-list (undo-tree-node-undo node))))))
+
+
+
+(defun undo-tree-apply-deltas (undo-elt deltas &optional sgn)
+ ;; Apply DELTAS in order to UNDO-ELT, multiplying deltas by SGN
+ ;; (only useful value for SGN is -1).
+ (let (position offset)
+ (dolist (delta deltas)
+ (setq position (car delta)
+ offset (* (cdr delta) (or sgn 1)))
+ (cond
+ ;; POSITION
+ ((integerp undo-elt)
+ (when (>= undo-elt position)
+ (setq undo-elt (- undo-elt offset))))
+ ;; nil (or any other atom)
+ ((atom undo-elt))
+ ;; (TEXT . POSITION)
+ ((stringp (car undo-elt))
+ (let ((text-pos (abs (cdr undo-elt)))
+ (point-at-end (< (cdr undo-elt) 0)))
+ (if (>= text-pos position)
+ (setcdr undo-elt (* (if point-at-end -1 1)
+ (- text-pos offset))))))
+ ;; (BEGIN . END)
+ ((integerp (car undo-elt))
+ (when (>= (car undo-elt) position)
+ (setcar undo-elt (- (car undo-elt) offset))
+ (setcdr undo-elt (- (cdr undo-elt) offset))))
+ ;; (nil PROPERTY VALUE BEG . END)
+ ((null (car undo-elt))
+ (let ((tail (nthcdr 3 undo-elt)))
+ (when (>= (car tail) position)
+ (setcar tail (- (car tail) offset))
+ (setcdr tail (- (cdr tail) offset)))))
+ ))
+ undo-elt))
+
+
+
+(defun undo-tree-repeated-undo-in-region-p (start end)
+ ;; Return non-nil if undo-in-region between START and END is a repeated
+ ;; undo-in-region
+ (let ((node (undo-tree-current buffer-undo-tree)))
+ (and (setq node
+ (nth (undo-tree-node-branch node) (undo-tree-node-next node)))
+ (eq (undo-tree-node-undo-beginning node) start)
+ (eq (undo-tree-node-undo-end node) end))))
+
+
+(defun undo-tree-repeated-redo-in-region-p (start end)
+ ;; Return non-nil if undo-in-region between START and END is a repeated
+ ;; undo-in-region
+ (let ((node (undo-tree-current buffer-undo-tree)))
+ (and (eq (undo-tree-node-redo-beginning node) start)
+ (eq (undo-tree-node-redo-end node) end))))
+
+
+;; Return non-nil if undo-in-region between START and END is simply
+;; reverting the last redo-in-region
+(defalias 'undo-tree-reverting-undo-in-region-p
+ 'undo-tree-repeated-undo-in-region-p)
+
+
+;; Return non-nil if redo-in-region between START and END is simply
+;; reverting the last undo-in-region
+(defalias 'undo-tree-reverting-redo-in-region-p
+ 'undo-tree-repeated-redo-in-region-p)
+
+
+
+
+;;; =====================================================================
;;; Undo-tree commands
(define-minor-mode undo-tree-mode
@@ -1327,104 +1957,194 @@ Within the undo-tree visualizer, the following keys
are available:
-(defun undo-tree-undo (&optional arg)
- "Undo changes. A numeric ARG serves as a repeat count."
- (interactive "p")
+(defun undo-tree-undo (&optional arg preserve-redo)
+ "Undo changes.
+Repeat this command to undo more changes.
+A numeric ARG serves as a repeat count.
+
+In Transient Mark mode when the mark is active, only undo changes
+within the current region. Similarly, when not in Transient Mark
+mode, just \\[universal-argument] as an argument limits undo to
+changes within the current region.
+
+A non-nil PRESERVE-REDO causes the existing redo record to be
+preserved, rather than replacing it with the new one generated by
+undoing."
+ (interactive "*P")
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t) (error "No undo information in this buffer"))
(let ((undo-in-progress t)
- current)
- ;; if `buffer-undo-tree' is empty, create initial undo-tree
- (when (null buffer-undo-tree)
- (setq buffer-undo-tree (make-undo-tree)))
+ (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'
(undo-list-transfer-to-tree)
- (dotimes (i (or arg 1))
- (setq current (undo-tree-current buffer-undo-tree))
+ (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
;; check if at top of undo tree
- (if (null (undo-tree-node-previous
- (undo-tree-current buffer-undo-tree)))
- (error "No further undo information")
- ;; remove any GC'd elements from node's undo list
- (setq current (undo-tree-current buffer-undo-tree))
- (decf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-undo current)))
- (setf (undo-tree-node-undo current)
- (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
- (incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-undo current)))
- ;; undo one record from undo tree
- (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
- ;; pop redo entries that `primitive-undo' has added to
- ;; `buffer-undo-list' and record them in current node's redo record,
- ;; replacing existing entry if one already exists
- (when (undo-tree-node-redo current)
+ (unless (undo-tree-node-previous (undo-tree-current buffer-undo-tree))
+ (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"))
+
+ ;; remove any GC'd elements from node's undo list
+ (setq current (undo-tree-current buffer-undo-tree))
+ (decf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-undo current)))
+ (setf (undo-tree-node-undo current)
+ (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
+ (incf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-undo current)))
+ ;; undo one record from undo tree
+ (when undo-in-region
+ (setq pos (set-marker (make-marker) (point)))
+ (set-marker-insertion-type pos t))
+ (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-undo current)))
+ (undo-boundary)
+
+ ;; if preserving old redo record, discard new redo entries that
+ ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
+ ;; elements from node's redo list
+ (if preserve-redo
+ (progn
+ (undo-list-pop-changeset)
+ (decf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-redo current)))
+ (setf (undo-tree-node-redo current)
+ (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
+ (incf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-redo current))))
+ ;; 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))))
(setf (undo-tree-node-redo current) (undo-list-pop-changeset))
(incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-redo current)))
- ;; rewind current node
- (setf (undo-tree-current buffer-undo-tree)
- (undo-tree-node-previous current))
- ;; update timestamp
- (setf (undo-tree-node-timestamp (undo-tree-current buffer-undo-tree))
- (current-time))))
-
+ (undo-list-byte-size (undo-tree-node-redo current))))
+
+ ;; 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))
+
+ ;; 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
+ ;; `transient-mark-mode'; if not, erase any leftover data
+ (if (not undo-in-region)
+ (undo-tree-node-clear-region-data current)
+ (goto-char pos)
+ ;; note: we deliberately want to store the region information in the
+ ;; node *below* the now current one
+ (setf (undo-tree-node-undo-beginning current) (region-beginning)
+ (undo-tree-node-undo-end current) (region-end))
+ (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!"))))
-(defun undo-tree-redo (&optional arg)
- "Redo changes. A numeric ARG serves as a repeat count."
+(defun undo-tree-redo (&optional arg preserve-undo)
+ "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")
;; throw error if undo is disabled in buffer
(when (eq buffer-undo-list t) (error "No undo information in this buffer"))
(let ((undo-in-progress t)
- current)
- ;; if `buffer-undo-tree' is empty, create initial undo-tree
- (when (null buffer-undo-tree)
- (setq buffer-undo-tree (make-undo-tree)))
+ (redo-in-region (or (region-active-p) (and arg (not (numberp arg)))))
+ pos current)
;; transfer entries accumulated in `buffer-undo-list' to
;; `buffer-undo-tree'
(undo-list-transfer-to-tree)
- (dotimes (i (or arg 1))
+ (dotimes (i (or (and (numberp arg) (prefix-numeric-value arg)) 1))
;; check if at bottom of undo tree
- (if (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
- (error "No further redo information")
- ;; advance current node
- (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))))
- ;; 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)))
- (setf (undo-tree-node-redo current)
- (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
- (incf (undo-tree-size buffer-undo-tree)
- (undo-list-byte-size (undo-tree-node-redo current)))
- ;; redo one record from undo tree
- (primitive-undo 1 (undo-tree-copy-list
- (undo-tree-node-redo current)))
- ;; pop undo entries that `primitive-undo' has added to
- ;; `buffer-undo-list' and record them in current node's undo record,
- ;; replacing existing entry if one already exists
+ (when (null (undo-tree-node-next (undo-tree-current buffer-undo-tree)))
+ (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"))
+
+ ;; advance current node
+ (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))))
+ ;; 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)))
+ (setf (undo-tree-node-redo current)
+ (undo-list-clean-GCd-elts (undo-tree-node-redo current)))
+ (incf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-redo current)))
+ ;; redo one record from undo tree
+ (when redo-in-region
+ (setq pos (set-marker (make-marker) (point)))
+ (set-marker-insertion-type pos t))
+ (primitive-undo 1 (undo-tree-copy-list (undo-tree-node-redo current)))
+ (undo-boundary)
+
+ ;; if preserving old undo record, discard new undo entries that
+ ;; `primitive-undo' has added to `buffer-undo-list', and remove any GC'd
+ ;; elements from node's redo list
+ (if preserve-undo
+ (progn
+ (undo-list-pop-changeset)
+ (decf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-undo current)))
+ (setf (undo-tree-node-undo current)
+ (undo-list-clean-GCd-elts (undo-tree-node-undo current)))
+ (incf (undo-tree-size buffer-undo-tree)
+ (undo-list-byte-size (undo-tree-node-undo current))))
+ ;; 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))))
(setf (undo-tree-node-undo current) (undo-list-pop-changeset))
(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))))
-
+ (undo-list-byte-size (undo-tree-node-undo current))))
+
+ ;; update timestamp
+ (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
+ ;; `transient-mark-mode'
+ (if (not redo-in-region)
+ (undo-tree-node-clear-region-data current)
+ (goto-char pos)
+ (setf (undo-tree-node-redo-beginning current) (region-beginning)
+ (undo-tree-node-redo-end current) (region-end))
+ (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!"))))
- [elpa] externals/undo-tree bff9f31 049/195: Made undo-tree-visualizer-quit select window displaying parent buffer, (continued)
- [elpa] externals/undo-tree bff9f31 049/195: Made undo-tree-visualizer-quit select window displaying parent buffer, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 04b1a6f 054/195: Fixed bugs in history-discarding logic., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 227473a 058/195: Modified undo-tree-node defstruct and macros to allow arbitrary meta-data, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 011e11e 061/195: Rebuild buffer-undo-list from tree when disabling undo-tree-mode., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree a4b591b 059/195: Indicate registers storing undo-tree state in visualizer., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 6ab787bd 063/195: Added explanation of undo-in-region to Commentary., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 99903d9 053/195: Made visualizer buffer name into a defconst,, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 2fd006f 055/195: Fixed bug in undo-tree-insert triggered by undo-tree-visualizer-set., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree e569c17 056/195: Added missing changelog entry., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 5d2f73c 057/195: Implemented support for marker entries in undo changesets!, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 0ed621d 062/195: Implemented undo-in-region.,
Stefan Monnier <=
- [elpa] externals/undo-tree 8b1bae6 060/195: Implemented keyboard selection in visualizer., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 309f4bc 066/195: Define region-active-p if not already defined, for compatibility, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree e32f45e 072/195: Use correct faces and show registers in visualizer when displaying timestamps., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 2bfab98 079/195: Bumped copyright year for new release., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree a93e78f 071/195: Discard position entries from changesets created by undoing or redoing., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 45380b2 087/195: Suppress branch point messages when undo/redoing from undo-tree-set., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree db55cea 068/195: Bumped compyright year and corrected license wording., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 3255044 065/195: Fixed bugs in undo-list-transfer-to-tree and undo-list-rebuild-from-tree, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 07e934a 080/195: Added term-mode to undo-tree-incompatible-major-modes., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree acd7549 070/195: Prevent global-undo-tree-mode being enabled in incompatible major-modes., Stefan Monnier, 2020/11/28