Add widgetDependencies() S3 generic

DESCRIPTION

@@ -34,4 +34,4 @@ Enhances:
 VignetteBuilder: 
     knitr
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.3

NAMESPACE

@@ -3,6 +3,8 @@
 S3method(as.tags,htmlwidget)
 S3method(print,htmlwidget)
 S3method(print,suppress_viewer)
+S3method(widgetDependencies,character)
+S3method(widgetDependencies,htmlwidget)
 export(JS)
 export(JSEvals)
 export(appendContent)
@@ -17,6 +19,7 @@ export(setWidgetIdSeed)
 export(shinyRenderWidget)
 export(shinyWidgetOutput)
 export(sizingPolicy)
+export(widgetDependencies)
 import(htmltools)
 importFrom(utils,browseURL)
 importFrom(utils,file.edit)

NEWS.md

@@ -1,5 +1,7 @@
 # htmlwidgets (development version)
 
+* Added `widgetDependencies()`, an S3 generic for retrieving all HTML dependencies from a widget name (character) or object (htmlwidget). The htmlwidget method includes runtime dependencies passed via `createWidget(dependencies = ...)`, which were previously not accessible through the public API. `getDependency()` is now deprecated in favour of `widgetDependencies()`. (#255)
+
 * Moved `{rmarkdown}` from `Imports` to `Suggests`. It's now only required when calling `saveWidget(selfcontained = TRUE)`. (#455)
 
 * htmlwidgets hex sticker added

R/htmlwidgets.R

@@ -207,12 +207,7 @@ toHTML <- function(x, standalone = FALSE, knitrOptions = NULL) {
     }
   )
 
-  deps <- c(
-    widget_dependencies(name, package),
-    x$dependencies
-  )
-
-  browsable(attachDependencies(html, deps, append = TRUE))
+  browsable(attachDependencies(html, widgetDependencies(x), append = TRUE))
 }
 
 lookup_func <- function(name, package) {
@@ -318,10 +313,6 @@ widgetF_html <- function(name, package, id, style, class, inline = FALSE, ...) {
 
 ## End unit test support functions #################################
 
-widget_dependencies <- function(name, package){
-  getDependency(name, package)
-}
-
 # Generates a <script type="application/json"> tag with the JSON-encoded data,
 # to be picked up by htmlwidgets.js for static rendering.
 widget_data <- function(x, id, ...){
@@ -499,7 +490,7 @@ shinyWidgetOutput <- function(outputId, name, width, height, package = name,
   tag <- tagList(tag)
 
   attachDependencies(
-    tag, widget_dependencies(name, package), append = TRUE
+    tag, widgetDependencies(name, package = package), append = TRUE
   )
 }
 
@@ -533,7 +524,7 @@ shinyRenderWidget <- function(expr, outputFunction, env, quoted, cacheHint = "au
         "Shiny render call")
     }
 
-    deps <- .subset2(instance, "dependencies")
+    deps <- widgetDependencies(instance)
     deps_payload <- lapply(
       htmltools::resolveDependencies(deps),
       shiny::createWebDependency

R/utils.R

@@ -31,31 +31,35 @@ toJSON <- function(x) {
   structure(res, class = 'json')
 }
 
-#' Get js and css dependencies for  a htmlwidget
+#' Get HTML dependencies for a widget
 #'
-#' @param name name of the widget.
-#' @param package name of the package, defaults to the widget name.
+#' @param x A widget name (character) or an \code{htmlwidget} object.
+#' @param ... Currently unused.
+#' @param package Name of the package containing the widget (only used when
+#'   \code{x} is a character string). Defaults to the widget name.
+#' @return A list of \code{\link[htmltools]{htmlDependency}} objects.
 #' @export
-getDependency <- function(name, package = name){
-  config = sprintf("htmlwidgets/%s.yaml", name)
-  jsfile = sprintf("htmlwidgets/%s.js", name)
+widgetDependencies <- function(x, ...) {
+  UseMethod("widgetDependencies")
+}
+
+#' @rdname widgetDependencies
+#' @export
+widgetDependencies.character <- function(x, ..., package = x) {
+  name <- x
+  config <- sprintf("htmlwidgets/%s.yaml", name)
+  jsfile <- sprintf("htmlwidgets/%s.js", name)
 
-  # if yaml does not exist then assume no dependencies
-  #  in this cases dependencies should be provided through the
-  #  dependencies argument of createWidget
   widgetDep <- list()
   yaml_file <- system_file(config, package = package)
   if (file.exists(yaml_file)) {
-    config = yaml::yaml.load_file(yaml_file)
+    config <- yaml::yaml.load_file(yaml_file)
     widgetDep <- lapply(config$dependencies, function(l) {
-      l$package = package
+      l$package <- package
       do.call(htmlDependency, l)
     })
   }
 
-  # if js binding does not exist then assume provided through
-  #  some other mechanism such as a specified `htmlDependency` or `script` tag.
-  #  Note, this is a very special case.
   bindingDep <- if (file.exists(system_file(jsfile, package = package))) {
     htmlDependency(
       name = paste0(name, "-binding"),
@@ -80,6 +84,28 @@ getDependency <- function(name, package = name){
   )
 }
 
+#' @rdname widgetDependencies
+#' @export
+widgetDependencies.htmlwidget <- function(x, ...) {
+  name <- class(x)[1]
+  package <- attr(x, "package")
+  c(
+    widgetDependencies(name, package = package),
+    x$dependencies
+  )
+}
+
+
+#' Deprecated: use [widgetDependencies()] instead.
+#' @param name Widget name.
+#' @param package Package name.
+#' @keywords internal
+#' @export
+getDependency <- function(name, package = name) {
+  .Deprecated("widgetDependencies")
+  widgetDependencies(name, package = package)
+}
+
 
 prop <- function(x, path) {
   tryCatch({

tests/testthat/test-htmlwidgets.R

@@ -42,3 +42,39 @@ test_that("Legacy methods work with tagList() and HTML()", {
     widget_html("widgetF", "htmlwidgets", id = "id", style = NULL, class = NULL)
   }, NA)
 })
+
+dep_names <- function(deps) {
+  deps <- Filter(Negate(is.null), deps)
+  vapply(deps, function(d) d$name, character(1))
+}
+
+test_that("widgetDependencies.character returns YAML + binding deps", {
+  deps <- widgetDependencies("nonexistent_widget", package = "htmlwidgets")
+  expect_true("htmlwidgets" %in% dep_names(deps))
+})
+
+test_that("widgetDependencies.htmlwidget returns YAML + binding + runtime deps", {
+  extra_dep <- htmltools::htmlDependency(
+    name = "extra-dep", version = "1.0", src = ".",
+    script = "extra.js"
+  )
+  w <- createWidget(
+    name = "nonexistent_widget",
+    x = list(),
+    package = "htmlwidgets",
+    dependencies = list(extra_dep)
+  )
+  deps <- widgetDependencies(w)
+  expect_true("htmlwidgets" %in% dep_names(deps))
+  expect_true("extra-dep" %in% dep_names(deps))
+})
+
+test_that("widgetDependencies.htmlwidget works with NULL dependencies", {
+  w <- createWidget(
+    name = "nonexistent_widget",
+    x = list(),
+    package = "htmlwidgets"
+  )
+  deps <- widgetDependencies(w)
+  expect_true("htmlwidgets" %in% dep_names(deps))
+})