[Emacs-diffs] fix/no-undo-boundary-on-secondary-buffer-change fa9c238 1/4: Cosmetic changes and introduction of some more state!

[Phillip Lord]

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

    Cosmetic changes and introduction of some more state!
    
    This now handles amalgamation for both self-insert-command
    and delete-char (and can be extended freely for any command).
---
 lisp/simple.el |  146 +++++++++++++++++++++++++++++--------------------------
 src/cmds.c     |   15 +++---
 src/keyboard.c |    4 ++
 src/undo.c     |   21 +++-----
 4 files changed, 95 insertions(+), 91 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index a2421df..e090f8f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -27,6 +27,7 @@
 ;; major mode or to file-handling.
 
 ;;; Code:
+
 (eval-when-compile (require 'cl-lib))
 
 (declare-function widget-convert "wid-edit" (type &rest args))
@@ -2244,10 +2245,6 @@ as an argument limits undo to changes within the current 
region."
     ;; the next command should not be a "consecutive undo".
     ;; So set `this-command' to something other than `undo'.
     (setq this-command 'undo-start)
-    ;; We need to set `undo-last-boundary' to nil as we are about to
-    ;; delete the last boundary, so we want to not assume anything about
-    ;; the boundary before this one
-    (setq undo-last-boundary nil)
     (unless (and (eq last-command 'undo)
                 (or (eq pending-undo-list t)
                     ;; If something (a timer or filter?) changed the buffer
@@ -2758,18 +2755,9 @@ with < or <= based on USE-<."
 
 ;; Default undo-boundary addition
 ;;
-;; This section helps to prevent undo-lists from getting too large. It
-;; achieves by checking that no buffer has an undo-list which is large
-;; and has no `undo-boundary', a condition that will block garbage
-;; collection of that list. This happens silently and in most cases
-;; not at all, as generally, buffers add their own undo-boundary.
-;;
-;; It will still fail if a large amount of material is added or
-;; 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.
-
-
+;; 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.
 (defmacro undo-auto-message (&rest args)
   `(let ((msg
           (format ,@args)))
@@ -2785,52 +2773,67 @@ with < or <= based on USE-<."
   (setq buffer-undo-list t))
 (undo-auto-message "initialized")
 
+(defvar-local undo-last-boundary nil
+  "Describe the cause of the last undo-boundary.
+
+If nil, 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 number, then the last boundary was inserted
+by an amalgamating command.")
+
+(defvar undo--last-command-amalgamating nil)
+
+(defvar undo--amalgamating-commands '(self-insert-command delete-char))
+
 (defun undo-needs-boundary-p ()
-  "Returns non-nil if `buffer-undo-list' needs a boundary at the start."
-  (and
-   ;; `buffer-undo-list' can be t.
-   (listp buffer-undo-list)
-   ;; The first element of buffer-undo-list is not nil.
-   (car buffer-undo-list)))
-
-(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)))
+  "Return non-nil if `buffer-undo-list' needs a boundary at the start."
+  (car-safe buffer-undo-list))
+
+(defun undo-last-boundary-amalgamating-p ()
+  "Return non-nil if the last boundary was from an amalgamating command.
+Amalgamating commands are either `self-insert-command' and
+`delete-char'.  The return value is actual number of times one of
+these commands have been run if non-nil."
+  (and (integerp undo-last-boundary)
+       undo-last-boundary))
 
 (defun undo-ensure-boundary (reason)
-  ""
+  "Add an `undo-boundary' to the current buffer if needed.
+REASON describes the reason that the boundary is being added; see
+`undo-last-boundary' for more information. "
   (when (and
          buffer-undo-list
          (undo-needs-boundary-p))
-    (let ((last-sic
-           (undo-last-boundary-sic-p undo-last-boundary)))
-      (when last-sic
-        (setq reason
-              `(command self-insert-command
-                        ,(1+ last-sic))))
+    (let ((last-amalgamating
+           (undo-last-boundary-amalgamating-p)))
+      (when (and last-amalgamating
+                 (eq 'amalgamate reason))
+        (setq reason (1+ last-amalgamating)))
       (undo-boundary)
-      (setq undo-last-boundary reason))
+      (setq undo-last-boundary
+            (if (eq 'amalgamate reason)
+                0
+              reason)))
+    (undo-auto-message "last-boundary now %s" undo-last-boundary)
     t))
 
 (defun undo-auto-boundary (reason)
   "Checks recently change buffers and adds a boundary if necessary.
 
 See also `undo-ensure-boundary'."
-  (mapc
-   (lambda (b)
-     (when (buffer-live-p b)
-       (with-current-buffer b
-         (when (undo-ensure-boundary reason)
-           (undo-auto-message "undo-auto-boundary boundary added %s" b)))))
-   undo-undoably-changed-buffers)
+  (dolist (b undo-undoably-changed-buffers)
+          (when (buffer-live-p b)
+            (with-current-buffer b
+              (undo-ensure-boundary reason))))
   (setq undo-undoably-changed-buffers nil))
 
 (defvar undo-auto-current-boundary-timer nil
@@ -2838,12 +2841,12 @@ See also `undo-ensure-boundary'."
 
 (defun undo-auto-boundary-timer ()
   "Timer which will run `undo-auto-boundary-timer'."
-  (undo-auto-message "running timer")
+  ;;(undo-auto-message "running timer")
   (undo-auto-boundary 'timer)
   (setq undo-auto-current-boundary-timer nil))
 
 (defun undo-auto-boundary-ensure-timer ()
-  "Ensure that the `undo-auto-boundary-timer is set."
+  "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))))
@@ -2851,49 +2854,54 @@ See also `undo-ensure-boundary'."
 (defvar undo-undoably-changed-buffers nil
   "List of buffers that have changed recently.
 
-This list is maintained by
-`undo-auto-boundary-first-undoable-change-hook' and
+This list is maintained by `undo-undoable-change' and
 `undo-auto-boundary' and can be affected by changes to their
 default values.
 
 See also `undo-buffer-undoably-changed'.")
 
-(defun undo-auto-boundary-first-undoable-change-hook ()
-  "Default value of `undo-boundary-first-undoable-change-hook'."
-  ;;(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))
-
 (defun undo-auto-post-command-hook ()
   (unless (eq buffer-undo-list t)
-    (undo-auto-boundary `(command ,this-command))))
-
-(defun undo-auto-pre-self-insert-command()
+    (undo-auto-boundary
+     (if undo--last-command-amalgamating
+         'amalgamate
+       'command))))
+
+(defun undo-auto-pre-amalgamating-command ()
+  "Amalgamate undo if necessary.
+This function is called before `self-insert-command', and removes
+the previous `undo-boundary' if a series of `self-insert-command'
+calls have been made."
   (condition-case err
-      (let ((last-sic-count
-             (undo-last-boundary-sic-p undo-last-boundary)))
+      (let ((last-amalgamating-count
+             (undo-last-boundary-amalgamating-p)))
+        (setq undo--last-command-amalgamating t)
         (when
-            last-sic-count
+            last-amalgamating-count
           (if
-              (< last-sic-count 20)
+              (and
+               (< last-amalgamating-count 20)
+               (eq this-command last-command))
               (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))))))
+                   (setq undo-last-boundary 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))
+  "Called after every undoable buffer 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)
 
+;; 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 4a1782c..6931546 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -265,9 +265,8 @@ because it respects values of `delete-active-region' and 
`overwrite-mode'.  */)
 
   CHECK_NUMBER (n);
 
-  // PWL
-  //if (abs (XINT (n)) < 2)
-  //  remove_excessive_undo_boundaries ();
+  if (abs (XINT (n)) < 2)
+    call0(Qundo_auto_pre_amalgamating_command);
 
   pos = PT + XINT (n);
   if (NILP (killflag))
@@ -312,10 +311,10 @@ At the end, it runs `post-self-insert-hook'.  */)
   if (XFASTINT (n) < 0)
     error ("Negative repetition argument %"pI"d", XFASTINT (n));
 
-  // PWL remove for now
-  //if (XFASTINT (n) < 2)
+  if (XFASTINT (n) < 2)
+    call0(Qundo_auto_pre_amalgamating_command);
+
   //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))
@@ -530,8 +529,8 @@ 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 (Qundo_auto_pre_amalgamating_command,
+          "undo-auto-pre-amalgamating-command" );
 
   DEFSYM (Qkill_forward_chars, "kill-forward-chars");
 
diff --git a/src/keyboard.c b/src/keyboard.c
index 29307cb..852ceed 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1502,6 +1502,8 @@ command_loop_1 (void)
               }
 #endif
 
+            Fset (Qundo__last_command_amalgamating, Qnil);
+
             /* if (NILP (KVAR (current_kboard, Vprefix_arg))) /\* FIXME: Why?  
--Stef  *\/ */
             /*   { */
             /*     Fundo_auto_boundary(); */
@@ -11088,6 +11090,8 @@ syms_of_keyboard (void)
   DEFSYM (Qpre_command_hook, "pre-command-hook");
   DEFSYM (Qpost_command_hook, "post-command-hook");
 
+  DEFSYM (Qundo__last_command_amalgamating, "undo--last-command-amalgamating");
+
   DEFSYM (Qdeferred_action_function, "deferred-action-function");
   DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook");
   DEFSYM (Qfunction_key, "function-key");
diff --git a/src/undo.c b/src/undo.c
index 58d1e7d..57ee037 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -40,7 +40,7 @@ static Lisp_Object pending_boundary;
 void
 run_undoable_change ()
 {
-  call0(Qundo_undoable_change);
+  call0 (Qundo_undoable_change);
 }
 
 /* Record point as it was at beginning of this command (if necessary)
@@ -74,7 +74,8 @@ record_point (ptrdiff_t pt)
   if (at_boundary
       && current_buffer == last_boundary_buffer
       && last_boundary_position != pt)
-    bset_undo_list (current_buffer,
+
+   bset_undo_list (current_buffer,
                    Fcons (make_number (last_boundary_position),
                           BVAR (current_buffer, undo_list)));
 }
@@ -248,9 +249,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length,
     pending_boundary = Fcons (Qnil, Qnil);
 
   /* Switch temporarily to the buffer that was changed.  */
-  current_buffer = buf;
+  set_buffer_internal (buf);
 
-  // PWL running with the wrong current-buffer
   run_undoable_change ();
 
   if (MODIFF <= SAVE_MODIFF)
@@ -262,7 +262,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,
@@ -293,7 +294,7 @@ but another undo command will undo to the previous 
boundary.  */)
   last_boundary_position = PT;
   last_boundary_buffer = current_buffer;
 
-  Fset(Qundo_last_boundary,Qnil);
+  Fset (Qundo_last_boundary,Qnil);
   return Qnil;
 }
 
@@ -565,12 +566,4 @@ 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;
 }