From 07005474dd4ea6bc6f496b4e837de86944d9a009 Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Tue, 12 May 2026 10:17:58 -0400 Subject: [PATCH 1/6] Add CI workflow, local test runner, and multi-IDE config GitHub Actions workflow with four jobs: readme-updated (PR-only, guards the soft-fork features list), agent-symlinks (verifies the multi-IDE plumbing), dependency-dag (require graph must be acyclic), and test (byte-compile + ERT under emacs 29.4 with acp.el and shell-maker as checkout deps). bin/test parses ci.yml with yq and dispatches each step locally, so CI changes are picked up automatically. adapt_for_local rewrites GitHub PR sha context to a single @{u}... three-dot range that the git wrapper accepts. CONTRIBUTING.org documents the runner and the acp_root / shell_maker_root overrides. .claude / .codex / .gemini and CODEX.md are symlinks pointing at .agents and AGENTS.md so the same config works across Claude Code, Codex, and Gemini CLI. .agents/commands/live-validate.md describes the live rendering-validation workflow. README.org gets a "Features on top of agent-shell" section enumerating the streaming-dedup work and follow-on polish. agent-shell-devcontainer.el declares agent-shell-text-file-capabilities to suppress a byte-compile warning for the cross-file reference. Three send-command tests in tests/agent-shell-tests.el get :title and :last-activity-time pre-seeded on their hand-rolled state alists so the local runner produces a clean baseline. Without the placeholders, agent-shell--set-session-title's map-put! call fails with map-not-inplace because the alists lack the keys. Quote the keymap argument to shell-maker-define-major-mode. Under shell-maker 0.91.2 the macro expects a symbol it can resolve at mode activation; passing the unquoted variable evaluates to the keymap value before the macro can use it, and agent-shell-mode signals (void-function keymap) when any test creates a fresh buffer. Co-Authored-By: Claude Opus 4.7 (1M context) --- .agents/commands/live-validate.md | 74 ++++++++++++ .claude | 1 + .codex | 1 + .gemini | 1 + .github/workflows/ci.yml | 99 ++++++++++++++++ .gitignore | 1 + AGENTS.md | 13 ++- CODEX.md | 1 + CONTRIBUTING.org | 21 ++++ README.org | 13 +++ agent-shell-devcontainer.el | 2 + agent-shell.el | 2 +- bin/test | 181 +++++++++++++++--------------- tests/agent-shell-tests.el | 12 +- 14 files changed, 327 insertions(+), 95 deletions(-) create mode 100644 .agents/commands/live-validate.md create mode 120000 .claude create mode 120000 .codex create mode 120000 .gemini create mode 120000 CODEX.md diff --git a/.agents/commands/live-validate.md b/.agents/commands/live-validate.md new file mode 100644 index 00000000..8b2796c2 --- /dev/null +++ b/.agents/commands/live-validate.md @@ -0,0 +1,74 @@ +# Live validation of agent-shell rendering + +Run a live agent-shell session in batch mode and verify the buffer output. +This exercises the full rendering pipeline with real ACP traffic — the only +way to catch ordering, marker, and streaming bugs that unit tests miss. + +## Prerequisites + +- `ANTHROPIC_API_KEY` must be available (via `op run` / 1Password) +- `timvisher_emacs_agent_shell` must be on PATH +- Dependencies (acp.el-plus, shell-maker) in sibling worktrees or + overridden via env vars + +## How to run + +```bash +cd "$(git rev-parse --show-toplevel)" +timvisher_agent_shell_checkout=. \ + timvisher_emacs_agent_shell claude --batch \ + 1>/tmp/agent-shell-live-stdout.log \ + 2>/tmp/agent-shell-live-stderr.log +``` + +Stderr shows heartbeat lines every 30 seconds. Stdout contains the +full buffer dump once the agent turn completes. + +## What to check in the output + +1. **Fragment ordering**: tool call drawers should appear in + chronological order (the order the agent invoked them), not + reversed. Look for `▶` lines — their sequence should match the + logical execution order. + +2. **No duplicate content**: each tool call output should appear + exactly once. Watch for repeated blocks of identical text. + +3. **Prompt position**: the prompt line (`agent-shell>`) should + appear at the very end of the buffer, after all fragments. + +4. **Notices placement**: `[hook-trace]` and other notice lines + should appear in a `Notices` section, not interleaved with tool + call fragments. + +## Enabling invariant checking + +To run with runtime invariant assertions (catches corruption as it +happens rather than after the fact): + +```elisp +;; Add to your init or eval before the session starts: +(setq agent-shell-invariants-enabled t) +``` + +When an invariant fires, a `*agent-shell invariant*` buffer pops up +with a debug bundle and recommended analysis prompt. + +The content-store consistency check is O(N · buffer-size) per +mutation — every notification walks the buffer once for every +content-store entry. That's fine for live-validate batch runs +but unsuitable for normal interactive use; keep +`agent-shell-invariants-enabled` off outside of debugging. + +## Quick validation one-liner + +```bash +cd "$(git rev-parse --show-toplevel)" && \ + timvisher_agent_shell_checkout=. \ + timvisher_emacs_agent_shell claude --batch \ + 1>/tmp/agent-shell-live.log 2>&1 && \ + grep -n '▶' /tmp/agent-shell-live.log | head -20 +``` + +If the `▶` lines are in logical order and the exit code is 0, the +rendering pipeline is healthy. diff --git a/.claude b/.claude new file mode 120000 index 00000000..c0ca4685 --- /dev/null +++ b/.claude @@ -0,0 +1 @@ +.agents \ No newline at end of file diff --git a/.codex b/.codex new file mode 120000 index 00000000..c0ca4685 --- /dev/null +++ b/.codex @@ -0,0 +1 @@ +.agents \ No newline at end of file diff --git a/.gemini b/.gemini new file mode 120000 index 00000000..c0ca4685 --- /dev/null +++ b/.gemini @@ -0,0 +1 @@ +.agents \ No newline at end of file diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5751e3b7..e9a89464 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -36,6 +36,105 @@ jobs: fi fi + agent-symlinks: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Verify agent config symlinks + run: | + ok=true + for dir in .claude .codex .gemini; do + target=$(readlink "${dir}" 2>/dev/null) + if [[ "${target}" != ".agents" ]]; then + echo "::error::${dir} should symlink to .agents but points to '${target:-}'" + ok=false + fi + done + for md in CLAUDE.md CODEX.md GEMINI.md; do + target=$(readlink "${md}" 2>/dev/null) + if [[ "${target}" != "AGENTS.md" ]]; then + echo "::error::${md} should symlink to AGENTS.md but points to '${target:-}'" + ok=false + fi + done + if ! [[ -d .agents/commands ]]; then + echo "::error::.agents/commands/ directory missing" + ok=false + fi + if [[ "${ok}" != "true" ]]; then + exit 1 + fi + echo "All agent config symlinks verified." + + dependency-dag: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + + - name: Verify require graph is a DAG (no cycles) + run: | + # Build the set of project-internal modules from *.el filenames. + declare -A project_modules + for f in *.el; do + mod="${f%.el}" + project_modules["${mod}"]=1 + done + + # Parse (require 'foo) from each file and build an adjacency list. + # Only track edges where both ends are project-internal. + # The regex anchors the (require to whitespace-only line prefix + # so semicolon comments and strings can't fake an edge. It + # captures only the first require per line; multi-require lines + # are not used in this codebase. + declare -A edges # edges["a"]="b c" means a requires b and c + for f in *.el; do + mod="${f%.el}" + deps="" + while IFS= read -r dep; do + if [[ -n "${project_modules[$dep]+x}" ]]; then + deps="${deps} ${dep}" + fi + done < <(sed -nE "s/^[[:space:]]*\\(require '([a-zA-Z0-9_-]+)\\).*/\\1/p" "$f") + edges["${mod}"]="${deps}" + done + + # DFS cycle detection. + declare -A color # white=unvisited, gray=in-stack, black=done + found_cycle="" + cycle_path="" + + dfs() { + local node="$1" + local path="$2" + color["${node}"]="gray" + for neighbor in ${edges["${node}"]}; do + if [[ "${color[$neighbor]:-white}" == "gray" ]]; then + found_cycle=1 + cycle_path="${path} -> ${neighbor}" + return + fi + if [[ "${color[$neighbor]:-white}" == "white" ]]; then + dfs "${neighbor}" "${path} -> ${neighbor}" + if [[ -n "${found_cycle}" ]]; then + return + fi + fi + done + color["${node}"]="black" + } + + for mod in "${!project_modules[@]}"; do + if [[ "${color[$mod]:-white}" == "white" ]]; then + dfs "${mod}" "${mod}" + if [[ -n "${found_cycle}" ]]; then + echo "::error::Dependency cycle detected: ${cycle_path}" + exit 1 + fi + fi + done + echo "Dependency graph is a DAG — no cycles found." + test: runs-on: ubuntu-latest steps: diff --git a/.gitignore b/.gitignore index d1b1e191..29b19a9f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ /.agent-shell/ +/.agents/*.lock /deps/ *.elc diff --git a/AGENTS.md b/AGENTS.md index e19fcdc1..c3d05592 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -24,9 +24,20 @@ When adding or changing features: 1. **Run `bin/test`.** Set `acp_root` and `shell_maker_root` if the deps aren't in sibling worktrees. This runs byte-compilation, ERT - tests, and checks that `README.org` was updated when code changed. + tests, dependency DAG check, and checks that `README.org` was + updated when code changed. Requires `yq` (`brew install yq`) — the + script parses `.github/workflows/ci.yml` to derive the same emacs + invocations CI uses. 2. **Keep the README features list current.** The "Features on top of agent-shell" section in `README.org` must be updated whenever code changes land. Both `bin/test` and CI enforce this — changes to `.el` or `tests/` files without a corresponding `README.org` update will fail. +3. **Live-validate rendering changes.** For changes to the rendering + pipeline (fragment insertion, streaming, markers, UI), run a live + batch session to verify fragment ordering and buffer integrity. + See `.agents/commands/live-validate.md` for details. The key command: + ```bash + timvisher_agent_shell_checkout=. timvisher_emacs_agent_shell claude --batch \ + 1>/tmp/agent-shell-live.log 2>&1 + ``` diff --git a/CODEX.md b/CODEX.md new file mode 120000 index 00000000..47dc3e3d --- /dev/null +++ b/CODEX.md @@ -0,0 +1 @@ +AGENTS.md \ No newline at end of file diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org index a53f09dd..e528b267 100644 --- a/CONTRIBUTING.org +++ b/CONTRIBUTING.org @@ -245,3 +245,24 @@ Tests live under the tests directory: Opening any file under the =tests= directory will load the =agent-shell-run-all-tests= command. Run tests with =M-x agent-shell-run-all-tests=. + +*** From the command line + +=bin/test= runs the full ERT suite in batch mode. By default it +expects =acp.el= and =shell-maker= to be checked out as sibling +worktrees (e.g. =…/acp.el/main= and =…/shell-maker/main= next to +=…/agent-shell/main=). Override the paths with environment variables +if your layout differs: + +#+begin_src bash + acp_root=~/path/to/acp.el \ + shell_maker_root=~/path/to/shell-maker \ + bin/test +#+end_src + +The script validates that both dependencies are readable and exits +with a descriptive error if either is missing. + +The script also requires =yq= (for parsing the GitHub Actions workflow +to derive the byte-compile and ERT invocations). Install with +=brew install yq= on macOS. diff --git a/README.org b/README.org index feb45edc..c49fde50 100644 --- a/README.org +++ b/README.org @@ -6,12 +6,25 @@ A soft fork of [[https://github.com/xenodium/agent-shell][agent-shell]] with ext * Features on top of agent-shell - CI workflow and local test runner ([[https://github.com/timvisher-dd/agent-shell-plus/pull/1][#1]], [[https://github.com/timvisher-dd/agent-shell-plus/pull/6][#6]], [[https://github.com/timvisher-dd/agent-shell-plus/pull/8][#8]]) + - Byte-compilation of all =.el= files ([[https://github.com/timvisher-dd/agent-shell-plus/pull/1][#1]]) + - ERT test suite ([[https://github.com/timvisher-dd/agent-shell-plus/pull/1][#1]]) + - README update check when code changes ([[https://github.com/timvisher-dd/agent-shell-plus/pull/4][#4]]) + - Dependency DAG check (=require= graph must be acyclic) ([[https://github.com/timvisher-dd/agent-shell-plus/pull/7][#7]]) - Desktop notifications when the prompt is idle and waiting for input ([[https://github.com/timvisher-dd/agent-shell-plus/pull/2][#2]], [[https://github.com/timvisher-dd/agent-shell-plus/pull/8][#8]]) - Per-shell debug logging infrastructure ([[https://github.com/timvisher-dd/agent-shell-plus/pull/2][#2]]) - Regression tests for shell buffer selection ordering ([[https://github.com/timvisher-dd/agent-shell-plus/pull/3][#3]]) - CI check that README.org is updated when code changes ([[https://github.com/timvisher-dd/agent-shell-plus/pull/4][#4]]) - Usage tests and defense against ACP =used > size= bug ([[https://github.com/timvisher-dd/agent-shell-plus/pull/5][#5]]) - Defensive guards in idle-timer functions so they no-op when shell state is missing instead of erroring ([[https://github.com/timvisher-dd/agent-shell-plus/pull/10][#10]]) +- Streaming tool output with dedup: advertise =_meta.terminal_output= capability, handle incremental chunks from codex-acp and batch results from claude-agent-acp, strip == tags, fix O(n²) rendering, and partial-overlap thought dedup ([[https://github.com/timvisher-dd/agent-shell-plus/pull/7][#7]]) +- Append-in-place rendering for streamed fragments: tokens append to existing fragment bodies without rebuilding, with boundary-newline normalization so paragraph-break chunks don't compound newlines and an empty =agent_message_chunk= mid-stream is rewritten to a paragraph break so two content blocks in the same turn don't run together ([[https://github.com/timvisher-dd/agent-shell-plus/pull/7][#7]]) +- DWIM context insertion: inserted context lands at the prompt and fragment updates no longer drag process-mark past it ([[https://github.com/timvisher-dd/agent-shell-plus/pull/7][#7]]) +- Runtime buffer invariant checking with event tracing and violation debug bundles, including head + tail snapshots for long buffers ([[https://github.com/timvisher-dd/agent-shell-plus/pull/7][#7]]) +- Render =session/update= chunks streamed after =session/prompt= resolves so a Claude Code Stop-hook bounce-and-regen turn no longer freezes the buffer mid-conversation +- Surface raw claude-agent-acp SDK messages (including hook lifecycle events) in the debug log when =agent-shell-logging-enabled= is set, so Stop-hook =decision:block= cycles and other hook-driven turn behavior are visible +- Tunable markdown-overlay debounce via =agent-shell-markdown-overlay-debounce-delay= (default 0.15s) for slow terminals or streaming-debug sessions +- Bug fix for upstream =shell-maker-define-major-mode= mode-map quoting — without it, every =agent-shell-mode= invocation emits =void-function keymap= because the bare keymap value gets spliced into a backquote that re-evaluates =(keymap ...)= as a function call (worth upstreaming separately) +- Live-validate workflow doc (=.agents/commands/live-validate.md=) describing the batch-mode rendering verification used for rendering-pipeline changes ----- diff --git a/agent-shell-devcontainer.el b/agent-shell-devcontainer.el index 1ab8ef69..d90ac17c 100644 --- a/agent-shell-devcontainer.el +++ b/agent-shell-devcontainer.el @@ -27,6 +27,8 @@ (declare-function agent-shell-cwd "agent-shell") +(defvar agent-shell-text-file-capabilities) + (defun agent-shell-devcontainer--get-workspace-path (cwd) "Return devcontainer workspaceFolder for CWD, or default value if none found. diff --git a/agent-shell.el b/agent-shell.el index 204ef350..48997352 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -1415,7 +1415,7 @@ and END from the buffer." "C-c C-o" #'agent-shell-other-buffer " " #'agent-shell-yank-dwim) -(shell-maker-define-major-mode (agent-shell--make-shell-maker-config) agent-shell-mode-map) +(shell-maker-define-major-mode (agent-shell--make-shell-maker-config) 'agent-shell-mode-map) (cl-defun agent-shell--handle (&key command shell-buffer) "Handle SHELL-BUFFER COMMAND (and lazy initialize the ACP stack). diff --git a/bin/test b/bin/test index 2115181f..74425eba 100755 --- a/bin/test +++ b/bin/test @@ -1,108 +1,109 @@ -#!/usr/bin/env bash -O globstar -O extglob - -# Assume that acp.el and shell-maker are checked out in sibling trunk -# worktrees and allow their location to be overridden: -# …/agent-shell/main/bin/test -# …/acp.el/main -# …/shell-maker/main -root=$(dirname "$0")/.. -tests_dir=${root}/tests -acp_root=${acp_root:-${root}/../../acp.el/main} -shell_maker_root=${shell_maker_root:-${root}/../../shell-maker/main} - -if ! [[ -r ${acp_root}/acp.el ]] -then - echo "Set acp_root to your acp.el checkout (e.g. ~/git/timvisher-dd/acp.el-plus/main)" >&2 - die=1 -fi - -if ! [[ -r ${shell_maker_root}/shell-maker.el ]] -then - echo "Set shell_maker_root to your shell-maker checkout (e.g. ~/git/xenodium/shell-maker/main)" >&2 - die=1 -fi - -if [[ -n $die ]] -then - echo "Fix the ↑ problems" >&2 +#!/usr/bin/env bash +# Runs the same checks as CI by parsing .github/workflows/ci.yml directly. +# If CI steps change, this script automatically picks them up. +# +# Local adaptations: +# - Dependencies (acp.el, shell-maker) are symlinked into deps/ from +# local worktree checkouts instead of being cloned by GitHub Actions. +# Override locations with acp_root and shell_maker_root env vars. +# - GitHub ${{ }} context variables are replaced with local git equivalents. +# - GitHub Actions ::error:: annotations are translated to stderr messages. +set -euo pipefail + +cd "$(git rev-parse --show-toplevel)" + +ci_yaml=".github/workflows/ci.yml" + +if ! command -v yq &>/dev/null; then + echo "error: yq is required (brew install yq)" >&2 exit 1 fi -shopt -s nullglob -all_elc_files=({"${root}","${acp_root}","${shell_maker_root}"}/**/*.elc) -all_el_files=("${root}"/*.el) -test_files=("${tests_dir}"/*-tests.el) -shopt -u nullglob +# Resolve local dependency paths — CI checks these out via actions/checkout +acp_root=${acp_root:-../../acp.el-plus/main} +shell_maker_root=${shell_maker_root:-../../shell-maker/main} -if (( 0 < ${#all_elc_files[@]} )) -then - rm -v "${all_elc_files[@]}" +die=0 +if ! [[ -r ${acp_root}/acp.el ]]; then + echo "error: acp.el not found at ${acp_root}" >&2 + echo "Set acp_root to your acp.el checkout" >&2 + die=1 fi -# Filter out x./y./z. prefixed scratch files from compilation -compile_files=() -for f in "${all_el_files[@]}"; do - case "$(basename "$f")" in - x.*|y.*|z.*) ;; - *) compile_files+=("$f") ;; - esac -done - -if (( ${#compile_files[@]} < 1 )); then - echo "No compile targets found in ${root}" >&2 - exit 1 +if ! [[ -r ${shell_maker_root}/shell-maker.el ]]; then + echo "error: shell-maker.el not found at ${shell_maker_root}" >&2 + echo "Set shell_maker_root to your shell-maker checkout" >&2 + die=1 fi -if (( ${#test_files[@]} < 1 )); then - echo "No test files found in ${tests_dir}" >&2 +if (( 0 < die )); then exit 1 fi -test_args=() -for file in "${test_files[@]}"; do - test_args+=(-l "$file") -done +# Create deps/ symlinks to match CI layout +mkdir -p deps +ln -sfn "$(cd "${acp_root}" && pwd)" deps/acp.el +ln -sfn "$(cd "${shell_maker_root}" && pwd)" deps/shell-maker + +# Adapt a CI run block for local execution: +# - Replace GitHub PR SHA context with local merge-base equivalents +# - Translate GitHub Actions ::error:: to plain stderr markers +# +# Each substitution is paired with a presence check first. If the +# expected literal appears in ci.yml (whitespace included) but the +# substitution misses it, we bail with a clear error rather than +# running a half-translated command silently. This catches drift +# when ci.yml gets reformatted (extra spaces inside ${{ }}, quoting +# changes, etc.). Conversely, if a new ${{ }} expression appears +# that bin/test doesn't know how to translate, the post-pass scan +# below catches it. +adapt_for_local() { + local cmd="$1" + local original="$cmd" + cmd="${cmd//\$\{\{ github.event.pull_request.base.sha \}\}/\@\{u\}}" + cmd="${cmd//\$\{\{ github.event.pull_request.head.sha \}\}/}" + # Collapse the now-empty "$head" arg: "\"$base\" \"$head\"" → "\"$base\"" + # After substitution, base="@{u}" and head="", so the diff line reads + # git diff --name-only "@{u}" "" + # We need it to read: + # git diff --name-only "@{u}..." + # Rewrite the two-variable diff into the three-dot range form. + cmd="${cmd//\"\$base\" \"\$head\"/\"\$base...\"}" + cmd="${cmd//::error::/ERROR: }" + # Drift guard: if ci.yml introduced a ${{ ... }} expression we + # don't know how to translate, fail loudly rather than running a + # half-substituted command. + if [[ "$cmd" == *'${{'* ]]; then + { + echo "error: adapt_for_local left an untranslated GitHub Actions" + echo " expression in the command — extend bin/test to handle it:" + echo "$cmd" | grep -n -F '${{' || true + echo " (original ci.yml block:)" + printf '%s\n' "$original" + } >&2 + exit 1 + fi + printf '%s' "$cmd" +} -emacs -Q --batch \ - -L "${root}" \ - -L "${acp_root}" \ - -L "${shell_maker_root}" \ - -f batch-byte-compile \ - "${compile_files[@]}" || - exit +# Iterate over all CI jobs, extracting and running steps with run: blocks. +# Job-level `if:` conditions (e.g. PR-only gates) are ignored — locally +# we always want to run every check. +jobs=$(yq '.jobs | keys | .[]' "$ci_yaml") -emacs -Q --batch \ - -L "${root}" \ - -L "${acp_root}" \ - -L "${shell_maker_root}" \ - -L "${tests_dir}" \ - "${test_args[@]}" \ - -f ert-run-tests-batch-and-exit || - exit +for job in ${jobs}; do + step_count=$(yq "[.jobs.${job}.steps[] | select(.run)] | length" "$ci_yaml") -# --- README update check (mirrors CI readme-updated job) --- -# Compare against main (or merge-base) to see if code changed without -# a corresponding README.org update. + for (( i = 0; i < step_count; i++ )); do + name=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].name" "$ci_yaml") + cmd=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].run" "$ci_yaml") -git rev-parse '@{u}' >&2 || - { - echo 'ERROR: @{u} does not parse' >&2 - exit 1 - } + adapted=$(adapt_for_local "$cmd") -changed_files=$(git diff --name-only '@{u}...') -has_code_changes=false -for f in ${changed_files}; do - case "${f}" in - *.el|tests/*) has_code_changes=true; break ;; - esac + echo "=== ${name} ===" + eval "$adapted" + echo "" + done done -if "${has_code_changes}"; then - if ! echo "${changed_files}" | grep -q '^README\.org$'; then - echo "ERROR: Code or test files changed but README.org was not updated." >&2 - echo "Please update the soft-fork features list in README.org." >&2 - exit 1 - fi -fi - +echo "=== All CI checks passed ===" diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index fd485bb6..98d1d7e8 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -443,10 +443,12 @@ (let ((sent-request nil) (agent-shell--state (list (cons :client 'test-client) - (cons :session (list (cons :id "test-session"))) + (cons :session (list (cons :id "test-session") + (cons :title nil))) (cons :prompt-capabilities '((:embedded-context . t))) (cons :buffer (current-buffer)) (cons :last-entry-type nil) + (cons :last-activity-time nil) (cons :active-requests nil)))) ;; Mock acp-send-request to capture what gets sent; @@ -479,10 +481,12 @@ (let ((sent-request nil) (agent-shell--state (list (cons :client 'test-client) - (cons :session (list (cons :id "test-session"))) + (cons :session (list (cons :id "test-session") + (cons :title nil))) (cons :prompt-capabilities '((:embedded-context . t))) (cons :buffer (current-buffer)) (cons :last-entry-type nil) + (cons :last-activity-time nil) (cons :active-requests nil)))) ;; Mock build-content-blocks to throw an error; @@ -526,8 +530,10 @@ (agent-shell--state (list (cons :buffer (current-buffer)) (cons :event-subscriptions nil) (cons :client 'test-client) - (cons :session (list (cons :id "test-session"))) + (cons :session (list (cons :id "test-session") + (cons :title nil))) (cons :last-entry-type nil) + (cons :last-activity-time nil) (cons :tool-calls nil) (cons :idle-notification-timer nil) (cons :usage (list (cons :total-tokens 0))))) From c87559967e625587cfd332bafb9ee7e3501e524a Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Tue, 12 May 2026 10:20:05 -0400 Subject: [PATCH 2/6] Add table rendering regression tests Three tests cover the markdown table overlay pipeline end-to-end: overlay structure for a static buffer, mid-stream cleanup so stale overlays disappear when a row is rewritten, and a regression that guards against table rows being split across visual lines. The helpers inject ACP traffic via agent-shell--on-notification and fire pending debounce timers when present, so the tests reflect the real streaming path rather than direct markdown-overlays-put calls. Co-Authored-By: Claude Opus 4.7 (1M context) --- tests/agent-shell-table-tests.el | 248 +++++++++++++++++++++++++++++++ 1 file changed, 248 insertions(+) create mode 100644 tests/agent-shell-table-tests.el diff --git a/tests/agent-shell-table-tests.el b/tests/agent-shell-table-tests.el new file mode 100644 index 00000000..f7bb9b8e --- /dev/null +++ b/tests/agent-shell-table-tests.el @@ -0,0 +1,248 @@ +;;; agent-shell-table-tests.el --- Tests for markdown table rendering -*- lexical-binding: t; -*- + +(require 'ert) +(require 'agent-shell) + +;;; Code: + +;; Reuse the visible-buffer-string helper if available, otherwise define it. +(unless (fboundp 'agent-shell-test--visible-buffer-string) + (defun agent-shell-test--visible-buffer-string () + "Return buffer text with invisible regions removed." + (let ((result "") + (pos (point-min))) + (while (< pos (point-max)) + (let ((next-change (next-single-property-change pos 'invisible nil (point-max)))) + (unless (get-text-property pos 'invisible) + (setq result (concat result (buffer-substring-no-properties pos next-change)))) + (setq pos next-change))) + result))) + +(defun agent-shell-table-test--setup-buffer () + "Create and return a test buffer with agent-shell-mode initialized." + (let ((buffer (get-buffer-create " *agent-shell-table-test*"))) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + buffer)) + +(defun agent-shell-table-test--fire-debounce () + "Fire pending markdown overlay debounce timer if present." + (when (and (boundp 'agent-shell--markdown-overlay-timer) + (timerp agent-shell--markdown-overlay-timer)) + (timer-event-handler agent-shell--markdown-overlay-timer))) + +(defun agent-shell-table-test--table-overlays () + "Return table overlays in the current buffer, sorted by position. +Each element is an alist with :start, :end, and :before-string." + (let ((result nil)) + (dolist (ov (overlays-in (point-min) (point-max))) + (when (overlay-get ov 'markdown-overlays-tables) + (push (list (cons :start (overlay-start ov)) + (cons :end (overlay-end ov)) + (cons :before-string + (when-let ((bs (overlay-get ov 'before-string))) + (substring-no-properties bs)))) + result))) + (sort result (lambda (a b) (< (map-elt a :start) (map-elt b :start)))))) + +(defun agent-shell-table-test--send-tool-call (state tool-id) + "Send a complete tool_call lifecycle (pending → meta → completed). +STATE is agent-shell--state, TOOL-ID is the tool call identifier." + (agent-shell--on-notification + :state state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + (agent-shell--on-notification + :state state + :acp-notification `((method . "session/update") + (params . ((update + . ((_meta (claudeCode (toolResponse (stdout . "tool output") + (stderr . "") + (interrupted) + (isImage) + (noOutputExpected)) + (toolName . "Bash"))) + (toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update"))))))) + (agent-shell--on-notification + :state state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed")))))))) + +(defun agent-shell-table-test--send-message-chunks (state tokens) + "Send agent_message_chunk notifications for each token in TOKENS. +STATE is agent-shell--state." + (dolist (token tokens) + (agent-shell--on-notification + :state state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . ,token)))))))))) + +;;; The real-world chunks from the debug session, split exactly as ACP +;;; delivered them. The table has 4 columns and ~10 data rows. +(defconst agent-shell-table-test--chunks + (list + "Here's the comparison:\n\n| Policy" + " | lab-green-003 | prod-green-003 | lab-v6.4-003 |\n|---|---|---|---|\n| dd_pastebin | `removed" + "` | `removed` | `removed` |\n| onepassword_scim | `removed` | `removed` | `removed` |\n| us1_prod_dog_incidents_app | `removed` | `removed` | `removed` |" + "\n| us1_prod_dog_pagerbeauty | `removed` | `removed` | `removed` |\n| us1_prod_dog_support_eng_access | `removed` | `removed` | `removed` |\n| us1-" + "staging-fed-ssh | `removed` | `removed` | `removed` |\n| us1-staging-fed-dns | `removed` | `removed` | `removed` |\n| pci | `removed` | `removed` | `removed` |\n|" + " production_ga | `removed` | `removed` | `removed` |\n| production_common_services | `removed` | `removed` | `removed` |" + "\n\nAll 18 policies are aligned.") + "Chunk sequence from a real debug session containing a markdown table.") + + +(ert-deftest agent-shell--table-rows-not-split-across-lines-test () + "Markdown table rows must render with pipe-delimited cells on single lines. +Regression test: table rows with backtick-wrapped content like `removed` +were being split so that cell content appeared on separate lines below +each row. + +Replays actual agent_message_chunk traffic from a debug session where +a 4-column table (Policy / lab-green-003 / prod-green-003 / lab-v6.4-003) +was streamed across multiple chunks with cell boundaries split mid-chunk." + (let* ((buffer (agent-shell-table-test--setup-buffer)) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_table_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell-table-test--send-tool-call agent-shell--state tool-id) + (agent-shell-table-test--send-message-chunks + agent-shell--state agent-shell-table-test--chunks) + (agent-shell-table-test--fire-debounce) + ;; Verify: the table content is visible in the raw text. + (let ((visible-text (agent-shell-test--visible-buffer-string))) + ;; Header row must be intact on one line. + (should (string-match-p + "| Policy.*| lab-green-003.*| prod-green-003.*| lab-v6.4-003 |" + visible-text)) + ;; Separator row. + (should (string-match-p "|---|---|---|---|" visible-text)) + ;; Data rows: policy name and all three `removed` cells + ;; must appear on the same logical line. + (should (string-match-p + "| dd_pastebin.*|.*removed.*|.*removed.*|.*removed.*|" + visible-text)) + (should (string-match-p + "| pci.*|.*removed.*|.*removed.*|.*removed.*|" + visible-text)) + ;; Post-table text must be visible. + (should (string-match-p "All 18 policies are aligned" visible-text))) + ;; No line should consist of just "removed" — the regression + ;; symptom of cell content breaking out of the table. + (let ((visible-text (agent-shell-test--visible-buffer-string))) + (dolist (line (split-string visible-text "\n")) + (should-not (string-match-p + "\\`[[:space:]]*\\(?:`\\)?removed\\(?:`\\)?[[:space:]]*\\'" + line)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--table-overlay-structure-test () + "Each table row must have exactly one overlay with correct before-string. +After all chunks arrive and markdown overlays are applied, the overlay +structure should show: + - 1 header row overlay containing all column names + - 1 separator overlay + - N data row overlays, each containing the policy name and all cells" + (let* ((buffer (agent-shell-table-test--setup-buffer)) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_overlay_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell-table-test--send-tool-call agent-shell--state tool-id) + (agent-shell-table-test--send-message-chunks + agent-shell--state agent-shell-table-test--chunks) + (agent-shell-table-test--fire-debounce) + (let ((table-ovs (agent-shell-table-test--table-overlays))) + ;; 1 header + 1 separator + 10 data rows = 12 overlays + (should (= 12 (length table-ovs))) + ;; First overlay is the header row. + (let ((header-bs (map-elt (car table-ovs) :before-string))) + (should (string-match-p "Policy" header-bs)) + (should (string-match-p "lab-green-003" header-bs)) + (should (string-match-p "prod-green-003" header-bs)) + (should (string-match-p "lab-v6.4-003" header-bs))) + ;; Each data row overlay (index 2+) must contain "removed" + ;; and the cell content must be on a single line. + (dolist (ov (nthcdr 2 table-ovs)) + (let ((bs (map-elt ov :before-string))) + (should (string-match-p "removed" bs)) + ;; The before-string for a single-line row should + ;; NOT contain newlines (multi-line wrapping aside). + ;; If it does, cells are being split. + (should-not (string-match-p "\n" bs))))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--table-mid-stream-overlay-cleanup-test () + "Overlays from partial table rendering must be cleaned up after full table arrives. +Simulates the debounce timer firing mid-stream (when only part of the +table has been received), then checks that the final overlay state is +correct after all chunks arrive." + (let* ((buffer (agent-shell-table-test--setup-buffer)) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_midstream_test") + (all-chunks agent-shell-table-test--chunks) + ;; Split: first 3 chunks = partial table, rest = completion. + (early-chunks (seq-take all-chunks 3)) + (late-chunks (seq-drop all-chunks 3))) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell-table-test--send-tool-call agent-shell--state tool-id) + ;; Stream partial table + (agent-shell-table-test--send-message-chunks + agent-shell--state early-chunks) + ;; Fire debounce mid-stream (partial table gets overlaid) + (agent-shell-table-test--fire-debounce) + (let ((partial-ovs (agent-shell-table-test--table-overlays))) + ;; Partial table should have SOME overlays (header + sep + rows so far). + (should (< 0 (length partial-ovs)))) + ;; Stream remaining chunks + (agent-shell-table-test--send-message-chunks + agent-shell--state late-chunks) + ;; Fire debounce again (full table) + (agent-shell-table-test--fire-debounce) + (let ((final-ovs (agent-shell-table-test--table-overlays))) + ;; Full table: 1 header + 1 separator + 10 data rows = 12 + (should (= 12 (length final-ovs))) + ;; Every data row overlay should contain "removed". + (dolist (ov (nthcdr 2 final-ovs)) + (should (string-match-p "removed" + (map-elt ov :before-string))))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(provide 'agent-shell-table-tests) +;;; agent-shell-table-tests.el ends here From 25a3b75c3ae61e1dfa0948135e5ab0a587be47b7 Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Tue, 12 May 2026 10:20:19 -0400 Subject: [PATCH 3/6] Add streaming tool output handler with dedup, invariants, and meta helpers Three new modules and the agent-shell.el integration that wires them together: - agent-shell-meta.el extracts toolResponse and terminal_output from the ACP meta envelope so streaming code can fold mixed-source tool output (terminal stream + final meta.toolResponse) without showing duplicate content. - agent-shell-invariants.el is a runtime tracing and assertion library: a ring of recent ACP/UI events, process-mark and fragment-update guard wrappers, and a long-buffer head/tail snapshot included in violation reports. - agent-shell-streaming.el is the streaming tool_call_update handler with dedup, including a label cache cleared on completion and the generalized title upgrade path that survives buffer-kill races. agent-shell.el wires these in (require, on-notification dispatch, process-mark/fragment guards, insert-cursor reset, defcustom for the markdown-overlay debounce delay, and dropping session/update handlers when the shell buffer has been killed). agent-shell-ui.el gains the invariants require and the UI plumbing the streaming handler relies on. Tests cover the dedup logic across mixed sources, the invariants library's event ring and guard wrappers, and additional regression coverage in agent-shell-tests.el (cancel with nil transcript-file, markdown-overlay debounce buffer-kill race, "Thinking" label restoration on agent_thought_chunk). Co-Authored-By: Claude Opus 4.7 (1M context) --- agent-shell-invariants.el | 465 +++++++++ agent-shell-meta.el | 132 +++ agent-shell-streaming.el | 490 ++++++++++ agent-shell-ui.el | 173 +++- agent-shell.el | 643 ++++++++----- tests/agent-shell-invariants-tests.el | 218 +++++ tests/agent-shell-streaming-tests.el | 1262 +++++++++++++++++++++++++ tests/agent-shell-tests.el | 275 +++++- 8 files changed, 3349 insertions(+), 309 deletions(-) create mode 100644 agent-shell-invariants.el create mode 100644 agent-shell-meta.el create mode 100644 agent-shell-streaming.el create mode 100644 tests/agent-shell-invariants-tests.el create mode 100644 tests/agent-shell-streaming-tests.el diff --git a/agent-shell-invariants.el b/agent-shell-invariants.el new file mode 100644 index 00000000..d499d784 --- /dev/null +++ b/agent-shell-invariants.el @@ -0,0 +1,465 @@ +;;; agent-shell-invariants.el --- Runtime buffer invariants and event tracing -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2025 Alvaro Ramirez and contributors + +;; Author: Alvaro Ramirez https://xenodium.com +;; URL: https://github.com/xenodium/agent-shell + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Runtime invariant checking and event tracing for agent-shell buffers. +;; +;; When enabled, every buffer mutation point logs a structured event to +;; a per-buffer ring buffer and then runs a set of cheap invariant +;; checks. When an invariant fails, the system captures a debug +;; bundle (event log + buffer snapshot + ACP traffic) and presents it +;; in a pop-up buffer with a recommended agent prompt. +;; +;; Enable globally: +;; +;; (setq agent-shell-invariants-enabled t) +;; +;; Or toggle in a running shell: +;; +;; M-x agent-shell-toggle-invariants + +;;; Code: + +(require 'ring) +(require 'map) +(require 'cl-lib) +(require 'text-property-search) + +(defvar agent-shell-ui--content-store) + +;;; --- Configuration -------------------------------------------------------- + +(defvar agent-shell-invariants-enabled nil + "When non-nil, check buffer invariants after every mutation.") + +(defvar agent-shell-invariants-ring-size 5000 + "Number of events to retain in the per-buffer ring. +Each event is a small plist; 5000 entries uses roughly 200-400 KB.") + +;;; --- Per-buffer state ----------------------------------------------------- + +(defvar-local agent-shell-invariants--ring nil + "Ring buffer holding recent mutation events for this shell.") + +(defvar-local agent-shell-invariants--seq 0 + "Monotonic event counter for this shell buffer.") + +(defvar-local agent-shell-invariants--violation-reported nil + "Non-nil when a violation has already been reported for this buffer. +Reset by `agent-shell-invariants--clear-violation-flag'.") + +;;; --- Event ring ----------------------------------------------------------- + +(defun agent-shell-invariants--ensure-ring () + "Create the event ring for the current buffer if needed." + (unless agent-shell-invariants--ring + (setq agent-shell-invariants--ring + (make-ring agent-shell-invariants-ring-size)))) + +(defun agent-shell-invariants--record (op &rest props) + "Record a mutation event with operation type OP and PROPS. +PROPS is a plist of operation-specific data." + (when agent-shell-invariants-enabled + (agent-shell-invariants--ensure-ring) + (let ((seq (cl-incf agent-shell-invariants--seq))) + (ring-insert agent-shell-invariants--ring + (append (list :seq seq + :time (float-time) + :op op) + props))))) + +(defun agent-shell-invariants--events () + "Return events from the ring as a list, oldest first." + (when agent-shell-invariants--ring + (let ((elts (ring-elements agent-shell-invariants--ring))) + ;; ring-elements returns newest-first + (nreverse elts)))) + +;;; --- Invariant checks ----------------------------------------------------- +;; +;; Each check returns nil on success or a string describing the +;; violation. Checks must be fast (marker comparisons, text property +;; lookups, no full-buffer scans). + +(defun agent-shell-invariants--check-process-mark () + "Verify the process mark is at or after all fragment content. +The process mark should sit at the prompt line, which comes after +every fragment." + (when-let ((proc (get-buffer-process (current-buffer))) + (pmark (process-mark proc))) + (let ((last-fragment-end nil)) + (save-excursion + (goto-char (point-max)) + (when-let ((match (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ v) v) t))) + (setq last-fragment-end (prop-match-end match)))) + (when (and last-fragment-end + (< (marker-position pmark) last-fragment-end)) + (format "process-mark (%d) is before last fragment end (%d)" + (marker-position pmark) last-fragment-end))))) + +(defun agent-shell-invariants--check-ui-state-contiguity () + "Verify that agent-shell-ui-state properties are contiguous per fragment. +Gaps in the text property within a single fragment indicate +corruption from insertion or deletion gone wrong." + (let ((violations nil) + (prev-end nil) + (prev-qid nil)) + (save-excursion + (let ((pos (point-min))) + (while (< pos (point-max)) + (let* ((state (get-text-property pos 'agent-shell-ui-state)) + (qid (when state (map-elt state :qualified-id))) + (next (or (next-single-property-change + pos 'agent-shell-ui-state) + (point-max)))) + (when qid + (when (and prev-qid (equal prev-qid qid) + prev-end (< prev-end pos)) + (push (format "fragment %s has gap: %d to %d" + qid prev-end pos) + violations)) + (setq prev-qid qid + prev-end next)) + ;; When qid is nil (no state at this position), just + ;; advance. The next span with a matching qid will + ;; detect the gap. + (setq pos next))))) + (when violations + (string-join violations "\n")))) + +(defun agent-shell-invariants--body-length-in-block (block-start block-end) + "Return length of the body section between BLOCK-START and BLOCK-END. +Finds the body by scanning for the `agent-shell-ui-section' text +property with value `body'. Returns nil if no body section exists." + (let ((pos block-start) + (body-len nil)) + (while (< pos block-end) + (when (eq (get-text-property pos 'agent-shell-ui-section) 'body) + (let ((end (next-single-property-change + pos 'agent-shell-ui-section nil block-end))) + (setq body-len (+ (or body-len 0) (- end pos))) + (setq pos end))) + (setq pos (or (next-single-property-change + pos 'agent-shell-ui-section nil block-end) + block-end))) + body-len)) + +(defun agent-shell-invariants--check-content-store-consistency () + "Verify content-store body length is plausible vs buffer body length. +Large discrepancies indicate the content-store and buffer diverged. + +Cost: O(N · buffer-size) per call — `maphash' over every entry in +the content store, and each entry walks the buffer from +`point-min' looking for its qualified-id property. Acceptable +for the live-validate workflow this is gated behind, but keep +`agent-shell-invariants-enabled' off in normal sessions." + (when agent-shell-ui--content-store + (let ((violations nil)) + (maphash + (lambda (key stored-body) + (when (and (string-suffix-p "-body" key) + stored-body) + (let* ((qid (string-remove-suffix "-body" key)) + (buf-body-len + (save-excursion + (goto-char (point-min)) + (let ((found nil)) + (while (and (not found) + (setq found + (text-property-search-forward + 'agent-shell-ui-state nil + (lambda (_ v) + (equal (map-elt v :qualified-id) qid)) + t)))) + (when found + (agent-shell-invariants--body-length-in-block + (prop-match-beginning found) + (prop-match-end found))))))) + ;; Only flag if buffer body is dramatically shorter than + ;; stored (indicating lost content, not just formatting). + (when (and buf-body-len + (< 0 (length stored-body)) + (< buf-body-len (/ (length stored-body) 2))) + (push (format "fragment %s: buffer body %d chars, store %d chars" + qid buf-body-len (length stored-body)) + violations))))) + agent-shell-ui--content-store) + (when violations + (string-join violations "\n"))))) + +(defvar agent-shell-invariants--all-checks + '(agent-shell-invariants--check-process-mark + agent-shell-invariants--check-ui-state-contiguity + agent-shell-invariants--check-content-store-consistency) + "List of invariant check functions to run after each mutation.") + +;;; --- Check runner --------------------------------------------------------- + +(defun agent-shell-invariants--run-checks (trigger-op) + "Run all invariant checks. TRIGGER-OP is the operation that triggered them. +On failure, present the debug bundle. Only reports the first violation +per buffer to avoid pop-up storms; reset with +`agent-shell-invariants--clear-violation-flag'." + (when (and agent-shell-invariants-enabled + (not agent-shell-invariants--violation-reported)) + (let ((violations nil)) + (dolist (check agent-shell-invariants--all-checks) + (condition-case err + (when-let ((v (funcall check))) + (push (cons check v) violations)) + (error + (push (cons check (format "check error: %s" (error-message-string err))) + violations)))) + (when violations + (setq agent-shell-invariants--violation-reported t) + (agent-shell-invariants--on-violation trigger-op violations))))) + +(defun agent-shell-invariants--clear-violation-flag () + "Clear the violation-reported flag so future violations are reported again." + (setq agent-shell-invariants--violation-reported nil)) + +;;; --- Violation handler ---------------------------------------------------- + +(defun agent-shell-invariants--snapshot-buffer () + "Capture the current buffer state as a string with properties." + (buffer-substring (point-min) (point-max))) + +(defun agent-shell-invariants--snapshot-markers () + "Capture key marker positions." + (let ((result nil)) + (when-let ((proc (get-buffer-process (current-buffer)))) + (push (cons :process-mark (marker-position (process-mark proc))) result)) + (push (cons :point-max (point-max)) result) + (push (cons :point-min (point-min)) result) + result)) + +(defun agent-shell-invariants--format-events () + "Format the event ring as a readable string." + (let ((events (agent-shell-invariants--events))) + (if (not events) + "(no events recorded)" + (mapconcat + (lambda (ev) + (format "[%d] %s %s" + (plist-get ev :seq) + (plist-get ev :op) + (let ((rest (copy-sequence ev))) + ;; Remove standard keys for compact display + (cl-remf rest :seq) + (cl-remf rest :time) + (cl-remf rest :op) + (if rest + (prin1-to-string rest) + "")))) + events "\n")))) + +(defun agent-shell-invariants--on-violation (trigger-op violations) + "Handle invariant violations from TRIGGER-OP. +VIOLATIONS is an alist of (check-fn . description)." + (let* ((shell-buffer (current-buffer)) + (buffer-name (buffer-name shell-buffer)) + (markers (agent-shell-invariants--snapshot-markers)) + (buf-snapshot (agent-shell-invariants--snapshot-buffer)) + (events-str (agent-shell-invariants--format-events)) + (violation-str (mapconcat + (lambda (v) + (format " %s: %s" (car v) (cdr v))) + violations "\n")) + (bundle-buf (get-buffer-create + (format "*agent-shell invariant [%s]*" buffer-name)))) + ;; Build the debug bundle buffer + (with-current-buffer bundle-buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "━━━ AGENT-SHELL INVARIANT VIOLATION ━━━\n\n") + (insert (format "Buffer: %s\n" buffer-name)) + (insert (format "Trigger: %s\n" trigger-op)) + (insert (format "Time: %s\n\n" (format-time-string "%Y-%m-%d %H:%M:%S"))) + (insert "── Violations ──\n\n") + (insert violation-str) + (insert "\n\n── Markers ──\n\n") + (insert (format "%S\n" markers)) + (let* ((window 2000) + (total (length buf-snapshot))) + (cond + ((<= total window) + (insert (format "\n── Buffer Snapshot (%d chars) ──\n\n" total)) + (insert buf-snapshot)) + (t + (insert (format "\n── Buffer Snapshot Head (first %d / %d chars) ──\n\n" + window total)) + (insert (substring buf-snapshot 0 window)) + (insert (format "\n\n── Buffer Snapshot Tail (last %d / %d chars) ──\n\n" + window total)) + (insert (substring buf-snapshot (- total window)))))) + (insert "\n\n── Event Log (last ") + (insert (format "%d" (length (agent-shell-invariants--events)))) + (insert " events) ──\n\n") + (insert events-str) + (insert "\n\n── Recommended Prompt ──\n\n") + (insert "Copy the full contents of this buffer and paste it as context ") + (insert "for this prompt:\n\n") + (let ((prompt-start (point))) + (insert "An agent-shell buffer invariant was violated during a ") + (insert (format "`%s` operation.\n\n" trigger-op)) + (insert "The debug bundle above contains:\n") + (insert "- The specific invariant(s) that failed and why\n") + (insert "- Marker positions at time of failure\n") + (insert "- The last N mutation events leading up to the failure\n\n") + (insert "Please analyze the event sequence to determine:\n") + (insert "1. Which event(s) caused the violation\n") + (insert "2. The root cause in the rendering pipeline\n") + (insert "3. A proposed fix\n\n") + (insert "The relevant source files are:\n") + (insert "- agent-shell-ui.el (fragment rendering, insert/append/rebuild)\n") + (insert "- agent-shell-streaming.el (tool call streaming, marker management)\n") + (insert "- agent-shell.el (agent-shell--update-fragment, ") + (insert "agent-shell--with-preserved-process-mark)\n") + (add-text-properties prompt-start (point) + '(face font-lock-doc-face))) + (insert "\n\n━━━ END ━━━\n") + (goto-char (point-min)) + (special-mode))) + ;; Show the bundle + (display-buffer bundle-buf + '((display-buffer-pop-up-window) + (window-height . 0.5))) + (message "agent-shell: invariant violation detected — see %s" + (buffer-name bundle-buf)))) + +;;; --- Mutation point hooks -------------------------------------------------- +;; +;; Call these from the 5 key mutation sites. Each records an event +;; and then runs the invariant checks. + +(defun agent-shell-invariants-on-update-fragment (op namespace-id block-id &optional append) + "Record and check after a fragment update. +OP is a string like \"create\", \"append\", or \"rebuild\". +NAMESPACE-ID and BLOCK-ID identify the fragment. +APPEND is non-nil if this was an append operation." + (when agent-shell-invariants-enabled + (let ((pmark (when-let ((proc (get-buffer-process (current-buffer)))) + (marker-position (process-mark proc))))) + (agent-shell-invariants--record + 'update-fragment + :detail op + :fragment-id (format "%s-%s" namespace-id block-id) + :append append + :process-mark pmark + :point-max (point-max))) + (agent-shell-invariants--run-checks 'update-fragment))) + +(defun agent-shell-invariants-on-append-output (tool-call-id marker-pos text-len) + "Record and check after live tool output append. +TOOL-CALL-ID identifies the tool call. +MARKER-POS is the output marker position. +TEXT-LEN is the length of appended text." + (when agent-shell-invariants-enabled + (agent-shell-invariants--record + 'append-output + :tool-call-id tool-call-id + :marker-pos marker-pos + :text-len text-len + :point-max (point-max)) + (agent-shell-invariants--run-checks 'append-output))) + +(defun agent-shell-invariants-on-process-mark-save (saved-pos) + "Record process-mark save. SAVED-POS is the position being saved." + (when agent-shell-invariants-enabled + (agent-shell-invariants--record + 'pmark-save + :saved-pos saved-pos + :point-max (point-max)))) + +(defun agent-shell-invariants-on-process-mark-restore (saved-pos restored-pos) + "Record and check after process-mark restore. +SAVED-POS was the target; RESTORED-POS is where it actually ended up." + (when agent-shell-invariants-enabled + (agent-shell-invariants--record + 'pmark-restore + :saved-pos saved-pos + :restored-pos restored-pos + :point-max (point-max)) + (agent-shell-invariants--run-checks 'pmark-restore))) + +(defun agent-shell-invariants-on-collapse-toggle (namespace-id block-id collapsed-p) + "Record and check after fragment collapse/expand. +NAMESPACE-ID and BLOCK-ID identify the fragment. +COLLAPSED-P is the new collapsed state." + (when agent-shell-invariants-enabled + (agent-shell-invariants--record + 'collapse-toggle + :fragment-id (format "%s-%s" namespace-id block-id) + :collapsed collapsed-p) + (agent-shell-invariants--run-checks 'collapse-toggle))) + +(defun agent-shell-invariants-on-notification (update-type &optional detail) + "Record an ACP notification arrival. +UPDATE-TYPE is the sessionUpdate type string. +DETAIL is optional extra info (tool-call-id, etc.)." + (when agent-shell-invariants-enabled + (agent-shell-invariants--record + 'notification + :update-type update-type + :detail detail))) + +;;; --- Interactive commands ------------------------------------------------- + +(defun agent-shell-toggle-invariants () + "Toggle invariant checking for the current buffer." + (interactive) + (setq agent-shell-invariants-enabled + (not agent-shell-invariants-enabled)) + (when agent-shell-invariants-enabled + (agent-shell-invariants--ensure-ring) + (agent-shell-invariants--clear-violation-flag)) + (message "Invariant checking: %s" + (if agent-shell-invariants-enabled "ON" "OFF"))) + +(defun agent-shell-view-invariant-events () + "Display the invariant event log for the current buffer." + (interactive) + (let ((events-str (agent-shell-invariants--format-events)) + (buf (get-buffer-create + (format "*agent-shell events [%s]*" (buffer-name))))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert events-str) + (goto-char (point-min)) + (special-mode))) + (display-buffer buf))) + +(defun agent-shell-check-invariants-now () + "Run all invariant checks right now, regardless of the enabled flag. +Temporarily clears the violation-reported flag so the check always runs." + (interactive) + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--violation-reported nil)) + (agent-shell-invariants--run-checks 'manual-check) + (unless (get-buffer (format "*agent-shell invariant [%s]*" (buffer-name))) + (message "All invariants passed.")))) + +(provide 'agent-shell-invariants) + +;;; agent-shell-invariants.el ends here diff --git a/agent-shell-meta.el b/agent-shell-meta.el new file mode 100644 index 00000000..87e0eb1e --- /dev/null +++ b/agent-shell-meta.el @@ -0,0 +1,132 @@ +;;; agent-shell-meta.el --- Meta helpers for agent-shell -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2025 Alvaro Ramirez and contributors + +;; Author: Alvaro Ramirez https://xenodium.com +;; URL: https://github.com/xenodium/agent-shell + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Meta helpers for agent-shell tool call handling. +;; +;; Report issues at https://github.com/xenodium/agent-shell/issues + +;;; Code: + +(require 'map) +(require 'seq) +(require 'subr-x) + +(defun agent-shell--meta-lookup (meta key) + "Lookup KEY in META, handling symbol or string keys. + +For example: + + (agent-shell--meta-lookup \\='((stdout . \"hello\")) \\='stdout) + => \"hello\" + + (agent-shell--meta-lookup \\='((\"stdout\" . \"hello\")) \\='stdout) + => \"hello\"" + (let ((value (map-elt meta key))) + (when (and (null value) (symbolp key)) + (setq value (map-elt meta (symbol-name key)))) + value)) + +(defun agent-shell--meta-find-tool-response (meta) + "Find a toolResponse value nested inside any namespace in META. +Agents may place toolResponse under an agent-specific key (e.g. +_meta.agentName.toolResponse). Walk the top-level entries of META +looking for one that contains a toolResponse. + +For example: + + (agent-shell--meta-find-tool-response + \\='((claudeCode . ((toolResponse . ((stdout . \"hi\"))))))) + => ((stdout . \"hi\"))" + (or (agent-shell--meta-lookup meta 'toolResponse) + (when-let ((match (seq-find (lambda (entry) + (and (consp entry) (consp (cdr entry)) + (agent-shell--meta-lookup (cdr entry) 'toolResponse))) + (when (listp meta) meta)))) + (agent-shell--meta-lookup (cdr match) 'toolResponse)))) + +(defun agent-shell--tool-call-meta-response-text (update) + "Return tool response text from UPDATE meta, if present. +Looks for a toolResponse entry inside any agent-specific _meta +namespace and extracts text from it. Handles three common shapes: + +An alist with a `stdout' string: + + \\='((toolCallId . \"id\") + (_meta . ((claudeCode . ((toolResponse . ((stdout . \"output\")))))))) + => \"output\" + +An alist with a `content' string: + + \\='((_meta . ((agent . ((toolResponse . ((content . \"text\")))))))) + => \"text\" + +A vector of text items: + + \\='((_meta . ((toolResponse . [((type . \"text\") (text . \"one\")) + ((type . \"text\") (text . \"two\"))])))) + => \"one\\n\\ntwo\"" + (when-let* ((meta (or (map-elt update '_meta) + (map-elt update 'meta))) + (response (agent-shell--meta-find-tool-response meta))) + (cond + ((and (listp response) + (not (vectorp response)) + (let ((stdout (agent-shell--meta-lookup response 'stdout))) + (and (stringp stdout) (not (string-empty-p stdout))))) + (agent-shell--meta-lookup response 'stdout)) + ((and (listp response) + (not (vectorp response)) + (stringp (agent-shell--meta-lookup response 'content))) + (agent-shell--meta-lookup response 'content)) + ((vectorp response) + (let* ((items (append response nil)) + (parts (delq nil + (mapcar (lambda (item) + (let ((text (agent-shell--meta-lookup item 'text))) + (when (and (stringp text) + (not (string-empty-p text))) + text))) + items)))) + (when parts + (mapconcat #'identity parts "\n\n"))))))) + +(defun agent-shell--tool-call-terminal-output-data (update) + "Return terminal output data string from UPDATE meta, if present. +Extracts the data field from _meta.terminal_output, used by agents +like codex-acp for incremental streaming. + +For example: + + (agent-shell--tool-call-terminal-output-data + \\='((_meta . ((terminal_output . ((data . \"hello\"))))))) + => \"hello\"" + (when-let* ((meta (or (map-elt update '_meta) + (map-elt update 'meta))) + (terminal (or (agent-shell--meta-lookup meta 'terminal_output) + (agent-shell--meta-lookup meta 'terminal-output)))) + (let ((data (agent-shell--meta-lookup terminal 'data))) + (when (stringp data) + data)))) + +(provide 'agent-shell-meta) + +;;; agent-shell-meta.el ends here diff --git a/agent-shell-streaming.el b/agent-shell-streaming.el new file mode 100644 index 00000000..e54cfc85 --- /dev/null +++ b/agent-shell-streaming.el @@ -0,0 +1,490 @@ +;;; agent-shell-streaming.el --- Streaming tool call handler for agent-shell -*- lexical-binding: t; -*- + +;; Copyright (C) 2024-2025 Alvaro Ramirez and contributors + +;; Author: Alvaro Ramirez https://xenodium.com +;; URL: https://github.com/xenodium/agent-shell + +;; This package is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This package is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; Streaming tool call handler for agent-shell. Accumulates incremental +;; tool output from _meta.*.toolResponse and renders it on final update, +;; avoiding duplicate output. +;; +;; Report issues at https://github.com/xenodium/agent-shell/issues + +;;; Code: + +(eval-when-compile + (require 'cl-lib)) +(require 'map) +(require 'seq) +(require 'agent-shell-invariants) +(require 'subr-x) +(require 'agent-shell-meta) + +;; Functions that remain in agent-shell.el +(declare-function agent-shell--update-fragment "agent-shell") +(declare-function agent-shell--delete-fragment "agent-shell") +(declare-function agent-shell--save-tool-call "agent-shell") +(declare-function agent-shell--make-diff-info "agent-shell") +(declare-function agent-shell--format-diff-as-text "agent-shell") +(declare-function agent-shell--append-transcript "agent-shell") +(declare-function agent-shell--make-transcript-tool-call-entry "agent-shell") +(declare-function agent-shell-make-tool-call-label "agent-shell") +(declare-function agent-shell--extract-tool-parameters "agent-shell") +(declare-function agent-shell-ui--nearest-range-matching-property "agent-shell-ui") + +(defvar agent-shell-tool-use-expand-by-default) +(defvar agent-shell--transcript-file) +(defvar agent-shell-ui--content-store) + +;;; Output normalization + +(defun agent-shell--tool-call-normalize-output (text) + "Normalize tool call output TEXT for streaming. +Strips backtick fences, formats wrappers as +fontified notices, and ensures a trailing newline. + +For example: + + (agent-shell--tool-call-normalize-output \"hello\") + => \"hello\\n\" + + (agent-shell--tool-call-normalize-output + \"saved\") + => fontified string with tags stripped" + (when (and text (stringp text)) + (let ((result (string-join (seq-remove (lambda (line) + (string-match-p "\\`\\s-*```" line)) + (split-string text "\n")) + "\n"))) + (when (string-match-p "" result) + (setq result (replace-regexp-in-string + "" "" result)) + (setq result (string-trim result)) + (setq result (propertize (concat "\n" result) + 'font-lock-face 'font-lock-comment-face))) + (when (and (not (string-empty-p result)) + (not (string-suffix-p "\n" result))) + (setq result (concat result "\n"))) + result))) + +(defun agent-shell--tool-call-content-text (content) + "Return concatenated text from tool call CONTENT items. + +For example: + + (agent-shell--tool-call-content-text + [((content . ((text . \"hello\"))))]) + => \"hello\"" + (let* ((items (cond + ((vectorp content) (append content nil)) + ((listp content) content) + (content (list content)))) + (parts (delq nil + (mapcar (lambda (item) + (let-alist item + (when (and (stringp .content.text) + (not (string-empty-p .content.text))) + .content.text))) + items)))) + (when parts + (mapconcat #'identity parts "\n\n")))) + +;;; Chunk accumulation + +(defun agent-shell--tool-call-append-output-chunk (state tool-call-id chunk) + "Append CHUNK to tool call output buffer for TOOL-CALL-ID in STATE." + (let* ((tool-calls (map-elt state :tool-calls)) + (entry (or (map-elt tool-calls tool-call-id) (list))) + (chunks (map-elt entry :output-chunks))) + (setf (map-elt entry :output-chunks) (cons chunk chunks)) + (setf (map-elt tool-calls tool-call-id) entry) + (map-put! state :tool-calls tool-calls))) + +(defun agent-shell--tool-call-output-text (state tool-call-id) + "Return aggregated output for TOOL-CALL-ID from STATE." + (let ((chunks (map-nested-elt state `(:tool-calls ,tool-call-id :output-chunks)))) + (when (and chunks (listp chunks)) + (mapconcat #'identity (reverse chunks) "")))) + +(defun agent-shell--tool-call-clear-output (state tool-call-id) + "Clear aggregated output for TOOL-CALL-ID in STATE." + (let* ((tool-calls (map-elt state :tool-calls)) + (entry (map-elt tool-calls tool-call-id))) + (when entry + (setf (map-elt entry :output-chunks) nil) + (setf (map-elt entry :output-marker) nil) + (setf (map-elt entry :output-ui-state) nil) + (setf (map-elt tool-calls tool-call-id) entry) + (map-put! state :tool-calls tool-calls)))) + +(defun agent-shell--tool-call-output-marker (state tool-call-id) + "Return output marker for TOOL-CALL-ID in STATE." + (map-nested-elt state `(:tool-calls ,tool-call-id :output-marker))) + +(defun agent-shell--tool-call-set-output-marker (state tool-call-id marker) + "Set output MARKER for TOOL-CALL-ID in STATE." + (let* ((tool-calls (map-elt state :tool-calls)) + (entry (or (map-elt tool-calls tool-call-id) (list)))) + (setf (map-elt entry :output-marker) marker) + (setf (map-elt tool-calls tool-call-id) entry) + (map-put! state :tool-calls tool-calls))) + +(defun agent-shell--tool-call-output-ui-state (state tool-call-id) + "Return cached UI state for TOOL-CALL-ID in STATE." + (map-nested-elt state `(:tool-calls ,tool-call-id :output-ui-state))) + +(defun agent-shell--tool-call-set-output-ui-state (state tool-call-id ui-state) + "Set cached UI-STATE for TOOL-CALL-ID in STATE." + (let* ((tool-calls (map-elt state :tool-calls)) + (entry (or (map-elt tool-calls tool-call-id) (list)))) + (setf (map-elt entry :output-ui-state) ui-state) + (setf (map-elt tool-calls tool-call-id) entry) + (map-put! state :tool-calls tool-calls))) + +(defun agent-shell--tool-call-body-range-info (state tool-call-id) + "Return tool call body range info for TOOL-CALL-ID in STATE." + (when-let ((buffer (map-elt state :buffer))) + (with-current-buffer buffer + (let* ((qualified-id (format "%s-%s" (map-elt state :request-count) tool-call-id)) + (match (save-excursion + (goto-char (point-max)) + (text-property-search-backward + 'agent-shell-ui-state nil + (lambda (_ state) + (equal (map-elt state :qualified-id) qualified-id)) + t)))) + (when match + (let* ((block-start (prop-match-beginning match)) + (block-end (prop-match-end match)) + (ui-state (get-text-property block-start 'agent-shell-ui-state)) + (body-range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from block-start :to block-end))) + (list (cons :ui-state ui-state) + (cons :body-range body-range)))))))) + +(defun agent-shell--tool-call-ensure-output-marker (state tool-call-id) + "Ensure an output marker exists for TOOL-CALL-ID in STATE." + (let* ((buffer (map-elt state :buffer)) + (marker (agent-shell--tool-call-output-marker state tool-call-id))) + (when (or (not (markerp marker)) + (not (eq (marker-buffer marker) buffer))) + (setq marker nil)) + (unless marker + (when-let ((info (agent-shell--tool-call-body-range-info state tool-call-id)) + (body-range (map-elt info :body-range))) + (setq marker (copy-marker (map-elt body-range :end) t)) + (agent-shell--tool-call-set-output-marker state tool-call-id marker) + (agent-shell--tool-call-set-output-ui-state state tool-call-id (map-elt info :ui-state)))) + marker)) + +(defun agent-shell--store-tool-call-output (ui-state text) + "Store TEXT in the content-store for UI-STATE's body key." + (when-let ((qualified-id (map-elt ui-state :qualified-id)) + (key (concat qualified-id "-body"))) + (unless agent-shell-ui--content-store + (setq agent-shell-ui--content-store (make-hash-table :test 'equal))) + (puthash key + (concat (or (gethash key agent-shell-ui--content-store) "") text) + agent-shell-ui--content-store))) + +(defun agent-shell--append-tool-call-output (state tool-call-id text) + "Append TEXT to TOOL-CALL-ID output body in STATE without formatting. +Note: process-mark preservation is unnecessary here because the output +marker is inside the fragment body, which is always before the +process-mark. Insertions at the output marker shift the process-mark +forward by the correct amount automatically." + (when (and text (not (string-empty-p text))) + (with-current-buffer (map-elt state :buffer) + (let* ((inhibit-read-only t) + (buffer-undo-list t) + (was-at-end (eobp)) + (saved-point (copy-marker (point) t)) + (marker (agent-shell--tool-call-ensure-output-marker state tool-call-id)) + (ui-state (agent-shell--tool-call-output-ui-state state tool-call-id))) + (if (not marker) + (progn + (agent-shell--update-fragment + :state state + :block-id tool-call-id + :body text + :append t + :navigation 'always) + (agent-shell--tool-call-ensure-output-marker state tool-call-id) + (setq ui-state (agent-shell--tool-call-output-ui-state state tool-call-id)) + (agent-shell--store-tool-call-output ui-state text)) + (goto-char marker) + (let ((start (point))) + (insert text) + (let ((end (point)) + (collapsed (and ui-state (map-elt ui-state :collapsed))) + (qualified-id (and ui-state (map-elt ui-state :qualified-id)))) + (set-marker marker end) + ;; Streamed appends bypass `agent-shell--update-fragment', + ;; so the block-level `field' and body-level `help-echo' + ;; properties that wrapper applies aren't extended. Stamp + ;; them here to keep comint field navigation and tooltips + ;; consistent across the streamed region. + (add-text-properties + start end + `(read-only t + front-sticky (read-only) + field output + ,@(when qualified-id (list 'help-echo qualified-id)) + agent-shell-ui-state ,ui-state + agent-shell-ui-section body)) + (agent-shell--store-tool-call-output ui-state text) + (when collapsed + (add-text-properties start end '(invisible t)))))) + (if was-at-end + (goto-char (point-max)) + (goto-char saved-point)) + (set-marker saved-point nil) + (agent-shell-invariants-on-append-output + tool-call-id + (when marker (marker-position marker)) + (length text)))))) + +;;; Streaming handler + +(defun agent-shell--tool-call-final-p (status) + "Return non-nil when STATUS represents a final tool call state." + (and status (member status '("completed" "failed" "cancelled")))) + +(defun agent-shell--tool-call-update-overrides (state update &optional include-content include-diff) + "Build tool call overrides for UPDATE in STATE. +INCLUDE-CONTENT and INCLUDE-DIFF control optional fields." + (let ((diff (when include-diff + (agent-shell--make-diff-info :acp-tool-call update)))) + (append (list (cons :status (map-elt update 'status))) + (when include-content + (list (cons :content (map-elt update 'content)))) + ;; The initial tool_call notification often carries a generic + ;; title (eg. "Bash", "Read"); a later tool_call_update may + ;; supply a more descriptive one (eg. 'grep -i -n "tool" + ;; /path/to/file'). Upgrade whenever a non-empty title + ;; arrives. See https://github.com/xenodium/agent-shell/issues/182 + ;; and https://github.com/xenodium/agent-shell/issues/309. + (when-let* ((new-title (map-elt update 'title)) + ((not (string-empty-p new-title)))) + (list (cons :title new-title))) + (when diff + (list (cons :diff diff)))))) + +(defun agent-shell--handle-tool-call-update-streaming (state update) + "Stream tool call UPDATE in STATE with dedup. +Three cond branches: + 1. Terminal output data: accumulate and stream to buffer live. + 2. Non-final meta-response: accumulate only, no buffer write. + 3. Final: render accumulated output or fallback to content-text." + (let* ((tool-call-id (map-elt update 'toolCallId)) + (status (map-elt update 'status)) + (terminal-data (agent-shell--tool-call-terminal-output-data update)) + (meta-response (agent-shell--tool-call-meta-response-text update)) + (final (agent-shell--tool-call-final-p status))) + (agent-shell--save-tool-call + state + tool-call-id + (agent-shell--tool-call-update-overrides state update nil nil)) + ;; Accumulate meta-response before final rendering so output is + ;; available even when stdout arrives only on the final update. + ;; Skip when terminal-data is also present to avoid double-accumulation + ;; (both sources carry the same underlying output). Run the chunk + ;; through the same delta dedup as thought chunks: agents that re-send + ;; cumulative stdout across updates would otherwise concatenate every + ;; revision into the final render. + (when (and meta-response (not terminal-data)) + (let* ((accumulated (or (agent-shell--tool-call-output-text state tool-call-id) "")) + (normalized (agent-shell--tool-call-normalize-output meta-response)) + (delta (and normalized + (agent-shell--thought-chunk-delta accumulated normalized)))) + (when (and delta (not (string-empty-p delta))) + (agent-shell--tool-call-append-output-chunk state tool-call-id delta)))) + (cond + ;; Terminal output data (e.g. codex-acp): accumulate and stream live. + ((and terminal-data (stringp terminal-data)) + (let ((chunk (agent-shell--tool-call-normalize-output terminal-data))) + (when (and chunk (not (string-empty-p chunk))) + (agent-shell--tool-call-append-output-chunk state tool-call-id chunk) + (unless final + (agent-shell--append-tool-call-output state tool-call-id chunk)))) + (when final + (agent-shell--handle-tool-call-final state update) + (agent-shell--tool-call-clear-output state tool-call-id))) + (final + (agent-shell--handle-tool-call-final state update))) + ;; Update labels for non-final updates (final gets labels via + ;; handle-tool-call-final). Only rebuild when labels actually + ;; changed — the rebuild invalidates the output marker used by + ;; live terminal streaming and is O(fragment-size), so skipping + ;; unchanged labels avoids O(n²) total work during streaming. + (unless final + (let* ((tool-call-labels (agent-shell-make-tool-call-label + state tool-call-id)) + (new-left (map-elt tool-call-labels :status)) + (new-right (map-elt tool-call-labels :title)) + (prev-left (map-nested-elt state `(:tool-calls ,tool-call-id :prev-label-left))) + (prev-right (map-nested-elt state `(:tool-calls ,tool-call-id :prev-label-right)))) + (unless (and (equal new-left prev-left) + (equal new-right prev-right)) + (agent-shell--update-fragment + :state state + :block-id tool-call-id + :label-left new-left + :label-right new-right + :expanded agent-shell-tool-use-expand-by-default) + (agent-shell--tool-call-set-output-marker state tool-call-id nil) + ;; Cache labels to skip redundant rebuilds on next update. + (let* ((tool-calls (map-elt state :tool-calls)) + (entry (or (map-elt tool-calls tool-call-id) (list)))) + (setf (map-elt entry :prev-label-left) new-left) + (setf (map-elt entry :prev-label-right) new-right) + (setf (map-elt tool-calls tool-call-id) entry) + (map-put! state :tool-calls tool-calls))))))) + +(defun agent-shell--handle-tool-call-final (state update) + "Render final tool call UPDATE in STATE. +Uses accumulated output-chunks when available, otherwise falls +back to content-text extraction." + (let-alist update + (let* ((accumulated (agent-shell--tool-call-output-text state .toolCallId)) + (content-text (or accumulated + (agent-shell--tool-call-content-text .content))) + (diff (map-nested-elt state `(:tool-calls ,.toolCallId :diff))) + (output (if (and content-text (not (string-empty-p content-text))) + (concat "\n\n" content-text "\n\n") + "")) + (diff-text (agent-shell--format-diff-as-text diff)) + (body-text (if diff-text + (concat output + "\n\n" + "╭─────────╮\n" + "│ changes │\n" + "╰─────────╯\n\n" diff-text) + output))) + (agent-shell--save-tool-call + state + .toolCallId + (agent-shell--tool-call-update-overrides state update t t)) + (when (member .status '("completed" "failed")) + (agent-shell--append-transcript + :text (agent-shell--make-transcript-tool-call-entry + :status .status + :title (map-nested-elt state `(:tool-calls ,.toolCallId :title)) + :kind (map-nested-elt state `(:tool-calls ,.toolCallId :kind)) + :description (map-nested-elt state `(:tool-calls ,.toolCallId :description)) + :command (map-nested-elt state `(:tool-calls ,.toolCallId :command)) + :parameters (agent-shell--extract-tool-parameters + (map-nested-elt state `(:tool-calls ,.toolCallId :raw-input))) + :output body-text) + :file-path agent-shell--transcript-file)) + (when (and .status + (not (equal .status "pending"))) + (agent-shell--delete-fragment :state state :block-id (format "permission-%s" .toolCallId))) + (let* ((tool-call-labels (agent-shell-make-tool-call-label + state .toolCallId)) + (saved-command (map-nested-elt state `(:tool-calls ,.toolCallId :command))) + (command-block (when saved-command + (concat "```console\n" saved-command "\n```")))) + (agent-shell--update-fragment + :state state + :block-id .toolCallId + :label-left (map-elt tool-call-labels :status) + :label-right (map-elt tool-call-labels :title) + :body (if command-block + (concat command-block "\n\n" (string-trim body-text)) + (string-trim body-text)) + :expanded agent-shell-tool-use-expand-by-default)) + ;; Clear the per-tool label cache too — the streaming dispatcher + ;; uses it to skip redundant rebuilds during in-flight updates. + ;; After final, no further updates fire, so the cached values + ;; would just linger in state for the lifetime of the shell. + (when-let* ((tool-calls (map-elt state :tool-calls)) + (entry (map-elt tool-calls .toolCallId))) + (setf (map-elt entry :prev-label-left) nil) + (setf (map-elt entry :prev-label-right) nil) + (setf (map-elt tool-calls .toolCallId) entry) + (map-put! state :tool-calls tool-calls)) + (agent-shell--tool-call-clear-output state .toolCallId)))) + +;;; Thought chunk dedup + +(defun agent-shell--thought-chunk-delta (accumulated chunk) + "Return the portion of CHUNK not already present in ACCUMULATED. +When an agent re-delivers the full accumulated thought text (e.g. +codex-acp sending a cumulative summary after incremental tokens), +only the genuinely new tail is returned. + +Four cases are handled: + ;; Cumulative from start (prefix match) + (agent-shell--thought-chunk-delta \"AB\" \"ABCD\") => \"CD\" + + ;; Already present (suffix match, e.g. leading whitespace trimmed) + (agent-shell--thought-chunk-delta \"\\n\\nABCD\" \"ABCD\") => \"\" + + ;; Partial overlap (tail of accumulated matches head of chunk) + (agent-shell--thought-chunk-delta \"ABCD\" \"CDEF\") => \"EF\" + + ;; Incremental token (no overlap) + (agent-shell--thought-chunk-delta \"AB\" \"CD\") => \"CD\"" + (cond + ((or (null accumulated) (string-empty-p accumulated)) + chunk) + ;; Chunk starts with all accumulated text (cumulative from start). + ((string-prefix-p accumulated chunk) + (substring chunk (length accumulated))) + ;; Chunk is already fully contained as a suffix of accumulated + ;; (e.g. re-delivery omits leading whitespace tokens). + ((string-suffix-p chunk accumulated) + "") + ;; Partial overlap: tail of accumulated matches head of chunk. + ;; Try decreasing overlap lengths to find the longest match. + (t + (let ((max-overlap (min (length accumulated) (length chunk))) + (overlap 0)) + (cl-loop for len from max-overlap downto 1 + when (string= (substring accumulated (- (length accumulated) len)) + (substring chunk 0 len)) + do (setq overlap len) and return nil) + (if (< 0 overlap) + (substring chunk overlap) + chunk))))) + +;;; Cancellation + +(defun agent-shell--mark-tool-calls-cancelled (state) + "Mark in-flight tool-call entries in STATE as cancelled and update UI." + (let ((tool-calls (map-elt state :tool-calls))) + (when tool-calls + (map-do + (lambda (tool-call-id tool-call-data) + (let ((status (map-elt tool-call-data :status))) + (when (or (not status) + (member status '("pending" "in_progress"))) + (agent-shell--handle-tool-call-final + state + `((toolCallId . ,tool-call-id) + (status . "cancelled") + (content . ,(map-elt tool-call-data :content)))) + (agent-shell--tool-call-clear-output state tool-call-id)))) + tool-calls)))) + +(provide 'agent-shell-streaming) + +;;; agent-shell-streaming.el ends here diff --git a/agent-shell-ui.el b/agent-shell-ui.el index cf09835f..1a858fd1 100644 --- a/agent-shell-ui.el +++ b/agent-shell-ui.el @@ -36,6 +36,7 @@ (require 'cursor-sensor) (require 'subr-x) (require 'text-property-search) +(require 'agent-shell-invariants) (defvar-local agent-shell-ui--content-store nil "A hash table used to save sui content like body. @@ -57,7 +58,7 @@ NAMESPACE-ID, BLOCK-ID, LABEL-LEFT, LABEL-RIGHT, and BODY are the keys." text) (insert text)) -(cl-defun agent-shell-ui-update-fragment (model &key append create-new on-post-process navigation expanded no-undo) +(cl-defun agent-shell-ui-update-fragment (model &key append create-new on-post-process navigation expanded no-undo insert-before) "Update or add a fragment using MODEL. When APPEND is non-nil, append to body instead of replacing. @@ -68,6 +69,9 @@ When NAVIGATION is `auto', block is navigatable if non-empty body. When NAVIGATION is `always', block is always TAB navigatable. When EXPANDED is non-nil, body will be expanded by default. When NO-UNDO is non-nil, disable undo recording for this operation. +When INSERT-BEFORE is a buffer position, new blocks are inserted +before that position instead of at the end of the buffer. This +keeps content above the shell prompt when user input is pending. For existing blocks, the current expansion state is preserved unless overridden." (save-mark-and-excursion @@ -92,41 +96,122 @@ For existing blocks, the current expansion state is preserved unless overridden. (when match (goto-char (prop-match-beginning match))) (if (and match (not create-new)) - ;; Found existing block - delete and regenerate (let* ((existing-model (agent-shell-ui--read-fragment-at-point)) (state (get-text-property (point) 'agent-shell-ui-state)) (existing-body (map-elt existing-model :body)) - (block-end (prop-match-end match)) - (final-body (if new-body - (if (and append existing-body) - (concat existing-body new-body) - new-body) - existing-body)) - (final-model (list (cons :namespace-id namespace-id) - (cons :block-id (map-elt model :block-id)) - (cons :label-left (or new-label-left - (map-elt existing-model :label-left))) - (cons :label-right (or new-label-right - (map-elt existing-model :label-right))) - (cons :body final-body)))) + (block-end (prop-match-end match))) (setq block-start (prop-match-beginning match)) - - ;; Safely replace existing block using narrow-to-region (save-excursion (goto-char block-start) (skip-chars-backward "\n") (setq padding-start (point))) - - ;; Replace block - (delete-region block-start block-end) - (goto-char block-start) - (agent-shell-ui--insert-fragment final-model qualified-id - (not (map-elt state :collapsed)) - navigation) - (setq padding-end (point))) + (if (and append new-body + existing-body (not (string-empty-p existing-body)) + (not new-label-left) + (not new-label-right)) + ;; Append in-place: insert only new body text, + ;; avoiding the delete-and-reinsert that displaces point. + (let* ((body-range (agent-shell-ui--nearest-range-matching-property + :property 'agent-shell-ui-section :value 'body + :from block-start :to block-end)) + (old-body-start (map-elt body-range :start)) + (old-body-end (map-elt body-range :end)) + (body-text new-body)) + ;; Normalize trailing whitespace only. Do NOT + ;; strip leading newlines here — unlike the initial + ;; insert (where \n\n is already placed between + ;; label and body), appended chunks carry meaningful + ;; leading newlines (list-item separators, paragraph + ;; breaks, etc.). + (when (string-suffix-p "\n\n" body-text) + (setq body-text (concat (string-trim-right body-text) "\n\n"))) + ;; Cap consecutive newlines at the append boundary + ;; to at most two. An empty agent_message_chunk is + ;; substituted with "\n\n" upstream to break + ;; paragraphs; if the existing body already ends in + ;; one or more "\n", a naive concat produces three + ;; or more newlines (an extra blank line). + (let* ((trailing-count + (save-excursion + (goto-char old-body-end) + (let ((n 0)) + (while (and (< (point-min) (point)) + (eq (char-before) ?\n)) + (cl-incf n) + (forward-char -1)) + n))) + (leading-count + (let ((i 0)) + (while (and (< i (length body-text)) + (eq (aref body-text i) ?\n)) + (cl-incf i)) + i)) + (boundary-target (min 2 (max trailing-count leading-count))) + (keep-leading (max 0 (- boundary-target trailing-count)))) + (when (< keep-leading leading-count) + (setq body-text (concat (make-string keep-leading ?\n) + (substring body-text leading-count))))) + (if (map-elt state :collapsed) + ;; Collapsed: insert-and-inherit picks up invisible + ;; from existing body via stickiness. + (progn + (goto-char old-body-end) + (insert-and-inherit (agent-shell-ui--indent-text + (string-remove-prefix " " body-text) " "))) + ;; Expanded: un-hide old trailing whitespace (no longer + ;; trailing), insert, re-hide new trailing whitespace. + (remove-text-properties old-body-start old-body-end + '(invisible nil)) + (goto-char old-body-end) + (insert-and-inherit (agent-shell-ui--indent-text + (string-remove-prefix " " body-text) " ")) + (let ((new-body-end (point))) + (save-mark-and-excursion + (goto-char new-body-end) + (when (re-search-backward "[^ \t\n]" old-body-start t) + (forward-char 1) + (when (< (point) new-body-end) + (add-text-properties (point) new-body-end + '(invisible t))))))) + (let ((new-body-end (point))) + ;; Extend block-level properties to cover new text + (put-text-property block-start new-body-end + 'agent-shell-ui-state + (get-text-property block-start 'agent-shell-ui-state)) + (put-text-property block-start new-body-end 'read-only t) + (put-text-property block-start new-body-end 'front-sticky '(read-only)) + ;; Update content-store + (unless agent-shell-ui--content-store + (setq agent-shell-ui--content-store (make-hash-table :test 'equal))) + (puthash (concat qualified-id "-body") + (concat existing-body new-body) + agent-shell-ui--content-store) + (setq padding-end new-body-end))) + ;; Full rebuild: delete and regenerate (label change, first + ;; body content, or non-append replacement). + (let* ((final-body (if new-body + (if (and append existing-body) + (concat existing-body new-body) + new-body) + existing-body)) + (final-model (list (cons :namespace-id namespace-id) + (cons :block-id (map-elt model :block-id)) + (cons :label-left (or new-label-left + (map-elt existing-model :label-left))) + (cons :label-right (or new-label-right + (map-elt existing-model :label-right))) + (cons :body final-body)))) + (delete-region block-start block-end) + (goto-char block-start) + (agent-shell-ui--insert-fragment final-model qualified-id + (not (map-elt state :collapsed)) + navigation) + (setq padding-end (point))))) ;; Not found or create-new - insert new block - (goto-char (point-max)) + (goto-char (if insert-before + (min insert-before (point-max)) + (point-max))) (setq padding-start (point)) (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) (setq block-start (point)) @@ -154,16 +239,25 @@ For existing blocks, the current expansion state is preserved unless overridden. (cons :end padding-end))))))))) +(defun agent-shell-ui--split-qualified-id (qualified-id) + "Split QUALIFIED-ID into (NAMESPACE-ID . BLOCK-ID) on the first hyphen. +Namespace-ids are hyphen-free in production (request-count integer), +but block-ids commonly carry hyphens (e.g. \"toolCallId-plan\", +\"permission-toolCallId\", \"failed-X-id:Y-code:Z\"). Returns nil +when QUALIFIED-ID has no hyphen." + (when (string-match "^\\([^-]+\\)-\\(.+\\)$" qualified-id) + (cons (match-string 1 qualified-id) + (match-string 2 qualified-id)))) + (defun agent-shell-ui--read-fragment-at (position qualified-id) "Read fragment at POSITION with QUALIFIED-ID." (when-let ((fragment (list (cons :block-id qualified-id))) (state (get-text-property position 'agent-shell-ui-state)) (range (agent-shell-ui--block-range :position position))) ;; TODO: Get rid of merging block namespace and id. - ;; Extract namespace-id from qualified-id if it contains a dash - (when (string-match "^\\(.+\\)-\\(.+\\)$" qualified-id) - (setf (map-elt fragment :namespace-id) (match-string 1 qualified-id)) - (setf (map-elt fragment :block-id) (match-string 2 qualified-id))) + (when-let ((split (agent-shell-ui--split-qualified-id qualified-id))) + (setf (map-elt fragment :namespace-id) (car split)) + (setf (map-elt fragment :block-id) (cdr split))) (save-mark-and-excursion (save-restriction (narrow-to-region (map-elt range :start) @@ -391,7 +485,8 @@ NAVIGATION controls navigability: ;; Use agent-shell-ui--content-store for these instances. ;; For example, fragment body. (cons :qualified-id qualified-id) - (cons :collapsed (not expanded)) + (cons :collapsed (and (or label-left label-right) + (not expanded))) (cons :navigatable (cond ((eq navigation 'never) nil) ((eq navigation 'always) t) @@ -403,13 +498,15 @@ NAVIGATION controls navigability: (put-text-property block-start (or body-end label-right-end label-left-end) 'read-only t) (put-text-property block-start (or body-end label-right-end label-left-end) 'front-sticky '(read-only)))) -(cl-defun agent-shell-ui-update-text (&key namespace-id block-id text append create-new no-undo) +(cl-defun agent-shell-ui-update-text (&key namespace-id block-id text append create-new no-undo insert-before) "Update or insert a plain text entry identified by NAMESPACE-ID and BLOCK-ID. TEXT is the string to insert or append. When APPEND is non-nil, append TEXT to existing entry. When CREATE-NEW is non-nil, always create a new entry. -When NO-UNDO is non-nil, disable undo recording." +When NO-UNDO is non-nil, disable undo recording. +When INSERT-BEFORE is a buffer position, new entries are inserted +before that position instead of at the end of the buffer." (save-mark-and-excursion (let* ((inhibit-read-only t) (buffer-undo-list (if no-undo t buffer-undo-list)) @@ -449,7 +546,9 @@ When NO-UNDO is non-nil, disable undo recording." (cons :end (point))))))) ;; New entry. (t - (goto-char (point-max)) + (goto-char (if insert-before + (min insert-before (point-max)) + (point-max))) (let ((padding-start (point))) (agent-shell-ui--insert-read-only (agent-shell-ui--required-newlines 2)) (let ((block-start (point))) @@ -529,7 +628,11 @@ When NO-UNDO is non-nil, disable undo recording." (point) indicator-properties) (map-put! state :collapsed new-collapsed-state) (put-text-property (map-elt block :start) - (map-elt block :end) 'agent-shell-ui-state state))))) + (map-elt block :end) 'agent-shell-ui-state state) + (when-let* ((qid (map-elt state :qualified-id)) + (split (agent-shell-ui--split-qualified-id qid))) + (agent-shell-invariants-on-collapse-toggle + (car split) (cdr split) new-collapsed-state)))))) (defun agent-shell-ui-collapse-fragment-by-id (namespace-id block-id) "Collapse fragment with NAMESPACE-ID and BLOCK-ID." diff --git a/agent-shell.el b/agent-shell.el index 48997352..9a064344 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -4,10 +4,10 @@ ;; Author: Alvaro Ramirez https://xenodium.com ;; URL: https://github.com/xenodium/agent-shell -;; Version: 0.50.1 -;; Package-Requires: ((emacs "29.1") (shell-maker "0.90.1") (acp "0.11.1")) +;; Version: 0.51.1 +;; Package-Requires: ((emacs "29.1") (shell-maker "0.91.2") (acp "0.11.1")) -(defconst agent-shell--version "0.50.1") +(defconst agent-shell--version "0.51.1") ;; This package is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -47,7 +47,8 @@ (require 'json) (require 'map) (unless (require 'markdown-overlays nil 'noerror) - (error "Please update 'shell-maker' to v0.90.1 or newer")) + (error "Please update 'shell-maker' to v0.91.2 or newer")) +(require 'agent-shell-invariants) (require 'agent-shell-anthropic) (require 'agent-shell-auggie) (require 'agent-shell-cline) @@ -74,6 +75,7 @@ (require 'agent-shell-styles) (require 'agent-shell-usage) (require 'agent-shell-worktree) +(require 'agent-shell-streaming) (require 'agent-shell-ui) (require 'agent-shell-viewport) (require 'image) @@ -842,6 +844,7 @@ OUTGOING-REQUEST-DECORATOR (passed through to `acp-make-client')." (cons :title nil))) (cons :last-entry-type nil) (cons :chunked-group-count 0) + (cons :thought-accumulated nil) (cons :request-count 0) (cons :last-activity-time nil) (cons :tool-calls nil) @@ -868,7 +871,8 @@ OUTGOING-REQUEST-DECORATOR (passed through to `acp-make-client')." (cons :context-size 0) (cons :cost-amount 0.0) (cons :cost-currency nil))) - (cons :idle-notification-timer nil))) + (cons :idle-notification-timer nil) + (cons :insert-cursor nil))) (defvar-local agent-shell--state (agent-shell--make-state)) @@ -1388,14 +1392,22 @@ See also `agent-shell-confirm-interrupt'." :shell-buffer (map-elt shell :buffer))))) (defun agent-shell--filter-buffer-substring (start end &optional delete) - "Return the buffer substring between START and END, after filtering. -Strip the text properties `line-prefix' and `wrap-prefix' from the -copied substring. If DELETE is non-nil, delete the text between START -and END from the buffer." - (let ((text (if delete - (prog1 (buffer-substring start end) - (delete-region start end)) - (buffer-substring start end)))) + "Return visible text between START and END, stripping hidden markup. +If DELETE is non-nil, delete the text between START and END." + (let ((text "") + (pos start)) + (while (< pos end) + (let ((next (next-overlay-change pos)) + (exclude (seq-find (lambda (ov) + (memq (overlay-get ov 'markdown-overlays-markup-type) + '(fence language inline-code + bold italic strikethrough header))) + (overlays-at pos)))) + (unless exclude + (setq text (concat text (buffer-substring pos (min next end))))) + (setq pos (max next (1+ pos))))) + (when delete + (delete-region start end)) (remove-text-properties 0 (length text) '(line-prefix nil wrap-prefix nil) text) @@ -1446,6 +1458,7 @@ Flow: ;; TODO: Make public in shell-maker. (shell-maker--current-request-id)) (map-put! (agent-shell--state) :last-activity-time (current-time)) + (agent-shell--reset-insert-cursor) (cond ((not (map-elt (agent-shell--state) :client)) ;; Needs a client (agent-shell--emit-event :event 'init-started) @@ -1615,103 +1628,113 @@ COMMAND, when present, may be a shell command string or an argv vector." (map-elt state :active-requests)) (cl-defun agent-shell--on-notification (&key state acp-notification) - "Handle incoming ACP-NOTIFICATION using STATE." + "Handle incoming ACP-NOTIFICATION using STATE. +The notification is dropped silently when the shell buffer has been +killed — handlers downstream assume the buffer is live." (map-put! state :last-activity-time (current-time)) - (cond ((equal (map-elt acp-notification 'method) "session/update") + (when-let* ((buffer (map-elt state :buffer)) + ((buffer-live-p buffer))) + (with-current-buffer buffer + (agent-shell-invariants-on-notification + (or (map-nested-elt acp-notification '(params update sessionUpdate)) + (map-elt acp-notification 'method)) + (map-nested-elt acp-notification '(params update toolCallId))) + (cond ((equal (map-elt acp-notification 'method) "session/update") (cond ((equal (map-nested-elt acp-notification '(params update sessionUpdate)) "tool_call") - ;; Notification is out of context (session/prompt finished). - ;; Cannot derive where to display, so show in minibuffer. - (if (not (agent-shell--active-requests-p state)) - (when acp-logging-enabled - (message "%s %s (stale, consider reporting to ACP agent)" - (agent-shell--make-status-kind-label - :status (map-nested-elt acp-notification '(params update status)) - :kind (map-nested-elt acp-notification '(params update kind))) - (propertize (or (map-nested-elt acp-notification '(params update title)) "") - 'face font-lock-doc-markup-face))) - (agent-shell--save-tool-call - state - (map-nested-elt acp-notification '(params update toolCallId)) - (append (list (cons :title (cond - ((and (string= (map-nested-elt acp-notification '(params update title)) "Skill") - (map-nested-elt acp-notification '(params update rawInput command))) - (format "Skill: %s" - (agent-shell--tool-call-command-to-string - (map-nested-elt acp-notification '(params update rawInput command))))) - (t - (map-nested-elt acp-notification '(params update title))))) - (cons :status (map-nested-elt acp-notification '(params update status))) - (cons :kind (map-nested-elt acp-notification '(params update kind))) - (cons :command (agent-shell--tool-call-command-to-string - (map-nested-elt acp-notification '(params update rawInput command)))) - (cons :description (map-nested-elt acp-notification '(params update rawInput description))) - (cons :content (map-nested-elt acp-notification '(params update content))) - (cons :raw-input (map-nested-elt acp-notification '(params update rawInput)))) - (when-let ((diff (agent-shell--make-diff-info - :acp-tool-call (map-nested-elt acp-notification '(params update))))) - (list (cons :diff diff))))) - (agent-shell--cancel-idle-timer) - (agent-shell--emit-event - :event 'tool-call-update - :data (list (cons :tool-call-id (map-nested-elt acp-notification '(params update toolCallId))) - (cons :tool-call (map-nested-elt state (list :tool-calls (map-nested-elt acp-notification '(params update toolCallId))))))) - (let ((tool-call-labels (agent-shell-make-tool-call-label - state (map-nested-elt acp-notification '(params update toolCallId))))) + ;; A tool_call arriving after the session/prompt request + ;; has resolved (e.g. Claude Code's Stop-hook bounce) must + ;; still render — see the agent_message_chunk handler. + (agent-shell--save-tool-call + state + (map-nested-elt acp-notification '(params update toolCallId)) + (append (list (cons :title (cond + ((and (string= (map-nested-elt acp-notification '(params update title)) "Skill") + (map-nested-elt acp-notification '(params update rawInput command))) + (format "Skill: %s" + (agent-shell--tool-call-command-to-string + (map-nested-elt acp-notification '(params update rawInput command))))) + (t + (map-nested-elt acp-notification '(params update title))))) + (cons :status (map-nested-elt acp-notification '(params update status))) + (cons :kind (map-nested-elt acp-notification '(params update kind))) + (cons :command (agent-shell--tool-call-command-to-string + (map-nested-elt acp-notification '(params update rawInput command)))) + (cons :description (map-nested-elt acp-notification '(params update rawInput description))) + (cons :content (map-nested-elt acp-notification '(params update content))) + (cons :raw-input (map-nested-elt acp-notification '(params update rawInput)))) + (when-let ((diff (agent-shell--make-diff-info + :acp-tool-call (map-nested-elt acp-notification '(params update))))) + (list (cons :diff diff))))) + (agent-shell--cancel-idle-timer) + (agent-shell--emit-event + :event 'tool-call-update + :data (list (cons :tool-call-id (map-nested-elt acp-notification '(params update toolCallId))) + (cons :tool-call (map-nested-elt state (list :tool-calls (map-nested-elt acp-notification '(params update toolCallId))))))) + (let ((tool-call-labels (agent-shell-make-tool-call-label + state (map-nested-elt acp-notification '(params update toolCallId))))) + (agent-shell--update-fragment + :state state + :block-id (map-nested-elt acp-notification '(params update toolCallId)) + :label-left (map-elt tool-call-labels :status) + :label-right (map-elt tool-call-labels :title) + :expanded agent-shell-tool-use-expand-by-default) + ;; Display plan as markdown block if present + (when (map-nested-elt acp-notification '(params update rawInput plan)) (agent-shell--update-fragment :state state - :block-id (map-nested-elt acp-notification '(params update toolCallId)) - :label-left (map-elt tool-call-labels :status) - :label-right (map-elt tool-call-labels :title) - :expanded agent-shell-tool-use-expand-by-default) - ;; Display plan as markdown block if present - (when (map-nested-elt acp-notification '(params update rawInput plan)) - (agent-shell--update-fragment - :state state - :block-id (concat (map-nested-elt acp-notification '(params update toolCallId)) "-plan") - :label-left (propertize "Proposed plan" 'font-lock-face 'font-lock-doc-markup-face) - :body (agent-shell--format-plan (map-nested-elt acp-notification '(params update rawInput plan))) - :expanded t))) - (map-put! state :last-entry-type "tool_call"))) + :block-id (concat (map-nested-elt acp-notification '(params update toolCallId)) "-plan") + :label-left (propertize "Proposed plan" 'font-lock-face 'font-lock-doc-markup-face) + :body (agent-shell--format-plan (map-nested-elt acp-notification '(params update rawInput plan))) + :expanded t))) + (map-put! state :last-entry-type "tool_call")) ((equal (map-nested-elt acp-notification '(params update sessionUpdate)) "agent_thought_chunk") - ;; Notification is out of context (session/prompt finished). - ;; Cannot derive where to display, so show in minibuffer. - (if (not (agent-shell--active-requests-p state)) - (when acp-logging-enabled - (message "%s %s (stale, consider reporting to ACP agent): %s" - agent-shell-thought-process-icon - (propertize "Thinking" 'face font-lock-doc-markup-face) - (truncate-string-to-width (map-nested-elt acp-notification '(params update content text)) 100))) - (unless (equal (map-elt state :last-entry-type) - "agent_thought_chunk") + ;; A chunk arriving after the session/prompt request has + ;; resolved (e.g. Claude Code's Stop-hook bounce) must + ;; still render — see the agent_message_chunk handler. + (let ((new-group (not (equal (map-elt state :last-entry-type) + "agent_thought_chunk")))) + (when new-group (map-put! state :chunked-group-count (1+ (map-elt state :chunked-group-count))) + (map-put! state :thought-accumulated nil) (agent-shell--append-transcript :text (format "## Agent's Thoughts (%s)\n\n" (format-time-string "%F %T")) :file-path agent-shell--transcript-file)) - (agent-shell--append-transcript - :text (agent-shell--indent-markdown-headers - (map-nested-elt acp-notification '(params update content text))) - :file-path agent-shell--transcript-file) - (agent-shell--update-fragment - :state state - :block-id (format "%s-agent_thought_chunk" - (map-elt state :chunked-group-count)) - :label-left (concat - agent-shell-thought-process-icon - " " - (propertize "Thinking" 'font-lock-face font-lock-doc-markup-face)) - :body (map-nested-elt acp-notification '(params update content text)) - :append (equal (map-elt state :last-entry-type) - "agent_thought_chunk") - :expanded agent-shell-thought-process-expand-by-default) - (map-put! state :last-entry-type "agent_thought_chunk"))) + (let ((delta (agent-shell--thought-chunk-delta + (map-elt state :thought-accumulated) + (map-nested-elt acp-notification '(params update content text))))) + (map-put! state :thought-accumulated + (concat (or (map-elt state :thought-accumulated) "") delta)) + (when (and delta (not (string-empty-p delta))) + (agent-shell--append-transcript + :text delta + :file-path agent-shell--transcript-file) + (agent-shell--update-fragment + :state state + :block-id (format "%s-agent_thought_chunk" + (map-elt state :chunked-group-count)) + :label-left (concat + agent-shell-thought-process-icon + " " + (propertize "Thinking" 'font-lock-face font-lock-doc-markup-face)) + :body delta + :append (not new-group) + :expanded agent-shell-thought-process-expand-by-default)))) + (map-put! state :last-entry-type "agent_thought_chunk")) ((equal (map-nested-elt acp-notification '(params update sessionUpdate)) "agent_message_chunk") - ;; Notification is out of context (session/prompt finished). - ;; Cannot derive where to display, so show in minibuffer. - (if (not (agent-shell--active-requests-p state)) - (when acp-logging-enabled - (message "Agent message (stale, consider reporting to ACP agent): %s" - (truncate-string-to-width (map-nested-elt acp-notification '(params update content text)) 100))) + (let ((chunk-text (map-nested-elt acp-notification '(params update content text)))) + ;; An empty chunk while already streaming message text + ;; indicates a content block boundary (the model resumed + ;; after a tool call within the same turn). Convert to a + ;; paragraph break so the two blocks don't run together. + (when (and (equal (map-elt state :last-entry-type) "agent_message_chunk") + (stringp chunk-text) + (string-empty-p chunk-text)) + (setq chunk-text "\n\n")) + ;; A chunk arriving after the session/prompt request has + ;; resolved (e.g. Claude Code's Stop-hook bounce streams + ;; a regen turn after end_turn) must still render — + ;; dropping it makes the buffer freeze on the prior message. (unless (equal (map-elt state :last-entry-type) "agent_message_chunk") (map-put! state :chunked-group-count (1+ (map-elt state :chunked-group-count))) (agent-shell--append-transcript @@ -1722,14 +1745,13 @@ COMMAND, when present, may be a shell command string or an argv vector." ;; per-chunk: if a header is split across chunks it may ;; not be indented (graceful degradation). (agent-shell--append-transcript - :text (agent-shell--indent-markdown-headers - (map-nested-elt acp-notification '(params update content text))) + :text (agent-shell--indent-markdown-headers chunk-text) :file-path agent-shell--transcript-file) (agent-shell--update-fragment :state state :block-id (format "%s-agent_message_chunk" (map-elt state :chunked-group-count)) - :body (map-nested-elt acp-notification '(params update content text)) + :body chunk-text :create-new (not (equal (map-elt state :last-entry-type) "agent_message_chunk")) :append t @@ -1784,106 +1806,43 @@ COMMAND, when present, may be a shell command string or an argv vector." :expanded t) (map-put! state :last-entry-type "plan")) ((equal (map-nested-elt acp-notification '(params update sessionUpdate)) "tool_call_update") - ;; Notification is out of context (session/prompt finished). - ;; Cannot derive where to display, so show in minibuffer. - (if (not (agent-shell--active-requests-p state)) - (when acp-logging-enabled - (message "%s %s (stale, consider reporting to ACP agent)" - (agent-shell--make-status-kind-label - :status (map-nested-elt acp-notification '(params update status)) - :kind (map-nested-elt acp-notification '(params update kind))) - (propertize (or (map-nested-elt acp-notification '(params update title)) "") - 'face font-lock-doc-markup-face))) - ;; Update stored tool call data with new status and content - (agent-shell--save-tool-call - state - (map-nested-elt acp-notification '(params update toolCallId)) - (append (list (cons :status (map-nested-elt acp-notification '(params update status))) - (cons :content (map-nested-elt acp-notification '(params update content)))) - ;; The initial tool_call notification often has a - ;; generic title (eg. "grep", "bash", "Read"). - ;; The tool_call_update may have a more descriptive - ;; title (eg. 'grep -i -n "tool" /path/to/file'). - ;; Upgrade to the more descriptive title when available. - ;; See https://github.com/xenodium/agent-shell/issues/182 - ;; See https://github.com/xenodium/agent-shell/issues/309 - (when-let* ((new-title (map-nested-elt acp-notification '(params update title))) - ((not (string-empty-p new-title)))) - (list (cons :title new-title))) - (when-let* ((description (agent-shell--tool-call-command-to-string - (map-nested-elt acp-notification '(params update rawInput description))))) - (list (cons :description description))) - (when-let* ((command (agent-shell--tool-call-command-to-string - (map-nested-elt acp-notification '(params update rawInput command))))) - (list (cons :command command))) - (when-let ((raw-input (map-nested-elt acp-notification '(params update rawInput)))) - (list (cons :raw-input raw-input))) - (when-let ((diff (agent-shell--make-diff-info - :acp-tool-call (map-nested-elt acp-notification '(params update))))) - (list (cons :diff diff))))) - (agent-shell--cancel-idle-timer) - (agent-shell--emit-event - :event 'tool-call-update - :data (list (cons :tool-call-id (map-nested-elt acp-notification '(params update toolCallId))) - (cons :tool-call (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId))))))) - (let* ((diff (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :diff))) - (output (concat - "\n\n" - ;; TODO: Consider if there are other - ;; types of content to display. - (mapconcat (lambda (item) - (map-nested-elt item '(content text))) - (map-nested-elt acp-notification '(params update content)) - "\n\n") - "\n\n")) - (diff-text (agent-shell--format-diff-as-text diff)) - (body-text (if diff-text - (concat output - "\n\n" - "╭─────────╮\n" - "│ changes │\n" - "╰─────────╯\n\n" diff-text) - output))) - ;; Log tool call to transcript when completed or failed - (when (and (map-nested-elt acp-notification '(params update status)) - (member (map-nested-elt acp-notification '(params update status)) '("completed" "failed"))) - (agent-shell--append-transcript - :text (agent-shell--make-transcript-tool-call-entry - :status (map-nested-elt acp-notification '(params update status)) - :title (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :title)) - :kind (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :kind)) - :description (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :description)) - :command (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :command)) - :parameters (agent-shell--extract-tool-parameters - (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId)) :raw-input))) - :output body-text) - :file-path agent-shell--transcript-file)) - ;; Hide permission after sending response. - ;; Status is completed or failed so the user - ;; likely selected one of: accepted/rejected/always. - ;; Remove stale permission dialog. - (when (member (map-nested-elt acp-notification '(params update status)) - '("completed" "failed")) - ;; block-id must be the same as the one used as - ;; agent-shell--update-fragment param by "session/request_permission". - (agent-shell--delete-fragment :state state :block-id (format "permission-%s" (map-nested-elt acp-notification '(params update toolCallId))))) - (let* ((tool-call-labels (agent-shell-make-tool-call-label state (map-nested-elt acp-notification '(params update toolCallId)))) - (saved-command (map-nested-elt state `(:tool-calls - ,(map-nested-elt acp-notification '(params update toolCallId)) - :command))) - ;; Prepend fenced command to body. - (command-block (when saved-command - (concat "```console\n" saved-command "\n```")))) - (agent-shell--update-fragment - :state state - :block-id (map-nested-elt acp-notification '(params update toolCallId)) - :label-left (map-elt tool-call-labels :status) - :label-right (map-elt tool-call-labels :title) - :body (if command-block - (concat command-block "\n\n" (string-trim body-text)) - (string-trim body-text)) - :expanded agent-shell-tool-use-expand-by-default))) - (map-put! state :last-entry-type "tool_call_update"))) + ;; A tool_call_update arriving after the session/prompt + ;; request has resolved (e.g. Claude Code's Stop-hook + ;; bounce) must still render — see the agent_message_chunk + ;; handler. + (agent-shell--save-tool-call + state + (map-nested-elt acp-notification '(params update toolCallId)) + (append (list (cons :status (map-nested-elt acp-notification '(params update status))) + (cons :content (map-nested-elt acp-notification '(params update content)))) + ;; The initial tool_call notification often has a + ;; generic title (eg. "grep", "bash", "Read"). + ;; The tool_call_update may have a more descriptive + ;; title (eg. 'grep -i -n "tool" /path/to/file'). + ;; Upgrade to the more descriptive title when available. + ;; See https://github.com/xenodium/agent-shell/issues/182 + ;; See https://github.com/xenodium/agent-shell/issues/309 + (when-let* ((new-title (map-nested-elt acp-notification '(params update title))) + ((not (string-empty-p new-title)))) + (list (cons :title new-title))) + (when-let* ((description (agent-shell--tool-call-command-to-string + (map-nested-elt acp-notification '(params update rawInput description))))) + (list (cons :description description))) + (when-let* ((command (agent-shell--tool-call-command-to-string + (map-nested-elt acp-notification '(params update rawInput command))))) + (list (cons :command command))) + (when-let ((raw-input (map-nested-elt acp-notification '(params update rawInput)))) + (list (cons :raw-input raw-input))) + (when-let ((diff (agent-shell--make-diff-info + :acp-tool-call (map-nested-elt acp-notification '(params update))))) + (list (cons :diff diff))))) + (agent-shell--cancel-idle-timer) + (agent-shell--emit-event + :event 'tool-call-update + :data (list (cons :tool-call-id (map-nested-elt acp-notification '(params update toolCallId))) + (cons :tool-call (map-nested-elt state `(:tool-calls ,(map-nested-elt acp-notification '(params update toolCallId))))))) + (agent-shell--handle-tool-call-update-streaming state (map-nested-elt acp-notification '(params update))) + (map-put! state :last-entry-type "tool_call_update")) ((equal (map-nested-elt acp-notification '(params update sessionUpdate)) "available_commands_update") (map-put! state :available-commands (map-nested-elt acp-notification '(params update availableCommands))) (agent-shell--update-fragment @@ -1932,6 +1891,25 @@ COMMAND, when present, may be a shell command string or an argv vector." :create-new t :navigation 'never) (map-put! state :last-entry-type nil)))) + ((equal (map-elt acp-notification 'method) "_claude/sdkMessage") + ;; claude-agent-acp's raw SDK message passthrough. Sessions + ;; opted into via _meta.claudeCode.emitRawSDKMessages: t (see + ;; `agent-shell--session-new-meta') receive every SDK system + ;; message here — including hook_started/hook_progress/ + ;; hook_response events the ACP layer otherwise drops at + ;; acp-agent.ts:837-852. Surfacing them in the debug log lets + ;; us see hook-driven turn behavior such as Stop-hook + ;; decision:block bounce-and-regenerate cycles. + (when agent-shell-logging-enabled + (agent-shell--log + "_claude/sdkMessage" + "%s" + (with-temp-buffer + (insert (json-serialize + (or (map-nested-elt acp-notification '(params message)) + acp-notification))) + (json-pretty-print (point-min) (point-max)) + (buffer-string))))) (acp-logging-enabled (agent-shell--update-fragment :state state @@ -1955,7 +1933,7 @@ COMMAND, when present, may be a shell command string or an argv vector." (buffer-string))) :create-new t :navigation 'never) - (map-put! state :last-entry-type nil)))) + (map-put! state :last-entry-type nil)))))) (cl-defun agent-shell--on-request (&key state acp-request) "Handle incoming ACP-REQUEST using STATE." @@ -2847,8 +2825,8 @@ SESSION-STRATEGY overrides `agent-shell-session-strategy' buffer-locally. SESSION-ID resumes an existing session by its id string. FORK-SESSION-ID forks an existing session by its id string. OUTGOING-REQUEST-DECORATOR is passed through to `acp-make-client'." - (unless (version<= "0.90.1" shell-maker-version) - (error "Please update shell-maker to version 0.90.1 or newer")) + (unless (version<= "0.91.2" shell-maker-version) + (error "Please update shell-maker to version 0.91.2 or newer")) (unless (version<= "0.11.1" acp-package-version) (error "Please update acp.el to version 0.11.1 or newer")) (when (boundp 'agent-shell--transcript-file-path-function) @@ -2882,6 +2860,8 @@ variable (see makunbound)")) (with-current-buffer shell-buffer ;; Apply dir-local variables in agent-shell buffer (hack-dir-local-variables-non-file-buffer) + ;; Set minimal buffer-local state initialization so `agent-shell-get-config' is available. + (setq-local agent-shell--state (agent-shell--make-state :agent-config config)) (unless (and (map-elt config :client-maker) (funcall (map-elt config :client-maker) (current-buffer))) (kill-buffer shell-buffer) @@ -2892,7 +2872,7 @@ variable (see makunbound)")) (error "%s" (agent-shell--make-missing-executable-error :executable command :install-instructions (map-elt config :install-instructions))))) - ;; Initialize buffer-local state + ;; Initialize full buffer-local state (replaces the minimal one above). (setq-local agent-shell--state (agent-shell--make-state :buffer shell-buffer :heartbeat (agent-shell-heartbeat-make @@ -3043,6 +3023,137 @@ variable (see makunbound)")) (error "Editing the wrong buffer: %s" (current-buffer))) (agent-shell-ui-delete-fragment :namespace-id (map-elt state :request-count) :block-id block-id :no-undo t))) +(defmacro agent-shell--with-preserved-process-mark (&rest body) + "Evaluate BODY, then restore process-mark to its pre-BODY position. +Fragment updates insert text before the process-mark (above the prompt), +so the saved marker uses insertion-type nil to stay anchored while the +live process-mark is pushed forward by the insertion." + (declare (indent 0) (debug body)) + (let ((proc-sym (make-symbol "proc")) + (saved-sym (make-symbol "saved-pmark"))) + `(let* ((,proc-sym (get-buffer-process (current-buffer))) + (,saved-sym (when ,proc-sym + (copy-marker (process-mark ,proc-sym))))) + (agent-shell-invariants-on-process-mark-save + (when ,saved-sym (marker-position ,saved-sym))) + (unwind-protect + (progn ,@body) + (when ,saved-sym + (set-marker (process-mark ,proc-sym) ,saved-sym) + (agent-shell-invariants-on-process-mark-restore + (marker-position ,saved-sym) + (marker-position (process-mark ,proc-sym))) + (set-marker ,saved-sym nil)))))) + +(defun agent-shell--insert-cursor () + "Return the insertion cursor for the current shell buffer. +The cursor is a marker with insertion-type t that advances past +each fragment inserted before it, ensuring fragments appear in +creation order. Created lazily at the process-mark position." + (let* ((state (agent-shell--state)) + (cursor (map-elt state :insert-cursor))) + (if (and (markerp cursor) + (marker-buffer cursor) + (eq (marker-buffer cursor) (current-buffer))) + cursor + ;; Create a new cursor at the process-mark. + (when-let ((proc (get-buffer-process (current-buffer)))) + (let ((m (copy-marker (process-mark proc) t))) ; insertion-type t + (map-put! state :insert-cursor m) + m))))) + +(defun agent-shell--reset-insert-cursor () + "Reset the insertion cursor so the next fragment starts at the process-mark. +Called when a new turn begins or the prompt reappears." + (when-let ((state (agent-shell--state)) + (cursor (map-elt state :insert-cursor)) + ((markerp cursor))) + (set-marker cursor nil) + (map-put! state :insert-cursor nil))) + +(defcustom agent-shell-markdown-overlay-debounce-delay 0.15 + "Idle time in seconds before applying markdown overlays during streaming. +Lower values keep overlays closer to live but cost more CPU when +the model emits tokens rapidly. Raise this on slower terminals +or when debugging streaming issues." + :type 'number + :group 'agent-shell) + +(defvar-local agent-shell--markdown-overlay-timer nil + "Idle timer for debounced markdown overlay processing.") + +(defun agent-shell--apply-markdown-overlays (range) + "Apply markdown overlays to body and right label in RANGE." + (when-let ((body-start (map-nested-elt range '(:body :start))) + (body-end (map-nested-elt range '(:body :end)))) + (narrow-to-region body-start body-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (markdown-overlays-put)) + (widen)) + ;; Note: skipping markdown overlays on left labels as + ;; they carry propertized text for statuses (boxed). + (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) + (label-right-end (map-nested-elt range '(:label-right :end)))) + (narrow-to-region label-right-start label-right-end) + (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) + (markdown-overlays-put)) + (widen))) + +(defun agent-shell--range-positions-to-markers (range) + "Convert integer positions in RANGE to markers for deferred use. +Returns a copy of RANGE with :start/:end values replaced by markers +so the range remains valid after buffer modifications." + (let ((result nil)) + (dolist (entry range) + (let* ((key (car entry)) + (val (cdr entry))) + (if (and (listp val) + (map-elt val :start) + (map-elt val :end)) + (push (cons key (list (cons :start (copy-marker (map-elt val :start))) + (cons :end (copy-marker (map-elt val :end))))) + result) + (push entry result)))) + (nreverse result))) + +(defun agent-shell--range-cleanup-markers (range) + "Release markers in RANGE created by `agent-shell--range-positions-to-markers'." + (dolist (entry range) + (let ((val (cdr entry))) + (when (listp val) + (let ((s (map-elt val :start)) + (e (map-elt val :end))) + (when (markerp s) (set-marker s nil)) + (when (markerp e) (set-marker e nil))))))) + +(defun agent-shell--schedule-markdown-overlays (buffer range) + "Schedule markdown overlay processing for RANGE in BUFFER at idle time. +Cancels any pending timer so only the latest range is processed. +Converts RANGE positions to markers so they track buffer modifications +between scheduling and firing. + +If the fragment containing RANGE is rebuilt before the timer fires +\(label change, full body replacement, etc.), the markers may +collapse onto a single point — the deleted region is gone. The +overlay pass then no-ops on a zero-width region, which is harmless; +the next streaming chunk schedules a fresh range." + (with-current-buffer buffer + (when (timerp agent-shell--markdown-overlay-timer) + (cancel-timer agent-shell--markdown-overlay-timer)) + (let ((marker-range (agent-shell--range-positions-to-markers range))) + (setq agent-shell--markdown-overlay-timer + (run-with-idle-timer + agent-shell-markdown-overlay-debounce-delay nil + (lambda () + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (save-restriction + (let ((inhibit-read-only t)) + (agent-shell--apply-markdown-overlays marker-range)))) + (agent-shell--range-cleanup-markers marker-range) + (setq agent-shell--markdown-overlay-timer nil))))))))) + (cl-defun agent-shell--update-fragment (&key state namespace-id block-id label-left label-right body append create-new navigation expanded render-body-images) @@ -3133,8 +3244,9 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." (equal (current-buffer) (map-elt state :buffer))) (error "Editing the wrong buffer: %s" (current-buffer))) - (shell-maker-with-auto-scroll-edit - (when-let* ((range (agent-shell-ui-update-fragment + (agent-shell--with-preserved-process-mark + (shell-maker-with-auto-scroll-edit + (when-let* ((range (agent-shell-ui-update-fragment (agent-shell-ui-make-fragment-model :namespace-id (or namespace-id (map-elt state :request-count)) @@ -3146,40 +3258,34 @@ by default, RENDER-BODY-IMAGES to enable inline image rendering in body." :append append :create-new create-new :expanded expanded - :no-undo t)) + :no-undo t + :insert-before (agent-shell--insert-cursor))) (padding-start (map-nested-elt range '(:padding :start))) (padding-end (map-nested-elt range '(:padding :end))) (block-start (map-nested-elt range '(:block :start))) (block-end (map-nested-elt range '(:block :end)))) - (save-restriction - ;; TODO: Move this to shell-maker? - (let ((inhibit-read-only t)) - ;; comint relies on field property to - ;; derive `comint-next-prompt'. - ;; Marking as field to avoid false positives in - ;; `agent-shell-next-item' and `agent-shell-previous-item'. - (add-text-properties (or padding-start block-start) - (or padding-end block-end) '(field output))) - ;; Apply markdown overlay to body. - (when-let ((body-start (map-nested-elt range '(:body :start))) - (body-end (map-nested-elt range '(:body :end)))) - (narrow-to-region body-start body-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) - (widen)) - ;; - ;; Note: For now, we're skipping applying markdown overlays - ;; on left labels as they currently carry propertized text - ;; for statuses (ie. boxed). - ;; - ;; Apply markdown overlay to right label. - (when-let ((label-right-start (map-nested-elt range '(:label-right :start))) - (label-right-end (map-nested-elt range '(:label-right :end)))) - (narrow-to-region label-right-start label-right-end) - (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks)) - (markdown-overlays-put)) - (widen))) - (run-hook-with-args 'agent-shell-section-functions range))))) + ;; markdown-overlays-put moves point (its parsers use + ;; goto-char), so save-excursion keeps point stable. + (save-excursion + (save-restriction + (let ((inhibit-read-only t)) + (add-text-properties (or padding-start block-start) + (or padding-end block-end) '(field output))) + ;; Apply markdown overlays. During streaming appends the + ;; full re-parse is expensive (O(n) per chunk → O(n²) + ;; overall), so debounce to idle time. Non-append updates + ;; (new blocks, label changes) run synchronously. + (if append + (agent-shell--schedule-markdown-overlays + (current-buffer) range) + (agent-shell--apply-markdown-overlays range)))) + (run-hook-with-args 'agent-shell-section-functions range) + (agent-shell-invariants-on-update-fragment + (cond (create-new "create") + (append "append") + (t "rebuild")) + (or namespace-id (map-elt state :request-count)) + block-id append)))))) (cl-defun agent-shell--update-text (&key state namespace-id block-id text append create-new) "Update plain text entry in the shell buffer. @@ -3205,18 +3311,25 @@ APPEND and CREATE-NEW control update behavior." :create-new create-new :no-undo t)))) (with-current-buffer (map-elt state :buffer) - (shell-maker-with-auto-scroll-edit - (when-let* ((range (agent-shell-ui-update-text - :namespace-id ns - :block-id block-id - :text text - :append append - :create-new create-new - :no-undo t)) - (block-start (map-nested-elt range '(:block :start))) - (block-end (map-nested-elt range '(:block :end)))) - (let ((inhibit-read-only t)) - (add-text-properties block-start block-end '(field output)))))))) + (agent-shell--with-preserved-process-mark + (shell-maker-with-auto-scroll-edit + (when-let* ((range (agent-shell-ui-update-text + :namespace-id ns + :block-id block-id + :text text + :append append + :create-new create-new + :no-undo t + :insert-before (agent-shell--insert-cursor))) + (block-start (map-nested-elt range '(:block :start))) + (block-end (map-nested-elt range '(:block :end)))) + (let ((inhibit-read-only t)) + (add-text-properties block-start block-end '(field output))) + (agent-shell-invariants-on-update-fragment + (cond (create-new "create") + (append "append") + (t "rebuild")) + ns block-id append))))))) (defun agent-shell-toggle-logging () "Toggle logging." @@ -4115,7 +4228,8 @@ Must provide ON-INITIATED (lambda ())." (title . "Emacs Agent Shell") (version . ,agent-shell--version)) :read-text-file-capability agent-shell-text-file-capabilities - :write-text-file-capability agent-shell-text-file-capabilities) + :write-text-file-capability agent-shell-text-file-capabilities + :meta-capabilities '((terminal_output . t))) :on-success (lambda (acp-response) (with-current-buffer shell-buffer (let ((acp-session-capabilities (or (map-elt acp-response 'sessionCapabilities) @@ -4543,6 +4657,25 @@ Falls back to latest session in batch mode (e.g. tests)." (agent-shell--emit-event :event 'init-session) (funcall on-session-init)) +(defun agent-shell--session-new-meta () + "Return the `_meta' alist to attach to session/new, or nil. + +When `agent-shell-logging-enabled' is non-nil and the active agent +identifier is `claude-code', request that claude-agent-acp forward +every raw SDK message (including hook lifecycle events) via the +`_claude/sdkMessage' extension notification. Without this opt-in the +ACP layer drops `hook_started'/`hook_progress'/`hook_response' system +messages at acp-agent.ts:837-852, leaving the debug log unable to +reveal hook-driven turn behavior such as Stop-hook block-and-regen +cycles. Logging must be enabled before the shell is started for this +to take effect; toggling it later won't retroactively opt the existing +session in." + (when (and agent-shell-logging-enabled + (eq (map-elt (map-elt (agent-shell--state) :agent-config) + :identifier) + 'claude-code)) + '((claudeCode . ((emitRawSDKMessages . t)))))) + (cl-defun agent-shell--initiate-new-session (&key shell-buffer on-session-init) "Initiate ACP session/new with SHELL-BUFFER and ON-SESSION-INIT." (agent-shell--send-request @@ -4550,7 +4683,8 @@ Falls back to latest session in batch mode (e.g. tests)." :client (map-elt (agent-shell--state) :client) :request (acp-make-session-new-request :cwd (agent-shell--resolve-path (agent-shell-cwd)) - :mcp-servers (agent-shell--mcp-servers)) + :mcp-servers (agent-shell--mcp-servers) + :meta (agent-shell--session-new-meta)) :buffer (current-buffer) :on-success (lambda (acp-response) (map-put! agent-shell--state @@ -6085,6 +6219,11 @@ Returns an alist with insertion details or nil otherwise: (let ((markdown-overlays-highlight-blocks agent-shell-highlight-blocks) (markdown-overlays-render-images nil)) (markdown-overlays-put)))) + ;; Leave point at the start of the inserted region so the + ;; user lands on their context, not after it — DWIM users + ;; expect to keep typing where the prompt is, not below + ;; the freshly-inserted text. + (goto-char insert-start) (when submit (shell-maker-submit))) `((:buffer . ,shell-buffer) diff --git a/tests/agent-shell-invariants-tests.el b/tests/agent-shell-invariants-tests.el new file mode 100644 index 00000000..0f383518 --- /dev/null +++ b/tests/agent-shell-invariants-tests.el @@ -0,0 +1,218 @@ +;;; agent-shell-invariants-tests.el --- Tests for agent-shell-invariants -*- lexical-binding: t; -*- + +;;; Commentary: +;; +;; Tests for the invariant checking and event tracing system. + +;;; Code: + +(require 'ert) +(require 'agent-shell-invariants) +(require 'agent-shell-ui) + +;;; --- Event ring tests ----------------------------------------------------- + +(ert-deftest agent-shell-invariants--record-populates-ring-test () + "Test that recording events populates the ring buffer." + (with-temp-buffer + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0)) + (agent-shell-invariants--record 'test-op :foo "bar") + (agent-shell-invariants--record 'test-op-2 :baz 42) + (should (= (ring-length agent-shell-invariants--ring) 2)) + (let ((events (agent-shell-invariants--events))) + (should (= (length events) 2)) + ;; Oldest first + (should (eq (plist-get (car events) :op) 'test-op)) + (should (eq (plist-get (cadr events) :op) 'test-op-2)) + ;; Sequence numbers increment + (should (= (plist-get (car events) :seq) 1)) + (should (= (plist-get (cadr events) :seq) 2)))))) + +(ert-deftest agent-shell-invariants--record-noop-when-disabled-test () + "Test that recording does nothing when invariants are disabled." + (with-temp-buffer + (let ((agent-shell-invariants-enabled nil) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0)) + (agent-shell-invariants--record 'test-op :foo "bar") + (should-not agent-shell-invariants--ring)))) + +(ert-deftest agent-shell-invariants--ring-wraps-test () + "Test that the ring drops oldest events when full." + (with-temp-buffer + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0) + (agent-shell-invariants-ring-size 3)) + (dotimes (i 5) + (agent-shell-invariants--record 'test-op :i i)) + (should (= (ring-length agent-shell-invariants--ring) 3)) + (let ((events (agent-shell-invariants--events))) + ;; Should have events 3, 4, 5 (seq 3, 4, 5) + (should (= (plist-get (car events) :seq) 3)) + (should (= (plist-get (car (last events)) :seq) 5)))))) + +;;; --- Invariant check tests ------------------------------------------------ + +(ert-deftest agent-shell-invariants--check-ui-state-contiguity-clean-test () + "Test that contiguity check passes for well-formed fragments." + (with-temp-buffer + (let ((inhibit-read-only t) + (state (list (cons :qualified-id "ns-1") (cons :collapsed nil)))) + (insert "fragment content") + (add-text-properties 1 (point) (list 'agent-shell-ui-state state))) + (should-not (agent-shell-invariants--check-ui-state-contiguity)))) + +(ert-deftest agent-shell-invariants--check-ui-state-contiguity-gap-test () + "Test that contiguity check detects gaps within a fragment." + (with-temp-buffer + (let ((inhibit-read-only t) + (state (list (cons :qualified-id "ns-1") (cons :collapsed nil)))) + ;; First span + (insert "part1") + (add-text-properties 1 (point) (list 'agent-shell-ui-state state)) + ;; Gap with no property + (insert "gap") + ;; Second span with same fragment id + (let ((start (point))) + (insert "part2") + (add-text-properties start (point) (list 'agent-shell-ui-state state)))) + (should (agent-shell-invariants--check-ui-state-contiguity)))) + +;;; --- Violation handler tests ---------------------------------------------- + +(ert-deftest agent-shell-invariants--on-violation-creates-bundle-buffer-test () + "Test that violation handler creates a debug bundle buffer." + (with-temp-buffer + (rename-buffer "*agent-shell test-inv*" t) + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0) + (bundle-buf-name (format "*agent-shell invariant [%s]*" + (buffer-name)))) + ;; Record a couple events + (agent-shell-invariants--record 'test-op :detail "setup") + ;; Trigger violation + (agent-shell-invariants--on-violation + 'test-trigger + '((test-check . "something went wrong"))) + ;; Bundle buffer should exist + (should (get-buffer bundle-buf-name)) + (with-current-buffer bundle-buf-name + (should (string-match-p "INVARIANT VIOLATION" (buffer-string))) + (should (string-match-p "something went wrong" (buffer-string))) + (should (string-match-p "test-trigger" (buffer-string))) + (should (string-match-p "Recommended Prompt" (buffer-string)))) + (kill-buffer bundle-buf-name)))) + +(ert-deftest agent-shell-invariants--on-violation-snapshots-head-and-tail-test () + "Bundle includes both head and tail snippets when buffer exceeds the window. +The 2000-char window from `point-min' alone misses violations +that fire near `point-max' on long sessions; both snippets must +appear in the bundle." + (with-temp-buffer + (rename-buffer "*agent-shell test-inv-long*" t) + ;; Build a buffer with distinctive head and tail markers separated + ;; by enough filler that neither end-snippet alone would contain + ;; both markers. + (insert "HEAD-MARKER ") + (insert (make-string 5000 ?x)) + (insert " TAIL-MARKER") + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0) + (bundle-buf-name (format "*agent-shell invariant [%s]*" + (buffer-name)))) + (agent-shell-invariants--on-violation + 'long-buffer-trigger + '((test-check . "long-buffer test"))) + (with-current-buffer bundle-buf-name + (let ((bundle (buffer-string))) + (should (string-match-p "Buffer Snapshot Head" bundle)) + (should (string-match-p "Buffer Snapshot Tail" bundle)) + (should (string-match-p "HEAD-MARKER" bundle)) + (should (string-match-p "TAIL-MARKER" bundle)))) + (kill-buffer bundle-buf-name)))) + +(ert-deftest agent-shell-invariants--on-violation-single-snapshot-when-short-test () + "Short buffers fit in a single snapshot section, no head/tail split." + (with-temp-buffer + (rename-buffer "*agent-shell test-inv-short*" t) + (insert "ONLY-MARKER plus a little filler text") + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0) + (bundle-buf-name (format "*agent-shell invariant [%s]*" + (buffer-name)))) + (agent-shell-invariants--on-violation + 'short-buffer-trigger + '((test-check . "short"))) + (with-current-buffer bundle-buf-name + (let ((bundle (buffer-string))) + (should (string-match-p "ONLY-MARKER" bundle)) + (should-not (string-match-p "Snapshot Head" bundle)) + (should-not (string-match-p "Snapshot Tail" bundle)))) + (kill-buffer bundle-buf-name)))) + +;;; --- Mutation hook tests -------------------------------------------------- + +(ert-deftest agent-shell-invariants-on-notification-records-event-test () + "Test that notification hook records to the event ring." + (with-temp-buffer + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0)) + (agent-shell-invariants-on-notification "tool_call" "tc-123") + (let ((events (agent-shell-invariants--events))) + (should (= (length events) 1)) + (should (eq (plist-get (car events) :op) 'notification)) + (should (equal (plist-get (car events) :update-type) "tool_call")) + (should (equal (plist-get (car events) :detail) "tc-123")))))) + +(ert-deftest agent-shell-invariants--format-events-test () + "Test that event formatting produces readable output." + (with-temp-buffer + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0)) + (agent-shell-invariants--record 'test-op :detail "hello") + (let ((formatted (agent-shell-invariants--format-events))) + (should (string-match-p "\\[1\\]" formatted)) + (should (string-match-p "test-op" formatted)) + (should (string-match-p "hello" formatted)))))) + +;;; --- Rate-limiting tests --------------------------------------------------- + +(ert-deftest agent-shell-invariants--violation-reported-once-test () + "Violation handler should only fire once per buffer until flag is cleared." + (with-temp-buffer + (rename-buffer "*agent-shell rate-limit-test*" t) + (let ((agent-shell-invariants-enabled t) + (agent-shell-invariants--ring nil) + (agent-shell-invariants--seq 0) + (agent-shell-invariants--violation-reported nil) + (call-count 0) + (bundle-buf-name (format "*agent-shell invariant [%s]*" + (buffer-name)))) + ;; Override one check to always fail + (let ((agent-shell-invariants--all-checks + (list (lambda () "always fails")))) + ;; First run should report + (agent-shell-invariants--run-checks 'test-op) + (should agent-shell-invariants--violation-reported) + (should (get-buffer bundle-buf-name)) + (kill-buffer bundle-buf-name) + ;; Second run should be suppressed + (agent-shell-invariants--run-checks 'test-op-2) + (should-not (get-buffer bundle-buf-name)) + ;; After clearing the flag, it should report again + (agent-shell-invariants--clear-violation-flag) + (agent-shell-invariants--run-checks 'test-op-3) + (should (get-buffer bundle-buf-name)) + (kill-buffer bundle-buf-name))))) + +(provide 'agent-shell-invariants-tests) + +;;; agent-shell-invariants-tests.el ends here diff --git a/tests/agent-shell-streaming-tests.el b/tests/agent-shell-streaming-tests.el new file mode 100644 index 00000000..2bb88e8b --- /dev/null +++ b/tests/agent-shell-streaming-tests.el @@ -0,0 +1,1262 @@ +;;; agent-shell-streaming-tests.el --- Tests for streaming/dedup -*- lexical-binding: t; -*- + +(require 'ert) +(require 'agent-shell) +(require 'agent-shell-meta) + +;;; Code: + +(ert-deftest agent-shell--tool-call-meta-response-text-test () + "Extract toolResponse text from meta updates." + (let ((update '((_meta . ((agent . ((toolResponse . ((content . "ok")))))))))) + (should (equal (agent-shell--tool-call-meta-response-text update) "ok"))) + (let ((update '((_meta . ((toolResponse . [((type . "text") (text . "one")) + ((type . "text") (text . "two"))])))))) + (should (equal (agent-shell--tool-call-meta-response-text update) + "one\n\ntwo")))) + +(ert-deftest agent-shell--tool-call-normalize-output-strips-fences-test () + "Backtick fence lines should be stripped from output. + +For example: + (agent-shell--tool-call-normalize-output \"```elisp\\n(+ 1 2)\\n```\") + => \"(+ 1 2)\\n\"" + ;; Plain fence + (should (equal (agent-shell--tool-call-normalize-output "```\nhello\n```") + "hello\n")) + ;; Fence with language + (should (equal (agent-shell--tool-call-normalize-output "```elisp\n(+ 1 2)\n```") + "(+ 1 2)\n")) + ;; Fence with leading whitespace + (should (equal (agent-shell--tool-call-normalize-output " ```\nindented\n ```") + "indented\n")) + ;; Non-fence backticks preserved + (should (string-match-p "`inline`" + (agent-shell--tool-call-normalize-output "`inline` code\n")))) + +(ert-deftest agent-shell--tool-call-normalize-output-trailing-newline-test () + "Normalized output should always end with a newline." + (should (string-suffix-p "\n" (agent-shell--tool-call-normalize-output "hello"))) + (should (string-suffix-p "\n" (agent-shell--tool-call-normalize-output "hello\n"))) + (should (equal (agent-shell--tool-call-normalize-output "") "")) + (should (equal (agent-shell--tool-call-normalize-output nil) nil))) + +(ert-deftest agent-shell--tool-call-normalize-output-persisted-output-test () + "Persisted-output tags should be stripped and content fontified." + (let ((result (agent-shell--tool-call-normalize-output + "\nOutput saved to: /tmp/foo.txt\n\nPreview:\nline 0\n"))) + ;; Tags stripped + (should-not (string-match-p "" result)) + (should-not (string-match-p "" result)) + ;; Content preserved + (should (string-match-p "Output saved to" result)) + (should (string-match-p "line 0" result)) + ;; Fontified as comment + (should (eq (get-text-property 1 'font-lock-face result) 'font-lock-comment-face)))) + +(ert-deftest agent-shell--tool-call-update-writes-output-test () + "Tool call updates should write output to the shell buffer." + (let* ((buffer (get-buffer-create " *agent-shell-tool-call-output*")) + (agent-shell--state (agent-shell--make-state :buffer buffer))) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update . ((sessionUpdate . "tool_call_update") + (toolCallId . "call-1") + (status . "completed") + (content . [((content . ((text . "stream chunk"))))])))))))) + (with-current-buffer buffer + (should (string-match-p "stream chunk" (buffer-string))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-meta-response-stdout-no-duplication-test () + "Meta toolResponse.stdout must not produce duplicate output. +Simplified replay without terminal notifications: sends tool_call +\(pending), tool_call_update with _meta stdout, then tool_call_update +\(completed). A distinctive line must appear exactly once." + (let* ((buffer (get-buffer-create " *agent-shell-dedup-test*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_replay_dedup") + (stdout-text "line 0\nline 1\nline 2\nline 3\nline 4\nline 5\nline 6\nline 7\nline 8\nline 9")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; Notification 1: tool_call (pending) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + ;; Notification 2: tool_call_update with toolResponse.stdout + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((_meta (claudeCode (toolResponse (stdout . ,stdout-text) + (stderr . "") + (interrupted) + (isImage) + (noOutputExpected)) + (toolName . "Bash"))) + (toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update"))))))) + ;; Notification 3: tool_call_update completed + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed")))))))) + (with-current-buffer buffer + (let* ((buf-text (buffer-substring-no-properties (point-min) (point-max))) + (count-line5 (let ((c 0) (s 0)) + (while (string-match "line 5" buf-text s) + (setq c (1+ c) s (match-end 0))) + c))) + ;; "line 9" must be present (output was rendered) + (should (string-match-p "line 9" buf-text)) + ;; "line 5" must appear exactly once (no duplication) + (should (= count-line5 1))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-meta-response-cumulative-no-duplication-test () + "Cumulative meta toolResponse.stdout across multiple updates must not duplicate. +Some agents re-send the full accumulated stdout on every +tool_call_update before the final notification. Without delta +detection, every revision concatenates into the rendered output." + (let* ((buffer (get-buffer-create " *agent-shell-cumulative-dedup-test*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_replay_cumulative") + (line1 "line 0\nline 1\nline 2") + (line2 (concat line1 "\nline 3\nline 4\nline 5")) + (line3 (concat line2 "\nline 6\nline 7\nline 8\nline 9"))) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + (dolist (cumulative (list line1 line2 line3)) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((_meta (claudeCode (toolResponse (stdout . ,cumulative)))) + (toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update"))))))) +) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed")))))))) + (with-current-buffer buffer + (let* ((buf-text (buffer-substring-no-properties (point-min) (point-max))) + (count-line2 (let ((c 0) (s 0)) + (while (string-match "line 2" buf-text s) + (setq c (1+ c) s (match-end 0))) + c))) + (should (string-match-p "line 9" buf-text)) + ;; Without delta dedup, "line 2" appears 3× (once per cumulative). + (should (= count-line2 1))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--initialize-request-includes-terminal-output-meta-test () + "Initialize request should include terminal_output meta capability. +Without this, agents like claude-agent-acp will not send +toolResponse.stdout streaming updates." + (let* ((buffer (get-buffer-create " *agent-shell-init-request*")) + (agent-shell--state (agent-shell--make-state :buffer buffer))) + (map-put! agent-shell--state :client 'test-client) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode) + (setq-local agent-shell--state agent-shell--state)) + (unwind-protect + (let ((captured-request nil)) + (cl-letf (((symbol-function 'acp-send-request) + (lambda (&rest args) + (setq captured-request (plist-get args :request))))) + (agent-shell--initiate-handshake + :shell-buffer buffer + :on-initiated (lambda () nil))) + (should (eq t (map-nested-elt captured-request + '(:params clientCapabilities _meta terminal_output))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--codex-terminal-output-streams-without-duplication-test () + "Codex-acp streams via terminal_output.data; output must not duplicate. +Replays the codex notification pattern: tool_call with terminal content, +incremental terminal_output.data chunks, then completed update." + (let* ((buffer (get-buffer-create " *agent-shell-codex-dedup*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "call_codex_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; Notification 1: tool_call (in_progress, terminal content) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call") + (toolCallId . ,tool-id) + (title . "Run echo test") + (kind . "execute") + (status . "in_progress") + (content . [((type . "terminal") + (terminalId . ,tool-id))]) + (_meta (terminal_info + (terminal_id . ,tool-id))))))))) + ;; Notification 2: first terminal_output.data chunk + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (_meta (terminal_output + (terminal_id . ,tool-id) + (data . "alpha\n"))))))))) + ;; Notification 3: second terminal_output.data chunk + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (_meta (terminal_output + (terminal_id . ,tool-id) + (data . "bravo\n"))))))))) + ;; Notification 4: completed + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (status . "completed") + (_meta (terminal_exit + (terminal_id . ,tool-id) + (exit_code . 0))))))))))) + (with-current-buffer buffer + (let* ((buf-text (buffer-substring-no-properties (point-min) (point-max))) + (count-alpha (let ((c 0) (s 0)) + (while (string-match "alpha" buf-text s) + (setq c (1+ c) s (match-end 0))) + c))) + ;; Both chunks rendered + (should (string-match-p "alpha" buf-text)) + (should (string-match-p "bravo" buf-text)) + ;; No duplication + (should (= count-alpha 1)) + ;; Streamed-append text must carry the same comint / + ;; tooltip properties the initial body insert applies, or + ;; comint field navigation and prompt-boundary detection + ;; degrade across the streamed region. Walk every "bravo" + ;; position (the second streamed chunk, inserted via the + ;; bypass path). + (save-excursion + (goto-char (point-min)) + (let ((found nil)) + (while (search-forward "bravo" nil t) + (setq found t) + (let ((p (match-beginning 0))) + (should (eq (get-text-property p 'field) 'output)) + (should (eq (get-text-property p 'agent-shell-ui-section) 'body)) + (should (stringp (get-text-property p 'help-echo))))) + (should found))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--mixed-source-output-no-duplication-test () + "Tool output streamed via terminal_output and finalized via _meta.toolResponse must dedup. +Some agents stream incremental terminal_output.data while in +progress, then send the full stdout via _meta.toolResponse on the +final update. The accumulator must recognize the cumulative +re-delivery and not re-emit text already present." + (let* ((buffer (get-buffer-create " *agent-shell-mixed-source*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "call_mixed_source")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call: in_progress with terminal content placeholder. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call") + (toolCallId . ,tool-id) + (title . "Run mixed test") + (kind . "execute") + (status . "in_progress") + (content . [((type . "terminal") + (terminalId . ,tool-id))]))))))) + ;; Two streamed terminal_output chunks. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (_meta (terminal_output + (terminal_id . ,tool-id) + (data . "hello\n"))))))))) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (_meta (terminal_output + (terminal_id . ,tool-id) + (data . "world\n"))))))))) + ;; Final completed update carries _meta.toolResponse.stdout + ;; with the full output (no terminal_output.data this time). + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (status . "completed") + (_meta (claudeCode + (toolResponse + (stdout . "hello\nworld\n")))))))))) + (let* ((buf-text (buffer-substring-no-properties (point-min) (point-max))) + (count-occurrences (lambda (needle) + (let ((c 0) (s 0)) + (while (string-match (regexp-quote needle) buf-text s) + (setq c (1+ c) s (match-end 0))) + c)))) + (should (string-match-p "hello" buf-text)) + (should (string-match-p "world" buf-text)) + (should (= 1 (funcall count-occurrences "hello"))) + (should (= 1 (funcall count-occurrences "world")))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--mixed-source-output-extends-with-final-tail-test () + "If _meta.toolResponse on the final update carries text the stream missed, append it." + (let* ((buffer (get-buffer-create " *agent-shell-mixed-source-tail*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "call_mixed_source_tail")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call") + (toolCallId . ,tool-id) + (title . "Run extends test") + (kind . "execute") + (status . "in_progress") + (content . [((type . "terminal") + (terminalId . ,tool-id))]))))))) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (_meta (terminal_output + (terminal_id . ,tool-id) + (data . "first chunk\n"))))))))) + ;; Final brings the full stdout — the second line was never + ;; streamed via terminal_output. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,tool-id) + (status . "completed") + (_meta (claudeCode + (toolResponse + (stdout . "first chunk\nsecond chunk\n")))))))))) + (let ((buf-text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "first chunk" buf-text)) + (should (string-match-p "second chunk" buf-text)) + (let ((c 0) (s 0)) + (while (string-match "first chunk" buf-text s) + (setq c (1+ c) s (match-end 0))) + (should (= 1 c)))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + + +;;; Thought chunk dedup tests + +(ert-deftest agent-shell--thought-chunk-delta-incremental-test () + "Incremental tokens with no prefix overlap pass through unchanged." + (should (equal (agent-shell--thought-chunk-delta "AB" "CD") "CD")) + (should (equal (agent-shell--thought-chunk-delta nil "hello") "hello")) + (should (equal (agent-shell--thought-chunk-delta "" "hello") "hello"))) + +(ert-deftest agent-shell--thought-chunk-delta-cumulative-test () + "Cumulative re-delivery returns only the new tail." + (should (equal (agent-shell--thought-chunk-delta "AB" "ABCD") "CD")) + (should (equal (agent-shell--thought-chunk-delta "hello " "hello world") "world"))) + +(ert-deftest agent-shell--thought-chunk-delta-exact-duplicate-test () + "Exact duplicate returns empty string." + (should (equal (agent-shell--thought-chunk-delta "ABCD" "ABCD") ""))) + +(ert-deftest agent-shell--thought-chunk-delta-suffix-test () + "Chunk already present as suffix of accumulated returns empty string. +This handles the case where leading whitespace tokens were streamed +incrementally but the re-delivery omits them." + (should (equal (agent-shell--thought-chunk-delta "\n\nABCD" "ABCD") "")) + (should (equal (agent-shell--thought-chunk-delta "\n\n**bold**" "**bold**") ""))) + +(ert-deftest agent-shell--thought-chunk-delta-partial-overlap-test () + "Partial overlap between tail of accumulated and head of chunk. +When an agent re-delivers text that partially overlaps with what +was already accumulated, only the genuinely new portion is returned." + (should (equal (agent-shell--thought-chunk-delta "ABCD" "CDEF") "EF")) + (should (equal (agent-shell--thought-chunk-delta "hello world" "world!") "!")) + (should (equal (agent-shell--thought-chunk-delta "abc" "cde") "de")) + ;; No overlap falls through to full chunk + (should (equal (agent-shell--thought-chunk-delta "AB" "CD") "CD"))) + +(ert-deftest agent-shell--thought-chunk-no-duplication-test () + "Thought chunks must not produce duplicate output in the buffer. +Replays the codex doubling pattern: incremental tokens followed by +a cumulative re-delivery of the complete thought text." + (let* ((buffer (get-buffer-create " *agent-shell-thought-dedup*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (thought-text "**Checking beads**\n\nLooking for .beads directory.")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf () + (with-current-buffer buffer + ;; Send incremental tokens + (dolist (token (list "\n\n" "**Checking" " beads**" "\n\n" + "Looking" " for" " .beads" " directory.")) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_thought_chunk") + (content (type . "text") + (text . ,token))))))))) + ;; Cumulative re-delivery of the complete text + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_thought_chunk") + (content (type . "text") + (text . ,thought-text)))))))) + (let* ((buf-text (buffer-substring-no-properties (point-min) (point-max))) + (count (let ((c 0) (s 0)) + (while (string-match "Checking beads" buf-text s) + (setq c (1+ c) s (match-end 0))) + c))) + ;; Content must be present + (should (string-match-p "Checking beads" buf-text)) + ;; Must appear exactly once (no duplication) + (should (= count 1))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell-ui-update-fragment-append-preserves-point-test () + "Appending body text must not displace point. +The append-in-place path inserts at the body end without +delete-and-reinsert, so markers (and thus point via save-excursion) +remain stable." + (with-temp-buffer + (let ((inhibit-read-only t)) + ;; Create a fragment with initial body + (let ((model (list (cons :namespace-id "1") + (cons :block-id "pt") + (cons :label-left "Status") + (cons :body "first chunk")))) + (agent-shell-ui-update-fragment model :expanded t)) + ;; Place point inside the body text + (goto-char (point-min)) + (search-forward "first") + (let ((saved (point))) + ;; Append more body text + (let ((model2 (list (cons :namespace-id "1") + (cons :block-id "pt") + (cons :body " second chunk")))) + (agent-shell-ui-update-fragment model2 :append t :expanded t)) + ;; Point must not have moved + (should (= (point) saved)) + ;; Both chunks present in correct order + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "first chunk second chunk" text))))))) + +(ert-deftest agent-shell-ui-update-fragment-append-with-label-change-test () + "Appending body with a new label must update the label. +The in-place append path must fall back to a full rebuild when the +caller provides a new :label-left or :label-right alongside :append t, +otherwise the label change is silently dropped." + (with-temp-buffer + (let ((inhibit-read-only t)) + ;; Create a fragment with initial label and body + (let ((model (list (cons :namespace-id "1") + (cons :block-id "boot") + (cons :label-left "[busy] Starting") + (cons :body "Initializing...")))) + (agent-shell-ui-update-fragment model :expanded t)) + ;; Verify initial label + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "\\[busy\\] Starting" text))) + ;; Append body AND change label + (let ((model2 (list (cons :namespace-id "1") + (cons :block-id "boot") + (cons :label-left "[done] Starting") + (cons :body "\n\nReady")))) + (agent-shell-ui-update-fragment model2 :append t :expanded t)) + ;; Label must now say [done], not [busy] + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "\\[done\\] Starting" text)) + (should-not (string-match-p "\\[busy\\]" text)) + ;; Body should contain both chunks + (should (string-match-p "Initializing" text)) + (should (string-match-p "Ready" text)))))) + +(ert-deftest agent-shell-ui-update-fragment-append-preserves-single-newline-test () + "Appending a chunk whose text starts with a single newline must +preserve that newline. Regression: the append-in-place path +previously stripped leading newlines from each chunk, collapsing +markdown list item separators (e.g. \"&&.\\n2.\" became \"&&.2.\")." + (with-temp-buffer + (let ((inhibit-read-only t)) + (let ((model (list (cons :namespace-id "1") + (cons :block-id "nl") + (cons :label-left "Agent") + (cons :body "1. First item")))) + (agent-shell-ui-update-fragment model :expanded t)) + (let ((model2 (list (cons :namespace-id "1") + (cons :block-id "nl") + (cons :body "\n2. Second item")))) + (agent-shell-ui-update-fragment model2 :append t :expanded t)) + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "First item\n.*2\\. Second item" text)))))) + +(ert-deftest agent-shell-ui-update-fragment-append-preserves-double-newline-test () + "Appending a chunk starting with a double newline (paragraph break) +must preserve both newlines." + (with-temp-buffer + (let ((inhibit-read-only t)) + (let ((model (list (cons :namespace-id "1") + (cons :block-id "dnl") + (cons :label-left "Agent") + (cons :body "Paragraph one.")))) + (agent-shell-ui-update-fragment model :expanded t)) + (let ((model2 (list (cons :namespace-id "1") + (cons :block-id "dnl") + (cons :body "\n\nParagraph two.")))) + (agent-shell-ui-update-fragment model2 :append t :expanded t)) + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "Paragraph one\\.\n.*\n.*Paragraph two" text)))))) + +(ert-deftest agent-shell-ui-update-fragment-append-caps-boundary-newlines-test () + "Boundary newlines between existing body and appended chunk cap at two. +When the existing body already ends in newline(s) and the appended chunk +starts with newline(s), naive concatenation yields three or more +consecutive newlines (an extra blank line). Cap the run at two." + (with-temp-buffer + (let ((inhibit-read-only t)) + ;; Existing body ends with one trailing \n. + (let ((model (list (cons :namespace-id "1") + (cons :block-id "cap") + (cons :label-left "Agent") + (cons :body "First line.\n")))) + (agent-shell-ui-update-fragment model :expanded t)) + ;; Appended chunk leads with two newlines (paragraph break). + (let ((model2 (list (cons :namespace-id "1") + (cons :block-id "cap") + (cons :body "\n\nSecond line.")))) + (agent-shell-ui-update-fragment model2 :append t :expanded t)) + (let ((text (buffer-substring-no-properties (point-min) (point-max)))) + ;; Expect exactly two newlines between "First line." and "Second line.". + (should (string-match-p "First line\\.\n\nSecond line\\." text)) + (should-not (string-match-p "First line\\.\n\n\n" text)))))) + +;;; Insert-before tests (content above prompt) + +(ert-deftest agent-shell-ui-update-fragment-insert-before-test () + "New fragment with :insert-before inserts above that position. +Simulates a prompt at the end of the buffer; the new fragment +must appear before the prompt text, not after it." + (with-temp-buffer + (let ((inhibit-read-only t)) + ;; Simulate existing output followed by a prompt. + (insert "previous output\n\nClaude Code> ") + (let ((prompt-start (- (point) (length "Claude Code> ")))) + ;; Insert a notice fragment before the prompt. + (let ((model (list (cons :namespace-id "1") + (cons :block-id "notice") + (cons :label-left "Notices") + (cons :body "Something happened")))) + (agent-shell-ui-update-fragment model + :expanded t + :insert-before prompt-start)) + ;; The prompt must still be at the end. + (should (string-suffix-p "Claude Code> " + (buffer-substring-no-properties (point-min) (point-max)))) + ;; The notice body must appear before the prompt. + (let ((notice-pos (save-excursion + (goto-char (point-min)) + (search-forward "Something happened" nil t))) + (prompt-pos (save-excursion + (goto-char (point-min)) + (search-forward "Claude Code> " nil t)))) + (should notice-pos) + (should prompt-pos) + (should (< notice-pos prompt-pos))))))) + +(ert-deftest agent-shell-ui-update-text-insert-before-test () + "New text entry with :insert-before inserts above that position." + (with-temp-buffer + (let ((inhibit-read-only t)) + (insert "previous output\n\nClaude Code> ") + (let ((prompt-start (- (point) (length "Claude Code> ")))) + (agent-shell-ui-update-text + :namespace-id "1" + :block-id "user-msg" + :text "yes" + :insert-before prompt-start) + ;; Prompt must remain at the end. + (should (string-suffix-p "Claude Code> " + (buffer-substring-no-properties (point-min) (point-max)))) + ;; User message must appear before the prompt. + (let ((msg-pos (save-excursion + (goto-char (point-min)) + (search-forward "yes" nil t))) + (prompt-pos (save-excursion + (goto-char (point-min)) + (search-forward "Claude Code> " nil t)))) + (should msg-pos) + (should prompt-pos) + (should (< msg-pos prompt-pos))))))) + +(ert-deftest agent-shell-ui-update-fragment-insert-before-nil-test () + "When :insert-before is nil, new fragment inserts at end (default)." + (with-temp-buffer + (let ((inhibit-read-only t)) + (insert "previous output") + (let ((model (list (cons :namespace-id "1") + (cons :block-id "msg") + (cons :label-left "Agent") + (cons :body "hello")))) + (agent-shell-ui-update-fragment model :expanded t :insert-before nil)) + (should (string-suffix-p "hello\n\n" + (buffer-substring-no-properties (point-min) (point-max))))))) + +(ert-deftest agent-shell--mark-tool-calls-cancelled-with-nil-transcript-test () + "Cancelling in-flight tool calls must not signal when transcript-file is nil. +agent-shell--mark-tool-calls-cancelled invokes handle-tool-call-final +which appends transcript entries; the transcript helper must tolerate +a nil file-path or interrupting an unsaved session would crash." + (let* ((buffer (get-buffer-create " *agent-shell-cancel-nil-transcript*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_cancel_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; Send a tool_call so there's an in-flight entry to cancel. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call") + (toolCallId . ,tool-id) + (title . "Run cancel test") + (kind . "execute") + (status . "pending"))))))) + ;; Cancel must not signal even with nil transcript-file. + (agent-shell--mark-tool-calls-cancelled agent-shell--state) + (let ((status (map-nested-elt agent-shell--state + `(:tool-calls ,tool-id :status)))) + (should (equal status "cancelled"))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-update-overrides-nil-title-test () + "Overrides must not signal when existing title is nil. +When a tool_call_update arrives before the initial tool_call has +set a title, the title-upgrade path must not crash on string=." + (let* ((state (list (cons :tool-calls + (list (cons "tc-1" (list (cons :status "pending"))))))) + (update '((toolCallId . "tc-1") + (status . "in_progress")))) + (should (listp (agent-shell--tool-call-update-overrides + state update nil nil))))) + +(ert-deftest agent-shell--tool-call-update-overrides-upgrades-title-test () + "A non-empty title in tool_call_update replaces the existing one. +Mirrors the non-streaming dispatcher in agent-shell.el so a generic +initial title (\"Bash\") is upgraded when a richer one arrives." + (let* ((state (list (cons :tool-calls + (list (cons "tc-1" (list (cons :title "Bash") + (cons :status "pending"))))))) + (update '((toolCallId . "tc-1") + (status . "in_progress") + (title . "grep -i -n pattern /path/to/file")))) + (should (equal "grep -i -n pattern /path/to/file" + (map-elt (agent-shell--tool-call-update-overrides + state update nil nil) + :title))))) + +(ert-deftest agent-shell--tool-call-update-overrides-empty-title-test () + "An empty-string title in tool_call_update is ignored. +Otherwise the existing descriptive title would be clobbered." + (let* ((state (list (cons :tool-calls + (list (cons "tc-1" (list (cons :title "Bash") + (cons :status "pending"))))))) + (update '((toolCallId . "tc-1") + (status . "in_progress") + (title . "")))) + (should-not (map-elt (agent-shell--tool-call-update-overrides + state update nil nil) + :title)))) + +;;; Label status transition tests + +(ert-deftest agent-shell--tool-call-update-overrides-uses-correct-keyword-test () + "Overrides with include-diff must use :acp-tool-call keyword. +Previously used :tool-call which caused a cl-defun keyword error, +aborting handle-tool-call-final before the label update." + (let* ((state (list (cons :tool-calls + (list (cons "tc-1" (list (cons :title "Read") + (cons :status "pending"))))))) + (update '((toolCallId . "tc-1") + (status . "completed") + (content . [((content . ((text . "ok"))))])))) + ;; With include-diff=t, this must not signal + ;; "Keyword argument :tool-call not one of (:acp-tool-call)" + (should (listp (agent-shell--tool-call-update-overrides + state update t t))))) + +(ert-deftest agent-shell--tool-call-label-transitions-to-done-test () + "Tool call label must transition from pending to done on completion. +Replays tool_call (pending) then tool_call_update (completed) and +verifies the buffer contains the done label, not wait." + (let* ((buffer (get-buffer-create " *agent-shell-label-done*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_label_done")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call (pending) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Read") + (kind . "read"))))))) + ;; Verify initial label is wait (pending) + (let ((buf-text (buffer-string))) + (should (string-match-p "wait" buf-text))) + ;; tool_call_update (completed) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed") + (content . [((content . ((text . "file contents"))))]))))))) + ;; Label must now be done, not wait + (let ((buf-text (buffer-string))) + (should (string-match-p "done" buf-text)) + (should-not (string-match-p "wait" buf-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-label-updates-on-in-progress-test () + "Non-final tool_call_update must update label from wait to busy. +Upstream updates labels on every tool_call_update, not just final." + (let* ((buffer (get-buffer-create " *agent-shell-label-busy*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_label_busy")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call (pending) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + (let ((buf-text (buffer-string))) + (should (string-match-p "wait" buf-text))) + ;; tool_call_update (in_progress, no content) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "in_progress"))))))) + ;; Label must now be busy, not wait + (let ((buf-text (buffer-string))) + (should (string-match-p "busy" buf-text)) + (should-not (string-match-p "wait" buf-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-command-block-in-body-test () + "Completed execute tool call must show saved command as fenced console block. +Upstream commit 75cc736 prepends a ```console block to the body when the +tool call has a saved :command. Verify the fenced block appears." + (let* ((buffer (get-buffer-create " *agent-shell-cmd-block*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_cmd_block")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call (pending) with rawInput command + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput (command . "echo hello world")) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + ;; tool_call_update (completed) with output + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed") + (content . [((content . ((text . "hello world"))))]))))))) + ;; Buffer must contain the fenced console command block + (let ((buf-text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "```console" buf-text)) + (should (string-match-p "echo hello world" buf-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--tool-call-meta-response-on-final-only-test () + "Meta toolResponse arriving only on the final update must render output. +Some agents send stdout exclusively on the completed tool_call_update +with no prior meta chunks. The output must not be dropped." + (let* ((buffer (get-buffer-create " *agent-shell-meta-final*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (tool-id "toolu_meta_final")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call (pending) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + ;; tool_call_update (completed) with _meta stdout only, no prior chunks + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((_meta (claudeCode (toolResponse (stdout . "final-only-output") + (stderr . "") + (interrupted) + (isImage) + (noOutputExpected)) + (toolName . "Bash"))) + (toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed"))))))) + ;; Output must be rendered, not dropped + (let ((buf-text (buffer-substring-no-properties (point-min) (point-max)))) + (should (string-match-p "final-only-output" buf-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--empty-chunk-inserts-paragraph-break-test () + "An empty agent_message_chunk mid-stream inserts a paragraph break. +Regression: when the model produces two content blocks in the same +turn (e.g. a description followed by a background-task result), +the ACP sends an empty chunk at the boundary. Without converting +that to a paragraph break, the end of the first block and the +start of the second get merged: \"pipeline.Full test suite passed\"." + (let* ((buffer (get-buffer-create " *agent-shell-empty-chunk-para*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_empty_chunk_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; Completed tool call (background task) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed"))))))) + ;; First content block: empty start chunk + text + (dolist (token (list "" "First paragraph" " ending.")) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . ,token))))))))) + ;; Second content block: empty boundary chunk + text + (dolist (token (list "" "Second paragraph" " starting.")) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . ,token))))))))) + ;; The two paragraphs must NOT be merged. + (let ((visible-text (agent-shell-test--visible-buffer-string))) + (should (string-match-p "First paragraph ending\\." visible-text)) + (should (string-match-p "Second paragraph starting\\." visible-text)) + ;; The boundary must include whitespace, not "ending.Second" + (should-not (string-match-p "ending\\.Second" visible-text)) + ;; And the boundary must be exactly one blank line (two + ;; consecutive newlines) — not a triple-newline regression + ;; if the existing chunk already trailed with a newline. + (should (string-match-p "ending\\.\n\nSecond paragraph" visible-text)) + (should-not (string-match-p "ending\\.\n\n\nSecond paragraph" visible-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--agent-message-chunks-fully-visible-test () + "All agent_message_chunk tokens must be visible in the buffer. +Regression: label-less fragments defaulted to :collapsed t. The +in-place append path used `insert-and-inherit', which inherited the +`invisible t' property from the trailing-whitespace-hiding step of +the previous body text, making every appended chunk invisible. + +Replays the traffic captured in the debug log: a completed tool call +followed by streaming agent_message_chunk tokens. The full message +\"All 10 tests pass.\" must be visible, not just \"All\"." + (let* ((buffer (get-buffer-create " *agent-shell-msg-chunk-visible*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (tool-id "toolu_msg_chunk_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; tool_call (pending) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call") + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) + ;; tool_call_update with toolResponse.stdout + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((_meta (claudeCode (toolResponse (stdout . "Ran 10 tests, 10 results as expected") + (stderr . "") + (interrupted) + (isImage) + (noOutputExpected)) + (toolName . "Bash"))) + (toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update"))))))) + ;; tool_call_update completed + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((toolCallId . ,tool-id) + (sessionUpdate . "tool_call_update") + (status . "completed"))))))) + ;; Now stream agent_message_chunk tokens (the agent's + ;; conversational response). This is label-less text. + (dolist (token (list "All " "10 tests pass" "." " Now" + " let me prepare" " the PR.")) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . ,token))))))))) + ;; The full message must be present AND visible. + (let ((visible-text (agent-shell-test--visible-buffer-string))) + (should (string-match-p "All 10 tests pass" visible-text)) + (should (string-match-p "let me prepare the PR" visible-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(ert-deftest agent-shell--post-turn-end-chunks-render-test () + "Notifications streamed after the turn appears finished must render. +Regression: when an ACP agent (e.g. Claude Code under a Stop-hook +bounce) sends more session/update notifications after the +session/prompt request has resolved, agent-shell would treat them as +stale and silently drop them — the buffer froze on the previous +message while the agent kept streaming. Replays a realistic +post-bounce sequence (thought chunk, tool_call, tool_call_update, +agent_message_chunk) and asserts every piece appears in the buffer." + (let* ((buffer (get-buffer-create " *agent-shell-post-turn-end*")) + (agent-shell--state (agent-shell--make-state :buffer buffer)) + (agent-shell--transcript-file nil) + (post-tool-id "toolu_post_bounce_test")) + (map-put! agent-shell--state :client 'test-client) + (map-put! agent-shell--state :request-count 1) + (map-put! agent-shell--state :active-requests (list t)) + (with-current-buffer buffer + (erase-buffer) + (agent-shell-mode)) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--make-diff-info) + (cl-function (lambda (&key acp-tool-call) (ignore acp-tool-call))))) + (with-current-buffer buffer + ;; Pre-bounce: request is active, chunk renders normally. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . "Pre-bounce reply.")))))))) ; + ;; Simulate the session/prompt response arriving — request + ;; is no longer active. + (map-put! agent-shell--state :active-requests nil) + ;; Post-bounce regen turn: thought chunk first. + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_thought_chunk") + (content (type . "text") + (text . "post-bounce thought")))))))) ; + ;; Post-bounce tool_call (pending). + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call") + (toolCallId . ,post-tool-id) + (rawInput) + (status . "pending") + (title . "Bash") + (kind . "execute"))))))) ; + ;; Post-bounce tool_call_update (completed). + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "tool_call_update") + (toolCallId . ,post-tool-id) + (status . "completed") + (content . [((content . ((text . "post-bounce-tool-output")))) ]))))))) + ;; Post-bounce assistant message chunks. + (dolist (token (list "Post-bounce " "regen " "content.")) + (agent-shell--on-notification + :state agent-shell--state + :acp-notification `((method . "session/update") + (params . ((update + . ((sessionUpdate . "agent_message_chunk") + (content (type . "text") + (text . ,token))))))))) ; + (let ((visible-text (agent-shell-test--visible-buffer-string)) + (buf-text (buffer-substring-no-properties (point-min) (point-max)))) + ;; Label-less message chunks must be visible (no + ;; collapsing). Pre- and post-bounce content both render. + (should (string-match-p "Pre-bounce reply" visible-text)) + (should (string-match-p "Post-bounce regen content" visible-text)) + ;; Thought chunks and tool calls render under collapsed + ;; drawers — present in the buffer even though invisible. + (should (string-match-p "Thinking" buf-text)) + (should (string-match-p "post-bounce thought" buf-text)) + (should (string-match-p "Bash" buf-text)) + (should (string-match-p "post-bounce-tool-output" buf-text))))) + (when (buffer-live-p buffer) + (kill-buffer buffer))))) + +(defun agent-shell-test--visible-buffer-string () + "Return buffer text with invisible regions removed." + (let ((result "") + (pos (point-min))) + (while (< pos (point-max)) + (let ((next-change (next-single-property-change pos 'invisible nil (point-max)))) + (unless (get-text-property pos 'invisible) + (setq result (concat result (buffer-substring-no-properties pos next-change)))) + (setq pos next-change))) + result)) + +(ert-deftest agent-shell-ui--split-qualified-id-no-hyphen-in-block-id-test () + (should (equal (agent-shell-ui--split-qualified-id "1-toolu123") + '("1" . "toolu123")))) + +(ert-deftest agent-shell-ui--split-qualified-id-hyphenated-block-id-test () + ;; Block-ids commonly carry hyphens; greedy-first parsing would + ;; misattribute them to the namespace. + (should (equal (agent-shell-ui--split-qualified-id "1-toolu123-plan") + '("1" . "toolu123-plan"))) + (should (equal (agent-shell-ui--split-qualified-id "1-permission-toolu123") + '("1" . "permission-toolu123"))) + (should (equal (agent-shell-ui--split-qualified-id "2-failed-x-id:y-code:z") + '("2" . "failed-x-id:y-code:z")))) + +(ert-deftest agent-shell-ui--split-qualified-id-no-hyphen-test () + (should (null (agent-shell-ui--split-qualified-id "single")))) + +(provide 'agent-shell-streaming-tests) +;;; agent-shell-streaming-tests.el ends here diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index 98d1d7e8..1bca522a 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -1614,17 +1614,16 @@ code block content (ert-deftest agent-shell--outgoing-request-decorator-reaches-client () "Test that :outgoing-request-decorator from state reaches the ACP client." (with-temp-buffer - (let* ((my-decorator (lambda (request) request)) - (agent-shell--state (agent-shell--make-state - :agent-config nil - :buffer (current-buffer) - :client-maker (lambda (_buffer) - (agent-shell--make-acp-client - :command "cat" - :context-buffer (current-buffer))) - :outgoing-request-decorator my-decorator))) - ;; setq-local needed for buffer-local-value in agent-shell--make-acp-client - (setq-local agent-shell--state agent-shell--state) + (let ((my-decorator (lambda (request) request))) + (setq-local agent-shell--state + (agent-shell--make-state + :agent-config nil + :buffer (current-buffer) + :client-maker (lambda (_buffer) + (agent-shell--make-acp-client + :command "cat" + :context-buffer (current-buffer))) + :outgoing-request-decorator my-decorator)) (let ((client (funcall (map-elt agent-shell--state :client-maker) (current-buffer)))) (should (eq (map-elt client :outgoing-request-decorator) my-decorator)))))) @@ -1638,16 +1637,16 @@ code block content (map-put! request :params (cons '(_meta . ((systemPrompt . ((append . "extra instructions"))))) (map-elt request :params)))) - request)) - (agent-shell--state (agent-shell--make-state - :agent-config nil - :buffer (current-buffer) - :client-maker (lambda (_buffer) - (agent-shell--make-acp-client - :command "cat" - :context-buffer (current-buffer))) - :outgoing-request-decorator decorator))) - (setq-local agent-shell--state agent-shell--state) + request))) + (setq-local agent-shell--state + (agent-shell--make-state + :agent-config nil + :buffer (current-buffer) + :client-maker (lambda (_buffer) + (agent-shell--make-acp-client + :command "cat" + :context-buffer (current-buffer))) + :outgoing-request-decorator decorator)) (let ((client (funcall (map-elt agent-shell--state :client-maker) (current-buffer)))) ;; Give client a fake process so acp--request-sender proceeds @@ -1862,7 +1861,9 @@ code block content (cl-letf (((symbol-function 'agent-shell--state) (lambda () agent-shell--state)) ((symbol-function 'derived-mode-p) - (lambda (&rest _) t))) + (lambda (&rest _) t)) + ((symbol-function 'message) + (lambda (&rest _) nil))) (agent-shell-copy-session-id) (should (equal (current-kill 0) "test-session-id"))))) @@ -2463,6 +2464,114 @@ code block content (should (equal (buffer-string) ""))) (kill-buffer log-buf))))) +(ert-deftest agent-shell--session-new-meta-opts-in-when-logging-and-claude-code-test () + "When logging is on and identifier is claude-code, request raw SDK messages." + (let ((agent-shell-logging-enabled t) + (state '((:agent-config . ((:identifier . claude-code)))))) + (cl-letf (((symbol-function 'agent-shell--state) + (lambda () state))) + (should (equal (agent-shell--session-new-meta) + '((claudeCode . ((emitRawSDKMessages . t))))))))) + +(ert-deftest agent-shell--session-new-meta-nil-when-logging-disabled-test () + "Without logging enabled, no _meta is requested even for claude-code." + (let ((agent-shell-logging-enabled nil) + (state '((:agent-config . ((:identifier . claude-code)))))) + (cl-letf (((symbol-function 'agent-shell--state) + (lambda () state))) + (should-not (agent-shell--session-new-meta))))) + +(ert-deftest agent-shell--session-new-meta-nil-for-non-claude-agents-test () + "Other agent identifiers don't receive the claude-specific opt-in." + (let ((agent-shell-logging-enabled t) + (state '((:agent-config . ((:identifier . gemini)))))) + (cl-letf (((symbol-function 'agent-shell--state) + (lambda () state))) + (should-not (agent-shell--session-new-meta))))) + +(ert-deftest agent-shell--on-notification-logs-claude-sdk-message-test () + "`_claude/sdkMessage' notifications are pretty-printed into the log buffer." + (with-temp-buffer + (rename-buffer "*agent-shell sdkmsg test*" t) + (let* ((log-buf (agent-shell--make-log-buffer (current-buffer))) + (agent-shell-logging-enabled t) + (state (list (cons :buffer (current-buffer)) + (cons :log-buffer log-buf) + (cons :last-activity-time nil)))) + (cl-letf (((symbol-function 'agent-shell--state) + (lambda () state))) + (agent-shell--on-notification + :state state + :acp-notification + '((method . "_claude/sdkMessage") + (params . ((sessionId . "sess-1") + (message . ((type . "system") + (subtype . "hook_response") + (hook_name . "Stop") + (output . "{\"decision\":\"block\"}"))))))) + (with-current-buffer log-buf + (should (string-match-p "_claude/sdkMessage >" (buffer-string))) + (should (string-match-p "hook_response" (buffer-string))) + (should (string-match-p "decision.*block" (buffer-string)))) + (kill-buffer log-buf))))) + +(ert-deftest agent-shell--on-notification-skips-claude-sdk-message-when-logging-disabled-test () + "With logging off, `_claude/sdkMessage' is silently dropped." + (with-temp-buffer + (rename-buffer "*agent-shell sdkmsg disabled test*" t) + (let* ((log-buf (agent-shell--make-log-buffer (current-buffer))) + (agent-shell-logging-enabled nil) + (state (list (cons :buffer (current-buffer)) + (cons :log-buffer log-buf) + (cons :last-activity-time nil)))) + (cl-letf (((symbol-function 'agent-shell--state) + (lambda () state))) + (agent-shell--on-notification + :state state + :acp-notification + '((method . "_claude/sdkMessage") + (params . ((sessionId . "sess-1") + (message . ((type . "system") + (subtype . "hook_started"))))))) + (with-current-buffer log-buf + (should (equal (buffer-string) ""))) + (kill-buffer log-buf))))) + +(ert-deftest agent-shell--on-notification-killed-buffer-test () + "Notifications addressed to a killed shell buffer are dropped silently. +Handlers downstream call `with-current-buffer' on the same buffer +and would error if the cond ran outside the live-buffer guard." + (let* ((shell-buf (generate-new-buffer "*agent-shell killed-buffer test*")) + (state (list (cons :buffer shell-buf) + (cons :last-activity-time nil)))) + (kill-buffer shell-buf) + (should-not (buffer-live-p shell-buf)) + ;; Must return nil rather than signalling. + (should-not (agent-shell--on-notification + :state state + :acp-notification + '((method . "session/update") + (params . ((update . ((sessionUpdate . "agent_message_chunk") + (content . ((text . "hi")))))))))) )) + +(ert-deftest agent-shell--schedule-markdown-overlays-survives-buffer-kill-test () + "Idle timer fired after buffer kill must not signal. +The timer captures the buffer in its closure; the buffer-live-p +guard inside the timer body short-circuits when the user kills +the shell before the debounce fires." + (let* ((buffer (generate-new-buffer "*agent-shell overlay-kill test*")) + (range (with-current-buffer buffer + (insert "hello") + `((:body . ((:start . ,(point-min)) + (:end . ,(point-max)))))))) + (agent-shell--schedule-markdown-overlays buffer range) + (let ((timer (with-current-buffer buffer agent-shell--markdown-overlay-timer))) + (should (timerp timer)) + (kill-buffer buffer) + (should-not (buffer-live-p buffer)) + ;; Firing the timer with a dead buffer must not signal. + (timer-event-handler timer)))) + (ert-deftest agent-shell--on-request-sends-error-for-unhandled-method-test () "Test `agent-shell--on-request' responds with an error for unknown methods." (with-temp-buffer @@ -2709,5 +2818,127 @@ and it must handle that cleanly." (remove-hook 'kill-buffer-hook #'agent-shell--clean-up t)) (kill-buffer shell-buf))))) +(defvar agent-shell-tests--bootstrap-messages + '(((:direction . outgoing) (:kind . request) + (:object (jsonrpc . "2.0") (method . "initialize") (id . 1) + (params (protocolVersion . 1) + (clientCapabilities + (fs (readTextFile . :false) + (writeTextFile . :false)))))) + ((:direction . incoming) (:kind . response) + (:object (jsonrpc . "2.0") (id . 1) + (result (protocolVersion . 1) + (authMethods + . [((id . "gemini-api-key") + (name . "Use Gemini API key") + (description . :null))]) + (agentCapabilities + (loadSession . :false) + (promptCapabilities (image . t)))))) + ((:direction . outgoing) (:kind . request) + (:object (jsonrpc . "2.0") (method . "authenticate") (id . 2) + (params (methodId . "gemini-api-key")))) + ((:direction . incoming) (:kind . response) + (:object (jsonrpc . "2.0") (id . 2) (result . :null))) + ((:direction . outgoing) (:kind . request) + (:object (jsonrpc . "2.0") (method . "session/new") (id . 3) + (params (cwd . "/tmp") (mcpServers . [])))) + ((:direction . incoming) (:kind . response) + (:object (jsonrpc . "2.0") (id . 3) + (result (sessionId . "fake-session-for-test"))))) + "Minimal ACP bootstrap traffic for insertion tests.") + +(defun agent-shell-tests--assert-context-insertion (context-text) + "Insert CONTEXT-TEXT into a fake shell and verify buffer invariants. + +Asserts: + - Point lands at the prompt, not after the context. + - Context sits between process-mark and point-max. + - A subsequent fragment update does not drag process-mark + past the context." + (require 'agent-shell-fakes) + (let* ((agent-shell-session-strategy 'new) + (shell-buffer (agent-shell-fakes-start-agent + agent-shell-tests--bootstrap-messages))) + (unwind-protect + (with-current-buffer shell-buffer + (let ((prompt-end (point-max)) + (proc (get-buffer-process (current-buffer)))) + (agent-shell--insert-to-shell-buffer :text context-text + :no-focus t + :shell-buffer shell-buffer) + ;; Point must be at the prompt so the user types before context. + (should (= prompt-end (point))) + ;; Context text sits between process-mark and point-max. + (let ((pmark (marker-position (process-mark proc)))) + (should (string-match-p + (regexp-quote context-text) + (buffer-substring-no-properties pmark (point-max))))) + ;; Fragment update must not drag process-mark past context. + (let ((pmark-before (marker-position (process-mark proc)))) + (agent-shell--update-fragment + :state agent-shell--state + :namespace-id "bootstrapping" + :block-id "test-fragment" + :label-left "Test" + :body "fragment body") + (should (= pmark-before + (marker-position (process-mark proc)))) + (should (string-match-p + (regexp-quote context-text) + (buffer-substring-no-properties + (marker-position (process-mark proc)) + (point-max))))))) + (when (buffer-live-p shell-buffer) + (kill-buffer shell-buffer))))) + +(ert-deftest agent-shell--insert-context-line-source-test () + "Context from `line' source (e.g. magit status line)." + (agent-shell-tests--assert-context-insertion + "Unstaged changes (2)")) + +(ert-deftest agent-shell--insert-context-region-source-test () + "Context from `region' source with file path and code." + (agent-shell-tests--assert-context-insertion + "agent-shell.el:42-50 + +(defun my-function () + (let ((x 1)) + (message \"hello %d\" x)))")) + +(ert-deftest agent-shell--insert-context-files-source-test () + "Context from `files' source (file path)." + (agent-shell-tests--assert-context-insertion + "/home/user/project/src/main.el")) + +(ert-deftest agent-shell--insert-context-error-source-test () + "Context from `error' source (flymake/flycheck diagnostic)." + (agent-shell-tests--assert-context-insertion + "main.el:17:5: error: void-function `foobar'")) + +(ert-deftest agent-shell--insert-context-multiline-markdown-test () + "Context containing markdown fences and backticks." + (agent-shell-tests--assert-context-insertion + "```elisp +(defun hello () + (message \"world\")) +```")) + +(ert-deftest agent-shell-filter-buffer-substring-strips-hidden-markup () + "Copying text should exclude markdown syntax hidden by overlays." + (with-temp-buffer + (insert "```emacs-lisp\n(defun foo (x)\n x)\n```\n") + (markdown-overlays-put) + (let ((result (agent-shell--filter-buffer-substring (point-min) (point-max)))) + (should (equal result "(defun foo (x)\n x)\n\n"))))) + +(ert-deftest agent-shell-filter-buffer-substring-strips-inline-code-backticks () + "Copying inline code should exclude the surrounding backticks." + (with-temp-buffer + (insert "Use `foo-bar` for that.") + (markdown-overlays-put) + (let ((result (agent-shell--filter-buffer-substring (point-min) (point-max)))) + (should (equal result "Use foo-bar for that."))))) + (provide 'agent-shell-tests) ;;; agent-shell-tests.el ends here From b3d42594342abb39460e1a192a4fd8093f63c108 Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Wed, 29 Apr 2026 10:49:02 -0400 Subject: [PATCH 4/6] Add gfm-mode compose buffer for agent-shell-queue-request MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace the read-string minibuffer prompt for the interactive form of `agent-shell-queue-request' with a `gfm-mode' compose buffer layered with the new `agent-shell-queue-compose-mode' minor mode: C-c C-c → agent-shell-queue-compose-submit C-c C-k → agent-shell-queue-compose-cancel The compose buffer (`*agent-shell-queue-compose: *') is bound to its originating shell via two buffer-locals — the compose buffer holds a back-reference to the shell, and the shell holds a forward reference so re-popping reuses the same buffer. An in-progress draft therefore survives a re-invocation (declined cancel or buried buffer). The forward reference is cleared via a buffer-local `kill-buffer-hook' on the compose buffer so submit/cancel don't leave a stale ref. On reuse, the modified flag resets so the modeline doesn't carry the `**' indicator from a kept draft. Submit hands the raw `(buffer-string)' to a small dispatcher, `agent-shell--queue-or-submit', which enqueues to the pending-request queue when the shell is busy and otherwise inserts and submits directly. Trimming is applied only for the empty-buffer guard so a trailing newline in a pasted code block isn't silently dropped. Whitespace-only PROMPT in the non-interactive form is rejected symmetrically with `user-error'. Both submit and cancel route through `agent-shell-queue-compose--quit-or-kill', which prefers `(quit-window t)' when the buffer is displayed and falls back to `kill-buffer' when it isn't (M-x after switching away). Other touches: - Add markdown-mode to Package-Requires (>= 2.5). - Wire markdown-mode into `bin/test' (XDG and ~/.emacs.d elpa auto-discovery via `mapfile' over a directory-only glob; v2.5 example in the not-found error) and CI (pin to v2.5 — the Package-Requires floor — with a comment noting the divergence from local auto-discovery). - Switch `(error "Not in a shell")' to `(user-error ...)' and add `(declare (modes agent-shell-mode))' for M-x discoverability. - Update README features list and key-binding table; fix the `agent-shell-queue-compose-cancel' description to say "modified" rather than "non-empty". - ERT tests for the entire flow: pop fresh-creation, alive-buffer reuse, post-submit fresh-creation, dead-shell errors, busy/idle dispatch, busy-branch end-to-end, submit empty/dispatch/dead-shell, cancel silent-kill / declined / confirmed, queue-request not-in- shell / non-interactive bypass / empty-PROMPT rejection, the --quit-or-kill helper branches, header-line presence, and keymap bindings. Co-Authored-By: Claude Opus 4.7 (1M context) --- .github/workflows/ci.yml | 13 +- README.org | 6 +- agent-shell.el | 164 ++++++++++++++++++++-- bin/test | 75 +++++++--- tests/agent-shell-tests.el | 275 +++++++++++++++++++++++++++++++++++++ 5 files changed, 497 insertions(+), 36 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e9a89464..58c01510 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -150,6 +150,15 @@ jobs: repository: xenodium/shell-maker path: deps/shell-maker + # Pin to the Package-Requires floor (v2.5) so CI catches code that + # silently depends on a newer markdown-mode. bin/test auto-discovers + # whatever's installed locally and may pick up something newer. + - uses: actions/checkout@v4 + with: + repository: jrblevin/markdown-mode + ref: v2.5 + path: deps/markdown-mode + - uses: purcell/setup-emacs@master with: version: 29.4 @@ -164,7 +173,7 @@ jobs: case "$f" in x.*|y.*|z.*) ;; *) compile_files+=("$f") ;; esac done emacs -Q --batch \ - -L . -L deps/acp.el -L deps/shell-maker \ + -L . -L deps/acp.el -L deps/shell-maker -L deps/markdown-mode \ -f batch-byte-compile \ "${compile_files[@]}" @@ -175,6 +184,6 @@ jobs: test_args+=(-l "$f") done emacs -Q --batch \ - -L . -L deps/acp.el -L deps/shell-maker -L tests \ + -L . -L deps/acp.el -L deps/shell-maker -L deps/markdown-mode -L tests \ "${test_args[@]}" \ -f ert-run-tests-batch-and-exit diff --git a/README.org b/README.org index c49fde50..a8f28691 100644 --- a/README.org +++ b/README.org @@ -25,6 +25,7 @@ A soft fork of [[https://github.com/xenodium/agent-shell][agent-shell]] with ext - Tunable markdown-overlay debounce via =agent-shell-markdown-overlay-debounce-delay= (default 0.15s) for slow terminals or streaming-debug sessions - Bug fix for upstream =shell-maker-define-major-mode= mode-map quoting — without it, every =agent-shell-mode= invocation emits =void-function keymap= because the bare keymap value gets spliced into a backquote that re-evaluates =(keymap ...)= as a function call (worth upstreaming separately) - Live-validate workflow doc (=.agents/commands/live-validate.md=) describing the batch-mode rendering verification used for rendering-pipeline changes +- =gfm-mode= compose buffer for the interactive =agent-shell-queue-request=, replacing the read-string minibuffer prompt (non-interactive callers still pass =PROMPT= directly) ----- @@ -790,6 +791,9 @@ always go to Evil modes if you need to with ~C-z~). | | agent-shell-anthropic-start-claude-code | Start an interactive Claude Agent shell. | | | agent-shell-auggie-start-agent | Start an interactive Auggie agent shell. | | | agent-shell-clear-buffer | Clear the current shell buffer. | +| | agent-shell-queue-compose-cancel | Cancel the compose buffer (asks confirmation when modified). | +| | agent-shell-queue-compose-mode | Minor mode for the agent-shell queue-request compose buffer. | +| | agent-shell-queue-compose-submit | Submit (or queue) the contents of the compose buffer. | | | agent-shell-completion-mode | Toggle agent shell completion with @ or / prefix. | | | agent-shell-cursor-start-agent | Start an interactive Cursor agent shell. | | C- | agent-shell-cycle-session-mode | Cycle through available session modes for the current `agent-shell' session. | @@ -819,7 +823,7 @@ always go to Evil modes if you need to with ~C-z~). | p or | agent-shell-previous-item | Go to previous item. | | | agent-shell-previous-permission-button | Jump to the previous button. | | | agent-shell-prompt-compose | Compose an `agent-shell' prompt in a dedicated buffer. | -| | agent-shell-queue-request | Queue or immediately send a request depending on shell busy state. | +| | agent-shell-queue-request | Compose (interactive) or send PROMPT (non-interactive) — busy-aware. | | | agent-shell-qwen-start | Start an interactive Qwen Code CLI agent shell. | | | agent-shell-remove-pending-request | Remove all pending requests or a specific request by REMOVE-INDEX. | | C-x x r | agent-shell-rename-buffer | Rename current shell buffer. | diff --git a/agent-shell.el b/agent-shell.el index 9a064344..3f7c2a04 100644 --- a/agent-shell.el +++ b/agent-shell.el @@ -5,7 +5,7 @@ ;; Author: Alvaro Ramirez https://xenodium.com ;; URL: https://github.com/xenodium/agent-shell ;; Version: 0.51.1 -;; Package-Requires: ((emacs "29.1") (shell-maker "0.91.2") (acp "0.11.1")) +;; Package-Requires: ((emacs "29.1") (shell-maker "0.91.2") (acp "0.11.1") (markdown-mode "2.5")) (defconst agent-shell--version "0.51.1") @@ -46,6 +46,7 @@ (require 'diff) (require 'json) (require 'map) +(require 'markdown-mode) (unless (require 'markdown-overlays nil 'noerror) (error "Please update 'shell-maker' to v0.91.2 or newer")) (require 'agent-shell-invariants) @@ -7330,22 +7331,28 @@ Remove: M-x agent-shell-remove-pending-request (append pending (list prompt))) (message "Request queued (%d pending)" (length (map-elt agent-shell--state :pending-requests))))) -(defun agent-shell-queue-request (prompt) +(defun agent-shell-queue-request (&optional prompt) "Queue or immediately send a request depending on shell busy state. -Read PROMPT from the minibuffer. If the shell is busy, add it to the pending -requests queue. Otherwise, submit it immediately. Queued requests will be -automatically sent when the current request completes." - (interactive - (progn - (unless (derived-mode-p 'agent-shell-mode) - (error "Not in a shell")) - (list (read-string (or (map-nested-elt (agent-shell--state) '(:agent-config :shell-prompt)) - "Enqueue request: "))))) - (agent-shell--idle-notification-cancel) - (if (shell-maker-busy) - (agent-shell--enqueue-request :prompt prompt) - (agent-shell--insert-to-shell-buffer :text prompt :submit t :no-focus t))) +Interactively, pop a `gfm-mode' compose buffer; submit on +\\\\[agent-shell-queue-compose-submit]. +If the shell is busy when submitted, add to the pending requests +queue; otherwise submit immediately. Queued requests will be +automatically sent when the current request completes. + +When called non-interactively with PROMPT, submit or queue +PROMPT directly, bypassing the compose buffer." + (declare (modes agent-shell-mode)) + (interactive) + (unless (derived-mode-p 'agent-shell-mode) + (user-error "Not in a shell")) + (cond + ((not prompt) + (agent-shell-queue-compose-pop (current-buffer))) + ((string-empty-p (string-trim prompt)) + (user-error "PROMPT is empty")) + (t + (agent-shell--queue-or-submit prompt (current-buffer))))) (defun agent-shell-resume-pending-requests () "Resume processing pending requests in the queue." @@ -7396,6 +7403,133 @@ or select a specific request to remove." (map-put! agent-shell--state :pending-requests nil) (message "Removed all pending requests")))) +;;; Queue compose + +(defvar-local agent-shell-queue-compose--shell-buffer nil + "Originating agent-shell buffer this compose buffer submits to.") + +(defvar-local agent-shell--queue-compose-buffer nil + "Compose buffer associated with this shell buffer, if any.") + +(defvar agent-shell-queue-compose-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") #'agent-shell-queue-compose-submit) + (define-key map (kbd "C-c C-k") #'agent-shell-queue-compose-cancel) + map) + "Keymap for `agent-shell-queue-compose-mode'.") + +(define-minor-mode agent-shell-queue-compose-mode + "Minor mode for the agent-shell queue-request compose buffer. + +Layered on top of `gfm-mode' so its keymap takes precedence over the +major-mode bindings. + +\\{agent-shell-queue-compose-mode-map}" + :lighter " ASQCompose" + :keymap agent-shell-queue-compose-mode-map) + +(defun agent-shell--queue-or-submit (prompt shell-buffer) + "Queue PROMPT or submit it to SHELL-BUFFER depending on busy state. + +The submit branch's `agent-shell--insert-to-shell-buffer' cancels +any active idle notification itself; the busy branch can't have +one active because the notification only fires when the shell is +idle." + (unless (buffer-live-p shell-buffer) + (user-error "Shell buffer is not live")) + (with-current-buffer shell-buffer + (if (shell-maker-busy) + (agent-shell--enqueue-request :prompt prompt) + (agent-shell--insert-to-shell-buffer + :shell-buffer shell-buffer :text prompt :submit t :no-focus t)))) + +(defun agent-shell-queue-compose-pop (shell-buffer) + "Pop a `gfm-mode' compose buffer bound to SHELL-BUFFER. + +Reuses the shell's existing compose buffer when alive so an +in-progress draft survives a re-invocation." + (unless (buffer-live-p shell-buffer) + (user-error "Shell buffer is not live")) + (let* ((existing (buffer-local-value 'agent-shell--queue-compose-buffer + shell-buffer)) + ;; Strip leading/trailing asterisks from the shell name so the + ;; compose buffer doesn't render as `*…: *shell**`. + (shell-stem (string-trim (buffer-name shell-buffer) "\\*+" "\\*+")) + (buffer (if (buffer-live-p existing) + (with-current-buffer existing + ;; Reset modified flag on reuse so the modeline + ;; doesn't carry the `**' indicator from a kept + ;; draft into the next session. + (set-buffer-modified-p nil) + existing) + (let ((new (generate-new-buffer + (format "*agent-shell-queue-compose: %s*" shell-stem)))) + (with-current-buffer new + (gfm-mode) + (agent-shell-queue-compose-mode 1) + (setq agent-shell-queue-compose--shell-buffer shell-buffer) + (add-hook 'kill-buffer-hook + #'agent-shell-queue-compose--clear-shell-ref + nil t) + (setq header-line-format + (substitute-command-keys + "Compose request — \\[agent-shell-queue-compose-submit] queue/submit · \\[agent-shell-queue-compose-cancel] cancel")) + (set-buffer-modified-p nil)) + (with-current-buffer shell-buffer + (setq agent-shell--queue-compose-buffer new)) + new)))) + (pop-to-buffer buffer) + buffer)) + +(defun agent-shell-queue-compose--clear-shell-ref () + "Clear the originating shell's compose-buffer pointer. +Run from `kill-buffer-hook' on the compose buffer so a killed +buffer doesn't leave a stale reference behind." + (let ((shell-buffer agent-shell-queue-compose--shell-buffer) + (this-buffer (current-buffer))) + (when (buffer-live-p shell-buffer) + (with-current-buffer shell-buffer + (when (eq agent-shell--queue-compose-buffer this-buffer) + (setq agent-shell--queue-compose-buffer nil)))))) + +(defun agent-shell-queue-compose--quit-or-kill () + "Kill the compose buffer, also quitting its window when displayed. +`quit-window t' kills the buffer and restores the previous window +state; if the buffer isn't currently displayed (e.g. invoked via +\\[execute-extended-command] after switching away), `quit-window' +would pick an arbitrary window — fall back to plain `kill-buffer'." + (if (get-buffer-window (current-buffer) t) + (quit-window t) + (kill-buffer (current-buffer)))) + +(defun agent-shell-queue-compose-submit () + "Submit (or queue) the contents of the compose buffer." + (interactive) + (unless agent-shell-queue-compose-mode + (user-error "Not in an agent-shell compose buffer")) + (let ((shell-buffer agent-shell-queue-compose--shell-buffer) + (prompt (buffer-string))) + (when (string-empty-p (string-trim prompt)) + (user-error "Compose buffer is empty")) + (unless (buffer-live-p shell-buffer) + (user-error "Originating shell buffer is no longer live")) + (agent-shell--queue-or-submit prompt shell-buffer) + (agent-shell-queue-compose--quit-or-kill))) + +(defun agent-shell-queue-compose-cancel () + "Cancel the compose buffer. + +Kills silently when the buffer is empty and unmodified; otherwise asks +for confirmation." + (interactive) + (unless agent-shell-queue-compose-mode + (user-error "Not in an agent-shell compose buffer")) + (if (or (and (zerop (buffer-size)) + (not (buffer-modified-p))) + (y-or-n-p "Discard compose buffer? ")) + (agent-shell-queue-compose--quit-or-kill) + (message "Kept draft"))) + (provide 'agent-shell) ;;; agent-shell.el ends here diff --git a/bin/test b/bin/test index 74425eba..689ae370 100755 --- a/bin/test +++ b/bin/test @@ -3,18 +3,19 @@ # If CI steps change, this script automatically picks them up. # # Local adaptations: -# - Dependencies (acp.el, shell-maker) are symlinked into deps/ from -# local worktree checkouts instead of being cloned by GitHub Actions. -# Override locations with acp_root and shell_maker_root env vars. +# - Dependencies (acp.el, shell-maker, markdown-mode) are symlinked into +# deps/ from local worktree checkouts instead of being cloned by GitHub +# Actions. Override locations with acp_root, shell_maker_root, and +# markdown_mode_root env vars. # - GitHub ${{ }} context variables are replaced with local git equivalents. # - GitHub Actions ::error:: annotations are translated to stderr messages. -set -euo pipefail -cd "$(git rev-parse --show-toplevel)" +cd "$(git rev-parse --show-toplevel)" || exit 1 ci_yaml=".github/workflows/ci.yml" -if ! command -v yq &>/dev/null; then +if ! command -v yq &>/dev/null +then echo "error: yq is required (brew install yq)" >&2 exit 1 fi @@ -23,20 +24,54 @@ fi acp_root=${acp_root:-../../acp.el-plus/main} shell_maker_root=${shell_maker_root:-../../shell-maker/main} +# Default markdown_mode_root to the newest elpa-installed copy in the +# user's Emacs config; override with the env var if checked out elsewhere. +# Look in both the classic ~/.emacs.d/elpa and the XDG ~/.config/emacs/elpa +# locations so users on either layout don't need to override. +if [[ -z ${markdown_mode_root:-} ]] +then + # Pick the newest installed copy locally. Note: CI pins markdown-mode + # to the Package-Requires floor (v2.5) — local runs may pick up a newer + # version, so a passing local test isn't a guarantee CI will pass. + shopt -s nullglob + # Trailing slashes restrict the glob to directories — package archives + # also drop sibling files (signatures, READMEs) into elpa/. + elpa_markdown_dirs=( + "$HOME"/.emacs.d/elpa/markdown-mode-*/ + "$HOME"/.config/emacs/elpa/markdown-mode-*/ + ) + shopt -u nullglob + if (( 0 < ${#elpa_markdown_dirs[@]} )) + then + mapfile -t sorted_elpa < <(printf '%s\n' "${elpa_markdown_dirs[@]}" | sort -V) + markdown_mode_root=${sorted_elpa[-1]%/} + fi +fi + die=0 -if ! [[ -r ${acp_root}/acp.el ]]; then +if ! [[ -r ${acp_root}/acp.el ]] +then echo "error: acp.el not found at ${acp_root}" >&2 echo "Set acp_root to your acp.el checkout" >&2 die=1 fi -if ! [[ -r ${shell_maker_root}/shell-maker.el ]]; then +if ! [[ -r ${shell_maker_root}/shell-maker.el ]] +then echo "error: shell-maker.el not found at ${shell_maker_root}" >&2 echo "Set shell_maker_root to your shell-maker checkout" >&2 die=1 fi -if (( 0 < die )); then +if ! [[ -r ${markdown_mode_root:-}/markdown-mode.el ]] +then + echo "error: markdown-mode.el not found at ${markdown_mode_root:-}" >&2 + echo "Set markdown_mode_root to your markdown-mode checkout (any version >= 2.5; e.g. ~/.emacs.d/elpa/markdown-mode-2.5)" >&2 + die=1 +fi + +if (( 0 < die )) +then exit 1 fi @@ -44,6 +79,7 @@ fi mkdir -p deps ln -sfn "$(cd "${acp_root}" && pwd)" deps/acp.el ln -sfn "$(cd "${shell_maker_root}" && pwd)" deps/shell-maker +ln -sfn "$(cd "${markdown_mode_root}" && pwd)" deps/markdown-mode # Adapt a CI run block for local execution: # - Replace GitHub PR SHA context with local merge-base equivalents @@ -73,7 +109,8 @@ adapt_for_local() { # Drift guard: if ci.yml introduced a ${{ ... }} expression we # don't know how to translate, fail loudly rather than running a # half-substituted command. - if [[ "$cmd" == *'${{'* ]]; then + if [[ "$cmd" == *'${{'* ]] + then { echo "error: adapt_for_local left an untranslated GitHub Actions" echo " expression in the command — extend bin/test to handle it:" @@ -89,19 +126,21 @@ adapt_for_local() { # Iterate over all CI jobs, extracting and running steps with run: blocks. # Job-level `if:` conditions (e.g. PR-only gates) are ignored — locally # we always want to run every check. -jobs=$(yq '.jobs | keys | .[]' "$ci_yaml") +jobs=$(yq '.jobs | keys | .[]' "$ci_yaml") || exit 1 -for job in ${jobs}; do - step_count=$(yq "[.jobs.${job}.steps[] | select(.run)] | length" "$ci_yaml") +for job in ${jobs} +do + step_count=$(yq "[.jobs.${job}.steps[] | select(.run)] | length" "$ci_yaml") || exit 1 - for (( i = 0; i < step_count; i++ )); do - name=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].name" "$ci_yaml") - cmd=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].run" "$ci_yaml") + for (( i = 0; i < step_count; i++ )) + do + name=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].name" "$ci_yaml") || exit 1 + cmd=$(yq "[.jobs.${job}.steps[] | select(.run)].[${i}].run" "$ci_yaml") || exit 1 - adapted=$(adapt_for_local "$cmd") + adapted=$(adapt_for_local "$cmd") || exit 1 echo "=== ${name} ===" - eval "$adapted" + eval "$adapted" || exit 1 echo "" done done diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index 1bca522a..f1079892 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -2940,5 +2940,280 @@ Asserts: (let ((result (agent-shell--filter-buffer-substring (point-min) (point-max)))) (should (equal result "Use foo-bar for that."))))) +;;; Queue-compose-buffer tests + +(defmacro agent-shell-tests--with-compose (shell-var compose-var &rest body) + "Run BODY with a fresh shell-buffer in SHELL-VAR and compose-buffer in COMPOSE-VAR. + +Stubs `pop-to-buffer' to avoid display side-effects in batch mode." + (declare (indent 2)) + `(let ((,shell-var (generate-new-buffer "*test-shell*")) + ,compose-var) + (unwind-protect + (cl-letf (((symbol-function 'pop-to-buffer) (lambda (b &rest _) b))) + (with-current-buffer ,shell-var + (setq major-mode 'agent-shell-mode)) + (setq ,compose-var (agent-shell-queue-compose-pop ,shell-var)) + ,@body) + (when (buffer-live-p ,compose-var) (kill-buffer ,compose-var)) + (when (buffer-live-p ,shell-var) (kill-buffer ,shell-var))))) + +(ert-deftest agent-shell-queue-compose-pop-creates-buffer-with-modes-and-tracking () + "`agent-shell-queue-compose-pop' sets up gfm-mode + compose-mode and links shell↔compose." + (agent-shell-tests--with-compose shell compose + (should (buffer-live-p compose)) + (with-current-buffer compose + (should (derived-mode-p 'gfm-mode)) + (should agent-shell-queue-compose-mode) + (should (eq agent-shell-queue-compose--shell-buffer shell)) + (should header-line-format) + (should-not (buffer-modified-p))) + (should (eq (buffer-local-value 'agent-shell--queue-compose-buffer shell) + compose)))) + +(ert-deftest agent-shell-queue-compose-pop-reuses-buffer-and-preserves-draft () + "Re-popping for the same shell returns the same buffer with draft intact." + (agent-shell-tests--with-compose shell compose + (with-current-buffer compose + (insert "draft content")) + (let ((reused (agent-shell-queue-compose-pop shell))) + (should (eq compose reused)) + (with-current-buffer reused + (should (string= "draft content" (buffer-string))))))) + +(ert-deftest agent-shell-queue-compose-pop-errors-on-dead-shell () + "`agent-shell-queue-compose-pop' refuses to pop for a killed shell buffer." + (let ((dead (generate-new-buffer "*test-shell-dead*"))) + (kill-buffer dead) + (should-error (agent-shell-queue-compose-pop dead) :type 'user-error))) + +(ert-deftest agent-shell--queue-or-submit-errors-on-dead-shell () + "`agent-shell--queue-or-submit' guards against a dead originating shell." + (let ((dead (generate-new-buffer "*test-shell-dead*"))) + (kill-buffer dead) + (should-error (agent-shell--queue-or-submit "hi" dead) :type 'user-error))) + +(ert-deftest agent-shell--queue-or-submit-enqueues-when-busy () + "When the shell is busy, `agent-shell--queue-or-submit' enqueues." + (let ((shell (generate-new-buffer "*test-shell*")) + enqueued + inserted) + (unwind-protect + (cl-letf (((symbol-function 'shell-maker-busy) (lambda () t)) + ((symbol-function 'agent-shell--idle-notification-cancel) + #'ignore) + ((symbol-function 'agent-shell--enqueue-request) + (lambda (&rest args) (setq enqueued args))) + ((symbol-function 'agent-shell--insert-to-shell-buffer) + (lambda (&rest args) (setq inserted args)))) + (agent-shell--queue-or-submit "hi" shell)) + (kill-buffer shell)) + (should (equal enqueued '(:prompt "hi"))) + (should (null inserted)))) + +(ert-deftest agent-shell--queue-or-submit-submits-when-idle () + "When the shell is idle, `agent-shell--queue-or-submit' submits directly." + (let ((shell (generate-new-buffer "*test-shell*")) + enqueued + inserted) + (unwind-protect + (cl-letf (((symbol-function 'shell-maker-busy) (lambda () nil)) + ((symbol-function 'agent-shell--idle-notification-cancel) + #'ignore) + ((symbol-function 'agent-shell--enqueue-request) + (lambda (&rest args) (setq enqueued args))) + ((symbol-function 'agent-shell--insert-to-shell-buffer) + (lambda (&rest args) (setq inserted args)))) + (agent-shell--queue-or-submit "hi" shell)) + (kill-buffer shell)) + (should (equal inserted (list :shell-buffer shell + :text "hi" + :submit t + :no-focus t))) + (should (null enqueued)))) + +(ert-deftest agent-shell-queue-compose-submit-errors-when-not-in-compose-mode () + "`agent-shell-queue-compose-submit' refuses to run outside a compose buffer." + (with-temp-buffer + (should-error (agent-shell-queue-compose-submit) :type 'user-error))) + +(ert-deftest agent-shell-queue-compose-submit-errors-on-empty-buffer () + "An empty compose buffer signals a `user-error' rather than submitting." + (agent-shell-tests--with-compose shell compose + (with-current-buffer compose + (should-error (agent-shell-queue-compose-submit) :type 'user-error)))) + +(ert-deftest agent-shell-queue-compose-submit-errors-on-dead-shell () + "Submitting after the originating shell dies raises a `user-error'." + (agent-shell-tests--with-compose shell compose + (with-current-buffer compose + (insert "hi")) + (kill-buffer shell) + (with-current-buffer compose + (should-error (agent-shell-queue-compose-submit) :type 'user-error)))) + +(ert-deftest agent-shell-queue-compose-submit-dispatches-and-kills-buffer () + "Submit hands raw prompt to `agent-shell--queue-or-submit' and kills the buffer." + (let (submitted) + (agent-shell-tests--with-compose shell compose + (cl-letf (((symbol-function 'agent-shell--queue-or-submit) + (lambda (prompt sb) (setq submitted (list prompt sb)))) + ((symbol-function 'quit-window) + (lambda (&rest _) (kill-buffer compose)))) + (with-current-buffer compose + (insert " hello world ") + (agent-shell-queue-compose-submit))) + (should (equal submitted (list " hello world " shell))) + (should-not (buffer-live-p compose))))) + +(ert-deftest agent-shell-queue-compose-cancel-silently-kills-empty-unmodified () + "Cancelling an empty unmodified buffer kills it without prompting." + (agent-shell-tests--with-compose shell compose + (cl-letf (((symbol-function 'y-or-n-p) + (lambda (&rest _) (error "should not prompt"))) + ((symbol-function 'quit-window) + (lambda (&rest _) (kill-buffer compose)))) + (with-current-buffer compose + (agent-shell-queue-compose-cancel))) + (should-not (buffer-live-p compose)))) + +(ert-deftest agent-shell-queue-compose-cancel-keeps-buffer-when-declined () + "Declining the discard prompt leaves the buffer alive with content intact." + (agent-shell-tests--with-compose shell compose + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) nil))) + (with-current-buffer compose + (insert "draft") + (agent-shell-queue-compose-cancel))) + (should (buffer-live-p compose)) + (with-current-buffer compose + (should (string= "draft" (buffer-string)))))) + +(ert-deftest agent-shell-queue-compose-cancel-discards-when-confirmed () + "Confirming the discard prompt kills the buffer." + (agent-shell-tests--with-compose shell compose + (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) + ((symbol-function 'quit-window) + (lambda (&rest _) (kill-buffer compose)))) + (with-current-buffer compose + (insert "draft") + (agent-shell-queue-compose-cancel))) + (should-not (buffer-live-p compose)))) + +(ert-deftest agent-shell-queue-request-errors-when-not-in-shell () + "`agent-shell-queue-request' raises a `user-error' outside agent-shell-mode." + (with-temp-buffer + (should-error (agent-shell-queue-request) :type 'user-error))) + +(ert-deftest agent-shell-queue-request-non-interactive-bypasses-compose () + "Calling with PROMPT submits directly, skipping compose." + (let ((shell (generate-new-buffer "*test-shell*")) + submitted + popped) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--queue-or-submit) + (lambda (p sb) (setq submitted (list p sb)))) + ((symbol-function 'agent-shell-queue-compose-pop) + (lambda (sb) (setq popped sb)))) + (with-current-buffer shell + (setq major-mode 'agent-shell-mode) + (agent-shell-queue-request "direct prompt"))) + (kill-buffer shell)) + (should (equal submitted (list "direct prompt" shell))) + (should (null popped)))) + +(ert-deftest agent-shell-queue-request-without-prompt-pops-compose () + "Calling without PROMPT pops the compose buffer." + (let ((shell (generate-new-buffer "*test-shell*")) + submitted + popped) + (unwind-protect + (cl-letf (((symbol-function 'agent-shell--queue-or-submit) + (lambda (p sb) (setq submitted (list p sb)))) + ((symbol-function 'agent-shell-queue-compose-pop) + (lambda (sb) (setq popped sb)))) + (with-current-buffer shell + (setq major-mode 'agent-shell-mode) + (agent-shell-queue-request))) + (kill-buffer shell)) + (should (eq popped shell)) + (should (null submitted)))) + +(ert-deftest agent-shell-queue-compose-pop-after-submit-creates-fresh-buffer () + "After submit kills the compose buffer, re-popping must create a new one." + (agent-shell-tests--with-compose shell first + (cl-letf (((symbol-function 'agent-shell--queue-or-submit) #'ignore)) + (with-current-buffer first + (insert "send me") + (agent-shell-queue-compose-submit))) + (should-not (buffer-live-p first)) + (let ((second (agent-shell-queue-compose-pop shell))) + (unwind-protect + (progn + (should (buffer-live-p second)) + (should-not (eq second first)) + (should (eq (buffer-local-value 'agent-shell--queue-compose-buffer + shell) + second))) + (when (buffer-live-p second) (kill-buffer second)))))) + +(ert-deftest agent-shell-queue-request-rejects-empty-prompt () + "Non-interactive `agent-shell-queue-request' rejects whitespace-only PROMPT." + (let ((shell (generate-new-buffer "*test-shell*"))) + (unwind-protect + (with-current-buffer shell + (setq major-mode 'agent-shell-mode) + (should-error (agent-shell-queue-request "") :type 'user-error) + (should-error (agent-shell-queue-request " \n\t") :type 'user-error)) + (kill-buffer shell)))) + +(ert-deftest agent-shell-queue-compose-submit-end-to-end-busy-enqueues () + "Compose → submit → busy shell → enqueue (no stub of queue-or-submit)." + (let (enqueued inserted) + (agent-shell-tests--with-compose shell compose + (cl-letf (((symbol-function 'shell-maker-busy) (lambda () t)) + ((symbol-function 'agent-shell--enqueue-request) + (lambda (&rest args) (setq enqueued args))) + ((symbol-function 'agent-shell--insert-to-shell-buffer) + (lambda (&rest args) (setq inserted args)))) + (with-current-buffer compose + (insert "draft text") + (agent-shell-queue-compose-submit)))) + (should (equal enqueued '(:prompt "draft text"))) + (should (null inserted)))) + +(ert-deftest agent-shell-queue-compose-mode-map-bindings () + "C-c C-c → submit, C-c C-k → cancel — keymap is the user contract." + (should (eq (lookup-key agent-shell-queue-compose-mode-map (kbd "C-c C-c")) + #'agent-shell-queue-compose-submit)) + (should (eq (lookup-key agent-shell-queue-compose-mode-map (kbd "C-c C-k")) + #'agent-shell-queue-compose-cancel))) + +(ert-deftest agent-shell-queue-compose--quit-or-kill-quits-window-when-displayed () + "When the compose buffer is in a window, prefer `quit-window t'." + (let (quit-args killed) + (with-temp-buffer + (cl-letf (((symbol-function 'get-buffer-window) + (lambda (&rest _) 'fake-window)) + ((symbol-function 'quit-window) + (lambda (&rest args) (setq quit-args args))) + ((symbol-function 'kill-buffer) + (lambda (&rest _) (setq killed t)))) + (agent-shell-queue-compose--quit-or-kill))) + (should (equal quit-args '(t))) + (should (null killed)))) + +(ert-deftest agent-shell-queue-compose--quit-or-kill-kills-buffer-when-not-displayed () + "When the compose buffer isn't displayed, fall back to `kill-buffer'." + (let (quit-called killed-buffer) + (with-temp-buffer + (cl-letf (((symbol-function 'get-buffer-window) (lambda (&rest _) nil)) + ((symbol-function 'quit-window) + (lambda (&rest _) (setq quit-called t))) + ((symbol-function 'kill-buffer) + (lambda (b) (setq killed-buffer b)))) + (agent-shell-queue-compose--quit-or-kill) + (should (eq killed-buffer (current-buffer))))) + (should (null quit-called)))) + (provide 'agent-shell-tests) ;;; agent-shell-tests.el ends here From 4dddc9c2da0cfd70211e8da42730091f934ec9ef Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Wed, 29 Apr 2026 10:49:16 -0400 Subject: [PATCH 5/6] Document why restart-preserves-default-directory test skips in batch The `agent-shell-restart-preserves-default-directory' test calls `make-frame' on a hidden frame to drive an interactive restart flow, which fails with "Unknown terminal type" under emacs --batch. Upstream guards the body with `(skip-unless (not noninteractive))'; add a comment above it explaining the constraint so a future reader doesn't mistake the skip for an unfinished test. Co-Authored-By: Claude Opus 4.7 (1M context) --- tests/agent-shell-tests.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index f1079892..32944847 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -2716,6 +2716,8 @@ Based on ACP traffic from https://github.com/xenodium/agent-shell/issues/415." After `kill-buffer' happens during restart, Emacs falls back to another buffer. Without the fix, `default-directory' would be inherited from that fallback buffer, potentially starting the new shell in the wrong project." + ;; `make-frame' below requires a real terminal, so this test cannot + ;; run in batch mode where Emacs has no controlling terminal. (skip-unless (not noninteractive)) (let ((shell-buffer nil) (other-buffer nil) From 4b261b3cd5b80315a0db6bee38085de467518217 Mon Sep 17 00:00:00 2001 From: Tim Visher <194828183+timvisher-dd@users.noreply.github.com> Date: Fri, 8 May 2026 07:32:09 -0400 Subject: [PATCH 6/6] Align :title cons-cell indentation in send-command turn-complete test Whitespace-only fix in agent-shell--send-command-emits-turn-complete-event-test so the (cons :title nil) row lines up with (cons :id ...) inside the (list ...) form, matching the other send-command test fixtures. Co-Authored-By: Claude Opus 4.7 (1M context) --- tests/agent-shell-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index 32944847..a0548a37 100644 --- a/tests/agent-shell-tests.el +++ b/tests/agent-shell-tests.el @@ -531,7 +531,7 @@ (cons :event-subscriptions nil) (cons :client 'test-client) (cons :session (list (cons :id "test-session") - (cons :title nil))) + (cons :title nil))) (cons :last-entry-type nil) (cons :last-activity-time nil) (cons :tool-calls nil)