Implement po_create()/po_update() for creating/updating translations (#…

…235)

* Implement tr_add() for adding new translations

* Add or update as necessary

* Only add previous for tr_add()

* Fix typo

* Split tr_add() into po_create() and po_update()

* lang->languages

* lang->languages

* Mark .pot file as UTF-8

* Split po_create() and po_update() into pieces

And fundamentally change approach

* Fix broken tests

* Add test for po_create()

Bringing in system2() code from #257

* WS

* Extract out local_test_package() helper

* Extract & test po_language_files()

* Add tests for create and update

And fix the bugs thus revealed

* Add missing line

* might as well use fifelse

* Add links to solaris docs

* Revert unintentional change

* Move local_test_package() to better home

* Revert CHARSET -> UTF-8 change

* More docs about updating

* Standardise number of dots

* Improve docs

* Tweak messaging

* Revert accidental doc changes

* add TODO

* another TODO

* typo

* clarify fuzzy description

* comment need for standardise_dots & americanize 🇺🇸

Co-authored-by: Michael Chirico <[email protected]>

NAMESPACE

@@ -10,8 +10,10 @@ export(check_untranslated_cat)
 export(check_untranslated_src)
 export(get_message_data)
 export(po_compile)
+export(po_create)
 export(po_extract)
 export(po_metadata)
+export(po_update)
 export(translate_package)
 export(write_po_file)
 importFrom(data.table,"%chin%")

R/msgmerge.R

@@ -1,8 +1,20 @@
 # split off from tools::update_pkg_po() to only run the msgmerge & checkPoFile steps
