IRkernel · cpsievert · Feb 1, 2017 · Apr 11, 2018 · Apr 11, 2018 · Apr 11, 2018
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,4 @@
 .Rhistory
 .RData
 repr.pdf
+.ipynb_checkpoints/
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -8,7 +8,8 @@ Authors@R: c(
     person('abielr', role = 'ctb'),
     person('Denilson', 'Figueiredo de Sa', role = 'ctb'),
     person('Jim', 'Hester', role = 'ctb'),
-    person('karldw', role = 'ctb')
+    person('karldw', role = 'ctb'),
+    person('Carson', 'Sievert', role = 'ctb')
     )
 Maintainer: Philipp Angerer <phil.angerer@gmail.com>
 Description: String and binary representations of objects for several formats /
@@ -17,7 +18,8 @@ Depends:
     R (>= 3.0.1)
 Imports:
     utils,
-    grDevices
+    grDevices,
+    base64enc
 Suggests:
     methods,
     highr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -16,6 +16,7 @@ S3method(repr_html,logical)
 S3method(repr_html,matrix)
 S3method(repr_html,numeric)
 S3method(repr_html,packageIQR)
+S3method(repr_html,shiny.tag)
 S3method(repr_html,shiny.tag.list)
 S3method(repr_javascript,default)
 S3method(repr_jpg,default)
@@ -61,6 +62,7 @@ S3method(repr_text,htmlwidget)
 S3method(repr_text,matrix)
 S3method(repr_text,packageIQR)
 S3method(repr_text,recordedplot)
+S3method(repr_text,shiny.tag)
 S3method(repr_text,shiny.tag.list)
 export(format2repr)
 export(mime2repr)
@@ -76,13 +78,18 @@ export(repr_pdf)
 export(repr_png)
 export(repr_svg)
 export(repr_text)
+importFrom(base64enc,dataURI)
 importFrom(grDevices,cairo_pdf)
 importFrom(grDevices,dev.off)
 importFrom(grDevices,jpeg)
 importFrom(grDevices,pdf)
 importFrom(grDevices,png)
 importFrom(grDevices,replayPlot)
 importFrom(grDevices,svg)
+importFrom(htmltools,copyDependencyToDir)
+importFrom(htmltools,makeDependencyRelative)
+importFrom(htmltools,renderDependencies)
+importFrom(htmltools,renderTags)
 importFrom(tools,Rd2HTML)
 importFrom(tools,Rd2latex)
 importFrom(tools,Rd2txt)

