1get_lang_strings <- function() { 2 lang_strings <- c( 3 de = "Gl\u00fcck", 4 cn = "\u5e78\u798f", 5 ru = "\u0441\u0447\u0430\u0441\u0442\u044c\u0435", 6 ko = "\ud589\ubcf5" 7 ) 8 9 native_lang_strings <- enc2native(lang_strings) 10 11 same <- (lang_strings == native_lang_strings) 12 13 list( 14 same = lang_strings[same], 15 different = lang_strings[!same] 16 ) 17} 18 19get_native_lang_string <- function() { 20 lang_strings <- get_lang_strings() 21 if (length(lang_strings$same) == 0) testthat::skip("No native language string available") 22 lang_strings$same[[1L]] 23} 24 25get_alien_lang_string <- function() { 26 lang_strings <- get_lang_strings() 27 if (length(lang_strings$different) == 0) testthat::skip("No alien language string available") 28 lang_strings$different[[1L]] 29} 30 31try_encoding <- function(enc) { 32 orig_encoding <- Sys.getlocale("LC_CTYPE") 33 on.exit(Sys.setlocale("LC_CTYPE", orig_encoding), add = TRUE) 34 tryCatch({ 35 Sys.setlocale("LC_CTYPE", enc) 36 TRUE 37 }, 38 warning = function(w) FALSE, 39 error = function(e) FALSE 40 ) 41} 42 43non_utf8_encoding <- function(enc = NULL) { 44 if (!l10n_info()$`UTF-8`) { 45 return(Sys.getlocale("LC_CTYPE")) 46 } 47 enc <- enc %||% c( 48 "en_US.ISO8859-1", 49 "en_US.ISO8859-15", 50 "fr_CH.ISO8859-1", 51 "fr_CH.ISO8859-15" 52 ) 53 available <- vapply(enc, try_encoding, logical(1)) 54 if (any(available)) { 55 enc[available][1] 56 } else { 57 NULL 58 } 59} 60 61local_non_utf8_encoding <- function(enc = NULL, env = parent.frame()) { 62 non_utf8 <- non_utf8_encoding(enc) 63 if (is.null(non_utf8)) { 64 skip("Can't set a non-UTF-8 encoding") 65 } else { 66 withr::local_locale(c(LC_CTYPE = non_utf8), .local_envir = env) 67 } 68} 69