[Emacs-diffs] fix/no-undo-boundary-on-secondary-buffer-change 825ade0: Remove excessive boundaries reworked.

[Phillip Lord]

branch: fix/no-undo-boundary-on-secondary-buffer-change
commit 825ade0cb9ad0936bb53b4732abda9e9aa1ce1a0
Author: Phillip Lord <address@hidden>
Commit: Phillip Lord <address@hidden>

    Remove excessive boundaries reworked.
    
    We now use direct calls rather than hook functions for most of the calls
    through to lisp. Instead of identifying the last boundary by storing
    cons cell as global state, we introduce a new buffer-local variable
    storing the reason why the last boundary was introduced.
---
 lisp/simple.el |   96 ++++++++++++++++++++++++++++++++------------------------
 src/cmds.c     |    4 ++
 src/undo.c     |   35 ++++++++++----------
 3 files changed, 77 insertions(+), 58 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 16cba7e..03982a7 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -27,7 +27,6 @@
 ;; major mode or to file-handling.
 
 ;;; Code:
-
 (eval-when-compile (require 'cl-lib))
 
 (declare-function widget-convert "wid-edit" (type &rest args))
@@ -2766,6 +2765,8 @@ with < or <= based on USE-<."
 ;; removed from a buffer with any rapidity and no undo-boundary. In
 ;; this case, the `undo-outer-limit' machinary will operate; this is
 ;; considered to be exceptional the user is warned.
+
+
 (defmacro undo-auto-message (&rest args)
   `(let ((msg
           (format ,@args)))
@@ -2774,14 +2775,12 @@ with < or <= based on USE-<."
           "*undo-auto-log*")
        (goto-char (point-max))
        (insert msg)
-       (insert "\n")
-       (when (get-buffer-window)
-         (recenter))
-       )))
+       (insert "\n"))))
 
-(undo-auto-message "initialized")
-(with-current-buffer "*undo-auto-log*"
+(with-current-buffer
+    (get-buffer-create "*undo-auto-log*")
   (setq buffer-undo-list t))
+(undo-auto-message "initialized")
 
 (defun undo-needs-boundary-p ()
   "Returns non-nil if `buffer-undo-list' needs a boundary at the start."
@@ -2791,15 +2790,34 @@ with < or <= based on USE-<."
    ;; The first element of buffer-undo-list is not nil.
    (car buffer-undo-list)))
 
