Add truncate-at-node for timestamp-based undo-list truncation

README.txt

@@ -20,6 +20,7 @@ should pop up. To move around, type:
   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
+  K   to truncate the undo list prior to a selected time-stamped node
 
   q   to quit, you can also type C-g
 

vundo.el

@@ -45,6 +45,7 @@
 ;;   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
+;;   K   to truncate the undo list prior to a selected time-stamped node
 ;;
 ;;   q   to quit, you can also type C-g
 ;;
@@ -161,6 +162,7 @@
 (require 'cl-lib)
 (require 'seq)
 (require 'subr-x)
+(require 'time-date)
 
 ;;; Customization
 
@@ -768,6 +770,7 @@ WINDOW is the window that was/is displaying the vundo buffer."
     (define-key map (kbd "d") #'vundo-diff)
     (define-key map (kbd "i") #'vundo--inspect)
     (define-key map (kbd "D") #'vundo--debug)
+    (define-key map (kbd "K") #'vundo-truncate-undo-at-node)
 
     (define-key map [remap save-buffer] #'vundo-save)
     map)
@@ -941,6 +944,68 @@ Consults the alist of TIMESTAMPS.  This moves the overlay
       (move-overlay vundo--highlight-last-saved-overlay
                     (1- node-pt) node-pt))))
 
+(defun vundo-truncate-undo-at-node (node &optional timestamp)
+  "Truncate the buffer's undo list, removing entries before NODE.
+If TIMESTAMP is provided and NODE is nil, use the timestamp to
+identify a saved node to trim to.  Interactively, NODE is
+selected based on its saved timestamp, if any saved nodes exist."
+  (interactive
+   (let* ((undo-cnt (length (buffer-local-value
+                             'buffer-undo-list vundo--orig-buffer)))
+          (ts-list
+           (mapcar
+            (lambda (entry)
+              (cons (format-time-string "%FT%T%z" (cdr entry)) entry))
+            (reverse (seq-filter
+                      (lambda (e)       ; anything to remove?
+                        (and (car e) (cdr (vundo-m-undo-list (car e)))))
+                      vundo--timestamps))))
+          (annotation-function
+           (lambda (time-string)
+             (let* ((entry (alist-get time-string ts-list nil nil #'equal))
+                    (age (seconds-to-string (float-time (time-since (cdr entry)))))
+                    (trim-cnt (length (cdr (vundo-m-undo-list (car entry)))))
+                    (percentage (* 100 (/ (float trim-cnt) undo-cnt)))
+                    (str (format "(%d records, %0.1f%%)" trim-cnt percentage))
+                    (l (length str)))
+               (concat " [" age "]"
+                       (propertize " " 'display
+                                   `(space :align-to (- right ,l)))
+                       str))))
+          (table (lambda (string pred action)
+		   (if (eq action 'metadata) ; timestamps pre-sorted
+		       `(metadata (display-sort-function . ,#'identity)
+                                  (annotation-function . ,annotation-function))
+		     (complete-with-action action ts-list string pred)))))
+     (or (and ts-list
+	      (let* ((key (completing-read "Trim undo records prior to timestamp: "
+					   table nil t))
+                     (entry (alist-get key ts-list nil nil #'equal)))
+		(list (car entry) (cdr entry))))
+         (progn (message "No timestamps found.")
+                (list nil nil)))))
+  (if (and (null node) timestamp)
+      (setq node (car (cl-find-if (lambda (x) (equal (cdr x) timestamp))
+                                  vundo--timestamps))))
+  (if (and node
+           (or (not (called-interactively-p 'interactive))
+               (yes-or-no-p
+                (format "Permanently remove all undo information prior to %s? "
+                        (if timestamp (format-time-string "%FT%T%z" timestamp)
+                          "this node")))))
+      (progn
+        (let* ((undo-list (vundo-m-undo-list node))
+               (len (length (cdr undo-list))))
+          (setcdr undo-list nil)
+          (when (called-interactively-p 'interactive)
+            (message "Trimmed %d undo-list records" len)))
+        (vundo--refresh-buffer vundo--orig-buffer (current-buffer))
+        (when vundo--roll-back-to-this
+          (setq vundo--roll-back-to-this
+                (vundo--current-node vundo--prev-mod-list))))
+    (when (called-interactively-p 'interactive)
+      (message "No undo-list records removed"))))
+
 ;;;###autoload
 (defun vundo ()
   "Display visual undo for the current buffer."