├── LICENSE ├── NAMESPACE ├── DESCRIPTION ├── inst └── javascript │ └── htmlwidgets.js └── R └── htmlwidgets.R /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: AT&T Intellectual Property 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | 2 | importFrom("utils", "packageName") 3 | export(print.htmlwidget) 4 | export(print.suppress_viewer) 5 | export(print.shiny.tag) 6 | S3method(print, shiny.tag) 7 | S3method(as.character, shiny.tag) 8 | S3method(print, htmlwidget) 9 | S3method(as.character, htmlwidget) 10 | S3method(print, suppress_viewer) 11 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rcloud.htmlwidgets 2 | Title: Html Widgets in RCloud 3 | Version: 1.0.1 4 | Author: Gábor Csárdi 5 | Maintainer: Gábor Csárdi 6 | Description: Embed HTML widgets in RCloud notebooks. This is a support 7 | package that makes sure that HTML widgets work in RCloud, the usual 8 | way, by simply printing a widget object. 9 | Imports: rcloud.support (>= 1.7-0), htmlwidgets (>= 0.7), htmltools (>= 0.3.5) 10 | License: MIT + file LICENSE 11 | Encoding: UTF-8 12 | -------------------------------------------------------------------------------- /inst/javascript/htmlwidgets.js: -------------------------------------------------------------------------------- 1 | 2 | function getDocHeight(Di) { 3 | var D = Di[0]; 4 | 5 | if (Di.find('body').css('overflow') === 'hidden') { 6 | return Math.max( 7 | D.documentElement.offsetHeight, 8 | D.documentElement.clientHeight 9 | ); 10 | 11 | } else { 12 | return Math.max( 13 | Math.max(D.body.scrollHeight, D.documentElement.scrollHeight), 14 | Math.max(D.body.offsetHeight, D.documentElement.offsetHeight), 15 | Math.max(D.body.clientHeight, D.documentElement.clientHeight) 16 | ); 17 | } 18 | } 19 | 20 | var lastWidths = { }; 21 | 22 | function size_this(div, reset) { 23 | // Check if the widget has a already. If not, we need to wait 24 | // a bit 25 | 26 | var Di = $(div).find('iframe').contents(); 27 | var D = Di[0]; 28 | 29 | if (!div.id) { 30 | // Do nothing if the div is not there at all 31 | 32 | } else if (!D || !D.body) { 33 | setTimeout(function() { size_this(div, reset); }, 100); 34 | 35 | } else { 36 | // Check if the width of the iframe is different. If not, then 37 | // we don't need to do anything. 38 | var rcid = div.id; 39 | var width = $(div).find('iframe').width(); 40 | if (reset || (! rcid in lastWidths) || (lastWidths[rcid] != width)) { 41 | var h = getDocHeight(Di); 42 | $(div).find('iframe').height(h); 43 | $(div).find('iframe').attr('height', h); 44 | } 45 | lastWidths[rcid] = width; 46 | } 47 | } 48 | 49 | function resize_all(reset) { 50 | var widgets = $('.rcloud-htmlwidget-content'); 51 | $.map( 52 | widgets, 53 | function(w) { 54 | setTimeout(function() { size_this(w, reset) }, 200) 55 | } 56 | ); 57 | 58 | return widgets.length; 59 | } 60 | 61 | var hooks = false; 62 | 63 | function add_hooks() { 64 | if (!hooks) { 65 | hooks = true; 66 | window.addEventListener('resize', resize_all, true); 67 | }; 68 | } 69 | 70 | // The resizer is mainly for mini.html, but might be handy for 71 | // notebook as well, if some widgets resize very slowly. 72 | 73 | var lastWidth = window.innerWidth; 74 | 75 | $(document).ready(function() { 76 | add_hooks() 77 | function resizer(reset) { 78 | var num_widgets = resize_all(reset); 79 | var interval = 200; 80 | if (num_widgets > 0) { 81 | setTimeout(resizer, 5000); 82 | } else { 83 | setTimeout(function() { resizer(true) }, interval); 84 | } 85 | } 86 | resizer(lastWidth < window.innerWidth); 87 | lastWidth = window.innerWidth; 88 | }); 89 | 90 | function initWidget(div, html, k) { 91 | $(div).html(html) 92 | 93 | setTimeout(function() { size_this($(div), true); }, 100); 94 | k(null, div); 95 | } 96 | 97 | (function() { 98 | return { 99 | create: function(div, html, k) { 100 | initWidget(div, html, k) 101 | } 102 | } 103 | })() 104 | -------------------------------------------------------------------------------- /R/htmlwidgets.R: -------------------------------------------------------------------------------- 1 | 2 | ## Some comments about how htmlwidgets work in Rcloud. 3 | ## 4 | ## # In the notebook 5 | ## 6 | ## This is simple. We override the 'viewer' option when the 7 | ## rcloud.support package is loaded (see .onLoad in zzz.R), 8 | ## and the rcloud.htmlwidgets.viewer function will be called 9 | ## whenever the widget is printed. 10 | ## 11 | ## So one can simply do 12 | ## library(radarchart) 13 | ## chartJSRadar(scores = skills) 14 | ## in a notbeook, and the radar chart widget will be shown in a cell. 15 | ## 16 | ## Our viewer does the following: 17 | ## 1. Creates an OCAP for htmlwidgets, if it does not exist yet. 18 | ## 2. Creates a self-contained HTML file from the widget using 19 | ## an internal function htmlwidgets:::pandoc_self_contained_html 20 | ## which in turn uses Pandoc. So htmlwidgets won't work, unless 21 | ## Pandoc is installed on the server. Unfortunately this also 22 | ## means that we write the HTML for the widget to disk, twice. 23 | ## This is fine for small widgets, but not ideal for some that 24 | ## contain a lot of data. 25 | ## 3. Sticks the HTML in an iframe, using the 'srcdoc' attribute 26 | ## This is supported in most browsers, except in IE. This polyfill 27 | ## could be used for IE, if this is a concern: 28 | ## https://github.com/jugglinmike/srcdoc-polyfill 29 | ## We are not using it currently. 30 | ## 4. Sends the HTML with the iframe over via the OCAP, which sticks 31 | ## it in the cell, and sizes it correctly. See sizing below. 32 | ## 33 | ## # In mini.html 34 | ## 35 | ## Mini is a bit different. Here is an example, it is also at 36 | ## https://gist.github.com/gordonwoodhull/fc9220160fb8819edb1c6e972d874305 37 | ## 38 | ## library(rcloud.web) 39 | ## library(rcloud.support) 40 | ## library(DT) 41 | ## library(rcloud.htmlwidgets) 42 | ## 43 | ## out("Data set:") 44 | ## oselection( 45 | ## "dataset", 46 | ## c("iris", "mtcars"), 47 | ## onChange = "window.notebook_result.update(this.value, function() {});" 48 | ## ) 49 | ## out("

") 50 | ## 51 | ## update <- function(dataset = "iris") { 52 | ## data <- get(dataset, asNamespace("datasets")) 53 | ## rcw.set("#mytable", datatable(data)) 54 | ## } 55 | ## 56 | ## rcw.result( 57 | ## update = update, 58 | ## run = function(..., dataset = "iris") { 59 | ## rcw.append("body", out()) 60 | ## update(dataset) 61 | ## } 62 | ## ) 63 | ## 64 | ## This is mostly standard mini.html stuff. The widget is created via 65 | ## the datatable() call, and note that you can just stick it into 66 | ## rcw.set() and everything works magically. 67 | ## 68 | ## This is because rcw.set() calls as.character() on the second argument. 69 | ## Here: https://github.com/att/rcloud/blob/1a90eb240f8e96dd1ead1c0f21f5095a06954f85/rcloud.packages/rcloud.web/R/caps.R#L31-L35 70 | ## 71 | ## This is required, because we define as.character() for htmlwidget 72 | ## objects. Our new as.character() method basically uses the same 73 | ## method as above, to create an iframe that will be eventually put in 74 | ## the div in mini.html. 75 | ## 76 | ## Note that as.character() also creates the OCAP if it does not exist, 77 | ## but only if we are on mini.html, not in the IDE, i.e. not in the 78 | ## notebook editor. 79 | ## 80 | ## # Sizing 81 | ## 82 | ## Sizing of html widgets is tricky by itself. See the vignette in the 83 | ## R package, currently here: 84 | ## https://cran.r-project.org/web/packages/htmlwidgets/vignettes/develop_sizing.html 85 | ## 86 | ## In Rcloud it is even more difficult, because we need to update the 87 | ## size of the div that contains the iframe, whenever the user resizes 88 | ## the browser window, or just the width of the cell changes. 89 | ## 90 | ## The good thing is that the widgets within the iframe get the resize 91 | ## event and resize themselves properly, so we don't need to deal with 92 | ## that. But we need to capture when the width of the cell changes, and 93 | ## rezise the div(s) containing widgets, **after** the widget itself 94 | ## already resized itself properly within the iframe. 95 | ## 96 | ## The JS code that does this is in the OCAP, see the inst/htmlwidgets.js 97 | ## file for the source. There are four different cases we need to 98 | ## handle, and they come up both for the notebook editor and mini.html. 99 | ## 100 | ## 1. Notebook, the first widget is being put on the page 101 | ## 102 | ## * We set the hooks for capturing window resize events. 103 | ## * We wait (well, aync) for 100ms, and if the widget within the iframe 104 | ## has its built already, we resize the iframe, and thus the 105 | ## cell. If there is no body yet, we try it again 100ms later, and keep 106 | ## trying. A more robust implementation would maybe use a gradually 107 | ## increasing timeout, but is only a problem for faulty widgets, that 108 | ## do not create an HTML , so if this happens, the user has bigger 109 | ## problems to worry about. In case a widget is slow deciding about 110 | ## its size, and the is already there, but the widget will still 111 | ## change its mind about the size, we also have a periodic size checker 112 | ## and resizer, see below. 113 | ## 114 | ## 2. Notebook, a widget is being put on the page that already has one 115 | ## 116 | ## This is similar to 1., but we don't need to add the resize event 117 | ## hooks. They are there already. The hook resizes *all* widgets on the 118 | ## page, so we only want one hook, and not one for each widget. 119 | ## 120 | ## 3. Notebook, the browser window is resized 121 | ## 122 | ## Our hook is fired, it resizes all widgets on the page, in parallel. 123 | ## For each widget, it uses the algorithm in 1., i.e. it tries resizing 124 | ## it every 100ms, looking for a tag in the iframe. 125 | ## 126 | ## 4. Notebook, the width of the cell changes, not the browser window size 127 | ## 128 | ## This is more tricky, because AFAIK we can't capture this event currently. 129 | ## In the future RCloud could trigger an event, maybe. 130 | ## 131 | ## So the way we handle this for now is by running a periodic check, 132 | ## currently every five seconds, to see if we need to resize any widget. 133 | ## This periodic check is installed when the htmlwidgets OCAP is 134 | ## installed. Actually, the check starts running every 200ms, but as soon 135 | ## as it resizes a widget on the page, it adjusts itself to run every five 136 | ## seconds. This is because of mini, see below. 137 | ## 138 | ## 5. Mini, first widget is being put on the page 139 | ## 140 | ## We add the hooks to the window resize event. We cannot directly size 141 | ## the widget(s) on the page, unfortunately, because we are not calling 142 | ## an OCAP explicitly from R to do this. (In the notebook this is called 143 | ## by the custom print method, but in mini, we want to avoid extra calls 144 | ## from the user just because of htmlwidgets, and we don't want to mess 145 | ## with the rcloud.web functions, either. 146 | ## 147 | ## Instead, we just use the periodic check to size the widget properly. 148 | ## We don't want the user to wait for 5 seconds for a correct sizing, 149 | ## so we start with periodic resize events every 200ms. Once a resize 150 | ## is successful, we switch to the 5 seconds period. 151 | ## 152 | ## 6. Mini, subsequent widgets 153 | ## 154 | ## Nothing special here, they work the same as the first in 5. 155 | ## One small glitch is that we cannot be sure how many widgets the page 156 | ## has, they are added dynamically, and we relax the check period after 157 | ## the first resized widget. So it might happen that one widget is sized 158 | ## properly when the page loads, but the others only 5 seconds later. 159 | ## 160 | ## 7. Mini, browser window is resized 161 | ## 162 | ## This is like 3. Our hook is fired and it takes care of business. 163 | ## 164 | ## 8. Mini, widget width changes without a resized browser window 165 | ## 166 | ## This probably does not happen in mini, because there are no cells. 167 | ## But even if it does, because of some complicated custom HTML layout, 168 | ## the periodic resizer takes care of it, albeit maybe only a couple 169 | ## of seconds later. 170 | 171 | .htmlwidgets.cache <- new.env(parent = emptyenv()) 172 | 173 | htmlwidgets.install.ocap <- function() { 174 | if (is.null(.htmlwidgets.cache$ocaps)) { 175 | jsfile <- file.path( 176 | system.file(package = packageName()), 177 | "javascript", "htmlwidgets.js" 178 | ) 179 | script <- paste(readLines(jsfile), collapse = "\n") 180 | oc <- rcloud.install.js.module("htmlwidgets", script, TRUE) 181 | .htmlwidgets.cache$ocaps <- oc 182 | } 183 | 184 | .htmlwidgets.cache$ocaps 185 | } 186 | 187 | as.character.htmlwidget <- function(x, ocaps = TRUE, ...) { 188 | html <- htmlwidgets:::toHTML(x, standalone = TRUE) 189 | deps <- lapply(htmltools::htmlDependencies(html), rcloudHTMLDependency) 190 | rendered <- htmltools::renderTags(html) 191 | 192 | build.html(list(body = rendered$html, head = rendered$head, dependencies = deps), ocaps) 193 | } 194 | 195 | as.character.shiny.tag <- function(x, ocaps = TRUE, ...) { 196 | rendered <- htmltools::renderTags(x) 197 | deps <- lapply(rendered$dependencies, rcloudHTMLDependency) 198 | 199 | build.html(list(body = rendered$html, head = rendered$head, dependencies = deps), ocaps) 200 | } 201 | 202 | build.html <- function(content = list(body = NULL, head = NULL, dependencies = list()), ocaps = TRUE) { 203 | background <- "white" 204 | html <- c( 205 | "", "", "", "", 206 | htmltools::renderDependencies(content$dependencies, "href"), 207 | content$head, "", 208 | sprintf( 209 | "", 210 | htmltools::htmlEscape(background) 211 | ), 212 | content$body, "", "" 213 | ) 214 | 215 | if (ocaps) htmlwidgets.install.ocap() 216 | 217 | where <- paste0("rc_htmlwidget_content_", as.integer(runif(1)*1e6)) 218 | 219 | paste( 220 | sep = "", 221 | "

", 224 | "", 227 | "

" 228 | ) 229 | } 230 | 231 | print.htmlwidget <- function(x, ..., view = interactive()) { 232 | 233 | where <- paste0("rc_htmlwidget_", as.integer(runif(1)*1e6)) 234 | rcloud.html.out(paste0( 235 | "

", 236 | "

", 237 | "

")) 238 | where <- paste0("#", where) 239 | 240 | widget <- as.character(x, ..., ocaps = FALSE) 241 | 242 | ocaps <- htmlwidgets.install.ocap() 243 | 244 | ocaps$create(where, widget) 245 | 246 | invisible(x) 247 | } 248 | 249 | print.suppress_viewer <- print.htmlwidget 250 | 251 | print.shiny.tag <- print.htmlwidget 252 | 253 | rcloudHTMLDependency <- function(dep) { 254 | 255 | file <- dep$src$file 256 | 257 | lib <- where_in_path(file, .libPaths()) 258 | if (is.na(lib)) { 259 | warning("Cannot find htmlwidgets dependency: ", file) 260 | return(dep) 261 | } 262 | 263 | rel_path <- path_inside(file, lib) 264 | c_rel_path <- path_components(rel_path) 265 | pkg <- c_rel_path[1] 266 | 267 | ## strip off pkg/www or pkg/htmlwidgets 268 | pkgpath <- paste(tail(c_rel_path, -2), collapse = "/") 269 | 270 | if (length(c_rel_path) < 2) { 271 | warning("Invalid htmlwidgets dependency path: ", file) 272 | return(dep) 273 | } else if (c_rel_path[2] == "htmlwidgets") { 274 | dep$src$href <- paste0("/shared.R/_htmlwidgets/", pkg, "/", pkgpath) 275 | 276 | } else if (c_rel_path[2] == "www") { 277 | dep$src$href <- paste0("/shared.R/", pkg, "/", pkgpath) 278 | } 279 | 280 | dep 281 | } 282 | 283 | where_in_path <- function(path, parents) { 284 | for (parent in parents) { 285 | if (is_in_path(path, parent)) return(parent) 286 | } 287 | NA_character_ 288 | } 289 | 290 | is_in_path <- function(path, parent) { 291 | 292 | path <- normalizePath(path) 293 | parent <- normalizePath(parent) 294 | 295 | c_path <- path_components(path) 296 | c_parent <- path_components(parent) 297 | 298 | if (length(c_path) < length(c_parent)) { 299 | FALSE 300 | 301 | } else { 302 | all(c_path[seq_along(c_parent)] == c_parent) 303 | } 304 | } 305 | 306 | path_components <- function(path) { 307 | strsplit(path, "/+")[[1]] 308 | } 309 | 310 | path_inside <- function(path, parent) { 311 | c_path <- path_components(path) 312 | c_parent <- path_components(parent) 313 | 314 | paste(tail(c_path, -length(c_parent)), collapse = "/") 315 | } 316 | --------------------------------------------------------------------------------