WIP: Add Support for Translations

DESCRIPTION

@@ -97,6 +97,7 @@ LazyData: true
 Config/testthat/edition: 3
 Config/testthat/parallel: false
 Config/Needs/check: rstudio/renv
+Config/potools/style: explicit
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 URL: https://carpentries.github.io/sandpaper/, https://github.com/carpentries/sandpaper/, https://carpentries.github.io/workbench/

R/build_404.R

@@ -54,7 +54,7 @@ build_404 <- function(pkg, quiet = FALSE) {
   this_dat <- list(
     this_page = "404.html",
     body = html,
-    pagetitle = "Page not found"
+    pagetitle = tr_("Page not found")
   )
   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 = "All in One View",
+    title = tr_("All in One View"),
     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)) {
-    pb_title <- if (page_back == "index.md") "Home" else get_trimmed_title(page_back)
+    pb_title <- if (page_back == "index.md") tr_("Home") else get_trimmed_title(page_back)
     page_back <- as_html(page_back)
   }
   if (!is.null(page_forward)) {

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 <- "Summary and Schedule"
+    nav$pagetitle <- tr_("Summary and Schedule")
   }
   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 <- "Summary and Setup"
+    nav$pagetitle <- tr_("Summary and Setup")
   }
   nav$page_forward <- as_html(nav$page_forward)
   page_globals$learner$update(nav)
