|
| 1 | +#' Create Quarto Markdown HTML Elements for Tables |
| 2 | +#' |
| 3 | +#' Functions to wrap content in HTML spans or divs with data-qmd attributes for |
| 4 | +#' Quarto processing within HTML tables. These functions are specifically designed |
| 5 | +#' for use with HTML table packages like kableExtra, gt, or DT where you need |
| 6 | +#' Quarto to process markdown content within table cells. |
| 7 | +#' |
| 8 | +#' @details |
| 9 | +#' These functions create HTML elements with `data-qmd` or `data-qmd-base64` |
| 10 | +#' attributes that Quarto processes during document rendering. The base64 |
| 11 | +#' encoding is recommended for content with special characters, quotes, or |
| 12 | +#' complex formatting. |
| 13 | +#' |
| 14 | +#' Available functions: |
| 15 | +#' |
| 16 | +#' * `tbl_qmd_span()` and `tbl_qmd_div()` are the main functions with encoding options |
| 17 | +#' * `tbl_qmd_span_base64()` and `tbl_qmd_div_base64()` explicitly use base64 encoding |
| 18 | +#' * `tbl_qmd_span_raw()` and `tbl_qmd_div_raw()` explicitly use raw encoding |
| 19 | +#' |
| 20 | +#' This feature requires Quarto version 1.3 or higher with HTML format outputs. |
| 21 | +#' For more information, see <https://quarto.org/docs/authoring/tables.html#html-tables>. |
| 22 | +#' |
| 23 | +#' @param content Character string of content to wrap. This can include Markdown, |
| 24 | +#' LaTeX math, and Quarto shortcodes. |
| 25 | +#' @param display Optional display text (if different from content). Useful for |
| 26 | +#' fallback text when Quarto processing is not available or for better |
| 27 | +#' accessibility. |
| 28 | +#' @param use_base64 Logical, whether to base64 encode the content (recommended |
| 29 | +#' for complex content with special characters or when content includes quotes) |
| 30 | +#' |
| 31 | +#' @return Character string containing the HTML element with appropriate data-qmd attributes |
| 32 | +#' |
| 33 | +#' @examples |
| 34 | +#' # Basic span usage in table cells |
| 35 | +#' tbl_qmd_span("**bold text**") |
| 36 | +#' tbl_qmd_span("$\\alpha + \\beta$", display = "Greek formula") |
| 37 | +#' |
| 38 | +#' # Basic div usage in table cells |
| 39 | +#' tbl_qmd_div("## Section Title\n\nContent here") |
| 40 | +#' tbl_qmd_div("{{< video https://example.com >}}", display = "[Video content]") |
| 41 | +#' |
| 42 | +#' # Explicit encoding choices |
| 43 | +#' tbl_qmd_span_base64("Complex $\\LaTeX$ content") |
| 44 | +#' tbl_qmd_span_raw("Simple text") |
| 45 | +#' |
| 46 | +#' # Use with different HTML table packages |
| 47 | +#' \dontrun{ |
| 48 | +#' # With kableExtra |
| 49 | +#' library(kableExtra) |
| 50 | +#' df <- data.frame( |
| 51 | +#' math = c(tbl_qmd_span("$x^2$"), tbl_qmd_span("$\\sum_{i=1}^n x_i$")), |
| 52 | +#' text = c(tbl_qmd_span("**Important**", "bold"), tbl_qmd_span("`code`", "code")) |
| 53 | +#' ) |
| 54 | +#' kbl(df, format = "html", escape = FALSE) |> kable_styling() |
| 55 | +#' } |
| 56 | +#' @name tbl_qmd_elements |
| 57 | +NULL |
| 58 | + |
| 59 | + |
| 60 | +.validate_tbl_qmd_input <- function( |
| 61 | + content, |
| 62 | + display = NULL, |
| 63 | + call = rlang::caller_env() |
| 64 | +) { |
| 65 | + if (!is.character(content) || length(content) != 1) { |
| 66 | + cli::cli_abort("'content' must be a single character string", call = call) |
| 67 | + } |
| 68 | + |
| 69 | + if (!is.null(display) && (!is.character(display) || length(display) != 1)) { |
| 70 | + cli::cli_abort( |
| 71 | + "'display' must be NULL or a single character string", |
| 72 | + call = call |
| 73 | + ) |
| 74 | + } |
| 75 | + |
| 76 | + invisible(TRUE) |
| 77 | +} |
| 78 | + |
| 79 | +#' @inheritParams tbl_qmd_elements |
| 80 | +#' @param class Optional CSS class(es) to add to the element. While this works for |
| 81 | +#' both span and div elements, it's more commonly used with div elements. |
| 82 | +#' @param attrs Named list of additional HTML attributes to add to the element. |
| 83 | +#' For example: `list(id = "my-element", title = "Tooltip text")` |
| 84 | +#' @noRd |
| 85 | +.tbl_qmd_element <- function( |
| 86 | + tag, |
| 87 | + content, |
| 88 | + display, |
| 89 | + use_base64, |
| 90 | + class = NULL, |
| 91 | + attrs = NULL |
| 92 | +) { |
| 93 | + .validate_tbl_qmd_input(content, display) |
| 94 | + |
| 95 | + if (is.null(display)) { |
| 96 | + display <- content |
| 97 | + } |
| 98 | + |
| 99 | + if (use_base64) { |
| 100 | + encoded_content <- xfun::base64_encode(charToRaw(content)) |
| 101 | + attr_list <- list("data-qmd-base64" = encoded_content) |
| 102 | + } else { |
| 103 | + attr_list <- list("data-qmd" = content) |
| 104 | + } |
| 105 | + |
| 106 | + # Add class if provided |
| 107 | + if (!is.null(class)) { |
| 108 | + attr_list$class <- class |
| 109 | + } |
| 110 | + |
| 111 | + # Add any additional attributes |
| 112 | + if (!is.null(attrs) && is.list(attrs) && length(attrs) > 0) { |
| 113 | + attr_list <- c(attr_list, attrs) |
| 114 | + } |
| 115 | + # Create HTML element using htmltools |
| 116 | + html_element <- if (tag == "div") { |
| 117 | + do.call(htmltools::div, c(list(display, .noWS = "outside"), attr_list)) |
| 118 | + } else { |
| 119 | + do.call(htmltools::span, c(list(display, .noWS = "outside"), attr_list)) |
| 120 | + } |
| 121 | + |
| 122 | + # Convert to character string |
| 123 | + as.character(html_element) |
| 124 | +} |
| 125 | + |
| 126 | +#' @rdname tbl_qmd_elements |
| 127 | +#' @export |
| 128 | +tbl_qmd_span <- function( |
| 129 | + content, |
| 130 | + display = NULL, |
| 131 | + use_base64 = TRUE |
| 132 | +) { |
| 133 | + .tbl_qmd_element("span", content, display, use_base64) |
| 134 | +} |
| 135 | + |
| 136 | +#' @rdname tbl_qmd_elements |
| 137 | +#' @export |
| 138 | +tbl_qmd_div <- function( |
| 139 | + content, |
| 140 | + display = NULL, |
| 141 | + use_base64 = TRUE |
| 142 | +) { |
| 143 | + .tbl_qmd_element("div", content, display, use_base64) |
| 144 | +} |
| 145 | +#' @rdname tbl_qmd_elements |
| 146 | +#' @export |
| 147 | +tbl_qmd_span_base64 <- function( |
| 148 | + content, |
| 149 | + display = NULL |
| 150 | +) { |
| 151 | + tbl_qmd_span( |
| 152 | + content, |
| 153 | + display, |
| 154 | + use_base64 = TRUE |
| 155 | + ) |
| 156 | +} |
| 157 | + |
| 158 | +#' @rdname tbl_qmd_elements |
| 159 | +#' @export |
| 160 | +tbl_qmd_div_base64 <- function( |
| 161 | + content, |
| 162 | + display = NULL |
| 163 | +) { |
| 164 | + tbl_qmd_div(content, display, use_base64 = TRUE) |
| 165 | +} |
| 166 | + |
| 167 | +#' @rdname tbl_qmd_elements |
| 168 | +#' @export |
| 169 | +tbl_qmd_span_raw <- function( |
| 170 | + content, |
| 171 | + display = NULL |
| 172 | +) { |
| 173 | + tbl_qmd_span( |
| 174 | + content, |
| 175 | + display, |
| 176 | + use_base64 = FALSE |
| 177 | + ) |
| 178 | +} |
| 179 | + |
| 180 | +#' @rdname tbl_qmd_elements |
| 181 | +#' @export |
| 182 | +tbl_qmd_div_raw <- function( |
| 183 | + content, |
| 184 | + display = NULL |
| 185 | +) { |
| 186 | + tbl_qmd_div( |
| 187 | + content, |
| 188 | + display, |
| 189 | + use_base64 = FALSE |
| 190 | + ) |
| 191 | +} |
0 commit comments