Skip to content

Commit 46a69d4

Browse files
pvictorpvictor
authored
Quercus widget (#759)
* init quercus * quercus: added update choices / clear selected methods + docs
1 parent 2e627bd commit 46a69d4

12 files changed

Lines changed: 801 additions & 3 deletions

File tree

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: shinyWidgets
22
Title: Custom Inputs Widgets for Shiny
3-
Version: 0.9.0.9100
3+
Version: 0.9.0.9200
44
Authors@R: c(
55
person("Victor", "Perrier", email = "victor.perrier@dreamrs.fr", role = c("aut", "cre", "cph")),
66
person("Fanny", "Meyer", role = "aut"),
@@ -18,7 +18,7 @@ BugReports: https://github.com/dreamRs/shinyWidgets/issues
1818
License: GPL-3
1919
Encoding: UTF-8
2020
LazyData: true
21-
RoxygenNote: 7.3.2
21+
RoxygenNote: 7.3.3
2222
Roxygen: list(markdown = TRUE)
2323
Depends:
2424
R (>= 3.1.0)

‎NAMESPACE‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@ export(prettySwitch)
7171
export(prettyToggle)
7272
export(progressBar)
7373
export(progressSweetAlert)
74+
export(quercusInput)
7475
export(radioGroupButtons)
7576
export(removeVerticalTab)
7677
export(reorderVerticalTabs)
@@ -120,6 +121,7 @@ export(updatePrettyRadioButtons)
120121
export(updatePrettySwitch)
121122
export(updatePrettyToggle)
122123
export(updateProgressBar)
124+
export(updateQuercusInput)
123125
export(updateRadioGroupButtons)
124126
export(updateSearchInput)
125127
export(updateSliderTextInput)

‎R/quercus-input.R‎

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
2+
#' @importFrom htmltools htmlDependency
3+
html_dependency_quercus <- function() {
4+
htmlDependency(
5+
name = "quercus.js",
6+
version = "0.4.1",
7+
src = c(file = system.file("packer", package = "shinyWidgets")),
8+
script = "quercus.js"
9+
)
10+
}
11+
12+
13+
#' @title Quercus Input Widget
14+
#'
15+
#' @description A Lightweight and Customizable JavaScript Treeview Library with absolutely no dependencies.
16+
#' See original widget [quercus.js](https://github.com/stefaneichert/quercus.js).
17+
#'
18+
#' @param inputId The `input` slot that will be used to access the value.
19+
#' @param label Display label for the control, or `NULL` for no label.
20+
#' @param choices A `list` of `list` in a tree structure, see [create_tree()] for examples creating the right structure.
21+
#' @param selected Inital selected values, note that you have to use node ID.
22+
#' @param ... Arguments passed to Quercus.js's Treeview JavaScript method,
23+
#' see [online documentation](https://github.com/stefaneichert/quercus.js?tab=readme-ov-file#treeview-options) for available methods or examples.
24+
#' @param nodeNameKey The key to retrieve label to use in `choices`. If [create_tree()] is used in `choices`, `nodeNameKey` must be set to `"text"`.
25+
#' @param returnValue Value returned server-side, default to `"text"` the node text,
26+
#' other possibilities are `"id"` (if no ID provided in `choices = `, one is generated) or
27+
#' `"all"` to returned all the tree under the element selected.
28+
#' @param unsetMaxWidth Default behavior in `quercus.js` is to set max-width to `600px`, this allow to disable this rule.
29+
#' @param width The width of the input, e.g. `400px`, or `"100%`.
30+
#'
31+
#' @return A `shiny.tag` object that can be used in a UI definition.
32+
#' @export
33+
#'
34+
#' @seealso [updateQuercusInput()] for updating from server.
35+
#'
36+
#' @example examples/quercus-default.R
37+
quercusInput <- function(inputId,
38+
label,
39+
choices,
40+
selected = NULL,
41+
...,
42+
nodeNameKey = "text",
43+
returnValue = c("text", "id", "all"),
44+
unsetMaxWidth = TRUE,
45+
width = NULL) {
46+
selected <- shiny::restoreInput(inputId, selected)
47+
returnValue <- match.arg(returnValue)
48+
if (!is.null(selected))
49+
selected <- as.character(selected)
50+
config <- dropNulls(list(
51+
containerId = inputId,
52+
data = toJSON(choices, auto_unbox = TRUE, json_verbatim = TRUE),
53+
nodeNameKey = nodeNameKey,
54+
...,
55+
selected = list1(selected)
56+
))
57+
config <- toJSON(config, auto_unbox = TRUE, json_verbatim = TRUE)
58+
tags$div(
59+
class = "form-group shiny-input-container",
60+
style = css(width = validateCssUnit(width)),
61+
label_input(inputId, label),
62+
tags$div(
63+
id = inputId,
64+
class = "quercus-widget",
65+
`data-return` = returnValue,
66+
tags$script(
67+
type = "application/json",
68+
`data-for` = inputId,
69+
HTML(config)
70+
)
71+
),
72+
html_dependency_quercus(),
73+
if (isTRUE(unsetMaxWidth))
74+
tags$style(sprintf("#%s.custom-treeview-wrapper { max-width: unset; }", inputId)),
75+
)
76+
}
77+
78+
79+
80+
#' @title Update Tree Input
81+
#'
82+
#' @description Update [treeInput()] from server.
83+
#'
84+
#' @inheritParams quercusInput
85+
#' @inheritParams shiny::updateCheckboxGroupInput
86+
#'
87+
#' @return No value.
88+
#' @export
89+
#'
90+
#'
91+
#' @example examples/quercus-update.R
92+
updateQuercusInput <- function(inputId,
93+
label = NULL,
94+
choices = NULL,
95+
selected = NULL,
96+
session = shiny::getDefaultReactiveDomain()) {
97+
if (!is.null(label))
98+
label <- doRenderTags(label)
99+
if (is.null(selected))
100+
selected <- character(0)
101+
message <- dropNulls(list(
102+
label = label,
103+
selected = list1(selected)
104+
))
105+
if (!is.null(choices)) {
106+
message$data <- toJSON(choices, auto_unbox = TRUE, json_verbatim = TRUE)
107+
}
108+
session$sendInputMessage(inputId, message)
109+
}
110+
111+

‎examples/quercus-default.R‎

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
2+
library(shiny)
3+
library(shinyWidgets)
4+
5+
# data
6+
cities <- data.frame(
7+
continent = c("America", "America", "America", "Africa",
8+
"Africa", "Africa", "Africa", "Africa",
9+
"Europe", "Europe", "Europe", "Antarctica"),
10+
country = c("Canada", "Canada", "USA", "Tunisia", "Tunisia",
11+
"Tunisia", "Algeria", "Algeria", "Italy", "Germany", "Spain", NA),
12+
city = c("Trois-Rivières", "Québec", "San Francisco", "Tunis",
13+
"Monastir", "Sousse", "Alger", "Oran", "Rome", "Berlin", "Madrid", NA),
14+
stringsAsFactors = FALSE
15+
)
16+
17+
# app
18+
ui <- fluidPage(
19+
theme = bslib::bs_theme(version = 5, preset = "bootstrap"),
20+
tags$h2("quercusInput() example"),
21+
fluidRow(
22+
column(
23+
width = 4,
24+
25+
quercusInput(
26+
inputId = "ID1",
27+
label = "Select cities: (initiallyExpanded = TRUE)",
28+
choices = create_tree(cities),
29+
initiallyExpanded = TRUE,
30+
returnValue = "text",
31+
width = "100%"
32+
),
33+
verbatimTextOutput("res1"),
34+
35+
quercusInput(
36+
inputId = "ID4",
37+
label = "Select cities: (multiSelectEnabled = TRUE)",
38+
choices = create_tree(cities),
39+
multiSelectEnabled = TRUE,
40+
returnValue = "text",
41+
width = "100%"
42+
),
43+
verbatimTextOutput("res4")
44+
45+
),
46+
column(
47+
width = 4,
48+
49+
quercusInput(
50+
inputId = "ID2",
51+
label = "Select cities: (searchEnabled = TRUE)",
52+
choices = create_tree(cities),
53+
searchEnabled = TRUE,
54+
returnValue = "text",
55+
width = "100%"
56+
),
57+
verbatimTextOutput("res2"),
58+
59+
quercusInput(
60+
inputId = "ID5",
61+
label = "Select cities: (checkboxSelectionEnabled = TRUE)",
62+
choices = create_tree(cities),
63+
checkboxSelectionEnabled = TRUE,
64+
returnValue = "text",
65+
width = "100%"
66+
),
67+
verbatimTextOutput("res5"),
68+
69+
quercusInput(
70+
inputId = "ID7",
71+
label = "Select cities: (cascadeSelectChildren = TRUE)",
72+
choices = create_tree(cities),
73+
cascadeSelectChildren = TRUE,
74+
returnValue = "text",
75+
width = "100%"
76+
),
77+
verbatimTextOutput("res7")
78+
79+
),
80+
column(
81+
width = 4,
82+
83+
quercusInput(
84+
inputId = "ID3",
85+
label = "Select cities: (multiSelectEnabled = TRUE, returnValue = \"all\")",
86+
choices = create_tree(cities),
87+
multiSelectEnabled = TRUE,
88+
returnValue = "all",
89+
width = "100%"
90+
),
91+
verbatimTextOutput("res3"),
92+
93+
quercusInput(
94+
inputId = "ID6a",
95+
label = "Select cities: (selected value)",
96+
choices = create_tree(cities),
97+
selected = "Monastir",
98+
returnValue = "text",
99+
width = "100%"
100+
),
101+
verbatimTextOutput("res6a"),
102+
103+
quercusInput(
104+
inputId = "ID6b",
105+
label = "Select cities: (selected valueS)",
106+
choices = create_tree(cities),
107+
multiSelectEnabled = TRUE,
108+
selected = c("Monastir", "Madrid"),
109+
returnValue = "text",
110+
width = "100%"
111+
),
112+
verbatimTextOutput("res6b")
113+
114+
)
115+
)
116+
)
117+
118+
server <- function(input, output, session) {
119+
120+
output$res1 <- renderPrint(input$ID1)
121+
output$res2 <- renderPrint(input$ID2)
122+
output$res3 <- renderPrint(input$ID3)
123+
output$res4 <- renderPrint(input$ID4)
124+
output$res5 <- renderPrint(input$ID5)
125+
output$res6a <- renderPrint(input$ID6a)
126+
output$res6b <- renderPrint(input$ID6b)
127+
output$res7 <- renderPrint(input$ID7)
128+
129+
}
130+
131+
if (interactive())
132+
shinyApp(ui, server)

‎examples/quercus-update.R‎

Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
2+
library(shiny)
3+
library(shinyWidgets)
4+
5+
# data
6+
cities <- data.frame(
7+
continent = c("America", "America", "America", "Africa",
8+
"Africa", "Africa", "Africa", "Africa",
9+
"Europe", "Europe", "Europe", "Antarctica"),
10+
country = c("Canada", "Canada", "USA", "Tunisia", "Tunisia",
11+
"Tunisia", "Algeria", "Algeria", "Italy", "Germany", "Spain", NA),
12+
city = c("Trois-Rivières", "Québec", "San Francisco", "Tunis",
13+
"Monastir", "Sousse", "Alger", "Oran", "Rome", "Berlin", "Madrid", NA),
14+
stringsAsFactors = FALSE
15+
)
16+
17+
# app
18+
ui <- fluidPage(
19+
theme = bslib::bs_theme(version = 5, preset = "bootstrap"),
20+
tags$h2("updateQuercusInput() example"),
21+
fluidRow(
22+
column(
23+
width = 6,
24+
quercusInput(
25+
inputId = "ID1",
26+
label = "Select cities:",
27+
choices = create_tree(cities),
28+
multiSelectEnabled = TRUE,
29+
initiallyExpanded = TRUE,
30+
returnValue = "text"
31+
),
32+
verbatimTextOutput("res1")
33+
),
34+
column(
35+
width = 6,
36+
textInput(
37+
inputId = "label",
38+
label = "Update label:",
39+
value = "Select cities:"
40+
),
41+
checkboxGroupInput(
42+
inputId = "val_country",
43+
label = "Select countries:",
44+
choices = unique(cities$country),
45+
inline = TRUE
46+
),
47+
checkboxGroupInput(
48+
inputId = "val_city",
49+
label = "Select cities:",
50+
choices = unique(cities$city),
51+
inline = TRUE
52+
),
53+
actionButton("clear", "Clear selected"),
54+
actionButton("update", "Update choices"),
55+
actionButton("back", "Back to first choices")
56+
)
57+
)
58+
)
59+
60+
server <- function(input, output, session) {
61+
62+
output$res1 <- renderPrint(input$ID1)
63+
64+
observe(
65+
updateTreeInput(inputId = "ID1", label = input$label)
66+
)
67+
68+
observe(
69+
updateQuercusInput(inputId = "ID1", selected = input$val_country)
70+
)
71+
72+
observe(
73+
updateQuercusInput(inputId = "ID1", selected = input$val_city)
74+
)
75+
76+
observeEvent(input$clear, {
77+
updateQuercusInput(inputId = "ID1", selected = character(0))
78+
updateCheckboxGroupInput(inputId = "val_country", selected = character(0))
79+
updateCheckboxGroupInput(inputId = "val_city", selected = character(0))
80+
})
81+
82+
observeEvent(input$update, {
83+
cities <- data.frame(
84+
continent = c("Asia", "Asia", "Asia", "Australia",
85+
"Australia", "Australia", "Australia", "Australia",
86+
"South America", "South America", "South America", "Arctic"),
87+
country = c("Japan", "Japan", "China", "Australia", "Australia",
88+
"Australia", "New Zealand", "New Zealand",
89+
"Brazil", "Argentina", "Chile", NA),
90+
city = c("Tokyo", "Kyoto", "Beijing", "Sydney",
91+
"Melbourne", "Perth", "Auckland", "Wellington",
92+
"São Paulo", "Buenos Aires", "Santiago", NA),
93+
stringsAsFactors = FALSE
94+
)
95+
updateQuercusInput(inputId = "ID1", choices = create_tree(cities))
96+
})
97+
98+
observeEvent(input$back, {
99+
updateQuercusInput(inputId = "ID1", choices = create_tree(cities))
100+
})
101+
}
102+
103+
if (interactive())
104+
shinyApp(ui, server)

‎inst/packer/quercus.js‎

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)
⚡