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

NAMESPACE

@@ -11,8 +11,10 @@ export(translate_package)
 export(get_message_data)
 export(write_po_file, po_metadata)
 
-export(po_extract)
 export(po_compile)
+export(po_create)
+export(po_extract)
+export(po_update)
 
 export(check_cracked_messages, check_untranslated_cat, check_untranslated_src)
 

R/msgmerge.R

@@ -1,16 +1,23 @@
 # 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
+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("Running msgmerge on './po/%s' succeeded:\n  %s", basename(po_file), paste(val, collapse = "\n"))
   }
 
-  res <- tools::checkPoFile(po_file, strictPlural = TRUE)
-  if (nrow(res)) {
-    warningf("tools::checkPoFile() found some issues in %s", po_file)
-    print(res)
-  }
-  return(invisible())
+  tools::checkPoFile(po_file, strictPlural = TRUE)
+  invisible()
 }
 
 run_msgfmt = function(po_file, mo_file, verbose) {
@@ -54,3 +61,22 @@ update_en_quot_mo_files <- function(dir, verbose) {
   }
   return(invisible())
 }
+
+# https://www.gnu.org/software/gettext/manual/html_node/msginit-Invocation.html
+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("Running msgint on './po/%s' succeeded:\n  %s", basename(po_path), paste(val, collapse = "\n"))
+  }
+  return(invisible())
+}
+

R/po_compile.R

@@ -6,8 +6,8 @@
 #'
 #' @param dir Path to package root directory.
 #' @param package Name of package. If not supplied, read from `DESCRIPTION`.
-#' @param lazy If `TRUE`, only `.mo` functions that are older than `.po`
-#'   files be updated
+#' @param lazy If `TRUE`, only `.mo` files that are older than their
+#'   corresponding `.po` file will be updated.
 #' @param verbose If `TRUE`, print information as it goes.
 po_compile = function(dir = ".", package = NULL, lazy = TRUE, verbose = TRUE) {
   po_metadata <- get_po_metadata(dir = dir, package = package)
@@ -52,11 +52,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,58 @@
+#' Create a new `.po` file
+#'
+#' `po_create()` creates a new `po/{languages}.po` containing the messages to be
+#' translated. If a translation already exists, it'll be updated with any
+#' changes to the `.pot` since it was last touched.
+#'
+#' @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
+#' @seealso [po_update()] to update all `.po` files with changes from the
+#'   `.pot`.
+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)
+}
+
+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[]
+}
+
+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")) {
+  ifelse(type == "R", "R-", "")
+}
+pot_types <- function(dir = ".") {
+  types <- c("R", "src")
+  types[file.exists(pot_paths(dir, types))]
+}

R/po_extract.R

@@ -1,10 +1,14 @@
 #' 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.
+#'
 #' @returns The extracted messages as computed by [get_message_data()],
 #'   invisibly.
 #' @inheritParams get_message_data

R/po_update.R

@@ -0,0 +1,25 @@
+#' Update all `.po` files with changes in `.pot`
+#'
+#' `po_update()` updates existing `.po` file after the `.pot` file has changed.
+#' The translations for existing messages are preserved; new messages are added;
+#' and translations for deleted message are marked as deprecated and moved to
+#' the bottom of the file.
+#'
+#' @inheritParams po_extract
+#' @param lazy If `TRUE`, only `.po` files that are older than their
+#'   corresponding `.pot` file will be updated
+#' @rdname po_create
+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)
+  }
+
+  invisible(meta)
+}

R/utils.R

@@ -167,3 +167,19 @@ is_outdated <- function(src, dst) {
 }
 
 is_testing = function() identical(Sys.getenv("TESTTHAT"), "true")
+
+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
+}

R/write_po_file.R

@@ -300,7 +300,7 @@ format.po_metadata = function(x, template = FALSE, use_plurals = FALSE, ...) {
     x$email = "EMAIL@ADDRESS"
     x$language = ''
     x$language_team = "LANGUAGE <[email protected]>"
-    x$charset = 'CHARSET'
+    x$charset = 'UTF-8'
   }
   if (is.character(x$copyright)) {
     x$copyright = list(years = format(x$pot_timestamp, "%Y"), holder = x$copyright)

po/R-potools.pot

@@ -8,7 +8,7 @@ msgstr ""
 "Language-Team: LANGUAGE <[email protected]>\n"
 "Language: \n"
 "MIME-Version: 1.0\n"
-"Content-Type: text/plain; charset=CHARSET\n"
+"Content-Type: text/plain; charset=UTF-8\n"
 "Content-Transfer-Encoding: 8bit\n"
 
 #: find_fuzzy_messages.R:6

tests/testthat/_snaps/po_create.md

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

tests/testthat/_snaps/po_update.md

@@ -0,0 +1,12 @@
+# user is told what's happening
+
+    Code
+      po_update(verbose = TRUE, lazy = FALSE)
+    Message <simpleMessage>
+      Updating 'fr' R translation
+      Running msgmerge on './po/R-fr.po' succeeded:
+        . done.
+      Updating 'ja' R translation
+      Running msgmerge on './po/R-ja.po' succeeded:
+        . done.
+

tests/testthat/test-po_compile.R

@@ -1,11 +1,15 @@
 # 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", {
+  meta <- get_po_metadata(temp)
+  expect_equal(nrow(meta), 0)
+})

tests/testthat/test-po_create.R

@@ -0,0 +1,28 @@
+test_that("the user is told what's happening", {
+  temp <- local_test_package()
+  file.create(file.path(temp, "po", "R-test.pot"))
+
+  withr::local_dir(temp)
+  expect_snapshot(po_create("jp", verbose = TRUE))
+  expect_snapshot(po_create("jp", verbose = TRUE))
+})
+
+test_that("can generate both R and src pot files", {
+  temp <- local_test_package()
+  file.create(file.path(temp, "po", c("R-test.pot", "test.pot")))
+
+  expect_equal(pot_types(temp), c("R", "src"))
+
+  files <- withr::with_dir(temp, po_language_files("en"))
+  expect_equal(files$type, c("R", "src"))
+  expect_equal(files$po_path, file.path(".", "po", c("R-en.po", "en.po")))
+  expect_equal(files$pot_path, file.path(".", "po", c("R-test.pot", "test.pot")))
+})
+
+test_that("can create multiple languages", {
+  temp <- local_test_package()
+  file.create(file.path(temp, "po", c("R-test.pot", "test.pot")))
+
+  files <- withr::with_dir(temp, po_language_files(c("en", "jp", "ar")))
+  expect_equal(nrow(files), 6)
+})

tests/testthat/test-po_update.R

@@ -0,0 +1,9 @@
+test_that("user is told what's happening", {
+  temp <- local_test_package("R/test.r" = "message('Hello')")
+  withr::local_dir(temp)
+
+  po_extract()
+  po_create(c("ja", "fr"))
+
+  expect_snapshot(po_update(verbose = TRUE, lazy = FALSE))
+})

tests/testthat/test-write-po-file.R

@@ -12,7 +12,7 @@ test_that("po_metadata constructor & methods work", {
     format(metadata, template = TRUE),
     c(
       '"Language-Team: LANGUAGE <[email protected]>\\n"',
-      '"Content-Type: text/plain; charset=CHARSET\\n"',
+      '"Content-Type: text/plain; charset=UTF-8\\n"',
       '# SOME DESCRIPTIVE TITLE.',
       '# This file is distributed under the same license as the R package.',
       '# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.'