Add ESC interrupt, response timestamps, MCP tool visibility
ober
cda77b3b46c9618e532dfd81e14b02bbd60e9f2e
--- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.sls @@ -20,10 +20,15 @@ (def current-model-override (make-parameter #f)) (def (system-prompt) (format - "You are an expert AI coding assistant. You help users with software development tasks.\nWorking directory: ~a\nCurrent mode: ~a\n\nYou have access to these tools:\n- read, write, edit, multi-edit: Read and modify files\n- glob, grep: Search files by pattern or content (prefer these over ls)\n- ls: List directory contents (use sparingly — prefer glob/grep to explore)\n- bash: Execute shell commands\n- fetch: HTTP requests\n- batch: Run multiple tool calls in parallel\n- git_status, git_diff, git_log, git_show, git_commit: Git operations\n\n~a\n\nIMPORTANT: Do NOT call the same tool repeatedly with the same or similar arguments.\nIf you already retrieved information, use what you have. Use batch to parallelize.\nUse glob to find files by pattern instead of exploring directory by directory with ls.\n\nWhen the user asks you to do something:\n1. Think about what tools you need\n2. Use tools to gather information or make changes\n3. Report back with results\n\nBe concise and helpful. When editing files, make minimal targeted changes.\nPrefer using the edit tool over write for modifying existing files." - (current-directory) - (mode-label (current-mode)) - (mode-instructions (current-mode)))) + "You are an expert AI coding assistant. You help users with software development tasks.\nWorking directory: ~a\nCurrent mode: ~a\n\nYou have access to these tools:\n~a\n\n~a\n\nIMPORTANT: Do NOT call the same tool repeatedly with the same or similar arguments.\nIf you already retrieved information, use what you have. Use batch to parallelize.\nUse glob to find files by pattern instead of exploring directory by directory with ls.\n\nWhen the user asks you to do something:\n1. Think about what tools you need\n2. Use tools to gather information or make changes\n3. Report back with results\n\nBe concise and helpful. When editing files, make minimal targeted changes.\nPrefer using the edit tool over write for modifying existing files." + (current-directory) (mode-label (current-mode)) + (format-tool-list) (mode-instructions (current-mode)))) + (def (format-tool-list) + "Build a bullet list of all registered tools for the system prompt." + (let ([names (sort string<? (list-tools))]) + (string-join + (map (lambda (n) (string-append "- " n)) names) + "\n"))) (def (mode-label m) (case m [(plan) "PLAN (read-only)"] @@ -143,14 +148,14 @@ (let ([trimmed (string-trim args-str)]) (if (string=? trimmed "") "{}" - (or (guard (e [list #t #f]) + (or (guard (e [#t #f]) (let ([ht (string->json-object trimmed)]) (and (hash-table? ht) (json-object->string ht)))) - (guard (e [list #t #f]) + (guard (e [#t #f]) (let ([ht (string->json-object (string-append "{" trimmed "}"))]) (and (hash-table? ht) (json-object->string ht)))) - (guard (e [list #t #f]) + (guard (e [#t #f]) (let ([ht (make-hash-table)]) (for-each (lambda (pair) @@ -318,8 +323,7 @@ (def (execute-single-tool tc) (let* ([name (tool-call-name tc)] [raw-args (tool-call-arguments tc)] - [args (guard (e [list #t #f]) - (string->json-object raw-args))] + [args (guard (e [#t #f]) (string->json-object raw-args))] [cb (current-tool-cb)]) (if (not args) (begin --- a/lib/jcode/mcp/client.sls +++ b/lib/jcode/mcp/client.sls @@ -166,7 +166,7 @@ [schema (or (hash-get tool "inputSchema") (make-hash-table))]) (let ([jcode-name (string-append prefix name)]) - (register-internal-tool! + (register-tool! jcode-name desc schema --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -247,26 +247,145 @@ (printf "Goodbye!~n") (exit 0)] [#t (printf "Unknown command: /~a~n" cmd)]))) + (def *stream-abort* (cons #f #f)) + (def (stream-aborted?) (car *stream-abort*)) + (def (save-terminal-state) + (guard (e [#t #f]) + (let-values ([(to-stdin from-stdout from-stderr pid) + (open-process-ports + "stty -g 2>/dev/null" + (buffer-mode block) + (native-transcoder))]) + (let ([state (get-line from-stdout)]) + (close-port to-stdin) + (close-port from-stdout) + (close-port from-stderr) + (if (eof-object? state) #f state))))) + (def (restore-terminal-state! state) + (when (and state + (string? state) + (> (string-length state) 0)) + (system (string-append "stty " state " 2>/dev/null")))) + (def (set-cbreak-mode!) + (system "stty cbreak -echo 2>/dev/null")) + (def (drain-stdin!) + (guard (e [#t (void)]) + (let loop () + (when (char-ready? (current-input-port)) + (read-char (current-input-port)) + (loop))))) + (def (start-escape-watcher!) + "Spawn thread that polls stdin in cbreak mode for ESC key." + (set-car! *stream-abort* #f) + (spawn + (lambda () + (guard (e [#t (void)]) + (let loop () + (unless (car *stream-abort*) + (if (char-ready? (current-input-port)) + (let ([c (read-char (current-input-port))]) + (when (and (char? c) (= (char->integer c) 27)) + (set-car! *stream-abort* #t)) + (unless (car *stream-abort*) (loop))) + (begin + (sleep (make-time 'time-duration 20000000 0)) + (loop))))))))) + (def (interruptible-stream-cb token) + "Stream callback that checks abort flag before forwarding to md-stream-token." + (when (car *stream-abort*) + (error 'stream-aborted "interrupted by user")) + (md-stream-token token)) + (def (format-elapsed secs) + (cond + [(< secs 60) (format "~as" secs)] + [else + (format "~am ~as" (quotient secs 60) (remainder secs 60))])) (def (handle-user-input input session-id) - (try (printf "~n") (flush-output-port (current-output-port)) - (md-reset!) - (parameterize ([current-stream-cb md-stream-token] - [current-tool-cb tool-indicator]) - (agent-run session-id input)) - (md-flush!) (printf "~n~n") - (catch - (e) - (log-error logger "error" `((msg . ,(err->string e)))) - (printf "~nError: ~a~n" (format-error e))))) + (let ([t0 (time-second (current-time))] + [term-state (save-terminal-state)] + [aborted? #f]) + (dynamic-wind + (lambda () (set-cbreak-mode!)) + (lambda () + (try (printf "~n") (flush-output-port (current-output-port)) + (md-reset!) + (let ([watcher (start-escape-watcher!)]) + (parameterize ([current-stream-cb + interruptible-stream-cb] + [current-tool-cb tool-indicator]) + (agent-run session-id input))) + (catch + (e) + (if (and (message-condition? e) + (string-contains + (condition-message e) + "stream-aborted")) + (set! aborted? #t) + (begin + (log-error + logger + "error" + `((msg . ,(err->string e)))) + (printf "~nError: ~a~n" (format-error e))))))) + (lambda () + (set-car! *stream-abort* #t) + (restore-terminal-state! term-state) + (drain-stdin!))) + (md-flush!) + (let ([elapsed (- (time-second (current-time)) t0)]) + (if aborted? + (printf + "~n\x1B;[2m(interrupted after ~a)\x1B;[0m~n~n" + (format-elapsed elapsed)) + (printf + "~n\x1B;[2m(~a)\x1B;[0m~n~n" + (format-elapsed elapsed)))) + (flush-output-port (current-output-port)))) (def (one-shot-mode prompt opts) - (try (md-reset!) - (parameterize ([current-stream-cb md-stream-token] - [current-tool-cb tool-indicator]) - (agent-chat prompt)) - (md-flush!) (newline) (mcp-stop-all!) (exit 0) - (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (format-error e)) (mcp-stop-all!) - (exit 1)))) + (let ([t0 (time-second (current-time))] + [term-state (save-terminal-state)]) + (dynamic-wind + (lambda () (set-cbreak-mode!)) + (lambda () + (try (md-reset!) + (let ([watcher (start-escape-watcher!)]) + (parameterize ([current-stream-cb + interruptible-stream-cb] + [current-tool-cb tool-indicator]) + (agent-chat prompt))) + (md-flush!) + (let ([elapsed (- (time-second (current-time)) t0)]) + (printf + "~n\x1B;[2m(~a)\x1B;[0m~n" + (format-elapsed elapsed))) + (mcp-stop-all!) (exit 0) + (catch + (e) + (if (and (message-condition? e) + (string-contains + (condition-message e) + "stream-aborted")) + (begin + (md-flush!) + (let ([elapsed (- (time-second (current-time)) + t0)]) + (printf + "~n\x1B;[2m(interrupted after ~a)\x1B;[0m~n" + (format-elapsed elapsed))) + (mcp-stop-all!) + (exit 0)) + (begin + (log-error + logger + "error" + `((msg . ,(err->string e)))) + (printf "Error: ~a~n" (format-error e)) + (mcp-stop-all!) + (exit 1)))))) + (lambda () + (set-car! *stream-abort* #t) + (restore-terminal-state! term-state) + (drain-stdin!))))) (def *md-line-buf* "") (def *md-in-code-block* #f) (def *backtick* (integer->char 96)) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -18,7 +18,9 @@ ./message ./session :jcode/provider/provider - :jcode/tool/registry) + :jcode/tool/registry + :jerboa/core + :jerboa/runtime) (def logger (make-logger "agent")) @@ -31,13 +33,7 @@ Working directory: ~a Current mode: ~a You have access to these tools: -- read, write, edit, multi-edit: Read and modify files -- glob, grep: Search files by pattern or content (prefer these over ls) -- ls: List directory contents (use sparingly — prefer glob/grep to explore) -- bash: Execute shell commands -- fetch: HTTP requests -- batch: Run multiple tool calls in parallel -- git_status, git_diff, git_log, git_show, git_commit: Git operations +~a ~a @@ -54,8 +50,16 @@ Be concise and helpful. When editing files, make minimal targeted changes. Prefer using the edit tool over write for modifying existing files." (current-directory) (mode-label (current-mode)) + (format-tool-list) (mode-instructions (current-mode)))) +(def (format-tool-list) + "Build a bullet list of all registered tools for the system prompt." + (let ((names (sort string<? (list-tools)))) + (string-join + (map (lambda (n) (string-append "- " n)) names) + "\n"))) + (def (mode-label m) (case m ((plan) "PLAN (read-only)") --- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -18,7 +18,9 @@ :std/misc/thread :jcode/core/log :jcode/core/config - :jcode/tool/registry) + :jcode/tool/registry + :jerboa/core + :jerboa/runtime) (def logger (make-logger "mcp")) @@ -183,7 +185,7 @@ (desc (or (hash-get tool "description") "MCP tool")) (schema (or (hash-get tool "inputSchema") (make-hash-table)))) (let ((jcode-name (string-append prefix name))) - (register-internal-tool! jcode-name desc schema + (register-tool! jcode-name desc schema (lambda (args) (mcp-call-tool conn name args)))))) tools) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -243,35 +243,136 @@ EXAMPLES: (#t (printf "Unknown command: /~a~n" cmd))))) +;; --- ESC interrupt support --- + +(def *stream-abort* (cons #f #f)) ;; mutable cell, car = abort flag + +(def (stream-aborted?) + (car *stream-abort*)) + +(def (save-terminal-state) + (guard (e [#t #f]) + (let-values (((to-stdin from-stdout from-stderr pid) + (open-process-ports "stty -g 2>/dev/null" + (buffer-mode block) (native-transcoder)))) + (let ((state (get-line from-stdout))) + (close-port to-stdin) + (close-port from-stdout) + (close-port from-stderr) + (if (eof-object? state) #f state))))) + +(def (restore-terminal-state! state) + (when (and state (string? state) (> (string-length state) 0)) + (system (string-append "stty " state " 2>/dev/null")))) + +(def (set-cbreak-mode!) + (system "stty cbreak -echo 2>/dev/null")) + +(def (drain-stdin!) + (guard (e [#t (void)]) + (let loop () + (when (char-ready? (current-input-port)) + (read-char (current-input-port)) + (loop))))) + +(def (start-escape-watcher!) + "Spawn thread that polls stdin in cbreak mode for ESC key." + (set-car! *stream-abort* #f) + (spawn + (lambda () + (guard (e [#t (void)]) + (let loop () + (unless (car *stream-abort*) + (if (char-ready? (current-input-port)) + (let ((c (read-char (current-input-port)))) + (when (and (char? c) (= (char->integer c) 27)) + (set-car! *stream-abort* #t)) + (unless (car *stream-abort*) (loop))) + (begin + (sleep (make-time 'time-duration 20000000 0)) + (loop))))))))) + +(def (interruptible-stream-cb token) + "Stream callback that checks abort flag before forwarding to md-stream-token." + (when (car *stream-abort*) + (error 'stream-aborted "interrupted by user")) + (md-stream-token token)) + +(def (format-elapsed secs) + (cond + ((< secs 60) (format "~as" secs)) + (else (format "~am ~as" (quotient secs 60) (remainder secs 60))))) + (def (handle-user-input input session-id) - (try - (printf "~n") - (flush-output-port (current-output-port)) - (md-reset!) - (parameterize ((current-stream-cb md-stream-token) - (current-tool-cb tool-indicator)) - (agent-run session-id input)) + (let ((t0 (time-second (current-time))) + (term-state (save-terminal-state)) + (aborted? #f)) + (dynamic-wind + (lambda () (set-cbreak-mode!)) + (lambda () + (try + (printf "~n") + (flush-output-port (current-output-port)) + (md-reset!) + (let ((watcher (start-escape-watcher!))) + (parameterize ((current-stream-cb interruptible-stream-cb) + (current-tool-cb tool-indicator)) + (agent-run session-id input))) + (catch (e) + (if (and (message-condition? e) + (string-contains (condition-message e) "stream-aborted")) + (set! aborted? #t) + (begin + (log-error logger "error" `((msg . ,(err->string e)))) + (printf "~nError: ~a~n" (format-error e))))))) + (lambda () + ;; Always restore terminal + drain stray keystrokes + (set-car! *stream-abort* #t) ;; signal watcher to stop + (restore-terminal-state! term-state) + (drain-stdin!))) + ;; Output epilogue after terminal is restored (md-flush!) - (printf "~n~n") - (catch (e) - (log-error logger "error" `((msg . ,(err->string e)))) - (printf "~nError: ~a~n" (format-error e))))) + (let ((elapsed (- (time-second (current-time)) t0))) + (if aborted? + (printf "~n\x1b;[2m(interrupted after ~a)\x1b;[0m~n~n" (format-elapsed elapsed)) + (printf "~n\x1b;[2m(~a)\x1b;[0m~n~n" (format-elapsed elapsed)))) + (flush-output-port (current-output-port)))) (def (one-shot-mode prompt opts) - (try - (md-reset!) - (parameterize ((current-stream-cb md-stream-token) - (current-tool-cb tool-indicator)) - (agent-chat prompt)) - (md-flush!) - (newline) - (mcp-stop-all!) - (exit 0) - (catch (e) - (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (format-error e)) - (mcp-stop-all!) - (exit 1)))) + (let ((t0 (time-second (current-time))) + (term-state (save-terminal-state))) + (dynamic-wind + (lambda () (set-cbreak-mode!)) + (lambda () + (try + (md-reset!) + (let ((watcher (start-escape-watcher!))) + (parameterize ((current-stream-cb interruptible-stream-cb) + (current-tool-cb tool-indicator)) + (agent-chat prompt))) + (md-flush!) + (let ((elapsed (- (time-second (current-time)) t0))) + (printf "~n\x1b;[2m(~a)\x1b;[0m~n" (format-elapsed elapsed))) + (mcp-stop-all!) + (exit 0) + (catch (e) + (if (and (message-condition? e) + (string-contains (condition-message e) "stream-aborted")) + (begin + (md-flush!) + (let ((elapsed (- (time-second (current-time)) t0))) + (printf "~n\x1b;[2m(interrupted after ~a)\x1b;[0m~n" (format-elapsed elapsed))) + (mcp-stop-all!) + (exit 0)) + (begin + (log-error logger "error" `((msg . ,(err->string e)))) + (printf "Error: ~a~n" (format-error e)) + (mcp-stop-all!) + (exit 1)))))) + (lambda () + (set-car! *stream-abort* #t) + (restore-terminal-state! term-state) + (drain-stdin!))))) ;; --- line-buffered markdown renderer ---