6

Q:  How can I modify undo-tree-save-history to remove the text-properties from all entries that make their way into the saved history file?

In a related thread, @PythonNut was on a very similar quest to remove text-properties from entries that make their way into the history file created by undo-tree-save-history: text-properties bloat persistent undo files

In that related thread, the original poster chose to remove text-properties before they ever become part of the buffer-undo-tree. This is not ideal, in my opinion, because a user should be able to undo/redo entries with text-properties intact if so desired. I am looking for a solution that does not modify either buffer-undo-tree or buffer-undo-list -- instead, I only want a history file without text-properties.

  • 1
    Please keep the question-answer style even if you answer your own question. I think the first paragraph more or less forms the question while the second paragraph starting with "The following is a modification" is your answer. The answer-question style helps organizing the questions. In particular, this question can be marked as answered after some waiting period. ...Thanks in advance. – Tobias Apr 17 '17 at 7:33
  • @Tobias -- I have clarified the question so that it relates only to a desired modification of undo-tree-save-history. Thank you. – lawlist Apr 17 '17 at 14:28
  • In github.com/joaotavora/yasnippet/issues/… undo-tree's author said he was open to adding some hooks that would be called on undo entries before writing to file. – npostavs Apr 19 '17 at 15:01
2
+100

The following is a modified version of undo-tree-save-history. As the code in the first version of your question I don't write to a file but output the undo tree as a string. I hope that is okay.

The most important changes w.r.t. undo-tree-save-history are:

  1. a recursive copy of the undo tree via (copy-tree buffer-undo-tree t) to avoid effects on the original buffer-undo-tree
  2. a deep recursion into the tree copy removing text properties on strings via undo-tree-seq-unprop
