TUI: fix stuck "thinking" spinner + reply truncation; add live-debug hooks
ober
462fe434574a05cce34da2ff560200c6fdd22e92
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -573,6 +573,19 @@ Be concise. Prefer edit over write for modifying existing files. ;; boundaries are buffered until we can disambiguate. The full token text ;; is still accumulated by the provider into the response content, so the ;; agent can post-process for tool calls; only the *display* is filtered. +(def (suffix-prefix-len s marker) + ;; Longest K such that the last K chars of S equal the first K chars of + ;; MARKER. Lets the stream filter hold back ONLY a genuine partial marker + ;; split across token boundaries, never arbitrary trailing text. + (let* ((slen (string-length s)) + (mlen (string-length marker)) + (maxk (min slen mlen))) + (let loop ((k maxk)) + (cond + ((= k 0) 0) + ((string=? (substring s (- slen k) slen) (substring marker 0 k)) k) + (else (loop (- k 1))))))) + (def (make-tool-call-stream-filter inner-cb) (let ((in-block? #f) (pending "")) @@ -590,9 +603,12 @@ Be concise. Prefer edit over write for modifying existing files. (set! in-block? #f) (process)) (else - ;; Keep last close-len-1 chars (might be a partial close). + ;; Inside a suppressed tool block: discard all but a trailing + ;; partial close marker so a close split across tokens is still + ;; detected. (Content here is suppressed, so this only affects + ;; close detection, not the displayed reply.) (let* ((slen (string-length pending)) - (keep (min (- (string-length *hermes-close*) 1) slen))) + (keep (suffix-prefix-len pending *hermes-close*))) (set! pending (substring pending (- slen keep) slen))))))) (else (let ((idx (string-contains pending *hermes-open*))) @@ -607,9 +623,16 @@ Be concise. Prefer edit over write for modifying existing files. (set! in-block? #t) (process)) (else - ;; Forward all but the last open-len-1 chars (partial open?). + ;; Forward everything EXCEPT a trailing PARTIAL open marker + ;; (a suffix of PENDING that is a prefix of "<tool_call>"). + ;; The old code held a FIXED 10 chars unconditionally; since + ;; this filter is recreated per round and never flushes at + ;; end-of-stream, that dropped the last ~10 chars of EVERY + ;; reply from the display ("...review for bugs." showed as + ;; "...review fo"). Ordinary text never ends in a "<tool_call>" + ;; prefix, so it is now forwarded in full. (let* ((slen (string-length pending)) - (keep (min (- (string-length *hermes-open*) 1) slen)) + (keep (suffix-prefix-len pending *hermes-open*)) (fwd (- slen keep))) (when (> fwd 0) (inner-cb (substring pending 0 fwd)) --- a/src/jcode/ui/tui-message.ss +++ b/src/jcode/ui/tui-message.ss @@ -19,6 +19,7 @@ :jcode/ui/tui-ffi :jcode/ui/tui-theme :jcode/ui/tui-markdown + :jcode/core/log :jerboa/core :jerboa/runtime :jcode/ui/tui-diff) @@ -307,9 +308,14 @@ (fg (face-fg-attr fname)) (bg (face-bg-attr fname)) (avail (- (+ x width) col)) - (disp (if (> (string-length text) avail) - (substring text 0 avail) - text))) + (clip? (> (string-length text) avail)) + (disp (if clip? (substring text 0 avail) text))) + (when clip? + (log-debug "tui" + (format "TRUNC role=~a x=~a width=~a col=~a avail=~a tlen=~a txt=~s" + (msg-block-role msg) x width col avail + (string-length text) + (substring text 0 (min 50 (string-length text)))))) (tb-print! col row fg bg disp) (seg-loop (cdr segs) (+ col (string-length disp))))))) (loop (cdr lines) (+ row 1) (+ count 1)))))) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -1,7 +1,7 @@ ;;; jcode TUI — main entry point and event loop ;;; Replaces the line-mode REPL with a panel-based terminal interface. -(export tui-main) +(export tui-main dbg-snapshot *dbg-state*) (import :std/misc/string :std/misc/thread @@ -60,6 +60,7 @@ ;; preemptive pthreads, so all state mutation must happen on the main thread. (def *main-thread* (make-parameter #f)) (def *mcp-disabled* #f) +(def *dbg-state* #f) ;; live app-state handle for REPL inspection (def (tui-log fmt . args) (let ((p (*tui-log-port*))) @@ -236,6 +237,7 @@ (state (make-fresh-state w h)) (session (session-create "New session"))) (tui-log "tui-main: terminal ~ax~a, session=~a" w h (session-id session)) + (set! *dbg-state* state) (app-state-session-id-set! state (session-id session)) ;; Populate MCP status on sidebar (best-effort, time-limited) (tui-log "tui-main: refresh-mcp-sidebar! (begin)") @@ -932,7 +934,14 @@ (tui-stream-token! state (apply string-append (reverse toks))) (loop evs))))) (else - (apply-agent-event! state (car evs)) + ;; Guard each handler: a throw in one event (e.g. finalize-last-assistant! + ;; on a malformed reply during 'usage-update) must NOT abort the drain + ;; before 'agent-done clears agent-busy? — that wedges the spinner forever + ;; with no error shown. Log and continue instead. + (guard (e (#t (log-debug "tui" + (format "apply-agent-event ERROR: ~a" + (with-output-to-string (lambda () (display-condition e))))))) + (apply-agent-event! state (car evs))) (loop (cdr evs))))))) (def (apply-agent-event! state ev) @@ -961,8 +970,12 @@ (app-state-dirty?-set! state #t)) ((list 'agent-done) (tui-log "apply-agent-event: agent-done") - (finalize-last-assistant! state) + ;; Clear busy FIRST: a finalize error must never leave the spinner stuck. (app-state-agent-busy?-set! state #f) + (guard (e (#t (log-debug "tui" + (format "agent-done finalize ERROR: ~a" + (with-output-to-string (lambda () (display-condition e))))))) + (finalize-last-assistant! state)) (app-state-scroll-offset-set! state 0) (app-state-dirty?-set! state #t)) ((list 'agent-cancelled) @@ -1482,6 +1495,16 @@ (def (tui-usage-update! state usage) "Accumulate token/cost usage from a streaming response." + ;; A usage report marks the end of ONE streamed completion (one agent + ;; round). Finalize that block and clear the stream buffer so the next + ;; round's first token opens a FRESH assistant block. Without this, a round + ;; that ends WITHOUT an executed tool call — e.g. the guardrails "retry" + ;; path after an unknown-tool call — never hits the tool-'start reset, so + ;; the next round's text appends to this block, producing run-on + ;; "...in this repoLet me use the correct tool" concatenation (which then + ;; word-wraps inside the merged "repoLet" token and reads as truncation). + (finalize-last-assistant! state) + (app-state-stream-buf-set! state "") (for-each (lambda (pair) (case (car pair) @@ -1640,6 +1663,40 @@ (when (pair? *active-toasts*) (toast-render! (app-state-width state) (app-state-height state))))) +(def (dbg-line-cols ln) + (apply + (map (lambda (sg) (string-length (car sg))) ln))) + +(def (dbg-block-info m) + (let* ((lines (msg-block-lines m)) + (lens (map dbg-line-cols lines)) + (ml (apply max 0 lens)) + (longest + (let loop ((ls lines) (best "")) + (cond ((null? ls) best) + ((>= (dbg-line-cols (car ls)) ml) + (apply string-append (map car (car ls)))) + (else (loop (cdr ls) best)))))) + (list (msg-block-role m) + 'ww (msg-block-wrap-width m) + 'h (msg-block-height m) + 'maxlen ml + 'nlines (length lines) + 'longest (substring longest 0 (min 140 (string-length longest)))))) + +(def (dbg-snapshot) + (let ((s *dbg-state*)) + (if (not s) 'no-dbg-state + (list 'tbw (tb-width) 'tbh (tb-height) + 'aw (app-state-width s) 'ah (app-state-height s) + 'sb? (app-state-sidebar-visible? s) + 'sbw (app-state-sidebar-width s) + 'sbx (sidebar-x s) + 'maw (msg-area-width s) + 'mx (msg-area-x s) + 'scroll (app-state-scroll-offset s) + 'nblocks (length (app-state-messages s)) + 'blocks (map dbg-block-info (app-state-messages s)))))) + (def (draw-messages! state) (ensure-reflow-width! state) (let* ((x (msg-area-x state)) @@ -1661,6 +1718,22 @@ ;; later changed; this per-block check closes that gap. (_ (unless (eqv? (msg-block-wrap-width msg) w) (reflow-message! msg w))) + (_dbg (let ((ml (apply max 0 + (map (lambda (ln) + (apply + (map (lambda (s) (string-length (car s))) ln))) + (msg-block-lines msg)))) + (tbw (tb-width)) + (aw (app-state-width state))) + (when (or (>= ml (- w 30)) + (not (eqv? (msg-block-wrap-width msg) w)) + (not (eqv? tbw aw))) + (log-debug "tui" + (format "DRAW role=~a tbw=~a aw=~a w=~a maw=~a sbw=~a sbx=~a sb?=~a ww=~a ml=~a h=~a" + (msg-block-role msg) tbw aw w (msg-area-width state) + (app-state-sidebar-width state) (sidebar-x state) + (app-state-sidebar-visible? state) + (msg-block-wrap-width msg) ml + (msg-block-height msg)))))) (mh (msg-block-height msg))) (if (> skip 0) (if (>= skip mh)