@@ -97,7 +97,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, "Finish"))
+  td2 <- glue::glue(td_template, cls = "col-md-3", thing = c(links, tr_("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 = "All Images",
+    title = tr_("All Images"),
     slug = "images",
     aggregate = "/img/..",
     prefix = FALSE,

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 = "Instructor Notes"
+      pagetitle = tr_("Instructor Notes")
     )
 
     page_globals$instructor$update(this_dat)

R/build_keypoints.R

@@ -3,7 +3,7 @@ build_keypoints <- function(pkg, pages = NULL, quiet = FALSE) {
   build_agg_page(
     pkg = pkg,
     pages = pages,
-    title = "Key Points",
+    title = tr_("Key Points"),
     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 = "Learner Profiles"
+    pagetitle = tr_("Learner Profiles")
   )
   page_globals$instructor$update(this_dat)
 

R/build_site.R

@@ -31,6 +31,7 @@ build_site <- function(path = ".", quiet = !interactive(), preview = TRUE, overr
   # Here we provision our website using pkgdown and either initialise it if it
   # does not exist or update the CSS, HTML, and JS if it does exist.
   pkg <- pkgdown::as_pkgdown(path_site(path), override = override)
+  pkg <-  section_init(pkg, depth = 0, override = override)
   built_path <- fs::path(pkg$src_path, "built")
   # NOTE: This is a kludge to prevent pkgdown from displaying a bunch of noise
   #       if the user asks for quiet.

R/utils-potools.R

@@ -0,0 +1,3 @@
+tr_ <- function(...) {
+  enc2utf8(gettext(paste0(...), domain = "R-sandpaper"))
+}

R/utils-translate.R

@@ -0,0 +1,71 @@
+local_envvar_pkgdown <- function(pkg, scope = parent.frame()) {
+  withr::local_envvar(
+    IN_PKGDOWN = "true",
+    LANGUAGE = pkg$meta$template$params$lang,
+    .local_envir = scope
+  )
+}
+
+section_init <- function(
+  pkg, depth, override = list(), .frame = parent.frame()) {
+  pkg <- pkgdown::as_pkgdown(pkg, override = override)
+
+  rstudio_save_all()
+  local_envvar_pkgdown(pkg, .frame)
+  local_options_link(pkg, depth = depth, .frame = .frame)
+
+  pkg
+}
+
+rstudio_save_all <- function() {
+  if (
+    rlang::is_installed("rstudioapi") &&
+      rstudioapi::hasFun("documentSaveAll")) {
+    rstudioapi::documentSaveAll()
+  }
+}
+
+local_options_link <- function(pkg, depth, .frame = parent.frame()) {
+  article_index <- article_index(pkg)
+  rdname <- get_rdname(pkg$topics)
+  topic_index <- unlist(invert_index(
+    purrr::set_names(pkg$topics$alias, rdname)))
+
+  withr::local_options(
+    list(
+      downlit.package = pkg$package,
+      downlit.article_index = article_index,
+      downlit.topic_index = topic_index,
+      downlit.article_path = paste0(up_path(depth), "articles/"),
+      downlit.topic_path = paste0(up_path(depth), "reference/")
+    ),
+    .local_envir = .frame
+  )
+}
+
+article_index <- function(pkg) {
+  purrr::set_names(
+    fs::path_rel(pkg$vignettes$file_out, "articles"),
+    fs::path_file(pkg$vignettes$name)
+  )
+}
+
+get_rdname <- function(topics) {
+  gsub("\\.[Rr]d$", "", topics$file_in)
+}
+
+invert_index <- function(x) {
+  stopifnot(is.list(x))
+
+  if (length(x) == 0)
+    return(list())
+
+  key <- rep(names(x), purrr::map_int(x, length))
+  val <- unlist(x, use.names = FALSE)
+
+  split(key, val)
+}
+
+up_path <- function(depth) {
+  paste(rep.int("../", depth), collapse = "")
+}

po/R-ja.po

@@ -0,0 +1,52 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: sandpaper 0.14.1.9000\n"
+"POT-Creation-Date: 2023-11-22 15:19+0900\n"
+"PO-Revision-Date: 2023-11-22 09:14+0900\n"
+"Last-Translator: Automatically generated\n"
+"Language-Team: none\n"
+"Language: ja\n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+"Plural-Forms: nplurals=1; plural=0;\n"
+
+#: build_404.R:57
+msgid "Page not found"
+msgstr "ページが見つかりません"
+
+#: build_aio.R:6
+msgid "All in One View"
+msgstr "一つにまとまったバージョン"
+
+#: build_episode.R:134
+msgid "Home"
+msgstr "ホーム"
+
+#: build_home.R:49
+msgid "Summary and Schedule"
+msgstr "概要とスケジュール"
+
+#: build_home.R:58
+msgid "Summary and Setup"
+msgstr "概要とセットアップ"
+
+#: build_home.R:100
+msgid "Finish"
+msgstr "終わり"
+
+#: build_images.R:6
+msgid "All Images"
+msgstr "全ての画像"
+
+#: build_instructor_notes.R:27
+msgid "Instructor Notes"
+msgstr "インストラクター用のメモ"
+
+#: build_keypoints.R:6
+msgid "Key Points"
+msgstr "まとめ"
+
+#: build_profiles.R:16
+msgid "Learner Profiles"
+msgstr "学習者プロフィール"

po/R-sandpaper.pot

@@ -0,0 +1,51 @@
+msgid ""
+msgstr ""
+"Project-Id-Version: sandpaper 0.14.1.9000\n"
+"POT-Creation-Date: 2023-11-22 15:19+0900\n"
+"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
+"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
+"Language-Team: LANGUAGE <[email protected]>\n"
+"Language: \n"
+"MIME-Version: 1.0\n"
+"Content-Type: text/plain; charset=UTF-8\n"
+"Content-Transfer-Encoding: 8bit\n"
+
+#: build_404.R:57
+msgid "Page not found"
+msgstr ""
+
+#: build_aio.R:6
+msgid "All in One View"
+msgstr ""
+
+#: build_episode.R:134
+msgid "Home"
+msgstr ""
+
+#: build_home.R:49
+msgid "Summary and Schedule"
+msgstr ""
+
+#: build_home.R:58
+msgid "Summary and Setup"
+msgstr ""
+
+#: build_home.R:100
+msgid "Finish"
+msgstr ""
+
+#: build_images.R:6
+msgid "All Images"
+msgstr ""
+
+#: build_instructor_notes.R:27
+msgid "Instructor Notes"
+msgstr ""
+
+#: build_keypoints.R:6
+msgid "Key Points"
+msgstr ""
+
+#: build_profiles.R:16
+msgid "Learner Profiles"
+msgstr ""

tests/testthat/test-translate.R

@@ -0,0 +1,38 @@
+# Generate temporary lesson and set `lang: ja` in config.yaml
+tmp <- res <- restore_fixture()
+config_path <- fs::path(tmp, "config.yaml")
+config <- yaml::read_yaml(config_path)
+config$lang <- "ja"
+yaml::write_yaml(config, config_path)
+metadata_json <- trimws(create_metadata_jsonld(tmp))
+sitepath <- fs::path(tmp, "site", "docs")
+
+test_that("Lessons can be translated with lang setting", {
+
+  skip_if_not(rmarkdown::pandoc_available("2.11"))
+
+  # Build lesson
+  suppressMessages(build_lesson(tmp, preview = FALSE, quiet = FALSE))
+
+  # Extract first header (Summary and Setup) from index
+  index <- readLines(fs::path(sitepath, "index.html"))
+  xml <- xml2::read_html(paste(index, collapse = ""))
+  h1_header <- xml2::xml_find_all(xml, "//h1[@class='schedule-heading']")
+
+  # Header should be translated to Japanese
+  expect_true(
+    identical(
+      xml2::xml_text(h1_header),
+      withr::with_language("ja", tr_("Summary and Setup"))
+    )
+  )
+
+  # Header should no longer be in English
+  expect_false(
+    identical(
+      xml2::xml_text(h1_header),
+      withr::with_language("en", tr_("Summary and Setup"))
+    )
+  )
+
+})