A ton of marker entry in buffer-und-list

[Yuan Fu <casouri@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1418 bytes --]

I’ve been playing around with undo recently. I used primitive-undo to undo some entries in the buffer-undo-list, and a ton of (#marker . -1) was added to the buffer-undo-list:

(nil
 ("a" . 27)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)
 (#<marker at 27 in a> . -1)

… hundreds of this.

Any idea of what is happening? What is this marker?

I don’t expect anyone to look at my code, but if you want to see it, here it is:


[-- Attachment #2: vundo.el --]
[-- Type: application/octet-stream, Size: 21787 bytes --]

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

;; Author: Yuan Fu <casouri@gmail.com>

;;; This file is NOT part of GNU Emacs

;;; Commentary:
;;

;;; Code:
;;

(require 'pcase)
(require 'cl-lib)
(require 'seq)

(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)))

;;; 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."))

(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 ((bound (or n (length undo-list)))
        (uidx 0)
        (mod-list (or mod-list (list (make-vundo-m))))
        new-mlist)
    (while (and (consp undo-list) (< uidx bound))
      ;; Skip leading nils.
      (while (and (< uidx bound) (null (nth uidx undo-list)))
        (cl-incf uidx))
      ;; Add modification.
      (if (< uidx bound)
          (push (make-vundo-m :undo-list (nthcdr uidx undo-list))
                new-mlist))
      ;; Skip through the content of this modification.
      (while (nth uidx undo-list)
        (cl-incf uidx)))
    (append 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 :size 200))))
    (cl-loop for mod in (nthcdr (or n 0) mod-list)
             for midx = (or n 0) then (1+ 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))

;; (setq lst '(6 5 4 nil 3 2 1))

;; (setq con (vundo--mod-list-from lst))
;; (setq mlist (car con))
;; (setq hash (cdr con))

;; (setq newlst (append '(9 8 7 nil) lst))
;; (setq ncon (vundo--mod-list-incr newlst mlist hash))
;; (setq nmlist (car ncon))
;; (setq nhash (cdr ncon))

;; (setq nnlst (nthcdr 4 lst))
;; (setq nncon (vundo--mod-list-incr nnlst mlist hash))
;; (setq nnlist (car nncon))
;; (setq nhash (cdr ncon))


;;; Mod list to eqv list

(defun vundo--eqv-list-of (mod)
  "Return all the modifications equivalent to MOD."
  (while (vundo-m-prev-eqv mod)
    (cl-assert (not (eq mod (vundo-m-prev-eqv mod))))
    (setq mod (vundo-m-prev-eqv mod)))
  ;; At the first mod in the equiv chain.
  (let ((eqv-list (list mod)))
    (while (vundo-m-next-eqv mod)
      (cl-assert (not (eq mod (vundo-m-next-eqv mod))))
      (setq mod (vundo-m-next-eqv mod))
      (push mod eqv-list))
    (reverse eqv-list)))

(defun vundo--eqv-merge (mlist)
  "Connect modifications in MLIST to be in the same equivalence list.
Order is reserved."
  (cl-loop for idx from 0 to (1- (length mlist))
           for this = (nth idx mlist)
           for next = (nth (1+ idx) mlist)
           for prev = nil then (nth (1- idx) mlist)
           do (setf (vundo-m-prev-eqv this) prev)
           do (setf (vundo-m-next-eqv this) next)))

(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 = (nth m mod-list)
   ;; If MOD is an undo, the buffer state it represents is equivalent
   ;; to a previous one.
   do (if-let ((prev-undo (undo--last-change-was-undo-p
                           (vundo-m-undo-list mod))))
          (if (eq prev-undo t)
              ;; FIXME: t means this undo is region-undo, currently
              ;; for the convenience of testing we regard t as undo to
              ;; the beginning of history.
              (vundo--eqv-merge-mod (nth 0 mod-list) mod)
            (if-let ((prev-m (gethash prev-undo mod-hash)))
                (vundo--eqv-merge-mod prev-m mod)
              (error "PREV-M shouldn't be nil")))
        ;; 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 (nth (1- m) mod-list))
                 ;; TODO: may need to optimize.
                 (min-eqv-mod (car (vundo--eqv-list-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)
                    (vundo--sort-mod (cons mod children) 'reverse))))))))

;;; Draw tree

(defun vundo--replace-at-col (from to col)
  "Replace FROM at COL with TO in each line of current buffer.
If a line is not COL columns long, skip that line."
  (save-excursion
    (let ((run t))
      (goto-char (point-min))
      (while run
        (move-to-column col)
        (if (and (eq (current-column) col)
                 (looking-at (regexp-quote from)))
            (replace-match to))
        ;; If ‘forward-line’ returns 0, we haven’t hit the end of
        ;; buffer.
        (setq run (eq (forward-line) 0))))))

(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--draw-tree (mod-list)
  "Draw the tree in MOD-LIST in current buffer."
  (let* ((root (nth 0 mod-list))
         (node-queue (list root))
         (inhibit-read-only t))
    (erase-buffer)
    (while node-queue
      (let* ((node (pop node-queue))
             (children (vundo-m-children node))
             (parent (vundo-m-parent node))
             ;; NODE is the nth child of PARENT.
             (my-idx (if parent
                         (seq-position (vundo-m-children parent) node)))
             ;; NODE is the last child of PARENT.
             (node-last-child-p
              (if parent
                  (eq node (car (last (vundo-m-children parent)))))))
        ;; Go to parent.
        (if parent (goto-char (vundo-m-point parent)))
        ;; TODO: more compact tree.
        (cond ((null parent)
               (insert "●"))
              ((eq my-idx 0)
               (insert "──●"))
              (t
               (let ((col (max 0 (1- (current-column)))))
                 ;; New line at bottom.
                 (goto-char (point-max))
                 (insert "\n")
                 ;; Go under parent node in the new line.
                 (indent-to-column col)
                 ;; Connect parent down.
                 (vundo--replace-at-col " " "│" col)
                 (if node-last-child-p
                     (insert "└──●")
                   (insert "├──●")))))
        ;; 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))))

(defvar vundo--mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "f") #'vundo-forward)
    (define-key map (kbd "b") #'vundo-backward)
    (define-key map (kbd "n") #'vundo-next)
    (define-key map (kbd "p") #'vundo-previous)
    (define-key map (kbd "q") #'kill-buffer-and-window)
    (define-key map (kbd "i") #'vundo--inspect)
    (define-key map (kbd "c") #'vundo--show-cursor)
    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)
  ;; If you leave the vundo buffer for the orig buffer and do some
  ;; modifications, you have to refresh the buffer. We can
  ;; auto-refresh or auto-quit, I choose to auto-quit.
  ;; (add-hook 'window-state-change-functions
  ;;           #'vundo--kill-buffer-if-point-left
  ;;           0 t)
  )

(defvar-local vundo--mod-list nil
  "Modification list generated by ‘vundo--mod-list-from’.")
(defvar-local vundo--mod-hash nil
  "Modification hashmap generated by ‘vundo--mod-list-from’.")
(defvar-local vundo--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--latest-node nil
  "The latest node.")

(defun vundo--mod-list-trim (mod-list n)
  "Remove MODS from MOD-LIST.
Keep the first N modifications."
  (dolist (mod (nthcdr (1+ n) mod-list))
    (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 some date."
  ;; If ‘buffer-undo-list’ is nil, then we do nothing.
  (with-current-buffer vundo-buffer
    (unless incremental
      (setq vundo--undo-list nil
            vundo--mod-list nil
            vundo--mod-hash nil))
    (let ((undo-list (buffer-local-value
                      'buffer-undo-list orig-buffer))
          (inhibit-read-only t)
          mod-list mod-hash)
      (if (> (length undo-list) (length vundo--undo-list))
          ;; Adding.
          (let ((diff (- (length undo-list)
                         (length vundo--undo-list))))
            (cl-assert (eq vundo--undo-list (nthcdr diff undo-list)))
            (setq mod-list (vundo--mod-list-from
                            undo-list diff vundo--mod-list)
                  mod-hash (vundo--update-mapping
                            mod-list vundo--mod-hash
                            (length vundo--mod-list)))
            ;; Build tree.
            (vundo--build-tree mod-list mod-hash
                               (length vundo--mod-list)))
        ;; Removing.
        (let ((ul undo-list))
          (while (null (car ul))
            (setq undo-list (cdr ul)))
          (if-let* ((new-tail (gethash ul vundo--mod-hash))
                    (idx (vundo-m-idx new-tail)))
              (setq mod-list (vundo--mod-list-trim vundo--mod-list idx)
                    mod-hash vundo--mod-hash)
            (error "Couldn't find modification"))))
      ;; Render buffer.
      (vundo--mode)
      (setq vundo--mod-list mod-list
            vundo--mod-hash mod-hash
            vundo--undo-list undo-list
            vundo--orig-buffer orig-buffer)
      (vundo--draw-tree mod-list)
      ;; Highlight current node.
      (let* ((last-m (car (last mod-list)))
             (node (car (vundo--eqv-list-of last-m))))
        (setq vundo--latest-node node)
        (goto-char (vundo-m-point node))
        (put-text-property (1- (point)) (point) 'face 'error)))))

(defun vundo ()
  "Display visual undo for current buffer."
  (interactive)
  (if (and buffer-undo-list (not (eq buffer-undo-list t)))
      (let* ((vundo-buf (vundo--buffer))
             (orig-buf (current-buffer)))
        (vundo--refresh-buffer orig-buf vundo-buf)
        (select-window
         (display-buffer-in-side-window
          vundo-buf
          '((side . bottom)
            (slot . 1)
            (window-height . 5))))
        (goto-char (vundo-m-point vundo--latest-node))
        (fit-window-to-buffer nil 5))
    (message "There is no undo history")))

;;; Traverse undo tree

(defun vundo--calculate-shortest-route (from to)
  "Calculate the shortest route from FROM to TO node.
Here they represent the source and dest buffer state. Both SETs
are an equivalence set of states. Return (SOURCE . DEST), meaning
you should undo the modifications from DEST to SOURCE. "
  (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 source dest) route-list))))
    ;; Find the shortest route.
    (car
     (seq-sort
      (lambda (r1 r2)
        ;; I.e., distance between SOURCE and DEST in R1
        ;; compare against distance in R2.
        (< (- (vundo-m-idx (car r1)) (vundo-m-idx (cdr r1)))
           (- (vundo-m-idx (car r2)) (vundo-m-idx (cdr r2)))))
      route-list))))

(defun vundo--list-subtract (l1 l2)
  "Return L1 - L2.

E.g.,

\(vundo--list-subtract '(1 2 3 4) '(3 4))
=> (1 2)"
  (let ((len1 (length l1))
        (len2 (length l2)))
    (cl-assert (> len1 len2))
    (seq-subseq l1 0 (- len1 len2))))

(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."
  (if-let* ((route (vundo--calculate-shortest-route
                    current dest)))
      (let* ((source (car route))
             (dest (cdr route))
             ;; The complete undo-list that stops at SOURCE.
             (undo-list-at-source (vundo-m-undo-list source))
             ;; The complete undo-list that stops at DEST.
             (undo-list-at-dest (vundo-m-undo-list dest))
             (step (- (vundo-m-idx source) (vundo-m-idx dest)))
             ;; We will undo these modifications.
             (planned-undo (vundo--list-subtract
                            undo-list-at-source
                            undo-list-at-dest)))
        (with-current-buffer orig-buffer
          ;; Undo. This will undo modifications in PLANNED-UNDO and
          ;; add new entries to ‘buffer-undo-list’.
          (primitive-undo step planned-undo)
          ;; TODO: optimize this (finding max)
          (let ((latest-buffer-state-idx
                 ;; If MOD has no prev-eqv, it is not an undo, and
                 ;; represents a unique buffer state. Among all the
                 ;; MODs that represents a unique buffer state, we
                 ;; find the latest one.
                 (seq-max (mapcar #'vundo-m-idx
                                  (seq-filter
                                   (lambda (mod)
                                     (null (vundo-m-prev-eqv mod)))
                                   mod-list)))))
            (if-let ((possible-trim-point
                      (cl-loop for node in (vundo--eqv-list-of dest)
                               if (>= (vundo-m-idx node)
                                      latest-buffer-state-idx)
                               return node
                               finally return nil)))
                ;; Can trim undo-list, trim to DEST.
                (setq buffer-undo-list
                      (vundo-m-undo-list possible-trim-point))
              ;; Can’t trim undo-list, update ‘undo-equiv-table’.
              (let ((list buffer-undo-list))
                ;; Strip leading nils.
                (while (eq (car list) nil)
	          (setq list (cdr list)))
                ;; FIXME: currently we regard t as pointing to root node.
                (puthash list (or undo-list-at-dest t)
                         undo-equiv-table))))
          (if (> (length buffer-undo-list) 10000)
              (debug))
          (message "%s -> %s: %s steps, now %s entries, undo: %s"
                   (vundo-m-idx source)
                   (vundo-m-idx dest)
                   (length planned-undo)
                   (length buffer-undo-list)
                   planned-undo)
          (with-selected-window (get-buffer-window)
            (set-window-point nil (point))
            (recenter))))
    (error "No possible route")))

(defun vundo-forward (arg)
  "Move forward ARG nodes in the undo tree.
If ARG < 0, move backward"
  (interactive "p")
  (let ((step (abs arg)))
    (let* ((step-fn (if (> arg 0)
                        (lambda (node)
                          (or (car (vundo-m-children node))
                              node))
                      (lambda (node)
                        (or (vundo-m-parent node) node))))
           (node vundo--latest-node)
           (dest node))
      (while (> step 0)
        (setq dest (funcall step-fn dest))
        (cl-decf step))
      (unless (eq node dest)
        (vundo--move-to-node
         node dest vundo--orig-buffer vundo--mod-list)
        (vundo--refresh-buffer
         vundo--orig-buffer (current-buffer)
         ;; 'incremental
         )))))

(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")
  (let* ((node vundo--latest-node)
         (parent (vundo-m-parent node)))
    ;; While have parent but no sibling, go up.
    (while (and parent (<= (length (vundo-m-children parent)) 1))
      (setq node parent
            parent (vundo-m-parent node)))
    ;; Move to next/previous sibling.
    (when parent
      (let* ((siblings (vundo-m-children parent))
             (idx (seq-position siblings node))
             (new-idx (+ idx arg))
             ;; TODO: Move as far as possible instead of not
             ;; moving when ARG is too large.
             (dest (or (nth new-idx siblings) node)))
        (unless (eq node dest)
          (vundo--move-to-node
           node dest vundo--orig-buffer vundo--mod-list)
          (vundo--refresh-buffer
           vundo--orig-buffer (current-buffer)
           ;; 'incremental
           ))))))

(defun vundo-previous (arg)
  "Move to node above the current one. Move ARG steps."
  (interactive "p")
  (vundo-next (- arg)))

;;; Debug

(defun vundo--inspect ()
  "Print some useful info at point"
  (interactive)
  (let ((node (vundo--get-node-at-point)))
    (message "States: %s Children: %s Parent: %s"
             (mapcar (lambda (mod)
                       (vundo-m-idx mod))
                     (vundo--eqv-list-of node))
             (and (vundo-m-children node)
                  (mapcar #'vundo-m-idx (vundo-m-children node)))
             (and (vundo-m-parent node)
                  (vundo-m-idx (vundo-m-parent node))))))

(defun vundo--show-cursor ()
  "Make cursor visible."
  (interactive)
  (setq cursor-type t))


(provide 'vundo)

;;; vundo.el ends here

[-- Attachment #3: Type: text/plain, Size: 128 bytes --]



The idea is to display an undo-tree and move between nodes with f/b/n/p. You can enable it with M-x vundo RET.

Yuan