Merge pull request rstudio#537 from yihui/bugfix/native-encoding

Use native encoding internally

Author: yihui

R/app.R

@@ -112,9 +112,7 @@ shinyAppDir <- function(appDir, options=list()) {
         # If not, then take the last expression that's returned from ui.R.
         .globals$ui <- NULL
         on.exit(.globals$ui <- NULL, add = FALSE)
-        ui <- source(uiR,
-          local = new.env(parent = globalenv()),
-          keep.source = TRUE, encoding = 'UTF-8')$value
+        ui <- sourceUTF8(uiR, local = new.env(parent = globalenv()))$value
         if (!is.null(.globals$ui)) {
           ui <- .globals$ui[[1]]
         }
@@ -137,11 +135,7 @@ shinyAppDir <- function(appDir, options=list()) {
       # server.R.
       .globals$server <- NULL
       on.exit(.globals$server <- NULL, add = TRUE)
-      result <- source(
-        serverR,
-        local = new.env(parent = globalenv()),
-        keep.source = TRUE, encoding = 'UTF-8'
-      )$value
+      result <- sourceUTF8(serverR, local = new.env(parent = globalenv()))$value
       if (!is.null(.globals$server)) {
         result <- .globals$server[[1]]
       }
@@ -169,8 +163,7 @@ shinyAppDir <- function(appDir, options=list()) {
     oldwd <<- getwd()
     setwd(appDir)
     if (file.exists(file.path.ci(appDir, "global.R")))
-      source(file.path.ci(appDir, "global.R"), keep.source = TRUE,
-             encoding = 'UTF-8')
+      sourceUTF8(file.path.ci(appDir, "global.R"))
   }
   onEnd <- function() {
     setwd(oldwd)

R/server.R

@@ -249,8 +249,11 @@ decodeMessage <- function(data) {
     packBits(rawToBits(data[pos:(pos+3)]), type='integer')
   }
 
-  if (readInt(1) != 0x01020202L)
-    return(fromJSON(rawToChar(data), asText=TRUE, simplify=FALSE, encoding='UTF-8'))
+  if (readInt(1) != 0x01020202L) {
+    # use native encoding for the message
+    nativeData <- iconv(rawToChar(data), 'UTF-8')
+    return(fromJSON(nativeData, asText=TRUE, simplify=FALSE))
+  }
 
   i <- 5
   parts <- list()
@@ -634,7 +637,7 @@ runApp <- function(appDir=getwd(),
   if (is.character(appDir)) {
     desc <- file.path.ci(appDir, "DESCRIPTION")
     if (file.exists(desc)) {
-      con <- file(desc, encoding = 'UTF-8')
+      con <- file(desc, encoding = checkEncoding(desc))
       on.exit(close(con), add = TRUE)
       settings <- read.dcf(con)
       if ("DisplayMode" %in% colnames(settings)) {

R/shinyui.R

@@ -33,6 +33,7 @@ renderPage <- function(ui, connection, showcase=0) {
 
   deps <- c(
     list(
+      htmlDependency("json2", "2014.02.04", c(href="shared"), script = "json2-min.js"),
       htmlDependency("jquery", "1.11.0", c(href="shared"), script = "jquery.js"),
       htmlDependency("shiny", packageVersion("shiny"), c(href="shared"),
         script = "shiny.js", stylesheet = "shiny.css")

R/showcase.R

@@ -50,7 +50,7 @@ showcaseHead <- function() {
          href="shared/shiny-showcase.css"),
     if (file.exists(mdfile))
       script(type="text/markdown", id="showcase-markdown-content",
-        paste(readLines(mdfile, warn = FALSE, encoding='UTF-8'), collapse="\n"))
+        paste(readUTF8(mdfile), collapse="\n"))
     else ""
   ))
 
@@ -106,9 +106,7 @@ showcaseCodeTabs <- function(codeLicense) {
                   # we need to prevent the indentation of <code> ... </code>
                   HTML(format(tags$code(
                     class="language-r",
-                    paste(readLines(file.path.ci(getwd(), rFile), warn=FALSE,
-                                    encoding='UTF-8'),
-                          collapse="\n")
+                    paste(readUTF8(file.path.ci(getwd(), rFile)), collapse="\n")
                   ), indent = FALSE))))
         })),
     codeLicense))
@@ -122,7 +120,9 @@ showcaseAppInfo <- function() {
   readmemd <- file.path.ci(getwd(), "Readme.md")
   hasReadme <- file.exists(readmemd)
   if (hasDesc) {
-    desc <- read.dcf(descfile)
+    con <- textConnection(readUTF8(descfile))
+    on.exit(close(con), add = TRUE)
+    desc <- read.dcf(con)
   }
   with(tags,
     div(class="container-fluid shiny-code-container well",

R/tar.R

@@ -141,7 +141,7 @@ untar2 <- function(tarfile, files = NULL, list = FALSE, exdir = ".")
                             warning(gettextf("failed to copy %s to %s", sQuote(name2), sQuote(name)), domain = NA)
                     }
                 } else {
-                    if(.Platform$OS.type == "windows") {
+                    if(isWindows()) {
                         ## this will not work for links to dirs
                         from <- file.path(dirname(name), name2)
                         if (!file.copy(from, name))

R/utils.R

@@ -185,7 +185,7 @@ resolve <- function(dir, relpath) {
   abs.path <- normalizePath(abs.path, winslash='/', mustWork=TRUE)
   dir <- normalizePath(dir, winslash='/', mustWork=TRUE)
   # trim the possible trailing slash under Windows (#306)
-  if (.Platform$OS.type == 'windows') dir <- sub('/$', '', dir)
+  if (isWindows()) dir <- sub('/$', '', dir)
   if (nchar(abs.path) <= nchar(dir) + 1)
     return(NULL)
   if (substr(abs.path, 1, nchar(dir)) != dir ||
@@ -195,6 +195,8 @@ resolve <- function(dir, relpath) {
   return(abs.path)
 }
 
+isWindows <- function() .Platform$OS.type == 'windows'
+
 # This is a wrapper for download.file and has the same interface.
 # The only difference is that, if the protocol is https, it changes the
 # download settings, depending on platform.
@@ -203,7 +205,7 @@ download <- function(url, ...) {
   if (grepl('^https?://', url)) {
 
     # If Windows, call setInternet2, then use download.file with defaults.
-    if (.Platform$OS.type == "windows") {
+    if (isWindows()) {
       # If we directly use setInternet2, R CMD CHECK gives a Note on Mac/Linux
       mySI2 <- `::`(utils, 'setInternet2')
       # Store initial settings
@@ -916,3 +918,35 @@ setServerInfo <- function(...) {
   infoOld[names(infoNew)] <- infoNew
   .globals$serverInfo <- infoOld
 }
+
+# see if the file can be read as UTF-8 on Windows, and converted from UTF-8 to
+# native encoding; if the conversion fails, it will produce NA's in the results
+checkEncoding <- function(file) {
+  if (!isWindows()) return('UTF-8')
+
+  x <- readLines(file, encoding = 'UTF-8', warn = FALSE)
+  isUTF8 <- !any(is.na(iconv(x, 'UTF-8')))
+  if (isUTF8) return('UTF-8')
+
+  enc <- getOption('encoding')
+  msg <- c(sprintf('The source file "%s" is not encoded in UTF-8. ', file),
+           'Please convert its encoding to UTF-8 ',
+           '(e.g. use the menu `File -> Save with Encoding` in RStudio).')
+  if (enc == 'UTF-8') stop(msg)
+  # if you publish the app to ShinyApps.io, you will be in trouble
+  warning(c(msg, ' Falling back to the encoding "', enc, '".'))
+
+  enc
+}
+
+# try to read a file using UTF-8 (fall back to getOption('encoding') in case of
+# failure, which defaults to native.enc, i.e. native encoding)
+readUTF8 <- function(file) {
+  x <- readLines(file, encoding = checkEncoding(file), warn = FALSE)
+  enc2native(x)
+}
+
+# similarly, try to source() a file with UTF-8
+sourceUTF8 <- function(file, ...) {
+  source(file, ..., keep.source = TRUE, encoding = checkEncoding(file))
+}