TUI: show expert escalation as a distinct purple-bordered block
ober
0e5d4691ab98ce8c30ff6dd73b597a9ba6a7b121
--- a/src/jcode/core/expert.ss +++ b/src/jcode/core/expert.ss @@ -28,7 +28,8 @@ get-expert-provider expert-prompt-instructions chat-with-expert - stream-chat-with-expert) + stream-chat-with-expert + current-expert-cb) (import :std/misc/string :jcode/core/config @@ -39,6 +40,13 @@ (def logger (make-logger "expert")) +;; Optional escalation hook. When set (e.g. by the TUI worker), it is invoked +;; on the streaming path INSTEAD of pushing the text banner through token-cb, +;; so the UI can render a structured indicator and colour the expert's reply +;; distinctly. Signature: (cb provider-name model-string reason-string sentinel?) +;; where sentinel? is #t when the primary self-reported via <expert/>. +(def current-expert-cb (make-parameter #f)) + ;; XML-style self-closing tag — distinctive enough not to collide with ;; normal prose or code, but harmless if accidentally emitted (stripped ;; before the user sees the response). @@ -217,14 +225,24 @@ (model . ,(provider-model expert)) (trigger . ,(if sentinel? 'sentinel 'auto)) (reason . ,reason-text))) - (when token-cb - (token-cb - (format "\n\n[escalating to ~a/~a~a]\n\n" - (provider-name expert) - (provider-model expert) - (if auto-reason - (string-append " — " reason-text) - "")))) + ;; Prefer a structured escalation event (TUI) so the UI can show an + ;; indicator and colour the expert reply; otherwise stream the text + ;; banner inline (line-mode REPL / plain CLI). + (let ((ecb (current-expert-cb))) + (cond + (ecb + (ecb (provider-name expert) + (provider-model expert) + reason-text + sentinel?)) + (token-cb + (token-cb + (format "\n\n[escalating to ~a/~a~a]\n\n" + (provider-name expert) + (provider-model expert) + (if auto-reason + (string-append " — " reason-text) + "")))))) (guard (e [#t (log-warn logger "expert-call-failed" `((err . ,(err->string e)))) --- a/src/jcode/ui/tui-message.ss +++ b/src/jcode/ui/tui-message.ss @@ -12,7 +12,7 @@ msg-block-thinking-set! msg-block-thinking-collapsed?-set! reflow-message! render-msg-block! - msg-block-user msg-block-assistant msg-block-tool msg-block-error msg-block-system) + msg-block-user msg-block-assistant msg-block-expert msg-block-tool msg-block-error msg-block-system) (import :std/misc/string :jcode/ui/tui-ffi @@ -25,7 +25,7 @@ ;; ---- Message block struct ---- (defstruct msg-block - (role ;; 'user | 'assistant | 'tool | 'error | 'system + (role ;; 'user | 'assistant | 'expert | 'tool | 'error | 'system content ;; raw text (assistant: visible reply only, with <think> stripped) lines ;; list of (list-of (text . face-name)) — rendered segments per line height ;; number of terminal rows @@ -49,6 +49,14 @@ (reflow-message! m 80) m)) +;; Expert reply (escalated to a stronger model). Renders like an assistant +;; block but with a distinct left-border colour so an escalated answer is +;; visually distinguishable from the primary model's output. +(def (msg-block-expert text) + (let ((m (make-msg-block 'expert text '() 0 #f #f #f '() #f #t))) + (reflow-message! m 80) + m)) + (def (msg-block-tool name status content . meta) (let ((m (make-msg-block 'tool content '() 0 name status #t (if (null? meta) '() (car meta)) @@ -137,6 +145,7 @@ (case role ((user) (render-user-content content)) ((assistant) (render-assistant-content content thinking thinking-collapsed? width)) + ((expert) (render-assistant-content content thinking thinking-collapsed? width)) ((tool) (render-tool-content tool-name tool-status content collapsed? metadata width)) ((error) (render-error-content content)) ((system) (render-system-content content)) @@ -250,6 +259,7 @@ (case role ((user) 'msg-border-user) ((assistant) 'msg-border-assistant) + ((expert) 'msg-border-expert) ((tool) 'msg-border-tool) ((error) 'msg-border-error) (else 'msg-border-tool))) --- a/src/jcode/ui/tui-theme.ss +++ b/src/jcode/ui/tui-theme.ss @@ -160,6 +160,7 @@ ;; Message borders (msg-border-user . ,(make-face (rgb #x56 #x9c #xd6) (rgb #x1e #x1e #x1e) #f #f #f)) (msg-border-assistant . ,(make-face (rgb #x4e #xc9 #xb0) (rgb #x1e #x1e #x1e) #f #f #f)) + (msg-border-expert . ,(make-face (rgb #xc5 #x86 #xc0) (rgb #x1e #x1e #x1e) #f #f #f)) (msg-border-tool . ,(make-face (rgb #x80 #x80 #x80) (rgb #x1e #x1e #x1e) #f #f #f)) (msg-border-error . ,(make-face (rgb #xf4 #x47 #x47) (rgb #x1e #x1e #x1e) #f #f #f)) ))) @@ -252,6 +253,7 @@ ;; Message borders (msg-border-user . ,(make-face (rgb #x00 #x51 #xa5) (rgb #xff #xff #xff) #f #f #f)) (msg-border-assistant . ,(make-face (rgb #x09 #x7c #x5a) (rgb #xff #xff #xff) #f #f #f)) + (msg-border-expert . ,(make-face (rgb #x6f #x42 #xc1) (rgb #xff #xff #xff) #f #f #f)) (msg-border-tool . ,(make-face (rgb #xc0 #xc0 #xc0) (rgb #xff #xff #xff) #f #f #f)) (msg-border-error . ,(make-face (rgb #xc0 #x22 #x22) (rgb #xff #xff #xff) #f #f #f)) ))) @@ -344,6 +346,7 @@ ;; Message borders (msg-border-user . ,(make-face (rgb #x83 #xa5 #x98) (rgb #x28 #x28 #x28) #f #f #f)) (msg-border-assistant . ,(make-face (rgb #xb8 #xbb #x26) (rgb #x28 #x28 #x28) #f #f #f)) + (msg-border-expert . ,(make-face (rgb #xd3 #x86 #x9b) (rgb #x28 #x28 #x28) #f #f #f)) (msg-border-tool . ,(make-face (rgb #xa8 #x99 #x84) (rgb #x28 #x28 #x28) #f #f #f)) (msg-border-error . ,(make-face (rgb #xfb #x49 #x34) (rgb #x28 #x28 #x28) #f #f #f)) ))) @@ -405,7 +408,7 @@ (background . ()) (backgroundPanel . (sidebar-bg completion-item toast-bg)) (backgroundElement . (completion-selected code-inline)) - (border . (tool-border divider sidebar-divider msg-border-user msg-border-assistant msg-border-tool msg-border-error)) + (border . (tool-border divider sidebar-divider msg-border-user msg-border-assistant msg-border-expert msg-border-tool msg-border-error)) (borderActive . (dialog-border sidebar-selected)) (borderSubtle . (horizontal-rule blockquote-border thinking-border)) (diffAdded . (diff-added)) --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -919,6 +919,8 @@ (tui-stream-token! state token)) ((list 'tool-event op name args) (tui-tool-event! state op name args)) + ((list 'escalation prov model reason sentinel?) + (tui-escalation! state prov model reason sentinel?)) ((list 'usage-update usage) (tui-usage-update! state usage)) ((list 'agent-error msg) @@ -1035,7 +1037,14 @@ (send-worker-event! gen (list 'tool-event event name args)))) (current-usage-cb (lambda (usage) - (send-worker-event! gen (list 'usage-update usage))))) + (send-worker-event! gen (list 'usage-update usage)))) + (current-expert-cb + (lambda (prov model reason sentinel?) + (when (or (car *tui-stream-abort*) + (not (= gen (tui-run-gen)))) + (error 'stream-aborted "interrupted by user")) + (send-worker-event! gen + (list 'escalation prov model reason sentinel?))))) (tui-log "worker: calling agent-run") (agent-run s-id text) (tui-log "worker: agent-run returned, sending agent-done") @@ -1348,6 +1357,12 @@ ((assistant) (make-assistant-message (msg-block-content blk))) (else (make-system-message (msg-block-content blk))))) +(def (streamed-reply-role? r) + ;; Roles whose blocks carry streamed LLM output and therefore share the + ;; streaming / finalize / thinking-toggle machinery: the primary assistant + ;; reply and an escalated expert reply. They differ only in border colour. + (or (eq? r 'assistant) (eq? r 'expert))) + (def (finalize-last-assistant! state) ;; If the trailing assistant block contains a <think>...</think> pair, hoist ;; the thinking text into its own slot and replace content with just the reply. @@ -1355,7 +1370,7 @@ (when (pair? msgs) (let ((m (car msgs))) (cond - ((not (eq? (msg-block-role m) 'assistant)) + ((not (streamed-reply-role? (msg-block-role m))) (loop (cdr msgs))) ((msg-block-thinking m) (void)) ;; already finalized (else @@ -1373,7 +1388,7 @@ (when (pair? msgs) (let ((m (car msgs))) (cond - ((and (eq? (msg-block-role m) 'assistant) + ((and (streamed-reply-role? (msg-block-role m)) (msg-block-thinking m)) (msg-block-thinking-collapsed?-set! m (not (msg-block-thinking-collapsed? m))) @@ -1393,7 +1408,7 @@ (let ((msgs (app-state-messages state))) (or (null? msgs) (let ((last (car (reverse msgs)))) - (or (not (eq? (msg-block-role last) 'assistant)) + (or (not (streamed-reply-role? (msg-block-role last))) (not (string-empty? (msg-block-content last)))))))) (tui-log "tui-stream-token: adding new assistant block") (add-message! state (msg-block-assistant ""))) @@ -1417,6 +1432,23 @@ ((end) (app-state-dirty?-set! state #t)))) +(def (tui-escalation! state prov model reason sentinel?) + "An expert model was called. Finalize the primary reply, then open a + distinctly-coloured 'expert block headed by an escalation notice; the + expert's streamed answer appends after the notice (stream-buf carries the + notice so the first expert token does not overwrite it)." + (finalize-last-assistant! state) + (let* ((why (if (and (not sentinel?) + reason (string? reason) + (not (string-empty? reason))) + (string-append " — " reason) + "")) + (notice (format "⚡ escalated to ~a/~a~a\n\n" prov model why))) + (add-message! state (msg-block-expert notice)) + (app-state-stream-buf-set! state notice)) + (app-state-scroll-offset-set! state 0) + (app-state-dirty?-set! state #t)) + (def (tui-usage-update! state usage) "Accumulate token/cost usage from a streaming response." (for-each @@ -1457,7 +1489,7 @@ (let loop ((msgs (reverse (app-state-messages state))) (skipped 0)) (if (pair? msgs) (let ((m (car msgs))) - (if (eq? (msg-block-role m) 'assistant) + (if (streamed-reply-role? (msg-block-role m)) (begin (tui-log "update-last-assistant: found at skip=~a content-len=~a" skipped (string-length content)) (msg-block-content-set! m content) @@ -1858,7 +1890,7 @@ (let loop ((rev rev)) (cond ((null? rev) #f) - ((eq? (msg-block-role (car rev)) 'assistant) + ((streamed-reply-role? (msg-block-role (car rev))) (let ((m (car rev))) (msg-block-content-set! m new-content) (reflow-message! m width)