From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Barry OReilly Newsgroups: gmane.emacs.bugs Subject: bug#16411: undo-only bugs Date: Tue, 13 May 2014 11:01:32 -0400 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Trace: ger.gmane.org 1399993502 14121 80.91.229.3 (13 May 2014 15:05:02 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 13 May 2014 15:05:02 +0000 (UTC) To: 16411 <16411@debbugs.gnu.org>, Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue May 13 17:04:55 2014 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1WkEGE-0004fY-3o for geb-bug-gnu-emacs@m.gmane.org; Tue, 13 May 2014 17:04:54 +0200 Original-Received: from localhost ([::1]:45658 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WkEGD-0003tn-LV for geb-bug-gnu-emacs@m.gmane.org; Tue, 13 May 2014 11:04:53 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:60567) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WkEDZ-0000gq-1y for bug-gnu-emacs@gnu.org; Tue, 13 May 2014 11:02:15 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1WkEDS-00033E-R5 for bug-gnu-emacs@gnu.org; Tue, 13 May 2014 11:02:09 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:45039) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1WkEDS-00032p-OK for bug-gnu-emacs@gnu.org; Tue, 13 May 2014 11:02:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.80) (envelope-from ) id 1WkEDS-0007Dn-5R for bug-gnu-emacs@gnu.org; Tue, 13 May 2014 11:02:02 -0400 X-Loop: help-debbugs@gnu.org In-Reply-To: Resent-From: Barry OReilly Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 13 May 2014 15:02:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 16411 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 16411-submit@debbugs.gnu.org id=B16411.139999330327723 (code B ref 16411); Tue, 13 May 2014 15:02:02 +0000 Original-Received: (at 16411) by debbugs.gnu.org; 13 May 2014 15:01:43 +0000 Original-Received: from localhost ([127.0.0.1]:34157 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WkED7-0007D0-KH for submit@debbugs.gnu.org; Tue, 13 May 2014 11:01:43 -0400 Original-Received: from mail-oa0-f43.google.com ([209.85.219.43]:60526) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1WkED4-0007Cd-QT for 16411@debbugs.gnu.org; Tue, 13 May 2014 11:01:40 -0400 Original-Received: by mail-oa0-f43.google.com with SMTP id l6so536093oag.2 for <16411@debbugs.gnu.org>; Tue, 13 May 2014 08:01:33 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:date:message-id:subject:from:to:content-type; bh=sndGun9iMKqlJu2mvWe4AWK6GEZyrHY4tPxL+b35LkU=; b=o0qcdDa0XhhNRQKmszN5es/ijXVn8cfHjQ3r4F9+8JuKi5SoaLyYgomXgYUafhnbgn CiROwgrA+acYZ/UFIxCFLy4gtzL07t+US8VclyxpBc+KHCLWABxorprKJ6Q42tVEz+kp Q4oSG/K/HmBytswwV9+lzm7RFDTdUoSGZJbkEs4LMy/UmMIOcvjhxOQ0wLmDYI4VP2w2 IW7spPGqzWefvaIaR+c6Ffnb3Y9Bil5FbMauckGV00SXzwRh3xCIDp5lHZBrwjnxS/RN akp8RMuvfccNMkhtojQm1+ThcNrlo6pbkNgyKIPMUNSdttAgQUaJPv0jr8h8ahG4mo7K WgZA== X-Received: by 10.182.225.137 with SMTP id rk9mr41938738obc.51.1399993292979; Tue, 13 May 2014 08:01:32 -0700 (PDT) Original-Received: by 10.76.6.44 with HTTP; Tue, 13 May 2014 08:01:32 -0700 (PDT) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:89017 Archived-At: 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.