vundo.el

;;; vundo.el --- Visual undo tree      -*- lexical-binding: t; -*-

;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
;;
;; Author: Yuan Fu <casouri@gmail.com>
;; Maintainer: Yuan Fu <casouri@gmail.com>
;; URL: https://github.com/casouri/vundo
;; Version: 2.1.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
;;   e   to go forward to the end/tip of the branch
;;   l   to go to the last 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)))

(defconst vundo-ascii-symbols
  '((selected-node . ?x)
    (node . ?o)
    (horizontal-stem . ?-)
    (vertical-stem . ?|)
    (branch . ?|)
    (last-branch . ?`))
  "ASCII symbols to draw vundo tree.")

(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 exists."
  :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 reserved."
  ;; 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 FORM-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, ie, 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" like (t . TIMESTAMP)
;; which capture the file modification time of the saved file which
;; an undo changed.  During tree draw, we collect the last of these, and
;; indicated nodes which had been saved specially.

(defvar vundo--last-saved-idx)
(defvar vundo--orig-buffer)

(defun vundo--mod-timestamp (mod-list idx)
  "Return a timestamp if the mod in MOD-LIST at IDX has a timestamp."
  ;; If the next mod’s timestamp is non-nil, this mod/node
  ;; represents a saved state.
  (let* ((next-mod-idx (1+ idx))
         (next-mod (when (< next-mod-idx (length mod-list))
                     (aref mod-list next-mod-idx))))
    (and next-mod (vundo-m-timestamp next-mod))))

(defun vundo--node-timestamp (mod-list node)
  "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 unmodified)."
  (let* ((idx (vundo-m-idx node))
	 (current (vundo--current-node mod-list)))
    (or (vundo--mod-timestamp mod-list idx)
	(and (eq node current) (eq idx vundo--last-saved-idx)
             (with-current-buffer vundo--orig-buffer
	       (and (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 (eq (point) (point-max))))
    (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))

(defvar vundo--last-saved-idx)

(defun vundo--draw-tree (mod-list orig-buffer-modified)
  "Draw the tree in MOD-LIST in current buffer.
ORIG-BUFFER-MODIFIED is t if the original buffer is not saved to
the disk.  Set `vundo--last-saved-idx' by side-effect,
corresponding to the index of the last saved node."
  (let* ((root (aref mod-list 0))
         (node-queue (list root))
         (inhibit-read-only t)
         (inhibit-modification-hooks t)
         (last-saved-idx -1))
    (erase-buffer)
    (setq vundo--last-saved-idx -1)
    (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)))))
             (node-idx (vundo-m-idx node))
             (mod-ts (vundo--mod-timestamp mod-list node-idx))
             (saved-p (and vundo-highlight-saved-nodes mod-ts))
             (node-face (if saved-p 'vundo-saved 'vundo-node))
             (stem-face (if only-child-p 'vundo-stem 'vundo-branch-stem)))
        (when (and mod-ts (> node-idx last-saved-idx))
          (setq last-saved-idx node-idx))
        ;; Go to parent.
        (if parent (goto-char (vundo-m-point parent)))
        (let ((col (max 0 (1- (current-column))))
              (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 col)
                ;; 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))))

    ;; If the associated buffer is unmodified, the last node must be
    ;; the last saved node even though it doesn’t (yet) have a next
    ;; node with a timestamp to indicate that.
    (setq vundo--last-saved-idx
          (if orig-buffer-modified
              (if (> last-saved-idx 0) last-saved-idx nil)
            (vundo-m-idx (vundo--current-node mod-list))))
    ;; Update the face of the last saved node (if any).
    (when (and vundo-highlight-saved-nodes
               vundo--last-saved-idx)
      (vundo--highlight-last-saved-node
       (aref mod-list vundo--last-saved-idx)))))

;;; 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 "e") #'vundo-stem-end)
    (define-key map (kbd "l") #'vundo-goto-last-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--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--last-saved-idx nil
  "The last node index with a timestamp seen.
This is set by ‘vundo--draw-tree’ and ‘vundo-save’, and used by
‘vundo-goto-last-saved’ and ‘vundo--highlight-last-saved-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
            vundo--last-saved-idx 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))))
      ;; 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 (with-current-buffer orig-buffer
                                     (buffer-modified-p))))

      ;; Highlight current node.
      (vundo--highlight-node (vundo--current-node mod-list))
      (goto-char (vundo-m-point (vundo--current-node 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))))

(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 (node)
  "Highlight NODE as the last saved.
This moves the overlay `vundo--highlight-last-saved-overlay'."
  (let ((node-pt (vundo-m-point node)))
    (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-in-side-window
      vundo-buf
      `((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.

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."
  (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 aasigned 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 children.
  (> (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 children.
  (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, ie, 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-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, ie, 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 ()
  "Goto the last saved node, if any."
  (interactive)
  (when (and vundo--last-saved-idx (>= vundo--last-saved-idx 0))
    (vundo--check-for-command
     (when-let* ((this (vundo--current-node vundo--prev-mod-list))
                 (dest (aref vundo--prev-mod-list vundo--last-saved-idx)))
       (unless (eq this dest)
         (vundo--move-to-node
          this 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))))))

(defun vundo-save (arg)
  "Run `save-buffer' with the current buffer Vundo is operating on.
Accepts the same interactive arfument ARG as ‘save-buffer’."
  (interactive "p")
  (vundo--check-for-command
   (with-current-buffer vundo--orig-buffer
     (save-buffer arg)))
  (let* ((cur-node (vundo--current-node vundo--prev-mod-list)))
    (setq vundo--last-saved-idx (vundo-m-idx cur-node))
    (when vundo-highlight-saved-nodes
      (vundo--highlight-last-saved-node cur-node))))

;;; Debug

(defun vundo--setup-test-buffer ()
  "Setup and pop a testing buffer.
TYPE is the type of buffer you want."
  (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