diff --git a/R/repr_htmlwidget.r b/R/repr_htmlwidget.r
@@ -1,3 +1,103 @@
+#' @importFrom htmltools renderTags copyDependencyToDir makeDependencyRelative renderDependencies
+#' @importFrom base64enc dataURI
+embed_tags <- function(obj, ...) {
+
+	obj <- htmltools::renderTags(obj)
+
+	if (nchar(obj$head) > 0) {
+		# TODO: 
+		# (1) can this be done?
+		# (2) what about singletons?
+		warning("Inserting HTML strings into <head> currently isn't supported")
+	}
+
+	# ignore dependencies that already exist in the notebook
+	obj$dependencies <- setdiff(obj$dependencies, .dependencies$get())
+
+	# add these (new) dependencies to the dependency manager
+	.dependencies$add(obj$dependencies)
+
+	# render dependencies as data URIs (for standalone HTML)
+	depHTML <- lapply(obj$dependencies, function(dep) {
+
+		html <- c()
+
+		if (length(dep$script) > 0) {
+			f <- file.path(dep$src$file, dep$script)
+			# TODO: is this *always* the correct mime type?
+			html <- c(html, sprintf(
+				'<script src="%s"></script>', 
+				base64enc::dataURI(mime = "application/javascript", file = f)
+			))
+		}
+
+		if (length(dep$stylesheet) > 0) {
+			f <- file.path(dep$src$file, dep$stylesheet)
+			# TODO: is this *always* the correct mime type? Use base64enc::checkUTF8() to ensure UTF-8 is OK?
+			html <- c(html, sprintf(
+				'<link href="%s" rel="stylesheet" />', 
+				base64enc::dataURI(mime = "text/css;charset-utf-8", file = f)
+			))
+		}
+
+		paste(html, collapse = "\n")
+	})
+
+	html <- sprintf(
+		'<!DOCTYPE html>
+		  <html>
+		    <head>
+		     <meta charset="utf-8" />
+         %s
+        <head>
+        <body>
+          %s
+        </body>
+      </html>
+		', unlist(depHTML), obj$html
+	)
+
+	paste(html, collapse = "\n")
+}
+
+# find a new folder name under the working directory 
+new_dir <- function() {
+	dirCandidate <- new_id()
+	while (dir.exists(dirCandidate)) {
+		dirCandidate <- new_id()
+	}
+	dirCandidate
+}
+
+new_id <- function() {
+	basename(tempfile(""))
+}
+
+
+# keep track of what dependencies have been included and where they are located
+dependency_manager <- function() {
+	deps <- NULL
+	depDir <- new_dir()
+
+	as.environment(list(
+		get = function() deps,
+		add = function(dep) deps <<- unique(c(deps, dep)),
+		dir = function() depDir
+	))
+}
+
+.dependencies <- dependency_manager()
+
+destroy <- function(.dep) {
+	unlink(.dep$dir(), recursive = TRUE)
+}
+
+# delete the dependency files that have been copied to the ipython notebook
+# webserver location (when this object is garbage collected or upon exiting R)
+reg.finalizer(.dependencies, destroy, onexit = TRUE)
+
+
+
 #' HTML widget representations
 #'
 #' Standalone HTML representation and dummy text representation
@@ -11,27 +111,33 @@ repr_text.htmlwidget <- function(obj, ...) 'HTML widgets cannot be represented i
 
 #' @name repr_*.htmlwidget
 #' @export
-repr_html.htmlwidget <- function(obj, ...) {
-	if (!requireNamespace('htmlwidgets', quietly = TRUE))
-		stop('repr_html.htmlwidget called without loadable htmlwidgets')
-
-	htmlfile <- tempfile(fileext = '.html')
-	on.exit(unlink(htmlfile))
-
-	htmlwidgets::saveWidget(obj, htmlfile)
-
-	readChar(htmlfile, file.info(htmlfile)$size)
-}
+repr_html.htmlwidget <- embed_tags
 
+#' Shiny tag representations
+#'
+#' Standalone HTML representation and dummy text representation
+#'
+#' @param obj  The shiny tags to create a representation for
+#' @param ...  ignored
+#'
+#' @name repr_*.shiny.tag
+#' @export
+repr_text.shiny.tag <- function(obj, ...) 'Shiny tags cannot be represented in plain text (need html)'
 
-#' @name repr_*.htmlwidget
+#' @name repr_*.shiny.tag
+#' @export
+repr_html.shiny.tag <- embed_tags
+
+#' Standalone HTML representation and dummy text representation
+#'
+#' @param obj  The shiny tags to create a representation for
+#' @param ...  ignored
+#'
+#' @name repr_*.shiny.tag.list
 #' @export
-repr_text.shiny.tag.list <- function(obj, ...) sprintf(
-	'Use HTML to display this shiny-taglist of length %s with named elements %s',
-	length(obj), paste(lapply(obj, function(t) dQuote(t$elementId)), collapse = '\n'))
+repr_text.shiny.tag.list <- function(obj, ...) 'Shiny tags cannot be represented in plain text (need html)'
 
 #' @name repr_*.htmlwidget
 #' @export
-repr_html.shiny.tag.list <- function(obj, ...) {
-	paste(lapply(obj, repr_html), collapse = '\n')
-}
+repr_html.shiny.tag.list <- embed_tags
+
diff --git a/man/repr_-times-.htmlwidget.Rd b/man/repr_-times-.htmlwidget.Rd
diff --git a/man/repr_-times-.shiny.tag.Rd b/man/repr_-times-.shiny.tag.Rd
diff --git a/man/repr_-times-.shiny.tag.list.Rd b/man/repr_-times-.shiny.tag.list.Rd