re-export rlang::enquo()

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: jmvcore
 Type: Package
 Title: Dependencies for the 'jamovi' Framework
-Version: 1.8.1
-Date: 2021-05-02
+Version: 2.3
+Date: 2021-10-21
 Author: Jonathon Love
 Maintainer: Jonathon Love <[email protected]>
 Description: A framework for creating rich interactive analyses for the jamovi
@@ -25,5 +25,6 @@ Suggests:
     knitr,
     ggplot2,
     RColorBrewer,
-    ragg
+    ragg,
+    fastmap
 RoxygenNote: 6.1.1

NAMESPACE

@@ -16,6 +16,7 @@ S3method(length,Array)
 S3method(length,Group)
 S3method(names,Array)
 S3method(names,Group)
+export(.)
 export(Analysis)
 export(Array)
 export(Cell.BEGIN_END_GROUP)

R/analysis.R

@@ -156,6 +156,9 @@ Analysis <- R6::R6Class('Analysis',
             private$.parent <- NULL
             private$.addons <- list()
         },
+        translate=function(text, n=1) {
+            private$.options$translate(text, n)
+        },
         check=function(checkValues=FALSE, checkVars=FALSE, checkData=FALSE) {
             private$.options$check(
                 checkValues=checkValues,

R/column.R

@@ -77,8 +77,8 @@ Column <- R6::R6Class("Column",
             private$.options <- options
 
             private$.name <- name
-            private$.title <- title
-            private$.superTitle <- superTitle
+            private$.title <- options$translate(title)
+            private$.superTitle <- options$translate(superTitle)
             if (identical(visible, TRUE))
                 private$.visibleExpr <- NULL
             else

R/i18n.R

@@ -0,0 +1,89 @@
+
+.i18n <- new.env()
+
+#' @export
+. <- function(text, n=1) {
+    self <- eval.parent(str2lang('self'))
+    self$options$translate(text, n)
+}
+
+Translator <- R6Class('Translator',
+    private=list(
+        .table=NA
+    ),
+    public=`if`(requireNamespace('fastmap'),
+        list(
+            initialize=function(langDef) {
+                private$.table <- fastmap::fastmap()
+                if (length(langDef) > 0) {
+                    messages <- langDef$locale_data$messages
+                    messages <- messages[names(messages) != ""]
+                    private$.table$mset(.list=messages)
+                }
+            },
+            translate=function(text, n=1) {
+                if (is.null(text) || text == '')
+                    return(text)
+                result <- private$.table$get(text)
+                if ( ! is.null(result)) {
+                    result <- result[[1]]
+                    if (result != '')
+                        text <- result
+                }
+                text
+            }
+        ),
+        list(
+            initialize=function(langDef) {
+                if (length(langDef) == 0) {
+                    private$.table <- list()
+                } else {
+                    private$.table <- langDef$locale_data$messages
+                }
+            },
+            translate=function(text, n=1) {
+                if (is.null(text) || text == '')
+                    return(text)
+                result <- private$.table[[text]]
+                if ( ! is.null(result)) {
+                    result <- result[[1]]
+                    if (result != '')
+                        text <- result
+                }
+                text
+            }
+        )
+    )
+)
+
+createTranslator <- function(package, code='en') {
+
+    if (package %in% names(.i18n)) {
+        packageEnv <- .i18n[[package]]
+    } else {
+        .i18n[[package]] <- packageEnv <- new.env()
+    }
+
+    if (code == 'C')
+        code <- 'en'
+
+    code2 = substring(code, 1, 2)
+
+    if (code %in% names(packageEnv)) {
+        langDef <- packageEnv[[code]]
+    } else if (code2 %in% names(packageEnv)) {
+        langDef <- packageEnv[[code2]]
+    } else {
+        path <- system.file(sprintf('i18n/%s.json', code), package=package)
+        path2 <- system.file(sprintf('i18n/%s.json', code2), package=package)
+        if (path != '') {
+            langDef <- packageEnv[[code]] <- jsonlite::read_json(path)
+        } else if (path2 != '') {
+            langDef <- packageEnv[[code2]] <- jsonlite::read_json(path2)
+        } else {
+            langDef <- packageEnv[[code2]] <- list()  # not available
+        }
+    }
+
+    Translator$new(langDef)
+}

R/options.R

@@ -5,13 +5,17 @@ Options <- R6::R6Class(
     "Options",
     private=list(
         .analysis=NA,
+        .package=NA,
+        .name=NA,
         .options=NA,
         .pb=NA,
         .env=NA,
         .ppi=72,
         .theme='default',
         .palette='jmv',
-        .requiresData=TRUE),
+        .lang='',
+        .requiresData=TRUE,
+        .translator=NA),
     active=list(
         analysis=function(analysis) {
             if (missing(analysis))
@@ -40,14 +44,17 @@ Options <- R6::R6Class(
         palette=function() private$.palette,
         options=function() private$.options),
     public=list(
-        initialize=function(requiresData=TRUE, ...) {
+        initialize=function(package, name, requiresData=TRUE, ...) {
 
+            private$.package <- package
+            private$.name <- name
             private$.requiresData <- requiresData
 
             private$.analysis <- NULL
             private$.options <- list()
             private$.env <- new.env()
             private$.pb <- NULL
+            private$.translator <- NULL
 
             args <- list(...)
             if ('.ppi' %in% names(args))
@@ -76,6 +83,24 @@ Options <- R6::R6Class(
         values=function() {
             private$.env
         },
+        translate=function(text, n=1) {
+
+            if (is.null(private$.translator)) {
+                if (private$.lang == '') {
+                    code <- Sys.getenv('LANGUAGE')
+                    if (code == '') {
+                        locale <- Sys.getlocale('LC_MESSAGES')
+                        code <- strsplit(locale, '.', fixed=TRUE)[[1]][1]
+                        if (is.null(code))
+                            code <- 'en'
+                    }
+                    private$.lang <- code
+                }
+                private$.translator <- createTranslator(private$.package, private$.lang)
+            }
+
+            private$.translator$translate(text, n)
+        },
         eval=function(value, ...) {
 
             if (class(value) == "character") {
@@ -158,17 +183,20 @@ Options <- R6::R6Class(
 
                 } else if (grepl('^`.*`$', value)) {
 
+                    value <- self$translate(value)
                     value <- substring(value, 2, nchar(value)-1)
                     formatStr <- function(...) format(str=value, ...)
                     value <- do.call(formatStr, as.list(private$.env))
 
                 } else {
 
                     nch <- nchar(value)
-                    if ( ! is.na(suppressWarnings(as.numeric(value))))
+                    if ( ! is.na(suppressWarnings(as.numeric(value)))) {
                         value <- as.numeric(value)
-                    else
+                    } else {
+                        value <- self$translate(value)
                         value <- jmvcore::format(value, ...)
+                    }
 
                     if (is.character(value))
                         Encoding(value) <- 'UTF-8'
@@ -245,6 +273,8 @@ Options <- R6::R6Class(
                     private$.theme <- value
                 } else if (name == 'palette') {
                     private$.palette <- value
+                } else if (name == '.lang') {
+                    private$.lang <- value
                 } else if (name %in% names(private$.options)) {
                     private$.options[[name]]$value <- value
                     private$.env[[name]] <- private$.options[[name]]$value

R/table-fold.R

@@ -32,6 +32,7 @@ fold <- function(input) {
         return(input)
 
     output <- Table$new(
+        options=input$options,
         name=input$name,
         title=input$title)
 

R/utils.R

@@ -306,14 +306,9 @@ decomposeFormula <- function(formula) {
     decomposeTerms(components)
 }
 
-#' rlang::enquo
-#' Simplifies things so packages overriding Analysis don't need
-#' to have rlang in their imports.
-#' This is intended for use by classes overriding Analysis
-#' @param arg the argument to enquote
-#' @return the quosure
+#' @importFrom rlang enquo
 #' @export
-enquo <- rlang::enquo
+rlang::enquo
 
 #' Evaluates a quosure
 #' This is intended for use by classes overriding Analysis