external: tabbed sessioned CLI integration (claude/codex/gemini/opencode)
ober
d9182906dd8015957e215c4a6b3be164b5df1fdd
--- a/src/jcode/tool/external-llm.ss +++ b/src/jcode/tool/external-llm.ss @@ -14,7 +14,17 @@ ;;; Every other CLI's tokens, ~/.ssh, ~/.aws, etc. are denied. (export ask-external-llm - external-llm-providers) + ask-external-llm-session + make-ext-result + ext-result? + ext-result-text + ext-result-error? + ext-result-session-id + ext-result-tokens-in + ext-result-tokens-out + ext-result-cost-usd + external-llm-providers + make-external-session-id) (import :jerboa/core :jerboa/runtime @@ -23,6 +33,8 @@ :std/os/sandbox :std/misc/ports :std/misc/string + :std/misc/uuid + :std/text/json :jcode/core/log) (def logger (make-logger "tool.external-llm")) @@ -212,3 +224,266 @@ ((eqv? status 0) text) (else (format "ERROR: ~a exited with status ~a\n\n~a" label status text))))))) + +;; ============================================================ +;; Sessioned API — keeps a stable session id across CLI invocations +;; so the user can have a real multi-turn conversation in a tab. +;; +;; Two session-id models: +;; self-assigned (claude, gemini): caller passes a UUID we own; the +;; CLI persists state keyed by that UUID for the next turn. +;; cli-assigned (codex, opencode): first turn passes #f; we parse the +;; id the CLI returns in its JSON stream; subsequent turns pass it +;; back via the CLI's resume/--session flag. +;; ============================================================ + +(defstruct ext-result + (text ;; final assistant text (or error message) + error? ;; #t if the call failed + session-id ;; UUID — may differ from input (codex/opencode assign) + tokens-in + tokens-out + cost-usd) + transparent: #t) + +(def (make-external-session-id) (uuid-string)) + +(def (nonempty-string s) + (and (string? s) (not (string=? s "")) s)) + +;; (provider-spec-session name session-id prompt) +;; Returns (label argv auth-paths parse-fn) for a sessioned turn. +(def (provider-spec-session name session-id prompt) + (case name + ((claude) + (list "claude" + (list "claude" "-p" prompt + "--session-id" (or (nonempty-string session-id) + (make-external-session-id)) + "--output-format" "json" + "--dangerously-skip-permissions") + (list (path-join (home) ".claude") + (path-join (home) ".claude.json") + (path-join (home) "Library/Application Support/claude")) + parse-claude-json)) + ((gemini) + (list "gemini" + (list "gemini" "-p" prompt + "--session-id" (or (nonempty-string session-id) + (make-external-session-id)) + "-o" "json" + "--yolo" "--skip-trust") + (list (path-join (home) ".gemini") + (path-join (home) ".config/gemini")) + parse-gemini-json)) + ((codex) + (list "codex" + (if (nonempty-string session-id) + (list "codex" "exec" "resume" session-id + "--dangerously-bypass-approvals-and-sandbox" + "--skip-git-repo-check" "--json" prompt) + (list "codex" "exec" + "--dangerously-bypass-approvals-and-sandbox" + "--skip-git-repo-check" "--json" prompt)) + (list (path-join (home) ".codex") + (path-join (home) ".config/codex")) + parse-codex-jsonl)) + ((opencode) + (list "opencode" + (if (nonempty-string session-id) + (list "opencode" "run" "--session" session-id + "--dangerously-skip-permissions" "--format" "json" prompt) + (list "opencode" "run" + "--dangerously-skip-permissions" "--format" "json" prompt)) + (list (path-join (home) ".config/opencode") + (path-join (home) ".local/share/opencode") + (path-join (home) ".cache/opencode")) + parse-opencode-jsonl)) + (else #f))) + +(def (ask-external-llm-session provider prompt session-id) + "Sessioned variant: returns an ext-result. SESSION-ID is the UUID for + this conversation; pass #f on the very first turn for codex/opencode + (they assign one), then thread the returned id forward. Claude and + Gemini accept a UUID we generate, so callers should pre-generate one + with make-external-session-id." + (cond + ((not (string? prompt)) + (make-ext-result "ERROR: prompt must be a string" #t session-id 0 0 0.0)) + (else + (let ((spec (provider-spec-session provider session-id prompt))) + (cond + ((not spec) + (make-ext-result (format "ERROR: unknown provider ~a" provider) + #t session-id 0 0 0.0)) + (else + (run-session-spec spec provider session-id))))))) + +(def (run-session-spec spec provider session-id) + (let* ((label (car spec)) + (argv (cadr spec)) + (auth (caddr spec)) + (parse-fn (cadddr spec)) + (chosen (string->symbol label)) + (cwd (current-directory)) + (tmp-out (path-join "/tmp" (format "jcode-tab-~a.log" label))) + (cmd (build-cmdline argv tmp-out)) + (read-paths + (list "/usr" "/bin" "/sbin" "/etc" "/opt" "/Library" "/System" + "/private/etc" "/private/var/db" "/dev" + (path-join (home) ".gitconfig") + (path-join (home) ".config/git"))) + (write-paths + (cons cwd (cons "/tmp" (cons "/private/tmp" auth)))) + (exec-paths + (list "/usr/bin" "/bin" "/usr/local/bin" "/opt/homebrew/bin" + (path-join (home) ".local/bin")))) + (log-info logger "ask-external-llm-session" + `((provider . ,label) (session-in . ,(or session-id "<new>")))) + (let ((status + (try + (cond + ((platform-macos?) + (sandbox-run/profile (build-deny-profile chosen) + (lambda () (system cmd)))) + (else + (sandbox-run/command read-paths write-paths exec-paths cmd))) + (catch (e) -1)))) + (let ((text (read-text-or-empty tmp-out))) + (cond + ((eqv? status 0) + (parse-fn text session-id)) + (else + (make-ext-result + (format "ERROR: ~a exited with status ~a\n\n~a" label status text) + #t session-id 0 0 0.0))))))) + +;; ---------- per-provider parsers ---------- + +(def (safe-parse-json s) + (try (string->json-object s) (catch (e) #f))) + +(def (parse-claude-json text session-id-in) + ;; claude --output-format=json produces a single JSON object with + ;; "result", "session_id", "is_error", "total_cost_usd", and + ;; "usage":{input_tokens, output_tokens, ...}. + (let ((parsed (safe-parse-json text))) + (cond + ((not (hash-table? parsed)) + (make-ext-result text #f session-id-in 0 0 0.0)) + (else + (let* ((result-text (or (nonempty-string (hash-ref parsed "result" #f)) + text)) + (sid (or (nonempty-string (hash-ref parsed "session_id" #f)) + session-id-in)) + (cost (hash-ref parsed "total_cost_usd" 0.0)) + (usage (hash-ref parsed "usage" #f)) + (in-tok (if (hash-table? usage) + (hash-ref usage "input_tokens" 0) 0)) + (out-tok (if (hash-table? usage) + (hash-ref usage "output_tokens" 0) 0))) + (make-ext-result + result-text + (eq? (hash-ref parsed "is_error" #f) #t) + sid + (if (number? in-tok) in-tok 0) + (if (number? out-tok) out-tok 0) + (if (number? cost) cost 0.0))))))) + +(def (parse-gemini-json text session-id-in) + ;; Gemini -o json layout varies by version; probe common field names. + (let ((parsed (safe-parse-json text))) + (cond + ((not (hash-table? parsed)) + (make-ext-result text #f session-id-in 0 0 0.0)) + (else + (let* ((result-text (or (nonempty-string (hash-ref parsed "response" #f)) + (nonempty-string (hash-ref parsed "text" #f)) + (nonempty-string (hash-ref parsed "result" #f)) + text)) + (sid (or (nonempty-string (hash-ref parsed "session_id" #f)) + (nonempty-string (hash-ref parsed "sessionId" #f)) + session-id-in)) + (usage (hash-ref parsed "usage" #f)) + (in-tok (if (hash-table? usage) + (or (hash-ref usage "input_tokens" #f) + (hash-ref usage "promptTokens" 0)) 0)) + (out-tok (if (hash-table? usage) + (or (hash-ref usage "output_tokens" #f) + (hash-ref usage "completionTokens" 0)) 0))) + (make-ext-result + result-text #f sid + (if (number? in-tok) in-tok 0) + (if (number? out-tok) out-tok 0) + 0.0)))))) + +(def (jsonl-events text) + ;; Split TEXT on newlines, parse each non-blank line as JSON, drop + ;; non-hash results (e.g. log lines or unparsable noise). + (let* ((lines (string-split text #\newline)) + (non-empty (filter (lambda (l) (not (string=? (string-trim l) ""))) + lines)) + (parsed (map safe-parse-json non-empty))) + (filter hash-table? parsed))) + +(def (find-jsonl-string-field events keys) + ;; Walk events first to last; return first non-empty string value + ;; for any key in KEYS. + (let loop ((es events)) + (cond + ((null? es) #f) + (else + (let ((found (try-keys (car es) keys))) + (if found found (loop (cdr es)))))))) + +(def (try-keys ev keys) + (let loop ((ks keys)) + (cond + ((null? ks) #f) + (else + (let ((v (hash-ref ev (car ks) #f))) + (cond + ((nonempty-string v) v) + (else (loop (cdr ks))))))))) + +(def (find-last-message-text events) + ;; Walk events from the end; return the first event whose `type` looks + ;; like a final message and whose payload has non-empty text. + (let loop ((es (reverse events))) + (cond + ((null? es) #f) + (else + (let* ((ev (car es)) + (typ (or (hash-ref ev "type" #f) "")) + (msg (or (nonempty-string (hash-ref ev "message" #f)) + (nonempty-string (hash-ref ev "text" #f)) + (nonempty-string (hash-ref ev "content" #f)) + (nonempty-string (hash-ref ev "delta" #f))))) + (cond + ((and msg + (or (string-contains typ "message") + (string-contains typ "agent") + (string-contains typ "complete") + (string-contains typ "result") + (string-contains typ "final"))) + msg) + (else (loop (cdr es))))))))) + +(def (parse-codex-jsonl text session-id-in) + ;; codex --json emits NDJSON. Look for session id event + final + ;; assistant message. + (let* ((events (jsonl-events text)) + (sid (or (find-jsonl-string-field events + (list "session_id" "sessionId" "id" "session")) + session-id-in)) + (final (or (find-last-message-text events) text))) + (make-ext-result final #f sid 0 0 0.0))) + +(def (parse-opencode-jsonl text session-id-in) + ;; opencode --format=json emits JSONL/JSON events. + (let* ((events (jsonl-events text)) + (sid (or (find-jsonl-string-field events + (list "session_id" "sessionId" "sessionID" "id")) + session-id-in)) + (final (or (find-last-message-text events) text))) + (make-ext-result final #f sid 0 0 0.0))) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -134,7 +134,26 @@ dialog ;; #f or active dialog tool-counts ;; hash-table: name → count sysmon ;; system utilization sampler - memstats) ;; local-model RAM breakdown sampler + memstats ;; local-model RAM breakdown sampler + tabs ;; list of tab (snapshots; active tab's slot is stale) + active-tab) ;; integer: 0 = main jcode, 1..N = external CLI + transparent: #t) + +;; Per-tab snapshot. The ACTIVE tab's live state lives in app-state's +;; flat fields above; non-active tabs are snapshotted into the list at +;; app-state-tabs. provider=#f marks the main jcode tab (always index 0). +(defstruct tab + (provider ;; #f for main, symbol for external CLI tab + session-id ;; jcode session UUID (main) or CLI session UUID (external) + messages + input + busy? + scroll-offset + stream-buf + tokens-in tokens-out + cache-read cache-creation + cost + tool-counts) transparent: #t) (def (make-fresh-state w h) @@ -163,7 +182,9 @@ #f ;; dialog (make-hash-table) mon - mem))) + mem + '() ;; tabs (lazily seeded on first switch) + 0))) ;; active-tab (main jcode) ;; ---- Layout calculations ---- @@ -456,6 +477,12 @@ ((char=? (string-ref text 0) #\/) (tui-log "submit: slash-command ~s" text) (handle-slash-command! state text)) + ;; External-CLI tab → talk to that CLI's session + ((current-tab-external? state) + (tui-log "submit: external-turn ~s" (current-tab-provider state)) + (add-message! state (msg-block-user text)) + (app-state-scroll-offset-set! state 0) + (run-external-turn! state text)) ;; Normal message → agent (#t (tui-log "submit: sending to agent") @@ -505,6 +532,13 @@ " /ask-gemini Second opinion from gemini CLI (sandboxed)" " /ask-codex Second opinion from codex CLI (sandboxed)" " /ask-opencode Second opinion from opencode CLI (sandboxed)" + " /claude [prompt] Open/focus a Claude Code tab (sessioned)" + " /codex [prompt] Open/focus a Codex tab (sessioned)" + " /gemini [prompt] Open/focus a Gemini CLI tab (sessioned)" + " /opencode [prompt] Open/focus an opencode tab (sessioned)" + " /tabs List open tabs" + " /jcode Switch back to the main jcode tab" + " /close-tab Close the current external tab" " /expert <q> Force this prompt to the configured expert model" " /theme Cycle theme (Ctrl-T)" " /sidebar Toggle sidebar (Ctrl-B)" @@ -621,6 +655,29 @@ (if (null? builtins) "(none)" (string-join builtins "\n ")) "\n\nUser skills (~/.claude/skills, ~/.jcode/skills, .claude/skills, .jcode/skills):\n " (if (null? file-skills) "(none)" (string-join file-skills "\n "))))))) + ((equal? cmd "tabs") + (add-message! state (msg-block-system (list-tabs-summary state)))) + ((or (equal? cmd "close-tab") (equal? cmd "close")) + (close-current-tab! state)) + ((or (equal? cmd "jcode") (equal? cmd "main")) + (ensure-tabs-seeded! state) + (switch-tab! state 0)) + ((or (equal? cmd "claude") (string-prefix? "claude " cmd)) + (let ((rest (if (equal? cmd "claude") "" + (string-trim (substring cmd 7 (string-length cmd)))))) + (open-or-focus-external-tab! state 'claude rest))) + ((or (equal? cmd "codex") (string-prefix? "codex " cmd)) + (let ((rest (if (equal? cmd "codex") "" + (string-trim (substring cmd 6 (string-length cmd)))))) + (open-or-focus-external-tab! state 'codex rest))) + ((or (equal? cmd "gemini") (string-prefix? "gemini " cmd)) + (let ((rest (if (equal? cmd "gemini") "" + (string-trim (substring cmd 7 (string-length cmd)))))) + (open-or-focus-external-tab! state 'gemini rest))) + ((or (equal? cmd "opencode") (string-prefix? "opencode " cmd)) + (let ((rest (if (equal? cmd "opencode") "" + (string-trim (substring cmd 9 (string-length cmd)))))) + (open-or-focus-external-tab! state 'opencode rest))) (#t ;; Slash dispatch: /<name> [args] runs a skill. Builtins win over ;; file-based skills (so jcode's jerboa-mcp workflow is always @@ -912,6 +969,12 @@ (msg-block-error (format "Compaction failed: ~a" msg))) (app-state-agent-busy?-set! state #f) (app-state-dirty?-set! state #t)) + ((list 'ext-turn-result idx provider result) + (tui-log "apply-agent-event: ext-turn-result idx=~a provider=~a" idx provider) + (apply-ext-turn-result! state idx provider result)) + ((list 'ext-turn-error idx msg) + (tui-log "apply-agent-event: ext-turn-error idx=~a msg=~a" idx msg) + (apply-ext-turn-error! state idx msg)) (_ (tui-log "apply-agent-event: unknown event ~s" ev)))) ;; ---- Agent integration ---- @@ -1488,3 +1551,347 @@ (if idx (substring s (+ idx 1) (string-length s)) s))) ;; err->string is available from the prelude/runtime + +;; ============================================================ +;; Tab management +;; ============================================================ +;; +;; A tab is one isolated conversation. Tab 0 is the main jcode +;; (provider=#f); tabs 1..N are external CLI conversations +;; (claude/codex/gemini/opencode), each with its own session id and +;; transcript. The ACTIVE tab's live state lives in app-state's flat +;; fields; non-active tabs are snapshotted into app-state-tabs. Switch +;; semantics: capture-then-restore. + +(def *external-providers* '(claude codex gemini opencode)) + +(def (provider-needs-uuid? provider) + ;; Claude and Gemini accept a UUID we generate. Codex and Opencode + ;; assign their own session id; we learn it from the first turn's + ;; JSON output and pass it forward. + (memq provider '(claude gemini))) + +(def (current-tab-provider state) + ;; Returns provider symbol of the active tab, or #f for main. + (let ((tabs (app-state-tabs state)) + (idx (app-state-active-tab state))) + (and (> idx 0) + (< idx (length tabs)) + (let ((t (list-ref tabs idx))) + (and (tab? t) (tab-provider t)))))) + +(def (current-tab-external? state) + (and (current-tab-provider state) #t)) + +(def (snapshot-current-tab state) + ;; Capture app-state's flat fields into a tab record. + (let ((tabs (app-state-tabs state)) + (idx (app-state-active-tab state))) + (make-tab + (cond + ((and (> idx 0) (< idx (length tabs))) + (let ((t (list-ref tabs idx))) + (and (tab? t) (tab-provider t)))) + (else #f)) + (app-state-session-id state) + (app-state-messages state) + (app-state-input state) + (app-state-agent-busy? state) + (app-state-scroll-offset state) + (app-state-stream-buf state) + (app-state-tokens-in state) + (app-state-tokens-out state) + (app-state-cache-read state) + (app-state-cache-creation state) + (app-state-cost state) + (app-state-tool-counts state)))) + +(def (load-tab! state t) + ;; Restore a tab record into app-state's flat fields. + (app-state-session-id-set! state (tab-session-id t)) + (app-state-messages-set! state (tab-messages t)) + (app-state-input-set! state (tab-input t)) + (app-state-agent-busy?-set! state (tab-busy? t)) + (app-state-scroll-offset-set! state (tab-scroll-offset t)) + (app-state-stream-buf-set! state (tab-stream-buf t)) + (app-state-tokens-in-set! state (tab-tokens-in t)) + (app-state-tokens-out-set! state (tab-tokens-out t)) + (app-state-cache-read-set! state (tab-cache-read t)) + (app-state-cache-creation-set! state (tab-cache-creation t)) + (app-state-cost-set! state (tab-cost t)) + (app-state-tool-counts-set! state (tab-tool-counts t))) + +(def (list-replace lst idx new-elem) + (let loop ((lst lst) (i 0) (acc '())) + (cond + ((null? lst) (reverse acc)) + ((= i idx) (loop (cdr lst) (+ i 1) (cons new-elem acc))) + (else (loop (cdr lst) (+ i 1) (cons (car lst) acc)))))) + +(def (ensure-tabs-seeded! state) + ;; The tabs list is empty on first run; seed it with the current + ;; (main) state so index math works. + (when (null? (app-state-tabs state)) + (app-state-tabs-set! state (list (snapshot-current-tab state))))) + +(def (switch-tab! state new-idx) + (ensure-tabs-seeded! state) + (let* ((tabs (app-state-tabs state)) + (old-idx (app-state-active-tab state))) + (cond + ((or (< new-idx 0) (>= new-idx (length tabs))) + (tui-log "switch-tab: invalid index ~a (have ~a tabs)" + new-idx (length tabs)) + #f) + ((= new-idx old-idx) #f) + (else + (let* ((captured (snapshot-current-tab state)) + (with-old (list-replace tabs old-idx captured))) + (app-state-tabs-set! state with-old) + (load-tab! state (list-ref with-old new-idx)) + (app-state-active-tab-set! state new-idx) + (reflow-all! state) + (app-state-dirty?-set! state #t) + #t))))) + +(def (find-external-tab-idx state provider) + (let loop ((tabs (app-state-tabs state)) (i 0)) + (cond + ((null? tabs) #f) + (else + (let ((t (car tabs))) + (if (and (tab? t) (eq? (tab-provider t) provider)) + i + (loop (cdr tabs) (+ i 1)))))))) + +(def (open-or-focus-external-tab! state provider initial-prompt) + ;; Switch to PROVIDER's tab (create if missing). If INITIAL-PROMPT is + ;; a non-empty string, submit it as the first turn. + (ensure-tabs-seeded! state) + (let ((existing (find-external-tab-idx state provider))) + (cond + (existing + (switch-tab! state existing) + (when (and (string? initial-prompt) + (not (string=? (string-trim initial-prompt) ""))) + (add-message! state (msg-block-user initial-prompt)) + (app-state-scroll-offset-set! state 0) + (run-external-turn! state initial-prompt))) + (else + (let* ((new-tab (make-tab + provider + (if (provider-needs-uuid? provider) + (make-external-session-id) + #f) + '() ;; empty transcript + (make-fresh-input) + #f 0 "" 0 0 0 0 0.0 + (make-hash-table))) + (snap (snapshot-current-tab state)) + (cur-tabs (app-state-tabs state)) + (cur-idx (app-state-active-tab state)) + (with-cur (list-replace cur-tabs cur-idx snap)) + (new-tabs (append with-cur (list new-tab))) + (new-idx (- (length new-tabs) 1))) + (app-state-tabs-set! state new-tabs) + (load-tab! state new-tab) + (app-state-active-tab-set! state new-idx) + (add-message! state + (msg-block-system + (format "Opened ~a tab. Type to talk to ~a; /close-tab to return; /tabs to list." + provider provider))) + (when (and (string? initial-prompt) + (not (string=? (string-trim initial-prompt) ""))) + (add-message! state (msg-block-user initial-prompt)) + (run-external-turn! state initial-prompt)) + (app-state-scroll-offset-set! state 0) + (reflow-all! state) + (app-state-dirty?-set! state #t)))))) + +(def (close-current-tab! state) + (let* ((tabs (app-state-tabs state)) + (idx (app-state-active-tab state))) + (cond + ((= idx 0) + (add-message! state (msg-block-system "Cannot close the main tab."))) + ((or (null? tabs) (>= idx (length tabs))) + (tui-log "close-current-tab: invalid state idx=~a tabs=~a" idx (length tabs))) + (else + (let ((new-tabs + (let loop ((tabs tabs) (i 0) (acc '())) + (cond + ((null? tabs) (reverse acc)) + ((= i idx) (loop (cdr tabs) (+ i 1) acc)) + (else (loop (cdr tabs) (+ i 1) (cons (car tabs) acc))))))) + (app-state-tabs-set! state new-tabs) + (load-tab! state (car new-tabs)) ;; main is always index 0 + (app-state-active-tab-set! state 0) + (reflow-all! state) + (app-state-dirty?-set! state #t)))))) + +(def (list-tabs-summary state) + (let ((tabs (app-state-tabs state)) + (idx (app-state-active-tab state))) + (cond + ((null? tabs) "Tabs: (jcode only)") + (else + (string-append + "Tabs:\n" + (string-join + (let loop ((tabs tabs) (i 0) (lines '())) + (cond + ((null? tabs) (reverse lines)) + (else + (let* ((t (car tabs)) + (provider (or (and (tab? t) (tab-provider t)) #f)) + (label (if provider (symbol->string provider) "jcode")) + (marker (if (= i idx) "● " " ")) + (sid (or (and (tab? t) (tab-session-id t)) ""))) + (loop (cdr tabs) (+ i 1) + (cons (format "~a[~a] ~a~a" + marker i label + (if (string=? sid "") "" + (format " (session ~a)" sid))) + lines)))))) + "\n")))))) + +(def (run-external-turn! state prompt) + ;; Spawn a worker that runs a sessioned external-LLM turn for the + ;; current external tab. The result is delivered back to the main + ;; thread via the agent event mailbox, tagged with the tab index so + ;; we can patch the snapshot if the user has since switched away. + (let ((provider (current-tab-provider state))) + (cond + ((not provider) + (tui-log "run-external-turn: not in an external tab")) + ((app-state-agent-busy? state) + (add-message! state + (msg-block-system "Wait for the current turn to finish."))) + (else + (app-state-agent-busy?-set! state #t) + (app-state-stream-buf-set! state "") + (add-message! state (msg-block-assistant "")) + (bump-tui-run-gen!) + (app-state-dirty?-set! state #t) + (let ((gen (tui-run-gen)) + (err-port (current-error-port)) + (log-lvl (current-log-level)) + (sid (app-state-session-id state)) + (active-idx (app-state-active-tab state))) + (spawn + (lambda () + (parameterize ((current-error-port err-port) + (current-log-level log-lvl)) + (try + (let ((result (ask-external-llm-session provider prompt sid))) + (send-worker-event! gen + (list 'ext-turn-result active-idx provider result))) + (catch (e) + (send-worker-event! gen + (list 'ext-turn-error active-idx + (format "~a turn failed: ~a" provider + (err->string e)))))))))))))) + +(def (update-last-assistant-list! msgs new-content width) + ;; Mutate the trailing assistant block in MSGS by setting its content + ;; to NEW-CONTENT and reflowing for WIDTH. Returns the list (unchanged + ;; identity, mutated in place). If no assistant block found, appends + ;; a new one. + (let* ((rev (reverse msgs)) + (found? + (let loop ((rev rev)) + (cond + ((null? rev) #f) + ((eq? (msg-block-role (car rev)) 'assistant) + (let ((m (car rev))) + (msg-block-content-set! m new-content) + (reflow-message! m width) + #t)) + (else (loop (cdr rev))))))) + (cond + (found? msgs) + (else + (let ((m (msg-block-assistant new-content))) + (reflow-message! m width) + (append msgs (list m))))))) + +(def (apply-ext-turn-result! state idx provider result) + (let* ((cur-idx (app-state-active-tab state)) + (assistant-text (or (ext-result-text result) "")) + (new-sid (ext-result-session-id result)) + (tokens-in (or (ext-result-tokens-in result) 0)) + (tokens-out (or (ext-result-tokens-out result) 0)) + (cost (or (ext-result-cost-usd result) 0.0)) + (err? (ext-result-error? result))) + (cond + ((= idx cur-idx) + ;; Tab is active — update live fields. + (update-last-assistant! state assistant-text) + (when (and new-sid (string? new-sid) (not (string=? new-sid ""))) + (app-state-session-id-set! state new-sid)) + (app-state-tokens-in-set! state (+ (app-state-tokens-in state) tokens-in)) + (app-state-tokens-out-set! state (+ (app-state-tokens-out state) tokens-out)) + (app-state-cost-set! state (+ (app-state-cost state) cost)) + (when err? + (add-message! state + (msg-block-error (format "~a turn returned an error" provider)))) + (app-state-agent-busy?-set! state #f) + (app-state-stream-buf-set! state "") + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t)) + (else + ;; Tab was switched away — patch the snapshot. + (let* ((tabs (app-state-tabs state)) + (t (list-ref tabs idx)) + (w (msg-area-width state)) + (patched-msgs + (update-last-assistant-list! (tab-messages t) assistant-text w)) + (updated + (make-tab + (tab-provider t) + (or (and new-sid (string? new-sid) (not (string=? new-sid "")) new-sid) + (tab-session-id t)) + patched-msgs + (tab-input t) + #f ;; busy? + 0 ;; scroll + "" ;; stream-buf + (+ (tab-tokens-in t) tokens-in) + (+ (tab-tokens-out t) tokens-out) + (tab-cache-read t) + (tab-cache-creation t) + (+ (tab-cost t) cost) + (tab-tool-counts t)))) + (app-state-tabs-set! state (list-replace tabs idx updated)) + (app-state-dirty?-set! state #t)))))) + +(def (apply-ext-turn-error! state idx msg) + (let* ((cur-idx (app-state-active-tab state))) + (cond + ((= idx cur-idx) + (add-message! state (msg-block-error msg)) + (app-state-agent-busy?-set! state #f) + (app-state-dirty?-set! state #t)) + (else + (let* ((tabs (app-state-tabs state)) + (t (list-ref tabs idx)) + (w (msg-area-width state)) + (err-blk (msg-block-error msg))) + (reflow-message! err-blk w) + (let ((updated + (make-tab + (tab-provider t) + (tab-session-id t) + (append (tab-messages t) (list err-blk)) + (tab-input t) + #f + (tab-scroll-offset t) + (tab-stream-buf t) + (tab-tokens-in t) + (tab-tokens-out t) + (tab-cache-read t) + (tab-cache-creation t) + (tab-cost t) + (tab-tool-counts t)))) + (app-state-tabs-set! state (list-replace tabs idx updated)) + (app-state-dirty?-set! state #t)))))))