[Emacs-diffs] master 20aa42e 2/2: ; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change'

[Phillip Lord]

branch: master
commit 20aa42e8204f8f0139ba3880cb32ddf88acc9bf4
Merge: d2f73db 44dfa86
Author: Phillip Lord <address@hidden>
Commit: Phillip Lord <address@hidden>

    ; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change'
    
    Conflicts:
        src/cmds.c
        src/keyboard.c
---
 lisp/simple.el |  137 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/cmds.c     |   56 ++++++-----------------
 src/keyboard.c |   16 +++----
 src/lisp.h     |    1 -
 src/undo.c     |   51 +++++++--------------
 5 files changed, 174 insertions(+), 87 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 1f2f4fe..2781ad0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2768,6 +2768,143 @@ with < or <= based on USE-<."
             '(0 . 0)))
     '(0 . 0)))
 
+;;; Default undo-boundary addition
+;;
+;; This section adds a new undo-boundary at either after a command is
+;; called or in some cases on a timer called after a change is made in
+;; any buffer.
+(defvar-local undo-auto--last-boundary-cause nil
+  "Describe the cause of the last undo-boundary.
+
+If `explicit', the last boundary was caused by an explicit call to
+`undo-boundary', that is one not called by the code in this
+section.
+
+If it is equal to `timer', then the last boundary was inserted
+by `undo-auto--boundary-timer'.
+
+If it is equal to `command', then the last boundary was inserted
+automatically after a command, that is by the code defined in
+this section.
+
+If it is equal to a list, then the last boundary was inserted by
+an amalgamating command.  The car of the list is the number of
+times an amalgamating command has been called, and the cdr are the
+buffers that were changed during the last command.")
+
+(defvar undo-auto--current-boundary-timer nil
+  "Current timer which will run `undo-auto--boundary-timer' or nil.
+
+If set to non-nil, this will effectively disable the timer.")
+
+(defvar undo-auto--this-command-amalgamating nil
+  "Non-nil if `this-command' should be amalgamated.
+This variable is set to nil by `undo-auto--boundaries' and is set
+by `undo-auto--amalgamate'." )
+
+(defun undo-auto--needs-boundary-p ()
+  "Return non-nil if `buffer-undo-list' needs a boundary at the start."
+  (car-safe buffer-undo-list))
+
+(defun undo-auto--last-boundary-amalgamating-number ()
+  "Return the number of amalgamating last commands or nil.
+Amalgamating commands are, by default, either
+`self-insert-command' and `delete-char', but can be any command
+that calls `undo-auto--amalgamate'."
+  (car-safe undo-auto--last-boundary-cause))
+
+(defun undo-auto--ensure-boundary (cause)
+  "Add an `undo-boundary' to the current buffer if needed.
+REASON describes the reason that the boundary is being added; see
+`undo-auto--last-boundary' for more information."
+  (when (and
+         (undo-auto--needs-boundary-p))
+    (let ((last-amalgamating
+           (undo-auto--last-boundary-amalgamating-number)))
+      (undo-boundary)
+      (setq undo-auto--last-boundary-cause
+            (if (eq 'amalgamate cause)
+                (cons
+                 (if last-amalgamating (1+ last-amalgamating) 0)
+                 undo-auto--undoably-changed-buffers)
+              cause)))))
+
+(defun undo-auto--boundaries (cause)
+  "Check recently changed buffers and add a boundary if necessary.
+REASON describes the reason that the boundary is being added; see
+`undo-last-boundary' for more information."
+  (dolist (b undo-auto--undoably-changed-buffers)
+          (when (buffer-live-p b)
+            (with-current-buffer b
+              (undo-auto--ensure-boundary cause))))
+  (setq undo-auto--undoably-changed-buffers nil))
+
+(defun undo-auto--boundary-timer ()
+  "Timer which will run `undo--auto-boundary-timer'."
+  (setq undo-auto--current-boundary-timer nil)
+  (undo-auto--boundaries 'timer))
+
+(defun undo-auto--boundary-ensure-timer ()
+  "Ensure that the `undo-auto-boundary-timer' is set."
+  (unless undo-auto--current-boundary-timer
+    (setq undo-auto--current-boundary-timer
+          (run-at-time 10 nil #'undo-auto--boundary-timer))))
+
+(defvar undo-auto--undoably-changed-buffers nil
+  "List of buffers that have changed recently.
+
+This list is maintained by `undo-auto--undoable-change' and
+`undo-auto--boundaries' and can be affected by changes to their
+default values.
+
+See also `undo-auto--buffer-undoably-changed'.")
+
+(defun undo-auto--add-boundary ()
+  "Add an `undo-boundary' in appropriate buffers."
+  (undo-auto--boundaries
+   (if undo-auto--this-command-amalgamating
+       'amalgamate
+     'command))
+  (setq undo-auto--this-command-amalgamating nil))
+
+(defun undo-auto--amalgamate ()
+  "Amalgamate undo if necessary.
+This function can be called after an amalgamating command.  It
+removes the previous `undo-boundary' if a series of such calls
+have been made.  By default `self-insert-command' and
+`delete-char' are the only amalgamating commands, although this
+function could be called by any command wishing to have this
+behaviour."
+  (let ((last-amalgamating-count
+         (undo-auto--last-boundary-amalgamating-number)))
+    (setq undo-auto--this-command-amalgamating t)
+    (when
+        last-amalgamating-count
+      (if
+          (and
+           (< last-amalgamating-count 20)
+           (eq this-command last-command))
+          ;; Amalgamate all buffers that have changed.
+          (dolist (b (cdr undo-auto--last-boundary-cause))
+            (when (buffer-live-p b)
+              (with-current-buffer
+                  b
+                (when
+                    ;; The head of `buffer-undo-list' is nil.
+                    ;; `car-safe' doesn't work because
+                    ;; `buffer-undo-list' need not be a list!
+                    (and (listp buffer-undo-list)
+                         (not (car buffer-undo-list)))
+                  (setq buffer-undo-list
+                        (cdr buffer-undo-list))))))
+        (setq undo-auto--last-boundary-cause 0)))))
+
+(defun undo-auto--undoable-change ()
+  "Called after every undoable buffer change."
+  (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer))
+  (undo-auto--boundary-ensure-timer))
+;; End auto-boundary section
+
 (defcustom undo-ask-before-discard nil
   "If non-nil ask about discarding undo info for the current command.
 Normally, Emacs discards the undo info for the current command if
diff --git a/src/cmds.c b/src/cmds.c
index 0afc023..167ebb7 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -218,36 +218,6 @@ to t.  */)
   return Qnil;
 }
 
-static int nonundocount;
-
-static void
-remove_excessive_undo_boundaries (void)
-{
-  bool remove_boundary = true;
-
-  if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command)))
-    nonundocount = 0;
-
-  if (NILP (Vexecuting_kbd_macro))
-    {
-      if (nonundocount <= 0 || nonundocount >= 20)
-       {
-         remove_boundary = false;
-         nonundocount = 0;
-       }
-      nonundocount++;
-    }
-
-  if (remove_boundary
-      && CONSP (BVAR (current_buffer, undo_list))
-      && NILP (XCAR (BVAR (current_buffer, undo_list)))
-      /* Only remove auto-added boundaries, not boundaries
-        added by explicit calls to undo-boundary.  */
-      && EQ (BVAR (current_buffer, undo_list), last_undo_boundary))
-    /* Remove the undo_boundary that was just pushed.  */
-    bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list)));
-}
-
 DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP",
        doc: /* Delete the following N characters (previous if N is negative).
 Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
@@ -263,7 +233,7 @@ because it respects values of `delete-active-region' and 
`overwrite-mode'.  */)
   CHECK_NUMBER (n);
 
   if (eabs (XINT (n)) < 2)
