amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v0.15.1: EOF/Escape fixes, box title rendering, full feature verification

Browse Source 
Bug fixes:
  - read-raw-byte now returns (values nil :eof) on stdin EOF
    instead of just nil, so callers can distinguish EOF from
    timeout.  Previously, non-TTY stdin (pipes, /dev/null)
    caused a busy-spin: sb-posix:read returned 0 immediately,
    read-raw-byte returned nil, the demo loop treated nil as
    'no event yet' and spun at 100% CPU producing 86MB of
    repeated rendering frames.

  - %read-escape-sequence now uses a 50ms timeout on the first
    follow-up byte to resolve the classic Escape-key ambiguity:
    a lone Escape press returned an :escape key-event instead of
    blocking indefinitely on VMIN=1 VTIME=0.  All callers
    (SS3, CSI, Alt+char) propagate :eof instead of faking
    :escape events when EOF occurs mid-sequence.

  - parse-csi-params now uses multiple-value-bind on read-raw-byte
    to preserve the :eof signal through CSI parsing.

  - simple-backend draw-border now renders :title on the top
    edge instead of declaring it (ignore).  The title was
    silently swallowed — the box rendered with the right border
    frame but the title text was never written.

  - demo.lisp: removed 'q' as quit key (conflicted with text
    input).  Only Esc and Ctrl+C quit.  Widget event forwarding
    scoped to tab 1 (Widgets tab).  EOF handling in main loop.
  - Stale help text (still said 'q/esc: quit') updated.

Verification infrastructure:
  - PTY-based demo test (17 checks) spawns the demo in a real
    pseudo-terminal, sends actual keystrokes, reads terminal
    output back.  Verifies: startup rendering, tab switching,
    key dispatch, 'q' doesn't quit, Escape quits via timeout,
    Ctrl+C quits, EOF clean exit, no busy-spin.

  - API feature verification (29 checks) exercises every major
    component through the actual exported API: Simple backend,
    Box with title, Text attributes, draw-rect, TextInput
    (insert/backspace/cursor/Ctrl-A/E), TextArea, key/mouse
    events, Layout flex, Markdown, Theme presets (dark/light/
    nord), Select filtering, Dialog stack, Mouse hit-test,
    Framebuffer, Dirty tracking, Modern backend, draw-ellipsis/
    draw-link, Render dispatch, Detection, Capabilities.

  - Testing pattern saved as skill (tui-pty-testing) for reuse.

Unit tests: 392/392 passing.  All 12 test suites green.
This commit is contained in:
Hermes Agent
2026-05-12 10:58:27 +00:00
parent eede03ee3f
commit 7f4f712399
5 changed files with 117 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
src/components/input.lisp
View File

