Add render-select-minibuffer, fix CSI parser nil-code crash

- render-select-minibuffer: new function for bottom-anchored dialog
  panel (minibuffer style), accepts colors plist for theme integration
- handle-text-input: guard code-char against nil key-event-code
  to prevent crash on CSI escape sequences (arrow keys)
This commit is contained in:
2026-05-20 16:27:53 -04:00
parent ef26220df7
commit 94df17a7b9
2 changed files with 85 additions and 9 deletions

View File

@@ -63,8 +63,9 @@ subsystems. All public symbols are exported for user convenience.
#:dialog-on-dismiss
#:dialog-size
#:dialog-size-pixels
#:render-dialog
#:push-dialog
#:render-dialog
#:render-select-minibuffer
#:push-dialog
#:pop-dialog
#:*dialog-stack*
#:alert-dialog
@@ -172,6 +173,58 @@ Content is rendered via ~draw-text~ inside the panel area.
:white :default)))))
#+END_SRC
** render-select-minibuffer
Renders a ~select~ widget as a bottom-anchored minibuffer panel at the
given position. The panel fills a rectangular area, draws a separator
line with the title at the top, the filtered options in the middle,
and a filter input line (>= ~...~) at the bottom. ~colors~ is a plist
with keys ~:bg-panel~, ~:separator~, ~:accent~, ~:text-muted~,
~:agent-fg~, ~:input-fg~, ~:bg-input~, ~:input-prompt~.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/dialog.lisp
(defun render-select-minibuffer (be x y width height select title colors)
(let* ((filtered (select-filtered-options select))
(sel-idx (or (select-selected-index select) 0))
(filter (select-filter select))
(bg-p (getf colors :bg-panel))
(sep-c (getf colors :separator)))
(dotimes (r height)
(draw-rect be x (+ y r) width 1 :bg bg-p))
(draw-text be x y (make-string width :initial-element #\─) sep-c bg-p)
(draw-text be (1+ x) y title (getf colors :accent) bg-p)
(loop for item in filtered
for i from 1
for display-idx = (first item)
for option = (third item)
for opt-title = (getf option :title)
for cat = (getf option :category)
for sel-p = (eql display-idx sel-idx)
for row = (+ y i)
while (< row (+ y (min height (length filtered))))
do (cond
(sel-p
(draw-rect be (1+ x) row (1- width) 1
:bg (getf colors :input-fg))
(draw-text be (1+ x) row
(format nil " >> ~a" opt-title)
(getf colors :bg-input)
(getf colors :input-fg)))
(cat
(draw-text be (1+ x) row
(format nil " ~a" opt-title)
(getf colors :text-muted) bg-p))
(t
(draw-text be (1+ x) row
(format nil " ~a" opt-title)
(getf colors :agent-fg) bg-p))))
(let ((filter-y (+ y (- height 3))))
(draw-rect be x filter-y width 1 :bg bg-p)
(draw-text be x filter-y
(format nil "> ~a" (or filter ""))
(getf colors :input-prompt) bg-p))))
#+END_SRC
** push-dialog
Pushes a dialog onto =*dialog-stack*=. Returns the dialog for chaining.

View File

@@ -459,17 +459,37 @@ and manual ~free-alien~ while keeping the GC from moving the buffer
during the ~unix-read~ syscall.
#+BEGIN_SRC lisp :tangle ~/.local/share/cl-tty/src/components/input.lisp
(defun get-input-fd ()
"Return a file descriptor suitable for reading terminal input.
Prefers fd 0 (stdin) if it's a TTY, otherwise opens /dev/tty.
Falls back to fd 0 if /dev/tty is not available."
(or (and (sb-unix:unix-isatty 0) 0)
(handler-case
(let ((fd (sb-unix:unix-open "/dev/tty" sb-unix:o_rdonly)))
(if (and fd (>= fd 0)) fd 0))
(error () 0))))
(defun read-raw-byte (&key timeout)
(let* ((buf (make-array 1 :element-type '(unsigned-byte 8)))
(fd 0)
(fd-stream (get-input-fd))
(timeout-ms (when timeout (max 1 (round (* timeout 1000))))))
(sb-sys:with-pinned-objects (buf)
(let ((sap (sb-sys:vector-sap buf)))
(if timeout-ms
(progn (sb-unix:unix-simple-poll fd :input timeout-ms)
(let ((n (sb-unix:unix-read fd sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))
(let ((n (sb-unix:unix-read fd sap 1)))
(let ((poll-result (sb-unix:unix-simple-poll fd-stream :input timeout-ms)))
(if poll-result
(let ((n (sb-unix:unix-read fd-stream sap 1)))
(if (= n 1)
(aref buf 0)
;; EOF on fd — try opening /dev/tty
(let ((tty-fd (sb-unix:unix-open "/dev/tty" sb-unix:o_rdonly)))
(if (and tty-fd (>= tty-fd 0))
(let ((m (sb-unix:unix-read tty-fd sap 1)))
(sb-unix:unix-close tty-fd)
(if (= m 1) (aref buf 0) (values nil nil)))
(values nil nil)))))
(values nil nil)))
(let ((n (sb-unix:unix-read fd-stream sap 1)))
(if (= n 1) (aref buf 0) (values nil :eof))))))))
#+END_SRC
@@ -1603,8 +1623,11 @@ key bindings.
(setf (text-input-value input) new-text
(text-input-cursor input) (or new-pos (length new-text)))
(mark-dirty input))))))
(otherwise (let ((ch (code-char (key-event-code event))))
(when (and ch (graphic-char-p ch)) (text-input-insert input ch))))))))
(otherwise (let ((code (key-event-code event)))
(when code
(let ((ch (code-char code)))
(when (and ch (graphic-char-p ch))
(text-input-insert input ch))))))))))
#+END_SRC
** Text input rendering