[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/undo-tree 6824805 064/195: Merge branch 'undo-in-region
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/undo-tree 6824805 064/195: Merge branch 'undo-in-region' |
|
Date: |
Sat, 28 Nov 2020 13:41:22 -0500 (EST) |
branch: externals/undo-tree
commit 6824805ff7686ab369e23a883eab3f4f884de43e
Merge: 011e11e 6ab787bd
Author: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>
Commit: Toby S. Cubitt <toby-undo-tree@dr-qubit.org>
Merge branch 'undo-in-region'
Conflicts:
undo-tree.el
---
undo-tree.el | 949 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 875 insertions(+), 74 deletions(-)
diff --git a/undo-tree.el b/undo-tree.el
index 5c72bce..5ee40ae 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
@@ -465,17 +465,150 @@
;;
;;
;;
-;; Drawbacks
-;; =========
+;; Undo-in-Region
+;; ==============
;;
-;; `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.
+;; 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
+;; produced by undoing-in-region naturally get added onto the end of the
+;; linear undo history:
+;;
+;; o
+;; |
+;; | x (second undo-in-region)
+;; o |
+;; | |
+;; | o (first undo-in-region)
+;; o |
+;; | /
+;; |/
+;; o
+;;
+;; You can of course redo these undos-in-region as usual, by undoing the
+;; undos:
+;;
+;; o
+;; |
+;; | o_
+;; o | \
+;; | | |
+;; | o o (undo the undo-in-region)
+;; o | |
+;; | / |
+;; |/ |
+;; 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.
+;;
+;; Previous undo history Undo-in-region
+;;
+;; o o
+;; | |
+;; | |
+;; o o
+;; | |\
+;; | | \
+;; o o x (undo-in-region)
+;; | | |
+;; | | |
+;; x o o
+;;
+;; As long as you don't change the active region after undoing-in-region,
+;; continuing to undo-in-region extends the new branch, pulling more changes
+;; that affect the current region into an undo step immediately above your
+;; current location in the undo tree, and pushing the point at which the new
+;; branch is attached further up the tree:
+;;
+;; First undo-in-region Second undo-in-region
+;;
+;; o o
+;; | |\
+;; | | \
+;; o o x (undo-in-region)
+;; |\ | |
+;; | \ | |
+;; o x o 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 (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.
+;;
+;; Previous undo history Redo-in-region
+;;
+;; o o
+;; | |
+;; | |
+;; x o
+;; | |\
+;; | | \
+;; o o x (redo-in-region)
+;; | | |
+;; | | |
+;; o o o
+;;
+;; As long as you don't change the active region after redoing-in-region,
+;; continuing to redo-in-region extends the new branch, pulling more redo
+;; changes into a redo step immediately below your current location in the
+;; undo tree.
+;;
+;; 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
+;;
+;; 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
+;; return to previous buffer states by switching to a previous branch of the
+;; tree.
;;; 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
@@ -817,11 +950,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))
@@ -837,6 +972,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)
@@ -934,12 +1151,12 @@ 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))
@@ -1470,6 +1687,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
@@ -1510,104 +2221,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 2ac4eac 181/195: Improve messages displayed to user when undo history is discarded., (continued)
- [elpa] externals/undo-tree 2ac4eac 181/195: Improve messages displayed to user when undo history is discarded., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 6a428ce 182/195: Bump copyright year in readiness for new release., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 7fb46cb 183/195: Fix copy-undo-tree by forcing vector rather than native defstruct., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 5011f91 186/195: Implement non-recursive undo-tree copier, to avoid hitting Elisp and c stack space limits., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 0161041 194/195: Fix argument order in gv setter definitions., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree bf2e9ba 195/195: Print complete objects when saving undo-tree history, Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 75b17c3 189/195: undo-outer-limit can also be null (no limit) in recent Emacsen., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 09641b2 188/195: Bump version number., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 1cc3a18 052/195: Minor documentation fix., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree fbcb046 085/195: Implemented persistent storage of undo history., Stefan Monnier, 2020/11/28
- [elpa] externals/undo-tree 6824805 064/195: Merge branch 'undo-in-region',
Stefan Monnier <=