From b3fb68c35a36c80ca492ee071d8f0ab93710c368 Mon Sep 17 00:00:00 2001 From: cxxxr Date: Tue, 31 Dec 2024 12:22:29 +0900 Subject: [PATCH] Fixes a bug where the position is shifted when using undo during collaborative editing. --- src/buffer/internal/buffer-insert.lisp | 45 ++++++---- tests/buffer/internal.lisp | 112 +++++++++++++++++++++++++ 2 files changed, 140 insertions(+), 17 deletions(-) diff --git a/src/buffer/internal/buffer-insert.lisp b/src/buffer/internal/buffer-insert.lisp index db39c6abd..ef32948ac 100644 --- a/src/buffer/internal/buffer-insert.lisp +++ b/src/buffer/internal/buffer-insert.lisp @@ -186,24 +186,35 @@ (defmethod insert-string/point :around (point string) (call-before-change-functions point 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)))))))) + (cond ((buffer-enable-undo-p buffer) + (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)))))) + (t + (prog1 (insert/after-change-function point (length string) #'call-next-method) + (when (inhibit-undo-p) + (let ((edit (make-edit :insert-string (position-at-point point) string))) + (recompute-undo-position-offset buffer edit)))))))) (defmethod delete-char/point :around (point remaining-deletions) (call-before-change-functions point remaining-deletions) (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)))) + (cond ((buffer-enable-undo-p buffer) + (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)) + (t + (let ((string (delete/after-change-function point #'call-next-method))) + (when (inhibit-undo-p) + (let ((edit (make-edit :delete-string + (position-at-point point) + string))) + (recompute-undo-position-offset buffer edit))) + string))))) diff --git a/tests/buffer/internal.lisp b/tests/buffer/internal.lisp index 22b165ea1..4ff387671 100644 --- a/tests/buffer/internal.lisp +++ b/tests/buffer/internal.lisp @@ -93,3 +93,115 @@ qrstuvwxyz" (ok (= 1 (lem:position-at-point start))) (ok (= 2 (lem:position-at-point end))) (ok (= 0 old-len)))))) + +(defun print-buffer (point &key (cursor #'cl-ansi-text:red) (stream *standard-output*)) + (let* ((buffer (lem:point-buffer point)) + (text (str:concat (lem:buffer-text buffer) " ")) + (pos (1- (lem:position-at-point point)))) + (format stream + "~A~A~A~%" + (subseq text 0 pos) + (funcall cursor (string (char text pos)) :style :background) + (subseq text (1+ pos))))) + +(defun on-before-change (name) + (lambda (point arg) + (etypecase arg + (string + (format t "~A inserts ~S into position ~S~%" name arg (lem:position-at-point point))) + (integer + (format t + "~A deletes ~S letters from position ~S~%" + name + arg + (lem:position-at-point point)))))) + +(defun on-after-change (cursor) + (lambda (start end old-len) + (declare (ignore end old-len)) + (let* ((buffer (lem:point-buffer start)) + (point (lem:buffer-point buffer))) + (print-buffer point :cursor cursor)))) + +(deftest multiuser-undo + ;; Arrange + (let* ((alice-buffer (lem:make-buffer "Alice's buffer" :temporary t)) + (bob-buffer (lem:make-buffer "Bob's buffer" :temporary t))) + + (lem:add-hook (lem:variable-value 'lem:before-change-functions :buffer alice-buffer) + (on-before-change "Alice")) + (lem:add-hook (lem:variable-value 'lem:after-change-functions :buffer alice-buffer) + (on-after-change #'cl-ansi-text:red)) + + (lem:add-hook (lem:variable-value 'lem:before-change-functions :buffer bob-buffer) + (on-before-change "Bob")) + (lem:add-hook (lem:variable-value 'lem:after-change-functions :buffer bob-buffer) + (on-after-change #'cl-ansi-text:green)) + + (format t "~%## Arrange~%") + + (lem:with-point ((alice-point (lem:buffer-point alice-buffer) :right-inserting) + (alice-temporary-point (lem:buffer-point alice-buffer) :left-inserting) + (bob-point (lem:buffer-point bob-buffer) :right-inserting) + (bob-temporary-point (lem:buffer-point bob-buffer) :left-inserting)) + + + (lem:buffer-disable-undo alice-buffer) + (lem:buffer-disable-undo bob-buffer) + + (lem:insert-string alice-point "___") + (lem:buffer-start alice-point) + + (lem:insert-string bob-point "___") + (lem:buffer-start bob-point) + (lem:character-offset bob-point 2) + + (lem:buffer-enable-undo alice-buffer) + (lem:buffer-enable-undo bob-buffer) + + ;; Act + (format t "~%## Act~%") + + (write-line "### Alice inserts \"a\"") + (lem:insert-string alice-point "a") + (lem:with-inhibit-undo () + (lem:insert-string (lem:move-to-position bob-temporary-point + (lem:position-at-point alice-point)) + "a")) + + (terpri) + + (write-line "### Bob inserts \"b\"") + (lem:insert-string bob-point "b") + (lem:with-inhibit-undo () + (lem:insert-string (lem:move-to-position alice-temporary-point + (lem:position-at-point bob-point)) + "b")) + + (terpri) + + (write-line "### Alice undo") + (lem:buffer-undo alice-point) + (lem:with-inhibit-undo () + (lem:delete-character (lem:move-to-position bob-temporary-point + (lem:position-at-point alice-point)) + 1)) + + (terpri) + + (write-line "### Bob undo") + (lem:buffer-undo bob-point) + (lem:with-inhibit-undo () + (lem:delete-character (lem:move-to-position alice-temporary-point + (lem:position-at-point bob-point)) + 1)) + + (terpri) + (format t "Alice: ") + (print-buffer alice-point :cursor #'cl-ansi-text:red) + (format t "Bob: ") + (print-buffer bob-point :cursor #'cl-ansi-text:green) + + (terpri) + (ok (equal "___" (lem:buffer-text alice-buffer))) + (ok (equal "___" (lem:buffer-text bob-buffer))))))