Add Docker-based make linux; TUI and provider improvements
ober
7eaeab03242b80f5985be7aab758c756e20581cf
new file mode 100644 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,43 @@ +# Dockerfile — Build jcode-musl using the jerboa21/jerboa base image +# +# Produces a fully static binary with zero runtime dependencies. +# No Chez Scheme or Jerboa installation needed on the target host. +# +# The base image (jerboa21/jerboa) provides stock Chez, musl Chez, +# jerboa libs, and all build dependencies pre-installed. +# +# Usage: +# docker build -t jcode-builder . +# docker run --rm jcode-builder > jcode-musl && chmod +x jcode-musl +# +# Or extract via docker cp: +# docker build -t jcode-builder . +# id=$(docker create jcode-builder) +# docker cp $id:/out/jcode-musl ./jcode-musl +# docker rm $id + +FROM jerboa21/jerboa AS builder + +ARG CACHE_BUST + +# ── Copy jcode source ──────────────────────────────────────────────────────── +COPY . /build/mine/jerboa-code + +# ── Build jcode-musl ───────────────────────────────────────────────────────── +WORKDIR /build/mine/jerboa-code +RUN JERBOA_HOME=/build/mine/jerboa make linux-local + +# ── Verify ─────────────────────────────────────────────────────────────────── +RUN echo "--- Binary info ---" && \ + ls -lh jcode-musl && \ + file jcode-musl && \ + echo "--- Hardening checks ---" && \ + { file jcode-musl | grep -qE 'stripped|no section header' && echo " PASS: stripped" || echo " WARN: not stripped"; } && \ + echo "--- Path leak check ---" && \ + count=$(strings jcode-musl | grep -c '/home/' || true) && \ + { [ "$count" -gt 0 ] && echo " WARNING: home paths found ($count)" || echo " PASS: no home path leaks"; } + +# ── Output ─────────────────────────────────────────────────────────────────── +FROM ubuntu:24.04 +COPY --from=builder /build/mine/jerboa-code/jcode-musl /out/jcode-musl +CMD ["cat", "/out/jcode-musl"] --- a/Makefile +++ b/Makefile @@ -10,7 +10,7 @@ TUI_SHIM_DIR := $(CURDIR)/vendor/termbox2 NATIVE_LIB_DIR := $(JERBOA_HOME)/lib LDPATH := $(SHIM_DIR):$(TUI_SHIM_DIR):$(SQLITE_LIB_DIR):$(NATIVE_LIB_DIR) -.PHONY: all build gen run test clean repl binary install tui-shim run-tui jcode-musl +.PHONY: all build gen run test clean repl binary install tui-shim run-tui jcode-musl linux linux-local docker all: build @@ -57,29 +57,39 @@ install: binary cp jcode $(HOME)/.local/bin/jcode @echo "Installed to ~/.local/bin/jcode" -# Cross-platform binary targets (require native host or Docker) -# Linux: build on Linux host with Chez installed -# FreeBSD: build on FreeBSD host with Chez installed -# Both use the same build-binary.ss which auto-detects the platform +linux: docker -linux: build - JERBOA_HOME=$(JERBOA_HOME) \ - $(SCHEME) -q --libdirs $(JERBOA_HOME)/lib:./lib:vendor/chez-sqlite/src \ - --script build-binary.ss +# ── Docker build (canonical static binary, zero runtime deps) ─────────────── +# Use `make linux` to build in Docker (canonical, reproducible). +# Use `make linux-local` to build directly on the host (requires +# musl-gcc and a musl-built Chez at ~/chez-musl or JERBOA_MUSL_CHEZ_PREFIX). -freebsd: build - JERBOA_HOME=$(JERBOA_HOME) \ - $(SCHEME) -q --libdirs $(JERBOA_HOME)/lib:./lib:vendor/chez-sqlite/src \ - --script build-binary.ss +docker: + @echo "=== Building jcode-musl in Docker ===" + docker build --platform linux/amd64 --build-arg CACHE_BUST=$$(date +%s) -t jcode-builder . + @id=$$(docker create --platform linux/amd64 jcode-builder) && \ + docker cp $$id:/out/jcode-musl ./jcode-musl && \ + docker rm $$id >/dev/null && \ + chmod +x jcode-musl + @echo "" + @ls -lh jcode-musl + @file jcode-musl # ─── musl Static Binary ────────────────────────────────────────────────────── # Build a fully static jcode binary using musl libc. # Requires: musl-gcc, Chez Scheme built with musl (~/chez-musl), # jerboa-native-rs built for x86_64-unknown-linux-musl. -jcode-musl: gen +linux-local: gen @echo "=== Building static jcode with musl ===" - ./build-jcode-musl.sh + JERBOA_HOME=$(JERBOA_HOME) ./build-jcode-musl.sh + +jcode-musl: linux-local + +freebsd: build + JERBOA_HOME=$(JERBOA_HOME) \ + $(SCHEME) -q --libdirs $(JERBOA_HOME)/lib:./lib:vendor/chez-sqlite/src \ + --script build-binary.ss clean: find lib/jcode -name "*.sls" -delete 2>/dev/null; true --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -9,9 +9,10 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std text json) (std net request) (std misc string) - (std misc retry) (jcode core log) (jcode core message) - (jerboa core) (jerboa runtime)) + (std text json) (std net request) (std net tls-rustls) + (std net tcp) (std misc string) (std misc retry) + (jcode core log) (jcode core message) (jerboa core) + (jerboa runtime)) (def logger (make-logger "provider")) (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) (def (retryable-error? e) @@ -79,12 +80,246 @@ (let ([response (provider-chat provider messages tools)]) (callback response) response)) + (def (parse-url-parts url) + (let ([parts (parse-url url)]) + (values + (url-parts-scheme parts) + (url-parts-host parts) + (url-parts-port parts) + (url-parts-path parts)))) + (def (build-http-request method path host headers body-str) + (let ([out (open-output-string)]) + (put-string + out + (string-append method " " path " HTTP/1.1\r\n")) + (put-string out (string-append "Host: " host "\r\n")) + (for-each + (lambda (h) + (put-string + out + (string-append (car h) ": " (cdr h) "\r\n"))) + headers) + (when body-str + (let ([bv (string->utf8 body-str)]) + (put-string + out + (string-append + "Content-Length: " + (number->string (bytevector-length bv)) + "\r\n")))) + (put-string out "\r\n") + (when body-str (put-string out body-str)) + (get-output-string out))) + (def (tls-write-string conn s) + (let ([bv (string->utf8 s)]) + (let loop ([offset 0]) + (when (< offset (bytevector-length bv)) + (let* ([remaining (- (bytevector-length bv) offset)] + [chunk (if (> remaining 4096) + (let ([c (make-bytevector 4096)]) + (bytevector-copy! bv offset c 0 4096) + c) + (let ([c (make-bytevector remaining)]) + (bytevector-copy! bv offset c 0 remaining) + c))] + [n (rustls-write + conn + chunk + (bytevector-length chunk))]) + (when (< n 0) (error 'tls-write-string "TLS write failed")) + (loop (+ offset n))))) + (rustls-flush conn))) + (def (tls-read-line conn) + (let ([out (open-output-string)] + [buf (make-bytevector 1)] + [got-any #f]) + (let loop () + (let ([n (rustls-read conn buf 1)]) + (cond + [(<= n 0) (if got-any (get-output-string out) #f)] + [else + (set! got-any #t) + (let ([ch (integer->char (bytevector-u8-ref buf 0))]) + (if (char=? ch #\newline) + (let ([s (get-output-string out)]) + (if (and (> (string-length s) 0) + (char=? + (string-ref s (- (string-length s) 1)) + #\return)) + (substring s 0 (- (string-length s) 1)) + s)) + (begin (write-char ch out) (loop))))]))))) + (def (tls-read-n conn n) + (let ([result (make-bytevector n)] + [buf (make-bytevector 4096)]) + (let loop ([offset 0]) + (if (>= offset n) + (utf8->string result) + (let* ([want (min 4096 (- n offset))] + [got (rustls-read conn buf want)]) + (cond + [(<= got 0) + (utf8->string + (let ([r (make-bytevector offset)]) + (bytevector-copy! result 0 r 0 offset) + r))] + [else + (bytevector-copy! buf 0 result offset got) + (loop (+ offset got))])))))) + (def (tls-read-all conn) + (let ([out (open-output-string)] + [buf (make-bytevector 4096)]) + (let loop () + (let ([n (rustls-read conn buf 4096)]) + (if (<= n 0) + (get-output-string out) + (begin + (put-string + out + (utf8->string + (let ([r (make-bytevector n)]) + (bytevector-copy! buf 0 r 0 n) + r))) + (loop))))))) + (def (parse-http-status line) + (if (and (string? line) (> (string-length line) 12)) + (or (string->number (substring line 9 12)) 0) + 0)) + (def (read-tls-headers conn) + (let loop ([headers '()]) + (let ([line (tls-read-line conn)]) + (if (or (not line) (string-empty? line)) + (reverse headers) + (let ([colon (string-contains line ":")]) + (if colon + (loop + (cons + (cons + (string-downcase (substring line 0 colon)) + (string-trim + (substring + line + (+ colon 1) + (string-length line)))) + headers)) + (loop headers))))))) + (def (port-write-string out s) + (put-string out s) + (flush-output-port out)) + (def (port-read-line in) + (let ([out (open-output-string)]) + (let loop () + (let ([c (read-char in)]) + (cond + [(eof-object? c) (get-output-string out)] + [(char=? c #\newline) + (let ([s (get-output-string out)]) + (if (and (> (string-length s) 0) + (char=? + (string-ref s (- (string-length s) 1)) + #\return)) + (substring s 0 (- (string-length s) 1)) + s))] + [else (write-char c out) (loop)]))))) + (def (port-read-headers in) + (let loop ([headers '()]) + (let ([line (port-read-line in)]) + (if (or (string-empty? line) (equal? line "")) + (reverse headers) + (let ([colon (string-contains line ":")]) + (if colon + (loop + (cons + (cons + (string-downcase (substring line 0 colon)) + (string-trim + (substring + line + (+ colon 1) + (string-length line)))) + headers)) + (loop headers))))))) + (def (port-read-all in) + (let ([out (open-output-string)]) + (let loop () + (let ([c (read-char in)]) + (if (eof-object? c) + (get-output-string out) + (begin (write-char c out) (loop))))))) (def (http-post-json url headers body-json) - (let* ([resp (http-post url headers body-json)] - [status (request-status resp)] - [body (request-text resp)]) - (request-close resp) - (values status body))) + (let-values ([(scheme host port path) + (parse-url-parts url)]) + (let ([req (build-http-request "POST" path host headers + body-json)]) + (if (equal? scheme "https") + (let ([conn (rustls-connect host port)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (tls-write-string conn req) + (let* ([status-line (tls-read-line conn)] + [status (parse-http-status status-line)] + [resp-headers (read-tls-headers conn)] + [cl (assoc "content-length" resp-headers)] + [body (if cl + (tls-read-n + conn + (string->number (cdr cl))) + (tls-read-all conn))]) + (values status body))) + (lambda () (rustls-close conn)))) + (let-values ([(in out) (tcp-connect host port)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (port-write-string out req) + (let* ([status-line (port-read-line in)] + [status (parse-http-status status-line)] + [resp-headers (port-read-headers in)] + [body (port-read-all in)]) + (values status body))) + (lambda () (close-port in) (close-port out)))))))) + (def (http-post-stream url headers body-json line-cb) + (let-values ([(scheme host port path) + (parse-url-parts url)]) + (let ([req (build-http-request "POST" path host headers + body-json)]) + (if (equal? scheme "https") + (let ([conn (rustls-connect host port)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (tls-write-string conn req) + (let* ([status-line (tls-read-line conn)] + [status (parse-http-status status-line)] + [_headers (read-tls-headers conn)]) + (unless (= status 200) + (let ([body (tls-read-all conn)]) + (error 'http-post-stream + (format "API error ~a: ~a" status body)))) + (let loop () + (let ([line (tls-read-line conn)]) + (when line (line-cb line) (loop)))))) + (lambda () (rustls-close conn)))) + (let-values ([(in out) (tcp-connect host port)]) + (dynamic-wind + (lambda () (void)) + (lambda () + (port-write-string out req) + (let* ([status-line (port-read-line in)] + [status (parse-http-status status-line)] + [_headers (port-read-headers in)]) + (unless (= status 200) + (let ([body (port-read-all in)]) + (error 'http-post-stream + (format "API error ~a: ~a" status body)))) + (let loop () + (let ([c (peek-char in)]) + (unless (eof-object? c) + (let ([line (port-read-line in)]) + (line-cb line) + (loop))))))) + (lambda () (close-port in) (close-port out)))))))) (def (openai-chat provider messages tools) (let* ([url (string-append (provider-base-url provider) --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -65,6 +65,8 @@ (loop (cdr args) (cons '(\x2D;-tui . #t) opts))] [(equal? (car args) "--no-tui") (loop (cdr args) (cons '(\x2D;-no-tui . #t) opts))] + [(equal? (car args) "--verbose") + (loop (cdr args) (cons '(\x2D;-verbose . #t) opts))] [(and (equal? (car args) "--model") (pair? (cdr args))) (loop (cddr args) @@ -87,7 +89,7 @@ (init-mcp-tools) (init-lsp-tools) (init-plugins)) (def (display-help) (display - "jcode - Portable AI coding agent\n\nUSAGE:\n jcode [OPTIONS] [PROMPT]\n jcode [COMMAND]\n\nOPTIONS:\n -h, --help Show this help message\n -v, --version Show version\n -d, --debug Enable debug logging\n -m, --model Model to use (default: claude-sonnet-4-20250514)\n -p, --provider Provider to use (default: anthropic)\n --tui Launch terminal UI mode\n --no-tui Force line-mode REPL (default)\n\nCOMMANDS:\n session list List all sessions\n session resume Resume a previous session\n config Show or edit configuration\n\nEXAMPLES:\n jcode Start interactive session\n jcode \"Read main.ss\" One-shot query\n jcode session list List sessions\n")) + "jcode - Portable AI coding agent\n\nUSAGE:\n jcode [OPTIONS] [PROMPT]\n jcode [COMMAND]\n\nOPTIONS:\n -h, --help Show this help message\n -v, --version Show version\n -d, --debug Enable debug logging\n -m, --model Model to use (default: claude-sonnet-4-20250514)\n -p, --provider Provider to use (default: anthropic)\n --tui Launch terminal UI mode\n --no-tui Force line-mode REPL (default)\n --verbose Log TUI events to ~/jcode.log\n\nCOMMANDS:\n session list List all sessions\n session resume Resume a previous session\n config Show or edit configuration\n\nEXAMPLES:\n jcode Start interactive session\n jcode \"Read main.ss\" One-shot query\n jcode session list List sessions\n")) (def (interactive-mode opts) (printf "jcode ~a~n" *version*) (printf --- a/lib/jcode/ui/tui-ffi.sls +++ b/lib/jcode/ui/tui-ffi.sls @@ -182,10 +182,10 @@ (def (tb-set-input-mode! mode) (c-tb-set-input mode)) (def (tb-set-output-mode! mode) (c-tb-set-output mode)) (def (tb-poll-event) - (let ([rc (c-tb-poll)]) (if (> rc 0) (read-event!) #f))) + (let ([rc (c-tb-poll)]) (if (= rc 0) (read-event!) #f))) (def (tb-peek-event timeout-ms) (let ([rc (c-tb-peek timeout-ms)]) - (if (> rc 0) (read-event!) #f))) + (if (= rc 0) (read-event!) #f))) (def (tui-event-key? ev) (= (tui-event-type ev) TB_EVENT_KEY)) (def (tui-event-resize? ev) --- a/lib/jcode/ui/tui.sls +++ b/lib/jcode/ui/tui.sls @@ -21,6 +21,47 @@ (jerboa runtime)) (def logger (make-logger "tui")) (def *version* "0.1.0") + (def *tui-log-port* (make-parameter #f)) + (def (tui-log fmt . args) + (let ([p (*tui-log-port*)]) + (when p + (let ([msg (apply format fmt args)]) + (display msg p) + (newline p) + (flush-output-port p))))) + (def (open-tui-log!) + (let ([p (open-file-output-port + (string-append (getenv "HOME") "/jcode.log") + (file-options no-fail) + (buffer-mode line) + (make-transcoder (utf-8-codec)))]) + (*tui-log-port* p) + (tui-log "---- jcode TUI log started ----"))) + (def (close-tui-log!) + (let ([p (*tui-log-port*)]) + (when p + (tui-log "---- jcode TUI log ended ----") + (close-port p) + (*tui-log-port* #f)))) + (def *saved-stderr* (make-parameter #f)) + (def (redirect-stderr-for-tui! verbose?) + "Redirect stderr away from terminal. If verbose, send to ~/jcode.log; else /dev/null." + (*saved-stderr* (current-error-port)) + (current-error-port + (if (and verbose? (*tui-log-port*)) + (*tui-log-port*) + (open-file-output-port + "/dev/null" + (file-options no-fail) + (buffer-mode none) + (make-transcoder (utf-8-codec)))))) + (def (restore-stderr!) + (when (*saved-stderr*) + (let ([devnull (current-error-port)]) + (current-error-port (*saved-stderr*)) + (*saved-stderr* #f) + (unless (eq? devnull (*tui-log-port*)) + (close-port devnull))))) (def *spinner-frames* '#("⠋" "⠙" "⠹" "⠸" "⠼" "⠴" "⠦" "⠧" "⠇" "⠏")) (defstruct @@ -52,15 +93,29 @@ (- (app-state-width state) (app-state-sidebar-width state))) (def (tui-main args) (load-config) (session-init-db) (init-tools-for-tui) (apply-tui-overrides! args) + (let ([verbose? (and (member "--verbose" args) #t)]) + (when verbose? (open-tui-log!)) + (tui-log "tui-main: starting, args=~a" args) + (redirect-stderr-for-tui! verbose?)) (with-tui - (tb-set-input-mode! - (bitwise-ior TB_INPUT_ALT TB_INPUT_MOUSE)) - (tb-set-output-mode! TB_OUTPUT_TRUECOLOR) + (tui-log "tui-main: tb-init done") + (let ([in-mode (bitwise-ior TB_INPUT_ALT TB_INPUT_MOUSE)]) + (tui-log + "tui-main: setting input-mode=~a output-mode=~a" + in-mode + TB_OUTPUT_TRUECOLOR) + (tb-set-input-mode! in-mode) + (tb-set-output-mode! TB_OUTPUT_TRUECOLOR)) (set-theme! theme-dark) (let* ([w (tb-width)] [h (tb-height)] [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)) (app-state-session-id-set! state (session-id session)) (app-state-messages-set! state @@ -72,7 +127,10 @@ (reflow-all! state) (draw-all! state) (tb-present!) - (event-loop state)))) + (tui-log "tui-main: entering event loop") + (event-loop state) + (restore-stderr!) + (close-tui-log!)))) (def (init-tools-for-tui) (init-file-tools) (init-bash-tool) (init-web-tools) (init-batch-tool) (init-git-tools) (init-mcp-tools) (init-lsp-tools) (init-plugins)) @@ -95,6 +153,7 @@ [(or (equal? (car args) "--debug") (equal? (car args) "-d")) (current-log-level 'debug) (loop (cdr args))] + [(equal? (car args) "--verbose") (loop (cdr args))] [#t (loop (cdr args))]))) (def (event-loop state) (let loop () @@ -103,10 +162,27 @@ (app-state-dirty?-set! state #t)) (let ([ev (tb-peek-event 50)]) (when ev + (tui-log "event: type=~a key=~a ch=~a(~a) mod=~a w=~a h=~a" + (tui-event-type ev) (tui-event-key ev) (tui-event-ch ev) + (if (> (tui-event-ch ev) 31) + (string (integer->char (tui-event-ch ev))) + "") + (tui-event-mod ev) (tui-event-w ev) (tui-event-h ev)) (cond - [(tui-event-resize? ev) (handle-resize! state ev)] + [(tui-event-resize? ev) + (tui-log + " -> resize ~ax~a" + (tui-event-w ev) + (tui-event-h ev)) + (handle-resize! state ev)] [(tui-event-key? ev) (handle-key! state ev)] - [(tui-event-mouse? ev) (handle-mouse! state ev)]))) + [(tui-event-mouse? ev) + (tui-log + " -> mouse key=~a x=~a y=~a" + (tui-event-key ev) + (tui-event-x ev) + (tui-event-y ev)) + (handle-mouse! state ev)]))) (when (app-state-dirty? state) (draw-all! state) (tb-present!) @@ -120,27 +196,37 @@ (reflow-all! state) (app-state-dirty?-set! state #t))) (def (handle-key! state ev) - (let ([key (tui-event-key ev)] [mod (tui-event-mod ev)]) + (let ([key (tui-event-key ev)] + [ch (tui-event-ch ev)] + [mod (tui-event-mod ev)]) + (tui-log " handle-key: key=~a ch=~a(~a) mod=~a busy?=~a" key ch + (if (> ch 31) (string (integer->char ch)) "") mod + (app-state-agent-busy? state)) (cond [(= key TB_KEY_CTRL_B) + (tui-log " -> toggle-sidebar") (app-state-sidebar-visible?-set! state (not (app-state-sidebar-visible? state))) (reflow-all! state) (app-state-dirty?-set! state #t)] [(= key TB_KEY_CTRL_L) + (tui-log " -> redraw") (tb-clear!) (app-state-dirty?-set! state #t)] [(= key TB_KEY_CTRL_T) + (tui-log " -> cycle-theme") (cycle-theme!) (app-state-dirty?-set! state #t)] [(= key TB_KEY_PGUP) + (tui-log " -> page-up") (app-state-scroll-offset-set! state (+ (app-state-scroll-offset state) (quotient (msg-area-height state) 2))) (app-state-dirty?-set! state #t)] [(= key TB_KEY_PGDN) + (tui-log " -> page-down") (app-state-scroll-offset-set! state (max 0 @@ -148,25 +234,32 @@ (quotient (msg-area-height state) 2)))) (app-state-dirty?-set! state #t)] [(and (= key TB_KEY_CTRL_C) (app-state-agent-busy? state)) + (tui-log " -> cancel-agent") (app-state-agent-busy?-set! state #f) (app-state-dirty?-set! state #t)] [#t - (unless (app-state-agent-busy? state) - (let ([action (input-handle-key! - (app-state-input state) - ev)]) - (case action - [(submit) (handle-submit! state)] - [(quit) (app-state-quit?-set! state #t)] - [(cancel) (input-clear! (app-state-input state))] - [(continue) (void)]) - (app-state-input-height-set! - state - (max 1 - (min 8 - (length - (input-lines (app-state-input state)))))) - (app-state-dirty?-set! state #t)))]))) + (if (app-state-agent-busy? state) + (tui-log " -> ignored (agent busy)") + (let ([action (input-handle-key! + (app-state-input state) + ev)]) + (tui-log + " -> input action=~a text=~s cursor=~a" + action + (input-state-text (app-state-input state)) + (input-state-cursor-pos (app-state-input state))) + (case action + [(submit) (handle-submit! state)] + [(quit) (app-state-quit?-set! state #t)] + [(cancel) (input-clear! (app-state-input state))] + [(continue) (void)]) + (app-state-input-height-set! + state + (max 1 + (min 8 + (length + (input-lines (app-state-input state)))))) + (app-state-dirty?-set! state #t)))]))) (def (handle-mouse! state ev) (let ([key (tui-event-key ev)]) (cond @@ -183,11 +276,14 @@ (def (handle-submit! state) (let* ([inp (app-state-input state)] [text (input-submit! inp)]) + (tui-log "submit: text=~s" text) (unless (string-empty? text) (cond [(char=? (string-ref text 0) #\/) + (tui-log "submit: slash-command ~s" text) (handle-slash-command! state text)] [#t + (tui-log "submit: sending to agent") (add-message! state (msg-block-user text)) (app-state-scroll-offset-set! state 0) (run-agent! state text)])))) @@ -254,6 +350,34 @@ "Provider: ~a (model: ~a)" p (current-model-override)))))] + [(equal? cmd "provider") + (let* ([cur-p (or (current-provider-override) + (config-provider))] + [cur-m (or (current-model-override) (config-model))] + [all '(("anthropic" . "claude-sonnet-4-20250514") ("openrouter" . "anthropic/claude-sonnet-4") + ("openai" . "gpt-4o") + ("deepseek" . "deepseek-chat") + ("google" . "gemini-2.0-flash") + ("ollama" . "llama3.2"))] + [lines (map (lambda (p) + (let ([name (car p)] [model (cdr p)]) + (format " ~a ~a ~a [~a]" + (if (equal? name cur-p) "●" " ") name + model + (if (config-get-provider-key name) + "key" + "no key")))) + all)]) + (add-message! + state + (msg-block-system + (string-append + (format + "Current: ~a / ~a\n\nAvailable providers:\n" + cur-p + cur-m) + (string-join lines "\n") + "\n\nUse: /provider <name>"))))] [(equal? cmd "theme") (cycle-theme!) (add-message! state (msg-block-system "Theme cycled."))] @@ -286,18 +410,25 @@ (app-state-stream-buf-set! state "") (add-message! state (msg-block-assistant "")) (app-state-dirty?-set! state #t) + (tui-log + "run-agent: starting, session=~a" + (app-state-session-id state)) (try (parameterize ([current-stream-cb (lambda (token) (tui-stream-token! state token))] [current-tool-cb (lambda (event name args) (tui-tool-event! state event name args))]) - (agent-run (app-state-session-id state) text)) - (let ([buf (app-state-stream-buf state)]) - (unless (string-empty? buf) - (update-last-assistant! state buf))) + (agent-run (app-state-session-id state) text) + (tui-log + "run-agent: agent-run returned, buf=~s" + (app-state-stream-buf state)) + (let ([buf (app-state-stream-buf state)]) + (unless (string-empty? buf) + (update-last-assistant! state buf)))) (catch (e) + (tui-log "run-agent: ERROR ~a" (err->string e)) (add-message! state (msg-block-error (err->string e))))) (app-state-agent-busy?-set! state #f) (app-state-scroll-offset-set! state 0) --- a/vendor/chez-sqlite +++ b/vendor/chez-sqlite @@ -1 +1 @@ -Subproject commit 11c1031e66ebe961799d8f0862ee8398eae5bd26 +Subproject commit 2f5942985ab0b1783b802a4216ec846b8e7afe1f