-run_msgmerge = function(po_file, pot_file) {
-  if (system(sprintf("msgmerge --update %s %s", po_file, shQuote(pot_file))) != 0L) {
+
+# https://www.gnu.org/software/gettext/manual/html_node/msgmerge-Invocation.html
+# https://docs.oracle.com/cd/E36784_01/html/E36870/msgmerge-1.html#scrolltoc
+run_msgmerge <- function(po_file, pot_file, previous = FALSE, verbose = TRUE) {
+  args <- c(
+    "--update", shQuote(path.expand(po_file)),
+    if (previous) "--previous", #show previous match for fuzzy matches
+    shQuote(path.expand(pot_file))
+  )
+
+  val <- system2("msgmerge", args, stdout = TRUE, stderr = TRUE)
+  if (!identical(attr(val, "status", exact = TRUE), NULL)) {
     # nocov these warnings? i don't know how to trigger them as of this writing.
-    warningf("Running msgmerge on '%s' failed.", po_file)
+    warningf("Running msgmerge on './po/%s' failed:\n  %s", basename(po_file), paste(val, collapse = "\n"))
+  } else if (verbose) {
+    messagef(paste(val, collapse = "\n"))
   }
 
   res <- tools::checkPoFile(po_file, strictPlural = TRUE)
@@ -54,3 +66,23 @@ update_en_quot_mo_files <- function(dir, verbose) {
   }
   return(invisible())
 }
+
+# https://www.gnu.org/software/gettext/manual/html_node/msginit-Invocation.html
+# https://docs.oracle.com/cd/E36784_01/html/E36870/msginit-1.html#scrolltoc
+run_msginit <- function(po_path, pot_path, locale, width = 80, verbose = TRUE) {
+  args <- c(
+    "-i", shQuote(path.expand(pot_path)),
+    "-o", shQuote(path.expand(po_path)),
+    "-l", shQuote(locale),
+    "-w", width,
+    "--no-translator" # don't consult user-email etc
+  )
+  val <- system2("msginit", args, stdout = TRUE, stderr = TRUE)
+  if (!identical(attr(val, "status", exact = TRUE), NULL)) {
+    stopf("Running msginit on '%s' failed", pot_path)
+  } else if (verbose) {
+    messagef(paste(val, collapse = "\n"))
+  }
+  return(invisible())
+}
+

R/po_compile.R

@@ -55,11 +55,13 @@ get_po_metadata <- function(dir = ".", package = NULL) {
 
   mo_names <- gsub(lang_regex, sprintf("\\1%s.mo", package), basename(po_paths))
   mo_paths <- file.path(dir, "inst", "po", languages, "LC_MESSAGES", mo_names)
+  pot_paths <- pot_paths(dir, type, package = package)
 
   data.table(
     language = languages,
     type = type,
     po = po_paths,
+    pot = pot_paths,
     mo = mo_paths
   )
 }

R/po_create.R

@@ -0,0 +1,64 @@
+#' Create a new `.po` file
+#'
+#' @description
+#' `po_create()` creates a new `po/{languages}.po` containing the messages to be
+#' translated.
+#'
+#' Generally, we expect you to use `po_create()` to create new `.po` files
+#' but if you call it with an existing translation, it will update it with any
+#' changes from the `.pot`. See [po_update()] for details.
+#'
+#' @param languages Language identifiers. These are typically two letters (e.g.
+#'   "en" = English, "fr" = French, "es" = Spanish, "zh" = Chinese), but
+#'   can include an additional suffix for languages that have regional
+#'   variations (e.g. "fr_CN" = French Canadian, "zh_CN" = simplified
+#'   characters as used in mainland China, "zh_TW" = traditional characters
+#'   as used in Taiwan.)
+#' @inheritParams po_extract
+#' @export
+po_create <- function(languages, dir = ".", verbose = !is_testing()) {
+  package <- get_desc_data(dir, "Package")
+  po_files <- po_language_files(languages, dir)
+
+  for (ii in seq_len(nrow(po_files))) {
+    row <- po_files[ii]
+    if (file.exists(row$po_path)) {
+      if (verbose) messagef("Updating '%s' %s translation", row$language, row$type)
+      run_msgmerge(row$po_path, row$pot_path, previous = TRUE, verbose = verbose)
+    } else {
+      if (verbose) messagef("Creating '%s' %s translation", row$language, row$type)
+      run_msginit(row$po_path, row$pot_path, locale = row$language, verbose = verbose)
+    }
+  }
+
+  invisible(po_files)
+}
+
+# TODO: make sure this works with translating/updating base, which
+#   has the anti-pattern that src translations are in R.pot, not base.pot.
+po_language_files <- function(languages, dir = ".") {
+  po_files <- data.table::CJ(type = pot_types(dir), language = languages)
+  po_files[, "po_path" := file.path(dir, "po", paste0(po_prefix(po_files$type), po_files$language, ".po"))]
+  po_files[, "pot_path" := pot_paths(dir, po_files$type)]
+  po_files[]
+}
+
+# TODO: should this be po_paths, with a template=TRUE/FALSE argument?
+pot_paths <- function(dir, type, package = NULL) {
+  if (is.null(package)) {
+    package <- get_desc_data(dir, "Package")
+  }
+  if (length(type) == 0) {
+    character()
+  } else {
+    file.path(dir, "po", paste0(po_prefix(type), package, ".pot"))
+  }
+
+}
+po_prefix <- function(type = c("R", "src")) {
+  data.table::fifelse(type == "R", "R-", "")
+}
+pot_types <- function(dir = ".") {
+  types <- c("R", "src")
+  types[file.exists(pot_paths(dir, types))]
+}

R/po_extract.R

@@ -1,34 +1,17 @@
 #' Extract messages for translation into a `.pot` file
 #'
+#' @description
 #' `po_extract()` scans your package for strings to be translated and
 #' saves them into a `.pot` template file (in the package's `po`
 #' directory). You should never modify this file by hand; instead modify the
 #' underlying source code and re-run `po_extract()`.
 #'
+#' If you have existing translations, call [po_update()] after [po_extract()]
+#' to update them with the changes.
 #'
-#' @param dir Character, default the present directory; a directory in which an
-#' R package is stored.
-#' @param custom_translation_functions A `list` with either/both of two
-#' components, `R` and `src`, together governing how to extract any
-#' non-standard strings from the package.
-#'
-#' See Details in [`translate_package()`][translate_package].
-#' @param verbose Logical, default `TRUE` (except during testing). Should
-#' extra information about progress, etc. be reported?
-#' @param style Translation style, either `"base"` or `"explict"`.
-#' The default, `NULL`, reads from the `DESCRIPTION` field
-#' `Config/potools/style` so you can specify the style once for your
-#' package.
-#'
-#' Both styles extract strings explicitly flagged for translation with
-#' `gettext()` or `ngettext()`. The base style additionally extracts
-#' strings in calls to `stop()`, `warning()`, and `message()`,
-#' and to `stopf()`, `warningf()`, and `messagef()` if you have
-#' added those helpers to your package. The explicit style also accepts
-#' `tr_()` as a short hand for `gettext()`. See
-#' `vignette("developer")` for more details.
-#' @return The extracted messages as computed by
-#' [`get_message_data()`][get_message_data], invisibly.
+#' @returns The extracted messages as computed by [get_message_data()],
+#'   invisibly.
+#' @inheritParams get_message_data
 #' @export
 po_extract <- function(
     dir = ".",

R/po_update.R

@@ -0,0 +1,45 @@
+#' Update all `.po` files with changes in `.pot`
+#'
+#' @description
+#' `po_update()` updates existing `.po` file after the `.pot` file has changed.
+#' There are four cases:
+#'
+#' * New messages: added with blank `msgstr`.
+#'
+#' * Deleted messages: marked as deprecated and moved to the bottom of the file.
+#'
+#' * Major changes to existing messages: appear as an addition and a deletion.
+#'
+#' * Minor changes to existing messages: will be flagged as fuzzy.
+#'
+#'     ```
+#'     #, fuzzy, c-format
+#'     #| msgid "Generating en@quot translations"
+#'     msgid "Updating '%s' %s translation"
+#'     msgstr "en@quot翻訳生成中。。。"
+#'     ```
+#'
+#'     The previous message is given in comments starting with `#|`.
+#'     Translators need to update the actual (uncommented) `msgstr` manually,
+#'     using the old `msgid` as a potential reference, then
+#'     delete the old translation and the `fuzzy` comment (c-format should
+#'     remain, if present).
+#'
+#' @inheritParams po_extract
+#' @param lazy If `TRUE`, only `.po` files that are older than their
+#'   corresponding `.pot` file will be updated.
+#' @export
+po_update <- function(dir = ".", lazy = TRUE, verbose = !is_testing()) {
+  meta <- get_po_metadata(dir)
+  if (lazy) {
+    meta <- meta[is_outdated(meta$po, meta$pot)]
+  }
+
+  for (ii in seq_len(nrow(meta))) {
+    row <- meta[ii]
+    if (verbose) messagef("Updating '%s' %s translation", row$language, row$type)
+    run_msgmerge(row$po, row$pot, previous = TRUE, verbose = verbose)
+  }
+
+  invisible(meta)
+}

tests/testthat/_snaps/po_create.md

@@ -0,0 +1,16 @@
+# the user is told what's happening
+
+    Code
+      po_create("jp", verbose = TRUE)
+    Message <simpleMessage>
+      Creating 'jp' R translation
+      Created ./po/R-jp.po.
+
+---
+
+    Code
+      po_create("jp", verbose = TRUE)
+    Message <simpleMessage>
+      Updating 'jp' R translation
+      . done.
+

tests/testthat/_snaps/po_update.md

@@ -0,0 +1,10 @@
+# user is told what's happening
+
+    Code
+      po_update(verbose = TRUE, lazy = FALSE)
+    Message <simpleMessage>
+      Updating 'fr' R translation
+      . done.
+      Updating 'ja' R translation
+      . done.
+

tests/testthat/helpers.R

@@ -48,3 +48,25 @@ expect_messages = function(expr, msgs, ..., invert=FALSE) {
 
 test_package = function(pkg) test_path(file.path("test_packages", pkg))
 mock_translation = function(mocks) test_path(file.path("mock_translations", mocks))
+
+local_test_package <- function(..., .envir = parent.frame()) {
+  temp <- withr::local_tempdir(.local_envir = .envir)
+  writeLines(con = file.path(temp, "DESCRIPTION"), c(
+    "Package: test",
+    "Version: 1.0.0"
+  ))
+  dir_create(file.path(temp, c("po", "R")))
+
+  files <- list(...)
+  for (i in seq_along(files)) {
+    writeLines(files[[i]], file.path(temp, names(files)[[i]]))
+  }
+
+  temp
+}
+
+# different platforms/installations of gettext apparently
+#   produce a different number of "." in "progress" output; normalize
+standardize_dots <- standardise_dots <- function(x) {
+  gsub("\\.{2,}", ".", x)
+}

tests/testthat/test-po_compile.R

@@ -1,11 +1,16 @@
 # metadata ----------------------------------------------------------------
 
 test_that("can find R and src translations", {
-  temp <- withr::local_tempdir()
-  dir.create(file.path(temp, "po"))
+  temp <- local_test_package()
   file.create(file.path(temp, "po", c("R-en.po", "en.po")))
 
-  meta <- withr::with_dir(temp, get_po_metadata(package = "test"))
+  meta <- withr::with_dir(temp, get_po_metadata())
   expect_equal(meta$language, c("en", "en"))
   expect_setequal(meta$type, c("R", "src"))
 })
+
+test_that("get_po_metadata() returns 0 rows if no .po fles", {
+  temp <- local_test_package()
+  meta <- get_po_metadata(temp)
+  expect_equal(nrow(meta), 0)
+})