Merge branch 'master' into spanner-id-valid-html

R/dt_boxhead.R

@@ -243,21 +243,28 @@ dt_boxhead_get_vars_groups <- function(data) {
 dt_boxhead_get_alignments_in_stub <- function(data) {
 
   stub_layout <- get_stub_layout(data = data)
+  alignments <- NULL
+
+  if ("group_label" %in% stub_layout) {
+    grp_vars <- dt_boxhead_get_vars_groups(data = data)
+    # non-initialized grp_vars
+      grp_alignment <-
+        dt_boxhead_get_alignment_by_var(
+          data = data,
+          var = grp_vars
+        )
 
-  c(
-    if ("group_label" %in% stub_layout) {
-      dt_boxhead_get_alignment_by_var(
-        data = data,
-        dt_boxhead_get_vars_groups(data = data)
-      )
-    },
-    if ("rowname" %in% stub_layout) {
-      dt_boxhead_get_alignment_by_var(
-        data = data,
-        dt_boxhead_get_var_stub(data = data)
-      )
-    }
-  )
+    alignments <- c(alignments, grp_alignment)
+  }
+
+  if ("rowname" %in% stub_layout) {
+    row_alignment <- dt_boxhead_get_alignment_by_var(
+      data = data,
+      dt_boxhead_get_var_stub(data = data)
+    )
+    alignments <- c(alignments, row_alignment)
+  }
+  alignments
 }
 
 dt_boxhead_get_var_by_type <- function(data, type) {

R/dt_groups_rows.R

@@ -56,6 +56,7 @@ dt_groups_rows_build <- function(data, context) {
     table_body <- dt_data_get(data = data)
     stub_df[["rowname"]] <- as.character(table_body[[stub_var]])
   }
+  # what happens if dt_stub_df doesn't exist?
 
   l <- length(ordering)
   groups_rows <-
@@ -94,10 +95,7 @@ dt_groups_rows_build <- function(data, context) {
       dplyr::left_join(groups_rows, group_label_df, by = "group_id")
 
     groups_rows <-
-      dplyr::rename(groups_rows, group_label = "built_group_label")
-
-    groups_rows <-
-      dplyr::relocate(groups_rows, "group_id", "group_label", .before = 0)
+      dplyr::relocate(groups_rows, "group_id", group_label = "built_group_label", .before = 0)
 
     others_group <-
       dt_options_get_value(

R/fmt.R

@@ -152,34 +152,6 @@ fmt <- function(
 
 # Utils formatters -------------------------------------------------------------
 
-#' Filter an internal table to a single row with filtering expressions
-#'
-#' @param table The table to filter down to one row.
-#' @param column The column from which the single value should be obtained.
-#' @param ... The arguments passed to `dplyr::filter()`.
-#' @noRd
-filter_table_to_value <- function(
-    table,
-    column,
-    ...
-) {
-
-  filter_args_enquos <- rlang::enquos(...)
-  column_enquo <- rlang::enquo(column)
-
-  filtered_tbl <- dplyr::filter(table, !!!filter_args_enquos)
-
-  if (nrow(filtered_tbl) != 1) {
-
-    cli::cli_abort(c(
-      "*" = "The filtered table doesn't result in a table of exactly one row.",
-      "*" = "Found {nrow(filtered_tbl)} rows."
-    ), .internal = TRUE)
-  }
-
-  dplyr::pull(filtered_tbl, !!column_enquo)
-}
-
 normalize_locale <- function(locale = NULL) {
 
   # Return NULL if the locale isn't specified
@@ -188,7 +160,7 @@ normalize_locale <- function(locale = NULL) {
   }
 
   # Normalize any underscores to hyphens
-  locale <- gsub("_", "-", locale)
+  locale <- gsub("_", "-", locale, fixed = TRUE)
 
   # Resolve any default locales into their base names (e.g., 'en-US' -> 'en')
   if (locale %in% default_locales$default_locale) {
@@ -238,13 +210,13 @@ validate_currency <- function(currency, call = rlang::caller_env()) {
   currency_char <- as.character(currency)
 
   # Stop function if the `currency` provided isn't a valid one
-  if (
-    !(
-      currency_char %in% currency_symbols$curr_symbol ||
-      currency_char %in% currencies$curr_code ||
-      currency_char %in% currencies$curr_number
-    )
-  ) {
+  valid_currencies <- vctrs::vec_c(
+    currency_symbols$curr_symbol,
+    currencies$curr_code,
+    currencies$curr_number,
+    .ptype = character()
+  )
+  if (!(currency_char %in% valid_currencies)) {
     cli::cli_abort(c(
       "The supplied `currency` is not available in the list of supported currencies.",
       "i" = "Use {.run [info_currencies()](gt::info_currencies())} to see which currencies can be used.",
@@ -279,8 +251,8 @@ get_locale_sep_mark <- function(
   }
 
   # Get the correct `group_sep` value from the `gt:::locales` lookup table
-  sep_mark <- filter_table_to_value(locales, group, locale == {{ locale }})
-
+  sep_mark <- locales$group[locales$locale == locale]
+  validate_length_one(sep_mark)
   # Replace any `""` or "\u00a0" with `" "` since an empty string actually
   # signifies a space character, and, we want to normalize to a simple space
   if (sep_mark == "" || sep_mark == "\u00a0") sep_mark <- " "
@@ -302,7 +274,9 @@ get_locale_dec_mark <- function(locale = NULL, default) {
   }
 
   # Get the correct `decimal` value from the `gt:::locales` lookup table
-  filter_table_to_value(locales, decimal, locale == {{ locale }})
+  val <- locales$decimal[locales$locale == locale]
+  validate_length_one(val, "dec_mark")
+  val
 }
 
 #' Get the range pattern based on a locale
@@ -316,8 +290,8 @@ get_locale_range_pattern <- function(locale = NULL) {
   locale <- locale %||% "en"
 
   # Get the correct `range_pattern` value from the `gt:::locales` lookup table
-  range_pattern <-
-    filter_table_to_value(locales, range_pattern, locale == {{ locale }})
+  range_pattern <- locales$range_pattern[locales$locale == locale]
+  validate_length_one(range_pattern)
 
   range_pattern <- gsub("1", "2", range_pattern)
   range_pattern <- gsub("0", "1", range_pattern)
@@ -336,7 +310,7 @@ get_locale_currency_code <- function(locale = NULL) {
     return("USD")
   }
 
-  locale <- locales[locales$locale == locale, ][["currency_code"]][[1]]
+  locale <- locales$currency_code[locales$locale == locale]
 
   if (is.na(locale)) {
     return("USD")
@@ -357,7 +331,9 @@ get_locale_idx_set <- function(locale = NULL) {
     return(LETTERS)
   }
 
-  locales[locales$locale == locale, ][["chr_index"]][[1L]]
+  val <- locales$chr_index[locales$locale == locale]
+  validate_length_one(val)
+  val
 }
 
 #' Get the `idx_num_spellout` vector based on a locale
@@ -411,7 +387,9 @@ get_locale_no_table_data_text <- function(locale = NULL) {
 
   # Get the correct `no_table_data_text` value from the
   # `gt:::locales` lookup table
-  filter_table_to_value(locales, no_table_data_text, locale == {{ locale }})
+  val <- locales$no_table_data_text[locales$locale == locale]
+  validate_length_one(val)
+  val
 }
 
 get_locale_segments <- function(locale) {
@@ -450,11 +428,13 @@ resolve_locale <- function(data, locale) {
   # An 'undetermined' locale should map back to the `"en"` locale
   if (identical(locale, "und")) {
     locale <- "en"
+  } else {
+    # Validate locale if some value is sent
+    locale <- normalize_locale(locale = locale)
+    validate_locale(locale = locale)
   }
 
-  locale <- normalize_locale(locale = locale)
 
-  validate_locale(locale = locale)
 
   locale
 }

R/format_data.R

@@ -6296,19 +6296,19 @@ values_to_durations <- function(
       colon_sep_trim_zero_units <- colon_sep_params$trim_zero_units
 
       # Filter to only the output units needed
-      x_df_i <- dplyr::filter(x_df_i, time_part %in% colon_sep_output_units)
+      x_df_i <- vctrs::vec_slice(x_df_i, x_df_i$time_part %in% colon_sep_output_units)
 
       # If days has a zero value, remove that entry unconditionally
       if ("days" %in% x_df_i$time_part && x_df_i[[1, "value"]] == 0) {
-        x_df_i <- dplyr::filter(x_df_i, time_part != "days")
+        x_df_i <- vctrs::vec_slice(x_df_i, x_df_i$time_part != "days")
       }
 
       if (colon_sep_trim_zero_units == "leading") {
         if (
           identical(x_df_i$time_part, c("hours", "minutes", "seconds")) &&
           x_df_i[[1, "value"]] == 0
         ) {
-          x_df_i <- dplyr::filter(x_df_i, time_part != "hours")
+          x_df_i <- vctrs::vec_slice(x_df_i, x_df_i$time_part != "hours")
         }
       }
 

R/gt.R

@@ -336,11 +336,12 @@ gt <- function(
   }
 
   # Initialize the main objects
+  rownames_to_column <- if (rownames_to_stub) rowname_col else NA_character_
   data <-
     dt_data_init(
       data = list(),
       data_tbl = data,
-      rownames_to_column = if (rownames_to_stub) rowname_col else NA_character_
+      rownames_to_column = rownames_to_column
     )
 
   data <- dt_boxhead_init(data = data)

R/info_tables.R

@@ -739,32 +739,29 @@ info_locales <- function(begins_with = NULL) {
   if (!is.null(begins_with)) {
 
     starting <- tolower(substr(begins_with, 1, 1))
-    loc <- dplyr::filter(locales, grepl(paste0("^", starting, ".*"), locale))
+    regex_starting <- paste0("^", starting, ".*")
+    loc <- vctrs::vec_slice(locales, grepl(regex_starting, locales$locale))
 
   } else {
     loc <- locales
   }
 
   tab_1 <-
     dplyr::select(
-      loc, locale, lang_desc, script_desc,
-      territory_desc, variant_desc, group, decimal
+      loc, "locale", "lang_desc", "script_desc",
+      "territory_desc", "variant_desc", "group", "decimal"
     )
 
-  tab_1 <-
-    dplyr::mutate(
-      tab_1,
-      display_name = paste0(
-        lang_desc,
-          paste0(
-            " (",
-            territory_desc, ", ",
-            script_desc, ", ",
-            variant_desc,
-            ")"
-          )
-      )
+  tab_1$display_name <- paste0(
+    tab_1$lang_desc,
+    paste0(
+      " (",
+      tab_1$territory_desc, ", ",
+      tab_1$script_desc, ", ",
+      tab_1$variant_desc,
+      ")"
     )
+  )
 
   tab_1$group <-
     dplyr::case_match(
@@ -791,7 +788,7 @@ info_locales <- function(begins_with = NULL) {
     ) %>%
     text_transform(
       fn = function(x) sub("space", "\U02420", x),
-      locations = cells_body(columns = group)
+      locations = cells_body(columns = "group")
     ) %>%
     cols_merge(
       columns = c("locale", "display_name"),

R/summary_rows.R

@@ -384,6 +384,7 @@ summary_rows <- function(
   # Collect all provided formatting options in a list
   formatter_options <- list(...)
 
+
   # Perform a partial build of the table to obtain the current
   # state of `group_id` values in the table; we should not assign this
   # to `data` but to a new object (`data_built`) so that we do not
@@ -393,7 +394,8 @@ summary_rows <- function(
   groups_rows_tbl <- dt_groups_rows_get(data = data_built)
 
   # Pull a character vector of available groups from `groups_rows_tbl`
-  available_groups <- dplyr::pull(groups_rows_tbl, group_id)
+  available_groups <- groups_rows_tbl$group_id
+  check_character(available_groups)
 
   # Resolve the group names
   groups <-
@@ -1028,7 +1030,7 @@ normalize_summary_fns <- function(fns) {
 
 normalize_fmt_fns <- function(fmt) {
 
-  if (is.null(fmt) || length(fmt) < 1) {
+  if (length(fmt) == 0) {
     return(NULL)
   }
 

R/tab_create_modify.R

@@ -1711,16 +1711,14 @@ tab_row_group <- function(
   # Capture the `rows` expression
   row_expr <- rlang::enquo(rows)
 
-  # Get the `stub_df` data frame from `data`
-  stub_df <- dt_stub_df_get(data = data)
-
   # Resolve the row numbers using `resolve_vars()`
   resolved_rows_idx <-
     resolve_rows_i(
       expr = !!row_expr,
       data = data
     )
 
+  # Get the `stub_df` data frame from `data`
   stub_df <- dt_stub_df_get(data = data)
 
   # If the label is marked as HTML or Markdown and there's no `id` set

R/utils_render_html.R

@@ -1446,7 +1446,8 @@ create_body_component_h <- function(data) {
     # needs to be repeated to match the size of the other fields
     group_ids <- vctrs::vec_rep_each(group_ids, times = ns)
     body_rows_data_flat$current_group_id <- group_ids
-
+    ## here we have to make sur the lengths can be recycled to each others.
+    # vctrs::vec_recycle_common()
     body_rows_uncollapsed <- vctrs::vec_chop(
       do.call(render_row_data, body_rows_data_flat),
       sizes = ns