vundo.el

;;; 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.3.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
;;   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 exists."
  :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 it's 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 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" 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 and 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--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)))))

(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-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. (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 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-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, ie. 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, 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 (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")
  (if-let* ((cur (vundo--current-node vundo--prev-mod-list))
            (dest (vundo--find-last-saved cur arg)))
      (progn
        (unless (eq cur dest)
          (vundo--check-for-command
           (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, got 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 arfument 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.
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

;; Local Variables:
;; indent-tabs-mode: nil
;; End: