Merge branch 'master' into ts_unit

* master:
  Move `./srcts` configs to top level to support types installation from GitHub (#3425)
  insertTab() now handles position correctly when target is NULL (#3404)
  yarn add node-gyp; yarn build (#3424)
  Export TypeScript type definitions to local folder (#3418)
  TypeScript: Remove `any` types / improve type definitions (#3414)
  Better color constrasting in sliderInput() (#3366)
  Use ggplot2::get_alt_text() if available to provide better default alt text (#3398)
  Set selectize dropdownParent to "body" to prevent clipping

.Rbuildignore

@@ -21,3 +21,19 @@
 ^TODO-promises.md$
 ^manualtests$
 ^\.github$
+
+^\.yarn$
+^\.vscode$
+^\.madgerc$
+^\.prettierrc\.yml$
+^babel\.config\.json$
+^jest\.config\.js$
+^package\.json$
+^tsconfig\.json$
+^yarn\.lock$
+^node_modules$
+^coverage$
+^.ignore$
+^\.browserslistrc$
+^\.eslintrc\.yml$
+^\.yarnrc\.yml$

srcts/.eslintrc.yml → .eslintrc.yml

@@ -25,6 +25,8 @@ rules:
     - off
   "@typescript-eslint/no-explicit-any":
     - off
+  "@typescript-eslint/explicit-module-boundary-types":
+    - error
   camelcase:
     - error
   default-case:

.github/workflows/rituals.yaml

@@ -129,22 +129,32 @@ jobs:
           tree src
           yarn install --immutable && yarn build
           git add ./src && git commit -m 'yarn lint (GitHub Actions)' || echo "No yarn lint changes to commit"
+          git add ./types && git commit -m 'yarn tsc (GitHub Actions)' || echo "No type definition changes to commit"
           git add ../inst && git commit -m 'yarn build (GitHub Actions)' || echo "No yarn build changes to commit"
-
-      - name: Check JS build is latest
-        run: |
-          ./tools/checkJSCurrent.sh
-
+          if [ -n "$(git status --porcelain)" ]
+          then
+            git status --porcelain
+            >&2 echo "The above files changed when we built the JavaScript assets."
+            exit 1
+          else
+            echo "No difference detected; TypeScript build is current."
+          fi
 
       - name: Git Push (PR)
         uses: r-lib/actions/pr-push@master
         if: github.event_name == 'pull_request'
         with:
           repo-token: ${{ secrets.GITHUB_TOKEN }}
-      - name: Git Push (MASTER)
+      - name: Verify no un-pushed commits (MASTER)
         if: github.event_name == 'push'
         run: |
-          git push https://${{github.actor}}:${{secrets.GITHUB_TOKEN}}@github.com/${{github.repository}}.git HEAD:${{ github.ref }} || echo "No changes to push"
+          # Can't push to a protected branch
+          if [ -z "`git cherry`"]; then
+            echo "Un-pushed commits:"
+            git cherry -v
+            echo "\nCan not push to a protected branch. Exiting"
+            exit 1
+          fi
 
       # Execute after pushing, as no updated files will be produced
       - name: Test TypeScript code

.gitignore

@@ -11,5 +11,18 @@ README.html
 .*.Rnb.cached
 tools/yarn-error.log
 
+# TypeScript / yarn
+node_modules/
+.cache
+.yarn/*
+!.yarn/releases
+!.yarn/plugins
+!.yarn/sdks
+!.yarn/versions
+.pnp.*
+coverage/
+madge.svg
+
+
 # GHA remotes installation
 .github/r-depends.rds

DESCRIPTION

@@ -91,7 +91,7 @@ Imports:
     withr,
     commonmark (>= 1.7),
     glue (>= 1.3.2),
-    bslib (>= 0.2.5.9001),
+    bslib (>= 0.2.5.9002),
     cachem,
     ellipsis,
     lifecycle (>= 0.2.0)

NEWS.md

@@ -18,6 +18,8 @@ shiny 1.6.0.9000
 
 * `icon(lib="fontawesome")` is now powered by the `{fontawesome}` package, which will make it easier to use the latest FA icons in the future (by updating the `{fontawesome}` package). (#3302)
 
+* Closed #3397: `renderPlot()` new uses `ggplot2::get_alt_text()` to inform an `alt` text default (for `{ggplot2}` plots). (#3398)
+
 * `modalDialog()` gains support for `size = "xl"`. (#3410)
 
 ### Other improvements

R/input-select.R

@@ -208,6 +208,15 @@ selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
     options$plugins <- c(options$plugins, list('selectize-plugin-a11y'))
   }
 
+  # to prevent clipping of the selectize drop-down we set the dropdownParent
+  # to "body". This might be necessary if e.g. overflow-x: scroll is set
+  # on it's container, which forces overflow-y to 'auto' (as per
+  # https://developer.mozilla.org/en-US/docs/Web/CSS/overflow-y). Discussion
+  # of usage here: https://github.com/selectize/selectize.js/issues/192
+  if (is.null(options$dropdownParent)) {
+    options$dropdownParent <- "body"
+  }
+
   res <- checkAsIs(options)
 
   deps <- list(selectizeDependency())

R/input-slider.R

@@ -228,26 +228,10 @@ ionRangeSliderDependencyCSS <- function(theme) {
     ))
   }
 
-  # Remap some variable names for ionRangeSlider's scss
-  sass_input <- list(
-    list(
-      # The bootswatch materia theme sets $input-bg: transparent;
-      # which is an issue for the slider's handle(s) (#3130)
-      bg = "if(alpha($input-bg)==0, $body-bg, $input-bg)",
-      fg = sprintf(
-        "if(alpha($input-color)==0, $%s, $input-color)",
-        if ("3" %in% bslib::theme_version(theme)) "text-color" else "body-color"
-      ),
-      accent = "$component-active-bg",
-      `font-family` = "$font-family-base"
-    ),
-    sass::sass_file(
-      system.file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
-    )
-  )
-
   bslib::bs_dependency(
-    input = sass_input,
+    input = sass::sass_file(
+      system.file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
+    ),
     theme = theme,
     name = "ionRangeSlider",
     version = version_ion_range_slider,

R/insert-tab.R

@@ -112,7 +112,7 @@
 #'
 #' }
 #' @export
-insertTab <- function(inputId, tab, target,
+insertTab <- function(inputId, tab, target = NULL,
                       position = c("before", "after"), select = FALSE,
                       session = getDefaultReactiveDomain()) {
   bslib::nav_insert(
@@ -137,48 +137,14 @@ insertTab <- function(inputId, tab, target,
 #' @export
 prependTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                        session = getDefaultReactiveDomain()) {
-  force(select)
-  force(menuName)
-  inputId <- session$ns(inputId)
-
-  item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
-    textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
-
-  callback <- function() {
-    session$sendInsertTab(
-      inputId = inputId,
-      liTag = processDeps(item$liTag, session),
-      divTag = processDeps(item$divTag, session),
-      menuName = menuName,
-      target = NULL,
-      position = "after",
-      select = select)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::tab_prepend(inputId, tab, menu_title = menuName, select = select, session = session)
 }
 
 #' @rdname insertTab
 #' @export
 appendTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                       session = getDefaultReactiveDomain()) {
-  force(select)
-  force(menuName)
-  inputId <- session$ns(inputId)
-
-  item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
-    textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
-
-  callback <- function() {
-    session$sendInsertTab(
-      inputId = inputId,
-      liTag = processDeps(item$liTag, session),
-      divTag = processDeps(item$divTag, session),
-      menuName = menuName,
-      target = NULL,
-      position = "before",
-      select = select)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::tab_append(inputId, tab, menu_title = menuName, select = select, session = session)
 }
 
 #' @rdname insertTab

R/render-plot.R

@@ -36,12 +36,14 @@
 #' @param res Resolution of resulting plot, in pixels per inch. This value is
 #'   passed to [grDevices::png()]. Note that this affects the resolution of PNG
 #'   rendering in R; it won't change the actual ppi of the browser.
-#' @param alt Alternate text for the HTML `<img>` tag
-#'   if it cannot be displayed or viewed (i.e., the user uses a screen reader).
-#'   In addition to a character string, the value may be a reactive expression
-#'   (or a function referencing reactive values) that returns a character string.
-#'   NULL or "" is not recommended because those should be limited to decorative images
-#'   (the default is "Plot object").
+#' @param alt Alternate text for the HTML `<img>` tag if it cannot be displayed
+#'   or viewed (i.e., the user uses a screen reader). In addition to a character
+#'   string, the value may be a reactive expression (or a function referencing
+#'   reactive values) that returns a character string. If the value is `NA` (the
+#'   default), then `ggplot2::get_alt_text()` is used to extract alt text from
+#'   ggplot objects; for other plots, `NA` results in alt text of "Plot object".
+#'   `NULL` or `""` is not recommended because those should be limited to
+#'   decorative images.
 #' @param ... Arguments to be passed through to [grDevices::png()].
 #'   These can be used to set the width, height, background color, etc.
 #' @param env The environment in which to evaluate `expr`.
@@ -58,7 +60,7 @@
 #'   interactive R Markdown document.
 #' @export
 renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
-                       alt = "Plot object",
+                       alt = NA,
                        env = parent.frame(), quoted = FALSE,
                        execOnResize = FALSE, outputArgs = list()
 ) {
@@ -212,7 +214,7 @@ resizeSavedPlot <- function(name, session, result, width, height, alt, pixelrati
     src = session$fileUrl(name, outfile, contentType = "image/png"),
     width = width,
     height = height,
-    alt = alt,
+    alt = result$alt,
     coordmap = coordmap,
     error = attr(coordmap, "error", exact = TRUE)
   )
@@ -288,6 +290,7 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
               recordedPlot = grDevices::recordPlot(),
               coordmap = getCoordmap(value, width*pixelratio, height*pixelratio, res*pixelratio),
               pixelratio = pixelratio,
+              alt = if (anyNA(alt)) getAltText(value) else alt,
               res = res
             )
           }
@@ -302,10 +305,10 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
     ),
     function(result) {
       result$img <- dropNulls(list(
-        src = session$fileUrl(name, outfile, contentType='image/png'),
+        src = session$fileUrl(name, outfile, contentType = 'image/png'),
         width = width,
         height = height,
-        alt = alt,
+        alt = result$alt,
         coordmap = result$coordmap,
         # Get coordmap error message if present
         error = attr(result$coordmap, "error", exact = TRUE)
@@ -339,6 +342,24 @@ custom_print.ggplot <- function(x) {
   ), class = "ggplot_build_gtable")
 }
 
+# Infer alt text description from renderPlot() value
+# (currently just ggplot2 is supported)
+getAltText <- function(x, default = "Plot Object") {
+  # Since, inside renderPlot(), custom_print.ggplot()
+  # overrides print.ggplot, this class indicates a ggplot()
+  if (!inherits(x, "ggplot_build_gtable")) {
+    return(default)
+  }
+  # ggplot2::get_alt_text() was added in v3.3.4
+  # https://github.com/tidyverse/ggplot2/pull/4482
+  get_alt <- getNamespace("ggplot2")$get_alt_text
+  if (!is.function(get_alt)) {
+    return(default)
+  }
+  alt <- paste(get_alt(x$build), collapse = " ")
+  if (nzchar(alt)) alt else default
+}
+
 # The coordmap extraction functions below return something like the examples
 # below. For base graphics:
 # plot(mtcars$wt, mtcars$mpg)

inst/www/shared/ionrangeslider/css/ion.rangeSlider.css

@@ -13,8 +13,6 @@
   -moz-user-select: none;
   -ms-user-select: none;
   user-select: none;
-  font-size: 12px;
-  font-family: Arial, sans-serif;
 }
 
 .irs-line {
@@ -92,7 +90,6 @@
   left: 0;
   width: 1px;
   height: 8px;
-  background: #000;
 }
 
 .irs-grid-pol.small {
@@ -108,7 +105,6 @@
   font-size: 9px;
   line-height: 9px;
   padding: 0 3px;
-  color: #000;
 }
 
 .irs-disable-mask {
@@ -153,7 +149,7 @@
 }
 
 .irs {
-  font-family: Arial, sans-serif;
+  font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
 }
 
 .irs--shiny {
@@ -167,7 +163,7 @@
 .irs--shiny .irs-line {
   top: 25px;
   height: 8px;
-  background: linear-gradient(to bottom, #dedede -50%, white 150%);
+  background: linear-gradient(to bottom, #dedede -50%, #fff 150%);
   background-color: #ededed;
   border: 1px solid #cccccc;
   border-radius: 8px;
@@ -176,9 +172,9 @@
 .irs--shiny .irs-bar {
   top: 25px;
   height: 8px;
-  border-top: 1px solid #428bca;
-  border-bottom: 1px solid #428bca;
-  background: #428bca;
+  border-top: 1px solid #337ab7;
+  border-bottom: 1px solid #337ab7;
+  background: #337ab7;
 }
 
 .irs--shiny .irs-bar--single {
@@ -207,14 +203,13 @@
 }
 
 .irs--shiny .irs-handle.state_hover, .irs--shiny .irs-handle:hover {
-  background: white;
+  background: #fff;
 }
 
 .irs--shiny .irs-min,
 .irs--shiny .irs-max {
   top: 0;
   padding: 1px 3px;
-  color: #333333;
   text-shadow: none;
   background-color: rgba(0, 0, 0, 0.1);
   border-radius: 3px;
@@ -233,7 +228,7 @@
   color: #fff;
   text-shadow: none;
   padding: 1px 3px;
-  background-color: #428bca;
+  background-color: #337ab7;
   border-radius: 3px;
   font-size: 11px;
   line-height: 1.333;
@@ -250,12 +245,11 @@
 }
 
 .irs--shiny .irs-grid-pol {
-  background-color: black;
+  background-color: #000;
 }
 
 .irs--shiny .irs-grid-text {
   bottom: 5px;
-  color: #1a1a1a;
 }
 
 .irs--shiny .irs-grid-pol.small {