1485 lines
58 KiB
EmacsLisp
1485 lines
58 KiB
EmacsLisp
;;; vundo.el --- Visual undo tree -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2019-2023 Free Software Foundation, Inc.
|
||
;;
|
||
;; Author: Yuan Fu <casouri@gmail.com>
|
||
;; Maintainer: Yuan Fu <casouri@gmail.com>
|
||
;; URL: https://github.com/casouri/vundo
|
||
;; Version: 2.4.0
|
||
;; Keywords: undo, text, editing
|
||
;; Package-Requires: ((emacs "28.1"))
|
||
;;
|
||
;; This file is part of GNU Emacs.
|
||
;;
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
;;
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
;;
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; Vundo (visual undo) displays the undo history as a tree and lets you
|
||
;; move in the tree to go back to previous buffer states. To use vundo,
|
||
;; type M-x vundo RET in the buffer you want to undo. An undo tree buffer
|
||
;; should pop up. To move around, type:
|
||
;;
|
||
;; f to go forward
|
||
;; b to go backward
|
||
;;
|
||
;; n to go to the node below when you at a branching point
|
||
;; p to go to the node above
|
||
;;
|
||
;; a to go back to the last branching point
|
||
;; w to go to the beginning of the next stem/branch
|
||
;; e to go forward to the end/tip of the branch
|
||
;; l to go to the last saved node
|
||
;; r to go to the next saved node
|
||
;;
|
||
;; m to mark the current node for diff
|
||
;; u to unmark the marked node
|
||
;; d to show a diff between the marked (or parent) and current nodes
|
||
;;
|
||
;; q to quit, you can also type C-g
|
||
;;
|
||
;; n/p may need some more explanation. In the following tree, n/p can
|
||
;; move between A and B because they share a parent (thus at a branching
|
||
;; point), but not C and D.
|
||
;;
|
||
;; A C
|
||
;; ──○──○──○──○──○
|
||
;; │ ↕
|
||
;; └──○──○──○
|
||
;; B D
|
||
;;
|
||
;; By default, you need to press RET to “commit” your change and if you
|
||
;; quit with q or C-g, the changes made by vundo are rolled back. You can
|
||
;; set `vundo-roll-back-on-quit' to nil to disable rolling back.
|
||
;;
|
||
;; Note: vundo.el requires Emacs 28.
|
||
;;
|
||
;; Customizable faces:
|
||
;;
|
||
;; - vundo-default
|
||
;; - vundo-node
|
||
;; - vundo-stem
|
||
;; - vundo-highlight
|
||
;;
|
||
;; If you want to use prettier Unicode characters to draw the tree like
|
||
;; this:
|
||
;;
|
||
;; ○──○──○
|
||
;; │ └──●
|
||
;; ├──○
|
||
;; └──○
|
||
;;
|
||
;; set vundo-glyph-alist by
|
||
;;
|
||
;; (setq vundo-glyph-alist vundo-unicode-symbols)
|
||
;;
|
||
;; Your default font needs to contain these Unicode characters, otherwise
|
||
;; they look terrible and don’t align. You can find a font that covers
|
||
;; these characters (eg, Symbola, Unifont), and set `vundo-default' face
|
||
;; to use that font:
|
||
;;
|
||
;; (set-face-attribute 'vundo-default nil :family "Symbola")
|
||
;;
|
||
;; Comparing to undo-tree:
|
||
;;
|
||
;; Vundo doesn’t need to be turned on all the time nor replace the undo
|
||
;; commands like undo-tree does. Vundo displays the tree horizontally,
|
||
;; whereas undo-tree displays a tree vertically.
|
||
|
||
;;; Developer:
|
||
;;
|
||
;; In the comments, when I say node, modification, mod, buffer state,
|
||
;; they all mean one thing: `vundo-m'. Ie, `vundo-m' represents
|
||
;; multiple things at once: it represents an modification recorded in
|
||
;; `buffer-undo-list', it represents the state of the buffer after
|
||
;; that modification took place, and it represents the node in the
|
||
;; undo tree in the vundo buffer representing that buffer state.
|
||
;;
|
||
;; The basic flow of the program:
|
||
;;
|
||
;; `vundo' calls `vundo--refresh-buffer' to setup the tree structure
|
||
;; and draw it in the buffer. We have two data structures:
|
||
;; `vundo--prev-mod-list' which stores a vector of `vundo-m'. This vector
|
||
;; is generated from `buffer-undo-list' by `vundo--mod-list-from'. We
|
||
;; also have a hash table `vundo--prev-mod-hash' generated by
|
||
;; `vundo--update-mapping', which maps undo-lists back to the
|
||
;; `vundo-m' object corresponding to it. Once we have the mod-list and
|
||
;; hash table, we connect the nodes in mod-list to form a tree in
|
||
;; `vundo--build-tree'. We build the tree by a simple observation:
|
||
;; only non-undo modifications creates new unique buffer states and
|
||
;; need to be drawn in the tree. For undo modifications, they
|
||
;; associate equivalent nodes.
|
||
;;
|
||
;; Once we have generated the data structure and drawn the tree, vundo
|
||
;; commands can move around in that tree by calling
|
||
;; `vundo--move-to-node'. It will construct the correct undo-list and
|
||
;; feed it to `primitive-undo'. `vundo--trim-undo-list' can trim the
|
||
;; undo list when possible.
|
||
;;
|
||
;; Finally, to avoid generating everything from scratch every time we
|
||
;; move on the tree, `vundo--refresh-buffer' can incrementally update
|
||
;; the data structures (`vundo--prev-mod-list' and
|
||
;; `vundo--prev-mod-hash'). If the undo list expands, we only process
|
||
;; the new entries, if the undo list shrinks (trimmed), we remove
|
||
;; modifications accordingly.
|
||
;;
|
||
;; For a high-level explanation of how this package works, see
|
||
;; https://archive.casouri.cat/note/2021/visual-undo-tree.
|
||
;;
|
||
;; Position-only records
|
||
;;
|
||
;; We know how undo works: when undoing, `primitive-undo' looks at
|
||
;; each record in `pending-undo-list' and modifies the buffer
|
||
;; accordingly, and that modification itself pushes new undo records
|
||
;; into `buffer-undo-list'. However, not all undo records introduce
|
||
;; modification, if the record is an integer, `primitive-undo' simply
|
||
;; `goto' that position, which introduces no modification to the
|
||
;; buffer and pushes no undo record to `buffer-undo-list'. Normally
|
||
;; position records accompany other buffer-modifying records, but if a
|
||
;; particular record consists of only position records, we have
|
||
;; trouble: after an undo step, `buffer-undo-list' didn’t grow, as far
|
||
;; as vundo tree-folding algorithm is concerned, we didn’t move.
|
||
;; Assertions expecting to see new undo records in `buffer-undo-list'
|
||
;; are also violated. To avoid all these complications, we ignore
|
||
;; position-only records when generating mod-list in
|
||
;; `vundo--mod-list-from'. These records are not removed, but they
|
||
;; can’t harm us now.
|
||
|
||
;;; Code:
|
||
|
||
(require 'pcase)
|
||
(require 'cl-lib)
|
||
(require 'seq)
|
||
(require 'subr-x)
|
||
|
||
;;; Customization
|
||
|
||
(defgroup vundo nil
|
||
"Visual undo tree."
|
||
:group 'undo)
|
||
|
||
(defface vundo-default '((t . (:inherit default)))
|
||
"Default face used in vundo buffer.")
|
||
|
||
(defface vundo-node '((t . (:inherit vundo-default)))
|
||
"Face for nodes in the undo tree.")
|
||
|
||
(defface vundo-stem '((t . (:inherit vundo-default)))
|
||
"Face for stems between nodes in the undo tree.")
|
||
|
||
(defface vundo-branch-stem
|
||
'((t (:inherit vundo-stem :weight bold)))
|
||
"Face for branching stems in the undo tree.")
|
||
|
||
(defface vundo-highlight
|
||
'((((background light)) .
|
||
(:inherit vundo-node :weight bold :foreground "red"))
|
||
(((background dark)) .
|
||
(:inherit vundo-node :weight bold :foreground "yellow")))
|
||
"Face for the highlighted node in the undo tree.")
|
||
|
||
(defface vundo-saved
|
||
'((((background light)) .
|
||
(:inherit vundo-node :foreground "dark green"))
|
||
(((background dark)) .
|
||
(:inherit vundo-node :foreground "light green")))
|
||
"Face for saved nodes in the undo tree.")
|
||
|
||
(defface vundo-last-saved
|
||
'((t (:inherit vundo-saved :weight bold)))
|
||
"Face for the last saved node in the undo tree.")
|
||
|
||
(defcustom vundo-roll-back-on-quit t
|
||
"If non-nil, vundo will roll back the change when it quits."
|
||
:type 'boolean)
|
||
|
||
(defcustom vundo-highlight-saved-nodes t
|
||
"If non-nil, vundo will highlight nodes which have been saved and then modified.
|
||
The face `vundo-saved' is used for saved nodes, except for the
|
||
most recent such node, which receives the face `vundo-last-saved'."
|
||
:type 'boolean)
|
||
|
||
(defcustom vundo-window-max-height 3
|
||
"The maximum height of the vundo window."
|
||
:type 'integer)
|
||
|
||
(defcustom vundo-window-side 'bottom
|
||
"The vundo window pops up on this side."
|
||
:type '(choice (const :tag "Bottom" bottom)
|
||
(const :tag "Top" top)))
|
||
|
||
;;;###autoload
|
||
(defconst vundo-ascii-symbols
|
||
'((selected-node . ?x)
|
||
(node . ?o)
|
||
(horizontal-stem . ?-)
|
||
(vertical-stem . ?|)
|
||
(branch . ?|)
|
||
(last-branch . ?`))
|
||
"ASCII symbols to draw vundo tree.")
|
||
|
||
;;;###autoload
|
||
(defconst vundo-unicode-symbols
|
||
'((selected-node . ?●)
|
||
(node . ?○)
|
||
(horizontal-stem . ?─)
|
||
(vertical-stem . ?│)
|
||
(branch . ?├)
|
||
(last-branch . ?└))
|
||
"Unicode symbols to draw vundo tree.")
|
||
|
||
(defcustom vundo-compact-display nil
|
||
"Show a more compact tree display if non-nil.
|
||
Basically we display
|
||
|
||
○─○─○ instead of ○──○──○
|
||
│ └─● │ └──●
|
||
├─○ ├──○
|
||
└─○ └──○"
|
||
:type 'boolean)
|
||
|
||
(defcustom vundo-glyph-alist vundo-ascii-symbols
|
||
"Alist mapping tree parts to characters used to draw a tree.
|
||
Keys are names for different parts of a tree, values are
|
||
characters for that part. Possible keys include
|
||
|
||
node which represents ○
|
||
selected-node which represents ●
|
||
horizontal-stem which represents ─
|
||
vertical-stem which represents │
|
||
branch which represents ├
|
||
last-branch which represents └
|
||
|
||
in a tree like
|
||
|
||
○──○──○
|
||
│ └──●
|
||
├──○
|
||
└──○
|
||
|
||
By default, the tree is drawn with ASCII characters like this:
|
||
|
||
o--o--o
|
||
| \\=`--x
|
||
|--o
|
||
\\=`--o
|
||
|
||
Set this variable to `vundo-unicode-symbols' to use Unicode
|
||
characters."
|
||
:type `(alist :tag "Translation alist"
|
||
:key-type (symbol :tag "Part of tree")
|
||
:value-type (character :tag "Draw using")
|
||
:options ,(mapcar #'car vundo-unicode-symbols)))
|
||
|
||
(defcustom vundo-pre-enter-hook nil
|
||
"List of functions to call when entering vundo.
|
||
This hook runs immediately after ‘vundo’ is called, in the buffer
|
||
the user invoked ‘vundo’, before every setup ‘vundo’ does."
|
||
:type 'hook)
|
||
|
||
(defcustom vundo-post-exit-hook nil
|
||
"List of functions to call when exiting vundo.
|
||
This hook runs in the original buffer the user invoked ‘vundo’,
|
||
after all the clean up the exiting function does. Ie, it is the
|
||
very last thing that happens when vundo exits."
|
||
:type 'hook)
|
||
|
||
(defcustom vundo-diff-setup-hook nil
|
||
"List of functions to call after creating a diff buffer.
|
||
This hook runs in the ‘vundo-diff’ buffer immediately after it's setup,
|
||
both for new or existing buffers. This may be used to
|
||
manipulate the diff or transform its contents."
|
||
:type 'hook)
|
||
|
||
;;; Undo list to mod list
|
||
|
||
(cl-defstruct vundo-m
|
||
"A modification in undo history.
|
||
This object serves two purpose: it represents a modification in
|
||
undo history, and it also represents the buffer state after the
|
||
modification."
|
||
(idx
|
||
nil
|
||
:type integer
|
||
:documentation "The index of this modification in history.")
|
||
(children
|
||
nil
|
||
:type proper-list
|
||
:documentation "Children in tree.")
|
||
(parent
|
||
nil
|
||
:type vundo-m
|
||
:documentation "Parent in tree.")
|
||
(prev-eqv
|
||
nil
|
||
:type vundo-m
|
||
:documentation "The previous equivalent state.")
|
||
(next-eqv
|
||
nil
|
||
:type vundo-m
|
||
:documentation "The next equivalent state.")
|
||
(undo-list
|
||
nil
|
||
:type cons
|
||
:documentation "The undo-list at this modification.")
|
||
(point
|
||
nil
|
||
:type integer
|
||
:documentation "Marks the text node in the vundo buffer if drawn.")
|
||
(timestamp
|
||
nil
|
||
:type timestamp
|
||
:documentation
|
||
"Timestamp at which this mod altered a saved buffer state.
|
||
If this field is non-nil, the mod contains a timestamp entry in
|
||
the undo list, meaning the previous state was saved to file. This
|
||
field records that timestamp."))
|
||
|
||
(defun vundo--position-only-p (undo-list)
|
||
"Check if the records at the start of UNDO-LIST are position-only.
|
||
Position-only means all records until to the next undo
|
||
boundary are position records. Position record is just an
|
||
integer (see `buffer-undo-list'). Assumes the first element
|
||
of UNDO-LIST is not nil."
|
||
(let ((pos-only t))
|
||
(while (car undo-list)
|
||
(when (not (integerp (pop undo-list)))
|
||
(setq pos-only nil)
|
||
(setq undo-list nil)))
|
||
pos-only))
|
||
|
||
(defun vundo--mod-list-from (undo-list &optional n mod-list)
|
||
"Generate and return a modification list from UNDO-LIST.
|
||
If N non-nil, only look at the first N entries in UNDO-LIST.
|
||
If MOD-LIST non-nil, extend on MOD-LIST."
|
||
(let ((uidx 0)
|
||
(mod-list (or mod-list (vector (make-vundo-m))))
|
||
new-mlist)
|
||
(while (and undo-list (or (null n) (< uidx n)))
|
||
;; Skip leading nils.
|
||
(while (and undo-list (null (car undo-list)))
|
||
(setq undo-list (cdr undo-list))
|
||
(cl-incf uidx))
|
||
;; It's possible the index was exceeded stepping over nil.
|
||
(when (or (null n) (< uidx n))
|
||
;; Add modification.
|
||
(let ((pos-only (vundo--position-only-p undo-list))
|
||
(mod-timestamp nil))
|
||
(unless pos-only
|
||
;; If this record is position-only, we skip it and don’t
|
||
;; add a mod for it. Effectively taking it out of the undo
|
||
;; tree. Read ‘Position-only records’ section in
|
||
;; Commentary for more explanation.
|
||
(cl-assert (not (null (car undo-list))))
|
||
(push (make-vundo-m :undo-list undo-list)
|
||
new-mlist))
|
||
;; Skip through the content of this modification.
|
||
(while (car undo-list)
|
||
;; Is this entry a timestamp?
|
||
(when (and (consp (car undo-list)) (eq (caar undo-list) t))
|
||
(setq mod-timestamp (cdar undo-list)))
|
||
(setq undo-list (cdr undo-list))
|
||
(cl-incf uidx))
|
||
;; If this modification contains a timestamp, the previous
|
||
;; state is saved to file.
|
||
(when (and mod-timestamp (not pos-only))
|
||
(setf (vundo-m-timestamp (car new-mlist)) mod-timestamp)))))
|
||
;; Convert to vector.
|
||
(vconcat mod-list new-mlist)))
|
||
|
||
(defun vundo--update-mapping (mod-list &optional hash-table n)
|
||
"Update each modification in MOD-LIST.
|
||
Add :idx for each modification, map :undo-list back to each
|
||
modification in HASH-TABLE. If N non-nil, start from the Nth
|
||
modification in MOD-LIST. Return HASH-TABLE."
|
||
(let ((hash-table (or hash-table
|
||
(make-hash-table :test #'eq :weakness t))))
|
||
(cl-loop for midx from (or n 0) to (1- (length mod-list))
|
||
for mod = (aref mod-list midx)
|
||
do (cl-assert (null (vundo-m-idx mod)))
|
||
do (cl-assert (null (gethash (vundo-m-undo-list mod)
|
||
hash-table)))
|
||
do (setf (vundo-m-idx mod) midx)
|
||
do (puthash (vundo-m-undo-list mod) mod hash-table))
|
||
hash-table))
|
||
|
||
;;; Mod list to tree
|
||
;;
|
||
;; If node a, b, c are in the same equivalent list, they represents
|
||
;; identical buffer states. For example, in the figure below, node 3
|
||
;; and 5 are in the same equivalent list:
|
||
;;
|
||
;; |
|
||
;; 3 5
|
||
;; | /
|
||
;; |/
|
||
;; 4
|
||
;;
|
||
;; We know 3 and 5 are in the same equivalent list because 5 maps to 3
|
||
;; in `undo-equiv-table' (basically).
|
||
|
||
(defun vundo--master-eqv-mod-of (mod)
|
||
"Return the master mod in the eqv-list of MOD.
|
||
Master mod is the mod with the smallest index in the eqv-list.
|
||
This function is equivalent to (car (vundo--eqv-list-of mod))."
|
||
(while (vundo-m-prev-eqv mod)
|
||
(cl-assert (not (eq mod (vundo-m-prev-eqv mod))))
|
||
(setq mod (vundo-m-prev-eqv mod)))
|
||
mod)
|
||
|
||
(defun vundo--eqv-list-of (mod)
|
||
"Return all the modifications equivalent to MOD."
|
||
(while (vundo-m-next-eqv mod)
|
||
(cl-assert (not (eq mod (vundo-m-next-eqv mod))))
|
||
(setq mod (vundo-m-next-eqv mod)))
|
||
;; Start at the last mod in the equiv chain, walk back to the first.
|
||
(let ((eqv-list (list mod)))
|
||
(while (vundo-m-prev-eqv mod)
|
||
(cl-assert (not (eq mod (vundo-m-prev-eqv mod))))
|
||
(setq mod (vundo-m-prev-eqv mod))
|
||
(push mod eqv-list))
|
||
eqv-list))
|
||
|
||
(defun vundo--eqv-merge (mlist)
|
||
"Connect modifications in MLIST to be in the same equivalence list.
|
||
Order is preserved."
|
||
;; Basically, for MLIST = (A B C), set
|
||
;; A.prev = nil A.next = B
|
||
;; B.prev = A B.next = C
|
||
;; C.prev = B C.next = nil
|
||
(cl-loop for this-tail = mlist then (cdr this-tail)
|
||
for next-tail = (cdr mlist) then (cdr next-tail)
|
||
for prev-tail = (cons nil mlist) then (cdr prev-tail)
|
||
while this-tail
|
||
do (setf (vundo-m-prev-eqv (car this-tail)) (car prev-tail))
|
||
do (setf (vundo-m-next-eqv (car this-tail)) (car next-tail))))
|
||
|
||
(defun vundo--sort-mod (mlist &optional reverse)
|
||
"Return sorted modifications in MLIST by their idx...
|
||
...in ascending order. If REVERSE non-nil, sort in descending
|
||
order."
|
||
(seq-sort (if reverse
|
||
(lambda (m1 m2)
|
||
(> (vundo-m-idx m1) (vundo-m-idx m2)))
|
||
(lambda (m1 m2)
|
||
(< (vundo-m-idx m1) (vundo-m-idx m2))))
|
||
mlist))
|
||
|
||
(defun vundo--eqv-merge-mod (m1 m2)
|
||
"Put M1 and M2 into the same equivalence list."
|
||
(let ((l1 (vundo--eqv-list-of m1))
|
||
(l2 (vundo--eqv-list-of m2)))
|
||
(vundo--eqv-merge (vundo--sort-mod (cl-union l1 l2)))))
|
||
|
||
(defun vundo--build-tree (mod-list mod-hash &optional from)
|
||
"Connect equivalent modifications and build the tree in MOD-LIST.
|
||
MOD-HASH maps undo-lists to modifications.
|
||
If FROM non-nil, build from FROM-th modification in MOD-LIST."
|
||
(cl-loop
|
||
for m from (or from 0) to (1- (length mod-list))
|
||
for mod = (aref mod-list m)
|
||
;; If MOD is an undo, the buffer state it represents is equivalent
|
||
;; to a previous one.
|
||
do (let ((prev-undo (undo--last-change-was-undo-p
|
||
(vundo-m-undo-list mod))))
|
||
(pcase prev-undo
|
||
;; This is an undo. Merge it with its equivalent nodes.
|
||
((and (pred consp)
|
||
;; It is possible for us to not find the PREV-UNDO in
|
||
;; our mod-list: if Emacs garbage collected prev-m,
|
||
;; then it will not end up in mod-list. NOTE: Is it
|
||
;; also possible that unable to find PREV-M is an
|
||
;; error? Maybe, but I think that's highly unlikely.
|
||
(guard (gethash prev-undo mod-hash)))
|
||
(let ((prev-m (gethash prev-undo mod-hash)))
|
||
(vundo--eqv-merge-mod prev-m mod)))
|
||
;; This undo undoes to root, merge with the root node.
|
||
('t (vundo--eqv-merge-mod (aref mod-list 0) mod))
|
||
;; This modification either is a region-undo, nil undo, or
|
||
;; not an undo. We treat them the same.
|
||
((or 'undo-in-region 'empty _)
|
||
;; If MOD isn't an undo, it represents a new buffer state,
|
||
;; we connect M-1 with M, where M-1 is the parent and M is
|
||
;; the child.
|
||
(unless (eq m 0)
|
||
(let* ((m-1 (aref mod-list (1- m)))
|
||
(min-eqv-mod (vundo--master-eqv-mod-of m-1)))
|
||
(setf (vundo-m-parent mod) min-eqv-mod)
|
||
(let ((children (vundo-m-children min-eqv-mod)))
|
||
;; If everything goes right, we should never encounter
|
||
;; this.
|
||
(cl-assert (not (memq mod children)))
|
||
(setf (vundo-m-children min-eqv-mod)
|
||
;; We sort in reverse order, i.e. later mod
|
||
;; comes first. Later in `vundo--build-tree' we
|
||
;; draw the tree depth-first.
|
||
(vundo--sort-mod (cons mod children)
|
||
'reverse))))))))))
|
||
|
||
;;; Timestamps
|
||
|
||
;; buffer-undo-list contains "timestamp entries" within a record like
|
||
;; (t . TIMESTAMP). These capture the file modification time of the
|
||
;; saved file which that undo changed (i.e. the TIMESTAMP applies to
|
||
;; the prior state). While reading the undo list, we collect these,
|
||
;; sort them, and during tree draw, indicate nodes which had been
|
||
;; saved specially. Note that the buffer associated with the current
|
||
;; node can be saved, but not yet modified by an undo/redo; this is
|
||
;; handled specially.
|
||
|
||
(defvar-local vundo--timestamps nil
|
||
"An alist mapping mods to modification times.
|
||
|
||
When there are multiple mods corresponding to the same node in
|
||
the undo tree, use the master equivalent mod as the
|
||
key (‘vundo--master-eqv-mod-of’).
|
||
|
||
Sorted by time, with latest saved mods first. Only undo-based
|
||
modification times are included; see `vundo--node-timestamp'.")
|
||
|
||
(defun vundo--record-timestamps (mod-list)
|
||
"Return an alist mapping mods in MOD-LIST to timestamps.
|
||
The alist is sorted by time, with latest saved mods first."
|
||
(let ((timestamps ()))
|
||
(cl-loop for idx from 1 below (length mod-list)
|
||
for ts = (vundo-m-timestamp (aref mod-list idx))
|
||
if ts do
|
||
(let* ((mod-node (aref mod-list (1- idx)))
|
||
(master (vundo--master-eqv-mod-of mod-node))
|
||
(entry (assq master timestamps))
|
||
(old-ts (cdr entry)))
|
||
(when (and old-ts (time-less-p ts old-ts))
|
||
;; Equivalent node modified again? take the newer time.
|
||
(setq ts old-ts))
|
||
(if entry (setcdr entry ts)
|
||
(push (cons master ts) timestamps))))
|
||
(sort timestamps ; Sort latest first.
|
||
(lambda (a b) (time-less-p (cdr b) (cdr a))))))
|
||
|
||
(defun vundo--find-last-saved (node &optional arg)
|
||
"Return the last saved node prior to NODE.
|
||
ARG (default 1) specifies the number of saved nodes to move
|
||
backwards in history. ARG<0 indicates moving that many saved
|
||
nodes forward in history. Returns nil if no such saved node
|
||
exists."
|
||
(let* ((arg (or arg 1))
|
||
(past (>= arg 0))
|
||
(cnt (abs arg))
|
||
(master (vundo--master-eqv-mod-of node))
|
||
(midx (vundo-m-idx master))
|
||
last-node)
|
||
(if (assq master vundo--timestamps)
|
||
(setq last-node master)
|
||
;; No timestamp here, find closest master idx on saved list in
|
||
;; the direction indicated by ARG.
|
||
(cl-loop with val = (if past -1 most-positive-fixnum)
|
||
with between = (if past #'< #'>)
|
||
for (n . _) in vundo--timestamps
|
||
for idx = (vundo-m-idx n)
|
||
if (funcall between val idx midx)
|
||
do (setq val idx last-node n))
|
||
;; Use up one count when getting started.
|
||
(when last-node (setq cnt (1- cnt))))
|
||
|
||
;; Found one, but more to go.
|
||
(if (and last-node (> cnt 0))
|
||
(let ((vt (if past vundo--timestamps
|
||
(reverse vundo--timestamps))))
|
||
(while (and vt (not (eq (caar vt) last-node)))
|
||
(setq vt (cdr vt)))
|
||
(caar (nthcdr cnt vt)))
|
||
last-node)))
|
||
|
||
(defvar vundo--orig-buffer)
|
||
(defun vundo--node-timestamp (mod-list node &optional no-buffer)
|
||
"Return a timestamp from MOD-LIST for NODE, if any.
|
||
In addition to undo-based timestamps, this includes the modtime
|
||
of the current buffer (if it has an associated file which is
|
||
unmodified), unless NO-BUFFER is non-nil."
|
||
(when-let ((master (vundo--master-eqv-mod-of node)))
|
||
(or (alist-get master vundo--timestamps nil nil #'eq)
|
||
(and (eq node (vundo--current-node mod-list))
|
||
(with-current-buffer vundo--orig-buffer
|
||
(and (not no-buffer) (buffer-file-name)
|
||
(not (buffer-modified-p))
|
||
(visited-file-modtime)))))))
|
||
|
||
;;; Draw tree
|
||
|
||
(defun vundo--put-node-at-point (node)
|
||
"Store the corresponding NODE as text property at point."
|
||
(put-text-property (1- (point)) (point)
|
||
'vundo-node
|
||
node))
|
||
|
||
(defun vundo--get-node-at-point ()
|
||
"Retrieve the corresponding NODE as text property at point."
|
||
(plist-get (text-properties-at (1- (point)))
|
||
'vundo-node))
|
||
|
||
(defun vundo--next-line-at-column (col)
|
||
"Move point to next line column COL."
|
||
(unless (and (eq 0 (forward-line))
|
||
(not (eobp)))
|
||
(goto-char (point-max))
|
||
(insert "\n"))
|
||
(move-to-column col)
|
||
(unless (eq (current-column) col)
|
||
(let ((indent-tabs-mode nil))
|
||
(indent-to-column col))))
|
||
|
||
(defun vundo--translate (text)
|
||
"Translate each character in TEXT and return translated TEXT.
|
||
Translate according to `vundo-glyph-alist'."
|
||
(seq-mapcat (lambda (ch)
|
||
(char-to-string
|
||
(alist-get
|
||
(pcase ch
|
||
(?○ 'node)
|
||
(?● 'selected-node)
|
||
(?─ 'horizontal-stem)
|
||
(?│ 'vertical-stem)
|
||
(?├ 'branch)
|
||
(?└ 'last-branch))
|
||
vundo-glyph-alist)))
|
||
text 'string))
|
||
|
||
(defun vundo--draw-tree (mod-list)
|
||
"Draw the tree in MOD-LIST in current buffer."
|
||
(let* ((root (aref mod-list 0))
|
||
(node-queue (list root))
|
||
(inhibit-read-only t)
|
||
(inhibit-modification-hooks t))
|
||
(erase-buffer)
|
||
(while node-queue
|
||
(let* ((node (pop node-queue))
|
||
(children (vundo-m-children node))
|
||
(parent (vundo-m-parent node))
|
||
(siblings (and parent (vundo-m-children parent)))
|
||
(only-child-p (and parent (eq (length siblings) 1)))
|
||
(node-last-child-p (and parent (eq node (car (last siblings)))))
|
||
(mod-ts (vundo--node-timestamp mod-list node 'no-buffer))
|
||
(node-face (if (and vundo-highlight-saved-nodes mod-ts)
|
||
'vundo-saved 'vundo-node))
|
||
(stem-face (if only-child-p 'vundo-stem 'vundo-branch-stem)))
|
||
;; Go to parent.
|
||
(if parent (goto-char (vundo-m-point parent)))
|
||
(let ((room-for-another-rx
|
||
(rx-to-string
|
||
`(or (>= ,(if vundo-compact-display 3 4) ?\s) eol))))
|
||
(if (null parent)
|
||
(insert (propertize (vundo--translate "○")
|
||
'face node-face))
|
||
(let ((planned-point (point)))
|
||
;; If a node is blocking, try next line.
|
||
;; Example: 1--2--3 Here we want to add a
|
||
;; | child to 1 but is blocked
|
||
;; +--4 by that plus sign.
|
||
(while (not (looking-at room-for-another-rx))
|
||
(vundo--next-line-at-column (max 0 (1- (current-column))))
|
||
;; When we go down, we could encounter space, EOL, │,
|
||
;; ├, or └. Space and EOL should be replaced by │, ├
|
||
;; and └ should be replaced by ├.
|
||
(let ((replace-char
|
||
(if (looking-at
|
||
(rx-to-string
|
||
`(or ,(vundo--translate "├")
|
||
,(vundo--translate "└"))))
|
||
(vundo--translate "├")
|
||
(vundo--translate "│"))))
|
||
(unless (eolp) (delete-char 1))
|
||
(insert (propertize replace-char 'face stem-face))))
|
||
;; Make room for inserting the new node.
|
||
(unless (looking-at "$")
|
||
(delete-char (if vundo-compact-display 2 3)))
|
||
;; Insert the new node.
|
||
(if (eq (point) planned-point)
|
||
(insert (propertize
|
||
(vundo--translate
|
||
(if vundo-compact-display "─" "──"))
|
||
'face stem-face)
|
||
(propertize (vundo--translate "○")
|
||
'face node-face))
|
||
;; We must break the line. Delete the previously
|
||
;; inserted char.
|
||
(delete-char -1)
|
||
(insert (propertize
|
||
(vundo--translate
|
||
(if node-last-child-p
|
||
(if vundo-compact-display "└─" "└──")
|
||
(if vundo-compact-display "├─" "├──")))
|
||
'face stem-face))
|
||
(insert (propertize (vundo--translate "○")
|
||
'face node-face))))))
|
||
;; Store point so we can later come back to this node.
|
||
(setf (vundo-m-point node) (point))
|
||
;; Associate the text node in buffer with the node object.
|
||
(vundo--put-node-at-point node)
|
||
;; Depth-first search.
|
||
(setq node-queue (append children node-queue))))))
|
||
|
||
;;; Vundo buffer and invocation
|
||
|
||
(defun vundo--buffer ()
|
||
"Return the vundo buffer."
|
||
(get-buffer-create " *vundo tree*"))
|
||
|
||
(defun vundo--kill-buffer-if-point-left (window)
|
||
"Kill the vundo buffer if point left WINDOW.
|
||
WINDOW is the window that was/is displaying the vundo buffer."
|
||
(if (and (eq (window-buffer window) (vundo--buffer))
|
||
(not (eq window (selected-window))))
|
||
(with-selected-window window
|
||
(kill-buffer-and-window))))
|
||
|
||
(declare-function vundo-diff "vundo-diff")
|
||
(declare-function vundo-diff-mark "vundo-diff")
|
||
(declare-function vundo-diff-unmark "vundo-diff")
|
||
(defvar vundo-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (kbd "f") #'vundo-forward)
|
||
(define-key map (kbd "<right>") #'vundo-forward)
|
||
(define-key map (kbd "b") #'vundo-backward)
|
||
(define-key map (kbd "<left>") #'vundo-backward)
|
||
(define-key map (kbd "n") #'vundo-next)
|
||
(define-key map (kbd "<down>") #'vundo-next)
|
||
(define-key map (kbd "p") #'vundo-previous)
|
||
(define-key map (kbd "<up>") #'vundo-previous)
|
||
(define-key map (kbd "a") #'vundo-stem-root)
|
||
(define-key map (kbd "w") #'vundo-next-root)
|
||
(define-key map (kbd "e") #'vundo-stem-end)
|
||
(define-key map (kbd "l") #'vundo-goto-last-saved)
|
||
(define-key map (kbd "r") #'vundo-goto-next-saved)
|
||
(define-key map (kbd "q") #'vundo-quit)
|
||
(define-key map (kbd "C-g") #'vundo-quit)
|
||
(define-key map (kbd "RET") #'vundo-confirm)
|
||
(define-key map (kbd "m") #'vundo-diff-mark)
|
||
(define-key map (kbd "u") #'vundo-diff-unmark)
|
||
(define-key map (kbd "d") #'vundo-diff)
|
||
(define-key map (kbd "i") #'vundo--inspect)
|
||
(define-key map (kbd "D") #'vundo--debug)
|
||
|
||
(define-key map [remap save-buffer] #'vundo-save)
|
||
map)
|
||
"Keymap for `vundo-mode'.")
|
||
|
||
(define-derived-mode vundo-mode special-mode
|
||
"Vundo" "Mode for displaying the undo tree."
|
||
(setq mode-line-format nil
|
||
truncate-lines t
|
||
cursor-type nil)
|
||
(jit-lock-mode nil)
|
||
(face-remap-add-relative 'default 'vundo-default)
|
||
|
||
;; Disable evil-mode, as normal-mode
|
||
;; key bindings override the ones set by vundo.
|
||
(when (and (boundp 'evil-emacs-state-modes)
|
||
(not (memq 'vundo-mode evil-emacs-state-modes)))
|
||
(push 'vundo-mode evil-emacs-state-modes)))
|
||
|
||
(defvar-local vundo--first-undo nil
|
||
"The ‘undo-list’ field of the first ever ‘vundo-m’ for this buffer.
|
||
|
||
This is used to detect truncated undo list by gc.")
|
||
|
||
(defvar-local vundo--prev-mod-list nil
|
||
"Modification list generated by `vundo--mod-list-from'.")
|
||
(defvar-local vundo--prev-mod-hash nil
|
||
"Modification hash table generated by `vundo--update-mapping'.")
|
||
(defvar-local vundo--prev-undo-list nil
|
||
"Original buffer's `buffer-undo-list'.")
|
||
(defvar-local vundo--orig-buffer nil
|
||
"Vundo buffer displays the undo tree for this buffer.")
|
||
(defvar-local vundo--message nil
|
||
"If non-nil, print information when moving between nodes.")
|
||
(defvar-local vundo--roll-back-to-this nil
|
||
"Vundo will roll back to this node.")
|
||
(defvar-local vundo--highlight-overlay nil
|
||
"Overlay used to highlight the selected node.")
|
||
(defvar-local vundo--highlight-last-saved-overlay nil
|
||
"Overlay used to highlight the last saved node.")
|
||
|
||
(defun vundo--mod-list-trim (mod-list n)
|
||
"Remove MODS from MOD-LIST.
|
||
Keep the first N modifications."
|
||
(cl-loop for midx from (1+ n) to (1- (length mod-list))
|
||
for mod = (aref mod-list midx)
|
||
do (let ((parent (vundo-m-parent mod))
|
||
(eqv-list (vundo--eqv-list-of mod)))
|
||
(when parent
|
||
(setf (vundo-m-children parent)
|
||
(remove mod (vundo-m-children parent))))
|
||
(when eqv-list
|
||
(vundo--eqv-merge (remove mod eqv-list)))))
|
||
(seq-subseq mod-list 0 (1+ n)))
|
||
|
||
(defun vundo--refresh-buffer
|
||
(orig-buffer vundo-buffer &optional incremental)
|
||
"Refresh VUNDO-BUFFER with the undo history of ORIG-BUFFER.
|
||
If INCREMENTAL non-nil, reuse existing mod-list and mod-hash.
|
||
INCREMENTAL is only applicable when entries are either added or
|
||
removed from undo-list. On the other hand, if some entries are
|
||
removed and some added, do not use INCREMENTAL.
|
||
|
||
This function modifies `vundo--prev-mod-list',
|
||
`vundo--prev-mod-hash', `vundo--prev-undo-list',
|
||
`vundo--orig-buffer'."
|
||
(with-current-buffer vundo-buffer
|
||
;; 1. Setting these to nil makes `vundo--mod-list-from',
|
||
;; `vundo--update-mapping' and `vundo--build-tree' starts from
|
||
;; scratch.
|
||
(when (not incremental)
|
||
(setq vundo--prev-undo-list nil
|
||
vundo--prev-mod-list nil
|
||
vundo--prev-mod-hash nil)
|
||
;; Give the garbage collector a chance to release
|
||
;; `buffer-undo-list': GC cannot release cons cells when all
|
||
;; these stuff are referring to it.
|
||
(garbage-collect))
|
||
(let ((undo-list (buffer-local-value
|
||
'buffer-undo-list orig-buffer))
|
||
mod-list
|
||
mod-hash
|
||
(latest-state (and vundo--prev-mod-list
|
||
(vundo--latest-buffer-state
|
||
vundo--prev-mod-list)))
|
||
(inhibit-read-only t))
|
||
;; 2. Here we consider two cases, adding more nodes (or starting
|
||
;; from scratch) or removing nodes. In both cases, we update and
|
||
;; set MOD-LIST and MOD-HASH. We don't need to worry about the
|
||
;; garbage collector trimming the end of `buffer-undo-list': if
|
||
;; we are generating MOD-LIST from scratch, it will work as
|
||
;; normal, if we are generating incrementally,
|
||
;; `vundo--prev-undo-list' holds the untrimmed undo list.
|
||
(if-let ((new-tail (and vundo--prev-mod-hash
|
||
(gethash (vundo--sans-nil undo-list)
|
||
vundo--prev-mod-hash))))
|
||
;; a) Removing.
|
||
(setq mod-list (vundo--mod-list-trim vundo--prev-mod-list
|
||
(vundo-m-idx new-tail))
|
||
mod-hash vundo--prev-mod-hash)
|
||
;; b) Adding.
|
||
(let ((diff (- (length undo-list)
|
||
(length vundo--prev-undo-list))))
|
||
(cl-assert (eq vundo--prev-undo-list (nthcdr diff undo-list)))
|
||
(setq mod-list (vundo--mod-list-from
|
||
undo-list diff vundo--prev-mod-list)
|
||
mod-hash (vundo--update-mapping
|
||
mod-list vundo--prev-mod-hash
|
||
(length vundo--prev-mod-list)))
|
||
;; Build tree.
|
||
(vundo--build-tree mod-list mod-hash
|
||
(length vundo--prev-mod-list))))
|
||
|
||
;; Update cache.
|
||
(setq vundo--prev-mod-list mod-list
|
||
vundo--prev-mod-hash mod-hash
|
||
vundo--prev-undo-list undo-list
|
||
vundo--orig-buffer orig-buffer)
|
||
|
||
;; Record timestamps
|
||
(setq vundo--timestamps (vundo--record-timestamps mod-list))
|
||
|
||
;; 3. Render buffer. We don't need to redraw the tree if there
|
||
;; is no change to the nodes.
|
||
(unless (eq (vundo--latest-buffer-state mod-list) latest-state)
|
||
(vundo--draw-tree mod-list))
|
||
|
||
;; Highlight current node.
|
||
(vundo--highlight-node (vundo--current-node mod-list))
|
||
(goto-char (vundo-m-point (vundo--current-node mod-list)))
|
||
|
||
;; Highlight the last saved node extra specially
|
||
(when vundo-highlight-saved-nodes
|
||
(vundo--highlight-last-saved-node mod-list vundo--timestamps))
|
||
|
||
;; Call out truncated undo tree.
|
||
(let ((first-undo (buffer-local-value
|
||
'vundo--first-undo orig-buffer))
|
||
(current-first-undo
|
||
;; We actually use the second vundo-m, because the
|
||
;; ‘undo-list’ of the first vundo-m is always nil.
|
||
(vundo-m-undo-list (aref mod-list 1))))
|
||
(when (and first-undo (not (eq first-undo current-first-undo)))
|
||
(message "⚠️ The undo-list of this buffer is truncated by garbage collection, to prevent this from happening again, consider increasing ‘undo-limit’"))
|
||
(when (or (not first-undo)
|
||
(and first-undo (not (eq first-undo
|
||
current-first-undo))))
|
||
(with-current-buffer orig-buffer
|
||
(setq vundo--first-undo
|
||
(vundo-m-undo-list (aref mod-list 1)))))))))
|
||
|
||
(defun vundo--current-node (mod-list)
|
||
"Return the currently highlighted node in MOD-LIST."
|
||
(vundo--master-eqv-mod-of (aref mod-list (1- (length mod-list)))))
|
||
|
||
(defun vundo--highlight-node (node)
|
||
"Highlight NODE as current node."
|
||
(unless vundo--highlight-overlay
|
||
(setq vundo--highlight-overlay
|
||
(make-overlay (1- (vundo-m-point node)) (vundo-m-point node)))
|
||
(overlay-put vundo--highlight-overlay
|
||
'display (vundo--translate "●"))
|
||
(overlay-put vundo--highlight-overlay
|
||
'face 'vundo-highlight)
|
||
;; Make current node’s highlight override last saved node’s
|
||
;; highlight, should they collide.
|
||
(overlay-put vundo--highlight-overlay 'priority 2))
|
||
(move-overlay vundo--highlight-overlay
|
||
(1- (vundo-m-point node))
|
||
(vundo-m-point node)))
|
||
|
||
(defun vundo--highlight-last-saved-node (mod-list timestamps)
|
||
"Highlight the last (latest) saved node on MOD-LIST.
|
||
Consults the alist of TIMESTAMPS. This moves the overlay
|
||
`vundo--highlight-last-saved-overlay'."
|
||
(let* ((last-saved (car timestamps))
|
||
(cur (vundo--current-node mod-list))
|
||
(cur-ts (vundo--node-timestamp mod-list cur))
|
||
(node (cond ((and last-saved cur-ts)
|
||
(if (time-less-p (cdr last-saved) cur-ts)
|
||
cur (car last-saved)))
|
||
(last-saved (car last-saved))
|
||
(cur-ts cur)
|
||
(t nil)))
|
||
(node-pt (and node (vundo-m-point node))))
|
||
(when node-pt
|
||
(unless vundo--highlight-last-saved-overlay
|
||
(setq vundo--highlight-last-saved-overlay
|
||
(make-overlay (1- node-pt) node-pt))
|
||
(overlay-put vundo--highlight-last-saved-overlay
|
||
'face 'vundo-last-saved))
|
||
(move-overlay vundo--highlight-last-saved-overlay
|
||
(1- node-pt) node-pt))))
|
||
|
||
;;;###autoload
|
||
(defun vundo ()
|
||
"Display visual undo for the current buffer."
|
||
(interactive)
|
||
(when (not (consp buffer-undo-list))
|
||
(user-error "There is no undo history"))
|
||
(when buffer-read-only
|
||
(user-error "Buffer is read-only"))
|
||
(run-hooks 'vundo-pre-enter-hook)
|
||
(let ((vundo-buf (vundo-1 (current-buffer))))
|
||
(select-window
|
||
(display-buffer
|
||
vundo-buf
|
||
`(display-buffer-in-side-window
|
||
(side . ,vundo-window-side)
|
||
(window-height . 3))))
|
||
(set-window-dedicated-p nil t)
|
||
(let ((window-min-height 3))
|
||
(fit-window-to-buffer nil vundo-window-max-height))
|
||
(goto-char
|
||
(vundo-m-point
|
||
(vundo--current-node vundo--prev-mod-list)))
|
||
(setq vundo--roll-back-to-this
|
||
(vundo--current-node vundo--prev-mod-list))))
|
||
|
||
(defun vundo-1 (buffer)
|
||
"Return a vundo buffer for BUFFER.
|
||
BUFFER must have a valid `buffer-undo-list'."
|
||
(with-current-buffer buffer
|
||
(let ((vundo-buf (vundo--buffer))
|
||
(orig-buf (current-buffer)))
|
||
(with-current-buffer vundo-buf
|
||
;; Enable major mode before refreshing the buffer.
|
||
;; Because major modes kill local variables.
|
||
(unless (derived-mode-p 'vundo-mode)
|
||
(vundo-mode))
|
||
(vundo--refresh-buffer orig-buf vundo-buf)
|
||
vundo-buf))))
|
||
|
||
(defmacro vundo--check-for-command (&rest body)
|
||
"Sanity check before running interactive commands.
|
||
Do sanity check, then evaluate BODY."
|
||
(declare (debug (&rest form)))
|
||
`(progn
|
||
(when (not (derived-mode-p 'vundo-mode))
|
||
(user-error "Not in vundo buffer"))
|
||
(when (not (buffer-live-p vundo--orig-buffer))
|
||
(when (y-or-n-p "Original buffer is gone, kill vundo buffer? ")
|
||
(kill-buffer-and-window))
|
||
;; Non-local exit.
|
||
(user-error ""))
|
||
;; If ORIG-BUFFER changed since we last synced the vundo buffer
|
||
;; (eg, user left vundo buffer and did some edit in ORIG-BUFFER
|
||
;; then comes back), refresh to catch up.
|
||
(let ((undo-list (buffer-local-value
|
||
'buffer-undo-list vundo--orig-buffer)))
|
||
;; 1. Refresh if the beginning is not the same.
|
||
(cond ((not (eq (vundo--sans-nil undo-list)
|
||
(vundo--sans-nil vundo--prev-undo-list)))
|
||
(vundo--refresh-buffer vundo--orig-buffer (current-buffer))
|
||
(message "Refresh"))
|
||
;; 2. It is possible that GC trimmed the end of undo
|
||
;; list, but that doesn't affect us:
|
||
;; `vundo--prev-mod-list' and `vundo--prev-undo-list' are
|
||
;; still perfectly fine. Run the command normally. Of
|
||
;; course, the next time the user invokes `vundo', the
|
||
;; new tree will reflect the trimmed undo list.
|
||
(t ,@body)))))
|
||
|
||
(defun vundo-quit ()
|
||
"Quit buffer and window.
|
||
Roll back changes if `vundo-roll-back-on-quit' is non-nil."
|
||
(interactive)
|
||
(vundo--check-for-command
|
||
(when (and vundo-roll-back-on-quit vundo--roll-back-to-this
|
||
(not (eq vundo--roll-back-to-this
|
||
(vundo--current-node vundo--prev-mod-list))))
|
||
(vundo--move-to-node
|
||
(vundo--current-node vundo--prev-mod-list)
|
||
vundo--roll-back-to-this
|
||
vundo--orig-buffer vundo--prev-mod-list))
|
||
(with-current-buffer vundo--orig-buffer
|
||
(setq-local buffer-read-only nil))
|
||
(let* ((orig-buffer vundo--orig-buffer)
|
||
(orig-window (get-buffer-window orig-buffer)))
|
||
(kill-buffer-and-window)
|
||
(when (window-live-p orig-window)
|
||
(select-window orig-window))
|
||
(with-current-buffer orig-buffer
|
||
(run-hooks 'vundo-post-exit-hook)))))
|
||
|
||
(defun vundo-confirm ()
|
||
"Confirm change and close vundo window."
|
||
(interactive)
|
||
(with-current-buffer vundo--orig-buffer
|
||
(setq-local buffer-read-only nil))
|
||
(let* ((orig-buffer vundo--orig-buffer)
|
||
(orig-window (get-buffer-window orig-buffer)))
|
||
(kill-buffer-and-window)
|
||
(when (window-live-p orig-window)
|
||
(select-window orig-window))
|
||
(with-current-buffer orig-buffer
|
||
(run-hooks 'vundo-post-exit-hook))))
|
||
|
||
;;; Traverse undo tree
|
||
|
||
(defun vundo--calculate-shortest-route (from to)
|
||
"Calculate the shortest route from FROM to TO node.
|
||
Return (SOURCE STOP1 STOP2 ... DEST), meaning you should undo the
|
||
modifications from DEST to SOURCE. Each STOP is an intermediate
|
||
stop. Eg, (6 5 4 3). Return nil if there’s no valid route."
|
||
(let (route-list)
|
||
;; Find all valid routes.
|
||
(dolist (source (vundo--eqv-list-of from))
|
||
(dolist (dest (vundo--eqv-list-of to))
|
||
;; We only allow route in this direction.
|
||
(if (> (vundo-m-idx source) (vundo-m-idx dest))
|
||
(push (cons (vundo-m-idx source)
|
||
(vundo-m-idx dest))
|
||
route-list))))
|
||
;; Find the shortest route.
|
||
(setq route-list
|
||
(seq-sort
|
||
(lambda (r1 r2)
|
||
;; Ie, distance between SOURCE and DEST in R1 compare
|
||
;; against distance in R2.
|
||
(< (- (car r1) (cdr r1)) (- (car r2) (cdr r2))))
|
||
route-list))
|
||
(if-let* ((route (car route-list))
|
||
(source (car route))
|
||
(dest (cdr route)))
|
||
(number-sequence source dest -1))))
|
||
|
||
(defun vundo--list-subtract (l1 l2)
|
||
"Return L1 - L2.
|
||
|
||
\(vundo--list-subtract \='(4 3 2 1) \='(2 1))
|
||
=> (4 3)"
|
||
(let ((len1 (length l1))
|
||
(len2 (length l2)))
|
||
(cl-assert (> len1 len2))
|
||
(seq-subseq l1 0 (- len1 len2))))
|
||
|
||
(defun vundo--sans-nil (undo-list)
|
||
"Return UNDO-LIST sans leading nils.
|
||
If UNDO-LIST is nil, return nil."
|
||
(while (and (consp undo-list) (null (car undo-list)))
|
||
(setq undo-list (cdr undo-list)))
|
||
undo-list)
|
||
|
||
(defun vundo--latest-buffer-state (mod-list)
|
||
"Return the node representing the latest buffer state.
|
||
Basically, return the latest non-undo modification in MOD-LIST."
|
||
(let ((max-node (aref mod-list 0)))
|
||
(cl-loop for midx from 1 to (1- (length mod-list))
|
||
for mod = (aref mod-list midx)
|
||
do (if (and (null (vundo-m-prev-eqv mod))
|
||
(> (vundo-m-idx mod)
|
||
(vundo-m-idx max-node)))
|
||
(setq max-node mod)))
|
||
max-node))
|
||
|
||
(defun vundo--move-to-node (current dest orig-buffer mod-list)
|
||
"Move from CURRENT node to DEST node by undoing in ORIG-BUFFER.
|
||
ORIG-BUFFER must be at CURRENT state. MOD-LIST is the list you
|
||
get from `vundo--mod-list-from'. You should refresh vundo buffer
|
||
after calling this function. (You can call this function
|
||
repeatedly before refreshing, but moving back-and-forth might not
|
||
work, see docstring of ‘vundo--trim-undo-list’.)
|
||
|
||
This function modifies the content of ORIG-BUFFER."
|
||
(cl-assert (not (eq current dest)))
|
||
;; 1. Find the route we want to take.
|
||
(if-let* ((route (vundo--calculate-shortest-route current dest)))
|
||
(let* ((source-idx (car route))
|
||
(dest-idx (car (last route)))
|
||
;; The complete undo-list that stops at SOURCE.
|
||
(undo-list-at-source
|
||
(vundo-m-undo-list (aref mod-list source-idx)))
|
||
;; The complete undo-list that stops at DEST.
|
||
(undo-list-at-dest
|
||
(vundo-m-undo-list (aref mod-list dest-idx)))
|
||
;; We will undo these modifications.
|
||
(planned-undo (vundo--list-subtract
|
||
undo-list-at-source undo-list-at-dest))
|
||
;; We don’t want to quit in the middle of this function.
|
||
(inhibit-quit t))
|
||
(with-current-buffer orig-buffer
|
||
(setq-local buffer-read-only t)
|
||
;; 2. Undo. This will undo modifications in PLANNED-UNDO and
|
||
;; add new entries to `buffer-undo-list'.
|
||
(let ((undo-in-progress t))
|
||
(cl-loop
|
||
for step = (- source-idx dest-idx)
|
||
then (1- step)
|
||
while (and (> step 0)
|
||
;; If there is a quit signal, we break the
|
||
;; loop, continue to step 3 and 4, then quits
|
||
;; when we go out of the let-form.
|
||
(not quit-flag))
|
||
for stop = (1- source-idx) then (1- stop)
|
||
do
|
||
(progn
|
||
;; Stop at each intermediate stop along the route to
|
||
;; create trim points for future undo.
|
||
(setq planned-undo (primitive-undo 1 planned-undo))
|
||
(cl-assert (not (and (consp buffer-undo-list)
|
||
(null (car buffer-undo-list)))))
|
||
(let ((undo-list-at-stop
|
||
(vundo-m-undo-list (aref mod-list stop))))
|
||
(puthash buffer-undo-list (or undo-list-at-stop t)
|
||
undo-equiv-table))
|
||
(push nil buffer-undo-list))))
|
||
;; 3. Some misc work.
|
||
(when vundo--message
|
||
(message "%s -> %s Steps: %s Undo-list len: %s"
|
||
(mapcar #'vundo-m-idx (vundo--eqv-list-of
|
||
(aref mod-list source-idx)))
|
||
(mapcar #'vundo-m-idx (vundo--eqv-list-of
|
||
(aref mod-list dest-idx)))
|
||
(length planned-undo)
|
||
(length buffer-undo-list)))
|
||
(when-let ((win (get-buffer-window)))
|
||
(set-window-point win (point)))))
|
||
(error "No possible route")))
|
||
|
||
(defun vundo--trim-undo-list (buffer current mod-list)
|
||
"Trim `buffer-undo-list' in BUFFER according to CURRENT and MOD-LIST.
|
||
CURRENT is the current mod, MOD-LIST is the current mod-list.
|
||
|
||
This function modifies `buffer-undo-list' of BUFFER.
|
||
|
||
IMPORTANT Relationship between `vundo--move-to-node',
|
||
`vundo--refresh-buffer', `vundo--trim-undo-list':
|
||
|
||
Each vundo command cycle roughly works like this:
|
||
1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list
|
||
2. `vundo--move-to-node': read mod-list, modify `buffer-undo-list'
|
||
3. `vundo--trim-undo-list': trim `buffer-undo-list'
|
||
1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list
|
||
...
|
||
|
||
We can call `vundo--move-to-node' multiple times between two
|
||
`vundo--refresh-buffer'. But we should only call
|
||
`vundo--trim-undo-list' once between two `vundo--refresh-buffer'.
|
||
Because if we only trim once, `buffer-undo-list' either shrinks
|
||
or expands. But if we trim multiple times after multiple
|
||
movements, it could happen that the undo-list first
|
||
shrinks (trimmed) then expands. In that situation we cannot use
|
||
the INCREMENTAL option in `vundo--refresh-buffer' anymore.
|
||
|
||
Also, if you move back-end-forth with ‘vundo--move-to-node’, it
|
||
might not work: Suppose undo list is [1 2 3], mod-list is [1 2
|
||
3], now we move back to 2, undo list becomes [1 2 3 2’], but
|
||
before we refresh vundo buffer, mod-list will remain [1 2 3], so
|
||
there’s no route from 2 to 3 (you can only move back). Once
|
||
we refresh the buffer and mod-list is updated to [1 2 3 2’], we
|
||
have a route from 3 to 2 (2’->3)."
|
||
(let ((latest-buffer-state-idx
|
||
;; Among all the MODs that represents a unique buffer
|
||
;; state, we find the latest one. Because any node
|
||
;; beyond that one is dispensable.
|
||
(vundo-m-idx
|
||
(vundo--latest-buffer-state mod-list))))
|
||
;; Find a trim point between latest buffer state and
|
||
;; current node.
|
||
(when-let ((possible-trim-point
|
||
(cl-loop for node in (vundo--eqv-list-of current)
|
||
if (>= (vundo-m-idx node)
|
||
latest-buffer-state-idx)
|
||
return node
|
||
finally return nil)))
|
||
(with-current-buffer buffer
|
||
(setq buffer-undo-list
|
||
(vundo-m-undo-list possible-trim-point)))
|
||
(when vundo--message
|
||
(message "Trimmed to: %s"
|
||
(vundo-m-idx possible-trim-point))))))
|
||
|
||
(defvar vundo-after-undo-functions nil
|
||
"Special hook that runs after `vundo' motions.
|
||
Functions assigned to this hook are called with one argument: the
|
||
original buffer `vundo' operates on.")
|
||
|
||
(defun vundo-forward (arg)
|
||
"Move forward ARG nodes in the undo tree.
|
||
If ARG < 0, move backward."
|
||
(interactive "p")
|
||
(vundo--check-for-command
|
||
(let ((step (abs arg)))
|
||
(let* ((source (vundo--current-node vundo--prev-mod-list))
|
||
dest
|
||
(this source)
|
||
(next (if (> arg 0)
|
||
(car (vundo-m-children this))
|
||
(vundo-m-parent this))))
|
||
;; Move to the dest node step-by-step, stop when no further
|
||
;; node to go to.
|
||
(while (and next (> step 0))
|
||
(setq this next
|
||
next (if (> arg 0)
|
||
(car (vundo-m-children this))
|
||
(vundo-m-parent this)))
|
||
(cl-decf step))
|
||
(setq dest this)
|
||
(unless (eq source dest)
|
||
(vundo--move-to-node
|
||
source dest vundo--orig-buffer vundo--prev-mod-list)
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer dest vundo--prev-mod-list)
|
||
;; Refresh display.
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer) 'incremental))))
|
||
(run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer)))
|
||
|
||
(defun vundo-backward (arg)
|
||
"Move back ARG nodes in the undo tree.
|
||
If ARG < 0, move forward."
|
||
(interactive "p")
|
||
(vundo-forward (- arg)))
|
||
|
||
(defun vundo-next (arg)
|
||
"Move to node below the current one. Move ARG steps."
|
||
(interactive "p")
|
||
(vundo--check-for-command
|
||
(let* ((source (vundo--current-node vundo--prev-mod-list))
|
||
(parent (vundo-m-parent source)))
|
||
;; Move to next/previous sibling.
|
||
(when parent
|
||
(let* ((siblings (vundo-m-children parent))
|
||
(idx (seq-position siblings source))
|
||
;; If ARG is larger than the number of siblings,
|
||
;; move as far as possible (to the end).
|
||
(new-idx (max 0 (min (+ idx arg)
|
||
(1- (length siblings)))))
|
||
(dest (nth new-idx siblings)))
|
||
(when (not (eq source dest))
|
||
(vundo--move-to-node
|
||
source dest vundo--orig-buffer vundo--prev-mod-list)
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer dest vundo--prev-mod-list)
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer)
|
||
'incremental)))))
|
||
(run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer)))
|
||
|
||
(defun vundo-previous (arg)
|
||
"Move to node above the current one. Move ARG steps."
|
||
(interactive "p")
|
||
(vundo-next (- arg)))
|
||
|
||
(defun vundo--stem-root-p (node)
|
||
"Return non-nil if NODE is the root of a stem."
|
||
;; Ie, parent has more than one child.
|
||
(> (length (vundo-m-children (vundo-m-parent node))) 1))
|
||
|
||
(defun vundo--stem-end-p (node)
|
||
"Return non-nil if NODE is the end of a stem."
|
||
;; No children, or more than one child.
|
||
(let ((len (length (vundo-m-children node))))
|
||
(or (> len 1) (eq len 0))))
|
||
|
||
(defun vundo-stem-root ()
|
||
"Move to the beginning of the current stem."
|
||
(interactive)
|
||
(vundo--check-for-command
|
||
(when-let* ((this (vundo--current-node vundo--prev-mod-list))
|
||
(next (vundo-m-parent this)))
|
||
;; If NEXT is nil, i.e. this node doesn’t have a parent,
|
||
;; do nothing.
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (vundo-m-parent this))
|
||
(while (and next (not (vundo--stem-root-p this)))
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (vundo-m-parent this)))
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer this vundo--prev-mod-list)
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer)
|
||
'incremental))))
|
||
|
||
(defun vundo-next-root ()
|
||
"Move to the beginning of the next stem."
|
||
(interactive)
|
||
(vundo--check-for-command
|
||
(when-let* ((this (vundo--current-node vundo--prev-mod-list))
|
||
;; If NEXT is nil, i.e. this node doesn’t have a child,
|
||
;; do nothing.
|
||
(next (car (vundo-m-children this))))
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (car (vundo-m-children this)))
|
||
(while (and next (not (vundo--stem-root-p this)))
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (car (vundo-m-children this))))
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer this vundo--prev-mod-list)
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer)
|
||
'incremental))))
|
||
|
||
(defun vundo-stem-end ()
|
||
"Move to the end of the current stem."
|
||
(interactive)
|
||
(vundo--check-for-command
|
||
(when-let* ((this (vundo--current-node vundo--prev-mod-list))
|
||
(next (car (vundo-m-children this))))
|
||
;; If NEXT is nil, i.e. this node doesn’t have a child,
|
||
;; do nothing.
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (car (vundo-m-children this)))
|
||
(while (and next (not (vundo--stem-end-p this)))
|
||
(vundo--move-to-node
|
||
this next vundo--orig-buffer vundo--prev-mod-list)
|
||
(setq this next
|
||
next (car (vundo-m-children this))))
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer this vundo--prev-mod-list)
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer)
|
||
'incremental))))
|
||
|
||
(defun vundo-goto-last-saved (arg)
|
||
"Go back to the first saved node prior to the current node, if any.
|
||
With numeric prefix ARG, move that many saved nodes back (ARG<0
|
||
moves forward in history)."
|
||
(interactive "p")
|
||
(vundo--check-for-command
|
||
(if-let* ((cur (vundo--current-node vundo--prev-mod-list))
|
||
(dest (vundo--find-last-saved cur arg)))
|
||
(progn
|
||
(unless (eq cur dest)
|
||
(vundo--move-to-node
|
||
cur dest vundo--orig-buffer vundo--prev-mod-list)
|
||
(vundo--trim-undo-list
|
||
vundo--orig-buffer dest vundo--prev-mod-list)
|
||
(vundo--refresh-buffer
|
||
vundo--orig-buffer (current-buffer) 'incremental))
|
||
(message "Node saved %s"
|
||
(format-time-string
|
||
"%F %r"
|
||
(vundo--node-timestamp vundo--prev-mod-list dest))))
|
||
(message "No such saved node"))))
|
||
|
||
(defun vundo-goto-next-saved (arg)
|
||
"Go to the ARGth saved node after the current node (default 1).
|
||
For ARG<0, go to the last saved node prior to the current node."
|
||
(interactive "p")
|
||
(vundo-goto-last-saved (- arg)))
|
||
|
||
(defun vundo-save (arg)
|
||
"Run `save-buffer' with the current buffer Vundo is operating on.
|
||
Accepts the same interactive argument ARG as ‘save-buffer’."
|
||
(interactive "p")
|
||
(vundo--check-for-command
|
||
(with-current-buffer vundo--orig-buffer
|
||
(save-buffer arg)))
|
||
(when vundo-highlight-saved-nodes
|
||
(vundo--highlight-last-saved-node
|
||
vundo--prev-mod-list vundo--timestamps)))
|
||
|
||
;;; Debug
|
||
|
||
(defun vundo--setup-test-buffer ()
|
||
"Setup and pop a testing buffer."
|
||
(interactive)
|
||
(let ((buf (get-buffer "*vundo-test*")))
|
||
(if buf (kill-buffer buf))
|
||
(setq buf (get-buffer-create "*vundo-test*"))
|
||
(pop-to-buffer buf)))
|
||
|
||
(defun vundo--inspect ()
|
||
"Print some useful info about the node at point."
|
||
(interactive)
|
||
(let ((node (vundo--get-node-at-point)))
|
||
(message "Parent: %s States: %s Children: %s%s"
|
||
(and (vundo-m-parent node)
|
||
(vundo-m-idx (vundo-m-parent node)))
|
||
(mapcar #'vundo-m-idx (vundo--eqv-list-of node))
|
||
(and (vundo-m-children node)
|
||
(mapcar #'vundo-m-idx (vundo-m-children node)))
|
||
(if-let* ((ts (vundo--node-timestamp vundo--prev-mod-list node))
|
||
((consp ts)))
|
||
(format " Saved: %s" (format-time-string "%F %r" ts))
|
||
""))))
|
||
|
||
(defun vundo--debug ()
|
||
"Make cursor visible and show debug information on movement."
|
||
(interactive)
|
||
(setq cursor-type t
|
||
vundo--message t))
|
||
|
||
(defvar vundo--monitor nil
|
||
"Timer for catching bugs.")
|
||
(defun vundo--start-monitor ()
|
||
"Run `vundo-1' in idle timer to try to catch bugs."
|
||
(interactive)
|
||
(setq vundo--monitor
|
||
(run-with-idle-timer 3 t (lambda ()
|
||
(unless (eq t buffer-undo-list)
|
||
(vundo-1 (current-buffer))
|
||
(message "SUCCESS"))))))
|
||
|
||
(provide 'vundo)
|
||
|
||
;;; vundo.el ends here
|
||
|
||
;; Local Variables:
|
||
;; indent-tabs-mode: nil
|
||
;; End:
|