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..58c01510 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: @@ -51,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 @@ -65,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[@]}" @@ -76,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/.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..a8f28691 100644 --- a/README.org +++ b/README.org @@ -6,12 +6,26 @@ 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 +- =gfm-mode= compose buffer for the interactive =agent-shell-queue-request=, replacing the read-string minibuffer prompt (non-interactive callers still pass =PROMPT= directly) ----- @@ -777,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. | @@ -806,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-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-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 204ef350..3f7c2a04 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") (markdown-mode "2.5")) -(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 @@ -46,8 +46,10 @@ (require 'diff) (require 'json) (require 'map) +(require 'markdown-mode) (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 +76,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 +845,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 +872,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 +1393,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) @@ -1415,7 +1428,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). @@ -1446,6 +1459,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 +1629,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 +1746,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 +1807,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 +1892,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 +1934,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 +2826,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 +2861,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 +2873,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 +3024,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 +3245,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 +3259,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 +3312,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 +4229,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 +4658,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 +4684,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 +6220,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) @@ -7191,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." @@ -7257,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 2115181f..689ae370 100755 --- a/bin/test +++ b/bin/test @@ -1,108 +1,148 @@ -#!/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} +#!/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, 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. + +cd "$(git rev-parse --show-toplevel)" || exit 1 + +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 + +# 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} +# 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 - echo "Set acp_root to your acp.el checkout (e.g. ~/git/timvisher-dd/acp.el-plus/main)" >&2 + 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 - echo "Set shell_maker_root to your shell-maker checkout (e.g. ~/git/xenodium/shell-maker/main)" >&2 + 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 [[ -n $die ]] +if ! [[ -r ${markdown_mode_root:-}/markdown-mode.el ]] then - echo "Fix the ↑ problems" >&2 - exit 1 + 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 -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 - -if (( 0 < ${#all_elc_files[@]} )) +if (( 0 < die )) then - rm -v "${all_elc_files[@]}" + exit 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 +# 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 +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 +# - 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" +} -if (( ${#compile_files[@]} < 1 )); then - echo "No compile targets found in ${root}" >&2 - exit 1 -fi +# 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") || exit 1 -if (( ${#test_files[@]} < 1 )); then - echo "No test files found in ${tests_dir}" >&2 - exit 1 -fi +for job in ${jobs} +do + step_count=$(yq "[.jobs.${job}.steps[] | select(.run)] | length" "$ci_yaml") || exit 1 -test_args=() -for file in "${test_files[@]}"; do - test_args+=(-l "$file") -done + 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 -emacs -Q --batch \ - -L "${root}" \ - -L "${acp_root}" \ - -L "${shell_maker_root}" \ - -f batch-byte-compile \ - "${compile_files[@]}" || - exit - -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 - -# --- 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. - -git rev-parse '@{u}' >&2 || - { - echo 'ERROR: @{u} does not parse' >&2 - exit 1 - } - -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 -done + adapted=$(adapt_for_local "$cmd") || exit 1 -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 "=== ${name} ===" + eval "$adapted" || exit 1 + echo "" + done +done +echo "=== All CI checks passed ===" 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-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 diff --git a/tests/agent-shell-tests.el b/tests/agent-shell-tests.el index fd485bb6..a0548a37 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))))) @@ -1608,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)))))) @@ -1632,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 @@ -1856,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"))))) @@ -2457,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 @@ -2601,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) @@ -2703,5 +2820,402 @@ 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."))))) + +;;; 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