diff --git a/README.org b/README.org
index 4a892a01..556175f2 100644
--- a/README.org
+++ b/README.org
@@ -923,6 +923,16 @@ All of the above settings can be applied on a per-project basis using [[https://
- =C-c C-c= - Interrupt current agent operation
- =TAB and Shift-TAB= - Navigate interactive elements
+ When an ACP agent requests structured input, agent-shell displays the
+ authoritative shell and renders the form inline there. =TAB= and =Shift-TAB=
+ include its fields, options, and actions in normal interactive-element
+ navigation. Press =RET= to edit a value, toggle an option, or activate
+ =Submit=, =Decline=, or =Cancel=.
+
+ Form elicitation must not be used for passwords, API keys, access tokens,
+ payment credentials, or other secrets. agent-shell currently supports
+ form elicitation only; it does not advertise URL-mode elicitation.
+
To customize =RET= binding behaviour, you can use something like:
#+begin_src emacs-lisp :lexical no
diff --git a/agent-shell-chat-mode.el b/agent-shell-chat-mode.el
index 057d3d5a..9ae2a33e 100644
--- a/agent-shell-chat-mode.el
+++ b/agent-shell-chat-mode.el
@@ -161,9 +161,9 @@ so a label following it needs a full pad rather than a single newline."
(or (= beg (point-min))
(eq (char-before beg) ?\n))))
-(cl-defun agent-shell-chat--ensure-overlay (&key tag beg end props rear-advance
- (anchor-beg beg)
- (anchor-end end))
+(cl-defun agent-shell-chat--ensure-overlay
+ (&key tag beg end props front-advance rear-advance
+ (anchor-beg beg) (anchor-end end))
"Ensure a TAG overlay spans BEG..END carrying PROPS.
TAG is a symbol naming what the overlay is for (`me', `agent' and so
@@ -182,14 +182,21 @@ agent event, and each overlay write dirties its span for redisplay.
ANCHOR-BEG..ANCHOR-END default to the span, and are widened only where
an overlay is expected to sit somewhere its span no longer covers.
-With REAR-ADVANCE non-nil the overlay takes in text inserted at its end
-and is not `evaporate'd while empty, so it can hold properties over an
-input still being typed: relabeling is event-driven, so an overlay that
-stopped at the caret would never grow to cover what follows it."
+FRONT-ADVANCE and REAR-ADVANCE control whether text inserted at the
+corresponding boundary remains outside or enters the overlay. Live
+prompt decoration uses FRONT-ADVANCE so fragments inserted immediately
+before it do not become prompt chrome or disappear behind its `display'
+properties. With REAR-ADVANCE non-nil
+the overlay takes in text inserted at its end and is not `evaporate'd
+while empty, so it can hold properties over an input still being typed:
+relabeling is event-driven, so an overlay that stopped at the caret
+would never grow to cover what follows it."
(let ((overlay (or (seq-find (lambda (overlay)
(eq (overlay-get overlay 'agent-shell-chat--tag) tag))
(overlays-in anchor-beg (max anchor-end (1+ anchor-beg))))
- (let ((created (make-overlay beg end nil nil rear-advance)))
+ (let ((created
+ (make-overlay beg end nil
+ front-advance rear-advance)))
(overlay-put created 'agent-shell-chat--tag tag)
(unless rear-advance
(overlay-put created 'evaporate t))
@@ -562,6 +569,7 @@ above, putting the first line of a multi-line input out of reach of
(push
(agent-shell-chat--ensure-overlay
:tag 'me-surplus :beg start :end label-nl
+ :front-advance t
:props (list (cons 'display "")
(cons 'line-prefix "")
(cons 'wrap-prefix "")))
@@ -572,6 +580,7 @@ above, putting the first line of a multi-line input out of reach of
(push
(agent-shell-chat--ensure-overlay
:tag 'me-label :beg label-nl :end pos
+ :front-advance t
:props (list (cons 'before-string before)
(cons 'line-prefix "")
(cons 'wrap-prefix "")))
@@ -579,6 +588,7 @@ above, putting the first line of a multi-line input out of reach of
(push
(agent-shell-chat--ensure-overlay
:tag 'me :beg (if label-nl pos start) :end end
+ :front-advance t
;; Anchor on the prompt run, which the span may start before: the
;; span's start flips with `label-nl', and reuse has to survive
;; that flip rather than strand the overlay it should have moved.
diff --git a/agent-shell-elicitation.el b/agent-shell-elicitation.el
new file mode 100644
index 00000000..24706b4d
--- /dev/null
+++ b/agent-shell-elicitation.el
@@ -0,0 +1,1344 @@
+;;; agent-shell-elicitation.el --- Inline ACP elicitation forms -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Alvaro Ramirez
+
+;; 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 this program. If not, see .
+
+;;; Commentary:
+;;
+;; Render ACP form elicitations as ordinary agent-shell fragments. The
+;; shell state owns each request record and its shell buffer owns the
+;; canonical controls. The generic fragment renderer may mirror them
+;; into a viewing viewport, as it does for permission prompts; a compose
+;; viewport remains untouched because its contents are the user's next
+;; prompt.
+;;
+;; Elicitations are independent Agent-to-Client requests. They can
+;; arrive before a session exists, during a turn, or between turns, and
+;; the Agent may continue working while one is pending. Records are
+;; therefore scoped to their ACP request, session, tool call, and
+;; connection rather than to the shell's current turn.
+;;
+;; Settlement removes that live record before sending a response, then
+;; replaces its controls with display-only history. The visible summary
+;; cannot extend the protocol request's lifetime or answer it twice.
+;;
+;; Unknown extension field types stay opaque while pending. Optional
+;; fields can then be omitted, while a required unknown field leaves only
+;; Decline and Cancel; treating unknown data as a known control would
+;; invent wire semantics.
+;;
+;; Only form mode is implemented. agent-shell does not advertise URL
+;; mode, whose consent and browser lifecycle are separate concerns.
+
+;;; Code:
+
+(require 'acp)
+(eval-when-compile
+ (require 'cl-lib))
+(require 'json)
+(require 'map)
+(require 'seq)
+(require 'subr-x)
+(require 'text-property-search)
+
+(declare-function agent-shell--delete-fragment "agent-shell")
+(declare-function agent-shell--make-button "agent-shell")
+(declare-function agent-shell--present-user-input-request "agent-shell")
+(declare-function agent-shell--state "agent-shell")
+(declare-function agent-shell--update-fragment "agent-shell")
+
+(defconst agent-shell-elicitation--namespace "elicitations"
+ "Fragment namespace for pending form elicitations.")
+
+(defconst agent-shell-elicitation--integer-min (- (expt 2 63))
+ "Smallest integer representable by ACP elicitation content.")
+
+(defconst agent-shell-elicitation--integer-max (1- (expt 2 63))
+ "Largest integer representable by ACP elicitation content.")
+
+(defconst agent-shell-elicitation--json-schema-types
+ '("array" "boolean" "integer" "null" "number" "object" "string")
+ "JSON Schema types known independently of ACP's restricted subset.")
+
+(defun agent-shell-elicitation--integer-p (value)
+ "Return non-nil when VALUE is an ACP signed 64-bit integer."
+ (and (integerp value)
+ (<= agent-shell-elicitation--integer-min
+ value
+ agent-shell-elicitation--integer-max)))
+
+(defun agent-shell-elicitation--name-string (name)
+ "Return protocol property NAME as a display string."
+ (cond ((symbolp name) (symbol-name name))
+ ((stringp name) name)
+ (t (error "Elicitation property names must be strings"))))
+
+(defun agent-shell-elicitation--agent-name (state)
+ "Return the name of the Agent represented by STATE."
+ (or (map-nested-elt state '(:agent-config :mode-line-name))
+ (map-nested-elt state '(:agent-config :buffer-name))
+ "ACP Agent"))
+
+(defun agent-shell-elicitation--entry (state request-id)
+ "Return STATE's pending elicitation with REQUEST-ID."
+ (map-nested-elt state (list :elicitations request-id)))
+
+(defun agent-shell-elicitation--field (entry name)
+ "Return ENTRY's normalized field named NAME."
+ (seq-find (lambda (field)
+ (equal (map-elt field :name) name))
+ (map-elt entry :fields)))
+
+(defun agent-shell-elicitation--active-request-p (state request-id)
+ "Return non-nil when REQUEST-ID names an active request in STATE."
+ (seq-some
+ (lambda (request)
+ (equal (map-elt request :wire-request-id) request-id))
+ (map-elt state :active-requests)))
+
+(defun agent-shell-elicitation--scope (state params)
+ "Validate PARAMS' scope against STATE and return its normalized form.
+
+For example, `(sessionId . \"s\")' becomes `(:scope . session)' and
+`(:scope-id . \"s\")' when \"s\" is STATE's active session."
+ (let ((has-session (map-contains-key params 'sessionId))
+ (has-request (map-contains-key params 'requestId))
+ (session-id (map-elt params 'sessionId))
+ (request-id (map-elt params 'requestId))
+ (tool-call-id (map-elt params 'toolCallId)))
+ (when (eq has-session has-request)
+ (error "An elicitation must have exactly one scope"))
+ (when (and tool-call-id (not has-session))
+ (error "The toolCallId field requires session scope"))
+ (when (and tool-call-id (not (stringp tool-call-id)))
+ (error "The toolCallId field must be a string"))
+ (cond
+ (has-session
+ (unless (and (stringp session-id)
+ (equal session-id
+ (map-nested-elt state '(:session :id))))
+ (error "Elicitation sessionId is not the active session"))
+ (when-let* ((tool-call-id)
+ (tool-call
+ (or (map-nested-elt
+ state (list :tool-calls tool-call-id))
+ (error
+ "Elicitation toolCallId is not active")))
+ ((seq-contains-p
+ '("completed" "failed" "cancelled")
+ (map-elt tool-call :status))))
+ (error "Elicitation toolCallId has already finished"))
+ (list (cons :scope 'session)
+ (cons :scope-id session-id)
+ (cons :tool-call-id tool-call-id)))
+ (t
+ (unless (or (stringp request-id)
+ (agent-shell-elicitation--integer-p request-id))
+ (error "Elicitation requestId must be a string or signed 64-bit integer"))
+ (unless (agent-shell-elicitation--active-request-p state request-id)
+ (error "Elicitation requestId is not active"))
+ (list (cons :scope 'request)
+ (cons :scope-id request-id))))))
+
+(defun agent-shell-elicitation--required-names (schema)
+ "Return SCHEMA's required property names."
+ (let ((required (map-elt schema 'required)))
+ (cond ((null required) nil)
+ ((and (vectorp required)
+ (seq-every-p #'stringp required))
+ (append required nil))
+ (t
+ (error "The requestedSchema.required field must be an array of strings")))))
+
+(defun agent-shell-elicitation--options (schema plain-key titled-key)
+ "Return options from SCHEMA's PLAIN-KEY or TITLED-KEY.
+
+For example:
+
+ (agent-shell-elicitation--options
+ \\='((enum . [\"red\" \"blue\"])) \\='enum \\='oneOf)
+ => (((:value . \"red\") (:title . \"red\"))
+ ((:value . \"blue\") (:title . \"blue\")))"
+ (let* ((plain (map-elt schema plain-key))
+ (titled (map-elt schema titled-key))
+ ;; ACP treats null option collections like omitted ones.
+ (plain-present
+ (and plain (map-contains-key schema plain-key)))
+ (titled-present
+ (and titled (map-contains-key schema titled-key))))
+ (when (and plain-present titled-present)
+ (error "An elicitation field cannot use two option forms"))
+ (cond
+ (plain-present
+ (unless (and (vectorp plain)
+ (> (length plain) 0)
+ (seq-every-p #'stringp plain))
+ (error "Elicitation enum must contain string values"))
+ (seq-map
+ (lambda (value)
+ (list (cons :value value)
+ (cons :title value)))
+ plain))
+ (titled-present
+ (unless (and (vectorp titled)
+ (> (length titled) 0))
+ (error "Elicitation titled options must be a nonempty array"))
+ (seq-map
+ (lambda (option)
+ (unless (and (listp option)
+ (stringp (map-elt option 'const))
+ (stringp (map-elt option 'title)))
+ (error "Elicitation titled options need const and title"))
+ (list
+ (cons :value (map-elt option 'const))
+ (cons :title (map-elt option 'title))
+ (cons :description
+ (when (stringp (map-elt option 'description))
+ (map-elt option 'description)))))
+ titled))
+ (t nil))))
+
+(cl-defun agent-shell-elicitation--constraint
+ (&key schema key predicate description)
+ "Return SCHEMA's KEY after checking PREDICATE.
+
+Nil means the optional constraint is absent. DESCRIPTION names the
+constraint in errors."
+ (when-let* ((value (map-elt schema key)))
+ (unless (funcall predicate value)
+ (error "Elicitation %s has the wrong type" description))
+ value))
+
+(defun agent-shell-elicitation--field-kind-and-options (schema)
+ "Return SCHEMA's field kind and normalized options.
+
+For example, `((type . \"integer\"))' becomes
+`((:kind . integer))'."
+ (let ((type (map-elt schema 'type)))
+ (cond
+ ((equal type "string")
+ (let ((options
+ (agent-shell-elicitation--options schema 'enum 'oneOf)))
+ (list (cons :kind (if options 'single-select 'string))
+ (cons :options options))))
+ ((equal type "number")
+ '((:kind . number)))
+ ((equal type "integer")
+ '((:kind . integer)))
+ ((equal type "boolean")
+ '((:kind . boolean)))
+ ((equal type "array")
+ (unless (listp (map-elt schema 'items))
+ (error "Elicitation multi-select requires items"))
+ (let* ((items (map-elt schema 'items))
+ (item-type (map-elt items 'type)))
+ (when (and item-type (not (stringp item-type)))
+ (error "Elicitation multi-select items.type must be a string"))
+ (cond
+ ((and item-type (not (equal item-type "string")))
+ (if (seq-contains-p
+ agent-shell-elicitation--json-schema-types item-type)
+ (error "Elicitation multi-select items must be strings")
+ (list (cons :kind 'unsupported)
+ (cons :raw-type type)
+ (cons :raw-item-type item-type))))
+ (t
+ (let ((options
+ (agent-shell-elicitation--options
+ items 'enum 'anyOf)))
+ (when (and (map-elt items 'enum)
+ (not (equal item-type "string")))
+ (error "Plain multi-select items require string type"))
+ (unless options
+ (error "Elicitation multi-select has no options"))
+ (list (cons :kind 'multi-select)
+ (cons :options options)))))))
+ ((and (stringp type)
+ (not (seq-contains-p
+ agent-shell-elicitation--json-schema-types type)))
+ ;; Unknown extension types remain opaque. The type name is sufficient
+ ;; for display: agent-shell does not store, replay, proxy, or forward
+ ;; elicitation schemas.
+ (list (cons :kind 'unsupported)
+ (cons :raw-type type)))
+ (t
+ (error "Unsupported elicitation property type %S" type)))))
+
+(defun agent-shell-elicitation--default (schema kind options)
+ "Return normalized default information for SCHEMA, KIND, and OPTIONS.
+
+For example:
+
+ (agent-shell-elicitation--default
+ \\='((default . \"blue\")) \\='single-select
+ \\='(((:value . \"red\")) ((:value . \"blue\"))))
+ => ((:present . t) (:value . \"blue\"))"
+ (let* ((raw (map-elt schema 'default))
+ (present (map-contains-key schema 'default))
+ (allowed (seq-map (lambda (option)
+ (map-elt option :value))
+ options))
+ (missing 'agent-shell-elicitation--missing-default)
+ ;; The live parser retains acp.el's established nil
+ ;; representation for JSON false, while recorded traffic uses
+ ;; :false. Presence is checked separately, so a false default
+ ;; remains distinct from an omitted default without changing every
+ ;; ACP boolean consumer. Live JSON null is indistinguishable here;
+ ;; treating it as false is the safe, editable boolean value.
+ (value
+ (cond
+ ((not present)
+ missing)
+ ((and (eq kind 'boolean)
+ (or (eq raw t) (null raw) (eq raw :false)))
+ (eq raw t))
+ ((and (eq kind 'string) (stringp raw))
+ raw)
+ ((and (eq kind 'number) (numberp raw))
+ (format "%s" raw))
+ ((and (eq kind 'integer)
+ (agent-shell-elicitation--integer-p raw))
+ (format "%s" raw))
+ ((and (eq kind 'single-select)
+ (stringp raw)
+ (seq-contains-p allowed raw))
+ raw)
+ ((and (eq kind 'multi-select) (vectorp raw))
+ ;; ACP explicitly asks readers to skip malformed or unknown
+ ;; default selections rather than rejecting the whole form.
+ (seq-filter
+ (lambda (item)
+ (and (stringp item)
+ (seq-contains-p allowed item)))
+ raw))
+ ;; Primitive defaults are tolerant fields in ACP. A malformed
+ ;; value is equivalent to no default and remains user-editable.
+ (t missing))))
+ (list
+ (cons :present (not (eq value missing)))
+ (cons :value
+ (if (eq value missing)
+ (pcase kind
+ ((or 'string 'number 'integer) "")
+ ('boolean nil)
+ ('single-select nil)
+ ('multi-select nil))
+ value)))))
+
+(defun agent-shell-elicitation--validate-bounds (field)
+ "Return FIELD after validating its normalized lower and upper bounds."
+ (when (and (map-elt field :minimum)
+ (map-elt field :maximum)
+ (> (map-elt field :minimum)
+ (map-elt field :maximum)))
+ (error "Elicitation minimum exceeds maximum"))
+ field)
+
+(defun agent-shell-elicitation--normalize-field
+ (name schema required-names)
+ "Normalize field NAME from SCHEMA using REQUIRED-NAMES.
+
+For example, NAME `enabled' with SCHEMA `((type . \"boolean\"))'
+produces a field containing `(:kind . boolean)'."
+ (unless (listp schema)
+ (error "Elicitation property %S must be an object" name))
+ (let* ((kind-and-options
+ (agent-shell-elicitation--field-kind-and-options schema))
+ (kind (map-elt kind-and-options :kind))
+ (options (map-elt kind-and-options :options))
+ (default
+ (if (eq kind 'unsupported)
+ '((:present . nil) (:value . nil))
+ (agent-shell-elicitation--default schema kind options)))
+ (required
+ (and (seq-contains-p
+ required-names
+ (agent-shell-elicitation--name-string name))
+ t))
+ (uint32
+ (lambda (value)
+ (and (integerp value)
+ (<= 0 value (1- (expt 2 32))))))
+ (uint64
+ (lambda (value)
+ (and (integerp value)
+ (<= 0 value (1- (expt 2 64))))))
+ (number-value
+ (if (eq kind 'integer)
+ #'agent-shell-elicitation--integer-p
+ #'numberp)))
+ (agent-shell-elicitation--validate-bounds
+ (append
+ (list
+ (cons :name name)
+ (cons :kind kind)
+ (cons :title
+ (or (when (stringp (map-elt schema 'title))
+ (map-elt schema 'title))
+ (agent-shell-elicitation--name-string name)))
+ (cons :description
+ (when (stringp (map-elt schema 'description))
+ (map-elt schema 'description)))
+ (cons :required required)
+ (cons :included (or required (map-elt default :present)))
+ (cons :has-value
+ (or (map-elt default :present)
+ (seq-contains-p
+ '(string boolean multi-select) kind)))
+ (cons :value (map-elt default :value))
+ (cons :options options)
+ (cons :raw-type (map-elt kind-and-options :raw-type))
+ (cons :raw-item-type
+ (map-elt kind-and-options :raw-item-type)))
+ (when (eq kind 'string)
+ (list
+ (cons :minimum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'minLength
+ :predicate uint32
+ :description "minLength"))
+ (cons :maximum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'maxLength
+ :predicate uint32
+ :description "maxLength"))
+ (cons :pattern
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'pattern
+ :predicate #'stringp :description "pattern"))
+ (cons :format
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'format
+ :predicate #'stringp :description "format"))))
+ (when (seq-contains-p '(number integer) kind)
+ (list
+ (cons :minimum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'minimum
+ :predicate number-value :description "minimum"))
+ (cons :maximum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'maximum
+ :predicate number-value :description "maximum"))))
+ (when (eq kind 'multi-select)
+ (list
+ (cons :minimum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'minItems
+ :predicate uint64
+ :description "minItems"))
+ (cons :maximum
+ (agent-shell-elicitation--constraint
+ :schema schema :key 'maxItems
+ :predicate uint64
+ :description "maxItems"))))))))
+
+(defun agent-shell-elicitation--normalize-schema (schema)
+ "Normalize an ACP form SCHEMA into editable field records.
+
+For example:
+
+ (map-elt
+ (seq-first
+ (map-elt
+ (agent-shell-elicitation--normalize-schema
+ \\='((properties (name (type . \"string\")))))
+ :fields))
+ :kind)
+ => string"
+ (unless (listp schema)
+ (error "The requestedSchema field must be an object"))
+ (when (and (stringp (map-elt schema 'type))
+ (not (equal (map-elt schema 'type) "object")))
+ (error "The requestedSchema.type field must be \"object\""))
+ (let ((properties (map-elt schema 'properties))
+ (required (agent-shell-elicitation--required-names schema)))
+ (unless (listp properties)
+ (error "The requestedSchema.properties field must be an object"))
+ (seq-do
+ (lambda (name)
+ (unless (seq-some
+ (lambda (property-name)
+ (equal
+ (agent-shell-elicitation--name-string property-name)
+ name))
+ (map-keys properties))
+ (error "Required elicitation property %S is not defined" name)))
+ required)
+ (list
+ (cons :title
+ (when (stringp (map-elt schema 'title))
+ (map-elt schema 'title)))
+ (cons :description
+ (when (stringp (map-elt schema 'description))
+ (map-elt schema 'description)))
+ (cons :fields
+ (map-apply
+ (lambda (name property-schema)
+ (agent-shell-elicitation--normalize-field
+ name property-schema required))
+ properties)))))
+
+(defun agent-shell-elicitation--normalize-request (state acp-request)
+ "Validate ACP-REQUEST against STATE and return a pending record.
+
+For example, request id 7 scoped by `(sessionId . \"s\")' produces
+`(:request-id . 7)', `(:scope . session)', and `(:scope-id . \"s\")'
+when \"s\" is STATE's active session."
+ (let ((params (map-elt acp-request 'params))
+ (request-id (map-elt acp-request 'id)))
+ (unless (or (stringp request-id)
+ (agent-shell-elicitation--integer-p request-id))
+ (error "Elicitation JSON-RPC id must be a string or signed 64-bit integer"))
+ (unless (listp params)
+ (error "Elicitation params must be an object"))
+ (unless (equal (map-elt params 'mode) "form")
+ (error "Only form elicitation is supported"))
+ (unless (stringp (map-elt params 'message))
+ (error "An elicitation message is required"))
+ (unless (map-contains-key params 'requestedSchema)
+ (error "An elicitation requestedSchema is required"))
+ (when (agent-shell-elicitation--entry state request-id)
+ (error "An elicitation with this request id is already pending"))
+ (let ((scope (agent-shell-elicitation--scope state params))
+ (form
+ (agent-shell-elicitation--normalize-schema
+ (map-elt params 'requestedSchema))))
+ (append
+ (list
+ (cons :request-id request-id)
+ (cons :message (map-elt params 'message))
+ (cons :error nil))
+ scope
+ form))))
+
+(cl-defun agent-shell-elicitation--button
+ (&key state entry action text help field option (boxed t))
+ "Return an inline control for ENTRY in STATE.
+
+ACTION selects the command behavior. TEXT and HELP are displayed.
+FIELD and OPTION identify an optional field or choice. BOXED controls
+whether the control is drawn as a button."
+ (agent-shell--make-button
+ :text text
+ :help help
+ :kind 'elicitation
+ :action #'agent-shell-elicitation-activate
+ :boxed boxed
+ :properties
+ (list
+ 'agent-shell-elicitation-control t
+ 'agent-shell-elicitation-shell-buffer (map-elt state :buffer)
+ 'agent-shell-elicitation-request-id (map-elt entry :request-id)
+ 'agent-shell-elicitation-action action
+ 'agent-shell-elicitation-field field
+ 'agent-shell-elicitation-option option)))
+
+(defun agent-shell-elicitation--constraint-text (field)
+ "Return FIELD's constraints as display text.
+
+For example, `((:minimum . 1) (:maximum . 2))' becomes
+\"minimum 1, maximum 2\"."
+ (string-join
+ (seq-filter
+ #'identity
+ (list
+ (when (map-elt field :minimum)
+ (format "minimum %s" (map-elt field :minimum)))
+ (when (map-elt field :maximum)
+ (format "maximum %s" (map-elt field :maximum)))
+ (when (map-elt field :format)
+ (format "format %s" (map-elt field :format)))
+ (when (map-elt field :pattern)
+ (format "pattern %s" (map-elt field :pattern)))))
+ ", "))
+
+(defun agent-shell-elicitation--insert-field (state entry field)
+ "Insert FIELD from ENTRY's inline representation using STATE."
+ (insert (propertize (map-elt field :title) 'face 'bold))
+ (when (map-elt field :required)
+ (insert " (required)"))
+ (insert "\n")
+ (when (map-elt field :description)
+ (insert (map-elt field :description) "\n"))
+ (when-let* ((constraints
+ (agent-shell-elicitation--constraint-text field))
+ ((not (string-empty-p constraints))))
+ (insert (propertize constraints 'face 'shadow) "\n"))
+ (unless (or (map-elt field :required)
+ (eq (map-elt field :kind) 'unsupported))
+ (insert
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'toggle-include
+ :field (map-elt field :name)
+ :text (if (map-elt field :included) "Included" "Omitted")
+ :help "RET to include or omit this field")
+ " "))
+ (pcase (map-elt field :kind)
+ ((or 'string 'number 'integer)
+ (insert
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'edit
+ :field (map-elt field :name)
+ :text (if (map-elt field :has-value)
+ (if (eq (map-elt field :kind) 'string)
+ (prin1-to-string (map-elt field :value))
+ (map-elt field :value))
+ "")
+ :help "RET to edit this value")
+ "\n"))
+ ('boolean
+ (insert
+ (string-join
+ (seq-map
+ (lambda (choice)
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'set-option
+ :field (map-elt field :name)
+ :option (car choice)
+ :text (format "%s %s"
+ (if (eq (map-elt field :value) (car choice))
+ "(*)"
+ "( )")
+ (cdr choice))
+ :boxed nil
+ :help "RET to select this value"))
+ '((t . "Yes") (nil . "No")))
+ " ")
+ "\n"))
+ ((or 'single-select 'multi-select)
+ (insert "\n")
+ (seq-do
+ (lambda (option)
+ (let ((selected
+ (if (eq (map-elt field :kind) 'single-select)
+ (equal (map-elt field :value)
+ (map-elt option :value))
+ (seq-contains-p
+ (map-elt field :value)
+ (map-elt option :value)))))
+ (insert
+ (agent-shell-elicitation--button
+ :state state
+ :entry entry
+ :action (if (eq (map-elt field :kind) 'single-select)
+ 'set-option
+ 'toggle-option)
+ :field (map-elt field :name)
+ :option (map-elt option :value)
+ :text (format "%s %s"
+ (if selected "[x]" "[ ]")
+ (map-elt option :title))
+ :help "RET to select this option")
+ "\n")
+ (when (map-elt option :description)
+ (insert " "
+ (propertize (map-elt option :description)
+ 'face 'shadow)
+ "\n"))))
+ (map-elt field :options)))
+ ('unsupported
+ (insert
+ (propertize
+ (if (map-elt field :raw-item-type)
+ (format
+ "Unsupported array item type %S; no value can be entered."
+ (map-elt field :raw-item-type))
+ (format
+ "Unsupported field type %S; no value can be entered."
+ (map-elt field :raw-type)))
+ 'face 'warning)
+ "\n")))
+ (insert "\n"))
+
+(defun agent-shell-elicitation--required-unsupported-field (entry)
+ "Return ENTRY's first required field with an unsupported type."
+ (seq-find
+ (lambda (field)
+ (and (map-elt field :required)
+ (eq (map-elt field :kind) 'unsupported)))
+ (map-elt entry :fields)))
+
+(defun agent-shell-elicitation--body (state entry)
+ "Return the propertized fragment body for ENTRY in STATE."
+ (with-temp-buffer
+ (insert (map-elt entry :message) "\n\n")
+ (when (map-elt entry :title)
+ (insert (propertize (map-elt entry :title) 'face 'bold) "\n"))
+ (when (map-elt entry :description)
+ (insert (map-elt entry :description) "\n"))
+ (when (or (map-elt entry :title)
+ (map-elt entry :description))
+ (insert "\n"))
+ (insert
+ (propertize
+ "Do not enter passwords, API keys, or other credentials in this form."
+ 'face 'warning)
+ "\n\n")
+ (seq-do
+ (lambda (field)
+ (agent-shell-elicitation--insert-field state entry field))
+ (map-elt entry :fields))
+ (when (map-elt entry :error)
+ (insert (propertize (map-elt entry :error) 'face 'error) "\n\n"))
+ (let ((unsupported
+ (agent-shell-elicitation--required-unsupported-field entry)))
+ (when unsupported
+ (insert
+ (propertize
+ (format
+ "Cannot submit: required field %S has an unsupported type."
+ (map-elt unsupported :title))
+ 'face 'error)
+ "\n\n"))
+ (unless unsupported
+ (insert
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'submit
+ :text "Submit" :help "RET to submit this form")
+ " "))
+ (insert
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'decline
+ :text "Decline" :help "RET to explicitly decline")
+ " "
+ (agent-shell-elicitation--button
+ :state state :entry entry :action 'cancel
+ :text "Cancel" :help "RET to dismiss without choosing")))
+ (buffer-string)))
+
+(defun agent-shell-elicitation--option-title (field value)
+ "Return FIELD's display title for option VALUE, or nil.
+
+For example, VALUE \"s\" in an option titled \"Small\" produces
+\"Small\"."
+ (map-elt
+ (seq-find
+ (lambda (option)
+ (equal (map-elt option :value) value))
+ (map-elt field :options))
+ :title))
+
+(defun agent-shell-elicitation--summary-value (field value)
+ "Return VALUE from FIELD as literal settled-summary text.
+
+For example, JSON false in a boolean field produces \"No\"."
+ (pcase (map-elt field :kind)
+ ('boolean
+ (if (eq value t) "Yes" "No"))
+ ('single-select
+ (or (agent-shell-elicitation--option-title field value)
+ (prin1-to-string value)))
+ ('multi-select
+ (string-join
+ (seq-map
+ (lambda (item)
+ (or (agent-shell-elicitation--option-title field item)
+ (prin1-to-string item)))
+ value)
+ ", "))
+ ('string
+ (prin1-to-string value))
+ (_
+ (format "%s" value))))
+
+(cl-defun agent-shell-elicitation--settled-body
+ (&key entry action content detail)
+ "Return inert summary text for settled ENTRY.
+
+ACTION is \"accept\", \"decline\", or \"cancel\". CONTENT contains
+the accepted values, and DETAIL optionally explains automatic
+cancellation.
+
+For example, ACTION \"decline\" produces a summary ending in
+\"Declined\"."
+ (with-temp-buffer
+ (insert (map-elt entry :message) "\n\n")
+ (pcase action
+ ("accept"
+ (if content
+ (progn
+ (insert (propertize "Submitted" 'face 'bold) "\n\n")
+ (map-do
+ (lambda (name value)
+ (let ((field
+ (agent-shell-elicitation--field entry name)))
+ (insert
+ (format
+ "%s: %s\n"
+ (or (map-elt field :title)
+ (agent-shell-elicitation--name-string name))
+ (agent-shell-elicitation--summary-value
+ field value)))))
+ content))
+ (insert (propertize
+ "Submitted with no values."
+ 'face 'bold))))
+ ("decline"
+ (insert (propertize "Declined" 'face 'bold)))
+ (_
+ (insert (propertize "Cancelled" 'face 'bold))))
+ (when detail
+ (insert "\n\n" (propertize detail 'face 'shadow)))
+ (buffer-string)))
+
+(defun agent-shell-elicitation--render-body (state entry body)
+ "Render BODY for ENTRY in STATE's shell."
+ (agent-shell--update-fragment
+ :state state
+ :namespace-id agent-shell-elicitation--namespace
+ :block-id (map-elt entry :block-id)
+ :label-left
+ (propertize
+ (format "Input requested by %s"
+ (agent-shell-elicitation--agent-name state))
+ 'font-lock-face 'agent-shell-section-heading)
+ :body body
+ :navigation 'never
+ :expanded t
+ :render-markdown nil
+ :above-last-prompt t))
+
+(defun agent-shell-elicitation--render (state entry)
+ "Render pending ENTRY in STATE's shell."
+ (agent-shell-elicitation--render-body
+ state entry (agent-shell-elicitation--body state entry)))
+
+(cl-defun agent-shell-elicitation--render-settled
+ (&key state entry action content detail)
+ "Replace ENTRY's controls with an inert settlement summary in STATE."
+ (agent-shell-elicitation--render-body
+ state entry
+ (agent-shell-elicitation--settled-body
+ :entry entry
+ :action action
+ :content content
+ :detail detail)))
+
+(defun agent-shell-elicitation--take (state request-id)
+ "Remove and return REQUEST-ID's live record from STATE.
+
+Rendered text is intentionally untouched so successful settlement can
+replace it with an inert summary."
+ (when-let* ((entry (agent-shell-elicitation--entry state request-id)))
+ (map-put! state :elicitations
+ (map-delete (map-elt state :elicitations) request-id))
+ entry))
+
+(defun agent-shell-elicitation--delete-entry-fragment-safely (state entry)
+ "Best-effort removal of ENTRY's rendered fragment from STATE."
+ (condition-case err
+ (when-let* ((buffer (map-elt state :buffer))
+ ((buffer-live-p buffer)))
+ (agent-shell--delete-fragment
+ :state state
+ :namespace-id agent-shell-elicitation--namespace
+ :block-id (map-elt entry :block-id)))
+ (error
+ (message "Could not remove ACP form UI: %s"
+ (error-message-string err)))))
+
+(defun agent-shell-elicitation--remove (state request-id)
+ "Remove REQUEST-ID from STATE and both rendered views."
+ (when-let* ((entry
+ (agent-shell-elicitation--take state request-id)))
+ (agent-shell-elicitation--delete-entry-fragment-safely
+ state entry)
+ entry))
+
+(defun agent-shell-elicitation--control-property (property)
+ "Return PROPERTY from the inline control at point."
+ (or (get-text-property (point) property)
+ (when (> (point) (point-min))
+ (get-text-property (1- (point)) property))))
+
+(cl-defun agent-shell-elicitation--goto-control
+ (&key request-id action field option)
+ "Move to REQUEST-ID's control matching ACTION, FIELD, and OPTION."
+ (goto-char (point-min))
+ (let (found)
+ (while (and (not found)
+ (setq found
+ (text-property-search-forward
+ 'agent-shell-elicitation-request-id
+ request-id t)))
+ (goto-char (prop-match-beginning found))
+ (unless
+ (and
+ (or (null action)
+ (eq (get-text-property
+ (point) 'agent-shell-elicitation-action)
+ action))
+ (or (null field)
+ (equal
+ (get-text-property
+ (point) 'agent-shell-elicitation-field)
+ field))
+ (or (null option)
+ (equal
+ (get-text-property
+ (point) 'agent-shell-elicitation-option)
+ option)))
+ (goto-char (prop-match-end found))
+ (setq found nil)))
+ (when found
+ (goto-char (prop-match-beginning found))
+ t)))
+
+(defun agent-shell-elicitation--focus-request (request-id)
+ "Move this buffer and its windows to REQUEST-ID's first control."
+ (when (agent-shell-elicitation--goto-control
+ :request-id request-id)
+ (seq-do
+ (lambda (window)
+ (set-window-point window (point)))
+ (get-buffer-window-list (current-buffer) nil t))
+ t))
+
+(defun agent-shell-elicitation--parse-number (text integer)
+ "Parse TEXT as a JSON number, requiring INTEGER when non-nil.
+
+For example:
+
+ (agent-shell-elicitation--parse-number \"1.5\" nil)
+ => 1.5"
+ (let ((value
+ (condition-case nil
+ (json-parse-string text)
+ (error
+ (user-error "Enter a valid JSON number")))))
+ (unless (numberp value)
+ (user-error "Enter a valid JSON number"))
+ (when (and integer
+ (not (agent-shell-elicitation--integer-p value)))
+ (user-error "Enter a signed 64-bit integer"))
+ value))
+
+(defun agent-shell-elicitation--validate-value (field value)
+ "Validate FIELD's VALUE and return it."
+ (pcase (map-elt field :kind)
+ ('string
+ (when (and (map-elt field :minimum)
+ (< (length value) (map-elt field :minimum)))
+ (user-error "%s is shorter than its minimum length"
+ (map-elt field :title)))
+ (when (and (map-elt field :maximum)
+ (> (length value) (map-elt field :maximum)))
+ (user-error "%s is longer than its maximum length"
+ (map-elt field :title)))
+ ;; ACP uses ECMA-262 patterns. Emacs regular expressions have
+ ;; different semantics and no evaluation timeout, so evaluating an
+ ;; untrusted pattern here would be both inaccurate and able to block
+ ;; the UI. The constraint is displayed and the Agent validates it.
+ )
+ ((or 'number 'integer)
+ (when (and (map-elt field :minimum)
+ (< value (map-elt field :minimum)))
+ (user-error "%s is below its minimum"
+ (map-elt field :title)))
+ (when (and (map-elt field :maximum)
+ (> value (map-elt field :maximum)))
+ (user-error "%s is above its maximum"
+ (map-elt field :title))))
+ ('multi-select
+ (when (and (map-elt field :minimum)
+ (< (length value) (map-elt field :minimum)))
+ (user-error "%s has too few selections"
+ (map-elt field :title)))
+ (when (and (map-elt field :maximum)
+ (> (length value) (map-elt field :maximum)))
+ (user-error "%s has too many selections"
+ (map-elt field :title)))))
+ value)
+
+(defun agent-shell-elicitation--content (entry)
+ "Return validated ACP content from pending ENTRY.
+
+For example, an included false boolean field named `authorize' becomes:
+
+ ((authorize . :false))"
+ (when-let* ((field
+ (agent-shell-elicitation--required-unsupported-field
+ entry)))
+ (user-error
+ "%s has an unsupported field type"
+ (map-elt field :title)))
+ (seq-keep
+ (lambda (field)
+ (when (and (map-elt field :included)
+ (not (eq (map-elt field :kind) 'unsupported)))
+ (unless (map-elt field :has-value)
+ (user-error "%s needs a value" (map-elt field :title)))
+ (let ((value
+ (pcase (map-elt field :kind)
+ ('number
+ (agent-shell-elicitation--parse-number
+ (map-elt field :value) nil))
+ ('integer
+ (agent-shell-elicitation--parse-number
+ (map-elt field :value) t))
+ ('boolean
+ (if (map-elt field :value) t :false))
+ ('multi-select
+ (vconcat (map-elt field :value)))
+ (_
+ (map-elt field :value)))))
+ (cons (map-elt field :name)
+ (agent-shell-elicitation--validate-value field value)))))
+ (map-elt entry :fields)))
+
+(cl-defun agent-shell-elicitation--settle-ui
+ (&key state entry action content detail)
+ "Replace ENTRY with an inert ACTION summary in STATE.
+
+CONTENT contains accepted values and DETAIL explains automatic
+cancellation. Rendering cannot change the already completed protocol
+operation; if it fails, remove the stale controls instead."
+ (let ((buffer (map-elt state :buffer)))
+ (if (and buffer
+ (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (derived-mode-p 'agent-shell-mode)))
+ (condition-case err
+ (agent-shell-elicitation--render-settled
+ :state state
+ :entry entry
+ :action action
+ :content content
+ :detail detail)
+ (error
+ (agent-shell-elicitation--delete-entry-fragment-safely
+ state entry)
+ (message "Could not render settled ACP form: %s"
+ (error-message-string err))))
+ (agent-shell-elicitation--delete-entry-fragment-safely
+ state entry))))
+
+(cl-defun agent-shell-elicitation--send-user-response
+ (&key state request-id action content)
+ "Settle REQUEST-ID in STATE with user ACTION and optional CONTENT."
+ (when-let* ((entry
+ (agent-shell-elicitation--take state request-id)))
+ (condition-case err
+ (acp-send-response
+ :client (map-elt state :client)
+ :response
+ (acp-make-elicitation-response
+ :request-id request-id
+ :action action
+ :content content))
+ (error
+ (agent-shell-elicitation--delete-entry-fragment-safely
+ state entry)
+ (signal (car err) (cdr err))))
+ (agent-shell-elicitation--settle-ui
+ :state state
+ :entry entry
+ :action action
+ :content content)
+ entry))
+
+(cl-defun agent-shell-elicitation--send-cancelled-error
+ (&key state request-id message)
+ "Settle REQUEST-ID in STATE as protocol cancellation with MESSAGE."
+ (when-let* ((entry
+ (agent-shell-elicitation--take state request-id)))
+ ;; Automatic owner cleanup runs inside unrelated request and
+ ;; notification callbacks. A dead transport must not prevent those
+ ;; owners from completing their own state transitions.
+ (condition-case err
+ (acp-send-response
+ :client (map-elt state :client)
+ :response
+ `((:request-id . ,request-id)
+ (:error . ,(acp-make-error
+ :code -32800
+ :message message))))
+ (error
+ (message "Could not cancel ACP form request: %s"
+ (error-message-string err))))
+ (agent-shell-elicitation--settle-ui
+ :state state
+ :entry entry
+ :action "cancel"
+ :detail message)
+ entry))
+
+(defun agent-shell-elicitation-submit (state request-id)
+ "Validate and submit REQUEST-ID from STATE."
+ (when-let* ((entry (agent-shell-elicitation--entry state request-id)))
+ (condition-case err
+ (agent-shell-elicitation--send-user-response
+ :state state
+ :request-id request-id
+ :action "accept"
+ :content (agent-shell-elicitation--content entry))
+ (user-error
+ (map-put! entry :error (error-message-string err))
+ (agent-shell-elicitation--render state entry)))))
+
+(defun agent-shell-elicitation-activate ()
+ "Activate the inline elicitation control at point."
+ (interactive)
+ (let ((shell-buffer
+ (agent-shell-elicitation--control-property
+ 'agent-shell-elicitation-shell-buffer))
+ (request-id
+ (agent-shell-elicitation--control-property
+ 'agent-shell-elicitation-request-id))
+ (action
+ (agent-shell-elicitation--control-property
+ 'agent-shell-elicitation-action))
+ (field-name
+ (agent-shell-elicitation--control-property
+ 'agent-shell-elicitation-field))
+ (option
+ (agent-shell-elicitation--control-property
+ 'agent-shell-elicitation-option))
+ (origin (current-buffer)))
+ (unless (buffer-live-p shell-buffer)
+ (user-error "The elicitation's shell is no longer available"))
+ (with-current-buffer shell-buffer
+ (let* ((state (agent-shell--state))
+ (entry
+ (or (agent-shell-elicitation--entry state request-id)
+ (user-error "This elicitation is no longer pending")))
+ (field
+ (when field-name
+ (or (agent-shell-elicitation--field entry field-name)
+ (user-error "This elicitation field no longer exists")))))
+ (pcase action
+ ('edit
+ (map-put! field :value
+ (read-string
+ (format "%s: " (map-elt field :title))
+ (map-elt field :value)))
+ (map-put! field :has-value t)
+ (map-put! field :included t))
+ ('toggle-include
+ (map-put! field :included
+ (not (map-elt field :included))))
+ ('set-option
+ (map-put! field :value option)
+ (map-put! field :has-value t)
+ (map-put! field :included t))
+ ('toggle-option
+ (map-put!
+ field :value
+ (if (seq-contains-p (map-elt field :value) option)
+ (seq-remove
+ (lambda (value)
+ (equal value option))
+ (map-elt field :value))
+ (append (map-elt field :value) (list option))))
+ (map-put! field :included t))
+ ('submit
+ (agent-shell-elicitation-submit state request-id))
+ ('decline
+ (agent-shell-elicitation--send-user-response
+ :state state :request-id request-id :action "decline"))
+ ('cancel
+ (agent-shell-elicitation--send-user-response
+ :state state :request-id request-id :action "cancel"))
+ (_
+ (user-error "Unknown elicitation action")))
+ (when (agent-shell-elicitation--entry state request-id)
+ (unless (eq action 'submit)
+ (map-put! entry :error nil)
+ (agent-shell-elicitation--render state entry))
+ (when (buffer-live-p origin)
+ (with-current-buffer origin
+ (agent-shell-elicitation--goto-control
+ :request-id request-id
+ :action action
+ :field field-name
+ :option option))))))))
+
+(cl-defun agent-shell-elicitation--on-create-request
+ (&key state acp-request)
+ "Handle an incoming `elicitation/create' ACP-REQUEST using STATE."
+ (let ((request-id (map-elt acp-request 'id))
+ entry)
+ (condition-case err
+ (setq entry
+ (agent-shell-elicitation--normalize-request
+ state acp-request))
+ (error
+ (acp-send-response
+ :client (map-elt state :client)
+ :response
+ `((:request-id . ,request-id)
+ (:error . ,(acp-make-error
+ :code -32602
+ :message (error-message-string err)))))))
+ (when entry
+ ;; JSON-RPC IDs need only be unique while outstanding. A local
+ ;; sequence keeps an inert summary distinct if the Agent later
+ ;; reuses the same wire ID for another elicitation.
+ (map-put! state :elicitation-count
+ (1+ (map-elt state :elicitation-count)))
+ (setq entry
+ (append
+ entry
+ (list
+ (cons
+ :block-id
+ (format
+ "request-%s-%S"
+ (map-elt state :elicitation-count)
+ request-id)))))
+ (map-put! state :elicitations
+ (cons (cons request-id entry)
+ (map-elt state :elicitations)))
+ (condition-case err
+ (progn
+ (agent-shell-elicitation--render state entry)
+ (agent-shell--present-user-input-request
+ :state state
+ :focus
+ (lambda ()
+ (agent-shell-elicitation--focus-request request-id))))
+ (error
+ (agent-shell-elicitation--remove state request-id)
+ (acp-send-response
+ :client (map-elt state :client)
+ :response
+ `((:request-id . ,request-id)
+ (:error . ,(acp-make-error
+ :code -32603
+ :message (error-message-string err))))))))))
+
+(cl-defun agent-shell-elicitation--on-cancel-request
+ (&key state request-id)
+ "Handle Agent cancellation of incoming REQUEST-ID in STATE."
+ (agent-shell-elicitation--send-cancelled-error
+ :state state
+ :request-id request-id
+ :message "Elicitation cancelled by Agent"))
+
+(cl-defun agent-shell-elicitation--request-finished
+ (&key state request-id)
+ "Cancel forms whose owning client REQUEST-ID has finished in STATE."
+ (map-do
+ (lambda (elicitation-id entry)
+ (when (and (eq (map-elt entry :scope) 'request)
+ (equal (map-elt entry :scope-id) request-id))
+ (agent-shell-elicitation--send-cancelled-error
+ :state state
+ :request-id elicitation-id
+ :message "Owning ACP request finished")))
+ (copy-sequence (map-elt state :elicitations))))
+
+(cl-defun agent-shell-elicitation--tool-finished
+ (&key state tool-call-id)
+ "Cancel forms whose owning TOOL-CALL-ID has finished in STATE."
+ (map-do
+ (lambda (elicitation-id entry)
+ (when (equal (map-elt entry :tool-call-id) tool-call-id)
+ (agent-shell-elicitation--send-cancelled-error
+ :state state
+ :request-id elicitation-id
+ :message "Owning tool call finished")))
+ (copy-sequence (map-elt state :elicitations))))
+
+(cl-defun agent-shell-elicitation--session-finished
+ (&key state session-id)
+ "Cancel forms owned by SESSION-ID during a STATE session change."
+ (map-do
+ (lambda (elicitation-id entry)
+ (when (and (eq (map-elt entry :scope) 'session)
+ (equal (map-elt entry :scope-id) session-id))
+ (agent-shell-elicitation--send-cancelled-error
+ :state state
+ :request-id elicitation-id
+ :message "Owning ACP session finished")))
+ (copy-sequence (map-elt state :elicitations))))
+
+(cl-defun agent-shell-elicitation--dismiss-all (&key state)
+ "Dismiss all pending forms in STATE before intentional shutdown."
+ (map-do
+ (lambda (request-id _entry)
+ (condition-case err
+ (agent-shell-elicitation--send-user-response
+ :state state
+ :request-id request-id
+ :action "cancel")
+ (error
+ (agent-shell-elicitation--remove state request-id)
+ (message "Could not cancel ACP form: %s"
+ (error-message-string err)))))
+ (copy-sequence (map-elt state :elicitations))))
+
+(cl-defun agent-shell-elicitation--abandon-all (&key state)
+ "Settle STATE's forms after their ACP connection has disappeared."
+ (map-do
+ (lambda (request-id _entry)
+ (when-let* ((entry
+ (agent-shell-elicitation--take state request-id)))
+ (agent-shell-elicitation--settle-ui
+ :state state
+ :entry entry
+ :action "cancel"
+ :detail "Agent connection closed")))
+ (copy-sequence (map-elt state :elicitations))))
+
+(defun agent-shell-next-elicitation-control ()
+ "Move to the next inline elicitation control."
+ (interactive)
+ (when-let* ((found
+ (save-mark-and-excursion
+ (when-let* (((get-text-property
+ (point)
+ 'agent-shell-elicitation-control))
+ (next-change
+ (next-single-property-change
+ (point)
+ 'agent-shell-elicitation-control)))
+ (goto-char next-change))
+ (when-let* ((match
+ (text-property-search-forward
+ 'agent-shell-elicitation-control t t)))
+ (prop-match-beginning match)))))
+ (deactivate-mark)
+ (goto-char found)
+ (point)))
+
+(defun agent-shell-previous-elicitation-control ()
+ "Move to the previous inline elicitation control."
+ (interactive)
+ (when-let* ((found
+ (save-mark-and-excursion
+ (when-let* (((get-text-property
+ (point)
+ 'agent-shell-elicitation-control))
+ (previous-change
+ (previous-single-property-change
+ (point)
+ 'agent-shell-elicitation-control)))
+ (goto-char previous-change))
+ (when-let* ((match
+ (text-property-search-backward
+ 'agent-shell-elicitation-control t t)))
+ (prop-match-beginning match)))))
+ (deactivate-mark)
+ (goto-char found)
+ (point)))
+
+(provide 'agent-shell-elicitation)
+
+;;; agent-shell-elicitation.el ends here
diff --git a/agent-shell.el b/agent-shell.el
index fb112da8..48909a8f 100644
--- a/agent-shell.el
+++ b/agent-shell.el
@@ -64,6 +64,7 @@
(require 'agent-shell-cursor)
(require 'agent-shell-devcontainer)
(require 'agent-shell-diff)
+(require 'agent-shell-elicitation)
(require 'agent-shell-experimental)
(require 'agent-shell-droid)
(require 'agent-shell-github)
@@ -353,14 +354,20 @@ members, so neither local nor global renderers run.
Passes agent-shell's own cache directory as the renderer's remote-image
cache so downloaded images share `agent-shell-cache-dir'."
- (let ((agent-shell-markdown-render-functions
- (when external-renderers
- agent-shell-markdown-render-functions)))
- (funcall agent-shell-markdown-render-function
- :render-images render-images
- :highlight-blocks highlight-blocks
- :complete complete
- :image-cache-directory (agent-shell-cache-dir "content"))))
+ ;; Literal fragments retain this property so later generic passes, such
+ ;; as expansion and deferred-image rendering, cannot accidentally turn
+ ;; untrusted form text into active Markdown links.
+ (unless (and (< (point-min) (point-max))
+ (get-text-property (point-min)
+ 'agent-shell-literal-content))
+ (let ((agent-shell-markdown-render-functions
+ (when external-renderers
+ agent-shell-markdown-render-functions)))
+ (funcall agent-shell-markdown-render-function
+ :render-images render-images
+ :highlight-blocks highlight-blocks
+ :complete complete
+ :image-cache-directory (agent-shell-cache-dir "content")))))
(defun agent-shell--render-deferred-images ()
"Render image markup the streaming passes held back, the turn being over.
@@ -1192,6 +1199,8 @@ OUTGOING-REQUEST-DECORATOR (passed through to `acp-make-client')."
(cons :request-count 0)
(cons :last-activity-time nil)
(cons :tool-calls nil)
+ (cons :elicitations nil)
+ (cons :elicitation-count 0)
(cons :available-commands nil)
(cons :available-modes nil)
(cons :supports-session-list nil)
@@ -2124,6 +2133,28 @@ When nil, check if any permission request is pending."
(map-elt (cdr entry) :permission-request-id))
(map-elt (agent-shell--state) :tool-calls)))))
+(cl-defun agent-shell--present-user-input-request (&key state focus)
+ "Display STATE's shell and reveal the control selected by FOCUS.
+
+Permission and elicitation requests have different protocol lifetimes,
+but their canonical controls belong to the same shell buffer. Present
+that buffer instead of changing a viewport, which may contain the
+user's next prompt."
+ (when-let* ((shell-buffer (map-elt state :buffer))
+ ((buffer-live-p shell-buffer)))
+ (with-current-buffer shell-buffer
+ ;; A chat label is an overlay attached before the shell prompt.
+ ;; Recompute it after inserting the request above that prompt, or its
+ ;; displayed "Me" label remains above Agent-originated controls.
+ (when agent-shell-chat-mode
+ (agent-shell-chat--relabel))
+ (agent-shell--display-buffer shell-buffer)
+ (when (funcall focus)
+ ;; `set-window-point' alone permits a window point outside its
+ ;; displayed range. Recenter the selected shell window so the
+ ;; request is visibly actionable, not merely present in its buffer.
+ (recenter)))))
+
(cl-defun agent-shell-status (&key shell-buffer)
"Return the status of the agent shell as a symbol.
When SHELL-BUFFER is non-nil, check that buffer instead of the current one.
@@ -2355,7 +2386,10 @@ Flow:
;; Needs ACP subscriptions
((or (not (map-nested-elt (agent-shell--state) '(:client :request-handlers)))
(not (map-nested-elt (agent-shell--state) '(:client :notification-handlers)))
- (not (map-nested-elt (agent-shell--state) '(:client :error-handlers))))
+ (not (map-nested-elt (agent-shell--state) '(:client :error-handlers)))
+ (not (map-nested-elt
+ (agent-shell--state)
+ '(:client :process-exit-handlers))))
(when (agent-shell--initialize-subscriptions)
(agent-shell--handle :command command :shell-buffer shell-buffer)))
;; Needs to send ACP initialize request
@@ -2948,7 +2982,16 @@ Clears STATE's `:expanded-activity-group'."
(cl-defun agent-shell--on-notification (&key state acp-notification)
"Handle incoming ACP-NOTIFICATION using STATE."
(map-put! state :last-activity-time (current-time))
- (cond ((equal (map-elt acp-notification 'method) "session/update")
+ (cond ((and
+ (equal (map-elt acp-notification 'method) "$/cancel_request")
+ (agent-shell-elicitation--entry
+ state
+ (map-nested-elt acp-notification '(params requestId))))
+ (agent-shell-elicitation--on-cancel-request
+ :state state
+ :request-id (map-nested-elt acp-notification
+ '(params requestId))))
+ ((equal (map-elt acp-notification 'method) "session/update")
;; Replayed user_message_chunks aren't followed by
;; shell-maker's end-of-prompt marker (no real
;; `comint-send-input'). Insert it on the first
@@ -3045,6 +3088,15 @@ Clears STATE's `:expanded-activity-group'."
(when-let* ((diffs (agent-shell--make-diff-infos
:acp-tool-call (map-nested-elt acp-notification '(params update)))))
(list (cons :diffs diffs)))))
+ (when (seq-contains-p
+ '("completed" "failed" "cancelled")
+ (map-nested-elt acp-notification
+ '(params update status)))
+ (agent-shell-elicitation--tool-finished
+ :state state
+ :tool-call-id
+ (map-nested-elt acp-notification
+ '(params update toolCallId))))
(agent-shell--cancel-idle-timer)
(agent-shell--emit-event
:event 'tool-call-update
@@ -3306,8 +3358,17 @@ Clears STATE's `:expanded-activity-group'."
;; 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"))
+ (when (seq-contains-p
+ '("completed" "failed" "cancelled")
+ (map-nested-elt
+ acp-notification '(params update status)))
+ ;; A tool-scoped elicitation cannot remain valid after its
+ ;; owning tool call has reached a terminal state.
+ (agent-shell-elicitation--tool-finished
+ :state state
+ :tool-call-id
+ (map-nested-elt acp-notification
+ '(params update toolCallId)))
;; 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)))))
@@ -3487,13 +3548,9 @@ Clears STATE's `:expanded-activity-group'."
:expanded t
:navigation 'never
:above-last-prompt (not (agent-shell--active-requests-p state)))
- (agent-shell-jump-to-latest-permission-button-row)
- (when-let* (((map-elt state :buffer))
- (viewport-buffer (agent-shell-viewport--buffer
- :shell-buffer (map-elt state :buffer)
- :existing-only t)))
- (with-current-buffer viewport-buffer
- (agent-shell-jump-to-latest-permission-button-row)))
+ (agent-shell--present-user-input-request
+ :state state
+ :focus #'agent-shell-jump-to-latest-permission-button-row)
(let ((data (list (cons :request-id (map-elt acp-request 'id))
(cons :tool-call-id tool-call-id)
(cons :tool-call (map-nested-elt state (list :tool-calls tool-call-id))))))
@@ -3514,6 +3571,10 @@ Clears STATE's `:expanded-activity-group'."
(agent-shell-experimental--on-session-push-request
:state state
:acp-request acp-request))
+ ((equal (map-elt acp-request 'method) "elicitation/create")
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request acp-request))
(t
(let ((method (map-elt acp-request 'method)))
(agent-shell--update-fragment
@@ -4226,6 +4287,10 @@ For example, shut down ACP client."
(unless (derived-mode-p 'agent-shell-mode)
(error "Not in a shell"))
(when (map-elt (agent-shell--state) :client)
+ ;; Elicitations are reverse requests owned by this connection. Resolve
+ ;; them before deliberately closing the transport; a dead connection
+ ;; cannot receive their cancellation responses.
+ (agent-shell-elicitation--dismiss-all :state (agent-shell--state))
(acp-shutdown :client (map-elt (agent-shell--state) :client))
(map-put! (agent-shell--state) :client nil)
(map-put! (agent-shell--state) :initialized nil)
@@ -4851,24 +4916,28 @@ variable (see makunbound)"))
(agent-shell--display-buffer shell-buffer))))
shell-buffer))
-(cl-defun agent-shell--delete-fragment (&key state block-id)
- "Delete fragment with STATE and BLOCK-ID."
- (when-let* (((map-elt state :buffer))
- (viewport-buffer (agent-shell-viewport--buffer
- :shell-buffer (map-elt state :buffer)
- :existing-only t))
- ;; Fragment deletion only makes sense when viewport is
- ;; displaying conversation, never while it's an active compose buffer.
- ((with-current-buffer viewport-buffer
- (derived-mode-p 'agent-shell-viewport-view-mode))))
- (with-current-buffer viewport-buffer
- (agent-shell-ui-delete-fragment :namespace-id (map-elt state :request-count) :block-id block-id :no-undo t)))
- (with-current-buffer (map-elt state :buffer)
- (unless (and (derived-mode-p 'agent-shell-mode)
- (equal (current-buffer)
- (map-elt state :buffer)))
- (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)))
+(cl-defun agent-shell--delete-fragment (&key state block-id namespace-id)
+ "Delete fragment with STATE and BLOCK-ID.
+Use STATE's request count as the namespace unless NAMESPACE-ID is given."
+ (let ((namespace-id (or namespace-id (map-elt state :request-count))))
+ (when-let* (((map-elt state :buffer))
+ (viewport-buffer (agent-shell-viewport--buffer
+ :shell-buffer (map-elt state :buffer)
+ :existing-only t))
+ ;; Fragment deletion only makes sense when viewport is
+ ;; displaying conversation, never while it's an active compose buffer.
+ ((with-current-buffer viewport-buffer
+ (derived-mode-p 'agent-shell-viewport-view-mode))))
+ (with-current-buffer viewport-buffer
+ (agent-shell-ui-delete-fragment
+ :namespace-id namespace-id :block-id block-id :no-undo t)))
+ (with-current-buffer (map-elt state :buffer)
+ (unless (and (derived-mode-p 'agent-shell-mode)
+ (equal (current-buffer)
+ (map-elt state :buffer)))
+ (error "Editing the wrong buffer: %s" (current-buffer)))
+ (agent-shell-ui-delete-fragment
+ :namespace-id namespace-id :block-id block-id :no-undo t))))
(cl-defun agent-shell--collapse-fragment-group (&key state namespace-id block-id)
"Collapse group header BLOCK-ID under NAMESPACE-ID in STATE's buffers.
@@ -4968,7 +5037,8 @@ the reported range down to the newly inserted chars."
(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 above-last-prompt
- group-id group-label (group-expanded t))
+ group-id group-label (group-expanded t)
+ (render-markdown t))
"Update fragment in the shell buffer.
Creates or updates existing dialog using STATE's request count as namespace
@@ -4983,7 +5053,8 @@ NAVIGATION for navigation style, EXPANDED to show block expanded
by default, RENDER-BODY-IMAGES to enable inline image rendering in
body, ABOVE-LAST-PROMPT to land content above the active prompt
instead of after it (typical for notifications arriving out of
-turn). Programmatic fragment updates do not enter undo history.
+turn), and RENDER-MARKDOWN nil to preserve body and labels literally.
+Programmatic fragment updates do not enter undo history.
GROUP-ID nests this block under a collapsible group header, materialized
from GROUP-LABEL on first use (see `agent-shell-ui-make-fragment-model'),
@@ -4993,7 +5064,8 @@ with GROUP-EXPANDED as the group's initial fold state."
;; Convert non-standard multiline single-backtick code spans to fenced
;; code blocks so the markdown renderer can recognize them as source
;; blocks, but only for labels that start with `.
- (when (and label-right
+ (when (and render-markdown
+ label-right
(not (string-match-p (rx "```") label-right))
(string-match-p
(rx "`" (zero-or-more (not (any "\n`")))
@@ -5008,6 +5080,16 @@ with GROUP-EXPANDED as the group's initial fold state."
"`")
"Snippet\n\n```\n\\1\n```\n"
label-right)))
+ ;; Carry literalness with the text rather than with one rendering pass.
+ ;; Expansion and deferred-image rendering revisit fragment bodies later,
+ ;; and `agent-shell--render-markdown' must still leave them inert.
+ (unless render-markdown
+ (when body
+ (setq body
+ (propertize body 'agent-shell-literal-content t)))
+ (when label-right
+ (setq label-right
+ (propertize label-right 'agent-shell-literal-content t))))
(when-let* (((map-elt state :buffer))
(viewport-buffer (agent-shell-viewport--buffer
:shell-buffer (map-elt state :buffer)
@@ -5275,6 +5357,8 @@ insert the character instead."
(agent-shell-ui-forward-block)))
(button-pos (save-mark-and-excursion
(agent-shell-next-permission-button)))
+ (elicitation-pos (save-mark-and-excursion
+ (agent-shell-next-elicitation-control)))
(image-pos (save-mark-and-excursion
(agent-shell-markdown--next-visible-image)))
(link-pos (save-mark-and-excursion
@@ -5292,6 +5376,7 @@ insert the character instead."
(delq nil (list prompt-pos
block-pos
button-pos
+ elicitation-pos
image-pos
link-pos
source-block-pos
@@ -5342,6 +5427,8 @@ insert the character instead."
(agent-shell-ui-backward-block)))
(button-pos (save-mark-and-excursion
(agent-shell-previous-permission-button)))
+ (elicitation-pos (save-mark-and-excursion
+ (agent-shell-previous-elicitation-control)))
(image-pos (save-mark-and-excursion
(agent-shell-markdown--previous-visible-image)))
(link-pos (save-mark-and-excursion
@@ -5361,6 +5448,7 @@ insert the character instead."
(delq nil (list prompt-pos
block-pos
button-pos
+ elicitation-pos
image-pos
link-pos
source-block-pos
@@ -6512,8 +6600,9 @@ the original EVENT as :idle-event."
(cl-defun agent-shell--send-request (&key state client request buffer on-success on-failure sync)
"Send ACP REQUEST, tracking it in STATE via :active-requests.
-Wraps `acp-send-request' so that REQUEST is pushed to
-:active-requests while in-flight and removed on success or failure.
+The tracked copy receives its wire request id before transmission. ACP
+elicitations may be scoped to that id, so the id must be visible while
+the Agent can observe and answer the outgoing request.
CLIENT, REQUEST, BUFFER, ON-SUCCESS, ON-FAILURE, and SYNC are passed
through to `acp-send-request'."
@@ -6521,27 +6610,48 @@ through to `acp-send-request'."
;; Without this, map-put! fails on mid-session package updates.
(unless (assq :active-requests state)
(nconc state (list (cons :active-requests nil))))
- (map-put! state :active-requests
- (cons request (map-elt state :active-requests)))
- (acp-send-request
- :client client
- :request request
- :buffer buffer
- :on-success (lambda (acp-response)
- (map-put! state :active-requests
- (seq-remove (lambda (r)
- (equal r request))
- (map-elt state :active-requests)))
- (when on-success
- (funcall on-success acp-response)))
- :on-failure (lambda (acp-error raw-message)
- (map-put! state :active-requests
- (seq-remove (lambda (r)
- (equal r request))
- (map-elt state :active-requests)))
- (when on-failure
- (funcall on-failure acp-error raw-message)))
- :sync sync))
+ (let* ((tracked-request
+ (append (copy-tree request)
+ (list (cons :wire-request-id nil))))
+ (finished nil)
+ (finish
+ (lambda ()
+ (unless finished
+ (setq finished t)
+ (map-put! state :active-requests
+ (seq-remove
+ (lambda (active-request)
+ (eq active-request tracked-request))
+ (map-elt state :active-requests)))
+ (agent-shell-elicitation--request-finished
+ :state state
+ :request-id
+ (map-elt tracked-request :wire-request-id))))))
+ (map-put! state :active-requests
+ (cons tracked-request (map-elt state :active-requests)))
+ (condition-case err
+ (acp-send-request
+ :client client
+ :request request
+ :buffer buffer
+ :on-sent
+ (lambda (sent)
+ (map-put! tracked-request :wire-request-id
+ (map-elt sent :request-id)))
+ :on-success
+ (lambda (acp-response)
+ (funcall finish)
+ (when on-success
+ (funcall on-success acp-response)))
+ :on-failure
+ (lambda (acp-error raw-message)
+ (funcall finish)
+ (when on-failure
+ (funcall on-failure acp-error raw-message)))
+ :sync sync)
+ (error
+ (funcall finish)
+ (signal (car err) (cdr err))))))
(cl-defun agent-shell--initiate-handshake (&key shell-buffer on-initiated)
"Initiate ACP handshake with SHELL-BUFFER.
@@ -6564,7 +6674,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
+ :elicitation-form-capability t)
:on-success (lambda (acp-response)
(with-current-buffer shell-buffer
(let ((acp-session-capabilities (or (map-elt acp-response 'sessionCapabilities)
@@ -7318,6 +7429,14 @@ Falls back to latest session in batch mode (e.g. tests)."
(cl-defun agent-shell--set-session-from-response (&key acp-response acp-session-id)
"Set active session state from ACP-RESPONSE and ACP-SESSION-ID."
+ (when-let* ((old-session-id
+ (map-nested-elt agent-shell--state '(:session :id)))
+ ((not (equal old-session-id acp-session-id))))
+ ;; Session-scoped reverse requests belong to the old session even when
+ ;; the same ACP connection is reused for a new or forked one.
+ (agent-shell-elicitation--session-finished
+ :state agent-shell--state
+ :session-id old-session-id))
(map-put! agent-shell--state
:session (agent-shell--session-from-response
:acp-response acp-response
@@ -7957,6 +8076,13 @@ The agent config's `:mcp-servers' take precedence over the global
(cl-defun agent-shell--subscribe-to-client-events (&key state)
"Subscribe SHELL and STATE to ACP events."
+ (acp-subscribe-to-process-exits
+ :client (map-elt state :client)
+ :on-exit
+ (lambda (_event)
+ ;; The transport is already gone, so there is nowhere to send a
+ ;; cancellation response. Remove connection-owned UI and state.
+ (agent-shell-elicitation--abandon-all :state state)))
(acp-subscribe-to-errors
:client (map-elt state :client)
:on-error (lambda (acp-error)
diff --git a/tests/agent-shell-chat-mode-tests.el b/tests/agent-shell-chat-mode-tests.el
index c401e9ca..2e3534d7 100644
--- a/tests/agent-shell-chat-mode-tests.el
+++ b/tests/agent-shell-chat-mode-tests.el
@@ -254,6 +254,37 @@ such as `end-of-visual-line'."
(should (> (overlay-start me) terminator))
(should-not (get-char-property terminator 'display))))))
+(ert-deftest agent-shell-chat-live-prompt-excludes-replaced-output-test ()
+ "Replacing output before the live prompt does not hide its replacement.
+
+An inline control replaces its fragment body by deleting the old body
+before inserting the new one. The live prompt's whitespace overlay
+survives because one structural newline remains. Text inserted at that
+overlay's front must stay outside its empty `display', as \"new form\"
+does here."
+ (agent-shell-chat-mode-tests--with-shell
+ (let ((body-start (point)))
+ (insert "old form\n")
+ (let ((body-end (point)))
+ (insert "\n\n")
+ (agent-shell-chat-mode-tests--prompt "Claude> ")
+ (agent-shell-chat--relabel)
+ (let ((surplus
+ (seq-find
+ (lambda (overlay)
+ (eq
+ (overlay-get overlay 'agent-shell-chat--tag)
+ 'me-surplus))
+ (overlays-in (point-min) (point-max)))))
+ (should surplus)
+ (delete-region body-start body-end)
+ (should (= body-start (overlay-start surplus)))
+ (goto-char body-start)
+ (insert "new form\n\n")
+ (should-not
+ (equal ""
+ (get-char-property body-start 'display))))))))
+
(ert-deftest agent-shell-chat-label-is-before-string-test ()
"The `Me' label renders as a `before-string' with an empty `display'.
Like the agent label, this keeps the cursor from landing on it during
diff --git a/tests/agent-shell-elicitation-tests.el b/tests/agent-shell-elicitation-tests.el
new file mode 100644
index 00000000..74f3b195
--- /dev/null
+++ b/tests/agent-shell-elicitation-tests.el
@@ -0,0 +1,1174 @@
+;;; agent-shell-elicitation-tests.el --- Tests for inline ACP forms -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Tests for ACP form normalization, inline rendering, and ownership.
+
+;;; Code:
+
+(require 'agent-shell)
+(require 'agent-shell-elicitation)
+(require 'ert)
+
+(defun agent-shell-elicitation-tests--state (&optional buffer)
+ "Return fresh shell state using BUFFER."
+ (let ((state
+ (agent-shell--make-state
+ :agent-config '((:mode-line-name . "Loki"))
+ :buffer buffer)))
+ (map-put! state :client 'client)
+ (map-put! state :session '((:id . "session-1")))
+ state))
+
+(cl-defun agent-shell-elicitation-tests--request
+ (&key (id 1) (message "Choose") schema request-id
+ (session-id "session-1") tool-call-id (mode "form"))
+ "Return an elicitation request.
+
+ID identifies the reverse request. MESSAGE, SCHEMA, and MODE are its
+form data. REQUEST-ID selects request scope; otherwise SESSION-ID and
+optional TOOL-CALL-ID select session scope."
+ `((id . ,id)
+ (method . "elicitation/create")
+ (params
+ ,@(if request-id
+ `((requestId . ,request-id))
+ `((sessionId . ,session-id)
+ ,@(when tool-call-id
+ `((toolCallId . ,tool-call-id)))))
+ (mode . ,mode)
+ (message . ,message)
+ (requestedSchema . ,schema))))
+
+(defun agent-shell-elicitation-tests--boolean-schema ()
+ "Return Loki's saved-connection authorization schema."
+ '((type . "object")
+ (properties
+ (authorize
+ (type . "boolean")
+ (title . "Use saved connection")
+ (description . "Allow this connection.")
+ (default)))
+ (required . ["authorize"])))
+
+(defun agent-shell-elicitation-tests--all-fields-schema ()
+ "Return one constrained schema containing every supported field kind."
+ '((type . "object")
+ (properties
+ (text (type . "string") (default . "hello")
+ (minLength . 2) (maxLength . 8)
+ (pattern . "^[a-z]+$") (format . "text"))
+ (amount (type . "number") (default . 1.5)
+ (minimum . 1) (maximum . 2))
+ (count (type . "integer") (default . 2)
+ (minimum . 1) (maximum . 3))
+ (enabled (type . "boolean") (default))
+ (color (type . "string")
+ (enum . ["red" "blue"])
+ (default . "blue"))
+ (size (type . "string")
+ (oneOf . [((const . "s") (title . "Small"))
+ ((const . "l") (title . "Large"))])
+ (default . "l"))
+ (tags (type . "array")
+ (items
+ (type . "string")
+ (anyOf . [((const . "one") (title . "One"))
+ ((const . "two") (title . "Two"))]))
+ (default . ["two"])
+ (minItems . 1)
+ (maxItems . 2)))
+ (required . ["text" "amount" "count" "enabled"
+ "color" "size" "tags"])))
+
+(defun agent-shell-elicitation-tests--entry (schema)
+ "Normalize SCHEMA and return its form data."
+ (agent-shell-elicitation--normalize-schema schema))
+
+(defmacro agent-shell-elicitation-tests--with-shell
+ (shell state &rest body)
+ "Run BODY with initialized SHELL and STATE bindings."
+ (declare (indent 2) (debug (symbolp symbolp body)))
+ `(let* ((agent-shell-header-style nil)
+ (,shell (generate-new-buffer " *elicitation-shell*"))
+ (,state (agent-shell-elicitation-tests--state ,shell)))
+ (unwind-protect
+ (progn
+ (with-current-buffer ,shell
+ (comint-mode)
+ (setq major-mode 'agent-shell-mode)
+ (agent-shell-ui-mode 1)
+ (setq-local agent-shell--state ,state
+ kill-buffer-query-functions nil
+ shell-maker--config
+ (make-shell-maker-config
+ :name "Agent"
+ :prompt "> "
+ :prompt-regexp "^> ")))
+ ,@body)
+ (when (buffer-live-p ,shell)
+ (kill-buffer ,shell)))))
+
+(ert-deftest agent-shell-elicitation-normalizes-and-collects-fields-test ()
+ "Normalize and collect all supported field kinds and constraints."
+ (let* ((form
+ (agent-shell-elicitation-tests--entry
+ (agent-shell-elicitation-tests--all-fields-schema)))
+ (fields (map-elt form :fields)))
+ (should
+ (equal (seq-map (lambda (field) (map-elt field :kind)) fields)
+ '(string number integer boolean
+ single-select single-select multi-select)))
+ (should (equal (map-elt (seq-first fields) :minimum) 2))
+ (should (equal (map-elt (seq-first fields) :maximum) 8))
+ (should (equal (map-elt (seq-first fields) :pattern) "^[a-z]+$"))
+ (should
+ (equal
+ (agent-shell-elicitation--content form)
+ '((text . "hello")
+ (amount . 1.5)
+ (count . 2)
+ (enabled . :false)
+ (color . "blue")
+ (size . "l")
+ (tags . ["two"]))))))
+
+(ert-deftest agent-shell-elicitation-preserves-unset-and-false-test ()
+ "Keep omission distinct from JSON false on the live parse path."
+ (let* ((form
+ (agent-shell-elicitation-tests--entry
+ (map-nested-elt
+ (acp--parse-json
+ "{\"requestedSchema\":{\"type\":\"object\",\
+\"properties\":{\"note\":{\"type\":\"string\"},\
+\"authorize\":{\"type\":\"boolean\",\"default\":false}},\
+\"required\":[\"authorize\"]}}")
+ '(requestedSchema))))
+ (fields (map-elt form :fields)))
+ (should-not (map-elt (seq-first fields) :included))
+ (should (map-elt (seq-elt fields 1) :included))
+ (should
+ (equal (agent-shell-elicitation--content form)
+ '((authorize . :false))))))
+
+(ert-deftest agent-shell-elicitation-rejects-malformed-schema-test ()
+ "Reject schemas whose supported forms cannot be represented faithfully."
+ (seq-do
+ (lambda (schema)
+ (should-error (agent-shell-elicitation-tests--entry schema)))
+ '(((type . "object")
+ (properties (nested (type . "object"))))
+ ((type . "object")
+ (properties (choice (type . "string") (enum . []))))
+ ((type . "object")
+ (properties
+ (value (type . "number") (minimum . 2) (maximum . 1))))
+ ((type . "object")
+ (properties
+ (choices
+ (type . "array")
+ (items (type . "number") (enum . ["one"])))))
+ ((type . "object")
+ (properties
+ (choices
+ (type . "array")
+ (items (enum . ["one"])))))
+ ((type . "object")
+ (properties
+ (text
+ (type . "string")
+ (minLength . 4294967296)))))))
+
+(ert-deftest agent-shell-elicitation-preserves-unknown-field-types-test ()
+ "Keep unknown types opaque without preventing valid optional answers."
+ (let* ((unknown
+ '((type . "_future")
+ (title . "Future value")
+ (_meta (extension . t))))
+ (form
+ (agent-shell-elicitation-tests--entry
+ (list
+ (cons 'type "object")
+ (cons
+ 'properties
+ (list
+ (cons
+ 'known
+ '((type . "string") (default . "value")))
+ (cons 'future unknown)))
+ (cons 'required ["known"]))))
+ (field
+ (agent-shell-elicitation--field form 'future)))
+ (should (eq (map-elt field :kind) 'unsupported))
+ (should
+ (equal (agent-shell-elicitation--content form)
+ '((known . "value"))))
+ (let ((required
+ (agent-shell-elicitation-tests--entry
+ (list
+ (cons 'type "object")
+ (cons 'properties
+ (list (cons 'future unknown)))
+ (cons 'required ["future"])))))
+ (should
+ (eq
+ (map-elt
+ (agent-shell-elicitation--required-unsupported-field
+ required)
+ :kind)
+ 'unsupported))
+ (should-error
+ (agent-shell-elicitation--content required)
+ :type 'user-error)
+ (let* ((body
+ (agent-shell-elicitation--body
+ (agent-shell-elicitation-tests--state)
+ (append
+ '((:message . "Question"))
+ required)))
+ (plain (substring-no-properties body)))
+ (should (string-match-p
+ "Unsupported field type \"_future\"" plain))
+ (should (string-match-p "Cannot submit" plain))
+ (should-not
+ (text-property-any
+ 0 (length body)
+ 'agent-shell-elicitation-action 'submit body))
+ (should (string-match-p "Decline" plain))
+ (should (string-match-p "Cancel" plain))))
+ (let* ((form
+ (agent-shell-elicitation-tests--entry
+ '((type . "object")
+ (properties
+ (choices
+ (type . "array")
+ (items
+ (type . "_future")
+ (enum . ["one"])))))))
+ (field (seq-first (map-elt form :fields))))
+ (should (eq (map-elt field :kind) 'unsupported))
+ (should (equal (map-elt field :raw-type) "array"))
+ (should (equal (map-elt field :raw-item-type) "_future")))))
+
+(ert-deftest agent-shell-elicitation-tolerates-defaulted-schema-fields-test ()
+ "Apply ACP's reader defaults without inventing a choice."
+ (should-not
+ (map-elt (agent-shell-elicitation-tests--entry nil) :fields))
+ (let* ((form
+ (agent-shell-elicitation-tests--entry
+ '((type . 23)
+ (properties
+ (text (type . "string") (default . 42))
+ (choice (type . "string")
+ (enum . ["a" "b"])
+ (default . "missing"))
+ (tags (type . "array")
+ (items (type . "string")
+ (enum . ["a" "b"]))
+ (default . ["a" 2 "missing"]))))))
+ (fields (map-elt form :fields)))
+ (should-not (map-elt (seq-elt fields 0) :included))
+ (should-not (map-elt (seq-elt fields 1) :included))
+ (should-not (map-elt (seq-elt fields 1) :has-value))
+ (should (equal (map-elt (seq-elt fields 2) :value) '("a")))))
+
+(ert-deftest agent-shell-elicitation-validates-edited-values-test ()
+ "Validate length, numeric, integer, and selection-count constraints."
+ (let* ((form
+ (agent-shell-elicitation-tests--entry
+ (agent-shell-elicitation-tests--all-fields-schema)))
+ (fields (map-elt form :fields))
+ (text (seq-elt fields 0))
+ (amount (seq-elt fields 1))
+ (count (seq-elt fields 2))
+ (tags (seq-elt fields 6)))
+ (map-put! text :value "x")
+ (should-error (agent-shell-elicitation--content form)
+ :type 'user-error)
+ (map-put! text :value "hello")
+ (map-put! amount :value "3")
+ (should-error (agent-shell-elicitation--content form)
+ :type 'user-error)
+ (map-put! amount :value "1.5")
+ (map-put! count :value "2.5")
+ (should-error (agent-shell-elicitation--content form)
+ :type 'user-error)
+ (map-put! count :value "2")
+ (map-put! tags :value nil)
+ (should-error (agent-shell-elicitation--content form)
+ :type 'user-error)))
+
+(ert-deftest agent-shell-elicitation-validates-json-numbers-test ()
+ "Require complete JSON numbers and signed 64-bit integers."
+ (should (equal 1.5
+ (agent-shell-elicitation--parse-number "1.5" nil)))
+ (should (equal 2
+ (agent-shell-elicitation--parse-number "2" t)))
+ (should-error
+ (agent-shell-elicitation--parse-number "2 trailing" nil))
+ (should-error
+ (agent-shell-elicitation--parse-number "2.5" t))
+ (should-error
+ (agent-shell-elicitation--parse-number "9223372036854775808" t)))
+
+(ert-deftest agent-shell-elicitation-renders-inline-in-shell-test ()
+ "Render and settle one authoritative form in its shell."
+ (agent-shell-elicitation-tests--with-shell shell state
+ (let (sent)
+ (cl-letf (((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) sent))))
+ (with-current-buffer shell
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form-1"
+ :message "Use *literal* [site](https://example.test)"
+ :schema (agent-shell-elicitation-tests--boolean-schema))))
+ (with-current-buffer shell
+ (should
+ (string-match-p
+ (regexp-quote
+ "Use *literal* [site](https://example.test)")
+ (buffer-string)))
+ (goto-char (point-min))
+ (search-forward "https://example.test")
+ (should
+ (get-text-property
+ (1- (point)) 'agent-shell-literal-content))
+ (should-not (get-text-property (1- (point)) 'button))
+ (should
+ (string-match-p
+ (concat (regexp-quote "( ) Yes")
+ ".*"
+ (regexp-quote "(*) No"))
+ (buffer-string)))
+ ;; Generic expansion and deferred rendering revisit fragment
+ ;; bodies; literal form text must remain inert in those passes.
+ (let ((before (buffer-string)))
+ (save-restriction
+ (narrow-to-region
+ (previous-single-property-change
+ (point) 'agent-shell-literal-content nil (point-min))
+ (next-single-property-change
+ (point) 'agent-shell-literal-content nil (point-max)))
+ (agent-shell--render-markdown))
+ (should (equal before (buffer-string))))
+ (should
+ (agent-shell-elicitation--goto-control
+ :request-id "form-1"
+ :action 'set-option
+ :field 'authorize
+ :option t))
+ (agent-shell-elicitation-activate))
+ (let* ((entry
+ (agent-shell-elicitation--entry state "form-1"))
+ (field
+ (agent-shell-elicitation--field entry 'authorize)))
+ (should (map-elt field :value)))
+ (with-current-buffer shell
+ (should
+ (string-match-p
+ (concat (regexp-quote "(*) Yes")
+ ".*"
+ (regexp-quote "( ) No"))
+ (buffer-string)))
+ (goto-char (point-min))
+ (search-forward "( ) No")
+ (agent-shell-elicitation-activate))
+ (let* ((entry
+ (agent-shell-elicitation--entry state "form-1"))
+ (field
+ (agent-shell-elicitation--field entry 'authorize)))
+ (should-not (map-elt field :value)))
+ (with-current-buffer shell
+ (should
+ (string-match-p
+ (concat (regexp-quote "( ) Yes")
+ ".*"
+ (regexp-quote "(*) No"))
+ (buffer-string)))
+ (should
+ (agent-shell-elicitation--goto-control
+ :request-id "form-1"
+ :action 'set-option
+ :field 'authorize
+ :option t))
+ (agent-shell-elicitation-activate)
+ (should
+ (agent-shell-elicitation--goto-control
+ :request-id "form-1" :action 'submit))
+ (agent-shell-elicitation-activate))
+ (should-not (map-elt state :elicitations))
+ (should
+ (equal
+ (seq-first sent)
+ '((:request-id . "form-1")
+ (:result . ((action . "accept")
+ (content . ((authorize . t))))))))
+ (with-current-buffer shell
+ (should (string-match-p "Submitted" (buffer-string)))
+ (should
+ (string-match-p "Use saved connection: Yes" (buffer-string)))
+ (goto-char (point-min))
+ (should-not
+ (text-property-search-forward
+ 'agent-shell-elicitation-control t t)))))))
+
+(ert-deftest agent-shell-elicitation-cancellation-leaves-summary-test ()
+ "Replace an automatically cancelled form with its inert reason."
+ (agent-shell-elicitation-tests--with-shell shell state
+ (let (response)
+ (cl-letf (((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (setq response (plist-get args :response)))))
+ (with-current-buffer shell
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (agent-shell-elicitation--send-cancelled-error
+ :state state
+ :request-id "form"
+ :message "Owning tool call finished")))
+ (should
+ (equal -32800
+ (map-nested-elt response '(:error code))))
+ (should-not (map-elt state :elicitations))
+ (with-current-buffer shell
+ (should (string-match-p "Cancelled" (buffer-string)))
+ (should
+ (string-match-p "Owning tool call finished" (buffer-string)))
+ (goto-char (point-min))
+ (should-not
+ (text-property-search-forward
+ 'agent-shell-elicitation-control t t))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :message "Second request"
+ :schema (agent-shell-elicitation-tests--boolean-schema))))
+ (with-current-buffer shell
+ (should
+ (string-match-p "Owning tool call finished" (buffer-string)))
+ (should (string-match-p "Second request" (buffer-string)))))))
+
+(ert-deftest agent-shell-elicitation-stable-namespace-and-navigation-test ()
+ "Keep forms addressable across turns and expose each inline control."
+ (agent-shell-elicitation-tests--with-shell shell state
+ (cl-letf (((symbol-function 'acp-send-response) #'ignore))
+ (with-current-buffer shell
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id 1
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (map-put! state :request-count 99)
+ (agent-shell-elicitation--render
+ state (agent-shell-elicitation--entry state 1))
+ (goto-char (point-min))
+ (let ((first (agent-shell-next-elicitation-control)))
+ (should first)
+ (should (> (agent-shell-next-elicitation-control) first)))
+ (agent-shell-elicitation--send-user-response
+ :state state :request-id 1 :action "cancel")
+ (should-not
+ (text-property-search-forward
+ 'agent-shell-elicitation-request-id 1 t))))))
+
+(ert-deftest agent-shell-elicitation-focuses-form-above-live-draft-test ()
+ "Show a form above the prompt without changing its draft.
+
+The selected shell window must actually include the form control in its
+displayed screen-line range, not merely store that position as its
+possibly off-screen window point."
+ (agent-shell-elicitation-tests--with-shell shell state
+ (cl-letf (((symbol-function 'acp-send-response) #'ignore))
+ (save-window-excursion
+ (let ((window (selected-window)))
+ (with-current-buffer shell
+ (rename-buffer "elicitation-visible-shell" t))
+ (set-window-buffer window shell)
+ (select-window window)
+ (set-buffer shell)
+ (insert (make-string 100 ?\n))
+ (let ((prompt-start (copy-marker (point) nil)))
+ (insert
+ (propertize
+ "> "
+ 'font-lock-face
+ '(comint-highlight-prompt comint-highlight-prompt)))
+ (setq-local comint-last-prompt
+ (cons prompt-start (copy-marker (point) nil))))
+ (insert "draft text")
+ (setq-local agent-shell-chat-mode t
+ agent-shell-chat--labeled t)
+ (agent-shell-chat--relabel)
+ (goto-char (point-max))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (should
+ (get-text-property
+ (point) 'agent-shell-elicitation-control))
+ (should (eq (window-buffer window) shell))
+ (should (= (window-point window) (point)))
+ (should-not (get-char-property (point) 'invisible))
+ (should (<= (window-start window) (point)))
+ (should
+ (< (count-screen-lines
+ (window-start window) (point) nil window)
+ (window-body-height window)))
+ (should (string-suffix-p "> draft text" (buffer-string)))
+ (should
+ (equal "draft text"
+ (buffer-substring-no-properties
+ (marker-position (cdr comint-last-prompt))
+ (point-max)))))))))
+
+(ert-deftest agent-shell-permission-displays-shell-without-changing-viewport-test ()
+ "Reveal a permission in its shell without modifying a viewport draft."
+ (agent-shell-elicitation-tests--with-shell shell state
+ (let ((viewport (agent-shell-viewport--buffer :shell-buffer shell)))
+ (unwind-protect
+ (save-window-excursion
+ (with-current-buffer shell
+ (insert (make-string 100 ?\n)))
+ (with-current-buffer viewport
+ (insert "unfinished draft")
+ (goto-char 5))
+ (set-window-buffer (selected-window) viewport)
+ (with-current-buffer shell
+ (agent-shell--on-request
+ :state state
+ :acp-request
+ '((id . 7)
+ (method . "session/request_permission")
+ (params
+ (options
+ . [((optionId . "allow")
+ (name . "Allow")
+ (kind . "allow_once"))])
+ (toolCall
+ (toolCallId . "tool")
+ (title . "Run command")
+ (kind . "execute")
+ (status . "pending"))))))
+ (should (eq (window-buffer (selected-window)) shell))
+ (with-current-buffer shell
+ (should
+ (get-text-property
+ (point) 'agent-shell-permission-button))
+ (should-not (get-char-property (point) 'invisible))
+ (should
+ (<= (window-start (selected-window)) (point)))
+ (should
+ (< (count-screen-lines
+ (window-start (selected-window))
+ (point)
+ nil
+ (selected-window))
+ (window-body-height (selected-window)))))
+ (with-current-buffer viewport
+ (should
+ (derived-mode-p 'agent-shell-viewport-edit-mode))
+ (should (equal "unfinished draft" (buffer-string)))
+ (should (= 5 (point)))))
+ (when (buffer-live-p viewport)
+ (let ((agent-shell-viewport--clean-up nil))
+ (kill-buffer viewport)))))))
+
+(ert-deftest agent-shell-elicitation-session-load-focuses-shell-form-test ()
+ "Focus a request that arrives while an existing session is loading.
+
+This follows the non-viewport `session/list' then `session/load' path
+used when a user selects a saved session. The displayed chat shell must
+land on the form control while preserving type-ahead at its live prompt."
+ (let ((agent-shell-prefer-viewport-interaction nil)
+ (agent-shell-session-strategy 'prompt)
+ (agent-shell-session-restore-verbosity 'first-last)
+ (agent-shell-file-completion-enabled nil)
+ (agent-shell-show-busy-indicator nil)
+ (agent-shell-show-welcome-message t)
+ (agent-shell-chat-mode-enabled t)
+ (next-request-id 0)
+ shell
+ list-success
+ (client (acp-make-client :command "cat")))
+ (let ((config
+ (agent-shell-make-agent-config
+ :mode-line-name "Mock Agent"
+ :buffer-name "Mock Agent"
+ :shell-prompt "Mock> "
+ :shell-prompt-regexp "^Mock> "
+ :client-maker
+ (lambda (buffer)
+ (setq shell buffer)
+ (map-put! client :context-buffer buffer)
+ client))))
+ (unwind-protect
+ (cl-letf
+ (((symbol-function 'agent-shell--context)
+ (lambda (&rest _)
+ (concat (make-string 100 ?\n) "draft text")))
+ ((symbol-function 'acp-send-response) #'ignore)
+ ((symbol-function 'acp-send-request)
+ (lambda (&rest args)
+ (let* ((request (plist-get args :request))
+ (method (map-elt request :method))
+ (request-id
+ (setq next-request-id (1+ next-request-id))))
+ (when-let* ((on-sent (plist-get args :on-sent)))
+ (funcall on-sent
+ `((:request-id . ,request-id))))
+ (pcase method
+ ("initialize"
+ (funcall
+ (plist-get args :on-success)
+ '((agentCapabilities
+ (loadSession . t)
+ (sessionCapabilities (list))))))
+ ("session/list"
+ (setq list-success (plist-get args :on-success)))
+ ("session/load"
+ (should (eq (window-buffer (selected-window))
+ shell))
+ (with-current-buffer shell
+ (should (derived-mode-p 'agent-shell-mode))
+ (should agent-shell-chat-mode)
+ (seq-do
+ (lambda (handler)
+ (funcall
+ handler
+ (agent-shell-elicitation-tests--request
+ :id "authorization"
+ :message
+ "Authorize Loki to use this saved connection?
+Provider: \"OpenAI ChatGPT subscription [endpoint supplied by Loki]\"
+Model: \"gpt-5.6-sol\"
+Chat endpoint: \"https://chatgpt.com/backend-api/codex/responses\"
+Models endpoint: \"https://chatgpt.com/backend-api/codex/models?client_version=0.144.0\"
+Credential: \"openai-subscription:openai\"
+Streaming: \"yes\"
+
+Do not enter passwords, API keys, or other credentials in this form."
+ :request-id request-id
+ :schema
+ (agent-shell-elicitation-tests--boolean-schema))))
+ (map-elt client :request-handlers))
+ (should
+ (get-text-property
+ (point) 'agent-shell-elicitation-control))
+ (should
+ (= (window-point (selected-window)) (point)))
+ (should-not
+ (get-char-property (point) 'invisible))
+ (should
+ (<= (window-start (selected-window))
+ (point)))
+ (should
+ (< (count-screen-lines
+ (window-start (selected-window))
+ (point)
+ nil
+ (selected-window))
+ (window-body-height (selected-window))))
+ (should
+ (string-match-p
+ "Authorize Loki"
+ (buffer-string)))
+ (let ((visible
+ (agent-shell-chat--displayed-substring
+ (point-min) (point-max))))
+ (should
+ (string-match-p
+ "Input requested by Mock Agent"
+ visible))
+ (should
+ (string-match-p "Authorize Loki" visible))
+ (should
+ (< (string-match
+ "Input requested by Mock Agent"
+ visible)
+ (string-match "\n Me \n" visible))))
+ (should
+ (agent-shell-elicitation--goto-control
+ :request-id "authorization"
+ :action 'set-option
+ :field 'authorize
+ :option t))
+ (agent-shell-elicitation-activate)
+ (goto-char (point-min))
+ (search-forward "Authorize Loki")
+ (should-not
+ (equal
+ ""
+ (get-char-property
+ (match-beginning 0) 'display)))
+ (let ((visible
+ (agent-shell-chat--displayed-substring
+ (point-min) (point-max))))
+ (should
+ (string-match-p
+ "Input requested by Mock Agent"
+ visible))
+ (should
+ (string-match-p "Authorize Loki" visible))
+ (should
+ (< (string-match
+ "Input requested by Mock Agent"
+ visible)
+ (string-match "\n Me \n" visible))))
+ (should
+ (string-suffix-p
+ "draft text" (buffer-string))))
+ (funcall
+ (plist-get args :on-success)
+ '((modes
+ (currentModeId . "default")
+ (availableModes . []))
+ (models
+ (currentModelId . "model")
+ (availableModels . [])))))
+ (_
+ (ert-fail
+ (format "Unexpected ACP request: %s"
+ method))))))))
+ (agent-shell--dwim :config config :new-shell t)
+ (should (buffer-live-p shell))
+ (should list-success)
+ (with-current-buffer shell
+ (funcall
+ list-success
+ '((sessions
+ . [((sessionId . "saved-session")
+ (cwd . "/tmp")
+ (title . "Saved session"))])))))
+ (when (buffer-live-p shell)
+ (with-current-buffer shell
+ (setq-local kill-buffer-query-functions nil))
+ (kill-buffer shell))))))
+
+(ert-deftest agent-shell-elicitation-request-scope-follows-wire-request-test ()
+ "Bind a pre-session form to the actual outgoing JSON-RPC request id."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ sent)
+ (cl-letf (((symbol-function 'acp-send-request)
+ (lambda (&rest args)
+ (funcall (plist-get args :on-sent)
+ '((:request-id . 41)))
+ (should
+ (agent-shell-elicitation--active-request-p state 41))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "authorization"
+ :request-id 41
+ :schema
+ (agent-shell-elicitation-tests--boolean-schema)))
+ (funcall (plist-get args :on-success) '((ok . t)))))
+ ((symbol-function 'agent-shell-elicitation--render)
+ #'ignore)
+ ((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) sent))))
+ (agent-shell--send-request
+ :state state
+ :client 'client
+ :request '((:method . "session/load")))
+ (should-not (map-elt state :active-requests))
+ (should-not (map-elt state :elicitations))
+ (should
+ (equal -32800
+ (map-nested-elt
+ (seq-first sent) '(:error code))))))))
+
+(ert-deftest agent-shell-elicitation-request-send-failure-cleans-owner-test ()
+ "Remove request ownership when transmission fails after id assignment."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer))))
+ (cl-letf (((symbol-function 'acp-send-request)
+ (lambda (&rest args)
+ (funcall (plist-get args :on-sent)
+ '((:request-id . 42)))
+ (error "Write failed"))))
+ (should-error
+ (agent-shell--send-request
+ :state state
+ :client 'client
+ :request '((:method . "session/load")))))
+ (should-not (map-elt state :active-requests)))))
+
+(ert-deftest agent-shell-elicitation-scope-validation-test ()
+ "Reject nonexistent, conflicting, expired, and malformed owners."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ responses)
+ (agent-shell--save-tool-call
+ state "done" '((:status . "completed")))
+ (agent-shell--save-tool-call
+ state "cancelled" '((:status . "cancelled")))
+ (cl-letf (((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) responses))))
+ (seq-do
+ (lambda (request)
+ (agent-shell-elicitation--on-create-request
+ :state state :acp-request request))
+ (list
+ (agent-shell-elicitation-tests--request
+ :id 1 :request-id 404
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ (agent-shell-elicitation-tests--request
+ :id 2 :session-id "other"
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ (agent-shell-elicitation-tests--request
+ :id 3 :tool-call-id "missing"
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ (agent-shell-elicitation-tests--request
+ :id 4 :tool-call-id "done"
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ (agent-shell-elicitation-tests--request
+ :id 6 :tool-call-id "cancelled"
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ '((id . 5)
+ (method . "elicitation/create")
+ (params
+ (requestId . 1)
+ (sessionId . "session-1")
+ (mode . "form")
+ (message . "bad")
+ (requestedSchema
+ (type . "object")
+ (properties)))))))
+ (should (= (length responses) 6))
+ (seq-do
+ (lambda (response)
+ (should
+ (equal -32602
+ (map-nested-elt response '(:error code)))))
+ responses))))
+
+(ert-deftest agent-shell-elicitation-cancellation-is-exactly-once-test ()
+ "Settle an Agent-cancelled form once even if actions race."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ responses)
+ (cl-letf (((symbol-function 'agent-shell-elicitation--render)
+ #'ignore)
+ ((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) responses))))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (agent-shell-elicitation--on-cancel-request
+ :state state :request-id "form")
+ (agent-shell-elicitation--send-user-response
+ :state state :request-id "form" :action "cancel"))
+ (should (= (length responses) 1))
+ (should
+ (equal -32800
+ (map-nested-elt
+ (seq-first responses) '(:error code)))))))
+
+(ert-deftest agent-shell-elicitation-lifecycle-ownership-test ()
+ "Apply tool, session, shutdown, and connection lifetimes independently."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ responses)
+ (agent-shell--save-tool-call state "running" '((:status . "pending")))
+ (cl-letf (((symbol-function 'agent-shell-elicitation--render)
+ #'ignore)
+ ((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) responses))))
+ (seq-do
+ (lambda (request)
+ (agent-shell-elicitation--on-create-request
+ :state state :acp-request request))
+ (list
+ (agent-shell-elicitation-tests--request
+ :id "tool" :tool-call-id "running"
+ :schema (agent-shell-elicitation-tests--boolean-schema))
+ (agent-shell-elicitation-tests--request
+ :id "session"
+ :schema (agent-shell-elicitation-tests--boolean-schema))))
+ (agent-shell-elicitation--tool-finished
+ :state state :tool-call-id "running")
+ (should
+ (agent-shell-elicitation--entry state "session"))
+ ;; Finishing an unrelated Client-to-Agent request or prompt turn
+ ;; does not own a session-scoped form.
+ (agent-shell-elicitation--request-finished
+ :state state :request-id 41)
+ (should
+ (agent-shell-elicitation--entry state "session"))
+ (agent-shell-elicitation--session-finished
+ :state state :session-id "session-1")
+ (should-not (map-elt state :elicitations))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "shutdown"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (agent-shell-elicitation--dismiss-all :state state)
+ (should
+ (equal "cancel"
+ (map-nested-elt (seq-first responses)
+ '(:result action))))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "lost"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (let ((before (length responses)))
+ (agent-shell-elicitation--abandon-all :state state)
+ (should (= before (length responses)))))
+ (should-not (map-elt state :elicitations)))))
+
+(ert-deftest agent-shell-elicitation-tool-notification-ends-owner-test ()
+ "Settle a tool-scoped form when its tool reaches a terminal status."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ response)
+ (agent-shell--save-tool-call
+ state "tool" '((:status . "in_progress")))
+ (cl-letf (((symbol-function 'agent-shell-elicitation--render)
+ #'ignore)
+ ((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (setq response (plist-get args :response))))
+ ((symbol-function 'agent-shell--cancel-idle-timer)
+ #'ignore)
+ ((symbol-function 'agent-shell--emit-event)
+ #'ignore)
+ ((symbol-function 'agent-shell-make-tool-call-label)
+ (lambda (&rest _)
+ '((:status . "") (:title . ""))))
+ ((symbol-function 'agent-shell--activity-group-id)
+ #'ignore)
+ ((symbol-function 'agent-shell--update-fragment)
+ #'ignore)
+ ((symbol-function 'agent-shell--refresh-activity-group-header)
+ #'ignore)
+ ((symbol-function 'agent-shell--sync-activity-group-fold)
+ #'ignore))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :tool-call-id "tool"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (agent-shell--on-notification
+ :state state
+ :acp-notification
+ '((method . "session/update")
+ (params
+ (update
+ (sessionUpdate . "tool_call")
+ (toolCallId . "tool")
+ (status . "cancelled"))))))
+ (should-not (map-elt state :elicitations))
+ (should
+ (equal -32800
+ (map-nested-elt response '(:error code)))))))
+
+(ert-deftest agent-shell-elicitation-session-change-ends-owner-test ()
+ "Settle session-scoped forms before replacing the active session."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ response)
+ (setq-local agent-shell--state state)
+ (cl-letf (((symbol-function 'agent-shell-elicitation--render)
+ #'ignore)
+ ((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (setq response (plist-get args :response))))
+ ((symbol-function 'agent-shell--save-config-options)
+ #'ignore))
+ (agent-shell-elicitation--on-create-request
+ :state state
+ :acp-request
+ (agent-shell-elicitation-tests--request
+ :id "form"
+ :schema (agent-shell-elicitation-tests--boolean-schema)))
+ (agent-shell--set-session-from-response
+ :acp-response nil
+ :acp-session-id "session-2"))
+ (should-not (map-elt state :elicitations))
+ (should
+ (equal -32800
+ (map-nested-elt response '(:error code))))
+ (should
+ (equal "session-2"
+ (map-nested-elt state '(:session :id)))))))
+
+(ert-deftest agent-shell-elicitation-connection-subscription-cleans-ui-test ()
+ "Abandon connection-owned forms when the ACP transport disappears."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ (client (acp-make-client :command "cat"))
+ responses)
+ (map-put! state :client client)
+ (map-put! state :elicitations
+ '(("form" . ((:request-id . "form")
+ (:message . "Question")
+ (:block-id . "request-form")))))
+ (cl-letf (((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) responses))))
+ (agent-shell--subscribe-to-client-events :state state)
+ (acp--notify-process-exit :client client :event "exited"))
+ (should-not (map-elt state :elicitations))
+ (should-not responses))))
+
+(ert-deftest agent-shell-elicitation-shutdown-answers-before-close-test ()
+ "Dismiss reverse requests before deliberate ACP shutdown closes transport."
+ (with-temp-buffer
+ (setq major-mode 'agent-shell-mode)
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ events)
+ (setq-local agent-shell--state state)
+ (map-put! state :elicitations
+ '(("form" . ((:request-id . "form")
+ (:message . "Question")
+ (:block-id . "request-form")))))
+ (cl-letf (((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function
+ 'agent-shell-elicitation--render-settled)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push
+ (list 'response (plist-get args :response))
+ events)))
+ ((symbol-function 'acp-shutdown)
+ (lambda (&rest _)
+ (push '(shutdown) events)))
+ ((symbol-function 'agent-shell-heartbeat-stop)
+ #'ignore))
+ (agent-shell--shutdown))
+ (should
+ (equal
+ (seq-reverse events)
+ '((response
+ ((:request-id . "form")
+ (:result . ((action . "cancel")))))
+ (shutdown)))))))
+
+(ert-deftest agent-shell-elicitation-turn-cancel-does-not-own-form-test ()
+ "Do not infer that session/cancel cancels an independent elicitation."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ notifications
+ responses)
+ (map-put! state :elicitations
+ '(("form" . ((:request-id . "form")
+ (:message . "Question")
+ (:scope . session)
+ (:scope-id . "session-1")))))
+ (cl-letf (((symbol-function 'derived-mode-p)
+ (lambda (&rest _) t))
+ ((symbol-function 'agent-shell--state)
+ (lambda () state))
+ ((symbol-function 'acp-send-notification)
+ (lambda (&rest args)
+ (push (plist-get args :notification)
+ notifications)))
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (push (plist-get args :response) responses))))
+ (agent-shell-interrupt t))
+ (should (= (length notifications) 1))
+ (should-not responses)
+ (should (map-elt state :elicitations)))))
+
+(ert-deftest agent-shell-elicitation-status-is-not-inferred-test ()
+ "A pending form alone does not establish that the Agent is blocked."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer))))
+ (map-put! state :elicitations '(("form" . t)))
+ (cl-letf (((symbol-function 'agent-shell--state)
+ (lambda () state))
+ ((symbol-function 'shell-maker-busy)
+ (lambda () nil)))
+ (should (eq (agent-shell-status) 'ready))))))
+
+(ert-deftest agent-shell-elicitation-agent-cancel-notification-test ()
+ "Route generic JSON-RPC cancellation to the reverse request."
+ (with-temp-buffer
+ (let ((state (agent-shell-elicitation-tests--state (current-buffer)))
+ response)
+ (map-put! state :elicitations
+ '(("form" . ((:request-id . "form")
+ (:message . "Question")
+ (:block-id . "request-form")))))
+ (cl-letf (((symbol-function 'agent-shell--delete-fragment)
+ #'ignore)
+ ((symbol-function 'acp-send-response)
+ (lambda (&rest args)
+ (setq response (plist-get args :response)))))
+ (agent-shell--on-notification
+ :state state
+ :acp-notification
+ '((method . "$/cancel_request")
+ (params (requestId . "form")))))
+ (should
+ (equal -32800
+ (map-nested-elt response '(:error code)))))))
+
+(ert-deftest agent-shell-elicitation-handshake-advertises-form-test ()
+ "Promise form handling in the initialize request."
+ (with-temp-buffer
+ (let ((agent-shell--state
+ (agent-shell-elicitation-tests--state (current-buffer)))
+ request)
+ (cl-letf (((symbol-function
+ 'agent-shell--update-bootstrapping-fragment)
+ #'ignore)
+ ((symbol-function 'agent-shell--send-request)
+ (lambda (&rest args)
+ (setq request (plist-get args :request)))))
+ (agent-shell--initiate-handshake
+ :shell-buffer (current-buffer)
+ :on-initiated #'ignore)
+ (let ((form
+ (map-nested-elt
+ request
+ '(:params clientCapabilities elicitation form))))
+ (should (hash-table-p form))
+ (should (equal 0 (hash-table-count form))))))))
+
+(provide 'agent-shell-elicitation-tests)
+
+;;; agent-shell-elicitation-tests.el ends here