v0.3.3: left/right cursor movement in input
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
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:
@@ -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))
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user