change so that undo can be used for each replica in collaborative edi…

…ting

src/buffer/internal/buffer-insert.lisp

@@ -185,21 +185,25 @@
 
 (defmethod insert-string/point :around (point string)
   (call-before-change-functions point string)
-  (if (not (buffer-enable-undo-p (point-buffer point)))
-      (insert/after-change-function point (length string) #'call-next-method)
-      (let ((position (position-at-point point)))
-        (prog1 (insert/after-change-function point (length string) #'call-next-method)
-          (without-interrupts
-            (push-undo (point-buffer point)
-                       (make-edit :insert-string position string)))))))
+  (let ((buffer (point-buffer point)))
+    (if (not (buffer-enable-undo-p buffer))
+        (insert/after-change-function point (length string) #'call-next-method)
+        (let ((position (position-at-point point)))
+          (prog1 (insert/after-change-function point (length string) #'call-next-method)
+            (let ((edit (make-edit :insert-string position string)))
+              (if (inhibit-undo-p)
+                  (recompute-undo-position-offset buffer edit)
+                  (push-undo buffer edit))))))))
 
 (defmethod delete-char/point :around (point remaining-deletions)
   (call-before-change-functions point remaining-deletions)
-  (if (not (buffer-enable-undo-p (point-buffer point)))
-      (delete/after-change-function point #'call-next-method)
-      (let ((position (position-at-point point))
-            (string (delete/after-change-function point #'call-next-method)))
-        (without-interrupts
-          (push-undo (point-buffer point)
-                     (make-edit :delete-string position string)))
-        string)))
+  (let ((buffer (point-buffer point)))
+    (if (not (buffer-enable-undo-p buffer))
+        (delete/after-change-function point #'call-next-method)
+        (let* ((position (position-at-point point))
+               (string (delete/after-change-function point #'call-next-method))
+               (edit (make-edit :delete-string position string)))
+          (if (inhibit-undo-p)
+              (recompute-undo-position-offset buffer edit)
+              (push-undo buffer edit))
+          string))))

src/buffer/internal/edit.lisp

@@ -8,8 +8,7 @@
         :type edit-kind
         :read-only t)
   (position (alexandria:required-argument :position)
-            :type (integer 0 *)
-            :read-only t)
+            :type (integer 0 *))
   (string (alexandria:required-argument :string)
           :type string
           :read-only t))
@@ -37,3 +36,15 @@
                  (make-edit :insert-string
                             (edit-position edit)
                             (edit-string edit))))))
+
+(defun compute-edit-offset (dest src)
+  (ecase (edit-kind src)
+    ((:insert-string)
+     (when (<= (edit-position src) (edit-position dest))
+       (incf (edit-position dest) (length (edit-string src)))))
+    ((:delete-string)
+     (when (< (edit-position src)
+              (edit-position dest))
+       (decf (edit-position dest) (length (edit-string src)))
+       (when (< (edit-position dest) (edit-position src))
+         (setf (edit-position dest) (edit-position src)))))))

src/buffer/internal/undo.lisp

@@ -3,9 +3,18 @@
 (defparameter *undo-modes* '(:edit :undo :redo))
 (defvar *undo-mode* :edit)
 
+(defvar *inhibit-undo* nil)
+
+(defun inhibit-undo-p ()
+  *inhibit-undo*)
+
+(defmacro with-inhibit-undo (() &body body)
+  `(let ((*inhibit-undo* t))
+     ,@body))
+
 (defun buffer-enable-undo-p (&optional (buffer (current-buffer)))
   "Returns T if undo is enabled for `buffer`, otherwise returns NIL."
-  (buffer-%enable-undo-p buffer))
+  (and (buffer-%enable-undo-p buffer) (not *inhibit-undo*)))
 
 (defun buffer-enable-undo (buffer)
   "Enables undo for `buffer`."
@@ -103,3 +112,11 @@
                     (last-edit-history buffer)))
         (vector-pop (buffer-edit-history buffer)))
       result0)))
+
+(defun recompute-undo-position-offset (buffer edit)
+  (loop :for edit-1 :across (buffer-edit-history buffer)
+        :do (unless (eq edit-1 :separator)
+              (compute-edit-offset edit-1 edit)))
+  (loop :for edit-1 :in (buffer-redo-stack buffer)
+        :do (unless (eq edit-1 :separator)
+              (compute-edit-offset edit-1 edit))))

src/buffer/package.lisp

@@ -81,6 +81,9 @@
    ;; TODO: delete ugly exports
    :%buffer-clear-keep-binfo
    :%buffer-keep-binfo)
+  ;; undo.lisp
+  (:export
+   :with-inhibit-undo)
   (:export
    :buffer-list
    :any-modified-buffer-p