v0.3.3: left/right cursor movement in input
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s

Adds :cursor-pos to TUI state. New functions:
- input-insert-char(ch): insert at cursor position, advance cursor
- input-delete-char(): delete char before cursor (standard backspace)

on-key handlers:
- Left arrow: decrement cursor-pos (clamped >= 0)
- Right arrow: increment cursor-pos (clamped <= buffer-len)
- Character input: input-insert-char at cursor position
- Backspace: input-delete-char at cursor position
- Enter: reset cursor-pos to 0

view-input: cursor at visual position matching cursor-pos

Test: (init-state) → (input-insert-char #\h) → (input-insert-char #\i)
→ (setf cursor-pos 1) → (input-insert-char #\X) → 'hXi' at pos 2
This commit is contained in:
2026-05-06 17:46:49 -04:00
parent 0861ac26f1
commit 9350cb855e
6 changed files with 104 additions and 40 deletions

View File

@@ -94,8 +94,9 @@
(setf (st :busy) t)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil)
(setf (st :dirty) (list t t t))))))
(setf (st :input-buffer) nil)
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list t t t))))))
;; Tab — command completion
((or (eql ch 9) (eq ch :tab))
(let ((text (input-string)))
@@ -110,11 +111,21 @@
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
(push #\Space (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))))))
;; Backspace
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
(eql ch #\Backspace))
(when (st :input-buffer) (pop (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))
;; Backspace
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
(eql ch #\Backspace))
(input-delete-char)
(setf (st :dirty) (list nil nil t)))
;; Left arrow
((or (eq ch :left) (eql ch 260))
(when (> (or (st :cursor-pos) 0) 0)
(decf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Right arrow
((or (eq ch :right) (eql ch 261))
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
(incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Up arrow
((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos)))
@@ -141,15 +152,15 @@
((or (eq ch :npage) (eql ch 338))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(push chr (st :input-buffer))
(setf (st :dirty) (list nil nil t))))))))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))))
(defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload))

View File

@@ -28,7 +28,7 @@
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :busy nil
:messages nil :scroll-offset 0 :busy nil :cursor-pos 0
:dirty (list nil nil nil))))
(defun now ()
@@ -39,6 +39,25 @@
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun input-insert-char (ch)
"Insert character at cursor position into the input buffer."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0))
(s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1+ pos))))
(defun input-delete-char ()
"Delete character before cursor position (standard backspace)."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0)))
(when (and buf (> pos 0))
(let* ((s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1- pos))))))
(defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil)))

View File

@@ -87,10 +87,12 @@ Returns list of trimmed strings. Single words wider than width are split."
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 clip)))
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
(defun redraw (sw cw ch iw)

View File

@@ -122,8 +122,9 @@ Event handlers + daemon I/O + main loop.
(setf (st :busy) t)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil)
(setf (st :dirty) (list t t t))))))
(setf (st :input-buffer) nil)
(setf (st :cursor-pos) 0)
(setf (st :dirty) (list t t t))))))
;; Tab — command completion
((or (eql ch 9) (eq ch :tab))
(let ((text (input-string)))
@@ -138,11 +139,21 @@ Event handlers + daemon I/O + main loop.
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
(push #\Space (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))))))
;; Backspace
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
(eql ch #\Backspace))
(when (st :input-buffer) (pop (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))
;; Backspace
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
(eql ch #\Backspace))
(input-delete-char)
(setf (st :dirty) (list nil nil t)))
;; Left arrow
((or (eq ch :left) (eql ch 260))
(when (> (or (st :cursor-pos) 0) 0)
(decf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Right arrow
((or (eq ch :right) (eql ch 261))
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
(incf (st :cursor-pos))
(setf (st :dirty) (list nil nil t))))
;; Up arrow
((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos)))
@@ -169,15 +180,15 @@ Event handlers + daemon I/O + main loop.
((or (eq ch :npage) (eql ch 338))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(push chr (st :input-buffer))
(setf (st :dirty) (list nil nil t))))))))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(input-insert-char chr)
(setf (st :dirty) (list nil nil t))))))))
(defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload))

View File

@@ -48,7 +48,7 @@ All state mutation flows through event handlers in the controller.
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :busy nil
:messages nil :scroll-offset 0 :busy nil :cursor-pos 0
:dirty (list nil nil nil))))
#+end_src
@@ -62,6 +62,25 @@ All state mutation flows through event handlers in the controller.
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun input-insert-char (ch)
"Insert character at cursor position into the input buffer."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0))
(s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1+ pos))))
(defun input-delete-char ()
"Delete character before cursor position (standard backspace)."
(let* ((buf (st :input-buffer))
(pos (or (st :cursor-pos) 0)))
(when (and buf (> pos 0))
(let* ((s (coerce (reverse buf) 'string))
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
(setf (st :input-buffer) (reverse (coerce new 'list)))
(setf (st :cursor-pos) (1- pos))))))
(defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil)))

View File

@@ -115,10 +115,12 @@ Returns list of trimmed strings. Single words wider than width are split."
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(pos (or (st :cursor-pos) 0))
(display-start (max 0 (- pos (1- w))))
(visible (subseq text display-start (min (length text) (+ display-start w)))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 clip)))
(add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
(refresh win))
#+end_src