Save cursor state when changing history in repl (#2218)

* Move cursor to a safe spot before replacing the buffer underneath

* Extract internal helper for next and previous history

* Keep the correct offset when moving through history

* Don't lose track of history

When you tried to move past the end of the history list we lost track of
where we were and lost the current edited line.

* Clean up function

* Add tests for listener next/previous history search

Ran format on whole, some parts seems to have a different formatting.

* Change name of internal function to match name of commands

* Refactor to use cond instead

Author: JesperAxelsson

src/ext/listener-mode.lisp

@@ -116,7 +116,7 @@
     (when (input-start-point buffer)
       (delete-point (input-start-point buffer)))
     (set-input-start-point buffer
-                          (copy-point point :right-inserting))))
+                           (copy-point point :right-inserting))))
 
 (defun write-prompt (point)
   (let ((buffer (point-buffer point)))
@@ -183,52 +183,48 @@
     (when win
       (replace-textarea buffer str))))
 
+(defun %search-history-startswith-input (direction)
+  "Internal helper for history next and previous history navigation."
+  (let* ((buffer (current-buffer))
+         (point (buffer-point buffer))
+         (start (input-start-point buffer))
+         (prefix (points-to-string (input-start-point buffer) point))
+         (prefix-len (length prefix))
+         (step-fn (case direction 
+                    (:previous #'lem/common/history:previous-history)
+                    (:next #'lem/common/history:next-history))))
+    (backup-edit-string (current-buffer))
+    (loop :for steps :from 0
+          :do (multiple-value-bind (str found)
+                  (funcall step-fn (current-listener-history))
+                (cond
+                  ((and found (eql 0 (search prefix str :test #'string=)))
+                   (replace-textarea buffer str)
+                   (move-point point start)
+                   (character-offset point prefix-len)
+                   (return))
+                  ((not found)
+                   (ecase direction
+                     (:previous 
+                      (dotimes (i steps)
+                        (lem/common/history:next-history (current-listener-history))))
+                     (:next 
+                      (restore-edit-string buffer)
+                      (move-point point start)
+                      (character-offset point prefix-len)))
+                   (return)))))))
+
 (define-command listener-previous-startswith-input () ()
   "Find the previous prompt starting with the current input.
 
   See also `listener-previous-input`."
-  (block nil
-    (let* ((buffer (current-buffer))
-           (point (buffer-point buffer))
-           (charpos (point-charpos point))
-           (prefix (points-to-string (input-start-point buffer) point)))
-      (backup-edit-string (current-buffer))
-      (flet ((commit (str)
-               (replace-textarea buffer str)
-               (setf (point-charpos point) charpos)
-               (return)))
-        (loop
-          (multiple-value-bind (str win)
-              (lem/common/history:previous-history (current-listener-history))
-            (if win
-                (when (eql 0 (search prefix str :test #'string=))
-                  (commit str))
-                (return))))))))
+  (%search-history-startswith-input :previous))
 
 (define-command listener-next-startswith-input () ()
   "Find the next prompt starting with the current input.
 
   See also `listener-next-input`."
-  (block nil
-    (let* ((buffer (current-buffer))
-           (point (buffer-point buffer))
-           (charpos (point-charpos point))
-           (prefix (points-to-string (input-start-point buffer) point)))
-      (backup-edit-string (current-buffer))
-      (flet ((commit (str)
-               (replace-textarea buffer str)
-               (setf (point-charpos point) charpos)
-               (return))
-             (rollback ()
-               (restore-edit-string buffer)
-               (return)))
-        (loop
-          (multiple-value-bind (str win)
-              (lem/common/history:next-history (current-listener-history))
-            (if win
-                (when (eql 0 (search prefix str :test #'string=))
-                  (commit str))
-                (rollback))))))))
+  (%search-history-startswith-input :next))
 
 (define-command listener-previous-input () ()
   "Get and insert the previous REPL input."

tests/listener-mode.lisp

@@ -12,7 +12,9 @@
                 :listener-execute-function
                 :start-listener-mode
                 :refresh-prompt
-                :clamp-cursor-to-input-area))
+                :clamp-cursor-to-input-area
+                :listener-previous-startswith-input
+                :listener-next-startswith-input))
 (in-package :lem-tests/listener-mode)
 
 (defun setup-listener-buffer ()
@@ -35,28 +37,93 @@
     (with-current-buffers ()
       (let ((buffer (setup-listener-buffer)))
         (testing "cursor at input-start-point is not moved"
-          (move-point (current-point) (input-start-point buffer))
-          (lem/listener-mode:clamp-cursor-to-input-area)
-          (ok (point= (current-point) (input-start-point buffer))))
+                 (move-point (current-point) (input-start-point buffer))
+                 (lem/listener-mode:clamp-cursor-to-input-area)
+                 (ok (point= (current-point) (input-start-point buffer))))
 
         (testing "cursor before input-start-point on same line is clamped"
-          (line-start (current-point))
-          (ok (point< (current-point) (input-start-point buffer)))
-          (lem/listener-mode:clamp-cursor-to-input-area)
-          (ok (point= (current-point) (input-start-point buffer))))
+                 (line-start (current-point))
+                 (ok (point< (current-point) (input-start-point buffer)))
+                 (lem/listener-mode:clamp-cursor-to-input-area)
+                 (ok (point= (current-point) (input-start-point buffer))))
 
         (testing "cursor after input-start-point is not moved"
-          (buffer-end (current-point))
-          (insert-string (current-point) "hello")
-          (let ((pos (copy-point (current-point) :temporary)))
-            (lem/listener-mode:clamp-cursor-to-input-area)
-            (ok (point= (current-point) pos))))
+                 (buffer-end (current-point))
+                 (insert-string (current-point) "hello")
+                 (let ((pos (copy-point (current-point) :temporary)))
+                   (lem/listener-mode:clamp-cursor-to-input-area)
+                   (ok (point= (current-point) pos))))
 
         (testing "cursor on previous line is not clamped"
-          ;; Add a newline in the input area so cursor can go to a previous line
-          (move-point (current-point) (input-start-point buffer))
-          (character-offset (current-point) -1)
-          ;; cursor is now on a line before input-start-point's line
-          (unless (same-line-p (current-point) (input-start-point buffer))
-            (lem/listener-mode:clamp-cursor-to-input-area)
-            (ok (not (point= (current-point) (input-start-point buffer))))))))))
+                 ;; Add a newline in the input area so cursor can go to a previous line
+                 (move-point (current-point) (input-start-point buffer))
+                 (character-offset (current-point) -1)
+                 ;; cursor is now on a line before input-start-point's line
+                 (unless (same-line-p (current-point) (input-start-point buffer))
+                   (lem/listener-mode:clamp-cursor-to-input-area)
+                   (ok (not (point= (current-point) (input-start-point buffer))))))))))
+
+;; make-history does not need pathname?
+
+(deftest listener-history-search-state-and-geometry
+  (with-fake-interface ()
+    (with-current-buffers ()
+      (let* ((buffer (setup-listener-buffer))
+             (test-history (lem/common/history:make-history)))
+        
+        (setf (buffer-value buffer 'lem/listener-mode::%listener-history)
+              test-history)
+               
+        (lem/common/history:add-history test-history "hello")
+        (lem/common/history:add-history test-history "world")
+        (lem/common/history:add-history test-history "hector")
+
+        (testing "Successful previous match perfectly preserves prefix cursor offset"
+                 ;; Type our unsubmitted prefix "'he"
+                 (move-point (current-point) (input-start-point buffer))
+                 (insert-string (current-point) "he")
+          
+                 ;; Trigger the search
+                 (listener-previous-startswith-input)
+          
+                 ;; Assert 1: The buffer text was completely replaced with the newest match
+                 (let ((full-input (points-to-string (input-start-point buffer) 
+                                                     (buffer-end-point buffer))))
+                   (ok (string= "hector" full-input)))
+          
+                 ;; Assert 2: The cursor is resting exactly at the end of the "he" prefix.
+                 ;; This proves our linear offset math is working and preventing the timer crash!
+                 (let ((cursor-prefix (points-to-string (input-start-point buffer) 
+                                                        (current-point))))
+                   (ok (string= "he" cursor-prefix))))
+
+        (testing "State drift is prevented on failed searches and rollback succeeds"
+                 ;; We are currently viewing "hector". 
+                 ;; Search previous again to hit the oldest match ("hello").
+                 (listener-previous-startswith-input)
+                 (ok (string= "hello" (points-to-string (input-start-point buffer) 
+                                                        (buffer-end-point buffer))))
+
+                 ;; Now we force the failure state. Searching previous again will find nothing.
+                 ;; Because of our fix, the internal loop should rewind its phantom steps.
+                 (listener-previous-startswith-input)
+                 (ok (string= "hello" (points-to-string (input-start-point buffer) 
+                                                        (buffer-end-point buffer))))
+
+                 ;; If the rewind worked, stepping 'Next' exactly twice should traverse 
+                 ;; perfectly back through "hector" and hit the Rollback state.
+                 (listener-next-startswith-input)
+                 (ok (string= "hector" (points-to-string (input-start-point buffer) 
+                                                         (buffer-end-point buffer))))
+          
+                 ;; The final step Next: Rollback triggers!
+                 (listener-next-startswith-input)
+          
+                 ;; Assert 3: The unsubmitted text was flawlessly restored
+                 (ok (string= "he" (points-to-string (input-start-point buffer) 
+                                                     (buffer-end-point buffer))))
+          
+                 ;; Assert 4: The rollback explicitly clamped the cursor safely
+                 (let ((cursor-prefix (points-to-string (input-start-point buffer) 
+                                                        (current-point))))
+                   (ok (string= "he" cursor-prefix))))))))