Implement with_language() and local_language() (#180)

Uses LC_MESSAGES to reset cache on windows, and warns in two scenarios where setting the LANGUAGE will fail to have any effect.

DESCRIPTION

@@ -57,7 +57,7 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Collate: 
     'local_.R'
     'with_.R'
@@ -71,6 +71,7 @@ Collate:
     'dir.R'
     'env.R'
     'file.R'
+    'language.R'
     'libpaths.R'
     'locale.R'
     'makevars.R'

NAMESPACE

@@ -16,6 +16,7 @@ export(local_environment)
 export(local_envvar)
 export(local_file)
 export(local_jpeg)
+export(local_language)
 export(local_libpaths)
 export(local_locale)
 export(local_makevars)
@@ -53,6 +54,7 @@ export(with_environment)
 export(with_envvar)
 export(with_file)
 export(with_jpeg)
+export(with_language)
 export(with_libpaths)
 export(with_locale)
 export(with_makevars)

NEWS.md

@@ -1,5 +1,8 @@
 # withr (development version)
 
+* New `with_language()` and `local_language()` to temporarily control the
+  language used for translations (#180).
+
 * `with_seed()` now caches the check for R version, so is now faster (#170)
 
 * `with_makevars()` and `local_makevars()` now eagerly evaluate the `path` argument (#169)

R/language.R

@@ -0,0 +1,48 @@
+#' Language
+#'
+#' Temporarily change the language used for translations.
+#'
+#' @param lang A BCP47 language code like "en" (English), "fr" (French),
+#'   "fr_CA" (French Canadian). Formally, this is a lower case two letter
+#'   [ISO 639 country code](https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes),
+#'   optionally followed by a "_" and an upper case two letter
+#'   [ISO 3166 region code](https://en.wikipedia.org/wiki/ISO_3166-2).
+#' @inheritParams with_collate
+#' @export
+#' @examples
+#' with_language("en", try(mean[[1]]))
+#' with_language("fr", try(mean[[1]]))
+#' with_language("es", try(mean[[1]]))
+with_language <- function(lang, code) {
+  local_language(lang)
+  code
+}
+
+#' @export
+#' @rdname with_language
+local_language <- function(lang, .local_envir = parent.frame()) {
+  if (!has_nls()) {
+    warning("Changing language has no effect when R installed without NLS")
+  }
+
+  # > Note: The variable LANGUAGE is ignored if the locale is set to ‘C’.
+  # > In other words, you have to first enable localization, by setting LANG
+  # > (or LC_ALL) to a value other than ‘C’, before you can use a language
+  # > priority list through the LANGUAGE variable.
+  # --- https://www.gnu.org/software/gettext/manual/html_node/The-LANGUAGE-variable.html
+  if (identical(Sys.getenv("LANG"), "C")) {
+    warning("Changing language has no effect when envvar LANG='C'")
+  }
+
+  local_envvar(LANGUAGE = lang, .local_envir = .local_envir)
+  if (Sys.info()[["sysname"]] != "Windows") {
+    # Reset cache to avoid gettext() retrieving cached value from a previous
+    # language. I think this works because Sys.setlocale() calls setlocale()
+    # which https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=931456 claims
+    # resets the cache. So if there's some OS/setup that this technique fails
+    # on, we might try bindtextdomain() instead or as well.
+    local_locale(c(LC_MESSAGES = ""), .local_envir = .local_envir)
+  }
+}
+
+has_nls <- function() capabilities("NLS")[[1]]

tests/testthat/test-language.R

@@ -0,0 +1,14 @@
+test_that("can temporary change language", {
+  skip_if_not(has_nls())
+
+  expect_error(with_language("en", mean[[1]]), "not subsettable")
+  expect_error(with_language("fr", mean[[1]]), "non indi\u00e7able")
+  expect_error(with_language("es", mean[[1]]), "no es subconjunto")
+})
+
+test_that("warns if LANG=C", {
+  skip_if_not(has_nls())
+
+  local_envvar(LANG = "C")
+  expect_warning(with_language("en", "x"), "has no effect")
+})