-    remove_excessive_undo_boundaries ();
+    call0 (Qundo_auto__amalgamate);
 
   pos = PT + XINT (n);
   if (NILP (killflag))
@@ -309,20 +279,19 @@ At the end, it runs `post-self-insert-hook'.  */)
     error ("Negative repetition argument %"pI"d", XINT (n));
 
   if (XFASTINT (n) < 2)
-    remove_excessive_undo_boundaries ();
+    call0 (Qundo_auto__amalgamate);
 
   /* Barf if the key that invoked this was not a character.  */
   if (!CHARACTERP (last_command_event))
     bitch_at_user ();
-  else
-    {
-      int character = translate_char (Vtranslation_table_for_input,
-                                     XINT (last_command_event));
-      int val = internal_self_insert (character, XFASTINT (n));
-      if (val == 2)
-       nonundocount = 0;
-      frame_make_pointer_invisible (SELECTED_FRAME ());
-    }
+  else {
+    int character = translate_char (Vtranslation_table_for_input,
+                                   XINT (last_command_event));
+    int val = internal_self_insert (character, XFASTINT (n));
+    if (val == 2)
+      Fset (Qundo_auto__this_command_amalgamating, Qnil);
+    frame_make_pointer_invisible (SELECTED_FRAME ());
+  }
 
   return Qnil;
 }
@@ -525,6 +494,10 @@ internal_self_insert (int c, EMACS_INT n)
 void
 syms_of_cmds (void)
 {
+  DEFSYM (Qundo_auto__amalgamate, "undo-auto--amalgamate");
+  DEFSYM (Qundo_auto__this_command_amalgamating,
+          "undo-auto--this-command-amalgamating");
+
   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
 
   /* A possible value for a buffer's overwrite-mode variable.  */
@@ -554,7 +527,6 @@ keys_of_cmds (void)
 {
   int n;
 
-  nonundocount = 0;
   initial_define_key (global_map, Ctl ('I'), "self-insert-command");
   for (n = 040; n < 0177; n++)
     initial_define_key (global_map, n, "self-insert-command");
diff --git a/src/keyboard.c b/src/keyboard.c
index 8512078..2449abb 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1230,9 +1230,6 @@ static int read_key_sequence (Lisp_Object *, int, 
Lisp_Object,
                               bool, bool, bool, bool);
 static void adjust_point_for_property (ptrdiff_t, bool);
 
-/* The last boundary auto-added to buffer-undo-list.  */
-Lisp_Object last_undo_boundary;
-
 Lisp_Object
 command_loop_1 (void)
 {
@@ -1448,13 +1445,10 @@ command_loop_1 (void)
               }
 #endif
 
-           {
-             Lisp_Object undo = BVAR (current_buffer, undo_list);
-             Fundo_boundary ();
-             last_undo_boundary
-               = (EQ (undo, BVAR (current_buffer, undo_list))
-                  ? Qnil : BVAR (current_buffer, undo_list));
-           }
+            /* Ensure that we have added appropriate undo-boundaries as a
+               result of changes from the last command. */
+            call0 (Qundo_auto__add_boundary);
+
             call1 (Qcommand_execute, Vthis_command);
 
 #ifdef HAVE_WINDOW_SYSTEM
@@ -10909,6 +10903,8 @@ syms_of_keyboard (void)
   DEFSYM (Qpre_command_hook, "pre-command-hook");
   DEFSYM (Qpost_command_hook, "post-command-hook");
 
+  DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary");
+
   DEFSYM (Qdeferred_action_function, "deferred-action-function");
   DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
   DEFSYM (Qfunction_key, "function-key");
diff --git a/src/lisp.h b/src/lisp.h
index c782f0d..3efa492 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4008,7 +4008,6 @@ extern void syms_of_casetab (void);
 extern Lisp_Object echo_message_buffer;
 extern struct kboard *echo_kboard;
 extern void cancel_echoing (void);
-extern Lisp_Object last_undo_boundary;
 extern bool input_pending;
 #ifdef HAVE_STACK_OVERFLOW_HANDLING
 extern sigjmp_buf return_to_command_loop;
diff --git a/src/undo.c b/src/undo.c
index e0924b2..009ebc0 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -23,10 +23,6 @@ along with GNU Emacs.  If not, see 
<http://www.gnu.org/licenses/>.  */
 #include "lisp.h"
 #include "buffer.h"
 
-/* Last buffer for which undo information was recorded.  */
-/* BEWARE: This is not traced by the GC, so never dereference it!  */
-static struct buffer *last_undo_buffer;
-
 /* Position of point last time we inserted a boundary.  */
 static struct buffer *last_boundary_buffer;
 static ptrdiff_t last_boundary_position;
@@ -38,6 +34,12 @@ static ptrdiff_t last_boundary_position;
    an undo-boundary.  */
 static Lisp_Object pending_boundary;
 
+void
+run_undoable_change ()
+{
+  call0 (Qundo_auto__undoable_change);
+}
+
 /* Record point as it was at beginning of this command (if necessary)
    and prepare the undo info for recording a change.
    PT is the position of point that will naturally occur as a result of the
@@ -56,15 +58,7 @@ record_point (ptrdiff_t pt)
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
-  if ((current_buffer != last_undo_buffer)
-      /* Don't call Fundo_boundary for the first change.  Otherwise we
-        risk overwriting last_boundary_position in Fundo_boundary with
-        PT of the current buffer and as a consequence not insert an
-        undo boundary because last_boundary_position will equal pt in
-        the test at the end of the present function (Bug#731).  */
-      && (MODIFF > SAVE_MODIFF))
-    Fundo_boundary ();
-  last_undo_buffer = current_buffer;
+  run_undoable_change ();
 
   at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
                 || NILP (XCAR (BVAR (current_buffer, undo_list)));
@@ -136,9 +130,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
-  if (current_buffer != last_undo_buffer)
-    Fundo_boundary ();
-  last_undo_buffer = current_buffer;
+  run_undoable_change ();
 
   for (m = BUF_MARKERS (current_buffer); m; m = m->next)
     {
@@ -225,10 +217,6 @@ record_first_change (void)
   if (EQ (BVAR (current_buffer, undo_list), Qt))
     return;
 
-  if (current_buffer != last_undo_buffer)
-    Fundo_boundary ();
-  last_undo_buffer = current_buffer;
-
   if (base_buffer->base_buffer)
     base_buffer = base_buffer->base_buffer;
 
@@ -256,15 +244,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
-  if (buf != last_undo_buffer)
-    boundary = true;
-  last_undo_buffer = buf;
-
   /* Switch temporarily to the buffer that was changed.  */
-  current_buffer = buf;
+  set_buffer_internal (buf);
 
-  if (boundary)
-    Fundo_boundary ();
+  run_undoable_change ();
 
   if (MODIFF <= SAVE_MODIFF)
     record_first_change ();
@@ -275,7 +258,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
   bset_undo_list (current_buffer,
                  Fcons (entry, BVAR (current_buffer, undo_list)));
 
-  current_buffer = obuf;
+  /* Reset the buffer */
+  set_buffer_internal (obuf);
 }
 
 DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0,
@@ -305,6 +289,8 @@ but another undo command will undo to the previous 
boundary.  */)
     }
   last_boundary_position = PT;
   last_boundary_buffer = current_buffer;
+
+  Fset (Qundo_auto__last_boundary_cause, Qexplicit);
   return Qnil;
 }
 
@@ -380,7 +366,6 @@ truncate_undo_list (struct buffer *b)
       && !NILP (Vundo_outer_limit_function))
     {
       Lisp_Object tem;
-      struct buffer *temp = last_undo_buffer;
 
       /* Normally the function this calls is undo-outer-limit-truncate.  */
       tem = call1 (Vundo_outer_limit_function, make_number (size_so_far));
@@ -391,10 +376,6 @@ truncate_undo_list (struct buffer *b)
          unbind_to (count, Qnil);
          return;
        }
-      /* That function probably used the minibuffer, and if so, that
-        changed last_undo_buffer.  Change it back so that we don't
-        force next change to make an undo boundary here.  */
-      last_undo_buffer = temp;
     }
 
   if (CONSP (next))
@@ -452,6 +433,9 @@ void
 syms_of_undo (void)
 {
   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
+  DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change");
+  DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause");
+  DEFSYM (Qexplicit, "explicit");
 
   /* Marker for function call undo list elements.  */
   DEFSYM (Qapply, "apply");
@@ -459,7 +443,6 @@ syms_of_undo (void)
   pending_boundary = Qnil;
   staticpro (&pending_boundary);
 
-  last_undo_buffer = NULL;
   last_boundary_buffer = NULL;
 
   defsubr (&Sundo_boundary);