Package: emacs;
Reported by: Barry OReilly <gundaetiapo <at> gmail.com>
Date: Fri, 10 Jan 2014 22:34:02 UTC
Severity: normal
Message #53 received at 16411 <at> debbugs.gnu.org (full text, mbox):
From: Barry OReilly <gundaetiapo <at> gmail.com> To: 16411 <16411 <at> debbugs.gnu.org>, Stefan Monnier <monnier <at> iro.umontreal.ca> Subject: Re: undo-only bugs Date: Tue, 13 May 2014 11:01:32 -0400
I am pursuing a solution more like the first one I suggested in bug
16411 and have a preliminary patch I would like to get some feedback
on. undo-tests pass but the patch does not fix the bug yet. The patch
does two major things:
1: Defines and populates a new undo-redo-table
2: Uses closures to lazily compute pending undo elements
Item 1 is the crucial one. The undo-redo-table is somewhat like
undo-equiv-table, except that instead of mapping equal buffer states,
it maps undo elements to what they undid. This conveys better
information.
Mapping equal buffer states with undo-equiv-table is not workable,
because undos in region generally don't return the user to a buffer
state that actually existed before. Consider: insert A, insert B, undo
in region of A. The buffer has just B for the first time.
Existing use of undo-equiv-table can readily switch to use
undo-redo-table, as described in the obsoletion note of the patch. The
converse, using undo-equiv-table instead of undo-redo-table, would
require traversing backwards in the singly linked list.
The reason undo-redo-table maps at the element level, as opposed to
the change group level, is because in the case of undo in region with
a prefix arg, the newly created change group needs to reference
subsets of potentially many prior change groups.
Having undo elements reference what they undid would help solve
several issues:
1: undo-only in region doesn't work.
2: Normal undo-only after an undo in region doesn't work. I've
previously outlined how the solution would use the
undo-redo-table.
3: Undo in region has counter intuitive behavior as described in
the FIXME of simple.el describing undo in region.
4: Deleting X bytes, then doing Y iterations of undo and redo
causes undo history to grow about X*Y. To grow proportional to Y
should be achievable: set undo-in-progress to the in progress
element, and the C level undo recording to use it and
undo-redo-table to find the eq Lisp_String.
5: Undo Tree should more tightly integrate with the builtin undo
system. To do so, it needs sufficient information to visualize
the buffer-undo-list as a tree. Undo Tree has a means to
visualize undo in regions, so undo-equiv-table is inadequate.
There are variations on how elements could reference what they undid,
but fundamentally I think it is essential. I wish to know how you like
the direction the patch is going as I proceed to solve some problems
building upon it.
The patch ignores whitespace.
diff --git a/lisp/simple.el b/lisp/simple.el
index 1484339..09b3a5f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2054,20 +2054,32 @@ Go to the history element by the absolute
history position HIST-POS."
;Put this on C-x u, so we can force that rather than C-_ into startup msg
(define-obsolete-function-alias 'advertised-undo 'undo "23.2")
+(defvar undo-redo-table (make-hash-table :test 'eq :weakness t)
+ "Hash table mapping undo elements created by an undo command to
+the undo element they undid. Specifically, the keys and values
+are eq to cons of buffer-undo-list. The hash table is weak so as
+truncated undo elements can be garbage collected.")
(defconst undo-equiv-table (make-hash-table :test 'eq :weakness t)
"Table mapping redo records to the corresponding undo one.
A redo record for undo-in-region maps to t.
A redo record for ordinary undo maps to the following (earlier) undo.")
+(make-obsolete-variable
+ 'undo-equiv-table
+ "Use undo-redo-table instead. For non regional undos, (gethash
+k undo-equiv-table) is the same as taking (gethash k
+undo-redo-table) and scanning forward one change group."
+ "24.5")
(defvar undo-in-region nil
- "Non-nil if `pending-undo-list' is not just a tail of `buffer-undo-list'.")
+ "Non-nil during an undo in region.")
(defvar undo-no-redo nil
"If t, `undo' doesn't go through redo entries.")
(defvar pending-undo-list nil
- "Within a run of consecutive undo commands, list remaining to be undone.
-If t, we undid all the way to the end of it.")
+ "Within a run of consecutive undo commands, is a tail of
+buffer-undo-list for remaining undo elements, or a closure to
+generate them. If t, there is no more to undo.")
(defun undo (&optional arg)
"Undo some previous changes.
@@ -2115,9 +2127,10 @@ as an argument limits undo to changes within
the current region."
(undo-more 1))
;; If we got this far, the next command should be a consecutive undo.
(setq this-command 'undo)
- ;; Check to see whether we're hitting a redo record, and if
- ;; so, ask the user whether she wants to skip the redo/undo pair.
- (let ((equiv (gethash pending-undo-list undo-equiv-table)))
+ ;; Check to see whether we're hitting a redo record
+ (let ((equiv (if (functionp pending-undo-list)
+ t
+ (gethash pending-undo-list undo-equiv-table))))
(or (eq (selected-window) (minibuffer-window))
(setq message (format "%s%s!"
(if (or undo-no-redo (not equiv))
@@ -2202,40 +2215,48 @@ Some change-hooks test this variable to do
something different.")
"Undo back N undo-boundaries beyond what was already undone recently.
Call `undo-start' to get ready to undo recent changes,
then call `undo-more' one or more times to undo them."
- (or (listp pending-undo-list)
+ (when (eq pending-undo-list t)
(user-error (concat "No further undo information"
(and undo-in-region " for region"))))
(let ((undo-in-progress t))
- ;; Note: The following, while pulling elements off
- ;; `pending-undo-list' will call primitive change functions which
- ;; will push more elements onto `buffer-undo-list'.
- (setq pending-undo-list (primitive-undo n pending-undo-list))
- (if (null pending-undo-list)
+ ;; Note: The following changes the buffer, and so calls primitive
+ ;; change functions that push more elements onto
+ ;; `buffer-undo-list'.
+ (unless (if (functionp pending-undo-list)
+ (undo-using-generator pending-undo-list n)
+ (setq pending-undo-list
+ (primitive-undo n pending-undo-list)))
+ ;; Reached the end of undo history
(setq pending-undo-list t))))
(defun primitive-undo (n list)
- "Undo N records from the front of the list LIST.
+ "Undo N change groups from the front of the list LIST.
Return what remains of the list."
+ (undo-using-generator
+ (lambda (&optional option)
+ (prog1 (cons (car list) list)
+ (unless (eq option 'peek) (pop list))))
+ n)
+ list)
- ;; This is a good feature, but would make undo-start
- ;; unable to do what is expected.
- ;;(when (null (car (list)))
- ;; ;; If the head of the list is a boundary, it is the boundary
- ;; ;; preceding this command. Get rid of it and don't count it.
- ;; (setq list (cdr list))))
-
+(defun undo-using-generator (generator n)
+ "Undo N change groups using a GENERATOR closure to get
+successive undo elements. Return the last association returned
+from GENERATOR or nil if the end of undo history was reached."
(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))
+ next-assoc)
(while (> arg 0)
- (while (setq next (pop list)) ;Exit inner loop at undo boundary.
+ ;; Exit this inner loop at an undo boundary, which would be
+ ;; next-assoc of (nil . nil).
+ (while (car (setq next-assoc (funcall generator)))
+ (let ((next (car next-assoc))
+ (orig-tail (cdr next-assoc))
+ (prior-undo-list buffer-undo-list))
;; Handle an integer by setting point to that value.
(pcase next
((pred integerp) (goto-char next))
@@ -2289,21 +2310,27 @@ Return what remains of the list."
(apply fun-args))
(unless (eq currbuff (current-buffer))
(error "Undo function switched buffer"))
- (setq did-apply t)))
+ ;; Make sure an apply entry produces at least one undo entry,
+ ;; so the test in `undo' for continuing an undo series
+ ;; will work right.
+ (when (eq prior-undo-list buffer-undo-list)
+ (push (list 'apply 'cdr nil) buffer-undo-list))))
;; 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))))
(error "Changes to be undone are outside visible
portion of buffer"))
- (let (valid-marker-adjustments)
+ (let (valid-marker-adjustments
+ ahead)
;; 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))
+ (while (and (setq ahead (funcall generator 'peek))
+ (markerp (car-safe (car ahead)))
+ (integerp (cdr-safe (car ahead))))
+ (let* ((marker-adj (car (funcall generator)))
(m (car marker-adj)))
(and (eq (marker-buffer m) (current-buffer))
(= pos m)
@@ -2331,16 +2358,13 @@ Return what remains of the list."
(set-marker marker
(- marker offset)
(marker-buffer marker))))
- (_ (error "Unrecognized entry in undo list %S" next))))
+ (_ (error "Unrecognized entry in undo list %S" next)))
+ ;; Map the new undo element to what it undid. Not aware yet
+ ;; of cases where we want to map all new elements.
+ (unless (eq prior-undo-list buffer-undo-list)
+ (puthash buffer-undo-list orig-tail undo-redo-table))))
(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-assoc))
;; Deep copy of a list
(defun undo-copy-list (list)
@@ -2353,16 +2377,16 @@ Return what remains of the list."
elt))
(defun undo-start (&optional beg end)
- "Set `pending-undo-list' to the front of the undo list.
-The next call to `undo-more' will undo the most recently made change.
-If BEG and END are specified, then only undo elements
-that apply to text between BEG and END are used; other undo elements
-are ignored. If BEG and END are nil, all undo elements are used."
+ "Set `pending-undo-list' to begin a run of undos. The next
+call to `undo-more' will undo the next change group. If BEG and
+END are specified, then only undo elements that apply to text
+between BEG and END are used; other undo elements are ignored.
+If BEG and END are nil, all undo elements are used."
(if (eq buffer-undo-list t)
(user-error "No undo information in this buffer"))
(setq pending-undo-list
(if (and beg end (not (= beg end)))
- (undo-make-selective-list (min beg end) (max beg end))
+ (undo-make-regional-generator (min beg end) (max beg end))
buffer-undo-list)))
;; The positions given in elements of the undo list are the positions
@@ -2424,30 +2448,39 @@ are ignored. If BEG and END are nil, all undo
elements are used."
;; "ccaabad", as though the first "d" became detached from the
;; original "ddd" insertion. This quirk is a FIXME.
-(defun undo-make-selective-list (start end)
- "Return a list of undo elements for the region START to END.
-The elements come from `buffer-undo-list', but we keep only the
-elements inside this region, and discard those outside this
-region. The elements' positions are adjusted so as the returned
-list can be applied to the current buffer."
+(defun undo-make-regional-generator (start end)
+ "Make a closure that will return the next undo element
+association in the region START to END each time it is called, in
+the form (ADJUSTED-ELT . ORIG-UNDO-LIST). ADJUSTED-ELT is an
+undo element with adjusted positions and ORIG-UNDO-LIST is a cons
+of buffer-undo-list whose car is the original unadjusted undo
+element. ADJUSTED-ELT may or may not be eq to (car
+ORIG-UNDO-LIST).
+
+The use of a closure allows for lazy adjustment of elements of
+the buffer-undo-list as needed for successive undo commands."
(let ((ulist buffer-undo-list)
- ;; A list of position adjusted undo elements in the region.
- (selective-list (list nil))
+ ;; (ADJUSTED-ELT . ORIG-UNDO-LIST) associations to be returned
+ ;; from closure
+ (selective-list (list (cons nil nil)))
+ prev-assoc
;; A list of undo-deltas for out of region undo elements.
- undo-deltas
- undo-elt)
- (while ulist
- (setq undo-elt (car ulist))
+ undo-deltas)
+ (lambda (&optional option)
+ ;; Update selective-list with potential returns if necessary
+ (while (and ulist (not selective-list))
+ (let ((undo-elt (car ulist)))
(cond
((null undo-elt)
- ;; Don't put two nils together in the list
- (when (car selective-list)
- (push nil selective-list)))
+ ;; Don't put two undo boundaries, represented as (nil
+ ;; . nil), together in the list
+ (unless (equal (cons nil nil) prev-assoc)
+ (push (cons nil nil) selective-list)))
((and (consp undo-elt) (eq (car undo-elt) t))
;; This is a "was unmodified" element. Keep it
;; if we have kept everything thus far.
(when (not undo-deltas)
- (push undo-elt selective-list)))
+ (push (cons undo-elt ulist) selective-list)))
;; Skip over marker adjustments, instead relying
;; on finding them after (TEXT . POS) elements
((markerp (car-safe undo-elt))
@@ -2458,19 +2491,37 @@ list can be applied to the current buffer."
(if (undo-elt-in-region adjusted-undo-elt start end)
(progn
(setq end (+ end (cdr (undo-delta adjusted-undo-elt))))
- (push adjusted-undo-elt selective-list)
+ (push (cons adjusted-undo-elt ulist) selective-list)
;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was
;; kept. primitive-undo may discard them later.
(when (and (stringp (car-safe adjusted-undo-elt))
(integerp (cdr-safe adjusted-undo-elt)))
(let ((list-i (cdr ulist)))
(while (markerp (car-safe (car list-i)))
- (push (pop list-i) selective-list)))))
+ (let ((marker-adj (pop list-i)))
+ (push (cons marker-adj marker-adj)
+ selective-list))))
+ (setq selective-list (nreverse selective-list))))
(let ((delta (undo-delta undo-elt)))
(when (/= 0 (cdr delta))
- (push delta undo-deltas)))))))
+ (push delta undo-deltas))))))))
(pop ulist))
+ (if (eq option 'peek)
+ (car selective-list)
+ (setq prev-assoc (pop selective-list))))))
+
+(defun undo-make-selective-list (start end)
+ "Realize a full selective undo list per
+undo-make-regional-generator."
+ (let ((selective-list nil)
+ (gen (undo-make-regional-generator start end))
+ elt)
+ (while (setq elt (funcall gen))
+ (push selective-list (car elt)))
(nreverse selective-list)))
+(make-obsolete 'undo-make-selective-list
+ "Use undo-make-regional-generator instead."
+ "24.5")
(defun undo-elt-in-region (undo-elt start end)
"Determine whether UNDO-ELT falls inside the region START ... END.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.