(require 'cl-lib)
(require 'org)
(require 'pp)
(require 'subr-x)
(require 'llm)
(require 'crdt)
(declare-function crdt--share-buffer "crdt" (buffer &optional session network-name))
(declare-function crdt--with-buffer-name-pull "crdt" (spec &rest body))
(declare-function crdt-stop-session "crdt" (&optional session))
(declare-function crdt--stop-session "crdt" (session))
(defgroup madrigal nil
"LLM-driven CRDT editing."
:group 'tools
:prefix "madrigal-")
(defcustom madrigal-llm-provider-code nil
"LLM provider object for code-editing requests."
:type 'sexp)
(defcustom madrigal-llm-provider-reason nil
"LLM provider object for deeper reasoning requests."
:type 'sexp)
(defcustom madrigal-llm-provider-quick nil
"LLM provider object for quick/lightweight requests."
:type 'sexp)
(defcustom madrigal-default-provider 'code
"Default provider slot used by `madrigal-edit'."
:type '(choice (const :tag "Code" code)
(const :tag "Reason" reason)
(const :tag "Quick" quick)))
(define-obsolete-variable-alias 'madrigal-llm-provider
'madrigal-llm-provider-code
"0.2.0")
(defcustom madrigal-context-lines 80
"Number of lines around point to include in context."
:type 'integer)
(defcustom madrigal-default-agent "default"
"Default logical agent ID used by `madrigal-edit'."
:type 'string)
(defcustom madrigal-max-tool-rounds 512
"Maximum model/tool continuation rounds per request."
:type 'integer)
(when (and (boundp 'madrigal-max-tool-rounds)
(<= madrigal-max-tool-rounds 64)
(null (get 'madrigal-max-tool-rounds 'saved-value))
(null (get 'madrigal-max-tool-rounds 'customized-value)))
(setq-default madrigal-max-tool-rounds 512)
(setq madrigal-max-tool-rounds 512))
(defcustom madrigal-log-buffer-name "*madrigal-log*"
"Name of the org buffer used for madrigal request logs."
:type 'string)
(defcustom madrigal-open-log-buffer t
"When non-nil, open the madrigal log buffer when a request starts."
:type 'boolean)
(defcustom madrigal-log-include-reasoning t
"When non-nil, include model reasoning in the madrigal org log."
:type 'boolean)
(defcustom madrigal-reasoning-level 'medium
"Reasoning effort requested from providers that support it.
Set to nil to avoid sending any explicit reasoning effort hint."
:type '(choice (const :tag "Provider default" nil)
(const :tag "None" none)
(const :tag "Light" light)
(const :tag "Medium" medium)
(const :tag "Maximum" maximum)))
(defcustom madrigal-openai-responses-reasoning-summary "auto"
"Reasoning summary mode for `llm-openai-responses' providers.
When non-nil, madrigal configures the provider to request reasoning
summaries (for example \"auto\")."
:type '(choice (const :tag "Disabled" nil)
string))
(defcustom madrigal-log-include-context t
"When non-nil, include the full context window sent to the model in logs."
:type 'boolean)
(defcustom madrigal-log-start-collapsed t
"Deprecated log folding toggle.
The madrigal log now keeps the latest request expanded as entries are
written. This option is retained for backward compatibility."
:type 'boolean)
(defcustom madrigal-session-port-base 6530
"Initial port used when creating the madrigal CRDT session."
:type 'integer)
(defcustom madrigal-session-port-span 64
"Number of ports to try when creating the madrigal CRDT session."
:type 'integer)
(defcustom madrigal-save-sync-timeout 1.0
"Seconds to wait for replica edits to reach the server before save."
:type 'number)
(defcustom madrigal-allow-save-buffer-op nil
"When non-nil, allow tool op `save_buffer` to write files.
Default is nil so saving remains the user's explicit choice."
:type 'boolean)
(defvar madrigal--server-session nil)
(defvar madrigal--session-port nil)
(defvar madrigal--agents (make-hash-table :test #'equal))
(defvar madrigal--log-request-seq 0)
(defvar madrigal--log-request-markers (make-hash-table :test #'equal))
(cl-defstruct madrigal--agent
id
display-name
session)
(defun madrigal--ensure-log-buffer ()
(let ((buf (get-buffer-create madrigal-log-buffer-name)))
(with-current-buffer buf
(unless (derived-mode-p 'org-mode)
(org-mode)))
buf))
(defun madrigal--log-refresh-visibility (buffer)
(with-current-buffer buffer
(when (derived-mode-p 'org-mode)
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^\\*+ " nil t)
(org-show-entry)
(org-show-subtree))
(goto-char (point-max))
(when (re-search-backward "^\\* Request " nil t)
(org-show-entry)
(org-show-subtree))))))
(defun madrigal--pp-string (obj)
(with-temp-buffer
(let ((print-length nil)
(print-level nil))
(pp obj (current-buffer))
(buffer-string))))
(defun madrigal--log-insert-example-block (text)
(insert "#+begin_example\n")
(let ((body (replace-regexp-in-string
"^#\\+end_example\\b"
",#+end_example"
(or text "")
nil
nil
0)))
(insert body))
(unless (or (string-empty-p (or text ""))
(string-suffix-p "\n" text))
(insert "\n"))
(insert "#+end_example\n\n"))
(defun madrigal--log-insert-src-block (obj)
(let ((text (madrigal--pp-string obj)))
(insert "#+begin_src emacs-lisp\n")
(insert text)
(unless (string-suffix-p "\n" text)
(insert "\n"))
(insert "#+end_src\n\n")))
(defun madrigal--log-append-src (request-id obj &optional tag)
(let* ((buf (madrigal--ensure-log-buffer))
(marker (gethash request-id madrigal--log-request-markers)))
(with-current-buffer buf
(save-excursion
(goto-char (if (and marker (marker-buffer marker)) marker (point-max)))
(when tag
(insert (format "#+name: %s\n" tag)))
(madrigal--log-insert-src-block obj)
(puthash request-id (copy-marker (point) t) madrigal--log-request-markers)))
(madrigal--log-refresh-visibility buf)))
(defun madrigal--as-list-safe (v)
(cond
((vectorp v) (append v nil))
((listp v) v)
(t nil)))
(defun madrigal--log-new-request (agent-id source-buffer prompt-text context-text)
(let* ((buf (madrigal--ensure-log-buffer))
(stamp (format-time-string "%Y-%m-%d %H:%M:%S"))
(path (with-current-buffer source-buffer
(or buffer-file-name "(no file)")))
(request-id (format "%s-%04d"
(format-time-string "%Y%m%dT%H%M%S")
(cl-incf madrigal--log-request-seq)))
marker)
(with-current-buffer buf
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(insert (format "* Request %s\n" stamp))
(insert ":PROPERTIES:\n")
(insert (format ":agent: %s\n" agent-id))
(insert (format ":buffer: %s\n" (buffer-name source-buffer)))
(insert (format ":path: %s\n" path))
(insert (format ":request-id: %s\n" request-id))
(insert ":END:\n\n")
(insert "** User Prompt\n")
(madrigal--log-insert-example-block prompt-text)
(when (and madrigal-log-include-context context-text)
(insert "** Context Window\n")
(madrigal--log-insert-example-block context-text))
(setq marker (copy-marker (point) t)))
(puthash request-id marker madrigal--log-request-markers)
(when madrigal-open-log-buffer
(display-buffer buf))
(madrigal--log-refresh-visibility buf)
request-id))
(defun madrigal--log-append-heading (request-id level heading)
(let* ((buf (madrigal--ensure-log-buffer))
(marker (gethash request-id madrigal--log-request-markers)))
(with-current-buffer buf
(save-excursion
(goto-char (if (and marker (marker-buffer marker)) marker (point-max)))
(insert (make-string level ?*) " " heading "\n")
(setf marker (copy-marker (point) t))
(puthash request-id marker madrigal--log-request-markers)))
(madrigal--log-refresh-visibility buf)
buf))
(defun madrigal--log-append-example (request-id level heading text)
(let ((buf (madrigal--log-append-heading request-id level heading)))
(with-current-buffer buf
(save-excursion
(goto-char (gethash request-id madrigal--log-request-markers))
(madrigal--log-insert-example-block text)
(puthash request-id (copy-marker (point) t) madrigal--log-request-markers)))
(madrigal--log-refresh-visibility buf)))
(defun madrigal--log-append-obj (request-id level heading obj)
(let ((buf (madrigal--log-append-heading request-id level heading)))
(with-current-buffer buf
(save-excursion
(goto-char (gethash request-id madrigal--log-request-markers))
(madrigal--log-insert-src-block obj)
(puthash request-id (copy-marker (point) t) madrigal--log-request-markers)))
(madrigal--log-refresh-visibility buf)))
(defun madrigal--log-round (request-id round final)
(when request-id
(madrigal--log-append-heading request-id 2 (format "Round %d" round))
(let ((reasoning (plist-get final :reasoning))
(text (plist-get final :text))
(tool-uses (plist-get final :tool-uses))
(tool-results (plist-get final :tool-results)))
(when (and madrigal-log-include-reasoning reasoning)
(madrigal--log-append-example request-id 3 "Reasoning" (format "%s" reasoning)))
(when (and text (> (length text) 0))
(madrigal--log-append-example request-id 3 "Response" text))
(when (or tool-uses tool-results)
(let* ((uses (madrigal--as-list-safe tool-uses))
(results (madrigal--as-list-safe tool-results))
(count (max (length uses) (length results))))
(dotimes (idx count)
(let ((n (1+ idx))
(use (nth idx uses))
(result (nth idx results)))
(when use
(madrigal--log-append-src
request-id
use
(format "round-%d-tool-use-%d" round n)))
(when result
(madrigal--log-append-src
request-id
result
(format "round-%d-tool-result-%d" round n))))))))))
(defun madrigal--log-error (request-id heading etype message)
(when request-id
(madrigal--log-append-heading request-id 2 heading)
(madrigal--log-append-obj request-id 3 "Error"
`((type . ,etype)
(message . ,message)))))
(defun madrigal--log-tool-op (request-id heading payload)
(when request-id
(let ((buf (madrigal--ensure-log-buffer))
(marker (gethash request-id madrigal--log-request-markers)))
(with-current-buffer buf
(save-excursion
(goto-char (if (and marker (marker-buffer marker)) marker (point-max)))
(madrigal--log-insert-src-block `((event . ,heading)
(payload . ,payload)))
(puthash request-id (copy-marker (point) t) madrigal--log-request-markers)))
(madrigal--log-refresh-visibility buf))))
(defun madrigal--live-session-p (session)
(and session
(memq session crdt--session-list)
(let ((proc (crdt--session-network-process session)))
(and proc (process-live-p proc)))))
(defun madrigal--ensure-server-session ()
(if (madrigal--live-session-p madrigal--server-session)
madrigal--server-session
(let ((created nil))
(cl-loop for port from madrigal-session-port-base
below (+ madrigal-session-port-base madrigal-session-port-span)
until created
do (condition-case nil
(let ((crdt-use-tuntox nil)
(crdt-use-stunnel nil))
(setq created
(crdt-new-session
port
nil
nil
"madrigal-server"
crdt-default-session-permissions))
(setq madrigal--session-port port))
(error nil)))
(unless created
(error "madrigal: failed to create CRDT session; checked ports %d-%d"
madrigal-session-port-base
(+ madrigal-session-port-base madrigal-session-port-span -1)))
(setq madrigal--server-session created)
created)))
(defun madrigal--agent-url ()
(format "ein://127.0.0.1:%d" madrigal--session-port))
(defun madrigal--ensure-agent (agent-id)
(let ((agent (gethash agent-id madrigal--agents)))
(if (and agent (madrigal--live-session-p (madrigal--agent-session agent)))
agent
(let* ((server (madrigal--ensure-server-session))
(_ server)
(display-name (format "madrigal-%s" agent-id))
(session (cl-letf (((symbol-function #'crdt-list-buffers)
(lambda (&optional _session) nil)))
(crdt-connect (madrigal--agent-url) display-name)))
(new-agent (make-madrigal--agent
:id agent-id
:display-name display-name
:session session)))
(puthash agent-id new-agent madrigal--agents)
new-agent))))
(defun madrigal--drop-agent (agent-id)
(let ((agent (gethash agent-id madrigal--agents)))
(when agent
(let ((session (madrigal--agent-session agent)))
(when (madrigal--live-session-p session)
(condition-case nil
(crdt--stop-session session)
(error
(condition-case nil
(crdt-stop-session session)
(error nil))))))
(remhash agent-id madrigal--agents))))
(defun madrigal--buffer-network-name (buffer)
(with-current-buffer buffer
crdt--buffer-network-name))
(defun madrigal--ensure-shared-in-server (buffer)
(let ((server (madrigal--ensure-server-session)))
(with-current-buffer buffer
(cond
((and crdt-mode (eq crdt--session server))
buffer)
(crdt-mode
(error "madrigal: buffer already belongs to a different CRDT session"))
(t
(crdt--share-buffer
buffer
server
(or (and buffer-file-name
(file-relative-name buffer-file-name default-directory))
(buffer-name buffer))))))))
(defun madrigal--server-buffer-from-network-name (network-name)
(gethash network-name (crdt--session-buffer-table madrigal--server-session)))
(defun madrigal--ensure-agent-replica (agent network-name)
(let* ((session (madrigal--agent-session agent))
(existing (gethash network-name (crdt--session-buffer-table session))))
(if (buffer-live-p existing)
existing
(let ((crdt--session session)
(replica nil))
(crdt--with-buffer-name-pull (network-name :sync t)
(setq replica (current-buffer)))
(unless (buffer-live-p replica)
(error "madrigal: failed to open agent replica for %s" network-name))
replica))))
(defun madrigal--context-window ()
(save-excursion
(let ((line (line-number-at-pos))
(orig-point (point))
(start nil)
(end nil))
(forward-line (- madrigal-context-lines))
(setq start (line-beginning-position))
(goto-char orig-point)
(forward-line (* 2 madrigal-context-lines))
(setq end (line-end-position))
(list :line line
:point orig-point
:start start
:end end
:text (buffer-substring-no-properties start end)))))
(defun madrigal--system-prompt ()
(string-join
(list
"You are an autonomous Emacs editing agent."
"When you need to edit files or buffers, call the tool exec_ops."
"You may chain many operations in one call."
"Prefer one exec_ops call containing a full sequence over multiple calls."
"Always read relevant text first before editing."
"open_file and switch_buffer place point at the beginning of the buffer."
"Use move and search for navigation; both use a direction parameter."
"For search ops, use needle (text/query aliases are accepted)."
"move returns moved_chars; search returns match_length (0 when not found)."
"Use set_mark and clear_region to control selections."
"Edit only via insert_text, delete_selection, and replace_selection."
"Do not save files; saving is always the user's explicit choice."
"All edits happen in CRDT-managed replicas; avoid speculative rewrites."
"Return concise text once edits are done.")
"\n"))
(defun madrigal--build-user-prompt (user-text)
(let* ((mode (symbol-name major-mode))
(path (or buffer-file-name "(no file)"))
(bname (buffer-name)))
(format
"%s\n\nBuffer: %s\nPath: %s\nMode: %s"
user-text
bname
path
mode)))
(defun madrigal--configure-provider-reasoning (provider)
(when (and madrigal-log-include-reasoning
madrigal-openai-responses-reasoning-summary
(fboundp 'llm-openai-responses-p)
(ignore-errors (llm-openai-responses-p provider)))
(condition-case nil
(setf (llm-openai-responses-reasoning-summary provider)
madrigal-openai-responses-reasoning-summary)
(error nil))))
(defun madrigal--provider-for-slot (slot)
(pcase slot
('code madrigal-llm-provider-code)
('reason madrigal-llm-provider-reason)
('quick madrigal-llm-provider-quick)
(_ nil)))
(defun madrigal--current-provider ()
(let ((provider (madrigal--provider-for-slot madrigal-default-provider)))
(unless provider
(user-error "madrigal: set provider `%s' first" madrigal-default-provider))
provider))
(defun madrigal--alist-get* (key obj)
(cond
((and (listp obj) (keywordp key))
(or (alist-get (intern (substring (symbol-name key) 1)) obj)
(alist-get (substring (symbol-name key) 1) obj)
(plist-get obj key)))
((listp obj)
(or (alist-get key obj)
(alist-get (if (symbolp key) (symbol-name key) key) obj)
(and (keywordp key) (plist-get obj key))))
(t nil)))
(defun madrigal--as-list (v)
(cond
((vectorp v) (append v nil))
((listp v) v)
(t nil)))
(defun madrigal--obj-has-key-p (obj key)
(and (listp obj)
(let* ((base (if (keywordp key)
(substring (symbol-name key) 1)
(and (symbolp key) (symbol-name key))))
(plain (and base (intern base)))
(kword (and base (intern (format ":%s" base)))))
(or (and (symbolp key) (assq key obj))
(and plain (assq plain obj))
(and kword (assq kword obj))
(and base (assoc base obj))
(and (keywordp key) (plist-member obj key))))))
(defun madrigal--resolve-ref (value results)
(if (and (stringp value)
(string-match "^\\$\\([0-9]+\\)\\.\\([A-Za-z0-9_-]+\\)$" value))
(let* ((idx (1- (string-to-number (match-string 1 value))))
(field (intern (match-string 2 value)))
(step-count (length results)))
(unless (and (>= idx 0) (< idx step-count))
(error "madrigal: invalid reference %s (step out of range)" value))
(let* ((step (nth idx results))
(resolved (or (madrigal--alist-get* field step)
(madrigal--alist-get* (intern (format ":%s" field)) step))))
(if resolved
resolved
(error "madrigal: invalid reference %s (field missing)" value))))
value))
(defun madrigal--require-integer (value field)
(let ((parsed
(cond
((integerp value) value)
((and (floatp value)
(= value (truncate value)))
(truncate value))
((and (stringp value)
(string-match-p "^-?[0-9]+$" value))
(string-to-number value))
(t nil))))
(unless (integerp parsed)
(error "madrigal: %s must be integer" field))
parsed))
(defun madrigal--require-pos-in-buffer (buffer pos field)
(with-current-buffer buffer
(unless (and (integerp pos)
(<= (point-min) pos)
(<= pos (point-max)))
(error "madrigal: %s out of bounds (%s not in [%s,%s])"
field pos (point-min) (point-max))))
pos)
(defun madrigal--move-clamped (forward-p unit count)
"Move point by UNIT COUNT steps, clamping at buffer bounds.
Returns number of characters moved."
(let ((before (point)))
(pcase unit
("char"
(let ((target (+ before (if forward-p count (- count)))))
(goto-char (min (point-max) (max (point-min) target)))))
("line"
(forward-line (if forward-p count (- count))))
("word"
(condition-case err
(funcall (if forward-p #'forward-word #'backward-word) count)
((beginning-of-buffer end-of-buffer)
(goto-char (if forward-p (point-max) (point-min))))
(error
(signal (car err) (cdr err)))))
("symbol"
(condition-case err
(forward-symbol (if forward-p count (- count)))
((beginning-of-buffer end-of-buffer)
(goto-char (if forward-p (point-max) (point-min))))
(error
(signal (car err) (cdr err)))))
("sexp"
(condition-case err
(funcall (if forward-p #'forward-sexp #'backward-sexp) count)
((beginning-of-buffer end-of-buffer)
(goto-char (if forward-p (point-max) (point-min))))
(error
(signal (car err) (cdr err)))))
("buffer"
(goto-char (if forward-p (point-max) (point-min)))))
(abs (- (point) before))))
(defun madrigal--sync-replica-point-from-buffer (source-buffer replica-buffer)
(let ((source-point (with-current-buffer source-buffer (point))))
(with-current-buffer replica-buffer
(goto-char (min (max (point-min) source-point) (point-max))))))
(defun madrigal--flush-replica-to-server (replica-buffer agent-session server-buffer timeout)
(let* ((deadline (+ (float-time) (max 0.0 timeout)))
(synced nil))
(while (and (not synced)
(< (float-time) deadline))
(setq synced
(with-current-buffer replica-buffer
(let ((replica-text (buffer-substring-no-properties (point-min) (point-max))))
(with-current-buffer server-buffer
(string= replica-text
(buffer-substring-no-properties (point-min) (point-max)))))))
(unless synced
(let ((agent-proc (crdt--session-network-process agent-session))
(server-proc (crdt--session-network-process madrigal--server-session)))
(when (process-live-p agent-proc)
(accept-process-output agent-proc 0.02))
(when (process-live-p server-proc)
(accept-process-output server-proc 0.02)))))
synced))
(defun madrigal--set-region (buffer start end)
(with-current-buffer buffer
(madrigal--require-pos-in-buffer buffer start "start")
(madrigal--require-pos-in-buffer buffer end "end")
(goto-char end)
(set-mark start)
(setq mark-active t
deactivate-mark nil)
(cons (region-beginning) (region-end))))
(defun madrigal--clear-region (buffer)
(with-current-buffer buffer
(setq mark-active nil
deactivate-mark t)
(set-marker (mark-marker) nil)
nil))
(defun madrigal--region-bounds-required (buffer)
(with-current-buffer buffer
(unless (use-region-p)
(error "madrigal: active region required"))
(cons (region-beginning) (region-end))))
(defun madrigal--tool-exec-ops (agent-id ops &optional request-id)
(let* ((agent (madrigal--ensure-agent agent-id))
(agent-session (madrigal--agent-session agent))
(target (madrigal--ensure-shared-in-server (current-buffer)))
(network-name (madrigal--buffer-network-name target))
(replica (madrigal--ensure-agent-replica agent network-name))
(results nil)
(state `((agent . ,agent-id)
(network_name . ,network-name)
(buffer . ,(buffer-name replica)))))
(madrigal--sync-replica-point-from-buffer target replica)
(dolist (raw-op (madrigal--as-list ops))
(let* ((op (or (madrigal--alist-get* 'op raw-op)
(madrigal--alist-get* :op raw-op)))
(op-name (if (symbolp op) (symbol-name op) op))
(row nil))
(unless (stringp op-name)
(error "madrigal: each op needs string field 'op'"))
(madrigal--log-tool-op request-id
(format "exec_ops input: %s" op-name)
raw-op)
(setq row (list (cons 'op op-name)))
(pcase op-name
("open_file"
(let* ((path0 (or (madrigal--alist-get* 'path raw-op)
(madrigal--alist-get* :path raw-op)))
(create0 (or (madrigal--alist-get* 'create raw-op)
(madrigal--alist-get* :create raw-op)))
(path (expand-file-name (madrigal--resolve-ref path0 results)))
(createp (and create0 (not (eq create0 :false)))))
(unless (or (file-exists-p path) createp)
(error "madrigal: file does not exist: %s" path))
(unless (file-exists-p path)
(with-temp-buffer (write-region "" nil path nil 0)))
(let ((buf (find-file-noselect path)))
(madrigal--ensure-shared-in-server buf)
(setq network-name (madrigal--buffer-network-name buf))
(setq replica (madrigal--ensure-agent-replica agent network-name))
(with-current-buffer replica
(goto-char (point-min)))
(setq row (append row
(list (cons 'path path)
(cons 'network_name network-name)
(cons 'buffer (buffer-name replica))))))))
("list_buffers"
(let (names)
(maphash (lambda (k _v) (push k names))
(crdt--session-buffer-table madrigal--server-session))
(setq row (append row (list (cons 'buffers (nreverse names)))))))
("switch_buffer"
(let* ((name0 (or (madrigal--alist-get* 'network_name raw-op)
(madrigal--alist-get* :network_name raw-op)
(madrigal--alist-get* 'buffer raw-op)
(madrigal--alist-get* :buffer raw-op)))
(name (madrigal--resolve-ref name0 results)))
(setq replica (madrigal--ensure-agent-replica agent name))
(with-current-buffer replica
(goto-char (point-min)))
(setq network-name name)
(setq row (append row
(list (cons 'network_name network-name)
(cons 'buffer (buffer-name replica)))))))
("move"
(let* ((direction0 (or (madrigal--alist-get* 'direction raw-op)
(madrigal--alist-get* :direction raw-op)
'forward))
(unit0 (or (madrigal--alist-get* 'unit raw-op)
(madrigal--alist-get* :unit raw-op)
(madrigal--alist-get* 'by raw-op)
(madrigal--alist-get* :by raw-op)
'char))
(count0 (or (madrigal--alist-get* 'count raw-op)
(madrigal--alist-get* :count raw-op)
1))
(direction (downcase (format "%s" (madrigal--resolve-ref direction0 results))))
(unit (downcase (format "%s" (madrigal--resolve-ref unit0 results))))
(count (madrigal--require-integer
(madrigal--resolve-ref count0 results) "count"))
(forward-p (string= direction "forward")))
(unless (member direction '("forward" "backward"))
(error "madrigal: move direction must be forward/backward"))
(unless (member unit '("char" "line" "word" "symbol" "sexp" "buffer"))
(error "madrigal: move unit must be char/line/word/symbol/sexp/buffer"))
(when (< count 0)
(error "madrigal: count must be >= 0"))
(with-current-buffer replica
(setq row (append row
(list (cons 'moved_chars
(madrigal--move-clamped forward-p unit count))))))))
("search"
(let* ((direction0 (or (madrigal--alist-get* 'direction raw-op)
(madrigal--alist-get* :direction raw-op)
'forward))
(needle0 (or (madrigal--alist-get* 'needle raw-op)
(madrigal--alist-get* :needle raw-op)
(madrigal--alist-get* 'text raw-op)
(madrigal--alist-get* :text raw-op)
(madrigal--alist-get* 'query raw-op)
(madrigal--alist-get* :query raw-op)))
(direction (downcase (format "%s" (madrigal--resolve-ref direction0 results))))
(needle (format "%s" (madrigal--resolve-ref needle0 results)))
(forward-p (string= direction "forward"))
(backward-p (string= direction "backward")))
(unless (or forward-p backward-p)
(error "madrigal: search direction must be forward/backward"))
(when (string-empty-p needle)
(error "madrigal: needle must be non-empty"))
(with-current-buffer replica
(let ((found nil)
(match-len (length needle)))
(setq found (if forward-p
(search-forward needle nil t)
(search-backward needle nil t)))
(setq row (append row
(list (cons 'match_length (if found match-len 0)))))))))
("set_mark"
(with-current-buffer replica
(push-mark (point) t t)
(setq mark-active t
deactivate-mark nil)
(setq row (append row
(list (cons 'mark_set t)
(cons 'region_active (and (use-region-p) t)))))))
("clear_region"
(madrigal--clear-region replica)
(setq row (append row (list (cons 'region_active nil)))))
("read_selection"
(with-current-buffer replica
(if (use-region-p)
(let* ((s (region-beginning))
(e (region-end))
(text (buffer-substring-no-properties s e)))
(setq row (append row
(list (cons 'text text)
(cons 'length (length text))))))
(setq row (append row
(list (cons 'text "")
(cons 'length 0)))))))
("insert_text"
(let* ((text0 (or (madrigal--alist-get* 'text raw-op)
(madrigal--alist-get* :text raw-op)))
(text (format "%s" (madrigal--resolve-ref text0 results))))
(with-current-buffer replica
(insert text)
(setq row (append row
(list (cons 'success t)))))))
("delete_selection"
(with-current-buffer replica
(pcase-let ((`(,s . ,e) (madrigal--region-bounds-required replica)))
(delete-region s e)
(madrigal--clear-region replica)
(setq row (append row
(list (cons 'success t)))))))
("replace_selection"
(let* ((text0 (or (madrigal--alist-get* 'text raw-op)
(madrigal--alist-get* :text raw-op)))
(text (format "%s" (madrigal--resolve-ref text0 results))))
(with-current-buffer replica
(pcase-let ((`(,s . ,e) (madrigal--region-bounds-required replica)))
(delete-region s e)
(goto-char s)
(insert text)
(madrigal--clear-region replica)
(setq row (append row
(list (cons 'success t))))))))
("save_buffer"
(if (not madrigal-allow-save-buffer-op)
(setq row (append row
(list (cons 'saved nil)
(cons 'skipped t)
(cons 'reason "user-save-required"))))
(let ((server-buffer (madrigal--server-buffer-from-network-name network-name)))
(unless (buffer-live-p server-buffer)
(error "madrigal: no server buffer for %s" network-name))
(unless (madrigal--flush-replica-to-server
replica agent-session server-buffer madrigal-save-sync-timeout)
(error "madrigal: timed out waiting for CRDT sync before save"))
(with-current-buffer server-buffer
(when (and buffer-file-name (buffer-modified-p))
(save-buffer))
(setq row (append row
(list (cons 'saved (and buffer-file-name t))
(cons 'path buffer-file-name))))))))
(_
(error "madrigal: unknown op %s" op-name)))
(madrigal--log-tool-op request-id
(format "exec_ops output: %s" op-name)
row)
(setq results (append results (list row)))))
(list :state state
:results results)))
(defun madrigal--exec-ops-tool (agent-id &optional request-id)
(llm-make-tool
:name "exec_ops"
:description
(concat
"Execute a sequence of CRDT editing operations in the agent replica. "
"Operations: open_file, list_buffers, switch_buffer, move, search, set_mark, clear_region, read_selection, "
"insert_text, delete_selection, replace_selection. "
"save_buffer is disabled by default unless `madrigal-allow-save-buffer-op` is non-nil. "
"move returns moved_chars. search supports direction (forward/backward) and needle (text/query aliases); it returns match_length (0 when not found). "
"Supports references like $1.field to consume previous step outputs.")
:args
(list
'(:name "ops"
:type array
:items (:type object)
:description "Array of operation objects."))
:function (lambda (ops)
(condition-case err
(let ((ret (madrigal--tool-exec-ops agent-id ops request-id)))
(madrigal--log-tool-op request-id "exec_ops return" ret)
ret)
(error
(madrigal--log-tool-op request-id
"exec_ops failure"
`((error . ,(error-message-string err))))
`((error . ,(error-message-string err))))))))
(defun madrigal--provider-capable-p (provider capability)
(memq capability (llm-capabilities provider)))
(defun madrigal--run-model-loop (provider prompt rounds-left done &optional request-id round)
(let ((round-no (or round 1)))
(if (<= rounds-left 0)
(progn
(madrigal--log-error request-id "Loop Error" 'max-rounds "madrigal: max rounds reached")
(funcall done (list :status 'error :message "madrigal: max rounds reached")))
(let* ((streaming-tool-use (madrigal--provider-capable-p provider 'streaming-tool-use))
(streaming (madrigal--provider-capable-p provider 'streaming))
(use-streaming (and streaming streaming-tool-use)))
(if use-streaming
(llm-chat-streaming
provider prompt
(lambda (partial)
(let ((txt (plist-get partial :text)))
(when (and txt (> (length txt) 0))
(message "madrigal: %s" (truncate-string-to-width txt 120 nil nil t)))))
(lambda (final)
(madrigal--log-round request-id round-no final)
(if (and (plist-get final :tool-results)
(string-empty-p (or (plist-get final :text) "")))
(madrigal--run-model-loop provider prompt (1- rounds-left) done request-id (1+ round-no))
(funcall done (list :status 'ok :result final))))
(lambda (etype emsg)
(madrigal--log-error request-id (format "Round %d Error" round-no) etype emsg)
(funcall done (list :status 'error :etype etype :message emsg)))
t)
(llm-chat-async
provider prompt
(lambda (final)
(madrigal--log-round request-id round-no final)
(if (and (plist-get final :tool-results)
(string-empty-p (or (plist-get final :text) "")))
(madrigal--run-model-loop provider prompt (1- rounds-left) done request-id (1+ round-no))
(funcall done (list :status 'ok :result final :fallback 'non-streaming-tool-use))))
(lambda (etype emsg)
(madrigal--log-error request-id (format "Round %d Error" round-no) etype emsg)
(funcall done (list :status 'error :etype etype :message emsg)))
t))))))
(defun madrigal-edit (agent-id prompt-text)
"Send PROMPT-TEXT to LLM agent AGENT-ID.
The model edits via CRDT-safe tools and each AGENT-ID has its own local CRDT
client session managed by madrigal."
(interactive
(list
(read-string (format "Agent (%s): " madrigal-default-agent)
nil nil madrigal-default-agent)
(read-string "Prompt: ")))
(madrigal--ensure-server-session)
(let* ((provider (madrigal--current-provider))
(source-buffer (current-buffer))
(request-id (madrigal--log-new-request agent-id source-buffer prompt-text nil))
(_agent (madrigal--ensure-agent agent-id))
(_shared (madrigal--ensure-shared-in-server source-buffer))
(prompt (llm-make-chat-prompt
(madrigal--build-user-prompt prompt-text)
:context (madrigal--system-prompt)
:reasoning (and madrigal-log-include-reasoning
madrigal-reasoning-level)
:tools (list (madrigal--exec-ops-tool agent-id request-id)))))
(madrigal--configure-provider-reasoning provider)
(madrigal--run-model-loop
provider
prompt
madrigal-max-tool-rounds
(lambda (status)
(unwind-protect
(pcase (plist-get status :status)
('ok
(let* ((res (plist-get status :result))
(text (or (plist-get res :text) ""))
(fallback (plist-get status :fallback)))
(madrigal--log-append-heading request-id 2 "Outcome")
(madrigal--log-append-obj request-id 3 "Status"
`((status . ok)
(fallback . ,fallback)
(text . ,text)))
(if fallback
(message "madrigal: done (fallback %s). %s" fallback text)
(message "madrigal: done. %s" text))))
(_
(madrigal--log-append-heading request-id 2 "Outcome")
(madrigal--log-append-obj request-id 3 "Status"
`((status . error)
(type . ,(or (plist-get status :etype) 'error))
(message . ,(or (plist-get status :message) "unknown"))))
(message "madrigal: error (%s) %s"
(or (plist-get status :etype) 'error)
(or (plist-get status :message) "unknown"))))
(madrigal--drop-agent agent-id)))
request-id)))
(provide 'madrigal)