mostly fix cursor and mark position when the cursor is to the left of…

… the mark

extensions/multiple-cursors/multiple-cursors.lisp

@@ -32,14 +32,14 @@
 (define-command mark-next-like-this () ()
   ""
   (if (buffer-mark-p (current-buffer))
-      (mark-like-this-direction (region-beginning (current-buffer)) (region-end (current-buffer))
+      (mark-like-this-direction (buffer-mark (current-buffer)) (buffer-point (current-buffer))
                                 #'search-forward)
       (add-cursors-to-next-line)))
 
 (define-command mark-previous-like-this () ()
   ""
   (if (buffer-mark-p (current-buffer))
-      (mark-like-this-direction (region-beginning (current-buffer)) (region-end (current-buffer))
+      (mark-like-this-direction (buffer-mark (current-buffer)) (buffer-point (current-buffer))
                                 #'search-backward)
       (add-cursors-to-previous-line)))
 
@@ -72,6 +72,7 @@
     (with-point ((point point))
       (if (search-next-matched point 1)
           (progn
+            (setf (point-charpos point) (point-charpos end))
             (setf cursor (make-fake-cursor point))
             (dotimes (_ (- (point-linum end) (point-linum start)))
               (if (equal direction #'search-forward)

tests/multiple-cursors.lisp

@@ -0,0 +1,127 @@
+(defpackage :lem-tests/multiple-cursors
+  (:use :cl
+        :rove
+        :lem-multiple-cursors)
+  )
+(in-package :lem-tests/multiple-cursors)
+
+(deftest mark-next-like-this-test
+  (with-testing-buffer (buffer (make-text-buffer (lines "abcdefg" "hijklmn" "opqrstu")))
+    (make-testing-fake-cursors (lem:buffer-point buffer) 2)
+    (testing "execute self-insert command"
+             (lem:execute-key-sequence (list (lem:make-key :sym " ")))
+             (ok (string= (lines " abcdefg" " hijklmn" " opqrstu")
+                          (lem:buffer-text buffer))))
+    (testing "execute delete-previous-character command"
+             (lem:execute-key-sequence (list (lem:make-key :ctrl t :sym "h")))
+             (lem:buffer-text buffer)
+             (ok (string= (lines "abcdefg" "hijklmn" "opqrstu")
+                          (lem:buffer-text buffer))))
+    (testing "multiple cursor killring"
+             (lem:execute (lem:buffer-major-mode buffer)
+                          (make-instance 'lem:delete-next-char)
+                          4)
+             (ok (equal '("abcd"
+                          "opqr"
+                          "hijk")
+                        (mapcar (lambda (killring)
+                                  (peek-killring-item killring 0))
+                                (cons lem-core::*killring*
+                                      (mapcar (lambda (cursor)
+                                                (lem-core::fake-cursor-killring cursor))
+                                              (lem-core::buffer-fake-cursors buffer))))))))
+  (let* ((buffer (lem:make-buffer "test" :temporary t))
+         (point (lem:buffer-point buffer)))
+    (lem:insert-string point "aa bb cc dd")
+    (lem:move-to-line point 1)
+    (lem:insert-string point "dd aa cc bb")
+    (lem:move-to-line point 2)
+    (lem:insert-string point "cc bb aa dd")
+    (lem:move-to-line point 0)
+    (lem:mark-set)
+    (lem:move-to-column 3)
+    (mark-next-like-this)
+    (mark-next-like-this)
+    (lem:delete-character point)
+    (lem:insert-string point "ee")
+    (ok (equal "ee bb cc dd
+dd ee cc bb
+cc bb ee dd" (lem:buffer-text buffer)))
+    ;; (ok (equal "Hello World" (lem:buffer-text buffer)))
+
+    ))
+
+(deftest test-to-execute-a-series-of-commands
+  (lem-fake-interface:with-fake-interface ()
+    (let ((lem-core::*killring* (lem/common/killring:make-killring 10)))
+      (with-testing-buffer (buffer (make-text-buffer (lines "abcdefg" "hijklmn" "opqrstu")))
+        (make-testing-fake-cursors (lem:buffer-point buffer) 2)
+        (testing "execute self-insert command"
+                 (lem:execute-key-sequence (list (lem:make-key :sym " ")))
+                 (ok (string= (lines " abcdefg" " hijklmn" " opqrstu")
+                              (lem:buffer-text buffer))))
+        (testing "execute delete-previous-character command"
+                 (lem:execute-key-sequence (list (lem:make-key :ctrl t :sym "h")))
+                 (lem:buffer-text buffer)
+                 (ok (string= (lines "abcdefg" "hijklmn" "opqrstu")
+                              (lem:buffer-text buffer))))
+        (testing "multiple cursor killring"
+                 (lem:execute (lem:buffer-major-mode buffer)
+                              (make-instance 'lem:delete-next-char)
+                              4)
+                 (ok (equal '("abcd"
+                              "opqr"
+                              "hijk")
+                            (mapcar (lambda (killring)
+                                      (peek-killring-item killring 0))
+                                    (cons lem-core::*killring*
+                                          (mapcar (lambda (cursor)
+                                                    (lem-core::fake-cursor-killring cursor))
+                                                  (lem-core::buffer-fake-cursors buffer)))))))))))
+
+
+;; (deftest |`buffer-end-point` points to the end of the buffer|
+;;   ;; Arrange
+;;   (let* ((buffer (lem:make-buffer "test" :temporary t))
+;;          (point (lem:buffer-point buffer)))
+;;     (lem:insert-string point "aaaaaaaaaa")
+
+;;     ;; Act
+;;     (lem:move-to-line point 1)
+;;     (lem:move-to-column point 5)
+;;     (lem:delete-character point 10)
+
+;;     ;; Assertion
+;;     (let ((end-point (lem:buffer-end-point buffer)))
+;;       (ok (= 5 (lem:point-charpos end-point)))
+;;       (ok (= 1 (lem:line-number-at-point point))))
+;;     (check-corruption buffer)))
+
+
+;; (deftest add-history-test
+;;   (let ((history (make-history)))
+;;     (testing "basic add-history"
+;;              (add-history history "first")
+;;              (add-history history "second")
+;;              (ok (equal '("first" "second") (history-data-list history))))
+
+;;     (testing "without allow-duplicates"
+;;              (add-history history "third" :allow-duplicates nil)
+;;              (add-history history "second" :allow-duplicates nil)
+;;              (ok (equal '("first" "second" "third") (history-data-list history))))
+
+;;     (testing "with allow-duplicates"
+;;              (add-history history "second" :allow-duplicates t)
+;;              (ok (equal '("first" "second" "third" "second") (history-data-list history))))
+
+;;     (testing "with move-to-top"
+;;              (add-history history "first" :move-to-top t)
+;;              (ok (equal '("second" "third" "second" "first") (history-data-list history))))
+
+;;     (testing "limit functionality"
+;;              (let ((limited-history (make-history :limit 3)))
+;;                (add-history limited-history "one")
+;;                (add-history limited-history "two")
+;;                (add-history limited-history "three")
+;;                (add-history limited-history "four")
+;;                (ok (equal '("two" "three" "four") (history-data-list limited-history)))))))