From 89fe2ff217cf442bf38b9782597f73cf46bcc08a Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Wed, 23 Sep 2015 22:57:35 -0500
Subject: [PATCH] a more fundamental fix of the Unicode issue

for R <= 3.2.2, Unicode chars don't work for shiny mainly because we want to
preserve the source reference, and unfortunately srcfilecopy() fails because of
the bug https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16264

here I use lines = '' to get around the bug, and assign the source lines to
the srcfile object later, so there is no grep("\n", multibyte_chars) occuring

I also replaced source() with a custom version, which is much simpler and works
better with Unicode chars
---
 R/app.R   |  6 +++---
 R/utils.R | 23 +++++++++++++++++++++--
 2 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/R/app.R b/R/app.R
index d5e1dc167..f66afd8e8 100644
--- a/R/app.R
+++ b/R/app.R
@@ -124,7 +124,7 @@ shinyAppDir_serverR <- 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 <- sourceUTF8(uiR, local = new.env(parent = globalenv()))$value
+        ui <- sourceUTF8(uiR, envir = new.env(parent = globalenv()))
         if (!is.null(.globals$ui)) {
           ui <- .globals$ui[[1]]
         }
@@ -147,7 +147,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
       # server.R.
       .globals$server <- NULL
       on.exit(.globals$server <- NULL, add = TRUE)
-      result <- sourceUTF8(serverR, local = new.env(parent = globalenv()))$value
+      result <- sourceUTF8(serverR, envir = new.env(parent = globalenv()))
       if (!is.null(.globals$server)) {
         result <- .globals$server[[1]]
       }
@@ -202,7 +202,7 @@ shinyAppDir_appR <- function(appDir, options=list()) {
   # app.R has changed, it'll re-source the file and return the result.
   appObj <- cachedFuncWithFile(appDir, "app.R", case.sensitive = FALSE,
     function(appR) {
-      result <- sourceUTF8(fullpath, local = new.env(parent = globalenv()))$value
+      result <- sourceUTF8(fullpath, envir = new.env(parent = globalenv()))
 
       if (!is.shiny.appobj(result))
         stop("app.R did not return a shiny.appobj object.")
diff --git a/R/utils.R b/R/utils.R
index f81dcf7c6..faad54ff4 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1022,8 +1022,27 @@ tryNativeEncoding <- function(string) {
 }
 
 # similarly, try to source() a file with UTF-8
-sourceUTF8 <- function(file, ...) {
-  source(file, ..., keep.source = TRUE, encoding = checkEncoding(file))
+sourceUTF8 <- function(file, envir = globalenv()) {
+  lines <- readUTF8(file)
+  enc <- if (any(Encoding(lines) == 'UTF-8')) 'UTF-8' else 'unknown'
+  src <- srcfilecopy(file, lines, isFile = TRUE)  # source reference info
+  # oddly, parse(file) does not work when file contains multibyte chars that
+  # **can** be encoded natively on Windows (might be a bug in base R); we fall
+  # back to parse(text) in this case
+  exprs <- tryCatch(
+    parse(file, keep.source = FALSE, srcfile = src, encoding = enc),
+    error = function(e) {
+      parse(text = lines, keep.source = FALSE, srcfile = src, encoding = enc)
+    }
+  )
+  eval(exprs, envir)
+}
+
+# a workaround for https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16264
+if (getRversion() <= '3.2.2') srcfilecopy <- function(filename, lines, ...) {
+  src <- base::srcfilecopy(filename, lines = '', ...)
+  src$lines <- lines
+  src
 }
 
 # write text as UTF-8