@@ -82,27 +82,33 @@
;;; Low-level byte reading
;;; ---------------------------------------------------------------------------
(defun read-raw-byte (&key timeout)
"Read one raw byte from stdin.
Returns:
(values byte nil) on success (byte is 0-255)
(values nil :timeout) on timeout
(values nil :eof) on EOF (stdin closed or /dev/null)"
(flet ((read-one ()
(let ((buf (make-array 1 :element-type '(unsigned-byte 8))))
;; Use sb-sys:with-pinned-objects so sb-posix:read can access the buffer
(sb-sys:with-pinned-objects (buf)
(let ((n (sb-posix:read 0 (sb-sys:vector-sap buf) 1)))
(when (plusp n)
(return-from read-raw-byte (aref buf 0))))))))
(cond
((plusp n) (return-from read-raw-byte (aref buf 0)))
((zerop n) (return-from read-raw-byte (values nil :eof)))))))))
(if timeout
(let ((deadline (+ (get-universal-time) timeout)))
(loop while (< (get-universal-time) deadline)
do (handler-case
(read-one)
(sb-posix:syscall-error ()
(return-from read-raw-byte nil)))
(return-from read-raw-byte (values nil :timeout))))
(sleep 0.01))
nil)
(values nil :timeout))
(handler-case
(read-one)
(sb-posix:syscall-error (e)
(format *error-output* "read error: ~A~%" e)
nil)))))
(values nil :eof))))))
;;; ---------------------------------------------------------------------------
;;; CSI parameter parser
@@ -113,8 +119,12 @@
:fill-pointer 0 :adjustable t))
(current 0))
(loop
(let ((b (read-raw-byte)))
(unless b (return (values nil nil nil)))
(multiple-value-bind (b reason) (read-raw-byte)
(unless b
(return-from parse-csi-params
(if (eq reason :eof)
(values nil nil :eof)
(values nil nil nil))))
(vector-push-extend b raw)
(cond
((and (>= b #x30) (<= b #x3f))
@@ -186,10 +196,15 @@
;;; Escape sequence reader
;;; ---------------------------------------------------------------------------
(defun %read-escape-sequence ()
(let ((b (read-raw-byte)))
"Read the remainder of an escape sequence after the initial ESC (0x1b).
Uses a 50ms timeout on the first follow-up byte to resolve the classic
Escape ambiguity: a lone Escape press returns immediately as an :escape
key event rather than blocking indefinitely."
(multiple-value-bind (b reason) (read-raw-byte :timeout 0.05)
(unless b
(return-from %read-escape-sequence
(make-key-event :key :escape :raw (string #\Esc))))
(if (eq reason :eof) :eof
(make-key-event :key :escape :raw (string #\Esc)))))
(case b
;; SS3: ESC O X
(#x4f
@@ -200,59 +215,64 @@
(#\R . :f3) (#\S . :f4))))))
(make-key-event :key (or key :unknown)
:raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
(make-key-event :key :escape :raw (string #\Esc)))))
:eof)))
;; CSI: ESC [ ...
(#x5b
(multiple-value-bind (params final-byte raw) (parse-csi-params)
(if (null final-byte)
(make-key-event :key :escape :raw (string #\Esc))
;; SGR mouse: ESC [ < ... m/M
(if (and raw (plusp (length raw)) (char= (char raw 0) #\<))
(or (parse-sgr-mouse raw)
(make-key-event :key :unknown :raw raw))
(if (and (char= (code-char final-byte) #\M)
(>= (length params) 3))
(let* ((p0 (first params)))
(if (zerop (logand p0 #x40))
(let* ((x (second params))
(y (third params))
(button (logand p0 #x03))
(motion (logand p0 #x20))
(release (= button 3)))
(make-mouse-event
:type (cond (release :release)
(motion :drag)
(t :press))
:button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
(let* ((tilde-p (char= (code-char final-byte) #\~))
(param (or p0 0))
(key (if tilde-p
(cdr (assoc param *csi-tilde-table*))
(cdr (assoc (code-char final-byte) *csi-key-table*))))
(modifier (when (> (length params) 1) (second params))))
(let ((ctrl nil) (alt nil) (shift nil))
(when modifier
(setf shift (logtest modifier 1)
alt (logtest modifier 2)
ctrl (logtest modifier 4)))
(make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))
(let* ((tilde-p (char= (code-char final-byte) #\~))
(param (or (first params) 0))
(key (if tilde-p
(cdr (assoc param *csi-tilde-table*))
(cdr (assoc (code-char final-byte) *csi-key-table*))))
(modifier (when (> (length params) 1) (second params))))
(let ((ctrl nil) (alt nil) (shift nil))
(when modifier
(setf shift (logtest modifier 1)
alt (logtest modifier 2)
ctrl (logtest modifier 4)))
(make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))))
(cond
((null final-byte)
;; EOF during CSI parsing — propagate it
(if (eq raw :eof)
:eof
(make-key-event :key :escape :raw (string #\Esc))))
;; SGR mouse: ESC [ < ... m/M
((and raw (plusp (length raw)) (char= (char raw 0) #\<))
(or (parse-sgr-mouse raw)
(make-key-event :key :unknown :raw raw)))
((and (char= (code-char final-byte) #\M)
(>= (length params) 3))
(let* ((p0 (first params)))
(if (zerop (logand p0 #x40))
(let* ((x (second params))
(y (third params))
(button (logand p0 #x03))
(motion (logand p0 #x20))
(release (= button 3)))
(make-mouse-event
:type (cond (release :release)
(motion :drag)
(t :press))
:button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
(let* ((tilde-p (char= (code-char final-byte) #\~))
(param (or p0 0))
(key (if tilde-p
(cdr (assoc param *csi-tilde-table*))
(cdr (assoc (code-char final-byte) *csi-key-table*))))
(modifier (when (> (length params) 1) (second params))))
(let ((ctrl nil) (alt nil) (shift nil))
(when modifier
(setf shift (logtest modifier 1)
alt (logtest modifier 2)
ctrl (logtest modifier 4)))
(make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))
(t
(let* ((tilde-p (char= (code-char final-byte) #\~))
(param (or (first params) 0))
(key (if tilde-p
(cdr (assoc param *csi-tilde-table*))
(cdr (assoc (code-char final-byte) *csi-key-table*))))
(modifier (when (> (length params) 1) (second params))))
(let ((ctrl nil) (alt nil) (shift nil))
(when modifier
(setf shift (logtest modifier 1)
alt (logtest modifier 2)
ctrl (logtest modifier 4)))
(make-key-event :key (or key :unknown)
:ctrl ctrl :alt alt :shift shift
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))))))
;; ESC ESC
(#x1b
(make-key-event :key :escape :alt t :raw "\\e\\e"))
@@ -270,9 +290,9 @@
;;; Top-level event reader
;;; ---------------------------------------------------------------------------
(defun %read-event (&key timeout)
(let ((b (read-raw-byte :timeout timeout)))
(multiple-value-bind (b reason) (read-raw-byte :timeout timeout)
(unless b
(return-from %read-event nil))
(return-from %read-event (if (eq reason :eof) :eof nil)))
(cond
((= b #x1b)
(%read-escape-sequence))