[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#16377: Undo Tree regression: (error "Unrecognized entry in undo list
From: |
Keith David Bershatsky |
Subject: |
bug#16377: Undo Tree regression: (error "Unrecognized entry in undo list undo-tree-canary") |
Date: |
Wed, 05 Jul 2017 17:33:57 -0700 |
I have been working on a fork of undo-tree.el, and am interested in resolving
this particular bug. I saw a recent post on reddit/emacs asking for help on
this issue, and thought I would take this opportunity to chime-in. I am
presently using the following modified version of primitive-undo in my forked
version for 2 reasons. First, is to just throw a message instead of an error
if bug 16377 shows its head. Second, I like to have the window-point update in
the target window while I am doing a change in the undo-tree visualization
buffer.
I have no idea whether bypassing the error about 16377 is a bad thing, so I
thought I'd share my function and let the experts decide how best to handle the
bug. I also wanted to remind the powers that be that this bug still affects
people in today's day and age. Another user on reddit added a comment stating
he/she also had the same problem. I have seen this bug as well when playing
with undo/redo in region.
Thanks.
(defun undo-tree--primitive-undo (n list)
"Undo N records from the front of the list LIST.
Return what remains of the list."
(let ((arg n)
;; In a writable buffer, enable undoing read-only text that is
;; so because of text properties.
(inhibit-read-only t)
;; Don't let `intangible' properties interfere with undo.
(inhibit-point-motion-hooks t)
;; We use oldlist only to check for EQ. ++kfs
(oldlist buffer-undo-list)
(did-apply nil)
(next nil)
(window-of-current-buffer (get-buffer-window (current-buffer)))
(selected-window (selected-window)))
(while (> arg 0)
(while (setq next (pop list)) ;Exit inner loop at undo boundary.
;; Handle an integer by setting point to that value.
(pcase next
((pred integerp)
(goto-char next)
(unless (eq window-of-current-buffer selected-window)
(set-window-point window-of-current-buffer next)))
;; Element (t . TIME) records previous modtime.
;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or
;; UNKNOWN_MODTIME_NSECS.
(`(t . ,time)
;; If this records an obsolete save
;; (not matching the actual disk file)
;; then don't mark unmodified.
(when (or (equal time (visited-file-modtime))
(and (consp time)
(equal (list (car time) (cdr time))
(visited-file-modtime))))
(when (fboundp 'unlock-buffer)
(unlock-buffer))
(set-buffer-modified-p nil)))
;; Element (nil PROP VAL BEG . END) is property change.
(`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare))
(when (or (> (point-min) beg) (< (point-max) end))
(let ((debug-on-quit nil)
(msg (concat
"undo-tree--primative-undo (1 of 4):"
" "
"Changes to be undone are outside visible portion of
buffer.")))
(signal 'quit `(,msg))))
(put-text-property beg end prop val))
;; Element (BEG . END) means range was inserted.
(`(,(and beg (pred integerp)) . ,(and end (pred integerp)))
;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp)))
;; Ideally: `(,(pred integerp beg) . ,(pred integerp end))
(when (or (> (point-min) beg) (< (point-max) end))
(let ((debug-on-quit nil)
(msg (concat
"undo-tree--primative-undo (2 of 4):"
" "
"Changes to be undone are outside visible portion of
buffer.")))
(signal 'quit `(,msg))))
;; Set point first thing, so that undoing this undo
;; does not send point back to where it is now.
(goto-char beg)
(delete-region beg end)
(unless (eq window-of-current-buffer selected-window)
(set-window-point window-of-current-buffer beg)))
;; Element (apply FUN . ARGS) means call FUN to undo.
(`(apply . ,fun-args)
(let ((currbuff (current-buffer)))
(if (integerp (car fun-args))
;; Long format: (apply DELTA START END FUN . ARGS).
(pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args)
(start-mark (copy-marker start nil))
(end-mark (copy-marker end t)))
(when (or (> (point-min) start) (< (point-max) end))
(let ((debug-on-quit nil)
(msg (concat
"undo-tree--primative-undo (3 of 4):"
" "
"Changes to be undone are outside visible portion of
buffer.")))
(signal 'quit `(,msg))))
(apply fun args) ;; Use `save-current-buffer'?
;; Check that the function did what the entry
;; said it would do.
(unless (and (= start start-mark)
(= (+ delta end) end-mark))
(error "Changes to be undone by function different than
announced"))
(set-marker start-mark nil)
(set-marker end-mark nil))
(apply fun-args))
(unless (eq currbuff (current-buffer))
(error "Undo function switched buffer"))
(setq did-apply t)))
;; Element (STRING . POS) means STRING was deleted.
(`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
(when (let ((apos (abs pos)))
(or (< apos (point-min)) (> apos (point-max))))
(let ((debug-on-quit nil)
(msg (concat
"undo-tree--primative-undo (4 of 4):"
" "
"Changes to be undone are outside visible portion of
buffer.")))
(signal 'quit `(,msg))))
(let (valid-marker-adjustments)
;; Check that marker adjustments which were recorded
;; with the (STRING . POS) record are still valid, ie
;; the markers haven't moved. We check their validity
;; before reinserting the string so as we don't need to
;; mind marker insertion-type.
(while (and (markerp (car-safe (car list)))
(integerp (cdr-safe (car list))))
(let* ((marker-adj (pop list))
(m (car marker-adj)))
(and (eq (marker-buffer m) (current-buffer))
(= pos m)
(push marker-adj valid-marker-adjustments))))
;; Insert string and adjust point
(if (< pos 0)
(progn
(goto-char (- pos))
(insert string))
(goto-char pos)
(insert string)
(goto-char pos))
(unless (eq window-of-current-buffer selected-window)
(set-window-point window-of-current-buffer pos))
;; Adjust the valid marker adjustments
(dolist (adj valid-marker-adjustments)
(set-marker (car adj)
(- (car adj) (cdr adj))))))
;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET.
(`(,(and marker (pred markerp)) . ,(and offset (pred integerp)))
(let ((msg
(concat
"undo-tree--primitive-undo: "
(format "Encountered %S entry in undo list with no
matching (TEXT . POS) entry"
next))))
(message msg))
;; Even though these elements are not expected in the undo
;; list, adjust them to be conservative for the 24.4
;; release. (Bug#16818)
(when (marker-buffer marker)
(set-marker marker
(- marker offset)
(marker-buffer marker))))
(_
(if (eq next 'undo-tree-canary)
(message "undo-tree--primitive-undo: catch-all found `%s'." next)
(error "Unrecognized entry in undo list %S" next)))))
(setq arg (1- arg)))
;; Make sure an apply entry produces at least one undo entry,
;; so the test in `undo' for continuing an undo series
;; will work right.
(if (and did-apply
(eq oldlist buffer-undo-list))
(setq buffer-undo-list
(cons (list 'apply 'cdr nil) buffer-undo-list))))
list)
- bug#16377: Undo Tree regression: (error "Unrecognized entry in undo list undo-tree-canary"),
Keith David Bershatsky <=