-(defun undo-ensure-boundary ()
+(defun undo-last-boundary-sic-p (last-boundary)
+  "Returns non-nil if the last boundary was from self-insert-command.
+Returns the actual number of times a self-insert-command has been
+run."
+  (and
+   (eq 'command
+       (car-safe last-boundary))
+   (eq 'self-insert-command
+       (nth 1 last-boundary))
+   (or (nth 2 last-boundary)
+       0)))
+
+(defun undo-ensure-boundary (reason)
   ""
   (when (and
          buffer-undo-list
          (undo-needs-boundary-p))
-    (undo-boundary)
+    (let ((last-sic
+           (undo-last-boundary-sic-p undo-last-boundary)))
+      (when last-sic
+        (setq reason
+              `(command self-insert-command
+                        ,(1+ last-sic))))
+      (undo-boundary)
+      (setq undo-last-boundary reason))
     t))
 
-(defun undo-auto-boundary ()
+(defun undo-auto-boundary (reason)
   "Checks recently change buffers and adds a boundary if necessary.
 
 See also `undo-ensure-boundary'."
@@ -2807,7 +2825,7 @@ See also `undo-ensure-boundary'."
    (lambda (b)
      (when (buffer-live-p b)
        (with-current-buffer b
-         (when (undo-ensure-boundary)
+         (when (undo-ensure-boundary reason)
            (undo-auto-message "undo-auto-boundary boundary added %s" b)))))
    undo-undoably-changed-buffers)
   (setq undo-undoably-changed-buffers nil))
@@ -2817,7 +2835,8 @@ See also `undo-ensure-boundary'."
 
 (defun undo-auto-boundary-timer ()
   "Timer which will run `undo-auto-boundary-timer'."
-  (undo-auto-boundary)
+  (undo-auto-message "running timer")
+  (undo-auto-boundary 'timer)
   (setq undo-auto-current-boundary-timer nil))
 
 (defun undo-auto-boundary-ensure-timer ()
@@ -2844,39 +2863,34 @@ See also `undo-buffer-undoably-changed'.")
 
 (defun undo-auto-post-command-hook ()
   (unless (eq buffer-undo-list t)
-    (undo-auto-boundary)))
-
-(defun undo-auto-pre-command-hook()
-  (when (and (eq last-command 'self-insert-command)
-             (eq this-command 'self-insert-command))
-    ;; As last-command was s-i-c, there should be "insert" cons just
-    ;; before this. We need to check that there have not been too many 
insertions
-    (let ((last-before-nil
-           (cadr buffer-undo-list)))
-      (when
-          (> 20
-             (- (cdr last-before-nil)
-                (car last-before-nil)))
-        (undo-auto-message "Removing last undo")
-        (setq buffer-undo-list
-              (cdr buffer-undo-list))))))
-
-(defun undo-auto-boundary-change (_ _ _)
-  ;;(undo-auto-message "undo-auto adding-to-list %s" (current-buffer))
-  (unless (eq buffer-undo-list t)
-    (add-to-list 'undo-undoably-changed-buffers
-                 (current-buffer))
-    (undo-auto-boundary-ensure-timer)))
-
-(add-hook 'after-change-functions
-          #'undo-auto-boundary-change)
+    (undo-auto-boundary `(command ,this-command))))
+
+(defun undo-auto-pre-self-insert-command()
+  (condition-case err
+      (let ((last-sic-count
+             (undo-last-boundary-sic-p undo-last-boundary)))
+        (when
+            last-sic-count
+          (if
+              (< last-sic-count 20)
+              (progn (undo-auto-message "(changed) Removing last undo")
+                     (setq buffer-undo-list
+                           (cdr buffer-undo-list)))
+            (progn (undo-auto-message "Reset sic to 0")
+                   (setq undo-last-boundary
+                         '(command self-insert-command 0))))))
+    (error
+     (undo-auto-message "pre-command-error %s"
+                        (error-message-string err)))))
+
+(defun undo-undoable-change ()
+  (undo-auto-message "undo-auto adding-to-list %s" (current-buffer))
+  (add-to-list 'undo-undoably-changed-buffers (current-buffer))
+  (undo-auto-boundary-ensure-timer))
 
 (add-hook 'post-command-hook
           #'undo-auto-post-command-hook)
 
-(add-hook 'pre-command-hook
-          #'undo-auto-pre-command-hook)
-
 (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 8e30417..4a1782c 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -315,6 +315,7 @@ At the end, it runs `post-self-insert-hook'.  */)
   // PWL remove for now
   //if (XFASTINT (n) < 2)
   //remove_excessive_undo_boundaries ();
+  call0(Qundo_auto_pre_self_insert_command);
 
   /* Barf if the key that invoked this was not a character.  */
   if (!CHARACTERP (last_command_event))
@@ -529,6 +530,9 @@ internal_self_insert (int c, EMACS_INT n)
 void
 syms_of_cmds (void)
 {
+  DEFSYM (Qundo_auto_pre_self_insert_command,
+          "undo-auto-pre-self-insert-command" );
+
   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
 
   /* A possible value for a buffer's overwrite-mode variable.  */
diff --git a/src/undo.c b/src/undo.c
index 509b972..58d1e7d 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -37,20 +37,10 @@ static ptrdiff_t last_boundary_position;
    an undo-boundary.  */
 static Lisp_Object pending_boundary;
 
-/*
-  Run the first-undo-hook if needed
- */
 void
-run_first_undo_hook ()
+run_undoable_change ()
 {
-  Lisp_Object list;
-
-  list = BVAR (current_buffer, undo_list);
-
-  if (NILP (list) || CONSP (list) && NILP (XCAR (list)))
-    {
-      safe_run_hooks (Qundo_first_undoable_change_hook);
-    }
+  call0(Qundo_undoable_change);
 }
 
 /* Record point as it was at beginning of this command (if necessary)
@@ -71,7 +61,7 @@ record_point (ptrdiff_t pt)
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
-  run_first_undo_hook ();
+  run_undoable_change ();
 
   at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
                 || NILP (XCAR (BVAR (current_buffer, undo_list)));
@@ -143,8 +133,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to)
   if (NILP (pending_boundary))
     pending_boundary = Fcons (Qnil, Qnil);
 
-
-  run_first_undo_hook ();
+  run_undoable_change ();
 
   for (m = BUF_MARKERS (current_buffer); m; m = m->next)
     {
@@ -261,7 +250,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
   /* Switch temporarily to the buffer that was changed.  */
   current_buffer = buf;
 
-  run_first_undo_hook ();
+  // PWL running with the wrong current-buffer
+  run_undoable_change ();
 
   if (MODIFF <= SAVE_MODIFF)
     record_first_change ();
@@ -302,6 +292,8 @@ but another undo command will undo to the previous 
boundary.  */)
     }
   last_boundary_position = PT;
   last_boundary_buffer = current_buffer;
+
+  Fset(Qundo_last_boundary,Qnil);
   return Qnil;
 }
 
@@ -498,7 +490,8 @@ void
 syms_of_undo (void)
 {
   DEFSYM (Qinhibit_read_only, "inhibit-read-only");
-  DEFSYM (Qundo_first_undoable_change_hook, "undo-first-undoable-change-hook");
+  DEFSYM (Qundo_undoable_change, "undo-undoable-change");
+  DEFSYM (Qundo_last_boundary, "undo-last-boundary");
 
   /* Marker for function call undo list elements.  */
   DEFSYM (Qapply, "apply");
@@ -572,4 +565,12 @@ so it must make sure not to do a lot of consing.  */);
 This hook will be run with `current-buffer' as the buffer that has
 changed.  Recent means since the last boundary. */);
   Vundo_first_undoable_change_hook = Qnil;
+
+  DEFVAR_LISP ("undo-last-boundary",
+               Vundo_last_boundary,
+               doc: /* TODO
+*/);
+
+  Fmake_variable_buffer_local (Qundo_last_boundary);
+  Vundo_last_boundary = Qnil;
 }