Matrix HTML table helpers and pipe-table Markdown support

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mx.client
 Type: Package
 Title: Stateful Matrix Client Helpers
-Version: 0.1.1.1
+Version: 0.1.1.2
 Date: 2026-06-13
 Authors@R: c(
     person("Troy", "Hernandez", role = c("aut", "cre"),

NAMESPACE

@@ -36,6 +36,8 @@ export(mx_room_encrypted)
 export(mx_room_lookup_by_name)
 export(mx_send_encrypted)
 export(mx_send_media)
+export(mx_send_table)
 export(mx_send_text)
 export(mx_sync_update)
+export(mx_table_html)
 export(mx_with_relogin)

NEWS.md

@@ -1,3 +1,15 @@
+# mx.client 0.1.1.2
+
+* New: `mx_table_html()` and `mx_send_table()` render a data frame,
+  matrix, or list as the conservative Matrix table HTML that clients such
+  as FluffyChat 2.6.0+ accept: a bare `<table>` of `<tr>`, `<th>`, and
+  `<td>` nodes, with no CSS, colspan, rowspan, or custom attributes.
+  A plain-text `body` is generated alongside for clients that ignore
+  `formatted_body`.
+* `mx_markdown_to_html()` converts GitHub-style pipe tables to the same
+  table HTML, honouring the `:---`/`:---:`/`---:` alignment row.
+* New: `inst/skills/mx.client/matrix-messaging/SKILL.md`.
+
 # mx.client 0.1.1.1
 
 * `mx_extract_text_events()` keeps the event's `origin_server_ts` as a

R/markdown.R

@@ -15,10 +15,88 @@ mx_markdown_inline_html <- function(x) {
     x
 }
 
+mx_table_row_cells <- function(x) {
+    x <- trimws(x)
+    if (startsWith(x, "|")) {
+        x <- substring(x, 2L)
+    }
+    if (endsWith(x, "|")) {
+        x <- substring(x, 1L, nchar(x) - 1L)
+    }
+    trimws(strsplit(x, "|", fixed = TRUE)[[1]])
+}
+
+mx_is_table_separator <- function(x) {
+    cells <- mx_table_row_cells(x)
+    length(cells) > 0L && all(grepl("^:?-{3,}:?$", cells))
+}
+
+mx_is_table_row <- function(x) {
+    grepl("\\|", x) && nzchar(trimws(x))
+}
+
+mx_table_align <- function(sep) {
+    cells <- mx_table_row_cells(sep)
+    vapply(cells, function(cell) {
+        left <- startsWith(cell, ":")
+        right <- endsWith(cell, ":")
+        if (left && right) {
+            "center"
+        } else if (right) {
+            "right"
+        } else if (left) {
+            "left"
+        } else {
+            NA_character_
+        }
+    }, character(1))
+}
+
+mx_table_html_cells <- function(cells, tag = "td", align = NULL) {
+    n <- length(cells)
+    if (is.null(align)) {
+        align <- rep(NA_character_, n)
+    }
+    if (length(align) < n) {
+        align <- c(align, rep(NA_character_, n - length(align)))
+    }
+    paste(vapply(seq_len(n), function(i) {
+        attr <- if (!is.na(align[[i]]) && nzchar(align[[i]])) {
+            sprintf(" align=\"%s\"", align[[i]])
+        } else {
+            ""
+        }
+        sprintf("<%s%s>%s</%s>", tag, attr,
+                mx_markdown_inline_html(cells[[i]]), tag)
+    }, character(1)), collapse = "")
+}
+
+mx_table_to_html <- function(rows) {
+    header <- mx_table_row_cells(rows[[1]])
+    align <- mx_table_align(rows[[2]])
+    body <- rows[-c(1L, 2L)]
+    html <- c("<table>", "<thead><tr>",
+              mx_table_html_cells(header, "th", align), "</tr></thead>")
+    if (length(body)) {
+        body_html <- vapply(body, function(row) {
+            cells <- mx_table_row_cells(row)
+            # Pad or trim body rows to header width, matching common GFM behavior.
+            if (length(cells) < length(header)) {
+                cells <- c(cells, rep("", length(header) - length(cells)))
+            } else if (length(cells) > length(header)) {
+                cells <- cells[seq_along(header)]
+            }
+            paste0("<tr>", mx_table_html_cells(cells, "td", align), "</tr>")
+        }, character(1))
+        html <- c(html, "<tbody>", body_html, "</tbody>")
+    }
+    paste0(c(html, "</table>"), collapse = "")
+}
+
 #' Convert a conservative markdown subset to Matrix custom HTML
 #'
 #' Supports headings, bullets, numbered lists, fenced code blocks, inline
-#' code, bold, and simple underscore emphasis.
+#' code, bold, simple underscore emphasis, and GitHub-style pipe tables.
 #'
 #' @param text Character markdown body.
 #' @return Character HTML suitable for m.room.message formatted_body.
@@ -43,7 +121,9 @@ mx_markdown_to_html <- function(text) {
         }
         z
     }
-    for (ln in lines) {
+    i <- 1L
+    while (i <= length(lines)) {
+        ln <- lines[[i]]
         if (grepl("^```", ln)) {
             if (in_pre) {
                 out <- c(out, "</code></pre>")
@@ -52,76 +132,107 @@ mx_markdown_to_html <- function(text) {
                 out <- c(out, close_lists(), "<pre><code>")
                 in_pre <- TRUE
             }
+            i <- i + 1L
             next
         }
         if (in_pre) {
             out <- c(out, mx_html_escape(ln))
+            i <- i + 1L
+            next
+        }
+        if (i < length(lines) && mx_is_table_row(ln) &&
+            mx_is_table_separator(lines[[i + 1L]])) {
+            j <- i + 2L
+            while (j <= length(lines) && mx_is_table_row(lines[[j]])) {
+                j <- j + 1L
+            }
+            out <- c(out, close_lists(), mx_table_to_html(lines[i:(j - 1L)]))
+            i <- j
             next
         }
         if (!nzchar(trimws(ln))) {
             out <- c(out, close_lists())
+            i <- i + 1L
             next
         }
-        if (grepl("^#{1,6}\\s+", ln)) {
+        h <- regexec("^(#{1,6})\\s+(.+)$", ln, perl = TRUE)
+        hm <- regmatches(ln, h)[[1]]
+        if (length(hm)) {
             out <- c(out, close_lists())
-            lvl <- nchar(sub("^(#{1,6}).*$", "\\1", ln))
-            body <- sub("^#{1,6}\\s+", "", ln)
+            lvl <- nchar(hm[[2]])
+            body <- hm[[3]]
             out <- c(out, sprintf("<h%d>%s</h%d>", lvl,
                                   mx_markdown_inline_html(body), lvl))
+            i <- i + 1L
             next
         }
-        if (grepl("^\\s*[-*]\\s+", ln)) {
+        b <- regexec("^\\s*[-*]\\s+(.+)$", ln, perl = TRUE)
+        bm <- regmatches(ln, b)[[1]]
+        if (length(bm)) {
+            if (in_ol) {
+                out <- c(out, "</ol>")
+                in_ol <- FALSE
+            }
             if (!in_ul) {
-                out <- c(out, close_lists(), "<ul>")
+                out <- c(out, "<ul>")
                 in_ul <- TRUE
             }
-            body <- sub("^\\s*[-*]\\s+", "", ln)
+            body <- bm[[2]]
             out <- c(out, sprintf("<li>%s</li>", mx_markdown_inline_html(body)))
+            i <- i + 1L
             next
         }
-        if (grepl("^\\s*[0-9]+[.)]\\s+", ln)) {
+        # Both "1." and "1)" are ordered-list markers; matching only the
+        # dot silently renders "1)" input as a paragraph.
+        o <- regexec("^\\s*[0-9]+[.)]\\s+(.+)$", ln, perl = TRUE)
+        om <- regmatches(ln, o)[[1]]
+        if (length(om)) {
+            if (in_ul) {
+                out <- c(out, "</ul>")
+                in_ul <- FALSE
+            }
             if (!in_ol) {
-                out <- c(out, close_lists(), "<ol>")
+                out <- c(out, "<ol>")
                 in_ol <- TRUE
             }
-            body <- sub("^\\s*[0-9]+[.)]\\s+", "", ln)
+            body <- om[[2]]
             out <- c(out, sprintf("<li>%s</li>", mx_markdown_inline_html(body)))
+            i <- i + 1L
             next
         }
         out <- c(out, close_lists(), sprintf("<p>%s</p>",
                 mx_markdown_inline_html(ln)))
+        i <- i + 1L
     }
-    out <- c(out, close_lists())
     if (in_pre) {
         out <- c(out, "</code></pre>")
     }
+    out <- c(out, close_lists())
     paste(out, collapse = "")
 }
 
-#' Turn textual @mentions into matrix.to pills
-#'
-#' Replaces each occurrence of \code{@localpart} (or the full
-#' \code{@localpart:server} id) in already-rendered HTML with a
-#' \code{matrix.to} anchor, which Matrix clients render as a mention pill.
-#' A user id with no textual occurrence is left to \code{m.mentions} alone,
-#' which still notifies.
+#' Turn textual @mentions into Matrix pills in formatted HTML
 #'
 #' @param html Character HTML (e.g. from \code{\link{mx_markdown_to_html}}).
-#' @param user_ids Character vector of full Matrix user ids.
-#' @return Character HTML with mention pills.
+#' @param user_ids Character Matrix user ids, such as
+#'   \code{"@jorge:example.org"}.
+#' @return HTML with textual \code{@localpart} occurrences replaced by
+#'   matrix.to links. Unmatched user ids leave the HTML unchanged; they
+#'   can still be placed in \code{m.mentions} by \code{mx_send_text()}.
 #' @examples
 #' mx_pill_mentions("<p>ping @jorge</p>", "@jorge:example.org")
 #' @export
 mx_pill_mentions <- function(html, user_ids) {
-    for (uid in user_ids) {
+    if (!length(user_ids)) {
+        return(html)
+    }
+    for (uid in unique(user_ids)) {
         local <- sub("^@([^:]+):.*$", "\\1", uid)
-        esc <- gsub("([][{}().*+?^$\\\\|])", "\\\\\\1", local)
-        pill <- sprintf("<a href=\"https://matrix.to/#/%s\">%s</a>", uid, local)
-        # One pass matching @localpart with an optional :server tail -- a
-        # second pass would rescan the @id inside the inserted href. Case-
-        # insensitive since people type @Jorge for @jorge.
+        esc <- gsub("([][{}()+*^$.|\\\\?])", "\\\\\\1", local, perl = TRUE)
+        pill <- sprintf("<a href=\"https://matrix.to/#/%s\">%s</a>",
+                        mx_html_escape(uid), mx_html_escape(local))
         html <- gsub(paste0("@", esc, "(:[A-Za-z0-9._-]+)?\\b"), pill, html,
-                     ignore.case = TRUE)
+                     perl = TRUE, ignore.case = TRUE)
     }
     html
 }

R/messages.R

@@ -218,19 +218,17 @@ mx_accept_invites <- function(client, invites) {
 #'                             target_event_id = "$msg")
 #' @export
 mx_extract_reaction_verdict <- function(sync_resp, room_id, self_id,
-                                        target_event_id,
-                                        approve_keys = NULL,
+                                        target_event_id, approve_keys = NULL,
                                         deny_keys = NULL) {
     # Emoji defaults are built here, not in the signature, so they don't
     # land as raw astral-plane glyphs in the .Rd \usage block -- LaTeX
     # can't typeset them and the PDF manual fails R CMD check --as-cran.
     if (is.null(approve_keys)) {
-        approve_keys <- c(intToUtf8(0x1F44D), intToUtf8(0x2705),
-                          "y", "yes", "ok")
+        approve_keys <- c(intToUtf8(0x1F44D), intToUtf8(0x2705), "y", "yes",
+                          "ok")
     }
     if (is.null(deny_keys)) {
-        deny_keys <- c(intToUtf8(0x1F44E), intToUtf8(0x274C),
-                       "n", "no", "nope")
+        deny_keys <- c(intToUtf8(0x1F44E), intToUtf8(0x274C), "n", "no", "nope")
     }
     room <- sync_resp$rooms$join[[room_id]]
     if (is.null(room)) {

R/tables.R

@@ -0,0 +1,97 @@
+# Matrix HTML table helpers.
+
+mx_table_coerce <- function(x) {
+    if (is.data.frame(x)) {
+        return(x)
+    }
+    if (is.matrix(x)) {
+        return(as.data.frame(x, stringsAsFactors = FALSE))
+    }
+    if (is.list(x)) {
+        return(as.data.frame(x, stringsAsFactors = FALSE, check.names = FALSE))
+    }
+    stop("x must be a data.frame, matrix, or list", call. = FALSE)
+}
+
+mx_table_plain <- function(x, header = TRUE) {
+    x <- mx_table_coerce(x)
+    rows <- vapply(seq_len(nrow(x)), function(i) {
+        paste(vapply(x[i,, drop = FALSE], as.character, character(1)),
+              collapse = " | ")
+    }, character(1))
+    # Track the HTML: emitting column names in the fallback while the
+    # formatted_body omits them shows different tables to different clients.
+    if (isTRUE(header)) {
+        rows <- c(paste(names(x), collapse = " | "), rows)
+    }
+    paste(rows, collapse = "\n")
+}
+
+#' Render tabular data as Matrix custom HTML
+#'
+#' Produces the conservative table shape rendered by Matrix clients such as
+#' FluffyChat 2.6.0+: a bare \code{<table>} containing \code{<tr>},
+#' \code{<th>}, and \code{<td>} nodes. No CSS, colspan, rowspan, or custom
+#' attributes are emitted.
+#'
+#' @param x A data frame, matrix, or list coercible to a data frame.
+#' @param header Logical. Include a header row using column names.
+#' @return Character HTML suitable for Matrix \code{formatted_body}.
+#' @examples
+#' mx_table_html(data.frame(A = 1:2, B = c("x", "y")))
+#' @export
+mx_table_html <- function(x, header = TRUE) {
+    x <- mx_table_coerce(x)
+    cell <- function(tag, value) {
+        sprintf("<%s>%s</%s>", tag, mx_html_escape(as.character(value)), tag)
+    }
+    rows <- character()
+    if (isTRUE(header)) {
+        rows <- c(rows, paste0("<tr>",
+                               paste(vapply(names(x), cell, character(1), tag = "th"),
+                                     collapse = ""),
+                               "</tr>"))
+    }
+    if (nrow(x)) {
+        rows <- c(rows, vapply(seq_len(nrow(x)), function(i) {
+            vals <- vapply(x[i,, drop = FALSE], as.character, character(1))
+            paste0("<tr>", paste(vapply(vals, cell, character(1), tag = "td"),
+                                 collapse = ""), "</tr>")
+        }, character(1)))
+    }
+    paste0("<table>", paste(rows, collapse = ""), "</table>")
+}
+
+#' Send tabular data to a Matrix room
+#'
+#' Sends a plain-text fallback body plus Matrix custom HTML table in
+#' \code{formatted_body}. This bypasses Markdown entirely.
+#'
+#' @param client Matrix client config.
+#' @param x A data frame, matrix, or list coercible to a data frame.
+#' @param room Character room id/name or NULL for the default room.
+#' @param header Logical. Include a header row using column names.
+#' @param title Optional text prepended to the plain fallback body.
+#' @param room_cache Optional room name-to-id cache.
+#' @param dry_run Logical. Print instead of sending.
+#' @return Event id, or NULL on dry-run.
+#' @examples
+#' client <- list(room_id = "!default:example.org")
+#' mx_send_table(client, data.frame(A = 1, B = 2), dry_run = TRUE)
+#' @export
+mx_send_table <- function(client, x, room = NULL, header = TRUE,
+                          title = NULL, room_cache = NULL, dry_run = FALSE) {
+    html <- mx_table_html(x, header = header)
+    body <- mx_table_plain(x, header = header)
+    if (!is.null(title) && nzchar(title)) {
+        body <- paste(as.character(title), body, sep = "\n")
+    }
+    if (isTRUE(dry_run)) {
+        message("=== mx_send_table (dry-run) [", room %||% "default",
+                "] ===\n", body, "\n--- formatted_body ---\n", html)
+        return(invisible(NULL))
+    }
+    rid <- mx_resolve_room(client, room, room_cache = room_cache)
+    mx.api::mx_send(mx_client_session(client), rid, body, msgtype = "m.text",
+                    extra = list(format = "org.matrix.custom.html", formatted_body = html))
+}