#' 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
#' provide content in any human language that can be processed by computer,
#' {sandpaper} must have a method to match the template content to the
#' language of the content. These translations are added to the source of
#' {sandpaper} by volunteers using the {potools} package.
#'
#' Template content strings are stored in the `$translations` element of the
#' `these` global environment variable, which is generated by the
#' `establish_translation_vars()` function, which is run every time
#' {sandpaper} is loaded. The `$translations` element consists of three
#' lists:
#'
#' - `varnish`: a list of translated strings that are passed directly
#' to {varnish}
#' - `computed`: a list of translated strings that are incorporated into
#' the HTML content before it is passed to {varnish}.
#' - `src`: a source list of the above two lists that serves as the source
#' of the translations.
#'
#' Whenever a lesson is built, the function `set_language()` will read the
#' `lang` item from the `config.yaml` and apply translations to
#' `these$translations$varnish` and `these$translations$computed` before the
#' lesson is generated or updated.
#'
#' ## List of Translation Variables
#'
#' ```{r, child="man/children/translation-vars.Rmd"}
#' ```
#'
#' @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")
#' head(snd$tr_varnish())
#' head(snd$tr_computed())
#'
#' # Setting language to Spanish will translate the computed and varnish
#' snd$set_language("es")
#' 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
#' @keywords internal
establish_translation_vars <- function() {
# Create central list of elements to translate. This function is called in
# the zzz.R file and establishes a central list of translation variables that
# are used to generate the website.
withr::with_language("en", {
varnish <- list(
# Keys and values that are known by {varnish}. They are passed directly
# via pkgdown::render_page() and represented in {varnish} by
# the key translate.VarName
# header.html -----------------------------------------------------------
SkipToMain = tr_('Skip to main content'),# alt text
iPreAlpha = tr_('Pre-Alpha'),
PreAlphaNote = tr_('This lesson is in the pre-alpha phase, which means that it is in early development, but has not yet been taught.'),
AlphaNote = tr_('This lesson is in the alpha phase, which means that it has been taught once and lesson authors are iterating on feedback.'),
iAlpha = tr_('Alpha'),
BetaNote = tr_('This lesson is in the beta phase, which means that it is ready for teaching by instructors outside of the original author team.'),
iBeta = tr_('Beta'),
PeerReview = tr_('This lesson has passed peer review.'),
InstructorView = tr_('Instructor View'), # navbar.html
LearnerView = tr_('Learner View'), # navbar.html
MainNavigation = tr_('Main Navigation'), # alt text
ToggleNavigation = tr_('Toggle Navigation'), # alt-text
Menu = tr_('Menu'), # footer.html
SearchButton = tr_('Search the All In One page'), # alt text
Setup = tr_('Setup'), # navbar.html
KeyPoints = tr_("Key Points"), # navbar.html
InstructorNotes = tr_('Instructor Notes'), # navbar.html
Glossary = tr_('Glossary'), # navbar.html
LearnerProfiles = tr_('Learner Profiles'), # navbar.html
More = tr_('More'),
# Search = tr_('Search'),
LessonProgress = tr_('Lesson Progress'), # alt text
# navbar.html -----------------------------------------------------------
CloseMenu = tr_("close menu"), # alt text
EPISODES = tr_('EPISODES'),
Home = tr_('Home'), # content-chapter.html
HomePageNav = tr_('Home Page Navigation'), # alt text
RESOURCES = tr_('RESOURCES'),
ExtractAllImages = tr_('Extract All Images'),
AIO = tr_("See all in one page"),
DownloadHandout = tr_('Download Lesson Handout'),
ExportSlides = tr_('Export Chapter Slides'), # content-chapter.html
# content-[thing].html --------------------------------------------------
PreviousAndNext = tr_('Previous and Next Chapter'), # alt text
Previous = tr_('Previous'),
EstimatedTime = tr_('Estimated time: {icons$clock} {minutes} minutes'),
Next = tr_('Next'),
NextChapter = tr_('Next Chapter'), # alt-text
LastUpdate = tr_('Last updated on {updated}'),
EditThisPage = tr_('Edit this page'),
ExpandAllSolutions = tr_('Expand All Solutions'),
# content-syllabus.html -------------------------------------------------
SetupInstructions = tr_('Setup Instructions'),
DownloadFiles = tr_('Download files required for the lesson'),
ActualScheduleNote = tr_('The actual schedule may vary slightly depending on the topics and exercises chosen by the instructor.'),
# footer.html -----------------------------------------------------------
BackToTop = tr_('Back To Top'),
SpanToTop = tr_('<(Back)> To Top'),
ThisLessonCoC = tr_('This lesson is subject to the <(Code of Conduct)>'),
CoC = tr_('Code of Conduct'),
EditOnGH = tr_('Edit on GitHub'),
Contributing = tr_('Contributing'),
Source = tr_('Source'),
Cite = tr_('Cite'),
Contact = tr_('Contact'),
About = tr_('About'),
MaterialsLicensedUnder = tr_('Materials licensed under {license} by {authors}'),
TemplateLicense = tr_('Template licensed under <(CC-BY 4.0)> by {template_authors}'),
Carpentries = tr_('The Carpentries'),
BuiltWith = tr_('Built with {sandpaper_link}, {pegboard_link}, and {varnish_link}'),
# javascript -----------------------------------------------------------
ExpandAllSolutions = tr_('Expand All Solutions'),
CollapseAllSolutions = tr_('Collapse All Solutions'),
Collapse = tr_('Collapse'),
Episodes = tr_('Episodes'),
# beta content not used anymore.
GiveFeedback = tr_('Give Feedback'),
LearnMore = tr_('Learn More')
)
computed <- list(
# These keys and values are used in {sandpaper}
# before they are passed to {varnish}
# Code blocks ----------------------------------------------------------
OUTPUT = tr_("OUTPUT"),
WARNING = tr_("WARNING"),
ERROR = tr_("ERROR"),
# Callouts -------------------------------------------------------------
Overview = tr_("Overview"),
Questions = tr_("Questions"),
Objectives = tr_("Objectives"),
Callout = tr_("Callout"),
Challenge = tr_("Challenge"),
Prereq = tr_("Prerequisite"),
Checklist = tr_("Checklist"),
Discussion = tr_("Discussion"),
Testimonial = tr_("Testimonial"),
Keypoints = varnish$KeyPoints,
# Accordions -----------------------------------------------------------
"Show me the solution" = tr_("Show me the solution"),
"Give me a hint" = tr_("Give me a hint"),
"Show details" = tr_("Show details"),
"Instructor Note" = tr_("Instructor Note"),
# Headings -------------------------------------------------------------
SummaryAndSetup = tr_("Summary and Setup"),
SummaryAndSchedule = tr_("Summary and Schedule"),
AllInOneView = tr_("All in One View"),
PageNotFound = tr_("Page not found"),
AllImages = tr_("All Images"),
# Misc -----------------------------------------------------------------
Anchor = tr_("anchor"), # alt text
Figure = tr_("Figure {element}"),
ImageOf = tr_("Image {i} of {n}: {sQuote(txt)}"),
Finish = tr_("Finish") # end of schedule
)
})
these$translations <- list(
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}"),
# )
)
}
#' @param lang a two-letter language code (optionally with a country code).
#' Defaults to `NULL`, which falls back to English (the language of the
#' source code).
#' @rdname translations
set_language <- function(lang = NULL) {
lang <- lang %||% "en"
known <- is_known_language(lang, warn = TRUE)
if (known) {
withr::with_language(lang, {
add_varnish_translations()
})
}
no_translations_exist <- length(these$translations$varnish) == 0L
if (no_translations_exist) {
withr::with_language("en", {
add_varnish_translations()
})
}
}
# These are all the translations that occur in {varnish}
# NOTE: this assumes a specific language context
add_varnish_translations <- function() {
to_translate <- these$translations$src
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}
#'
#' @details The known languages are translations of menu and navigational
#' elements that exist in {sandpaper}. If these elements have not been
#' translated for a given language and you would like to add translations for
#' them, please consult `vignette("translations", package = "sandpaper")` for
#' details of how to do so in the source code for {sandpaper}.
#'
#' ## List of Known Languages:
#'
#' ```{r, echo = FALSE}
#' langs <- known_languages()
#' writeLines(paste("-", langs))
#' ```
#'
#' @seealso `vignette("translations", package = "sandpaper")` for an overview
#' of providing translations.
#' @export
#' @examples
#' known_languages()
known_languages <- function() {
lang_files <- system.file("po", package = "sandpaper")
as.character(c("en", fs::path_file(fs::dir_ls(lang_files, type = "dir"))))
}
is_known_language <- function(lang = NULL, warn = FALSE) {
lang <- lang %||% "en"
not_known <- strsplit(lang, "_")[[1]][1] %nin% known_languages()
if (not_known && warn) {
warn_no_language(lang)
}
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
apply_translations <- function(txt, translations) {
ntxt <- length(txt)
ntranslations <- length(translations)
# empty text or empty translations returns the text
if (ntxt == 0L || ntranslations == 0L) {
return(txt)
}
# when there are translations, apply them only to the matching elements of
# the vector
to_translate <- txt %in% names(translations)
if (any(to_translate)) {
ids <- txt[to_translate]
txt[to_translate] <- translations[ids]
}
return(txt)
}
# generator of translations for code blocks.
get_codeblock_translations <- function() {
needed <- c("OUTPUT",
"ERROR",
"WARNING")
unlist(tr_computed()[needed])
}
# generator for translations of callout blocks and accordions
get_callout_translations <- function() {
needed <- c("Callout",
"Challenge",
"Prereq",
"Checklist",
"Discussion",
"Testimonial",
"Keypoints")
unlist(tr_computed()[needed])
}
get_accordion_translations <- function() {
needed <- c("Show me the solution",
"Give me a hint",
"Show details",
"Instructor Note"
)
unlist(tr_computed()[needed])
}
# replace text string with a <(kirby template)> with link text
# replace_link("this string has a <(kirby template)>", "https://emojicombos.com/kirby")
replace_link <- function(txt, href) {
replace_html(txt, open = paste0('<a href="', href, '">'), close = "</a>")
}
replace_html <- function(txt, open, close) {
txt <- sub("<(", open, txt, fixed = TRUE)
return(sub(")>", close, txt, fixed = TRUE))
}
#' Apply template items to translated strings
#'
#' @param the_data a list of global variables (either `learner_globals` or
#' `instructor_globals`) that also contains a "translate" element containing
#' a list of translated strings.
#'
#' @return the translated list with templated data filled out
#' @keywords internal
#' @details There are two kinds of templating we use:
#'
#' 1. variable templating indicated by `{key}` where `key` represents a
#' variable that exists within the global data and is replaced.
#' 2. link templating indicated by `<(text to wrap)>` where we replace the
#' `<()>` with a known URL or HTML markup. This allows the translators to
#' translate text without having to worry about HTML markup.
#' @examples
#'
#' dat <- list(
#' a = "a barn",
#' b = "a bee",
#' minutes = 5,
#' translate = list(
#' one = "a normal translated string (pretend it's translated from another language)",
#' two = "a question: are you (A) {a}, (B) {b}",
#' EstimatedTime = "Estimated time: {icons$clock} {minutes}",
#' license = "Licensed under {license} by {authors}",
#' ThisLessonCoC = "This lesson operates under our <(Code of Conduct)>"
#' )
#' )
#' asNamespace("sandpaper")$fill_translation_vars(dat)
fill_translation_vars <- function(the_data) {
# define icons that we will need to pre-fab insert for the template.
icns <- c("clock", "edit")
template_icns <- glue::glue(
'<i aria-hidden="true" data-feather="{icns}"></i>'
)
# add our templating variables to the data list
named_icons <- as.list(template_icns)
names(named_icons) <- icns
dat <- c(the_data,
list(
icons = named_icons,
template_authors = '<a href="https://carpentries.org/">The Carpentries</a>',
authors = "the authors",
license = the_data$license %||% "CC-BY 4.0",
minutes = the_data$minutes %||% NULL,
updated = the_data$updated %||% NULL
)
)
# variables that have known fixed URLs can simply have them added in.
dat$license <- glue::glue('<a href="LICENSE.html">{dat$license}</a>')
translated <- the_data[["translate"]]
# all translated items need to have variables replaced and the URL templates
# filled out.
for (key in names(translated)) {
the_string <- translated[[key]]
is_templated <- grepl("[{][A-z_$.]+?[}]", the_string)
if (is_templated) {
# if the string has a template variable {key}, it should be replaced
# via {glue}.
the_string <- glue::glue_data(dat, the_string)
}
string_exists <- length(the_string) > 0L
has_url_template <- string_exists && grepl("<(", the_string, fixed = TRUE)
if (has_url_template) {
# In this space, we need to replace links present in the URL template
# with their URLs
# (e.g. going from `<(hello)>` to `<a href="hello.html">hello</a>`)
the_string <- switch(key,
ThisLessonCoC = replace_link(the_string,
href = "CODE_OF_CONDUCT.html"
),
TemplateLicense = replace_link(the_string,
href = "https://creativecommons.org/licenses/by-sa/4.0/"
),
SpanToTop = replace_html(the_string,
open = '<span class="d-none d-sm-none d-md-none d-lg-none d-xl-block">',
close = '</span>'
),
the_string
)
}
translated[[key]] <- the_string
}
return(translated)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.