From ab34a312c570a22f0d460b7cadd948bd5f88bbe4 Mon Sep 17 00:00:00 2001
From: Eitaro Fukamachi <e.arrows@gmail.com>
Date: Thu, 31 Aug 2023 12:16:22 +0000
Subject: [PATCH] Add a feature to disable undo boundary temporarily.

---
 extensions/vi-mode/vi-mode.lisp | 17 ++++-------------
 src/base/buffer.lisp            | 20 ++++++++++++++++++--
 src/base/package.lisp           |  2 ++
 3 files changed, 24 insertions(+), 15 deletions(-)

diff --git a/extensions/vi-mode/vi-mode.lisp b/extensions/vi-mode/vi-mode.lisp
index 8dcc07df8..905dd39f1 100644
--- a/extensions/vi-mode/vi-mode.lisp
+++ b/extensions/vi-mode/vi-mode.lisp
@@ -60,22 +60,13 @@
                        (eq (vi-command-repeat command) nil))
                   (eq (command-name (this-command)) 'vi-end-insert))
         (appendf *last-repeat-keys*
-                 (vi-this-command-keys))))
-    (when (and (member (command-name command)
-                       '(self-insert
-                         ;; XXX: lem:call-command always adds a undo boundary
-                         ;;  Delete the last boundary after these commands executed.
-                         vi-open-below
-                         vi-open-above)
-                       :test 'eq)
-               (eq :separator (lem-base::last-edit-history (current-buffer))))
-      (vector-pop (lem-base::buffer-edit-history (current-buffer))))))
+                 (vi-this-command-keys))))))
 
 (defmethod state-enabled-hook ((state insert))
   (when *enable-repeat-recording*
     (setf *last-repeat-keys* nil))
-  (buffer-undo-boundary))
+  (buffer-undo-boundary)
+  (buffer-disable-undo-boundary (lem:current-buffer)))
 
 (defmethod state-disabled-hook ((state insert))
-  (unless (eq :separator (lem-base::last-edit-history (current-buffer)))
-    (buffer-undo-boundary)))
+  (buffer-enable-undo-boundary (lem:current-buffer)))
diff --git a/src/base/buffer.lisp b/src/base/buffer.lisp
index c7d874dd0..4843d8271 100644
--- a/src/base/buffer.lisp
+++ b/src/base/buffer.lisp
@@ -31,6 +31,10 @@
     :initarg :%enable-undo-p
     :accessor buffer-%enable-undo-p
     :type boolean)
+   (%enable-undo-boundary-p
+    :initarg :%enable-undo-boundary-p
+    :initform t
+    :accessor buffer-%enable-undo-boundary-p)
    (read-only-p
     :initarg :read-only-p
     :accessor buffer-read-only-p
@@ -194,6 +198,17 @@ Options that can be specified by arguments are ignored if `temporary` is NIL and
   (setf (buffer-redo-stack buffer) nil)
   nil)
 
+(defun buffer-enable-undo-boundary-p (&optional (buffer (current-buffer)))
+  (buffer-%enable-undo-boundary-p buffer))
+
+(defun buffer-enable-undo-boundary (buffer)
+  (setf (buffer-%enable-undo-boundary-p buffer) t)
+  nil)
+
+(defun buffer-disable-undo-boundary (buffer)
+  (setf (buffer-%enable-undo-boundary-p buffer) nil)
+  nil)
+
 (defmethod print-object ((buffer buffer) stream)
   (print-unreadable-object (buffer stream :identity t :type t)
     (format stream "~A ~A"
@@ -339,8 +354,9 @@ Options that can be specified by arguments are ignored if `temporary` is NIL and
       result0)))
 
 (defun buffer-undo-boundary (&optional (buffer (current-buffer)))
-  (unless (eq :separator (last-edit-history buffer))
-    (vector-push-extend :separator (buffer-edit-history buffer))))
+  (when (buffer-enable-undo-boundary-p)
+    (unless (eq :separator (last-edit-history buffer))
+      (vector-push-extend :separator (buffer-edit-history buffer)))))
 
 (defun buffer-value (buffer name &optional default)
   "`buffer`のバッファ変数`name`に束縛されている値を返します。
diff --git a/src/base/package.lisp b/src/base/package.lisp
index 957bb429b..462a4e38a 100644
--- a/src/base/package.lisp
+++ b/src/base/package.lisp
@@ -109,6 +109,8 @@
    :buffer-undo
    :buffer-redo
    :buffer-undo-boundary
+   :buffer-enable-undo-boundary
+   :buffer-disable-undo-boundary
    :buffer-value
    :buffer-unbound
    :clear-buffer-variables)