Easier specification of external file dependencies

R/fileDependency.R

@@ -0,0 +1,29 @@
+#' Create a file dependency that can be accessed by the client using javascript.
+#' @export
+fileDependency <- function(filename, version = '0.0.1'){
+  htmltools::htmlDependency(
+    name = basename(tools:::file_path_sans_ext(filename)),
+    version = version,
+    src = dirname(filename),
+    attachment = basename(filename)
+  )
+}
+
+#' Mark a string as an attachment
+#' @export
+attachment <- function(x){
+  if (!file.exists(x)){
+    stop("The attachment ", x, " does not exist")
+  }
+  structure(normalizePath(x), class = unique(c("ATTACHMENT", oldClass(x))))
+}
+
+attachmentDeps <- function(list) {
+  attachments = rapply(list, function(y){y}, classes = 'ATTACHMENT')
+  deps = lapply(attachments, fileDependency)
+  attachments = lapply(as.list(attachments), function(x){
+    basename(tools::file_path_sans_ext(x))
+  })
+  list(attachments = attachments, deps = deps)
+}
+

R/htmlwidgets.R

@@ -89,9 +89,10 @@ toHTML <- function(x, standalone = FALSE, knitrOptions = NULL) {
       )
     }
   )
+  attachments = attachmentDeps(x$x)
   html <- htmltools::attachDependencies(html,
     c(widget_dependencies(class(x)[1], attr(x, 'package')),
-      x$dependencies)
+      x$dependencies, attachments$deps)
   )
 
   htmltools::browsable(html)
@@ -123,8 +124,9 @@ widget_dependencies <- function(name, package){
 # to be picked up by htmlwidgets.js for static rendering.
 widget_data <- function(x, id, ...){
   evals <- JSEvals(x$x)
+  attachments = attachmentDeps(x$x)$attachments
   tags$script(type="application/json", `data-for` = id,
-    HTML(toJSON(list(x = x$x, evals = evals), collapse = "", digits = 16))
+    HTML(toJSON(list(x = x$x, evals = evals, attachments = attachments), collapse = "", digits = 16))
   )
 }
 
@@ -271,12 +273,14 @@ shinyRenderWidget <- function(expr, outputFunction, env, quoted) {
     }
     x <- .subset2(instance, "x")
     deps <- .subset2(instance, "dependencies")
+    attachments = attachmentDeps(x)
+    deps = c(deps, attachments$deps)
     deps <- lapply(
       htmltools::resolveDependencies(deps),
       shiny::createWebDependency
     )
     evals = JSEvals(x)
-    list(x = x, evals = evals, deps = deps)
+    list(x = x, evals = evals, deps = deps, attachments = attachments$attachments)
   }
 
   # mark it with the output function so we can use it in Rmd files

inst/www/htmlwidgets.js

@@ -398,6 +398,7 @@
             }
           }
           Shiny.renderDependencies(data.deps);
+          resolveAttachmentUrls(data)
           superfunc(el, data.x, elementData(el, "init_result"));
         };
       });
@@ -472,6 +473,7 @@
           for (var i = 0; data.evals && i < data.evals.length; i++) {
             window.HTMLWidgets.evaluateStringMember(data.x, data.evals[i]);
           }
+          resolveAttachmentUrls(data)
           binding.renderValue(el, data.x, initResult);
         }
       }
@@ -566,6 +568,34 @@
     }
     return results;
   }
+  // Set value of a property that is nested deep
+  // var dat = {a: {b: {c: 2}}}
+  // setDeepProperty(dat, "a.b", {d: 10})
+  // {a: {b: {d: 10}}}
+  function setDeepProperty(obj, path, value){
+    var path = path.split(".")
+    //var path = splitWithEscape(path, '.', '\\')
+    var path2 = path.slice(0, path.length - 1)
+    var x = path2.reduce(function(prev, cur){
+      return prev[cur]
+    }, obj)
+    if (typeof value === 'undefined'){
+      console.log('undefined')
+      return x[path[path.length - 1]]
+    } else {
+      x[path[path.length - 1]] = value
+    }
+  }
+  // Resolve attachment urls
+  function resolveAttachmentUrls(data){
+    if (data.attachments){
+      Object.keys(data.attachments).map(function(k){
+        setDeepProperty(data.x, k,
+            HTMLWidgets.getAttachmentUrl(data.attachments[k], 1)
+        )
+      })
+    }
+  }
   // Function authored by Yihui/JJ Allaire
   window.HTMLWidgets.evaluateStringMember = function(o, member) {
     var parts = splitWithEscape(member, '.', '\\');