inst/htmlwidgets structure not compatible with htmlwidgets::saveWidget()

Open yonicd opened this issue 8 years ago • 0 comments

i am trying to save trelliscopejs output to an html to nest it in slickR.

after looking a bit i figured out that the structure of an output object is missing a few attribrutes.

l<-qplot(cty, hwy, data = mpg) +
  geom_abline(alpha = 0.5) +
  xlim(7, 37) + ylim(9, 47) + theme_bw() +
  facet_trelliscope(~ manufacturer + class, nrow = 2, ncol = 4)

l<-structure(l, class=c("trelliscope_widget",'ggplot', "ggplot",'htmlwidget'),package='trelliscopejs')

this got me a bit farther down the script.

but then i found that the inst/htmlwidgets structure doesnt conform to what is in the saveWidget script, more specifically the function htmltools:::copyDependencyToDir()

How could i change things to make saveWidget run?

Thanks

see 4 lines after browser()

copyDependencyToDir<-function (dependency, outputDir, mustWork = TRUE) 
{
  dir <- dependency$src$file
  if (is.null(dir)) {
    if (mustWork) {
      stop("Dependency ", dependency$name, " ", dependency$version, 
           " is not disk-based")
    }
    else {
      return(dependency)
    }
  }
  if (length(outputDir) != 1 || outputDir %in% c("", "/")) 
    stop("outputDir must be of length 1 and cannot be \"\" or \"/\"")
  if (!htmltools:::dir_exists(outputDir)) 
    dir.create(outputDir)
  target_dir <- if (getOption("htmltools.dir.version", TRUE)) {
    paste(dependency$name, dependency$version, sep = "-")
  }
  else dependency$name
  target_dir <- file.path(outputDir, target_dir)
  if (htmltools:::dir_exists(target_dir)) 
    unlink(target_dir, recursive = TRUE)
  dir.create(target_dir)
  files <- if (dependency$all_files) 
    list.files(dir)
  else {
    unlist(dependency[c("script", "stylesheet", "attachment")])
  }
browser()
  srcfiles <- file.path(dir, files) #<------
  destfiles <- file.path(target_dir, files) #<------
  isdir <- file.info(srcfiles)$isdir #<------
  destfiles <- ifelse(isdir, dirname(destfiles), destfiles) #<------
  mapply(function(from, to, isdir) {
    if (!htmltools:::dir_exists(dirname(to))) 
      dir.create(dirname(to), recursive = TRUE)
    if (isdir && !htmltools:::dir_exists(to)) 
      dir.create(to)
    file.copy(from, to, overwrite = TRUE, recursive = isdir)
  }, srcfiles, destfiles, isdir)
  dependency$src$file <- normalizePath(target_dir, "/", TRUE)
  dependency
}

the functions that depend on this are save_html:

save_html=function (html, file, background = "white", libdir = "lib") 
{
 
  dir <- dirname(file)
  oldwd <- setwd(dir)
  on.exit(setwd(oldwd), add = TRUE)
  rendered <- htmltools::renderTags(html)
  deps <- lapply(rendered$dependencies, function(dep) {
    browser()
    dep <- copyDependencyToDir(dep, libdir, FALSE) #<----
    dep <- htmltools::makeDependencyRelative(dep, dir, FALSE)
    dep
  })
  html <- c("<!DOCTYPE html>", "<html>", "<head>", "<meta charset=\"utf-8\"/>", 
            htmltools::renderDependencies(deps, c("href", "file")), rendered$head, 
            "</head>", sprintf("<body style=\"background-color:%s;\">", 
                               htmltools::htmlEscape(background)), rendered$html, "</body>", 
            "</html>")
  writeLines(html, file, useBytes = TRUE)
}

and saveWidget:

saveWidget=function (widget, file, selfcontained = TRUE, libdir = NULL, 
          background = "white", knitrOptions = list()) 
{
  
  html <- htmlwidgets:::toHTML(widget, standalone = TRUE, knitrOptions = knitrOptions)
  
  if (is.null(libdir)) {
    libdir <- paste(tools::file_path_sans_ext(basename(file)), 
                    "_files", sep = "")
  }
  save_html(html, file = file, libdir = libdir, background = background) #<------
  if (selfcontained) {
    if (!pandoc_available()) {
      stop("Saving a widget with selfcontained = TRUE requires pandoc. For details see:\n", 
           "https://github.com/rstudio/rmarkdown/blob/master/PANDOC.md")
    }
    pandoc_self_contained_html(file, file)
    unlink(libdir, recursive = TRUE)
  }
  invisible(NULL)
}

Mar 14 '17 02:03 yonicd