From 003b6d82d8279aae733b8d3363b60aae65ddb6cc Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 24 Feb 2025 16:56:28 -0500 Subject: [PATCH 1/6] keyboard: regular keydown events --- inst/helpers/keyboard.R | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/inst/helpers/keyboard.R b/inst/helpers/keyboard.R index 0faacfe978..becb33b65c 100644 --- a/inst/helpers/keyboard.R +++ b/inst/helpers/keyboard.R @@ -33,12 +33,12 @@ key_press_factory <- function(app) { ) modifiers <- 0 - if (shift) modifiers <- modifiers + 8 + if (shift) modifiers <- modifiers + 8 if (command) modifiers <- modifiers + 4 if (control) modifiers <- modifiers + 2 - if (alt) modifiers <- modifiers + 1 + if (alt) modifiers <- modifiers + 1 - events <- + keydown <- if (!is.null(virtual_code)) { brwsr$Input$dispatchKeyEvent( "rawKeyDown", windowsVirtualKeyCode = virtual_code, @@ -46,7 +46,18 @@ key_press_factory <- function(app) { key = key, modifiers = modifiers, wait_ = FALSE - )$then(function(value) { + ) + } else { + brwsr$Input$dispatchKeyEvent( + "keyDown", + text = which, + modifiers = modifiers, + wait_ = FALSE + ) + } + + events <- + keydown$then(function(value) { brwsr$Input$dispatchKeyEvent( "keyUp", windowsVirtualKeyCode = virtual_code, From 3660c36f3884ac8b88b7ef32e24d09f000d2ffac Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 24 Feb 2025 16:56:11 -0500 Subject: [PATCH 2/6] 320-text-input-update-on-blur --- inst/apps/320-text-input-update-on-blur/app.R | 144 ++++++++ .../tests/testthat.R | 1 + .../tests/testthat/setup-shinytest2.R | 3 + .../test-320-text-input-update-on-blur.R | 322 ++++++++++++++++++ 4 files changed, 470 insertions(+) create mode 100644 inst/apps/320-text-input-update-on-blur/app.R create mode 100644 inst/apps/320-text-input-update-on-blur/tests/testthat.R create mode 100644 inst/apps/320-text-input-update-on-blur/tests/testthat/setup-shinytest2.R create mode 100644 inst/apps/320-text-input-update-on-blur/tests/testthat/test-320-text-input-update-on-blur.R diff --git a/inst/apps/320-text-input-update-on-blur/app.R b/inst/apps/320-text-input-update-on-blur/app.R new file mode 100644 index 0000000000..b3e53fa9bd --- /dev/null +++ b/inst/apps/320-text-input-update-on-blur/app.R @@ -0,0 +1,144 @@ +# https://github.com/rstudio/shiny/pull/4183 +library(shiny) + +random_values <- list( + word = c( + "serendipity", + "ephemeral", + "mellifluous", + "nebulous", + "quintessential", + "ethereal", + "luminescent", + "cascade", + "zenith", + "labyrinth" + ), + + sentence = c( + "The old oak tree whispered secrets to the wind.", + "Clouds painted shadows on the mountain peaks.", + "Stars danced across the midnight canvas.", + "Time flows like honey on a summer day.", + "Music filled the empty spaces between thoughts." + ), + + number = c( + 42, + 3.14159, + 1729, + 2.71828, + 1.41421, + 987654321, + 123.456, + 7.77777, + 9999.99, + 0.12345 + ), + + password = c( + "Tr0ub4dor&3", + "P@ssw0rd123!", + "C0mpl3x1ty#", + "S3cur3P@ss", + "Str0ngP@55w0rd", + "Un1qu3C0d3!", + "K3yM@st3r99", + "P@ssPhr@s3" + ) +) + +random_value <- function(category, index) { + selected_list <- random_values[[category]] + wrapped_index <- (index - 1) %% length(selected_list) + 1 + + return(selected_list[wrapped_index]) +} + + +text_input_ui <- function(updateOn = "change") { + ns <- NS(updateOn) + + tagList( + h2(sprintf('updateOn="%s"', updateOn)), + textInput(ns("txt"), "Text", "Hello", updateOn = updateOn), + textAreaInput(ns("txtarea"), "Text Area", updateOn = updateOn), + numericInput(ns("num"), "Numeric", 1, updateOn = updateOn), + passwordInput(ns("pwd"), "Password", updateOn = updateOn), + verbatimTextOutput(ns("value")), + actionButton(ns("update_text"), "Update Text"), + actionButton(ns("update_text_area"), "Update Text Area"), + actionButton(ns("update_number"), "Update Number"), + actionButton(ns("update_pwd"), "Update Password"), + ) +} + +text_input_server <- function(id) { + moduleServer(id, function(input, output, session) { + output$value <- renderText({ + paste( + "---- Text ----", + input$txt, + "---- Text Area ----", + input$txtarea, + "---- Numeric ----", + input$num, + "---- Password ----", + input$pwd, + sep = "\n" + ) + }) + + observeEvent(input$update_text, { + updateTextInput( + session, + "txt", + value = paste( + random_value("word", input$update_text + 0:1), + collapse = " " + ) + ) + }) + + observeEvent(input$update_text_area, { + updateTextAreaInput( + session, + "txtarea", + value = paste( + random_value("sentence", input$update_text_area + 0:1), + collapse = "\n" + ) + ) + }) + + observeEvent(input$update_number, { + updateNumericInput( + session, + "num", + value = random_value("number", input$update_number) + ) + }) + + observeEvent(input$update_pwd, { + updateTextInput( + session, + "pwd", + value = random_value("password", input$update_pwd) + ) + }) + }) +} + +ui <- fluidPage( + fluidRow( + column(6, class = "col-sm-12", text_input_ui("change")), + column(6, class = "col-sm-12", text_input_ui("blur")) + ) +) + +server <- function(input, output, session) { + text_input_server("change") + text_input_server("blur") +} + +shinyApp(ui, server) diff --git a/inst/apps/320-text-input-update-on-blur/tests/testthat.R b/inst/apps/320-text-input-update-on-blur/tests/testthat.R new file mode 100644 index 0000000000..7d25b5b9e4 --- /dev/null +++ b/inst/apps/320-text-input-update-on-blur/tests/testthat.R @@ -0,0 +1 @@ +shinytest2::test_app() diff --git a/inst/apps/320-text-input-update-on-blur/tests/testthat/setup-shinytest2.R b/inst/apps/320-text-input-update-on-blur/tests/testthat/setup-shinytest2.R new file mode 100644 index 0000000000..e739c4dd99 --- /dev/null +++ b/inst/apps/320-text-input-update-on-blur/tests/testthat/setup-shinytest2.R @@ -0,0 +1,3 @@ +# Load application support files into testing environment +shinytest2::load_app_env() + diff --git a/inst/apps/320-text-input-update-on-blur/tests/testthat/test-320-text-input-update-on-blur.R b/inst/apps/320-text-input-update-on-blur/tests/testthat/test-320-text-input-update-on-blur.R new file mode 100644 index 0000000000..f832dbfc3a --- /dev/null +++ b/inst/apps/320-text-input-update-on-blur/tests/testthat/test-320-text-input-update-on-blur.R @@ -0,0 +1,322 @@ +library(shinytest2) +if (FALSE) library(shinycoreci) # for renv + +source(system.file("helpers", "keyboard.R", package = "shinycoreci")) + +expect_js <- function(app, js, label = NULL) { + expect_true( + app$wait_for_js(!!js)$get_js(!!js), + label = label + ) + invisible(app) +} + +app_focus_element <- function(app, selector) { + js <- sprintf( + "const el = document.querySelector('%s'); el.focus(); el.matches(':focus');", + selector + ) + expect_js(app, js, label = paste("focus on:", selector)) +} + +app_get_value <- function(app, selector) { + app$get_js(sprintf("document.querySelector('%s').value", selector)) +} + +# Setup App -------------------------------------------------- +app <- AppDriver$new( + name = "320-text-input-update-on-blur", + variant = platform_variant(), + height = 800, + width = 1200, + seed = 20230724, + view = interactive(), + options = list(bslib.precompiled = FALSE), + expect_values_screenshot_args = FALSE, + screenshot_args = list(selector = "viewport", delay = 0.5) +) +withr::defer(app$stop()) + +key_press <- key_press_factory(app) + +key_press_write <- function(text) { + for (letter in strsplit(text, character())[[1]]) { + key_press(letter) + } +} + +test_that("textInput() -- updateOn='change'", { + VALUE <- "Hello" + app$set_inputs("change-txt" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "change-txt"), VALUE) + + app_focus_element(app, "#change-txt") + key_press("End") + key_press_write(", world") + + # input has updated, even though it still has focus + Sys.sleep(0.5) + VALUE <- "Hello, world" + expect_equal(app$get_value(input = "change-txt"), VALUE) + expect_js(app, "$('#change-txt').is(':focus')") + + app$click("change-update_text") + VALUE <- "serendipity ephemeral" + expect_equal(app$get_value(input = "change-txt"), VALUE) +}) + +test_that("textInput() -- updateOn='blur'", { + VALUE <- "Hello" + app$set_inputs("blur-txt" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "blur-txt"), VALUE) + + app_focus_element(app, "#blur-txt") + key_press("End") + key_press_write(", world") + + # input has not updated yet + expect_equal(app$get_value(input = "blur-txt"), VALUE) + + # input updates after blur + app$get_js("$('#blur-txt').blur()") + VALUE <- "Hello, world" + expect_equal(app$get_value(input = "blur-txt"), VALUE) + + # input updates on Enter + app_focus_element(app, "#blur-txt") + key_press("End") + key_press_write("!") + + expect_equal(app$get_value(input = "blur-txt"), VALUE) + key_press("Enter") + VALUE <- "Hello, world!" + expect_equal(app$get_value(input = "blur-txt"), VALUE) + + app$click('blur-update_text') + expect_equal( + app$get_js("document.querySelector('#blur-txt').value"), + "serendipity ephemeral" + ) + expect_equal(app$get_value(input = "blur-txt"), VALUE) + app$click('blur-update_text') + expect_equal( + app$get_js("document.querySelector('#blur-txt').value"), + "ephemeral mellifluous" + ) + expect_equal(app$get_value(input = "blur-txt"), VALUE) + + key_press("Enter") + VALUE <- "ephemeral mellifluous" + expect_equal(app$get_value(input = "blur-txt"), VALUE) +}) + +test_that("textAreaInput() -- updateOn='change'", { + VALUE <- "Hello" + app$set_inputs("change-txtarea" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "change-txtarea"), VALUE) + + app_focus_element(app, "#change-txtarea") + key_press("End") + key_press_write(", world") + + # input has updated, even though it still has focus + Sys.sleep(0.5) + VALUE <- "Hello, world" + expect_equal(app$get_value(input = "change-txtarea"), VALUE) + expect_js(app, "$('#change-txtarea').is(':focus')") + + app$click("change-update_text_area") + VALUE <- "The old oak tree whispered secrets to the wind.\nClouds painted shadows on the mountain peaks." + expect_equal( + app$get_value(input = "change-txtarea"), + VALUE + ) +}) + +test_that("textAreaInput() -- updateOn='blur'", { + VALUE <- "Hello" + app$set_inputs("blur-txtarea" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + app_focus_element(app, "#blur-txtarea") + key_press("End") + key_press_write(", world") + + # input has not updated yet + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + # input updates after blur + app$get_js("$('#blur-txtarea').blur()") + VALUE <- "Hello, world" + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + # input does not update on Enter + app_focus_element(app, "#blur-txtarea") + key_press("End") + key_press_write("!") + + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + key_press("Enter") + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + # input updates on Command/Control + Enter + key_press("Enter", command = TRUE, control = TRUE) + VALUE <- "Hello, world!" + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + app$click('blur-update_text_area') + expect_equal( + app$get_js("document.querySelector('#blur-txtarea').value"), + "The old oak tree whispered secrets to the wind.\nClouds painted shadows on the mountain peaks." + ) + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + app$click('blur-update_text_area') + expect_equal( + app$get_js("document.querySelector('#blur-txtarea').value"), + "Clouds painted shadows on the mountain peaks.\nStars danced across the midnight canvas." + ) + expect_equal(app$get_value(input = "blur-txtarea"), VALUE) + + key_press("Enter", command = TRUE, control = TRUE) + VALUE <- "Clouds painted shadows on the mountain peaks.\nStars danced across the midnight canvas." + expect_equal( + app$get_value(input = "blur-txtarea"), + VALUE + ) +}) + +# ---- numericInput() ---------------------------------------------------------- + +test_that("numericInput() -- updateOn='change'", { + VALUE <- 10 + app$set_inputs("change-num" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "change-num"), VALUE) + + app_focus_element(app, "#change-num") + key_press("ArrowUp") + + # input has updated immediately + VALUE <- 11 + expect_equal(app$get_value(input = "change-num"), VALUE) + + key_press("ArrowDown") + key_press("ArrowDown") + + # input has updated immediately + VALUE <- 9 + expect_equal(app$get_value(input = "change-num"), VALUE) + + app$click("change-update_number") + VALUE <- 42 + expect_equal(app$get_value(input = "change-num"), VALUE) +}) + +test_that("numericInput() -- updateOn='blur'", { + VALUE <- 10 + app$set_inputs("blur-num" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "blur-num"), VALUE) + + app_focus_element(app, "#blur-num") + key_press("ArrowUp") + + # input has not updated yet + expect_equal(app$get_value(input = "blur-num"), VALUE) + + # input updates after blur + app$get_js("$('#blur-num').blur()") + VALUE <- 11 + expect_equal(app$get_value(input = "blur-num"), VALUE) + + # input updates on Enter + app_focus_element(app, "#blur-num") + key_press("ArrowDown") + key_press("ArrowDown") + + expect_equal(app$get_value(input = "blur-num"), VALUE) + key_press("Enter") + VALUE <- 9 + expect_equal(app$get_value(input = "blur-num"), VALUE) + + app$click('blur-update_number') + expect_equal( + app$get_js("document.querySelector('#blur-num').value"), + "42" + ) + expect_equal(app$get_value(input = "blur-num"), VALUE) + app$click('blur-update_number') + expect_equal( + app$get_js("document.querySelector('#blur-num').value"), + "3.14159" + ) + expect_equal(app$get_value(input = "blur-num"), VALUE) + + key_press("Enter") + VALUE <- 3.14159 + expect_equal(app$get_value(input = "blur-num"), VALUE) +}) + +# ---- passwordInput() --------------------------------------------------------- +test_that("passwordInput() -- updateOn='change'", { + VALUE <- "H3ll0" + app$set_inputs("change-pwd" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "change-pwd"), VALUE) + + app_focus_element(app, "#change-pwd") + key_press("End") + key_press_write("_w0r1d") + + # input has updated, even though it still has focus + Sys.sleep(0.5) + VALUE <- "H3ll0_w0r1d" + expect_equal(app$get_value(input = "change-pwd"), VALUE) + expect_js(app, "$('#change-pwd').is(':focus')") + + app$click("change-update_pwd") + VALUE <- "Tr0ub4dor&3" + expect_equal(app$get_value(input = "change-pwd"), VALUE) +}) + +test_that("passwordInput() -- updateOn='blur'", { + VALUE <- "H3ll0" + app$set_inputs("blur-pwd" = VALUE, wait_ = FALSE) + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + + app_focus_element(app, "#blur-pwd") + key_press("End") + key_press_write("_w0r1d") + + # input has not updated yet + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + + # input updates after blur + app$get_js("$('#blur-pwd').blur()") + VALUE <- "H3ll0_w0r1d" + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + + # input updates on Enter + app_focus_element(app, "#blur-pwd") + key_press("End") + key_press_write("!") + + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + key_press("Enter") + VALUE <- "H3ll0_w0r1d!" + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + + app$click('blur-update_pwd') + expect_equal( + app$get_js("document.querySelector('#blur-pwd').value"), + "Tr0ub4dor&3" + ) + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + app$click('blur-update_pwd') + expect_equal( + app$get_js("document.querySelector('#blur-pwd').value"), + "P@ssw0rd123!" + ) + expect_equal(app$get_value(input = "blur-pwd"), VALUE) + + key_press("Enter") + VALUE <- "P@ssw0rd123!" + expect_equal(app$get_value(input = "blur-pwd"), VALUE) +}) From 3d8a6939278c70e89ed576450d4f9df399906f26 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 24 Feb 2025 16:57:49 -0500 Subject: [PATCH 3/6] temp: Use shiny version from PR --- DESCRIPTION | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8aeb2f9edb..b0aea18250 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,6 +21,7 @@ Imports: rprojroot, rstudioapi (>= 0.11), sessioninfo, + shiny (>= 1.10.0.9000), utils, withr Suggests: @@ -33,7 +34,6 @@ Suggests: renv, rmarkdown (>= 2.9), rsconnect (>= 1.0.1), - shiny, shinytest, testthat, tibble, @@ -43,3 +43,5 @@ Config/Needs/website: tidyverse/tidytemplate Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 +Remotes: + rstudio/shiny@text-input-enter From 7c3c22bce5eaad491b5a869e441c917bf682bfe7 Mon Sep 17 00:00:00 2001 From: gadenbuie Date: Mon, 24 Feb 2025 22:00:49 +0000 Subject: [PATCH 4/6] Generate apps deps (GitHub Actions) --- R/data-apps-deps.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/data-apps-deps.R b/R/data-apps-deps.R index c58f857cc8..20b573360d 100644 --- a/R/data-apps-deps.R +++ b/R/data-apps-deps.R @@ -176,6 +176,7 @@ apps_deps_map <- list( `316-bslib-popovers` = c("bsicons", "bslib", "plotly", "rversions", "shiny", "shinycoreci", "shinytest2", "testthat", "withr"), `317-nav-insert` = c("bslib", "htmltools", "leaflet", "rversions", "shiny", "shinycoreci", "shinytest2", "testthat", "withr"), `318-navbar-colors` = c("bslib", "jsonlite", "rlang", "rprojroot", "shiny", "shinytest2", "testthat", "withr"), + `320-text-input-update-on-blur` = c("shiny", "shinycoreci", "shinytest2", "withr"), `900-text-jster` = c("shiny", "shinyjster", "shinytest2"), `901-button-jster` = c("shiny", "shinyjster", "shinytest2") ) From ee5e0d486dcb4b2a58001885c394a9a5ef7418ea Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Mon, 24 Feb 2025 17:11:15 -0500 Subject: [PATCH 5/6] ci: run again From d61c1255724bf5ac7d0b97f7263e9accdd6d42b3 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Wed, 26 Feb 2025 13:52:25 -0500 Subject: [PATCH 6/6] Revert "temp: Use shiny version from PR" This reverts commit 3d8a6939278c70e89ed576450d4f9df399906f26. --- DESCRIPTION | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b0aea18250..8aeb2f9edb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,6 @@ Imports: rprojroot, rstudioapi (>= 0.11), sessioninfo, - shiny (>= 1.10.0.9000), utils, withr Suggests: @@ -34,6 +33,7 @@ Suggests: renv, rmarkdown (>= 2.9), rsconnect (>= 1.0.1), + shiny, shinytest, testthat, tibble, @@ -43,5 +43,3 @@ Config/Needs/website: tidyverse/tidytemplate Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 -Remotes: - rstudio/shiny@text-input-enter