Merge branch 'master' into extract-body-enhance

NEWS.md

@@ -59,6 +59,8 @@
 
 * Improved footnote rendering in Quarto with `fmt_markdown()` (@olivroy, #1773)
 
+* Fixed an issue where `md()` and `fmt_markdown()` would render factors as their numeric levels rather than their text labels (@rossellhayes, #1883).
+
 # gt 0.11.0
 
 ## New features

R/dt_spanners.R

@@ -35,7 +35,7 @@ dt_spanners_set <- function(data, spanners) {
 dt_spanners_init <- function(data) {
 
   spanners <-
-    dplyr::tibble(
+    vctrs::data_frame(
       # Column names that are part of the spanner
       vars = list(),
       # The spanner label

R/fmt.R

@@ -552,7 +552,7 @@ format_num_to_str <- function(
     system = c("intl", "ind")
 ) {
 
-  system <- rlang::arg_match(system)
+  system <- rlang::arg_match0(system, c("intl", "ind"))
 
   # If this hardcoding is ever to change, then we need to
   # modify the regexes below
@@ -604,7 +604,7 @@ format_num_to_str <- function(
 
   # Remove `-` for any signed zeros returned by `formatC()`
   x_str_signed_zero <- grepl("^(-0|-0\\.0*?)$", x_str)
-  x_str[x_str_signed_zero] <- gsub("-", "", x_str[x_str_signed_zero])
+  x_str[x_str_signed_zero] <- gsub("-", "", x_str[x_str_signed_zero], fixed = TRUE)
 
   # If a trailing decimal mark is to be retained (not the
   # default option but sometimes desirable), affix the `dec_mark`
@@ -633,7 +633,7 @@ format_num_to_str <- function(
         FUN = insert_seps_ind
       )
 
-    decimal_str <- rep("", length(x_str_numeric))
+    decimal_str <- rep_len("", length(x_str_numeric))
 
     decimal_str[has_decimal] <-
       gsub("^.*?(\\..*)", "\\1", x_str_numeric[has_decimal])
@@ -670,7 +670,7 @@ format_num_to_str_c <- function(
     system = c("intl", "ind")
 ) {
 
-  system <- rlang::arg_match(system)
+  system <- rlang::arg_match0(system, c("intl", "ind"))
 
   format_num_to_str(
     x = x,

R/format_data.R

@@ -9667,6 +9667,10 @@ fmt_markdown <- function(
     rows = {{ rows }},
     fns = list(
       html = function(x) {
+        # Ensure input is x (e.g. for factors)
+        if (!is.character(x)) {
+          x <- as.character(x)
+        }
         process_text(md(x), context = "html")
       },
       latex = function(x) {

R/format_vec.R

@@ -3341,7 +3341,7 @@ vec_fmt_markdown <- function(
 }
 
 gt_one_col <- function(x) {
-  gt(dplyr::tibble(x = x), auto_align = FALSE, process_md = FALSE)
+  gt(data.frame(x = x, stringsAsFactors = FALSE), auto_align = FALSE, process_md = FALSE, groupname_col = NULL)
 }
 
 # Similar as `stop_if_not_vector()` if `valid_classes` is not supplied.

R/helpers.R

@@ -70,7 +70,6 @@
 #'
 #' @export
 md <- function(text) {
-
   # Apply the `from_markdown` class
   class(text) <- "from_markdown"
   text

R/opts.R

@@ -1456,6 +1456,17 @@ opt_table_outline <- function(
 #'   A name that is representative of a font stack (obtained via internally via
 #'   the [system_fonts()] helper function). If provided, this new stack will
 #'   replace any defined fonts and any `font` values will be prepended.
+#' 
+#' @param size *Text size*
+#' 
+#'   `scalar<character|numeric|integer>` // *default:* `NULL` (`optional`)
+#' 
+#'   The text size for the entire table can be set by providing a `size` value.
+#'   Can be specified as a single-length character vector with units of pixels
+#'   (e.g., `12px`) or as a percentage (e.g., `80%`). If provided as a
+#'   single-length numeric vector, it is assumed that the value is given in
+#'   units of pixels. The [px()] and [pct()] helper functions can also be used
+#'   to pass in numeric values and obtain values as pixel or percentage units.
 #'
 #' @param style *Text style*
 #'
@@ -1472,6 +1483,13 @@ opt_table_outline <- function(
 #'   `"normal"`, `"bold"`, `"lighter"`, `"bolder"`, or, a numeric value between
 #'   `1` and `1000`, inclusive. Please note that typefaces have varying support
 #'   for the numeric mapping of weight.
+#' 
+#' @param color *Text color*
+#' 
+#'   `scalar<character>` // *default:* `NULL` (`optional`)
+#' 
+#'   The `color` option defines the text color used throughout the table. A
+#'   color name or a hexadecimal color code should be provided.
 #'
 #' @param add *Add to existing fonts*
 #'
@@ -1522,9 +1540,8 @@ opt_table_outline <- function(
 #'
 #' Use a subset of the [`sp500`] dataset to create a small **gt** table. We'll
 #' use [fmt_currency()] to display a dollar sign for the first row of monetary
-#' values. Then, set a larger font size for the table and use the
-#' `"Merriweather"` font (from *Google Fonts*, via [google_font()]) with two
-#' system font fallbacks (`"Cochin"` and the generic `"serif"`).
+#' values. The `"Merriweather"` font (from *Google Fonts*, via [google_font()])
+#' with two system font fallbacks (`"Cochin"` and the generic `"serif"`).
 #'
 #' ```r
 #' sp500 |>
@@ -1582,8 +1599,10 @@ opt_table_font <- function(
     data,
     font = NULL,
     stack = NULL,
+    size = NULL,
     weight = NULL,
     style = NULL,
+    color = NULL,
     add = TRUE
 ) {
 
@@ -1633,9 +1652,21 @@ opt_table_font <- function(
       )
   }
 
+  if (!is.null(size)) {
+
+    data <-
+      tab_options(
+        data = data,
+        table.font.size = size
+      )
+
+  }
+
   if (!is.null(weight)) {
 
-    if (is.numeric(weight)) weight <- as.character(weight)
+    if (is.numeric(weight)) {
+      weight <- as.character(weight)
+    }
 
     data <-
       tab_options(
@@ -1659,6 +1690,15 @@ opt_table_font <- function(
       )
   }
 
+  if (!is.null(color)) {
+
+    data <-
+      tab_options(
+        data = data,
+        table.font.color = color
+      )
+  }
+
   data
 }
 

R/utils_render_common.R

@@ -471,7 +471,7 @@ perform_col_merge <- function(data, context) {
           }
         )
 
-      glue_src_data <- stats::setNames(glue_src_data, seq_len(length(glue_src_data)))
+      glue_src_data <- stats::setNames(glue_src_data, seq_along(glue_src_data))
 
       glued_cols <- as.character(glue_gt(glue_src_data, pattern))
 

tests/testthat/test-fmt_markdown.R

@@ -235,3 +235,23 @@ test_that("LaTeX formulas render correctly in HTML", {
   # Take a snapshot of `gt_tbl`
   expect_snapshot_html(gt_tbl)
 })
+
+test_that("fmt_markdown() works correctly with factors", {
+
+  text <- "This is Markdown *text*."
+
+  # Create a `gt_tbl` object with `gt()`
+  # and a tibble; format all columns with
+  # `fmt_markdown()`
+  tab <-
+    dplyr::tibble(column_1 = factor(text)) %>%
+    gt() %>%
+    fmt_markdown(columns = everything())
+
+  # Compare output of cell to the expected HTML output strings
+  expect_equal(
+    (tab %>%
+       render_formats_test(context = "html"))[["column_1"]][[1]],
+    "<span class='gt_from_md'>This is Markdown <em>text</em>.</span>"
+  )
+})

tests/testthat/test-opts.R

@@ -340,6 +340,22 @@ test_that("opt_table_font() sets the correct options", {
       "font-weight: bold;",
       "font-style: italic;"
     ) %>% expect_true()
+
+  # Expect that the `size` option is passed as a CSS value
+  tbl %>%
+    opt_table_font(size = px(32)) %>%
+    compile_scss() %>%
+    as.character() %>%
+    html_fragment_within("font-size: 32px;") %>%
+    expect_true()
+
+  # Expect that the `color` option is passed as a CSS value
+  tbl %>%
+    opt_table_font(color = "#228B23") %>%
+    compile_scss() %>%
+    as.character() %>%
+    html_fragment_within("color: #228B23;") %>%
+    expect_true()
 
   # Expect that adding a font from the Google Fonts service
   # is possible with the `google_font()` function