From: Keith David Bershatsky <esq@lawlist.com>
To: 16377@debbugs.gnu.org
Subject: bug#16377: Undo Tree regression: (error "Unrecognized entry in undo list undo-tree-canary")
Date: Wed, 05 Jul 2017 17:33:57 -0700 [thread overview]
Message-ID: <m2a84immiy.wl%esq@lawlist.com> (raw)
In-Reply-To: <CAFM41H1VcYe=_nj3s1et+JKWNmgjkrsQN=XoT8KzCofHHToivw@mail.gmail.com>
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)
next prev parent reply other threads:[~2017-07-06 0:33 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2014-01-07 0:32 bug#16377: Undo Tree regression: (error "Unrecognized entry in undo list undo-tree-canary") Barry OReilly
2014-01-07 4:14 ` Toby Cubitt
2014-01-22 3:23 ` Barry OReilly
2014-01-22 17:08 ` bug#16523: " Toby Cubitt
2014-01-08 3:37 ` bug#16377: " Toby Cubitt
2014-01-22 0:05 ` Barry OReilly
[not found] ` <20140122141701.GA6728@c3po>
2014-01-22 15:26 ` Barry OReilly
2014-01-22 17:05 ` Toby Cubitt
2014-01-22 18:56 ` Stefan Monnier
2014-01-22 21:30 ` Toby Cubitt
2017-07-06 0:33 ` Keith David Bershatsky [this message]
2017-07-06 5:01 ` Keith David Bershatsky
2017-07-06 5:35 ` Stefan Monnier
2017-07-06 6:25 ` Keith David Bershatsky
2017-07-06 9:02 ` Toby Cubitt
2017-07-06 9:47 ` Toby Cubitt
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m2a84immiy.wl%esq@lawlist.com \
--to=esq@lawlist.com \
--cc=16377@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.