Merge pull request #560 from carpentries/finalise-translate-tests

finalise translate tests

NEWS.md

@@ -13,6 +13,11 @@
 * Translations now live in the global environment called `these$translations`
 * A new documentation page called `?translate` contains details of how
   translations of template elements are rendered.
+- `tr_src()` helper function provides access to the source strings of the
+  translations.
+- `tr_get()`, `tr_varnish()`, and `tr_computed()` helper functions provide
+  access top the lists of translated strings. These have replaced the `tr_()`
+  strings at the point of generation.
 
 # sandpaper 0.16.1 (2023-12-14)
 

R/build_404.R

@@ -54,7 +54,7 @@ build_404 <- function(pkg, quiet = FALSE) {
   this_dat <- list(
     this_page = "404.html",
     body = html,
-    pagetitle = these$translations$computed$PageNotFound
+    pagetitle = tr_computed("PageNotFound")
   )
   page_globals$instructor$update(this_dat)
   page_globals$learner$update(this_dat)

R/build_aio.R

@@ -3,7 +3,7 @@ build_aio <- function(pkg, pages = NULL, quiet = FALSE) {
   build_agg_page(
     pkg = pkg,
     pages = pages,
-    title = these$translations$computed$AllInOneView,
+    title = tr_computed("AllInOneView"),
     slug = "aio",
     aggregate = "*",
     prefix = TRUE,

R/build_episode.R

@@ -131,7 +131,7 @@ get_nav_data <- function(path_md, path_src = NULL, home = NULL,
   pf_title <- NULL
 
   if (!is.null(page_back)) {
-    trhome <- these$translations$varnish$Home
+    trhome <- tr_varnish("Home")
     pb_title <- if (page_back == "index.md") trhome else get_trimmed_title(page_back)
     page_back <- as_html(page_back)
   }

R/build_home.R

@@ -46,7 +46,7 @@ build_home <- function(pkg, quiet, next_page = NULL) {
   needs_title <- nav$pagetitle == ""
 
   if (needs_title) {
-    nav$pagetitle <- these$translations$computed$SummaryAndSchedule
+    nav$pagetitle <- tr_computed("SummaryAndSchedule")
   }
   nav$page_forward <- as_html(nav$page_forward, instructor = TRUE)
   page_globals$instructor$update(nav)
@@ -55,7 +55,7 @@ build_home <- function(pkg, quiet, next_page = NULL) {
   page_globals$instructor$set("setup", use_instructor(setup))
 
   if (needs_title) {
-    nav$pagetitle <- these$translations$computed$SummaryAndSetup
+    nav$pagetitle <- tr_computed("SummaryAndSetup")
   }
   nav$page_forward <- as_html(nav$page_forward)
   page_globals$learner$update(nav)
@@ -98,7 +98,7 @@ format_syllabus <- function(syl, use_col = TRUE) {
   }
   td1 <- glue::glue(td_template, cls = "col-md-2", thing = syl$timings)
   td2 <- glue::glue(td_template, cls = "col-md-3",
-    thing = c(links, these$translations$computed$Finish))
+    thing = c(links, tr_computed("Finish")))
   td3 <- glue::glue(td_template, cls = "col-md-7", thing = syl$questions)
   out <- glue::glue_collapse(glue::glue("<tr>{td1}{td2}{td3}</tr>"), sep = "\n")
   tmp <- tempfile(fileext = ".md")

R/build_images.R

@@ -3,7 +3,7 @@ build_images <- function(pkg, pages = NULL, quiet = FALSE) {
   build_agg_page(
     pkg = pkg,
     pages = pages,
-    title = these$translations$computed$AllImages,
+    title = tr_computed("AllImages"),
     slug = "images",
     aggregate = "/img/..",
     prefix = FALSE,
@@ -47,7 +47,7 @@ make_images_section <- function(name, contents, parent) {
     alt <- xml2::xml_text(xml2::xml_find_all(content, "./img/@alt"))
     n <- length(alt)
     xml2::xml_add_child(section, "h3",
-      glue::glue(these$translations$computed$Figure),
+      glue::glue(tr_computed("Figure")),
       id = glue::glue("{name}-figure-{element}")
     )
     for (i in seq_along(alt)) {
@@ -58,7 +58,7 @@ make_images_section <- function(name, contents, parent) {
       if (txt == "") {
         txt <- "[decorative]"
       }
-      desc <- glue::glue(these$translations$computed$ImageOf)
+      desc <- glue::glue(tr_computed("ImageOf"))
       xml2::xml_add_child(section, "p", "aria-hidden" = "true", desc)
     }
     xml2::xml_add_child(section, contents[[element]])

R/build_instructor_notes.R

@@ -24,7 +24,7 @@ build_instructor_notes <- function(pkg, pages = NULL, built = NULL, quiet) {
     this_dat <- list(
       this_page = "instructor-notes.html",
       body = use_instructor(html),
-      pagetitle = these$translations$varnish$InstructorNotes
+      pagetitle = tr_varnish("InstructorNotes")
     )
 
     page_globals$instructor$update(this_dat)
@@ -135,7 +135,7 @@ make_instructor_note_linkback <- function(node, name) {
   title <- trimws(xml2::xml_text(node))
   id <- xml2::xml_attr(node, "id")
   newid <- glue::glue("{name}-{id}")
-  tranchor <- these$translations$computed$Anchor
+  tranchor <- tr_computed("Anchor")
   anchor <- glue::glue("<a class='anchor' aria-label='{tranchor}' href='#{newid}'></a>")
   new <- "<h3><a href='{name}.html#{id}'>{title}</a>{anchor}</h3>"
   node <- xml2::read_xml(glue::glue(new))

R/build_keypoints.R

@@ -3,7 +3,7 @@ build_keypoints <- function(pkg, pages = NULL, quiet = FALSE) {
   build_agg_page(
     pkg = pkg,
     pages = pages,
-    title = these$translations$varnish$KeyPoints,
+    title = tr_varnish("KeyPoints"),
     slug = "key-points",
     aggregate = "/div[starts-with(@id, 'keypoints')]/div[@class='callout-inner']/div[@class='callout-content']/*",
     prefix = FALSE,

R/build_profiles.R

@@ -13,7 +13,7 @@ build_profiles <- function(pkg, quiet) {
   this_dat <- list(
     this_page = "profiles.html",
     body = use_instructor(html),
-    pagetitle = these$translations$varnish$LearnerProfiles
+    pagetitle = tr_varnish("LearnerProfiles")
   )
   page_globals$instructor$update(this_dat)
 

R/utils-translate.R

@@ -1,5 +1,8 @@
-
 #' Establish and Manage Translation Strings
+#' 
+#' This is documentation for internal functions for translation. If you want a
+#' guide to providing translations, please read `vignette("translations",
+#' package = "sandpaper")`
 #'
 #' @details A page generated from {sandpaper} is made up of user-provided
 #'   content wrapped into templated HTML provided by {varnish}. Since users can
@@ -33,15 +36,27 @@
 #'
 #' @aliases translations
 #' @rdname translations
+#' @seealso [known_languages()] for a list of known language codes.
 #' @keywords internal
 #' @examples
+#' # When sandpaper is loaded, these functions return English
 #' snd <- asNamespace("sandpaper")
-#' snd$these$translations$varnish
-#' snd$these$translations$computed
+#' head(snd$tr_varnish())
+#' head(snd$tr_computed())
+#'
+#' # Setting language to Spanish will translate the computed and varnish
 #' snd$set_language("es")
-#' snd$these$translations$computed
-#' snd$set_language() # defaults to English
-#' snd$these$translations$computed
+#' head(snd$tr_varnish())
+#' head(snd$tr_computed())
+#'
+#' # The source will remain the same
+#' head(snd$tr_src("varnish"))
+#' head(snd$tr_src("computed"))
+#'
+#' # Running set_language with no arguments defaults to English
+#' snd$set_language() 
+#' head(snd$tr_varnish())
+#' head(snd$tr_computed())
 these <- new.env(parent = emptyenv())
 
 #' @rdname translations
@@ -165,6 +180,13 @@ establish_translation_vars <- function() {
     src = list(varnish = varnish, computed = computed),
     varnish = varnish,
     computed = computed
+    # NOTE: If you want to include translations for messages to the user in
+    # their own language, they could be added to this list and then the
+    # message functions (e.g. those in R/utils-cli.R) could use
+    # a key from these$translations$msg
+    # msg = list(
+    #   RemovedFile = tr_("Removed {what}"),
+    # )
   )
 }
 
@@ -195,6 +217,7 @@ add_varnish_translations <- function() {
   these$translations$varnish <- lapply(to_translate$varnish, tr_)
   these$translations$computed <- lapply(to_translate$computed, tr_)
 }
+
 #' Show a list of languages known by {sandpaper}
 #'
 #' @return a character vector of language codes known by {sandpaper}
@@ -212,6 +235,8 @@ add_varnish_translations <- function() {
 #' writeLines(paste("-", langs))
 #' ```
 #'
+#' @seealso `vignette("translations", package = "sandpaper")` for an overview
+#'   of providing translations.
 #' @export
 #' @examples
 #' known_languages()
@@ -229,6 +254,44 @@ is_known_language <- function(lang = NULL, warn = FALSE) {
   return(!not_known)
 }
 
+#' @param from a single character specifying the translation list to fetch.
+#'   This defaults to "varnish" but can be one of the following:
+#'   ```{r echo = FALSE, results = "asis"}
+#'   writeLines(paste("-", names(these$translations)))
+#'   ```
+#' @param key a single character specifying a specific key to fetch from the
+#'   translation list. This defaults to `NULL`, returning the whole list.
+#' @return if `key = NULL`, a list if `key` is a single character, the result
+#'   will be an unnamed character vector of length 1 representing the value from
+#'   that list.
+#' @rdname translations
+tr_src <- function(from = "varnish", key = NULL) {
+  res <- these$translations$src[[from]]
+  if (length(key) == 1L) {
+    res <- res[[key]]
+  }
+  return(res)
+}
+
+#' @rdname translations
+tr_get <- function(from = "varnish", key = NULL) {
+  res <- these$translations[[from]]
+  if (length(key) == 1L) {
+    res <- res[[key]]
+  }
+  return(res)
+}
+
+#' @rdname translations
+tr_varnish <- function(key = NULL) {
+  tr_get(from = "varnish", key = key)
+}
+
+#' @rdname translations
+tr_computed <- function(key = NULL) {
+  tr_get(from = "computed", key = key)
+}
+
 
 # Apply translations to text assuming that the names of the translations
 # matches the text
@@ -254,7 +317,7 @@ get_codeblock_translations <- function() {
   needed <- c("OUTPUT",
     "ERROR",
     "WARNING")
-  unlist(these$translations$computed[needed])
+  unlist(tr_computed()[needed])
 }
 
 # generator for translations of callout blocks and accordions
@@ -266,7 +329,7 @@ get_callout_translations <- function() {
     "Discussion",
     "Testimonial",
     "Keypoints")
-  unlist(these$translations$computed[needed])
+  unlist(tr_computed()[needed])
 }
 
 get_accordion_translations <- function() {
@@ -275,7 +338,7 @@ get_accordion_translations <- function() {
     "Show details",
     "Instructor Note"
   )
-  unlist(these$translations$computed[needed])
+  unlist(tr_computed()[needed])
 }
 
 # replace text string with a <(kirby template)> with link text

R/utils-varnish.R

@@ -86,15 +86,15 @@ set_globals <- function(path) {
   idx_text <- xml2::xml_contents(idx_link)
   no_index_title <- length(idx_text) == 1 && xml2::xml_text(idx_text) == "0. "
   if (no_index_title) {
-    xml2::xml_set_text(idx_link, these$translations$computed$SummaryAndSchedule)
+    xml2::xml_set_text(idx_link, tr_computed("SummaryAndSchedule"))
   } else {
     xml2::xml_set_text(idx_text, sub("^0[.] ", "", xml2::xml_text(idx_text)))
   }
   sindex <- create_sidebar_item(nodes = NULL, as.character(idx_link), 1)
   learner_sidebar <- instructor_sidebar
   instructor_sidebar[[1]] <- sindex
   if (no_index_title) {
-    xml2::xml_set_text(idx_link, these$translations$computed$SummaryAndSetup)
+    xml2::xml_set_text(idx_link, tr_computed("SummaryAndSetup"))
     sindex <- create_sidebar_item(nodes = NULL, as.character(idx_link), 1)
   }
   learner_sidebar[[1]] <- sindex
@@ -115,7 +115,7 @@ set_globals <- function(path) {
       sidebar = learner_sidebar,
       more = paste(learner$extras, collapse = ""),
       resources = paste(learner$resources, collapse = ""),
-      translate = these$translations$varnish
+      translate = tr_varnish()
     ), pkg_versions)
   )
   instructor_globals$set(key = NULL,
@@ -125,7 +125,7 @@ set_globals <- function(path) {
       sidebar = instructor_sidebar,
       more = paste(instructor$extras, collapse = ""),
       resources = paste(instructor$resources, collapse = ""),
-      translate = these$translations$varnish
+      translate = tr_varnish()
     ), pkg_versions)
   )
 }

R/utils-xml.R

@@ -130,7 +130,7 @@ add_class <- function(nodes, new) {
 }
 
 add_anchors <- function(nodes, ids) {
-  tranchor <- these$translations$computed$Anchor
+  tranchor <- tr_computed("Anchor")
   anchor <- paste0(
     "<a class='anchor' aria-label='", tranchor, "' href='#", ids, "'></a>"
   )
@@ -158,7 +158,7 @@ translate_overview <- function(nodes = NULL) {
   opath <- ".//div[starts-with(@class, 'inner')]/h3[@class='card-title'][text()='Objectives']"
   questions <- xml2::xml_find_first(card, qpath)
   objectives <- xml2::xml_find_first(card, opath)
-  translated <- these$translations$computed
+  translated <- tr_computed()
 
   xml2::xml_set_text(questions, translated[["Questions"]])
   xml2::xml_set_text(objectives, translated[["Objectives"]])

man/children/translation-vars.Rmd

@@ -1,20 +1,20 @@
-There are `r length(asNamespace("sandpaper")$these$translations$src$varnish)` translations generated by
+There are `r length(asNamespace("sandpaper")$tr_src("varnish"))` translations generated by
 `set_language()` that correspond to the following variables in {varnish}:
 
 ```{r translation-list, results = "asis", echo = FALSE}
 snd <- asNamespace("sandpaper")
 res <- glue::glue("| `translate.{names(tr)}` | `{sQuote(tr, q = 2)}` |", 
-  tr = snd$these$translations$src$varnish)
+  tr = snd$tr_src("varnish"))
 writeLines(c("| variable | string |\n| --- | --- |", res))
 ```
 
-In addition, there are `r length(asNamespace("sandpaper")$these$translations$src$computed)` translations
+In addition, there are `r length(asNamespace("sandpaper")$tr_src("computed"))` translations
 that are inserted _before_ they get to {varnish}:
 
 ```{r translation-list-computed, results = "asis", echo = FALSE}
 snd <- asNamespace("sandpaper")
 res <- glue::glue("| `{names(tr)}` | `{sQuote(tr, q = 2)}` |", 
-  tr = snd$these$translations$src$computed)
+  tr = snd$tr_src("computed"))
 writeLines(c("| variable | string |\n| --- | --- |", res))
 ```