From 2277001ada42b5ddb7cdd37a4616fea4d3d282bf Mon Sep 17 00:00:00 2001 From: Carson Date: Fri, 21 Oct 2022 13:12:43 -0500 Subject: [PATCH] Add fill arguments to shinyWidgetOutput() and sizingPolicy() --- .github/workflows/R-CMD-check.yaml | 94 ++++++----------------- DESCRIPTION | 7 +- NEWS.md | 4 +- R/htmlwidgets.R | 117 ++++++++++++++--------------- R/sizing.R | 48 +++++++----- man/htmlwidgets-shiny.Rd | 8 +- man/sizingPolicy.Rd | 8 +- 7 files changed, 132 insertions(+), 154 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 82195e0e..66d89692 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -1,16 +1,14 @@ -# NOTE: This workflow is overkill for most R packages -# check-standard.yaml is likely a better choice -# usethis::use_github_action("check-standard") will install it. +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help # -# For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag. -# https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions +# NOTE: This workflow is overkill for most R packages and +# check-standard.yaml is likely a better choice. +# usethis::use_github_action("check-standard") will install it. on: push: - branches: - - master + branches: [main, master] pull_request: - branches: - - master + branches: [main, master] name: R-CMD-check @@ -26,79 +24,33 @@ jobs: config: - {os: macOS-latest, r: 'release'} - {os: windows-latest, r: 'release'} - - {os: windows-latest, r: '3.6'} - - {os: ubuntu-16.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest", http-user-agent: "R/4.0.0 (ubuntu-16.04) R (4.0.0 x86_64-pc-linux-gnu x86_64 linux-gnu) on GitHub Actions" } - - {os: ubuntu-16.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: 'oldrel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: '3.5', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: '3.4', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - - {os: ubuntu-16.04, r: '3.3', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: ubuntu-latest, r: 'oldrel-2'} + - {os: ubuntu-latest, r: 'oldrel-3'} + - {os: ubuntu-latest, r: 'oldrel-4'} env: - R_REMOTES_NO_ERRORS_FROM_WARNINGS: true - RSPM: ${{ matrix.config.rspm }} GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes steps: - uses: actions/checkout@v2 - - uses: r-lib/actions/setup-r@master + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true - - uses: r-lib/actions/setup-pandoc@master - - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Cache R packages - if: runner.os != 'Windows' - uses: actions/cache@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "16.04"))') - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE) - remotes::install_cran("rcmdcheck") - shell: Rscript {0} - - - name: Session info - run: | - options(width = 100) - pkgs <- installed.packages()[, "Package"] - sessioninfo::session_info(pkgs, include_base = TRUE) - shell: Rscript {0} - - - name: Check - env: - _R_CHECK_CRAN_INCOMING_: false - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") - shell: Rscript {0} - - - name: Show testthat output - if: always() - run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true - shell: bash + extra-packages: any::rcmdcheck + needs: check - - name: Upload check results - if: failure() - uses: actions/upload-artifact@main + - uses: r-lib/actions/check-r-package@v2 with: - name: ${{ runner.os }}-r${{ matrix.config.r }}-results - path: check + upload-snapshots: true diff --git a/DESCRIPTION b/DESCRIPTION index a9e269a4..ba659563 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: htmlwidgets Type: Package Title: HTML Widgets for R -Version: 1.5.4.9000 +Version: 1.5.4.9001 Authors@R: c( person("Ramnath", "Vaidyanathan", role = c("aut", "cph")), person("Yihui", "Xie", role = c("aut")), @@ -19,7 +19,7 @@ License: MIT + file LICENSE VignetteBuilder: knitr Imports: grDevices, - htmltools (>= 0.3), + htmltools (>= 0.5.3.9001), jsonlite (>= 0.9.16), yaml Suggests: @@ -30,3 +30,6 @@ Enhances: shiny (>= 1.1) URL: https://github.com/ramnathv/htmlwidgets BugReports: https://github.com/ramnathv/htmlwidgets/issues RoxygenNote: 7.2.1 +Encoding: UTF-8 +Remotes: + rstudio/htmltools diff --git a/NEWS.md b/NEWS.md index 5208261b..4c63daac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,10 +3,12 @@ htmlwidgets 1.5.4.9000 ### Breaking change -* `shinyWidgetOutput()`'s `reportSize` argument now defaults to `TRUE`. This way, calling `shiny::getCurrentOutputInfo()` inside a `shinyRenderWidget()` context will report the current height and width of the widget. +* `shinyWidgetOutput()`'s `reportSize` argument now defaults to `TRUE`. This way, calling `shiny::getCurrentOutputInfo()` inside a `shinyRenderWidget()` context will report the current height and width of the widget. +* `shinyWidgetOutput()` (and `as.tags.htmlwidget()`) no longer unnecessarily wraps the return value in an additional `tagList()`. ### Improvements +* `shinyWidgetOutput()` and `sizingPolicy()` gain a new `fill` parameter. If `TRUE`, the widget's container will be allowed to grow and shrink to fit inside a `htmltools::asFillContainer()`. This is primarily to make it easier to have resizable widgets inside a `bslib::card()`. * Closed #433: `saveWidget()` no longer throw deprecation warning when pandoc 2.19 or higher is used. htmlwidgets 1.5.4 diff --git a/R/htmlwidgets.R b/R/htmlwidgets.R index 28a09fbf..62669da1 100644 --- a/R/htmlwidgets.R +++ b/R/htmlwidgets.R @@ -170,62 +170,53 @@ addHook <- function(x, hookName, jsCode, data = NULL) { toHTML <- function(x, standalone = FALSE, knitrOptions = NULL) { + x$id <- x$elementId %||% paste("htmlwidget", createWidgetId(), sep = "-") + sizeInfo <- resolveSizing(x, x$sizingPolicy, standalone = standalone, knitrOptions = knitrOptions) - if (!is.null(x$elementId)) - id <- x$elementId - else - id <- paste("htmlwidget", createWidgetId(), sep="-") + name <- class(x)[1] + package <- attr(x, "package") - w <- validateCssUnit(sizeInfo$width) - h <- validateCssUnit(sizeInfo$height) + html <- widget_html( + name, package, id = x$id, + style = css( + width = validateCssUnit(sizeInfo$width), + height = validateCssUnit(sizeInfo$height) + ), + class = paste(name, "html-widget"), + width = sizeInfo$width, + height = sizeInfo$height + ) - # create a style attribute for the width and height - style <- paste( - "width:", w, ";", - "height:", h, ";", - sep = "") + if (sizeInfo$fill) { + html <- asFillItem(html) + } - x$id <- id + if (!is.null(x$prepend) || !is.null(x$append)) { + html <- tagList(x$append, html, x$prepend) + } - container <- if (isTRUE(standalone)) { - function(x) { - div(id="htmlwidget_container", x) - } - } else { - identity + if (isTRUE(standalone)) { + html <- div(id = "htmlwidget_container", html) } - html <- htmltools::tagList( - container( - htmltools::tagList( - x$prepend, - widget_html( - name = class(x)[1], - package = attr(x, "package"), - id = id, - style = style, - class = paste(class(x)[1], "html-widget"), - width = sizeInfo$width, - height = sizeInfo$height - ), - x$append - ) - ), - widget_data(x, id), + html <- tagList( + html, widget_data(x, x$id), if (!is.null(sizeInfo$runtime)) { - tags$script(type="application/htmlwidget-sizing", `data-for` = id, + tags$script( + type = "application/htmlwidget-sizing", + `data-for` = x$id, toJSON(sizeInfo$runtime) ) } ) - html <- htmltools::attachDependencies(html, - c(widget_dependencies(class(x)[1], attr(x, 'package')), - x$dependencies) - ) - htmltools::browsable(html) + deps <- c( + widget_dependencies(name, package), + x$dependencies + ) + browsable(attachDependencies(html, deps, append = TRUE)) } lookup_func <- function(name, package) { @@ -263,7 +254,7 @@ lookup_widget_html_method <- function(name, package) { list(fn = widget_html.default, name = "widget_html.default", legacy = FALSE) } -widget_html <- function (name, package, id, style, class, inline = FALSE, ...) { +widget_html <- function(name, package, id, style, class, inline = FALSE, ...) { fn_info <- lookup_widget_html_method(name, package) @@ -451,6 +442,10 @@ createWidget <- function(name, #' is useful if you want to save an expression in a variable. #' @param cacheHint Extra information to use for optional caching using #' \code{shiny::bindCache()}. +#' @param fill whether or not the returned tag should be wrapped +#' [htmltools::asFillItem()] so that it's `height` is allowed to grow/shrink +#' inside a tag wrapped with [htmltools::asFillContainer()] (e.g., +#' [bslib::card_body_fill()]). #' #' @return An output or render function that enables the use of the widget #' within Shiny applications. @@ -474,7 +469,8 @@ createWidget <- function(name, #' #' @export shinyWidgetOutput <- function(outputId, name, width, height, package = name, - inline = FALSE, reportSize = TRUE, reportTheme = FALSE) { + inline = FALSE, reportSize = TRUE, reportTheme = FALSE, + fill = is.null(height)) { # Theme reporting requires this shiny feature # https://github.com/rstudio/shiny/pull/2740/files @@ -482,26 +478,27 @@ shinyWidgetOutput <- function(outputId, name, width, height, package = name, message("`reportTheme = TRUE` requires shiny v.1.4.0.9003 or higher. Consider upgrading shiny.") } - # generate html - html <- htmltools::tagList( - widget_html( - name, package, id = outputId, - class = paste0( - name, " html-widget html-widget-output", - if (reportSize) " shiny-report-size", - if (reportTheme) " shiny-report-theme" - ), - style = sprintf("width:%s; height:%s; %s", - htmltools::validateCssUnit(width), - htmltools::validateCssUnit(height), - if (inline) "display: inline-block;" else "" - ), width = width, height = height + tag <- widget_html( + name, package, id = outputId, + class = paste0( + name, " html-widget html-widget-output", + if (reportSize) " shiny-report-size", + if (reportTheme) " shiny-report-theme" + ), + style = css( + width = validateCssUnit(width), + height = validateCssUnit(height), + display = if (inline) "inline-block" ) ) - # attach dependencies - dependencies = widget_dependencies(name, package) - htmltools::attachDependencies(html, dependencies) + if (fill) { + tag <- asFillItem(tag) + } + + attachDependencies( + tag, widget_dependencies(name, package), append = TRUE + ) } diff --git a/R/sizing.R b/R/sizing.R index 7b059409..6c8ee9b9 100644 --- a/R/sizing.R +++ b/R/sizing.R @@ -51,6 +51,10 @@ #' @param knitr.figure Apply the default knitr fig.width and fig.height to the #' widget when it's rendered within R Markdown documents. Defaults to #' \code{TRUE}. +#' @param fill whether or not the returned tag should be wrapped +#' [htmltools::asFillItem()] so that it's `height` is allowed to grow/shrink +#' inside a tag wrapped with [htmltools::asFillContainer()] (e.g., +#' [bslib::card_body_fill()]). #' #' @return A widget sizing policy #' @@ -85,12 +89,13 @@ sizingPolicy <- function( browser.defaultWidth = NULL, browser.defaultHeight = NULL, browser.padding = NULL, browser.fill = FALSE, browser.external = FALSE, knitr.defaultWidth = NULL, knitr.defaultHeight = NULL, - knitr.figure = TRUE) { + knitr.figure = TRUE, fill = NULL) { list( defaultWidth = defaultWidth, defaultHeight = defaultHeight, padding = padding, + fill = fill, viewer = list( defaultWidth = viewer.defaultWidth, defaultHeight = viewer.defaultHeight, @@ -185,9 +190,11 @@ DEFAULT_PADDING_VIEWER <- 15 #' @keywords internal #' @noRd resolveSizing <- function(x, sp, standalone, knitrOptions = NULL) { + userSized <- !is.null(x$width) || !is.null(x$height) + viewerScopes <- list(sp$viewer, sp) + viewerFill <- !userSized && any_prop(viewerScopes, "fill") %||% TRUE + if (isTRUE(standalone)) { - userSized <- !is.null(x$width) || !is.null(x$height) - viewerScopes <- list(sp$viewer, sp) browserScopes <- list(sp$browser, sp) # Precompute the width, height, padding, and fill for each scenario. return(list( @@ -196,7 +203,7 @@ resolveSizing <- function(x, sp, standalone, knitrOptions = NULL) { width = x$width %||% any_prop(viewerScopes, "defaultWidth") %||% DEFAULT_WIDTH_VIEWER, height = x$height %||% any_prop(viewerScopes, "defaultHeight") %||% DEFAULT_HEIGHT_VIEWER, padding = any_prop(viewerScopes, "padding") %||% DEFAULT_PADDING_VIEWER, - fill = !userSized && any_prop(viewerScopes, "fill") %||% TRUE + fill = viewerFill ), browser = list( width = x$width %||% any_prop(browserScopes, "defaultWidth") %||% DEFAULT_WIDTH, @@ -206,31 +213,36 @@ resolveSizing <- function(x, sp, standalone, knitrOptions = NULL) { ) ), width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH, - height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT + height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT, + fill = prop(sp, "fill") %||% viewerFill )) - } else if (!is.null(knitrOptions)) { + } + + if (!is.null(knitrOptions)) { knitrScopes <- list(sp$knitr, sp) isFigure <- any_prop(knitrScopes, "figure") - # flexdashboard actually adds on another fig.width for intelligent sizing of static + # flexdashboard actually adds on another fig.width for intelligent sizing of static # figures in desktop/mobile mode # https://github.com/rstudio/flexdashboard/blob/02207b7/R/flex_dashboard.R#L262 - # flexdashboard should really only be doing this for static plots, but we make sure - # to just take the first (desktop) sizing to make this "just work" for flexdashboard - # (or really anyone else that provides a vector of widths/heights for a widget by + # flexdashboard should really only be doing this for static plots, but we make sure + # to just take the first (desktop) sizing to make this "just work" for flexdashboard + # (or really anyone else that provides a vector of widths/heights for a widget by # just taking the 1st value) figWidth <- if (isFigure) knitrOptions$out.width.px[[1L]] else NULL figHeight <- if (isFigure) knitrOptions$out.height.px[[1L]] else NULL # Compute the width and height return(list( width = x$width %||% figWidth %||% any_prop(knitrScopes, "defaultWidth") %||% DEFAULT_WIDTH, - height = x$height %||% figHeight %||% any_prop(knitrScopes, "defaultHeight") %||% DEFAULT_HEIGHT - )) - } else { - # Some non-knitr, non-print scenario. - # Just resolve the width/height vs. defaultWidth/defaultHeight - return(list( - width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH, - height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT + height = x$height %||% figHeight %||% any_prop(knitrScopes, "defaultHeight") %||% DEFAULT_HEIGHT, + fill = prop(knitrScopes, "fill") %||% viewerFill )) } + + # Some non-knitr, non-print scenario. + # Just resolve the width/height vs. defaultWidth/defaultHeight + list( + width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH, + height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT, + fill = prop(sp, "fill") %||% viewerFill + ) } diff --git a/man/htmlwidgets-shiny.Rd b/man/htmlwidgets-shiny.Rd index ecc60d3e..065e68a0 100644 --- a/man/htmlwidgets-shiny.Rd +++ b/man/htmlwidgets-shiny.Rd @@ -14,7 +14,8 @@ shinyWidgetOutput( package = name, inline = FALSE, reportSize = TRUE, - reportTheme = FALSE + reportTheme = FALSE, + fill = is.null(height) ) shinyRenderWidget(expr, outputFunction, env, quoted, cacheHint = "auto") @@ -39,6 +40,11 @@ shiny session's client data?} \item{reportTheme}{Should the widget's container styles (e.g., colors and fonts) be reported in the shiny session's client data?} +\item{fill}{whether or not the returned tag should be wrapped +[htmltools::asFillItem()] so that it's `height` is allowed to grow/shrink +inside a tag wrapped with [htmltools::asFillContainer()] (e.g., +[bslib::card_body_fill()]).} + \item{expr}{An expression that generates an HTML widget (or a \href{https://rstudio.github.io/promises/}{promise} of an HTML widget).} diff --git a/man/sizingPolicy.Rd b/man/sizingPolicy.Rd index fcaef019..95c36bde 100644 --- a/man/sizingPolicy.Rd +++ b/man/sizingPolicy.Rd @@ -21,7 +21,8 @@ sizingPolicy( browser.external = FALSE, knitr.defaultWidth = NULL, knitr.defaultHeight = NULL, - knitr.figure = TRUE + knitr.figure = TRUE, + fill = NULL ) } \arguments{ @@ -85,6 +86,11 @@ within documents generated by knitr (e.g. R Markdown).} \item{knitr.figure}{Apply the default knitr fig.width and fig.height to the widget when it's rendered within R Markdown documents. Defaults to \code{TRUE}.} + +\item{fill}{whether or not the returned tag should be wrapped +[htmltools::asFillItem()] so that it's `height` is allowed to grow/shrink +inside a tag wrapped with [htmltools::asFillContainer()] (e.g., +[bslib::card_body_fill()]).} } \value{ A widget sizing policy