Fix spacing for callout titles

R/utils-translate.R

@@ -293,6 +293,15 @@ tr_computed <- function(key = NULL) {
 }
 
 
+starts_with_whitespace <- function(x) {
+  grepl("^\\s", x)
+}
+
+# Function to check if a string ends with a whitespace
+ends_with_whitespace <- function(x) {
+  grepl("\\s$", x)
+}
+
 # Apply translations to text assuming that the names of the translations
 # matches the text
 apply_translations <- function(txt, translations) {
@@ -302,14 +311,38 @@ apply_translations <- function(txt, translations) {
   if (ntxt == 0L || ntranslations == 0L) {
     return(txt)
   }
+
+  # https://github.com/carpentries/sandpaper/issues/562
+  # check if there is leading or trailing whitespace
+  sw <- starts_with_whitespace(txt)
+  ew <- ends_with_whitespace(txt)
+
+  # replace newlines with spaces and trim whitespace
+  trimmed_txt <- sub("\n", " ", txt)
+  trimmed_txt <- sub("^[[:space:]]+", "", trimmed_txt)
+  trimmed_txt <- sub("[[:space:]]+$", "", trimmed_txt)
+
   # when there are translations, apply them only to the matching elements of
   # the vector
-  to_translate <- txt %in% names(translations)
+  to_translate <- trimmed_txt %in% names(translations)
   if (any(to_translate)) {
-    ids <- txt[to_translate]
-    txt[to_translate] <- translations[ids]
+    ids <- trimmed_txt[to_translate]
+    trimmed_txt[to_translate] <- translations[ids]
+
+    # reintroduce whitespace where there was previously
+    if (any(sw)) {
+      trimmed_txt <- paste0(" ", trimmed_txt)
+    }
+
+    if (any(ew)) {
+      trimmed_txt <- paste0(trimmed_txt, " ")
+    }
+
+    return(trimmed_txt)
+  } else {
+    # return original text if no translations are found
+    return(txt)
   }
-  return(txt)
 }
 
 # generator of translations for code blocks.

R/utils-xml.R

@@ -171,8 +171,7 @@ translate_overview <- function(nodes = NULL) {
 # @param translations a named vector of translated strings whose names are the
 #   strings in English
 xml_text_translate <- function(nodes, translations) {
-  # removes whitespace in order to translate, but need to add it back for nested tags
-  txt <- xml2::xml_text(nodes, trim = TRUE)
+  txt <- xml2::xml_text(nodes, trim = FALSE)
   xml2::xml_set_text(nodes, apply_translations(txt, translations))
   return(invisible(nodes))
 }
@@ -200,12 +199,17 @@ fix_callouts <- function(nodes = NULL) {
   if (length(nodes) == 0) return(nodes)
   # fix for https://github.com/carpentries/sandpaper/issues/470
   callouts <- xml2::xml_find_all(nodes, ".//div[starts-with(@class, 'callout ')] | .//div[@class='callout']")
-  h3 <- xml2::xml_find_all(callouts, "./div/h3")
-  translations <- get_callout_translations()
+
   # https://github.com/carpentries/sandpaper/issues/556
-  h3_text <- xml2::xml_find_all(h3, ".//text()")
+  translations <- get_callout_translations()
+
+  # process only h3 titles with no child tags for translation
+  # https://github.com/carpentries/sandpaper/issues/562
+  h3_translate <- xml2::xml_find_all(callouts, "./div/h3[not(*)]")
+  h3_text <- xml2::xml_find_all(h3_translate, ".//text()")
   xml_text_translate(h3_text, translations)
 
+  h3 <- xml2::xml_find_all(callouts, "./div/h3")
   xml2::xml_set_attr(h3, "class", "callout-title")
   inner_div <- xml2::xml_parent(h3)
   # remove the "section level3 callout-title" attrs

tests/testthat/test-utils-translate.R

@@ -344,6 +344,7 @@ test_that("Lessons can be translated with lang setting", {
   # Instructor note headings should be translated
   xpath_instructor <- ".//div[@class='accordion-item']/button/h3"
   instructor_note <- xml2::xml_find_all(xml, xpath_instructor)
+
   expect_set_translated(instructor_note,
     tr_src("computed", "Instructor Note")
   )
@@ -353,6 +354,7 @@ test_that("Lessons can be translated with lang setting", {
   solution <- xml2::xml_find_all(xml, xpath_solution)
   # take the last solution block because that's the one that does not have
   # a title.
+  # print(solution)
   solution <- solution[[length(solution)]]
 
   expect_set_translated(solution,