Skip to content

Commit 1ee38c1

Browse files
gadenbuiegadenbuie
authored
Add 313-card-tab-focus (#178)
Co-authored-by: gadenbuie <[email protected]>
1 parent 746ca04 commit 1ee38c1

20 files changed

+540
-104
lines changed

‎R/data-apps-deps.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,4 +60,5 @@ apps_deps_map <- list(`001-hello` = "rsconnect", `012-datatables` = "ggplot2",
6060
"rversions"), `305-bslib-value-box` = c("rlang", "rversions"
6161
), `309-flexdashboard-tabs-navs` = "rmarkdown", `310-bslib-sidebar-dynamic` = c("rversions",
6262
"testthat"), `311-bslib-sidebar-toggle-methods` = c("rversions",
63-
"testthat"))
63+
"testthat"), `313-bslib-card-tab-focus` = c("rversions",
64+
"testthat", "withr"))

‎inst/apps/311-bslib-sidebar-toggle-methods/app.R‎

Lines changed: 42 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -17,59 +17,57 @@ animals <- c(
1717
"otter", "panda", "panther", "penguin", "zebra"
1818
)
1919

20-
sb <- layout_column_wrap(
21-
width = 500,
22-
id = "sidebar-here",
23-
layout_sidebar(
24-
id = "main_outer",
25-
sidebar = sidebar(
26-
"Outer Sidebar",
27-
id = "sidebar_outer",
28-
width = 150,
29-
bg = color_pairs[[1]]$dark,
30-
open = "desktop",
31-
max_height_mobile = "300px",
32-
selectInput(
33-
"adjective",
34-
"Adjective",
35-
choices = adjectives,
36-
selected = adjectives[1]
37-
)
38-
),
39-
height = 300,
40-
class = "p-0",
41-
fillable = TRUE,
20+
ui <- page_fixed(
21+
h1("Dynamic Sidebars"),
22+
tags$head(tags$title("bslib | Tests | Dynamic Sidebars")),
23+
p(
24+
"Test tab focus order: main, inner sidebar, outer sidebar.",
25+
"Test server-side open and close of sidebars."
26+
),
27+
layout_column_wrap(
28+
width = 500,
29+
id = "sidebar-here",
4230
layout_sidebar(
43-
id = "main_inner",
31+
id = "main_outer",
4432
sidebar = sidebar(
45-
"Inner Sidebar",
46-
id = "sidebar_inner",
33+
"Outer Sidebar",
34+
id = "sidebar_outer",
4735
width = 150,
48-
bg = color_pairs[[1]]$light,
36+
bg = color_pairs[[1]]$dark,
4937
open = "desktop",
38+
max_height_mobile = "300px",
5039
selectInput(
51-
"animal",
52-
"Animal",
53-
choices = animals,
54-
selected = animals[1]
40+
"adjective",
41+
"Adjective",
42+
choices = adjectives,
43+
selected = adjectives[1]
5544
)
5645
),
57-
border = FALSE,
58-
border_radius = FALSE,
59-
h2("Sidebar Layout"),
60-
uiOutput("ui_content", tabindex = 0)
46+
height = 300,
47+
class = "p-0",
48+
fillable = TRUE,
49+
layout_sidebar(
50+
id = "main_inner",
51+
sidebar = sidebar(
52+
"Inner Sidebar",
53+
id = "sidebar_inner",
54+
width = 150,
55+
bg = color_pairs[[1]]$light,
56+
open = "desktop",
57+
selectInput(
58+
"animal",
59+
"Animal",
60+
choices = animals,
61+
selected = animals[1]
62+
)
63+
),
64+
border = FALSE,
65+
border_radius = FALSE,
66+
h2("Sidebar Layout"),
67+
uiOutput("ui_content", tabindex = 0),
68+
)
6169
)
62-
)
63-
)
64-
65-
ui <- page_fixed(
66-
h1("Dynamic Sidebars"),
67-
tags$head(tags$title("bslib | Tests | Dynamic Sidebars")),
68-
p(
69-
"Test tab focus order: main, inner sidebar, outer sidebar.",
70-
"Test server-side open and close of sidebars."
7170
),
72-
tagAppendAttributes(sb, class = "mb-4", id = "layout"),
7371
div(
7472
class = "my-2",
7573
actionButton("show_all", "Show all"),

‎inst/apps/311-bslib-sidebar-toggle-methods/tests/testthat/test-shinytest2.R‎

Lines changed: 1 addition & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -12,58 +12,7 @@ is_mac_release <- identical(paste0("mac-", release), platform_variant())
1212

1313
DO_SCREENSHOT <- is_testing_on_ci && is_mac_release
1414

15-
key_press_factory <- function(app) {
16-
brwsr <- app$get_chromote_session()
17-
18-
function(which = "Tab", shift = FALSE) {
19-
virtual_code <- switch(
20-
which,
21-
Tab = 9,
22-
Enter = 13,
23-
Escape = 27,
24-
ArrowLeft = 37,
25-
ArrowUp = 38,
26-
ArrowRight = 39,
27-
ArrowDown = 40,
28-
Backspace = 8,
29-
Delete = 46,
30-
Home = 36,
31-
End = 35,
32-
PageUp = 33,
33-
PageDown = 34,
34-
Space = 32
35-
)
36-
37-
modifiers <- 0
38-
if (shift) modifiers <- modifiers + 8
39-
# if (command) modifiers <- modifiers + 4
40-
# if (control) modifiers <- modifiers + 2
41-
# if (alt) modifiers <- modifiers + 1
42-
43-
events <-
44-
brwsr$Input$dispatchKeyEvent(
45-
"rawKeyDown",
46-
windowsVirtualKeyCode = virtual_code,
47-
code = which,
48-
key = which,
49-
modifiers = modifiers,
50-
wait_ = FALSE
51-
)$then(
52-
brwsr$Input$dispatchKeyEvent(
53-
"keyUp",
54-
windowsVirtualKeyCode = virtual_code,
55-
code = which,
56-
key = which,
57-
modifiers = modifiers,
58-
wait_ = FALSE
59-
)
60-
)
61-
62-
brwsr$wait_for(events)
63-
64-
invisible(app)
65-
}
66-
}
15+
source(system.file("helpers", "keyboard.R", package = "shinycoreci"))
6716

6817
expect_sidebar_hidden_factory <- function(app) {
6918
function(which = c("inner", "outer")) {

‎inst/apps/313-bslib-card-tab-focus/README.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
## 313-bslib-card-tab-focus
2+
3+
`313-bslib-card-tab-focus` tests the tab focus order of full screen cards.

‎inst/apps/313-bslib-card-tab-focus/app.R‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
library(shiny)
2+
library(bslib)
3+
4+
ui <- page_fixed(
5+
h1("Dynamic Sidebars"),
6+
tags$head(tags$title("bslib | Tests | Dynamic Sidebars")),
7+
div(id = "neutral-focus-zone", tabindex = "-1"),
8+
layout_column_wrap(
9+
width = 1 / 2,
10+
card(
11+
id = "card-no-inputs",
12+
full_screen = TRUE,
13+
card_header("Nothing to focus on here"),
14+
shiny::p(
15+
"This is a boring card with just some plain text.",
16+
"There's something to read here but there aren't any inputs to focus on.",
17+
"Tabbing will only move focus to the \"Close\" button."
18+
)
19+
),
20+
card(
21+
id = "card-with-inputs",
22+
full_screen = TRUE,
23+
card_header("Inputs, oh my!"),
24+
shiny::p(
25+
"Here's a bit of text! This card does have stuff to focus on, and the",
26+
"first focusable element is automatically focused when the card is expanded.",
27+
"Try tabbing through the inputs, you can't leave!"
28+
),
29+
layout_column_wrap(
30+
width = "200px",
31+
class = "mb-3",
32+
card(
33+
id = "card-with-inputs-left",
34+
full_screen = TRUE,
35+
card_title("Left Column", class = "mb-3"),
36+
shiny::selectInput("letter", "Letter", letters, selected = "a"),
37+
shiny::selectizeInput("letter2", "Letter 2", letters, selected = "b", multiple = TRUE),
38+
shiny::dateRangeInput("dates", "Pick a Date")
39+
),
40+
card(
41+
id = "card-with-inputs-right",
42+
full_screen = TRUE,
43+
card_title("Right Column", class = "mb-3"),
44+
shiny::sliderInput("slider", "Pick a Number", min = 1, max = 10, value = 5),
45+
shiny::textInput("word", "Word", "hello"),
46+
shiny::textAreaInput("sentence", "Sentence", "hello world")
47+
)
48+
),
49+
shiny::actionButton("go", "Go")
50+
),
51+
card(
52+
id = "card-with-plot",
53+
full_screen = TRUE,
54+
card_header("A plotly plot"),
55+
textInput("search", "Search", "search or something"),
56+
plotly::plot_ly(x = rnorm(1e4), y = rnorm(1e4))
57+
)
58+
)
59+
)
60+
61+
server <- function(input, output, session) {
62+
# no server logic
63+
}
64+
65+
shinyApp(ui, server)

‎inst/apps/313-bslib-card-tab-focus/tests/testthat.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
shinytest2::test_app()

‎inst/apps/313-bslib-card-tab-focus/tests/testthat/_snaps/mac-4.3/313-bslib-card-tab-focus/313-bslib-card-tab-focus-001.png‎

41.4 KB
Loading

‎inst/apps/313-bslib-card-tab-focus/tests/testthat/_snaps/mac-4.3/313-bslib-card-tab-focus/313-bslib-card-tab-focus-002.png‎

68.5 KB
Loading

‎inst/apps/313-bslib-card-tab-focus/tests/testthat/_snaps/mac-4.3/313-bslib-card-tab-focus/313-bslib-card-tab-focus-003.png‎

35.1 KB
Loading

‎inst/apps/313-bslib-card-tab-focus/tests/testthat/_snaps/mac-4.3/313-bslib-card-tab-focus/313-bslib-card-tab-focus-004.png‎

36.9 KB
Loading

0 commit comments

Comments
 (0)