Add model registry, popup selection dialogs, and MCP status integration
ober
e2e63571dc5095cfcc6c488afc79b6b8d2ee5678
--- a/build-binary.ss +++ b/build-binary.ss @@ -101,7 +101,8 @@ (library-directories))) (define jcode-modules - '("lib/jcode/core/config" + '("lib/jcode/core/models" + "lib/jcode/core/config" "lib/jcode/core/log" "lib/jcode/core/session" "lib/jcode/core/message" --- a/lib/jcode/core/config.sls +++ b/lib/jcode/core/config.sls @@ -10,8 +10,8 @@ (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 os path) (jerboa core) - (jerboa runtime)) + (std text json) (std os path) (jcode core models) + (jerboa core) (jerboa runtime)) (define *config*--cell (vector (make-parameter #f))) (def (jcode-home) "Return ~/.jcode, creating it if needed." @@ -92,14 +92,7 @@ (or (config-ref "model") (config-default-model (config-provider)))) (def (config-default-model provider) - (case (string->symbol provider) - [(anthropic) "claude-sonnet-4-20250514"] - [(openai) "gpt-4o"] - [(openrouter) "anthropic/claude-sonnet-4"] - [(deepseek) "deepseek-chat"] - [(google) "gemini-2.0-flash"] - [(ollama) "llama3.2"] - [else "gpt-4o"])) + (provider-default-model provider)) (def (config-provider) (or (config-ref "provider") (config-detect-provider) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/models.sls @@ -0,0 +1,76 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/models.ss + +(library (jcode core models) + (export + provider-models + all-providers + provider-display-name + provider-default-model) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (jerboa core) + (jerboa runtime)) + (def (all-providers) + '("anthropic" "openai" "openrouter" "deepseek" "google" + "ollama")) + (def (provider-display-name p) + (case (string->symbol p) + [(anthropic) "Anthropic"] + [(openai) "OpenAI"] + [(openrouter) "OpenRouter"] + [(deepseek) "DeepSeek"] + [(google) "Google"] + [(ollama) "Ollama (local)"] + [else p])) + (def (provider-default-model provider) + (case (string->symbol provider) + [(anthropic) "claude-sonnet-4-20250514"] + [(openai) "gpt-4o"] + [(openrouter) "anthropic/claude-sonnet-4"] + [(deepseek) "deepseek-chat"] + [(google) "gemini-2.5-flash"] + [(ollama) "llama3.2"] + [else "gpt-4o"])) + (def (provider-models provider) + (case (string->symbol provider) + [(anthropic) anthropic-models] + [(openai) openai-models] + [(deepseek) deepseek-models] + [(google) google-models] + [(openrouter) openrouter-models] + [(ollama) ollama-models] + [else '()])) + (def anthropic-models + '(("claude-sonnet-4-20250514" . "Claude Sonnet 4") + ("claude-opus-4-20250514" . "Claude Opus 4") + ("claude-haiku-35-20241022" . "Claude 3.5 Haiku"))) + (def openai-models + '(("gpt-4o" . "GPT-4o") ("gpt-4o-mini" . "GPT-4o Mini") + ("gpt-4-turbo" . "GPT-4 Turbo") ("o3" . "o3") + ("o3-mini" . "o3 Mini") ("o4-mini" . "o4 Mini"))) + (def deepseek-models + '(("deepseek-chat" . "DeepSeek V3") + ("deepseek-reasoner" . "DeepSeek R1"))) + (def google-models + '(("gemini-2.5-pro" . "Gemini 2.5 Pro") + ("gemini-2.5-flash" . "Gemini 2.5 Flash") + ("gemini-2.0-flash" . "Gemini 2.0 Flash"))) + (def openrouter-models + '(("anthropic/claude-sonnet-4" . "Claude Sonnet 4") ("anthropic/claude-opus-4" . "Claude Opus 4") + ("openai/gpt-4o" . "GPT-4o") + ("google/gemini-2.5-pro" . "Gemini 2.5 Pro") + ("google/gemini-2.5-flash" . "Gemini 2.5 Flash") + ("deepseek/deepseek-chat" . "DeepSeek V3") + ("deepseek/deepseek-r1" . "DeepSeek R1") + ("meta-llama/llama-4-maverick" . "Llama 4 Maverick") + ("meta-llama/llama-4-scout" . "Llama 4 Scout") + ("qwen/qwen3-235b-a22b" . "Qwen3 235B"))) + (def ollama-models + '(("llama3.2" . "Llama 3.2") ("llama3.1" . "Llama 3.1") + ("qwen2.5-coder" . "Qwen 2.5 Coder") + ("deepseek-r1" . "DeepSeek R1") ("mistral" . "Mistral") + ("codellama" . "Code Llama") ("gemma2" . "Gemma 2")))) --- a/lib/jcode/mcp/client.sls +++ b/lib/jcode/mcp/client.sls @@ -5,7 +5,7 @@ (library (jcode mcp client) (export init-mcp-tools mcp-conn? mcp-conn-name mcp-start mcp-initialize mcp-list-tools mcp-call-tool mcp-stop! - mcp-stop-all!) + mcp-stop-all! mcp-active-servers) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -48,6 +48,13 @@ (def (mcp-stop-all!) (for-each mcp-stop! *mcp-servers*) (set! *mcp-servers* '())) + (def (mcp-active-servers) + "Return list of (name . tool-count) for active MCP servers." + (map (lambda (conn) + (cons + (mcp-conn-name conn) + (length (try (mcp-list-tools conn) (catch (e) '()))))) + *mcp-servers*)) (def (mcp-next-id! conn) (let ([id (mcp-conn-next-id conn)]) (mcp-conn-next-id-set! conn (+ id 1)) --- 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-dialog.sls +++ b/lib/jcode/ui/tui-dialog.sls @@ -3,10 +3,13 @@ ;;; Source: src/jcode/ui/tui-dialog.ss (library (jcode ui tui-dialog) - (export make-dialog dialog? dialog-title dialog-body dialog-actions - dialog-selected dialog-selected-set! dialog-result - show-dialog! render-dialog! make-permission-dialog - make-confirm-dialog) + (export make-dialog dialog? dialog-title dialog-body + dialog-actions dialog-selected dialog-selected-set! + dialog-result show-dialog! render-dialog! + make-permission-dialog make-confirm-dialog make-list-dialog + list-dialog? list-dialog-title list-dialog-items + list-dialog-selected list-dialog-scroll list-dialog-result + show-list-dialog! render-list-dialog!) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -155,4 +158,114 @@ (let loop ([col x]) (when (< col (+ x width)) (tb-change-cell! col y (char->integer #\space) bg bg) - (loop (+ col 1)))))) + (loop (+ col 1))))) + (defstruct + list-dialog + (title items selected scroll result) + transparent: + #t) + (def (show-list-dialog! dlg screen-w screen-h) + "Show list dialog modally. Returns the selected item's value or #f on cancel." + (let ([max-visible (- screen-h 6)]) + (let loop () + (render-list-dialog! dlg screen-w screen-h) + (tb-present!) + (let ([ev (tb-poll-event)]) + (when (and ev (tui-event-key? ev)) + (let ([key (tui-event-key ev)] + [nitems (length (list-dialog-items dlg))]) + (cond + [(or (= key TB_KEY_ARROW_DOWN) + (and (= (tui-event-ch ev) (char->integer #\j)) + (= key 0))) + (when (< (list-dialog-selected dlg) (- nitems 1)) + (list-dialog-selected-set! + dlg + (+ (list-dialog-selected dlg) 1)) + (when (>= (- (list-dialog-selected dlg) + (list-dialog-scroll dlg)) + max-visible) + (list-dialog-scroll-set! + dlg + (+ (list-dialog-scroll dlg) 1))))] + [(or (= key TB_KEY_ARROW_UP) + (and (= (tui-event-ch ev) (char->integer #\k)) + (= key 0))) + (when (> (list-dialog-selected dlg) 0) + (list-dialog-selected-set! + dlg + (- (list-dialog-selected dlg) 1)) + (when (< (list-dialog-selected dlg) + (list-dialog-scroll dlg)) + (list-dialog-scroll-set! + dlg + (list-dialog-selected dlg))))] + [(= key TB_KEY_ENTER) + (when (> nitems 0) + (let ([item (list-ref + (list-dialog-items dlg) + (list-dialog-selected dlg))]) + (list-dialog-result-set! dlg (cdr item))))] + [(or (= key TB_KEY_ESC) + (and (= (tui-event-ch ev) (char->integer #\q)) + (= key 0))) + (list-dialog-result-set! dlg 'cancel)])))) + (cond + [(eq? (list-dialog-result dlg) 'cancel) #f] + [(list-dialog-result dlg) (list-dialog-result dlg)] + [else (loop)])))) + (def (render-list-dialog! dlg screen-w screen-h) + "Render a list selection dialog centered on screen." + (let* ([items (list-dialog-items dlg)] + [title (list-dialog-title dlg)] + [nitems (length items)] + [max-visible (min nitems (- screen-h 6))] + [content-w (max (+ (string-length title) 4) + (if (null? items) + 20 + (+ 6 + (apply + max + (map (lambda (i) + (string-length (car i))) + items)))))] + [box-w (min (+ content-w 4) (- screen-w 4))] + [box-h (+ max-visible 3)] + [bx (max 0 (quotient (- screen-w box-w) 2))] + [by (max 0 (quotient (- screen-h box-h) 2))] + [bfg (face-fg-attr 'dialog-border)] + [bbg (face-bg-attr 'dialog-border)] + [tfg (face-fg-attr 'dialog-title)] + [dfg (face-fg-attr 'dialog-text)] + [dbg (face-bg-attr 'dialog-text)] + [sel (list-dialog-selected dlg)] + [scroll (list-dialog-scroll dlg)]) + (draw-hline! bx by box-w bfg bbg #\─) + (tb-print! (+ bx 2) by tfg bbg + (string-append "─ " title " ")) + (let loop ([idx scroll] [row (+ by 1)] [count 0]) + (when (and (< idx nitems) (< count max-visible)) + (let* ([item (list-ref items idx)] + [selected? (= idx sel)] + [face (if selected? 'completion-selected 'dialog-text)] + [fg (face-fg-attr face)] + [bg (face-bg-attr face)] + [prefix (if selected? " ● " " ")] + [text (string-append prefix (car item))]) + (clear-dialog-row! bx row box-w (if selected? bg dbg)) + (tb-change-cell! bx row (char->integer #\│) bfg bbg) + (tb-change-cell! (+ bx box-w -1) row (char->integer #\│) bfg + bbg) + (tb-print! (+ bx 1) row fg bg + (if (> (string-length text) (- box-w 3)) + (substring text 0 (- box-w 3)) + text)) + (loop (+ idx 1) (+ row 1) (+ count 1))))) + (let ([hrow (+ by 1 max-visible)]) + (clear-dialog-row! bx hrow box-w dbg) + (tb-change-cell! bx hrow (char->integer #\│) bfg bbg) + (tb-change-cell! (+ bx box-w -1) hrow (char->integer #\│) + bfg bbg) + (tb-print! (+ bx 2) hrow (face-fg-attr 'dim) dbg + "↑↓ select Enter accept Esc cancel") + (draw-hline! bx (+ hrow 1) box-w bfg bbg #\─))))) --- 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-message.sls +++ b/lib/jcode/ui/tui-message.sls @@ -145,7 +145,8 @@ (list (list (cons (string-append "Error: " content) 'error)))) (def (render-system-content content) - (list (list (cons content 'dim)))) + (map (lambda (line) (list (cons line 'dim))) + (string-split content #\newline))) (def (tool-summary tool-name metadata) (cond [(assoc-ref metadata "path")] --- a/lib/jcode/ui/tui.sls +++ b/lib/jcode/ui/tui.sls @@ -13,14 +13,55 @@ (jcode ui tui-markdown) (jcode ui tui-diff) (jcode ui tui-message) (jcode ui tui-status) (jcode ui tui-input) (jcode ui tui-sidebar) - (jcode ui tui-dialog) (jcode core config) (jcode core agent) - (jcode core session) (jcode core log) (jcode tool registry) - (jcode tool file) (jcode tool bash) (jcode tool web) - (jcode tool batch) (jcode tool git) (jcode mcp client) - (jcode tool lsp) (jcode core plugin) (jerboa core) - (jerboa runtime)) + (jcode ui tui-dialog) (jcode core config) + (jcode core models) (jcode core agent) (jcode core session) + (jcode core log) (jcode tool registry) (jcode tool file) + (jcode tool bash) (jcode tool web) (jcode tool batch) + (jcode tool git) (jcode mcp client) (jcode tool lsp) + (jcode core plugin) (jerboa core) (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,16 +93,31 @@ (- (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)) + (refresh-mcp-sidebar! state) (app-state-messages-set! state (list @@ -72,7 +128,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 +154,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 +163,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 +197,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 +235,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 +277,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)])))) @@ -201,13 +298,17 @@ (msg-block-system (string-join '("Commands:" " /help Show this help" - " /model Show or set model" - " /provider Show or set provider" + " /model Select model (popup)" + " /model <id> Set model directly" + " /provider Select provider (popup)" + " /provider <name> Set provider directly" " /tools List available tools" " /clear Start new session" " /sessions List sessions" - " /theme Cycle theme" - " /sidebar Toggle sidebar" " /quit Exit") + " /theme Cycle theme (Ctrl-T)" + " /sidebar Toggle sidebar (Ctrl-B)" + " /quit Exit" "" + "Keys: Alt-Enter submit | PgUp/PgDn scroll | Ctrl-C cancel") "\n")))] [(equal? cmd "quit") (app-state-quit?-set! state #t)] [(equal? cmd "clear") @@ -227,33 +328,19 @@ (string-append "Tools: " (string-join (list-tools) ", "))))] - [(equal? cmd "model") - (add-message! - state - (msg-block-system - (format - "Provider: ~a\nModel: ~a" - (or (current-provider-override) (config-provider)) - (or (current-model-override) (config-model)))))] + [(equal? cmd "model") (handle-model-popup! state)] [(string-prefix? "model " cmd) - (current-model-override - (string-trim (substring cmd 6 (string-length cmd)))) - (add-message! - state - (msg-block-system - (format "Model set to: ~a" (current-model-override))))] + (let ([m (string-trim + (substring cmd 6 (string-length cmd)))]) + (current-model-override m) + (add-message! + state + (msg-block-system (format "Model set to: ~a" m))))] [(string-prefix? "provider " cmd) (let ([p (string-trim (substring cmd 9 (string-length cmd)))]) - (current-provider-override p) - (current-model-override (config-default-model p)) - (add-message! - state - (msg-block-system - (format - "Provider: ~a (model: ~a)" - p - (current-model-override)))))] + (switch-provider! state p))] + [(equal? cmd "provider") (handle-provider-popup! state)] [(equal? cmd "theme") (cycle-theme!) (add-message! state (msg-block-system "Theme cycled."))] @@ -281,23 +368,128 @@ (add-message! state (msg-block-system (format "Unknown command: /~a" cmd)))]))) + (def (switch-provider! state p) + "Switch to provider p and set its default model." + (let ([known (all-providers)]) + (if (member p known) + (begin + (current-provider-override p) + (current-model-override (provider-default-model p)) + (add-message! + state + (msg-block-system + (format + "Provider: ~a (~a)\nModel: ~a" + (provider-display-name p) + p + (current-model-override))))) + (add-message! + state + (msg-block-system + (format + "Unknown provider: ~a\nAvailable: ~a" + p + (string-join known ", "))))))) + (def (handle-provider-popup! state) + "Show a popup list of providers for selection." + (let* ([cur-p (or (current-provider-override) + (config-provider))] + [items (map (lambda (p) + (let ([has-key? (config-get-provider-key p)] + [display-name (provider-display-name p)]) + (cons + (format + "~a~a ~a" + (if (equal? p cur-p) "● " " ") + display-name + (if has-key? "[key]" "[no key]")) + p))) + (all-providers))] + [cur-idx (let loop ([ps (all-providers)] [i 0]) + (cond + [(null? ps) 0] + [(equal? (car ps) cur-p) i] + [else (loop (cdr ps) (+ i 1))]))] + [dlg (make-list-dialog "Select Provider" items cur-idx 0 + #f)]) + (draw-all! state) + (let ([result (show-list-dialog! + dlg + (app-state-width state) + (app-state-height state))]) + (when result (switch-provider! state result)) + (app-state-dirty?-set! state #t)))) + (def (handle-model-popup! state) + "Show a popup list of models for the current provider." + (let* ([cur-p (or (current-provider-override) + (config-provider))] + [cur-m (or (current-model-override) (config-model))] + [models (provider-models cur-p)] + [items (map (lambda (m) + (cons + (format + "~a~a (~a)" + (if (equal? (car m) cur-m) "● " " ") + (cdr m) + (car m)) + (car m))) + models)]) + (if (null? items) + (add-message! + state + (msg-block-system + (format + "No models configured for ~a.\nUse: /model <model-id>" + cur-p))) + (let* ([cur-idx (let loop ([ms models] [i 0]) + (cond + [(null? ms) 0] + [(equal? (caar ms) cur-m) i] + [else (loop (cdr ms) (+ i 1))]))] + [dlg (make-list-dialog + (format + "Select Model — ~a" + (provider-display-name cur-p)) + items cur-idx 0 #f)]) + (draw-all! state) + (let ([result (show-list-dialog! + dlg + (app-state-width state) + (app-state-height state))]) + (when result + (current-model-override result) + (add-message! + state + (msg-block-system (format "Model: ~a" result)))) + (app-state-dirty?-set! state #t)))))) + (def (refresh-mcp-sidebar! state) + "Update sidebar MCP connection info." + (let ([servers (try (mcp-active-servers) (catch (e) '()))]) + (sidebar-state-mcp-set! (app-state-sidebar state) servers))) (def (run-agent! state text) (app-state-agent-busy?-set! state #t) (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) @@ -363,6 +555,9 @@ (reflow-message! last-msg (msg-area-width state))))))) (def (add-message! state msg) (reflow-message! msg (msg-area-width state)) + (tui-log "add-message: role=~a height=~a lines=~a width=~a" + (msg-block-role msg) (msg-block-height msg) + (length (msg-block-lines msg)) (msg-area-width state)) (app-state-messages-set! state (append (app-state-messages state) (list msg)))) @@ -401,7 +596,9 @@ (or (current-provider-override) (config-provider)) (or (current-model-override) (config-model)) (app-state-tokens-in state) (app-state-tokens-out state) - (app-state-cost state) (current-directory) #t #f) + (app-state-cost state) (current-directory) + (not (null? (sidebar-state-mcp (app-state-sidebar state)))) + (and (sidebar-state-lsp (app-state-sidebar state)) #t)) (when (app-state-sidebar-visible? state) (render-sidebar! (app-state-sidebar state) (sidebar-x state) 0 (app-state-sidebar-width state) --- a/src/jcode/core/config.ss +++ b/src/jcode/core/config.ss @@ -11,7 +11,8 @@ *config*) (import :std/text/json - :std/os/path) + :std/os/path + :jcode/core/models) (def *config* (make-parameter #f)) @@ -94,14 +95,7 @@ (config-default-model (config-provider)))) (def (config-default-model provider) - (case (string->symbol provider) - ((anthropic) "claude-sonnet-4-20250514") - ((openai) "gpt-4o") - ((openrouter) "anthropic/claude-sonnet-4") - ((deepseek) "deepseek-chat") - ((google) "gemini-2.0-flash") - ((ollama) "llama3.2") - (else "gpt-4o"))) + (provider-default-model provider)) (def (config-provider) (or (config-ref "provider") new file mode 100644 --- /dev/null +++ b/src/jcode/core/models.ss @@ -0,0 +1,88 @@ +;;; jcode model registry +;;; Pre-populated model lists per provider. + +(export provider-models + all-providers + provider-display-name + provider-default-model) + +;; ---- Provider metadata ---- + +(def (all-providers) + '("anthropic" "openai" "openrouter" "deepseek" "google" "ollama")) + +(def (provider-display-name p) + (case (string->symbol p) + ((anthropic) "Anthropic") + ((openai) "OpenAI") + ((openrouter) "OpenRouter") + ((deepseek) "DeepSeek") + ((google) "Google") + ((ollama) "Ollama (local)") + (else p))) + +(def (provider-default-model provider) + (case (string->symbol provider) + ((anthropic) "claude-sonnet-4-20250514") + ((openai) "gpt-4o") + ((openrouter) "anthropic/claude-sonnet-4") + ((deepseek) "deepseek-chat") + ((google) "gemini-2.5-flash") + ((ollama) "llama3.2") + (else "gpt-4o"))) + +;; ---- Model lists per provider ---- +;; Each entry: (model-id . display-name) + +(def (provider-models provider) + (case (string->symbol provider) + ((anthropic) anthropic-models) + ((openai) openai-models) + ((deepseek) deepseek-models) + ((google) google-models) + ((openrouter) openrouter-models) + ((ollama) ollama-models) + (else '()))) + +(def anthropic-models + '(("claude-sonnet-4-20250514" . "Claude Sonnet 4") + ("claude-opus-4-20250514" . "Claude Opus 4") + ("claude-haiku-35-20241022" . "Claude 3.5 Haiku"))) + +(def openai-models + '(("gpt-4o" . "GPT-4o") + ("gpt-4o-mini" . "GPT-4o Mini") + ("gpt-4-turbo" . "GPT-4 Turbo") + ("o3" . "o3") + ("o3-mini" . "o3 Mini") + ("o4-mini" . "o4 Mini"))) + +(def deepseek-models + '(("deepseek-chat" . "DeepSeek V3") + ("deepseek-reasoner" . "DeepSeek R1"))) + +(def google-models + '(("gemini-2.5-pro" . "Gemini 2.5 Pro") + ("gemini-2.5-flash" . "Gemini 2.5 Flash") + ("gemini-2.0-flash" . "Gemini 2.0 Flash"))) + +(def openrouter-models + '(("anthropic/claude-sonnet-4" . "Claude Sonnet 4") + ("anthropic/claude-opus-4" . "Claude Opus 4") + ("openai/gpt-4o" . "GPT-4o") + ("google/gemini-2.5-pro" . "Gemini 2.5 Pro") + ("google/gemini-2.5-flash" . "Gemini 2.5 Flash") + ("deepseek/deepseek-chat" . "DeepSeek V3") + ("deepseek/deepseek-r1" . "DeepSeek R1") + ("meta-llama/llama-4-maverick" . "Llama 4 Maverick") + ("meta-llama/llama-4-scout" . "Llama 4 Scout") + ("qwen/qwen3-235b-a22b" . "Qwen3 235B"))) + +(def ollama-models + '(("llama3.2" . "Llama 3.2") + ("llama3.1" . "Llama 3.1") + ("qwen2.5-coder" . "Qwen 2.5 Coder") + ("deepseek-r1" . "DeepSeek R1") + ("mistral" . "Mistral") + ("codellama" . "Code Llama") + ("gemma2" . "Gemma 2"))) --- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -10,7 +10,8 @@ mcp-list-tools mcp-call-tool mcp-stop! - mcp-stop-all!) + mcp-stop-all! + mcp-active-servers) (import :std/text/json :std/misc/string @@ -55,6 +56,13 @@ (for-each mcp-stop! *mcp-servers*) (set! *mcp-servers* '())) +(def (mcp-active-servers) + "Return list of (name . tool-count) for active MCP servers." + (map (lambda (conn) + (cons (mcp-conn-name conn) + (length (try (mcp-list-tools conn) (catch (e) '()))))) + *mcp-servers*)) + ;; --- JSON-RPC 2.0 protocol --- (def (mcp-next-id! conn) --- a/src/jcode/ui/tui-dialog.ss +++ b/src/jcode/ui/tui-dialog.ss @@ -6,7 +6,12 @@ dialog-selected dialog-selected-set! dialog-result show-dialog! render-dialog! - make-permission-dialog make-confirm-dialog) + make-permission-dialog make-confirm-dialog + ;; List selection dialog + make-list-dialog list-dialog? + list-dialog-title list-dialog-items list-dialog-selected + list-dialog-scroll list-dialog-result + show-list-dialog! render-list-dialog!) (import :jcode/ui/tui-ffi :jcode/ui/tui-theme) @@ -164,3 +169,106 @@ (when (< col (+ x width)) (tb-change-cell! col y (char->integer #\space) bg bg) (loop (+ col 1))))) + +;; ==== List selection dialog ==== +;; Scrollable list for picking from items like models/providers. + +(defstruct list-dialog + (title ;; string + items ;; list of (display-text . value) + selected ;; index of highlighted item + scroll ;; scroll offset for long lists + result) ;; #f until resolved, then selected value + transparent: #t) + +(def (show-list-dialog! dlg screen-w screen-h) + "Show list dialog modally. Returns the selected item's value or #f on cancel." + (let ((max-visible (- screen-h 6))) ;; leave room for borders + title + (let loop () + (render-list-dialog! dlg screen-w screen-h) + (tb-present!) + (let ((ev (tb-poll-event))) + (when (and ev (tui-event-key? ev)) + (let ((key (tui-event-key ev)) + (nitems (length (list-dialog-items dlg)))) + (cond + ;; Arrow down / j: next item + ((or (= key TB_KEY_ARROW_DOWN) + (and (= (tui-event-ch ev) (char->integer #\j)) (= key 0))) + (when (< (list-dialog-selected dlg) (- nitems 1)) + (list-dialog-selected-set! dlg (+ (list-dialog-selected dlg) 1)) + ;; Scroll if needed + (when (>= (- (list-dialog-selected dlg) (list-dialog-scroll dlg)) max-visible) + (list-dialog-scroll-set! dlg (+ (list-dialog-scroll dlg) 1))))) + ;; Arrow up / k: prev item + ((or (= key TB_KEY_ARROW_UP) + (and (= (tui-event-ch ev) (char->integer #\k)) (= key 0))) + (when (> (list-dialog-selected dlg) 0) + (list-dialog-selected-set! dlg (- (list-dialog-selected dlg) 1)) + (when (< (list-dialog-selected dlg) (list-dialog-scroll dlg)) + (list-dialog-scroll-set! dlg (list-dialog-selected dlg))))) + ;; Enter: accept + ((= key TB_KEY_ENTER) + (when (> nitems 0) + (let ((item (list-ref (list-dialog-items dlg) (list-dialog-selected dlg)))) + (list-dialog-result-set! dlg (cdr item))))) + ;; Escape / q: cancel + ((or (= key TB_KEY_ESC) + (and (= (tui-event-ch ev) (char->integer #\q)) (= key 0))) + (list-dialog-result-set! dlg 'cancel)))))) + (cond