Add chat_edit()

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: chat.api
 Type: Package
 Title: Transport-Agnostic Chat Contract for R Agents
-Version: 0.0.1.17
+Version: 0.0.1.19
 Date: 2026-08-05
 Authors@R: c(
     person("Troy", "Hernandez", role = c("aut", "cre"),

NAMESPACE

@@ -7,6 +7,7 @@ export(chat_channels)
 export(chat_config)
 export(chat_config_save)
 export(chat_disconnect)
+export(chat_edit)
 export(chat_history)
 export(chat_identity)
 export(chat_invite)
@@ -49,6 +50,10 @@ S3method(chat_channels,chat_slack)
 S3method(chat_channels,default)
 S3method(chat_disconnect,chat_irc)
 S3method(chat_disconnect,default)
+S3method(chat_edit,chat_loopback)
+S3method(chat_edit,chat_matrix)
+S3method(chat_edit,chat_slack)
+S3method(chat_edit,default)
 S3method(chat_history,chat_loopback)
 S3method(chat_history,chat_matrix)
 S3method(chat_history,chat_slack)

R/contract.R

@@ -37,6 +37,21 @@ chat_poll <- function(client, since = NULL, timeout = NULL, ...) {
 #' @param files Character vector of file paths to attach, or NULL.
 #' @param kind Message kind; \code{"message"} (default) or an
 #'   adapter-understood alternative (e.g. \code{"notice"}, \code{"emote"}).
+#' @param rich Adapter-native markup for the platforms that accept it,
+#'   or NULL. Matrix takes an HTML fragment and sends it as
+#'   \code{formatted_body}; adapters whose
+#'   \code{chat_capabilities()} is empty ignore it.
+#'
+#'   \code{text} is still required and still has to stand on its own. It
+#'   is what a client that cannot render the markup shows, what a push
+#'   notification carries, and what every other transport gets -- so a
+#'   \code{rich} that holds the real content and a \code{text} that says
+#'   "see above" is a message half the room cannot read.
+#'
+#'   Ignored rather than refused where unsupported, on
+#'   \code{\link{chat_typing}}'s reasoning: the text is the message and
+#'   the markup is decoration, so losing it costs presentation and
+#'   nothing else.
 #' @param notify Logical; FALSE requests a silent delivery where
 #'   supported.
 #' @param ... Adapter-specific options.
@@ -50,7 +65,8 @@ chat_poll <- function(client, since = NULL, timeout = NULL, ...) {
 #' @export
 chat_send <- function(client, channel, text, markup = c("plain", "markdown"),
                       thread = NULL, reply_to = NULL, identity = NULL,
-                      files = NULL, kind = "message", notify = TRUE, ...) {
+                      files = NULL, kind = "message", notify = TRUE,
+                      rich = NULL, ...) {
     UseMethod("chat_send")
 }
 
@@ -737,3 +753,50 @@ chat_relogin.default <- function(client, ...) {
     stop("chat_relogin() is not supported by this adapter (",
          paste(class(client), collapse = "/"), ").", call. = FALSE)
 }
+
+#' Replace the text of a message already sent
+#'
+#' What makes a progress message possible: post "working on it", then
+#' keep replacing it as the work happens, instead of narrating into the
+#' channel one message at a time.
+#'
+#' The default throws. An edit that silently does nothing leaves the old
+#' text on screen, and stale content is worse than a visible failure --
+#' the reader has no way to tell that what they are looking at is no
+#' longer true. Check \code{chat_capabilities()$edits}.
+#'
+#' @param client A \code{chat_client}.
+#' @param channel Channel/room identifier.
+#' @param message_id The message to replace, as returned by
+#'   \code{\link{chat_send}}.
+#' @param text The replacement text, in full. Not a delta: every
+#'   platform that supports this takes the whole new body, and a
+#'   contract that took a patch would have to reconstruct the old one to
+#'   apply it.
+#' @param markup \code{"plain"} or \code{"markdown"}, as
+#'   \code{\link{chat_send}}.
+#' @param ... Adapter-specific options.
+#' @return The identifier of the event the edit created where the
+#'   platform makes one (Matrix), or of the edited message where it does
+#'   not (Slack), invisibly.
+#'
+#' @section What a consumer must not assume:
+#' That the edit is what readers see. A client that does not implement
+#' edits shows the original and an "* edited" fallback beside it, and
+#' notifications almost always carry the text as first sent. So the
+#' first version has to stand on its own -- "working on it" is a fine
+#' thing to be paged with, a half-finished sentence is not.
+#' @export
+chat_edit <- function(client, channel, message_id, text,
+                      markup = c("plain", "markdown"), rich = NULL, ...) {
+    UseMethod("chat_edit")
+}
+
+#' @export
+chat_edit.default <- function(client, channel, message_id, text,
+                              markup = c("plain", "markdown"), rich = NULL,
+                              ...) {
+    stop("chat_edit() is not supported by this adapter (",
+         paste(class(client), collapse = "/"),
+         "). Check chat_capabilities()$edits.", call. = FALSE)
+}

R/irc.R

@@ -89,7 +89,8 @@ chat_send.chat_irc <- function(client, channel, text,
                                markup = c("plain", "markdown"),
                                thread = NULL, reply_to = NULL,
                                identity = NULL, files = NULL,
-                               kind = "message", notify = TRUE, ...) {
+                               kind = "message", notify = TRUE, rich = NULL,
+                               ...) {
     markup <- match.arg(markup)
     verb <- if (identical(kind, "notice")) {
         "NOTICE"
@@ -129,8 +130,8 @@ chat_capabilities.chat_irc <- function(client, ...) {
          channels = FALSE, history = FALSE, pending = FALSE,
          mark_read = FALSE, set_identity = TRUE, relogin = FALSE,
          files = FALSE, typing = FALSE, e2ee = FALSE,
-         identity_override = FALSE, markup_dialects = "plain",
-         max_message_bytes = 400L)
+         identity_override = FALSE, rich_markup = character(),
+         markup_dialects = "plain", max_message_bytes = 400L)
 }
 
 #' @export

R/loopback.R

@@ -25,7 +25,8 @@ chat_send.chat_loopback <- function(client, channel, text,
                                     markup = c("plain", "markdown"),
                                     thread = NULL, reply_to = NULL,
                                     identity = NULL, files = NULL,
-                                    kind = "message", notify = TRUE, ...) {
+                                    kind = "message", notify = TRUE,
+                                    rich = NULL, ...) {
     markup <- match.arg(markup)
     id <- sprintf("loopback-%d", length(client$env$log) + 1L)
     msg <- chat_message(id = id, channel = channel,
@@ -57,13 +58,14 @@ chat_resolve.chat_loopback <- function(client, name, ...) {
 
 #' @export
 chat_capabilities.chat_loopback <- function(client, ...) {
-    list(threads = TRUE, thread_replies = TRUE, edits = FALSE,
+    list(threads = TRUE, thread_replies = TRUE, edits = TRUE,
          reactions = FALSE, reaction_events = FALSE, channel_info = FALSE,
          members = FALSE, invites = FALSE, join = FALSE, whoami = TRUE,
          channels = TRUE, history = TRUE, pending = FALSE,
          mark_read = FALSE, set_identity = FALSE, relogin = FALSE,
          files = FALSE, typing = FALSE, e2ee = FALSE,
-         identity_override = TRUE, markup_dialects = c("plain", "markdown"),
+         identity_override = TRUE, rich_markup = character(),
+         markup_dialects = c("plain", "markdown"),
          max_message_bytes = NA_integer_)
 }
 
@@ -113,3 +115,24 @@ chat_history.chat_loopback <- function(client, channel, limit = 50L,
     }
     list(messages = log, cursor = nxt)
 }
+
+#' @export
+chat_edit.chat_loopback <- function(client, channel, message_id, text,
+                                    markup = c("plain", "markdown"),
+                                    rich = NULL, ...) {
+    markup <- match.arg(markup)
+    pos <- which(vapply(client$env$log,
+                        function(m) identical(m$id, message_id), logical(1)))
+    if (!length(pos)) {
+        # Not a no-op. A consumer editing a message that is not there has
+        # lost track of what it sent, and the reference adapter is where
+        # that should be loudest.
+        stop("chat_edit(): no message ", message_id, " in this log.",
+             call. = FALSE)
+    }
+    msg <- client$env$log[[pos[[1L]]]]
+    msg$body <- text
+    msg$markup <- markup
+    client$env$log[[pos[[1L]]]] <- msg
+    invisible(message_id)
+}

R/matrix.R

@@ -134,6 +134,10 @@
 #'   \code{mx.api::mx_read_receipt}. Leave NULL in production.
 #' @param .identity Testing seam: replacement for
 #'   \code{mx.client::mx_set_displayname}. Leave NULL in production.
+#' @param .rich Testing seam: replacement for \code{mx.api::mx_send} on
+#'   the rich-send path. Leave NULL in production.
+#' @param .edit Testing seam: replacement for \code{mx.api::mx_send} on
+#'   the edit path. Leave NULL in production.
 #' @return A \code{chat_client} of class \code{chat_matrix}.
 #'   \code{\link{chat_poll}} on this class returns \code{first_run} and
 #'   \code{client} alongside \code{messages}, \code{cursor}, and
@@ -151,7 +155,8 @@ chat_matrix <- function(app = NULL, path = NULL, save_cursor = TRUE,
                         .crypto = NULL, .save = NULL, .react = NULL,
                         .info = NULL, .members = NULL, .join = NULL,
                         .channels = NULL, .history = NULL, .pending = NULL,
-                        .read = NULL, .identity = NULL) {
+                        .read = NULL, .identity = NULL, .edit = NULL,
+                        .rich = NULL) {
     seams <- list(.sync, .extract, .send, .media)
     if ((is.null(mx) || any(vapply(seams, is.null, logical(1)))) &&
         !requireNamespace("mx.client", quietly = TRUE)) {
@@ -207,7 +212,8 @@ chat_matrix <- function(app = NULL, path = NULL, save_cursor = TRUE,
                    info_fn = .info, members_fn = .members, join_fn = .join,
                    channels_fn = .channels, history_fn = .history,
                    pending_fn = .pending, read_fn = .read,
-                   identity_fn = .identity,
+                   identity_fn = .identity, edit_fn = .edit,
+                   rich_fn = .rich,
                    crypto_ops = matrix_crypto_ops(.crypto)),
               class = c("chat_matrix", "chat_client"))
 }
@@ -515,7 +521,8 @@ chat_send.chat_matrix <- function(client, channel, text,
                                   markup = c("plain", "markdown"),
                                   thread = NULL, reply_to = NULL,
                                   identity = NULL, files = NULL,
-                                  kind = "message", notify = TRUE, ...) {
+                                  kind = "message", notify = TRUE,
+                                  rich = NULL, ...) {
     markup <- match.arg(markup)
     # Resolved before anything is uploaded or posted. The encryption
     # question used to be asked after the attachment loop had already run,
@@ -574,12 +581,25 @@ chat_send.chat_matrix <- function(client, channel, text,
         # markdown send renders the same either way. Only the envelope
         # differs.
         if (encrypted) {
+            # rich is dropped here rather than refused. crypto_ops$send()
+            # takes text, msgtype, markdown and mentions, and builds its
+            # own HTML from the markdown -- there is nowhere in that
+            # shape for a caller's fragment. The text still arrives, and
+            # chat_capabilities()$rich_markup is empty on an e2ee client
+            # so a consumer can know beforehand.
             event <- client$crypto_ops$send(crypto, client$env$mx, channel,
                 text, msgtype = msgtype,
                 markdown = identical(markup, "markdown"),
                 mentions = list(...)$mentions)
             return(invisible(c(media_ids, as.character(event))))
         }
+        if (!is.null(rich)) {
+            # A different function, because mx_send_text() renders its
+            # own HTML from markdown and has no argument for a supplied
+            # one. mx_send() takes the content wholesale.
+            event <- matrix_send_rich(client, channel, text, rich, msgtype)
+            return(invisible(c(media_ids, as.character(event))))
+        }
         event <- client$send_fn(client$env$mx, text, room = channel,
                                 msgtype = msgtype,
                                 markdown = identical(markup, "markdown"), ...)
@@ -705,15 +725,23 @@ chat_capabilities.chat_matrix <- function(client, ...) {
     # adapter has no encrypted-attachment path, so chat_send() refuses
     # attachments to an encrypted room. TRUE would advertise something
     # that fails in exactly the rooms such a client exists for.
-    list(threads = FALSE, thread_replies = FALSE, edits = FALSE,
+    list(threads = FALSE, thread_replies = FALSE,
+         # Refused in encrypted rooms: an edit carries its replacement
+         # text in an ordinary event, and there is no Megolm path that
+         # can carry a relation. Same bargain as files.
+         edits = !isTRUE(client$e2ee),
          reactions = TRUE, reaction_events = matrix_reactions_available(),
          channel_info = TRUE, members = TRUE,
          invites = matrix_invites_available(), join = TRUE, whoami = TRUE,
          channels = TRUE, history = TRUE,
          pending = matrix_invites_available(), mark_read = TRUE,
          set_identity = TRUE, relogin = TRUE, files = !isTRUE(client$e2ee),
          typing = TRUE, e2ee = isTRUE(client$e2ee),
-         identity_override = FALSE, markup_dialects = c("plain", "markdown"),
+         identity_override = FALSE,
+         # Empty on an e2ee client: the Megolm path builds its own HTML
+         # from markdown and has nowhere to put a supplied fragment.
+         rich_markup = if (isTRUE(client$e2ee)) character() else "html",
+         markup_dialects = c("plain", "markdown"),
          max_message_bytes = NA_integer_)
 }
 
@@ -891,3 +919,73 @@ chat_mark_read.chat_matrix <- function(client, channel, message_id, ...) {
     }, error = function(e) FALSE)
     invisible(ok)
 }
+
+#' @export
+chat_edit.chat_matrix <- function(client, channel, message_id, text,
+                                  markup = c("plain", "markdown"),
+                                  rich = NULL, ...) {
+    markup <- match.arg(markup)
+    # Refused in encrypted rooms, and chat_capabilities() reports
+    # edits = FALSE on an e2ee client to match -- the same bargain
+    # attachments get.
+    #
+    # An edit is an ordinary m.room.message carrying m.new_content, so
+    # sending one the plain way puts the replacement text on the
+    # homeserver in the clear, in a room whose whole point is that it is
+    # not. The Megolm path cannot carry it either: crypto_ops$send()
+    # takes text, msgtype, markdown and mentions, and there is nowhere in
+    # that shape to put a relation.
+    crypto <- matrix_crypto_require(client)
+    if (!is.null(crypto) &&
+        client$crypto_ops$encrypted(crypto, client$env$mx, channel)) {
+        stop("chat.api: cannot edit a message in the encrypted room ",
+             channel, ". An edit carries the replacement text in an ",
+             "ordinary event, and posting one would put it on the ",
+             "homeserver in the clear.", call. = FALSE)
+    }
+    sess <- mx.client::mx_client_session(client$env$mx)
+    fn <- client$edit_fn %||% mx.api::mx_send
+    html <- if (identical(markup, "markdown")) {
+        mx.client::mx_markdown_to_html(text)
+    } else {
+        NULL
+    }
+    new_content <- list(msgtype = "m.text", body = text)
+    # A supplied fragment wins over one rendered from markdown: the
+    # caller has markup the renderer cannot express, which is the only
+    # reason to pass one.
+    if (!is.null(rich)) {
+        html <- rich
+    }
+    if (!is.null(html)) {
+        new_content$format <- "org.matrix.custom.html"
+        new_content$formatted_body <- html
+    }
+    extra <- list(`m.new_content` = new_content,
+                  `m.relates_to` = list(rel_type = "m.replace", event_id = message_id))
+    if (!is.null(html)) {
+        extra$format <- "org.matrix.custom.html"
+        # The "* " prefix is the convention for the fallback copy: a
+        # client too old to understand m.replace renders this event as
+        # an ordinary message, and the asterisk is what tells a reader
+        # it is a correction rather than the bot repeating itself.
+        extra$formatted_body <- paste0("* ", html)
+    }
+    invisible(as.character(fn(sess, channel, paste0("* ", text),
+                              msgtype = "m.text", extra = extra)))
+}
+
+# A send carrying a caller-supplied HTML fragment. mx_send_text() builds
+# formatted_body itself out of markdown and takes no argument for one
+# already rendered, so this goes through mx_send(), which takes the
+# content wholesale.
+#
+# text is still the body. Matrix's own model is a plain body plus an
+# optional formatted one, and a client that cannot render the markup --
+# or a push notification, which never does -- shows the body.
+matrix_send_rich <- function(client, channel, text, rich, msgtype) {
+    sess <- mx.client::mx_client_session(client$env$mx)
+    fn <- client$rich_fn %||% mx.api::mx_send
+    fn(sess, channel, text, msgtype = msgtype,
+        extra = list(format = "org.matrix.custom.html", formatted_body = rich))
+}