config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

vundo.el (57317B)


      1 ;;; vundo.el --- Visual undo tree      -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2019-2023 Free Software Foundation, Inc.
      4 ;;
      5 ;; Author: Yuan Fu <casouri@gmail.com>
      6 ;; Maintainer: Yuan Fu <casouri@gmail.com>
      7 ;; URL: https://github.com/casouri/vundo
      8 ;; Version: 2.3.0
      9 ;; Keywords: undo, text, editing
     10 ;; Package-Requires: ((emacs "28.1"))
     11 ;;
     12 ;; This file is part of GNU Emacs.
     13 ;;
     14 ;; GNU Emacs is free software: you can redistribute it and/or modify
     15 ;; it under the terms of the GNU General Public License as published by
     16 ;; the Free Software Foundation, either version 3 of the License, or
     17 ;; (at your option) any later version.
     18 ;;
     19 ;; GNU Emacs is distributed in the hope that it will be useful,
     20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     22 ;; GNU General Public License for more details.
     23 ;;
     24 ;; You should have received a copy of the GNU General Public License
     25 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     26 
     27 ;;; Commentary:
     28 ;;
     29 ;; Vundo (visual undo) displays the undo history as a tree and lets you
     30 ;; move in the tree to go back to previous buffer states. To use vundo,
     31 ;; type M-x vundo RET in the buffer you want to undo. An undo tree buffer
     32 ;; should pop up. To move around, type:
     33 ;;
     34 ;;   f   to go forward
     35 ;;   b   to go backward
     36 ;;
     37 ;;   n   to go to the node below when you at a branching point
     38 ;;   p   to go to the node above
     39 ;;
     40 ;;   a   to go back to the last branching point
     41 ;;   e   to go forward to the end/tip of the branch
     42 ;;   l   to go to the last saved node
     43 ;;   r   to go to the next saved node
     44 ;;
     45 ;;   m   to mark the current node for diff
     46 ;;   u   to unmark the marked node
     47 ;;   d   to show a diff between the marked (or parent) and current nodes
     48 ;;
     49 ;;   q   to quit, you can also type C-g
     50 ;;
     51 ;; n/p may need some more explanation. In the following tree, n/p can
     52 ;; move between A and B because they share a parent (thus at a branching
     53 ;; point), but not C and D.
     54 ;;
     55 ;;          A  C
     56 ;;     ──○──○──○──○──○
     57 ;;       │  ↕
     58 ;;       └──○──○──○
     59 ;;          B  D
     60 ;;
     61 ;; By default, you need to press RET to “commit” your change and if you
     62 ;; quit with q or C-g, the changes made by vundo are rolled back. You can
     63 ;; set `vundo-roll-back-on-quit' to nil to disable rolling back.
     64 ;;
     65 ;; Note: vundo.el requires Emacs 28.
     66 ;;
     67 ;; Customizable faces:
     68 ;;
     69 ;; - vundo-default
     70 ;; - vundo-node
     71 ;; - vundo-stem
     72 ;; - vundo-highlight
     73 ;;
     74 ;; If you want to use prettier Unicode characters to draw the tree like
     75 ;; this:
     76 ;;
     77 ;;     ○──○──○
     78 ;;     │  └──●
     79 ;;     ├──○
     80 ;;     └──○
     81 ;;
     82 ;; set vundo-glyph-alist by
     83 ;;
     84 ;;     (setq vundo-glyph-alist vundo-unicode-symbols)
     85 ;;
     86 ;; Your default font needs to contain these Unicode characters, otherwise
     87 ;; they look terrible and don’t align. You can find a font that covers
     88 ;; these characters (eg, Symbola, Unifont), and set `vundo-default' face
     89 ;; to use that font:
     90 ;;
     91 ;;     (set-face-attribute 'vundo-default nil :family "Symbola")
     92 ;;
     93 ;; Comparing to undo-tree:
     94 ;;
     95 ;; Vundo doesn’t need to be turned on all the time nor replace the undo
     96 ;; commands like undo-tree does. Vundo displays the tree horizontally,
     97 ;; whereas undo-tree displays a tree vertically.
     98 
     99 ;;; Developer:
    100 ;;
    101 ;; In the comments, when I say node, modification, mod, buffer state,
    102 ;; they all mean one thing: `vundo-m'. Ie, `vundo-m' represents
    103 ;; multiple things at once: it represents an modification recorded in
    104 ;; `buffer-undo-list', it represents the state of the buffer after
    105 ;; that modification took place, and it represents the node in the
    106 ;; undo tree in the vundo buffer representing that buffer state.
    107 ;;
    108 ;; The basic flow of the program:
    109 ;;
    110 ;; `vundo' calls `vundo--refresh-buffer' to setup the tree structure
    111 ;; and draw it in the buffer. We have two data structures:
    112 ;; `vundo--prev-mod-list' which stores a vector of `vundo-m'. This vector
    113 ;; is generated from `buffer-undo-list' by `vundo--mod-list-from'. We
    114 ;; also have a hash table `vundo--prev-mod-hash' generated by
    115 ;; `vundo--update-mapping', which maps undo-lists back to the
    116 ;; `vundo-m' object corresponding to it. Once we have the mod-list and
    117 ;; hash table, we connect the nodes in mod-list to form a tree in
    118 ;; `vundo--build-tree'. We build the tree by a simple observation:
    119 ;; only non-undo modifications creates new unique buffer states and
    120 ;; need to be drawn in the tree. For undo modifications, they
    121 ;; associate equivalent nodes.
    122 ;;
    123 ;; Once we have generated the data structure and drawn the tree, vundo
    124 ;; commands can move around in that tree by calling
    125 ;; `vundo--move-to-node'. It will construct the correct undo-list and
    126 ;; feed it to `primitive-undo'. `vundo--trim-undo-list' can trim the
    127 ;; undo list when possible.
    128 ;;
    129 ;; Finally, to avoid generating everything from scratch every time we
    130 ;; move on the tree, `vundo--refresh-buffer' can incrementally update
    131 ;; the data structures (`vundo--prev-mod-list' and
    132 ;; `vundo--prev-mod-hash'). If the undo list expands, we only process
    133 ;; the new entries, if the undo list shrinks (trimmed), we remove
    134 ;; modifications accordingly.
    135 ;;
    136 ;; For a high-level explanation of how this package works, see
    137 ;; https://archive.casouri.cat/note/2021/visual-undo-tree.
    138 ;;
    139 ;; Position-only records
    140 ;;
    141 ;; We know how undo works: when undoing, `primitive-undo' looks at
    142 ;; each record in `pending-undo-list' and modifies the buffer
    143 ;; accordingly, and that modification itself pushes new undo records
    144 ;; into `buffer-undo-list'. However, not all undo records introduce
    145 ;; modification, if the record is an integer, `primitive-undo' simply
    146 ;; `goto' that position, which introduces no modification to the
    147 ;; buffer and pushes no undo record to `buffer-undo-list'. Normally
    148 ;; position records accompany other buffer-modifying records, but if a
    149 ;; particular record consists of only position records, we have
    150 ;; trouble: after an undo step, `buffer-undo-list' didn’t grow, as far
    151 ;; as vundo tree-folding algorithm is concerned, we didn’t move.
    152 ;; Assertions expecting to see new undo records in `buffer-undo-list'
    153 ;; are also violated. To avoid all these complications, we ignore
    154 ;; position-only records when generating mod-list in
    155 ;; `vundo--mod-list-from'. These records are not removed, but they
    156 ;; can’t harm us now.
    157 
    158 ;;; Code:
    159 
    160 (require 'pcase)
    161 (require 'cl-lib)
    162 (require 'seq)
    163 (require 'subr-x)
    164 
    165 ;;; Customization
    166 
    167 (defgroup vundo nil
    168   "Visual undo tree."
    169   :group 'undo)
    170 
    171 (defface vundo-default '((t . (:inherit default)))
    172   "Default face used in vundo buffer.")
    173 
    174 (defface vundo-node '((t . (:inherit vundo-default)))
    175   "Face for nodes in the undo tree.")
    176 
    177 (defface vundo-stem '((t . (:inherit vundo-default)))
    178   "Face for stems between nodes in the undo tree.")
    179 
    180 (defface vundo-branch-stem
    181   '((t (:inherit vundo-stem :weight bold)))
    182   "Face for branching stems in the undo tree.")
    183 
    184 (defface vundo-highlight
    185   '((((background light)) .
    186      (:inherit vundo-node :weight bold :foreground "red"))
    187     (((background dark)) .
    188      (:inherit vundo-node :weight bold :foreground "yellow")))
    189   "Face for the highlighted node in the undo tree.")
    190 
    191 (defface vundo-saved
    192   '((((background light)) .
    193      (:inherit vundo-node :foreground "dark green"))
    194     (((background dark)) .
    195      (:inherit vundo-node  :foreground "light green")))
    196   "Face for saved nodes in the undo tree.")
    197 
    198 (defface vundo-last-saved
    199   '((t (:inherit vundo-saved :weight bold)))
    200   "Face for the last saved node in the undo tree.")
    201 
    202 (defcustom vundo-roll-back-on-quit t
    203   "If non-nil, vundo will roll back the change when it quits."
    204   :type 'boolean)
    205 
    206 (defcustom vundo-highlight-saved-nodes t
    207   "If non-nil, vundo will highlight nodes which have been saved and then modified.
    208 The face `vundo-saved' is used for saved nodes, except for the
    209 most recent such node, which receives the face `vundo-last-saved'."
    210   :type 'boolean)
    211 
    212 (defcustom vundo-window-max-height 3
    213   "The maximum height of the vundo window."
    214   :type 'integer)
    215 
    216 (defcustom vundo-window-side 'bottom
    217   "The vundo window pops up on this side."
    218   :type '(choice (const :tag "Bottom" bottom)
    219                  (const :tag "Top"    top)))
    220 
    221 ;;;###autoload
    222 (defconst vundo-ascii-symbols
    223   '((selected-node . ?x)
    224     (node . ?o)
    225     (horizontal-stem . ?-)
    226     (vertical-stem . ?|)
    227     (branch . ?|)
    228     (last-branch . ?`))
    229   "ASCII symbols to draw vundo tree.")
    230 
    231 ;;;###autoload
    232 (defconst vundo-unicode-symbols
    233   '((selected-node . ?●)
    234     (node . ?○)
    235     (horizontal-stem . ?─)
    236     (vertical-stem . ?│)
    237     (branch . ?├)
    238     (last-branch . ?└))
    239   "Unicode symbols to draw vundo tree.")
    240 
    241 (defcustom vundo-compact-display nil
    242   "Show a more compact tree display if non-nil.
    243 Basically we display
    244 
    245     ○─○─○  instead of  ○──○──○
    246     │ └─●              │  └──●
    247     ├─○                ├──○
    248     └─○                └──○"
    249   :type 'boolean)
    250 
    251 (defcustom vundo-glyph-alist vundo-ascii-symbols
    252   "Alist mapping tree parts to characters used to draw a tree.
    253 Keys are names for different parts of a tree, values are
    254 characters for that part. Possible keys include
    255 
    256 node            which represents ○
    257 selected-node   which represents ●
    258 horizontal-stem which represents ─
    259 vertical-stem   which represents │
    260 branch          which represents ├
    261 last-branch     which represents └
    262 
    263 in a tree like
    264 
    265     ○──○──○
    266     │  └──●
    267     ├──○
    268     └──○
    269 
    270 By default, the tree is drawn with ASCII characters like this:
    271 
    272     o--o--o
    273     |  \\=`--x
    274     |--o
    275     \\=`--o
    276 
    277 Set this variable to `vundo-unicode-symbols' to use Unicode
    278 characters."
    279   :type `(alist :tag "Translation alist"
    280                 :key-type (symbol :tag "Part of tree")
    281                 :value-type (character :tag "Draw using")
    282                 :options ,(mapcar #'car vundo-unicode-symbols)))
    283 
    284 (defcustom vundo-pre-enter-hook nil
    285   "List of functions to call when entering vundo.
    286 This hook runs immediately after ‘vundo’ is called, in the buffer
    287 the user invoked ‘vundo’, before every setup ‘vundo’ does."
    288   :type 'hook)
    289 
    290 (defcustom vundo-post-exit-hook nil
    291   "List of functions to call when exiting vundo.
    292 This hook runs in the original buffer the user invoked ‘vundo’,
    293 after all the clean up the exiting function does. Ie, it is the
    294 very last thing that happens when vundo exists."
    295   :type 'hook)
    296 
    297 (defcustom vundo-diff-setup-hook nil
    298   "List of functions to call after creating a diff buffer.
    299 This hook runs in the ‘vundo-diff’ buffer immediately after it's setup,
    300 both for new or existing buffers. This may be used to
    301 manipulate the diff or transform it's contents."
    302   :type 'hook)
    303 
    304 ;;; Undo list to mod list
    305 
    306 (cl-defstruct vundo-m
    307   "A modification in undo history.
    308 This object serves two purpose: it represents a modification in
    309 undo history, and it also represents the buffer state after the
    310 modification."
    311   (idx
    312    nil
    313    :type integer
    314    :documentation "The index of this modification in history.")
    315   (children
    316    nil
    317    :type proper-list
    318    :documentation "Children in tree.")
    319   (parent
    320    nil
    321    :type vundo-m
    322    :documentation "Parent in tree.")
    323   (prev-eqv
    324    nil
    325    :type vundo-m
    326    :documentation "The previous equivalent state.")
    327   (next-eqv
    328    nil
    329    :type vundo-m
    330    :documentation "The next equivalent state.")
    331   (undo-list
    332    nil
    333    :type cons
    334    :documentation "The undo-list at this modification.")
    335   (point
    336    nil
    337    :type integer
    338    :documentation "Marks the text node in the vundo buffer if drawn.")
    339   (timestamp
    340    nil
    341    :type timestamp
    342    :documentation
    343    "Timestamp at which this mod altered a saved buffer state.
    344 If this field is non-nil, the mod contains a timestamp entry in
    345 the undo list, meaning the previous state was saved to file. This
    346 field records that timestamp."))
    347 
    348 (defun vundo--position-only-p (undo-list)
    349   "Check if the records at the start of UNDO-LIST are position-only.
    350 Position-only means all records until to the next undo
    351 boundary are position records. Position record is just an
    352 integer (see `buffer-undo-list'). Assumes the first element
    353 of UNDO-LIST is not nil."
    354   (let ((pos-only t))
    355     (while (car undo-list)
    356       (when (not (integerp (pop undo-list)))
    357         (setq pos-only nil)
    358         (setq undo-list nil)))
    359     pos-only))
    360 
    361 (defun vundo--mod-list-from (undo-list &optional n mod-list)
    362   "Generate and return a modification list from UNDO-LIST.
    363 If N non-nil, only look at the first N entries in UNDO-LIST.
    364 If MOD-LIST non-nil, extend on MOD-LIST."
    365   (let ((uidx 0)
    366         (mod-list (or mod-list (vector (make-vundo-m))))
    367         new-mlist)
    368     (while (and undo-list (or (null n) (< uidx n)))
    369       ;; Skip leading nils.
    370       (while (and undo-list (null (car undo-list)))
    371         (setq undo-list (cdr undo-list))
    372         (cl-incf uidx))
    373       ;; It's possible the index was exceeded stepping over nil.
    374       (when (or (null n) (< uidx n))
    375         ;; Add modification.
    376         (let ((pos-only (vundo--position-only-p undo-list))
    377               (mod-timestamp nil))
    378           (unless pos-only
    379             ;; If this record is position-only, we skip it and don’t
    380             ;; add a mod for it. Effectively taking it out of the undo
    381             ;; tree. Read ‘Position-only records’ section in
    382             ;; Commentary for more explanation.
    383             (cl-assert (not (null (car undo-list))))
    384             (push (make-vundo-m :undo-list undo-list)
    385                   new-mlist))
    386           ;; Skip through the content of this modification.
    387           (while (car undo-list)
    388             ;; Is this entry a timestamp?
    389             (when (and (consp (car undo-list)) (eq (caar undo-list) t))
    390               (setq mod-timestamp (cdar undo-list)))
    391             (setq undo-list (cdr undo-list))
    392             (cl-incf uidx))
    393           ;; If this modification contains a timestamp, the previous
    394           ;; state is saved to file.
    395           (when (and mod-timestamp (not pos-only))
    396             (setf (vundo-m-timestamp (car new-mlist)) mod-timestamp)))))
    397     ;; Convert to vector.
    398     (vconcat mod-list new-mlist)))
    399 
    400 (defun vundo--update-mapping (mod-list &optional hash-table n)
    401   "Update each modification in MOD-LIST.
    402 Add :idx for each modification, map :undo-list back to each
    403 modification in HASH-TABLE. If N non-nil, start from the Nth
    404 modification in MOD-LIST. Return HASH-TABLE."
    405   (let ((hash-table (or hash-table
    406                         (make-hash-table :test #'eq :weakness t))))
    407     (cl-loop for midx from (or n 0) to (1- (length mod-list))
    408              for mod = (aref mod-list midx)
    409              do (cl-assert (null (vundo-m-idx mod)))
    410              do (cl-assert (null (gethash (vundo-m-undo-list mod)
    411                                           hash-table)))
    412              do (setf (vundo-m-idx mod) midx)
    413              do (puthash (vundo-m-undo-list mod) mod hash-table))
    414     hash-table))
    415 
    416 ;;; Mod list to tree
    417 ;;
    418 ;; If node a, b, c are in the same equivalent list, they represents
    419 ;; identical buffer states. For example, in the figure below, node 3
    420 ;; and 5 are in the same equivalent list:
    421 ;;
    422 ;;     |
    423 ;;     3  5
    424 ;;     | /
    425 ;;     |/
    426 ;;     4
    427 ;;
    428 ;; We know 3 and 5 are in the same equivalent list because 5 maps to 3
    429 ;; in `undo-equiv-table' (basically).
    430 
    431 (defun vundo--master-eqv-mod-of (mod)
    432   "Return the master mod in the eqv-list of MOD.
    433 Master mod is the mod with the smallest index in the eqv-list.
    434 This function is equivalent to (car (vundo--eqv-list-of mod))."
    435   (while (vundo-m-prev-eqv mod)
    436     (cl-assert (not (eq mod (vundo-m-prev-eqv mod))))
    437     (setq mod (vundo-m-prev-eqv mod)))
    438   mod)
    439 
    440 (defun vundo--eqv-list-of (mod)
    441   "Return all the modifications equivalent to MOD."
    442   (while (vundo-m-next-eqv mod)
    443     (cl-assert (not (eq mod (vundo-m-next-eqv mod))))
    444     (setq mod (vundo-m-next-eqv mod)))
    445   ;; Start at the last mod in the equiv chain, walk back to the first.
    446   (let ((eqv-list (list mod)))
    447     (while (vundo-m-prev-eqv mod)
    448       (cl-assert (not (eq mod (vundo-m-prev-eqv mod))))
    449       (setq mod (vundo-m-prev-eqv mod))
    450       (push mod eqv-list))
    451     eqv-list))
    452 
    453 (defun vundo--eqv-merge (mlist)
    454   "Connect modifications in MLIST to be in the same equivalence list.
    455 Order is reserved."
    456   ;; Basically, for MLIST = (A B C), set
    457   ;; A.prev = nil  A.next = B
    458   ;; B.prev = A    B.next = C
    459   ;; C.prev = B    C.next = nil
    460   (cl-loop for this-tail = mlist then (cdr this-tail)
    461            for next-tail = (cdr mlist) then (cdr next-tail)
    462            for prev-tail = (cons nil mlist) then (cdr prev-tail)
    463            while this-tail
    464            do (setf (vundo-m-prev-eqv (car this-tail)) (car prev-tail))
    465            do (setf (vundo-m-next-eqv (car this-tail)) (car next-tail))))
    466 
    467 (defun vundo--sort-mod (mlist &optional reverse)
    468   "Return sorted modifications in MLIST by their idx...
    469 ...in ascending order. If REVERSE non-nil, sort in descending
    470 order."
    471   (seq-sort (if reverse
    472                 (lambda (m1 m2)
    473                   (> (vundo-m-idx m1) (vundo-m-idx m2)))
    474               (lambda (m1 m2)
    475                 (< (vundo-m-idx m1) (vundo-m-idx m2))))
    476             mlist))
    477 
    478 (defun vundo--eqv-merge-mod (m1 m2)
    479   "Put M1 and M2 into the same equivalence list."
    480   (let ((l1 (vundo--eqv-list-of m1))
    481         (l2 (vundo--eqv-list-of m2)))
    482     (vundo--eqv-merge (vundo--sort-mod (cl-union l1 l2)))))
    483 
    484 (defun vundo--build-tree (mod-list mod-hash &optional from)
    485   "Connect equivalent modifications and build the tree in MOD-LIST.
    486 MOD-HASH maps undo-lists to modifications.
    487 If FROM non-nil, build from FORM-th modification in MOD-LIST."
    488   (cl-loop
    489    for m from (or from 0) to (1- (length mod-list))
    490    for mod = (aref mod-list m)
    491    ;; If MOD is an undo, the buffer state it represents is equivalent
    492    ;; to a previous one.
    493    do (let ((prev-undo (undo--last-change-was-undo-p
    494                         (vundo-m-undo-list mod))))
    495         (pcase prev-undo
    496           ;; This is an undo. Merge it with its equivalent nodes.
    497           ((and (pred consp)
    498                 ;; It is possible for us to not find the PREV-UNDO in
    499                 ;; our mod-list: if Emacs garbage collected prev-m,
    500                 ;; then it will not end up in mod-list. NOTE: Is it
    501                 ;; also possible that unable to find PREV-M is an
    502                 ;; error? Maybe, but I think that's highly unlikely.
    503                 (guard (gethash prev-undo mod-hash)))
    504            (let ((prev-m (gethash prev-undo mod-hash)))
    505              (vundo--eqv-merge-mod prev-m mod)))
    506           ;; This undo undoes to root, merge with the root node.
    507           ('t (vundo--eqv-merge-mod (aref mod-list 0) mod))
    508           ;; This modification either is a region-undo, nil undo, or
    509           ;; not an undo. We treat them the same.
    510           ((or 'undo-in-region 'empty _)
    511            ;; If MOD isn't an undo, it represents a new buffer state,
    512            ;; we connect M-1 with M, where M-1 is the parent and M is
    513            ;; the child.
    514            (unless (eq m 0)
    515              (let* ((m-1 (aref mod-list (1- m)))
    516                     (min-eqv-mod (vundo--master-eqv-mod-of m-1)))
    517                (setf (vundo-m-parent mod) min-eqv-mod)
    518                (let ((children (vundo-m-children min-eqv-mod)))
    519                  ;; If everything goes right, we should never encounter
    520                  ;; this.
    521                  (cl-assert (not (memq mod children)))
    522                  (setf (vundo-m-children min-eqv-mod)
    523                        ;; We sort in reverse order, ie, later mod
    524                        ;; comes first. Later in `vundo--build-tree' we
    525                        ;; draw the tree depth-first.
    526                        (vundo--sort-mod (cons mod children)
    527                                         'reverse))))))))))
    528 
    529 ;;; Timestamps
    530 
    531 ;; buffer-undo-list contains "timestamp entries" within a record like
    532 ;; (t . TIMESTAMP).  These capture the file modification time of the
    533 ;; saved file which that undo changed (i.e. the TIMESTAMP applies to
    534 ;; the prior state).  While reading the undo list, we collect these,
    535 ;; sort them, and during tree draw, indicate nodes which had been
    536 ;; saved specially.  Note that the buffer associated with the current
    537 ;; node can be saved, but not yet modified by an undo/redo; this is
    538 ;; handled specially.
    539 
    540 (defvar-local vundo--timestamps nil
    541   "An alist mapping mods to modification times.
    542 
    543 When there are multiple mods corresponding to the same node in
    544 the undo tree, use the master equivalent mod as the
    545 key (‘vundo--master-eqv-mod-of’).
    546 
    547 Sorted by time, with latest saved mods first.  Only undo-based
    548 modification times are included; see `vundo--node-timestamp'.")
    549 
    550 (defun vundo--record-timestamps (mod-list)
    551   "Return an alist mapping mods in MOD-LIST to timestamps.
    552 The alist is sorted by time, with latest saved mods first."
    553   (let ((timestamps ()))
    554     (cl-loop for idx from 1 below (length mod-list)
    555              for ts = (vundo-m-timestamp (aref mod-list idx))
    556              if ts do
    557              (let* ((mod-node (aref mod-list (1- idx)))
    558                     (master (vundo--master-eqv-mod-of mod-node))
    559                     (entry (assq master timestamps))
    560                     (old-ts (cdr entry)))
    561                (when (and old-ts (time-less-p ts old-ts))
    562                  ;; Equivalent node modified again? take the newer time.
    563                  (setq ts old-ts))
    564                (if entry (setcdr entry ts)
    565                  (push (cons master ts) timestamps))))
    566     (sort timestamps  ; Sort latest first.
    567           (lambda (a b) (time-less-p (cdr b) (cdr a))))))
    568 
    569 (defun vundo--find-last-saved (node &optional arg)
    570   "Return the last saved node prior to NODE.
    571 ARG (default 1) specifies the number of saved nodes to move
    572 backwards in history.  ARG<0 indicates moving that many saved
    573 nodes forward in history.  Returns nil if no such saved node
    574 exists."
    575   (let* ((arg (or arg 1))
    576          (past (>= arg 0))
    577          (cnt (abs arg))
    578          (master (vundo--master-eqv-mod-of node))
    579          (midx (vundo-m-idx master))
    580          last-node)
    581     (if (assq master vundo--timestamps)
    582         (setq last-node master)
    583       ;; No timestamp here, find closest master idx on saved list in
    584       ;; the direction indicated by ARG.
    585       (cl-loop with val = (if past -1 most-positive-fixnum)
    586                with between = (if past #'< #'>)
    587                for (n . _) in vundo--timestamps
    588                for idx = (vundo-m-idx n)
    589                if (funcall between val idx midx)
    590                do (setq val idx last-node n))
    591       ;; Use up one count when getting started.
    592       (when last-node (setq cnt (1- cnt))))
    593 
    594     ;; Found one, but more to go.
    595     (if (and last-node (> cnt 0))
    596         (let ((vt (if past vundo--timestamps
    597                     (reverse vundo--timestamps))))
    598           (while (and vt (not (eq (caar vt) last-node)))
    599             (setq vt (cdr vt)))
    600           (caar (nthcdr cnt vt)))
    601       last-node)))
    602 
    603 (defvar vundo--orig-buffer)
    604 (defun vundo--node-timestamp (mod-list node &optional no-buffer)
    605   "Return a timestamp from MOD-LIST for NODE, if any.
    606 In addition to undo-based timestamps, this includes the modtime
    607 of the current buffer (if it has an associated file which is
    608 unmodified and NO-BUFFER is non-nil)."
    609   (when-let ((master (vundo--master-eqv-mod-of node)))
    610     (or (alist-get master vundo--timestamps nil nil #'eq)
    611         (and (eq node (vundo--current-node mod-list))
    612              (with-current-buffer vundo--orig-buffer
    613                (and (not no-buffer) (buffer-file-name)
    614                     (not (buffer-modified-p))
    615                     (visited-file-modtime)))))))
    616 
    617 ;;; Draw tree
    618 
    619 (defun vundo--put-node-at-point (node)
    620   "Store the corresponding NODE as text property at point."
    621   (put-text-property (1- (point)) (point)
    622                      'vundo-node
    623                      node))
    624 
    625 (defun vundo--get-node-at-point ()
    626   "Retrieve the corresponding NODE as text property at point."
    627   (plist-get (text-properties-at (1- (point)))
    628              'vundo-node))
    629 
    630 (defun vundo--next-line-at-column (col)
    631   "Move point to next line column COL."
    632   (unless (and (eq 0 (forward-line))
    633                (not (eobp)))
    634     (goto-char (point-max))
    635     (insert "\n"))
    636   (move-to-column col)
    637   (unless (eq (current-column) col)
    638     (let ((indent-tabs-mode nil))
    639       (indent-to-column col))))
    640 
    641 (defun vundo--translate (text)
    642   "Translate each character in TEXT and return translated TEXT.
    643 Translate according to `vundo-glyph-alist'."
    644   (seq-mapcat (lambda (ch)
    645                 (char-to-string
    646                  (alist-get
    647                   (pcase ch
    648                     (?○ 'node)
    649                     (?● 'selected-node)
    650                     (?─ 'horizontal-stem)
    651                     (?│ 'vertical-stem)
    652                     (?├ 'branch)
    653                     (?└ 'last-branch))
    654                   vundo-glyph-alist)))
    655               text 'string))
    656 
    657 (defun vundo--draw-tree (mod-list)
    658   "Draw the tree in MOD-LIST in current buffer."
    659   (let* ((root (aref mod-list 0))
    660          (node-queue (list root))
    661          (inhibit-read-only t)
    662          (inhibit-modification-hooks t))
    663     (erase-buffer)
    664     (while node-queue
    665       (let* ((node (pop node-queue))
    666              (children (vundo-m-children node))
    667              (parent (vundo-m-parent node))
    668              (siblings (and parent (vundo-m-children parent)))
    669              (only-child-p (and parent (eq (length siblings) 1)))
    670              (node-last-child-p (and parent (eq node (car (last siblings)))))
    671              (mod-ts (vundo--node-timestamp mod-list node 'no-buffer))
    672              (node-face (if (and vundo-highlight-saved-nodes mod-ts)
    673                             'vundo-saved 'vundo-node))
    674              (stem-face (if only-child-p 'vundo-stem 'vundo-branch-stem)))
    675         ;; Go to parent.
    676         (if parent (goto-char (vundo-m-point parent)))
    677         (let ((room-for-another-rx
    678                (rx-to-string
    679                 `(or (>= ,(if vundo-compact-display 3 4) ?\s) eol))))
    680           (if (null parent)
    681               (insert (propertize (vundo--translate "○")
    682                                   'face node-face))
    683             (let ((planned-point (point)))
    684               ;; If a node is blocking, try next line.
    685               ;; Example: 1--2--3  Here we want to add a
    686               ;;             |     child to 1 but is blocked
    687               ;;             +--4  by that plus sign.
    688               (while (not (looking-at room-for-another-rx))
    689                 (vundo--next-line-at-column (max 0 (1- (current-column))))
    690                 ;; When we go down, we could encounter space, EOL, │,
    691                 ;; ├, or └. Space and EOL should be replaced by │, ├
    692                 ;; and └ should be replaced by ├.
    693                 (let ((replace-char
    694                        (if (looking-at
    695                             (rx-to-string
    696                              `(or ,(vundo--translate "├")
    697                                   ,(vundo--translate "└"))))
    698                            (vundo--translate "├")
    699                          (vundo--translate "│"))))
    700                   (unless (eolp) (delete-char 1))
    701                   (insert (propertize replace-char 'face stem-face))))
    702               ;; Make room for inserting the new node.
    703               (unless (looking-at "$")
    704                 (delete-char (if vundo-compact-display 2 3)))
    705               ;; Insert the new node.
    706               (if (eq (point) planned-point)
    707                   (insert (propertize
    708                            (vundo--translate
    709                             (if vundo-compact-display "─" "──"))
    710                            'face stem-face)
    711                           (propertize (vundo--translate "○")
    712                                       'face node-face))
    713                 ;; We must break the line. Delete the previously
    714                 ;; inserted char.
    715                 (delete-char -1)
    716                 (insert (propertize
    717                          (vundo--translate
    718                           (if node-last-child-p
    719                               (if vundo-compact-display "└─" "└──")
    720                             (if vundo-compact-display "├─" "├──")))
    721                          'face stem-face))
    722                 (insert (propertize (vundo--translate "○")
    723                                     'face node-face))))))
    724         ;; Store point so we can later come back to this node.
    725         (setf (vundo-m-point node) (point))
    726         ;; Associate the text node in buffer with the node object.
    727         (vundo--put-node-at-point node)
    728         ;; Depth-first search.
    729         (setq node-queue (append children node-queue))))))
    730 
    731 ;;; Vundo buffer and invocation
    732 
    733 (defun vundo--buffer ()
    734   "Return the vundo buffer."
    735   (get-buffer-create " *vundo tree*"))
    736 
    737 (defun vundo--kill-buffer-if-point-left (window)
    738   "Kill the vundo buffer if point left WINDOW.
    739 WINDOW is the window that was/is displaying the vundo buffer."
    740   (if (and (eq (window-buffer window) (vundo--buffer))
    741            (not (eq window (selected-window))))
    742       (with-selected-window window
    743         (kill-buffer-and-window))))
    744 
    745 (declare-function vundo-diff "vundo-diff")
    746 (declare-function vundo-diff-mark "vundo-diff")
    747 (declare-function vundo-diff-unmark "vundo-diff")
    748 (defvar vundo-mode-map
    749   (let ((map (make-sparse-keymap)))
    750     (define-key map (kbd "f") #'vundo-forward)
    751     (define-key map (kbd "<right>") #'vundo-forward)
    752     (define-key map (kbd "b") #'vundo-backward)
    753     (define-key map (kbd "<left>") #'vundo-backward)
    754     (define-key map (kbd "n") #'vundo-next)
    755     (define-key map (kbd "<down>") #'vundo-next)
    756     (define-key map (kbd "p") #'vundo-previous)
    757     (define-key map (kbd "<up>") #'vundo-previous)
    758     (define-key map (kbd "a") #'vundo-stem-root)
    759     (define-key map (kbd "e") #'vundo-stem-end)
    760     (define-key map (kbd "l") #'vundo-goto-last-saved)
    761     (define-key map (kbd "r") #'vundo-goto-next-saved)
    762     (define-key map (kbd "q") #'vundo-quit)
    763     (define-key map (kbd "C-g") #'vundo-quit)
    764     (define-key map (kbd "RET") #'vundo-confirm)
    765     (define-key map (kbd "m") #'vundo-diff-mark)
    766     (define-key map (kbd "u") #'vundo-diff-unmark)
    767     (define-key map (kbd "d") #'vundo-diff)
    768     (define-key map (kbd "i") #'vundo--inspect)
    769     (define-key map (kbd "D") #'vundo--debug)
    770 
    771     (define-key map [remap save-buffer] #'vundo-save)
    772     map)
    773   "Keymap for `vundo-mode'.")
    774 
    775 (define-derived-mode vundo-mode special-mode
    776   "Vundo" "Mode for displaying the undo tree."
    777   (setq mode-line-format nil
    778         truncate-lines t
    779         cursor-type nil)
    780   (jit-lock-mode nil)
    781   (face-remap-add-relative 'default 'vundo-default)
    782 
    783   ;; Disable evil-mode, as normal-mode
    784   ;; key bindings override the ones set by vundo.
    785   (when (and (boundp 'evil-emacs-state-modes)
    786              (not (memq 'vundo-mode evil-emacs-state-modes)))
    787     (push 'vundo-mode evil-emacs-state-modes)))
    788 
    789 (defvar-local vundo--prev-mod-list nil
    790   "Modification list generated by `vundo--mod-list-from'.")
    791 (defvar-local vundo--prev-mod-hash nil
    792   "Modification hash table generated by `vundo--update-mapping'.")
    793 (defvar-local vundo--prev-undo-list nil
    794   "Original buffer's `buffer-undo-list'.")
    795 (defvar-local vundo--orig-buffer nil
    796   "Vundo buffer displays the undo tree for this buffer.")
    797 (defvar-local vundo--message nil
    798   "If non-nil, print information when moving between nodes.")
    799 (defvar-local vundo--roll-back-to-this nil
    800   "Vundo will roll back to this node.")
    801 (defvar-local vundo--highlight-overlay nil
    802   "Overlay used to highlight the selected node.")
    803 (defvar-local vundo--highlight-last-saved-overlay nil
    804   "Overlay used to highlight the last saved node.")
    805 
    806 (defun vundo--mod-list-trim (mod-list n)
    807   "Remove MODS from MOD-LIST.
    808 Keep the first N modifications."
    809   (cl-loop for midx from (1+ n) to (1- (length mod-list))
    810            for mod = (aref mod-list midx)
    811            do (let ((parent (vundo-m-parent mod))
    812                     (eqv-list (vundo--eqv-list-of mod)))
    813                 (when parent
    814                   (setf (vundo-m-children parent)
    815                         (remove mod (vundo-m-children parent))))
    816                 (when eqv-list
    817                   (vundo--eqv-merge (remove mod eqv-list)))))
    818   (seq-subseq mod-list 0 (1+ n)))
    819 
    820 (defun vundo--refresh-buffer
    821     (orig-buffer vundo-buffer &optional incremental)
    822   "Refresh VUNDO-BUFFER with the undo history of ORIG-BUFFER.
    823 If INCREMENTAL non-nil, reuse existing mod-list and mod-hash.
    824 INCREMENTAL is only applicable when entries are either added or
    825 removed from undo-list. On the other hand, if some entries are
    826 removed and some added, do not use INCREMENTAL.
    827 
    828 This function modifies `vundo--prev-mod-list',
    829 `vundo--prev-mod-hash', `vundo--prev-undo-list',
    830 `vundo--orig-buffer'."
    831   (with-current-buffer vundo-buffer
    832     ;; 1. Setting these to nil makes `vundo--mod-list-from',
    833     ;; `vundo--update-mapping' and `vundo--build-tree' starts from
    834     ;; scratch.
    835     (when (not incremental)
    836       (setq vundo--prev-undo-list nil
    837             vundo--prev-mod-list nil
    838             vundo--prev-mod-hash nil)
    839       ;; Give the garbage collector a chance to release
    840       ;; `buffer-undo-list': GC cannot release cons cells when all
    841       ;; these stuff are referring to it.
    842       (garbage-collect))
    843     (let ((undo-list (buffer-local-value
    844                       'buffer-undo-list orig-buffer))
    845           mod-list
    846           mod-hash
    847           (latest-state (and vundo--prev-mod-list
    848                              (vundo--latest-buffer-state
    849                               vundo--prev-mod-list)))
    850           (inhibit-read-only t))
    851       ;; 2. Here we consider two cases, adding more nodes (or starting
    852       ;; from scratch) or removing nodes. In both cases, we update and
    853       ;; set MOD-LIST and MOD-HASH. We don't need to worry about the
    854       ;; garbage collector trimming the end of `buffer-undo-list': if
    855       ;; we are generating MOD-LIST from scratch, it will work as
    856       ;; normal, if we are generating incrementally,
    857       ;; `vundo--prev-undo-list' holds the untrimmed undo list.
    858       (if-let ((new-tail (and vundo--prev-mod-hash
    859                               (gethash (vundo--sans-nil undo-list)
    860                                        vundo--prev-mod-hash))))
    861           ;; a) Removing.
    862           (setq mod-list (vundo--mod-list-trim vundo--prev-mod-list
    863                                                (vundo-m-idx new-tail))
    864                 mod-hash vundo--prev-mod-hash)
    865         ;; b) Adding.
    866         (let ((diff (- (length undo-list)
    867                        (length vundo--prev-undo-list))))
    868           (cl-assert (eq vundo--prev-undo-list (nthcdr diff undo-list)))
    869           (setq mod-list (vundo--mod-list-from
    870                           undo-list diff vundo--prev-mod-list)
    871                 mod-hash (vundo--update-mapping
    872                           mod-list vundo--prev-mod-hash
    873                           (length vundo--prev-mod-list)))
    874           ;; Build tree.
    875           (vundo--build-tree mod-list mod-hash
    876                              (length vundo--prev-mod-list))))
    877       
    878       ;; Update cache.
    879       (setq vundo--prev-mod-list mod-list
    880             vundo--prev-mod-hash mod-hash
    881             vundo--prev-undo-list undo-list
    882             vundo--orig-buffer orig-buffer)
    883       
    884       ;; Record timestamps
    885       (setq vundo--timestamps (vundo--record-timestamps mod-list))
    886 
    887       ;; 3. Render buffer. We don't need to redraw the tree if there
    888       ;; is no change to the nodes.
    889       (unless (eq (vundo--latest-buffer-state mod-list) latest-state)
    890         (vundo--draw-tree mod-list))
    891 
    892       ;; Highlight current node.
    893       (vundo--highlight-node (vundo--current-node mod-list))
    894       (goto-char (vundo-m-point (vundo--current-node mod-list)))
    895 
    896       ;; Highlight the last saved node extra specially
    897       (when vundo-highlight-saved-nodes
    898         (vundo--highlight-last-saved-node mod-list vundo--timestamps)))))
    899 
    900 (defun vundo--current-node (mod-list)
    901   "Return the currently highlighted node in MOD-LIST."
    902   (vundo--master-eqv-mod-of (aref mod-list (1- (length mod-list)))))
    903 
    904 (defun vundo--highlight-node (node)
    905   "Highlight NODE as current node."
    906   (unless vundo--highlight-overlay
    907     (setq vundo--highlight-overlay
    908           (make-overlay (1- (vundo-m-point node)) (vundo-m-point node)))
    909     (overlay-put vundo--highlight-overlay
    910                  'display (vundo--translate "●"))
    911     (overlay-put vundo--highlight-overlay
    912                  'face 'vundo-highlight)
    913     ;; Make current node’s highlight override last saved node’s
    914     ;; highlight, should they collide.
    915     (overlay-put vundo--highlight-overlay 'priority 2))
    916   (move-overlay vundo--highlight-overlay
    917                 (1- (vundo-m-point node))
    918                 (vundo-m-point node)))
    919 
    920 (defun vundo--highlight-last-saved-node (mod-list timestamps)
    921   "Highlight the last (latest) saved node on MOD-LIST.
    922 Consults the alist of TIMESTAMPS.  This moves the overlay
    923 `vundo--highlight-last-saved-overlay'."
    924   (let* ((last-saved (car timestamps))
    925          (cur (vundo--current-node mod-list))
    926          (cur-ts (vundo--node-timestamp mod-list cur))
    927          (node (cond ((and last-saved cur-ts)
    928                       (if (time-less-p (cdr last-saved) cur-ts)
    929                           cur (car last-saved)))
    930                      (last-saved (car last-saved))
    931                      (cur-ts cur)
    932                      (t nil)))
    933          (node-pt (and node (vundo-m-point node))))
    934     (when node-pt
    935       (unless vundo--highlight-last-saved-overlay
    936         (setq vundo--highlight-last-saved-overlay
    937               (make-overlay (1- node-pt) node-pt))
    938         (overlay-put vundo--highlight-last-saved-overlay
    939                      'face 'vundo-last-saved))
    940       (move-overlay vundo--highlight-last-saved-overlay
    941                     (1- node-pt) node-pt))))
    942 
    943 ;;;###autoload
    944 (defun vundo ()
    945   "Display visual undo for the current buffer."
    946   (interactive)
    947   (when (not (consp buffer-undo-list))
    948     (user-error "There is no undo history"))
    949   (when buffer-read-only
    950     (user-error "Buffer is read-only"))
    951   (run-hooks 'vundo-pre-enter-hook)
    952   (let ((vundo-buf (vundo-1 (current-buffer))))
    953     (select-window
    954      (display-buffer-in-side-window
    955       vundo-buf
    956       `((side . ,vundo-window-side)
    957         (window-height . 3))))
    958     (set-window-dedicated-p nil t)
    959     (let ((window-min-height 3))
    960       (fit-window-to-buffer nil vundo-window-max-height))
    961     (goto-char
    962      (vundo-m-point
    963       (vundo--current-node vundo--prev-mod-list)))
    964     (setq vundo--roll-back-to-this
    965           (vundo--current-node vundo--prev-mod-list))))
    966 
    967 (defun vundo-1 (buffer)
    968   "Return a vundo buffer for BUFFER.
    969 BUFFER must have a valid `buffer-undo-list'."
    970   (with-current-buffer buffer
    971     (let ((vundo-buf (vundo--buffer))
    972           (orig-buf (current-buffer)))
    973       (with-current-buffer vundo-buf
    974         ;; Enable major mode before refreshing the buffer.
    975         ;; Because major modes kill local variables.
    976         (unless (derived-mode-p 'vundo-mode)
    977           (vundo-mode))
    978         (vundo--refresh-buffer orig-buf vundo-buf)
    979         vundo-buf))))
    980 
    981 (defmacro vundo--check-for-command (&rest body)
    982   "Sanity check before running interactive commands.
    983 Do sanity check, then evaluate BODY."
    984   (declare (debug (&rest form)))
    985   `(progn
    986      (when (not (derived-mode-p 'vundo-mode))
    987        (user-error "Not in vundo buffer"))
    988      (when (not (buffer-live-p vundo--orig-buffer))
    989        (when (y-or-n-p "Original buffer is gone, kill vundo buffer? ")
    990          (kill-buffer-and-window))
    991        ;; Non-local exit.
    992        (user-error ""))
    993      ;; If ORIG-BUFFER changed since we last synced the vundo buffer
    994      ;; (eg, user left vundo buffer and did some edit in ORIG-BUFFER
    995      ;; then comes back), refresh to catch up.
    996      (let ((undo-list (buffer-local-value
    997                        'buffer-undo-list vundo--orig-buffer)))
    998        ;; 1. Refresh if the beginning is not the same.
    999        (cond ((not (eq (vundo--sans-nil undo-list)
   1000                        (vundo--sans-nil vundo--prev-undo-list)))
   1001               (vundo--refresh-buffer vundo--orig-buffer (current-buffer))
   1002               (message "Refresh"))
   1003              ;; 2. It is possible that GC trimmed the end of undo
   1004              ;; list, but that doesn't affect us:
   1005              ;; `vundo--prev-mod-list' and `vundo--prev-undo-list' are
   1006              ;; still perfectly fine. Run the command normally. Of
   1007              ;; course, the next time the user invokes `vundo', the
   1008              ;; new tree will reflect the trimmed undo list.
   1009              (t ,@body)))))
   1010 
   1011 (defun vundo-quit ()
   1012   "Quit buffer and window.
   1013 Roll back changes if `vundo-roll-back-on-quit' is non-nil."
   1014   (interactive)
   1015   (vundo--check-for-command
   1016    (when (and vundo-roll-back-on-quit vundo--roll-back-to-this
   1017               (not (eq vundo--roll-back-to-this
   1018                        (vundo--current-node vundo--prev-mod-list))))
   1019      (vundo--move-to-node
   1020       (vundo--current-node vundo--prev-mod-list)
   1021       vundo--roll-back-to-this
   1022       vundo--orig-buffer vundo--prev-mod-list))
   1023    (with-current-buffer vundo--orig-buffer
   1024      (setq-local buffer-read-only nil))
   1025    (let* ((orig-buffer vundo--orig-buffer)
   1026           (orig-window (get-buffer-window orig-buffer)))
   1027      (kill-buffer-and-window)
   1028      (when (window-live-p orig-window)
   1029        (select-window orig-window))
   1030      (with-current-buffer orig-buffer
   1031        (run-hooks 'vundo-post-exit-hook)))))
   1032 
   1033 (defun vundo-confirm ()
   1034   "Confirm change and close vundo window."
   1035   (interactive)
   1036   (with-current-buffer vundo--orig-buffer
   1037     (setq-local buffer-read-only nil))
   1038   (let* ((orig-buffer vundo--orig-buffer)
   1039          (orig-window (get-buffer-window orig-buffer)))
   1040     (kill-buffer-and-window)
   1041     (when (window-live-p orig-window)
   1042       (select-window orig-window))
   1043     (with-current-buffer orig-buffer
   1044       (run-hooks 'vundo-post-exit-hook))))
   1045 
   1046 ;;; Traverse undo tree
   1047 
   1048 (defun vundo--calculate-shortest-route (from to)
   1049   "Calculate the shortest route from FROM to TO node.
   1050 Return (SOURCE STOP1 STOP2 ... DEST), meaning you should undo the
   1051 modifications from DEST to SOURCE. Each STOP is an intermediate
   1052 stop. Eg, (6 5 4 3). Return nil if there’s no valid route."
   1053   (let (route-list)
   1054     ;; Find all valid routes.
   1055     (dolist (source (vundo--eqv-list-of from))
   1056       (dolist (dest (vundo--eqv-list-of to))
   1057         ;; We only allow route in this direction.
   1058         (if (> (vundo-m-idx source) (vundo-m-idx dest))
   1059             (push (cons (vundo-m-idx source)
   1060                         (vundo-m-idx dest))
   1061                   route-list))))
   1062     ;; Find the shortest route.
   1063     (setq route-list
   1064           (seq-sort
   1065            (lambda (r1 r2)
   1066              ;; Ie, distance between SOURCE and DEST in R1 compare
   1067              ;; against distance in R2.
   1068              (< (- (car r1) (cdr r1)) (- (car r2) (cdr r2))))
   1069            route-list))
   1070     (if-let* ((route (car route-list))
   1071               (source (car route))
   1072               (dest (cdr route)))
   1073         (number-sequence source dest -1))))
   1074 
   1075 (defun vundo--list-subtract (l1 l2)
   1076   "Return L1 - L2.
   1077 
   1078 \(vundo--list-subtract \='(4 3 2 1) \='(2 1))
   1079 => (4 3)"
   1080   (let ((len1 (length l1))
   1081         (len2 (length l2)))
   1082     (cl-assert (> len1 len2))
   1083     (seq-subseq l1 0 (- len1 len2))))
   1084 
   1085 (defun vundo--sans-nil (undo-list)
   1086   "Return UNDO-LIST sans leading nils.
   1087 If UNDO-LIST is nil, return nil."
   1088   (while (and (consp undo-list) (null (car undo-list)))
   1089     (setq undo-list (cdr undo-list)))
   1090   undo-list)
   1091 
   1092 (defun vundo--latest-buffer-state (mod-list)
   1093   "Return the node representing the latest buffer state.
   1094 Basically, return the latest non-undo modification in MOD-LIST."
   1095   (let ((max-node (aref mod-list 0)))
   1096     (cl-loop for midx from 1 to (1- (length mod-list))
   1097              for mod = (aref mod-list midx)
   1098              do (if (and (null (vundo-m-prev-eqv mod))
   1099                          (> (vundo-m-idx mod)
   1100                             (vundo-m-idx max-node)))
   1101                     (setq max-node mod)))
   1102     max-node))
   1103 
   1104 (defun vundo--move-to-node (current dest orig-buffer mod-list)
   1105   "Move from CURRENT node to DEST node by undoing in ORIG-BUFFER.
   1106 ORIG-BUFFER must be at CURRENT state. MOD-LIST is the list you
   1107 get from `vundo--mod-list-from'. You should refresh vundo buffer
   1108 after calling this function. (You can call this function
   1109 repeatedly before refreshing, but moving back-and-forth might not
   1110 work, see docstring of ‘vundo--trim-undo-list’.)
   1111 
   1112 This function modifies the content of ORIG-BUFFER."
   1113   (cl-assert (not (eq current dest)))
   1114   ;; 1. Find the route we want to take.
   1115   (if-let* ((route (vundo--calculate-shortest-route current dest)))
   1116       (let* ((source-idx (car route))
   1117              (dest-idx (car (last route)))
   1118              ;; The complete undo-list that stops at SOURCE.
   1119              (undo-list-at-source
   1120               (vundo-m-undo-list (aref mod-list source-idx)))
   1121              ;; The complete undo-list that stops at DEST.
   1122              (undo-list-at-dest
   1123               (vundo-m-undo-list (aref mod-list dest-idx)))
   1124              ;; We will undo these modifications.
   1125              (planned-undo (vundo--list-subtract
   1126                             undo-list-at-source undo-list-at-dest))
   1127              ;; We don’t want to quit in the middle of this function.
   1128              (inhibit-quit t))
   1129         (with-current-buffer orig-buffer
   1130           (setq-local buffer-read-only t)
   1131           ;; 2. Undo. This will undo modifications in PLANNED-UNDO and
   1132           ;; add new entries to `buffer-undo-list'.
   1133           (let ((undo-in-progress t))
   1134             (cl-loop
   1135              for step = (- source-idx dest-idx)
   1136              then (1- step)
   1137              while (and (> step 0)
   1138                         ;; If there is a quit signal, we break the
   1139                         ;; loop, continue to step 3 and 4, then quits
   1140                         ;; when we go out of the let-form.
   1141                         (not quit-flag))
   1142              for stop = (1- source-idx) then (1- stop)
   1143              do
   1144              (progn
   1145                ;; Stop at each intermediate stop along the route to
   1146                ;; create trim points for future undo.
   1147                (setq planned-undo (primitive-undo 1 planned-undo))
   1148                (cl-assert (not (and (consp buffer-undo-list)
   1149                                     (null (car buffer-undo-list)))))
   1150                (let ((undo-list-at-stop
   1151                       (vundo-m-undo-list (aref mod-list stop))))
   1152                  (puthash buffer-undo-list (or undo-list-at-stop t)
   1153                           undo-equiv-table))
   1154                (push nil buffer-undo-list))))
   1155           ;; 3. Some misc work.
   1156           (when vundo--message
   1157             (message "%s -> %s Steps: %s Undo-list len: %s"
   1158                      (mapcar #'vundo-m-idx (vundo--eqv-list-of
   1159                                             (aref mod-list source-idx)))
   1160                      (mapcar #'vundo-m-idx (vundo--eqv-list-of
   1161                                             (aref mod-list dest-idx)))
   1162                      (length planned-undo)
   1163                      (length buffer-undo-list)))
   1164           (when-let ((win (get-buffer-window)))
   1165             (set-window-point win (point)))))
   1166     (error "No possible route")))
   1167 
   1168 (defun vundo--trim-undo-list (buffer current mod-list)
   1169   "Trim `buffer-undo-list' in BUFFER according to CURRENT and MOD-LIST.
   1170 CURRENT is the current mod, MOD-LIST is the current mod-list.
   1171 
   1172 This function modifies `buffer-undo-list' of BUFFER.
   1173 
   1174 IMPORTANT Relationship between `vundo--move-to-node',
   1175 `vundo--refresh-buffer', `vundo--trim-undo-list':
   1176 
   1177 Each vundo command cycle roughly works like this:
   1178 1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list
   1179 2. `vundo--move-to-node': read mod-list, modify `buffer-undo-list'
   1180 3. `vundo--trim-undo-list': trim `buffer-undo-list'
   1181 1. `vundo--refresh-buffer': `buffer-undo-list' -> mod-list
   1182 ...
   1183 
   1184 We can call `vundo--move-to-node' multiple times between two
   1185 `vundo--refresh-buffer'. But we should only call
   1186 `vundo--trim-undo-list' once between two `vundo--refresh-buffer'.
   1187 Because if we only trim once, `buffer-undo-list' either shrinks
   1188 or expands. But if we trim multiple times after multiple
   1189 movements, it could happen that the undo-list first
   1190 shrinks (trimmed) then expands. In that situation we cannot use
   1191 the INCREMENTAL option in `vundo--refresh-buffer' anymore.
   1192 
   1193 Also, if you move back-end-forth with ‘vundo--move-to-node’, it
   1194 might not work: Suppose undo list is [1 2 3], mod-list is [1 2
   1195 3], now we move back to 2, undo list becomes [1 2 3 2’], but
   1196 before we refresh vundo buffer, mod-list will remain [1 2 3], so
   1197 there’s no route from 2 to 3 (you can only move back). Once
   1198 we refresh the buffer and mod-list is updated to [1 2 3 2’], we
   1199 have a route from 3 to 2 (2’->3)."
   1200   (let ((latest-buffer-state-idx
   1201          ;; Among all the MODs that represents a unique buffer
   1202          ;; state, we find the latest one. Because any node
   1203          ;; beyond that one is dispensable.
   1204          (vundo-m-idx
   1205           (vundo--latest-buffer-state mod-list))))
   1206     ;; Find a trim point between latest buffer state and
   1207     ;; current node.
   1208     (when-let ((possible-trim-point
   1209                 (cl-loop for node in (vundo--eqv-list-of current)
   1210                          if (>= (vundo-m-idx node)
   1211                                 latest-buffer-state-idx)
   1212                          return node
   1213                          finally return nil)))
   1214       (with-current-buffer buffer
   1215         (setq buffer-undo-list
   1216               (vundo-m-undo-list possible-trim-point)))
   1217       (when vundo--message
   1218         (message "Trimmed to: %s"
   1219                  (vundo-m-idx possible-trim-point))))))
   1220 
   1221 (defvar vundo-after-undo-functions nil
   1222   "Special hook that runs after `vundo' motions.
   1223 Functions aasigned to this hook are called with one argument: the
   1224 original buffer `vundo' operates on.")
   1225 
   1226 (defun vundo-forward (arg)
   1227   "Move forward ARG nodes in the undo tree.
   1228 If ARG < 0, move backward."
   1229   (interactive "p")
   1230   (vundo--check-for-command
   1231    (let ((step (abs arg)))
   1232      (let* ((source (vundo--current-node vundo--prev-mod-list))
   1233             dest
   1234             (this source)
   1235             (next (if (> arg 0)
   1236                       (car (vundo-m-children this))
   1237                     (vundo-m-parent this))))
   1238        ;; Move to the dest node step-by-step, stop when no further
   1239        ;; node to go to.
   1240        (while (and next (> step 0))
   1241          (setq this next
   1242                next (if (> arg 0)
   1243                         (car (vundo-m-children this))
   1244                       (vundo-m-parent this)))
   1245          (cl-decf step))
   1246        (setq dest this)
   1247        (unless (eq source dest)
   1248          (vundo--move-to-node
   1249           source dest vundo--orig-buffer vundo--prev-mod-list)
   1250          (vundo--trim-undo-list
   1251           vundo--orig-buffer dest vundo--prev-mod-list)
   1252          ;; Refresh display.
   1253          (vundo--refresh-buffer
   1254           vundo--orig-buffer (current-buffer) 'incremental))))
   1255    (run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer)))
   1256 
   1257 (defun vundo-backward (arg)
   1258   "Move back ARG nodes in the undo tree.
   1259 If ARG < 0, move forward."
   1260   (interactive "p")
   1261   (vundo-forward (- arg)))
   1262 
   1263 (defun vundo-next (arg)
   1264   "Move to node below the current one. Move ARG steps."
   1265   (interactive "p")
   1266   (vundo--check-for-command
   1267    (let* ((source (vundo--current-node vundo--prev-mod-list))
   1268           (parent (vundo-m-parent source)))
   1269      ;; Move to next/previous sibling.
   1270      (when parent
   1271        (let* ((siblings (vundo-m-children parent))
   1272               (idx (seq-position siblings source))
   1273               ;; If ARG is larger than the number of siblings,
   1274               ;; move as far as possible (to the end).
   1275               (new-idx (max 0 (min (+ idx arg)
   1276                                    (1- (length siblings)))))
   1277               (dest (nth new-idx siblings)))
   1278          (when (not (eq source dest))
   1279            (vundo--move-to-node
   1280             source dest vundo--orig-buffer vundo--prev-mod-list)
   1281            (vundo--trim-undo-list
   1282             vundo--orig-buffer dest vundo--prev-mod-list)
   1283            (vundo--refresh-buffer
   1284             vundo--orig-buffer (current-buffer)
   1285             'incremental)))))
   1286    (run-hook-with-args 'vundo-after-undo-functions vundo--orig-buffer)))
   1287 
   1288 (defun vundo-previous (arg)
   1289   "Move to node above the current one. Move ARG steps."
   1290   (interactive "p")
   1291   (vundo-next (- arg)))
   1292 
   1293 (defun vundo--stem-root-p (node)
   1294   "Return non-nil if NODE is the root of a stem."
   1295   ;; Ie, parent has more than one children.
   1296   (> (length (vundo-m-children (vundo-m-parent node))) 1))
   1297 
   1298 (defun vundo--stem-end-p (node)
   1299   "Return non-nil if NODE is the end of a stem."
   1300   ;; No children, or more than one children.
   1301   (let ((len (length (vundo-m-children node))))
   1302     (or (> len 1) (eq len 0))))
   1303 
   1304 (defun vundo-stem-root ()
   1305   "Move to the beginning of the current stem."
   1306   (interactive)
   1307   (vundo--check-for-command
   1308    (when-let* ((this (vundo--current-node vundo--prev-mod-list))
   1309                (next (vundo-m-parent this)))
   1310      ;; If NEXT is nil, ie, this node doesn’t have a parent, do
   1311      ;; nothing.
   1312      (vundo--move-to-node
   1313       this next vundo--orig-buffer vundo--prev-mod-list)
   1314      (setq this next
   1315            next (vundo-m-parent this))
   1316      (while (and next (not (vundo--stem-root-p this)))
   1317        (vundo--move-to-node
   1318         this next vundo--orig-buffer vundo--prev-mod-list)
   1319        (setq this next
   1320              next (vundo-m-parent this)))
   1321      (vundo--trim-undo-list
   1322       vundo--orig-buffer this vundo--prev-mod-list)
   1323      (vundo--refresh-buffer
   1324       vundo--orig-buffer (current-buffer)
   1325       'incremental))))
   1326 
   1327 (defun vundo-stem-end ()
   1328   "Move to the end of the current stem."
   1329   (interactive)
   1330   (vundo--check-for-command
   1331    (when-let* ((this (vundo--current-node vundo--prev-mod-list))
   1332                (next (car (vundo-m-children this))))
   1333      ;; If NEXT is nil, ie, this node doesn’t have a child, do
   1334      ;; nothing.
   1335      (vundo--move-to-node
   1336       this next vundo--orig-buffer vundo--prev-mod-list)
   1337      (setq this next
   1338            next (car (vundo-m-children this)))
   1339      (while (and next (not (vundo--stem-end-p this)))
   1340        (vundo--move-to-node
   1341         this next vundo--orig-buffer vundo--prev-mod-list)
   1342        (setq this next
   1343              next (car (vundo-m-children this))))
   1344      (vundo--trim-undo-list
   1345       vundo--orig-buffer this vundo--prev-mod-list)
   1346      (vundo--refresh-buffer
   1347       vundo--orig-buffer (current-buffer)
   1348       'incremental))))
   1349 
   1350 (defun vundo-goto-last-saved (arg)
   1351   "Go back to the first saved node prior to the current node, if any.
   1352 With numeric prefix ARG, move that many saved nodes back (ARG<0
   1353 moves forward in history)."
   1354   (interactive "p")
   1355   (if-let* ((cur (vundo--current-node vundo--prev-mod-list))
   1356             (dest (vundo--find-last-saved cur arg)))
   1357       (progn
   1358         (unless (eq cur dest)
   1359           (vundo--check-for-command
   1360            (vundo--move-to-node
   1361             cur dest vundo--orig-buffer vundo--prev-mod-list)
   1362            (vundo--trim-undo-list
   1363             vundo--orig-buffer dest vundo--prev-mod-list)
   1364            (vundo--refresh-buffer
   1365             vundo--orig-buffer (current-buffer) 'incremental)))
   1366         (message "Node saved %s"
   1367                  (format-time-string
   1368                   "%F %r"
   1369                   (vundo--node-timestamp vundo--prev-mod-list dest))))
   1370     (message "No such saved node")))
   1371 
   1372 (defun vundo-goto-next-saved (arg)
   1373   "Go to the ARGth saved node after the current node (default 1).
   1374 For ARG<0, got the last saved node prior to the current node."
   1375   (interactive "p")
   1376   (vundo-goto-last-saved (- arg)))
   1377 
   1378 (defun vundo-save (arg)
   1379   "Run `save-buffer' with the current buffer Vundo is operating on.
   1380 Accepts the same interactive arfument ARG as ‘save-buffer’."
   1381   (interactive "p")
   1382   (vundo--check-for-command
   1383    (with-current-buffer vundo--orig-buffer
   1384      (save-buffer arg)))
   1385   (when vundo-highlight-saved-nodes
   1386     (vundo--highlight-last-saved-node
   1387      vundo--prev-mod-list vundo--timestamps)))
   1388 
   1389 ;;; Debug
   1390 
   1391 (defun vundo--setup-test-buffer ()
   1392   "Setup and pop a testing buffer.
   1393 TYPE is the type of buffer you want."
   1394   (interactive)
   1395   (let ((buf (get-buffer "*vundo-test*")))
   1396     (if buf (kill-buffer buf))
   1397     (setq buf (get-buffer-create "*vundo-test*"))
   1398     (pop-to-buffer buf)))
   1399 
   1400 (defun vundo--inspect ()
   1401   "Print some useful info about the node at point."
   1402   (interactive)
   1403   (let ((node (vundo--get-node-at-point)))
   1404     (message "Parent: %s States: %s Children: %s%s"
   1405              (and (vundo-m-parent node)
   1406                   (vundo-m-idx (vundo-m-parent node)))
   1407              (mapcar #'vundo-m-idx (vundo--eqv-list-of node))
   1408              (and (vundo-m-children node)
   1409                   (mapcar #'vundo-m-idx (vundo-m-children node)))
   1410              (if-let* ((ts (vundo--node-timestamp vundo--prev-mod-list node))
   1411                        ((consp ts)))
   1412                  (format " Saved: %s" (format-time-string "%F %r" ts))
   1413                ""))))
   1414 
   1415 (defun vundo--debug ()
   1416   "Make cursor visible and show debug information on movement."
   1417   (interactive)
   1418   (setq cursor-type t
   1419         vundo--message t))
   1420 
   1421 (defvar vundo--monitor nil
   1422   "Timer for catching bugs.")
   1423 (defun vundo--start-monitor ()
   1424   "Run `vundo-1' in idle timer to try to catch bugs."
   1425   (interactive)
   1426   (setq vundo--monitor
   1427         (run-with-idle-timer 3 t (lambda ()
   1428                                    (unless (eq t buffer-undo-list)
   1429                                      (vundo-1 (current-buffer))
   1430                                      (message "SUCCESS"))))))
   1431 
   1432 (provide 'vundo)
   1433 
   1434 ;;; vundo.el ends here
   1435 
   1436 ;; Local Variables:
   1437 ;; indent-tabs-mode: nil
   1438 ;; End: