Merge pull request #1555 from naryl/main

List listener history filtering by prefix
lem-project · Oct 2, 2024 · 334fd12 · 334fd12
2 parents 3f2f0ad + 789a55a
commit 334fd12
Showing 1 changed file with 43 additions and 0 deletions.
diff --git a/src/ext/listener-mode.lisp b/src/ext/listener-mode.lisp
@@ -21,6 +21,8 @@
    :listener-return
    :listener-previous-input
    :listener-next-input
+   :listener-previous-startswith-input
+   :listener-next-startswith-input
    :listener-previous-matching-input
    :listener-clear-buffer
    :listener-clear-input)
@@ -168,6 +170,47 @@
     (when win
       (replace-textarea buffer str))))
 
+(define-command listener-previous-startswith-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))))))))
+
+(define-command listener-next-startswith-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))))))))
+
 (define-command listener-previous-input () ()
   (backup-edit-string (current-buffer))
   (multiple-value-bind (str win)