(require 'seq)
(require 'cl-lib)

(cl-defstruct (copy-tree*
               (:constructor copy-tree*-mem (&optional stack stack-new (hash (make-hash-table)))))
  stack stack-new hash)

(defmacro copy-tree*--push (el el-new mem &optional hash)
  (let ((my-el (make-symbol "my-el"))
        (my-el-new (make-symbol "my-el-new"))) ; makes sure `el' is only evaluated once
    (append `(let ((,my-el ,el)
                   (,my-el-new ,el-new))
               (push ,my-el (copy-tree*-stack ,mem))
               (push ,my-el-new (copy-tree*-stack-new ,mem)))
            (and hash
                 `((puthash ,my-el ,my-el-new (copy-tree*-hash ,mem))))
            (list my-el-new))))

(defmacro copy-tree*--pop (el el-new mem)
  `(setq ,el (pop (copy-tree*-stack ,mem))
         ,el-new (pop (copy-tree*-stack-new mem))))

(defun copy-tree*--copy-node (node mem vecp)
  (if (or (consp node)
      (and vecp (vectorp node)))
      (let ((existing-node (gethash node (copy-tree*-hash mem))))
    (if existing-node
        existing-node
      (copy-tree*--push node (if (consp node)
                     (cons nil nil)
                   (make-vector (length node) nil))
                mem t)))
    node))

(defun copy-tree* (tree &optional vecp)
  "Structure preserving version of `cl-copy-tree'."
  (if (or (consp tree)
      (and vecp (vectorp tree)))
      (let* ((tree-new (if (consp tree) (cons nil nil)
             (make-vector (length tree) nil)))
             (mem (copy-tree*-mem))
             next
             next-new)
        (copy-tree*--push tree tree-new mem t)
        (while (copy-tree*--pop next next-new mem)
      (cond
       ((consp next)
        (setcar next-new (copy-tree*--copy-node (car next) mem vecp))
        (setcdr next-new (copy-tree*--copy-node (cdr next) mem vecp)))
       ((and vecp (vectorp next))
        (cl-loop for i from 0 below (length next) do
             (aset next-new i (copy-tree*--copy-node (aref next i) mem vecp))))))
    tree-new)
    tree))


(defun undo-tree-seq-unprop (x)
  "Remove text properties on all strings of seq."
  (cond
   ((stringp x)
    (substring-no-properties x))
   ((consp x)
    (cons (undo-tree-seq-unprop (car x)) (undo-tree-seq-unprop (cdr x))))
   ((null x)
    nil)
   ((seqp x)
    (apply (type-of x) (seq-map (lambda (x) (undo-tree-seq-unprop x)) x)))
   (t x)))

(defun undo-tree-string (&optional filename)
  "Return undo-tree as a string.
If FILENAME is a string save this string in file with name FILENAME.
Ask for the file name in the interactive case."
  (interactive "FFile name: ") ;; just to ease testing
  (when (eq buffer-undo-list t)
    (user-error "No undo information in this buffer"))
  (undo-list-transfer-to-tree)
  (when (and buffer-undo-tree (not (eq buffer-undo-tree t)))
    (condition-case nil
    (progn
      (undo-tree-clear-visualizer-data buffer-undo-tree)
      (undo-tree-kill-visualizer))
      (error (undo-tree-clear-visualizer-data buffer-undo-tree)))
    (let ((buff (current-buffer))
          tree
          return-string)
      (unwind-protect
          (progn
            ;; transform undo-tree into non-circular structure, and make
            ;; temporary copy
            (undo-tree-decircle buffer-undo-tree)
        (setq tree (copy-tree* buffer-undo-tree t))
            ;; discard undo-tree object pool before saving
            (setf (undo-tree-object-pool tree) nil)
        (undo-tree-mapc (lambda (node)
                  (setf (undo-tree-node-undo node) (undo-tree-seq-unprop (undo-tree-node-undo node)))
                  (setf (undo-tree-node-redo node) (undo-tree-seq-unprop (undo-tree-node-redo node)))
                  )
                (undo-tree-root tree))
            (with-auto-compression-mode
              (with-temp-buffer
                (prin1 (sha1 buff) (current-buffer))
                (terpri (current-buffer))
                (let ((print-circle t)) (prin1 tree (current-buffer)))
                (setq return-string (buffer-string))
        (when filename
          (write-file filename)))))
        ;; restore circular undo-tree data structure
        (undo-tree-recircle buffer-undo-tree))
      return-string)))

EDITS:

  1. I added copy-tree* as a structure-preserving version of copy-tree. Therewith, undo-tree-string should work but it is only tested for a few cases.
  2. User lawlist has detected an error with killing the visualizer. I just put in his solution to call undo-tree-clear-visualizer-data buffer-undo-tree before undo-tree-kill-visualizer. Hopefully, the code works much better now thanks to lawlist!
  • The first draft transforms all of the vectors into lists, which makes restoring buffer-undo-tree from a saved string fail due to a wrong-type-argument arrayp (cl-struct-undo-tree ... Whenever you have time, it would be great if we could preserve the exact same structure -- i.e., a combination of vectors and lists. – lawlist Apr 19 '17 at 16:44
  • @lawlist Ha, that is really funny. I know the problem and I already had a structure preserving version. Don't know how this premature version finally made it here. I will correct this in a moment. The solution of this problem is actually what the structure of undo-tree-seq-unpropundo-tree-seq-unprop is all about. Otherwise a simpler version on the base of seq-map would be sufficient. – Tobias Apr 19 '17 at 19:05
  • I've committed the structure preserving version. But the cycling test does not work yet. (Cycling test: Edit buffer->save undo-tree-> load undo-tree->try to undo something) The only difference between the results of undo-tree-save-history and undo-tree-string I spotted with an ediff is that the tree-copy replaces pointers to already existing sequences with new (equivalent) sequences. – Tobias Apr 19 '17 at 19:48
  • @lawlist: I've added a structure-preserving version of copy-tree. Therewith undo-tree-string should work. Only tested for a few cases yet. – Tobias Apr 22 '17 at 21:37
  • 1
    @lawlist Thanks, I worked in your solution. Best regards, – Tobias May 2 '17 at 19:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.