Quercus widget

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: shinyWidgets
 Title: Custom Inputs Widgets for Shiny
-Version: 0.9.0.9100
+Version: 0.9.0.9200
 Authors@R: c(
   person("Victor", "Perrier", email = "victor.perrier@dreamrs.fr", role = c("aut", "cre", "cph")),
   person("Fanny", "Meyer", role = "aut"),
@@ -18,7 +18,7 @@ BugReports: https://github.com/dreamRs/shinyWidgets/issues
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Roxygen: list(markdown = TRUE)
 Depends:
     R (>= 3.1.0)

NAMESPACE

@@ -71,6 +71,7 @@ export(prettySwitch)
 export(prettyToggle)
 export(progressBar)
 export(progressSweetAlert)
+export(quercusInput)
 export(radioGroupButtons)
 export(removeVerticalTab)
 export(reorderVerticalTabs)
@@ -120,6 +121,7 @@ export(updatePrettyRadioButtons)
 export(updatePrettySwitch)
 export(updatePrettyToggle)
 export(updateProgressBar)
+export(updateQuercusInput)
 export(updateRadioGroupButtons)
 export(updateSearchInput)
 export(updateSliderTextInput)

R/quercus-input.R

@@ -0,0 +1,111 @@
+
+#' @importFrom htmltools htmlDependency
+html_dependency_quercus <- function() {
+  htmlDependency(
+    name = "quercus.js",
+    version = "0.4.1",
+    src = c(file = system.file("packer", package = "shinyWidgets")),
+    script = "quercus.js"
+  )
+}
+
+
+#' @title Quercus Input Widget
+#'
+#' @description A Lightweight and Customizable JavaScript Treeview Library with absolutely no dependencies.
+#'  See original widget [quercus.js](https://github.com/stefaneichert/quercus.js).
+#'
+#' @param inputId The `input` slot that will be used to access the value.
+#' @param label Display label for the control, or `NULL` for no label.
+#' @param choices A `list` of `list` in a tree structure, see [create_tree()] for examples creating the right structure.
+#' @param selected Inital selected values, note that you have to use node ID.
+#' @param ... Arguments passed to Quercus.js's Treeview JavaScript method,
+#'  see [online documentation](https://github.com/stefaneichert/quercus.js?tab=readme-ov-file#treeview-options) for available methods or examples.
+#' @param nodeNameKey The key to retrieve label to use in `choices`. If [create_tree()] is used in `choices`, `nodeNameKey` must be set to `"text"`.
+#' @param returnValue Value returned server-side, default to `"text"` the node text,
+#'  other possibilities are `"id"` (if no ID provided in `choices = `, one is generated) or
+#'  `"all"` to returned all the tree under the element selected.
+#' @param unsetMaxWidth Default behavior in `quercus.js` is to set max-width to `600px`, this allow to disable this rule.
+#' @param width The width of the input, e.g. `400px`, or `"100%`.
+#'
+#' @return A `shiny.tag` object that can be used in a UI definition.
+#' @export
+#'
+#' @seealso [updateQuercusInput()] for updating from server.
+#'
+#' @example examples/quercus-default.R
+quercusInput <- function(inputId,
+                         label,
+                         choices,
+                         selected = NULL,
+                         ...,
+                         nodeNameKey = "text",
+                         returnValue = c("text", "id", "all"),
+                         unsetMaxWidth = TRUE,
+                         width = NULL) {
+  selected <- shiny::restoreInput(inputId, selected)
+  returnValue <- match.arg(returnValue)
+  if (!is.null(selected))
+    selected <- as.character(selected)
+  config <- dropNulls(list(
+    containerId = inputId,
+    data = toJSON(choices, auto_unbox = TRUE, json_verbatim = TRUE),
+    nodeNameKey = nodeNameKey,
+    ...,
+    selected = list1(selected)
+  ))
+  config <- toJSON(config, auto_unbox = TRUE, json_verbatim = TRUE)
+  tags$div(
+    class = "form-group shiny-input-container",
+    style = css(width = validateCssUnit(width)),
+    label_input(inputId, label),
+    tags$div(
+      id = inputId,
+      class = "quercus-widget",
+      `data-return` = returnValue,
+      tags$script(
+        type = "application/json",
+        `data-for` = inputId,
+        HTML(config)
+      )
+    ),
+    html_dependency_quercus(),
+    if (isTRUE(unsetMaxWidth))
+      tags$style(sprintf("#%s.custom-treeview-wrapper { max-width: unset; }", inputId)),
+  )
+}
+
+
+
+#' @title Update Tree Input
+#'
+#' @description Update [treeInput()] from server.
+#'
+#' @inheritParams quercusInput
+#' @inheritParams shiny::updateCheckboxGroupInput
+#'
+#' @return No value.
+#' @export
+#'
+#'
+#' @example examples/quercus-update.R
+updateQuercusInput <- function(inputId,
+                               label = NULL,
+                               choices = NULL,
+                               selected = NULL,
+                               session = shiny::getDefaultReactiveDomain()) {
+  if (!is.null(label))
+    label <- doRenderTags(label)
+  if (is.null(selected))
+    selected <- character(0)
+  message <- dropNulls(list(
+    label = label,
+    selected = list1(selected)
+  ))
+  if (!is.null(choices)) {
+    message$data <- toJSON(choices, auto_unbox = TRUE, json_verbatim = TRUE)
+  }
+  session$sendInputMessage(inputId, message)
+}
+
+

examples/quercus-default.R

@@ -0,0 +1,132 @@
+
+library(shiny)
+library(shinyWidgets)
+
+# data
+cities <- data.frame(
+  continent = c("America", "America", "America", "Africa",
+                "Africa", "Africa", "Africa", "Africa",
+                "Europe", "Europe", "Europe", "Antarctica"),
+  country = c("Canada", "Canada", "USA", "Tunisia", "Tunisia",
+              "Tunisia", "Algeria", "Algeria", "Italy", "Germany", "Spain", NA),
+  city = c("Trois-Rivières", "Québec", "San Francisco", "Tunis",
+           "Monastir", "Sousse", "Alger", "Oran", "Rome", "Berlin", "Madrid", NA),
+  stringsAsFactors = FALSE
+)
+
+# app
+ui <- fluidPage(
+  theme = bslib::bs_theme(version = 5, preset = "bootstrap"),
+  tags$h2("quercusInput() example"),
+  fluidRow(
+    column(
+      width = 4,
+
+      quercusInput(
+        inputId = "ID1",
+        label = "Select cities: (initiallyExpanded = TRUE)",
+        choices = create_tree(cities),
+        initiallyExpanded = TRUE,
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res1"),
+
+      quercusInput(
+        inputId = "ID4",
+        label = "Select cities: (multiSelectEnabled = TRUE)",
+        choices = create_tree(cities),
+        multiSelectEnabled = TRUE,
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res4")
+
+    ),
+    column(
+      width = 4,
+
+      quercusInput(
+        inputId = "ID2",
+        label = "Select cities: (searchEnabled = TRUE)",
+        choices = create_tree(cities),
+        searchEnabled = TRUE,
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res2"),
+
+      quercusInput(
+        inputId = "ID5",
+        label = "Select cities: (checkboxSelectionEnabled = TRUE)",
+        choices = create_tree(cities),
+        checkboxSelectionEnabled = TRUE,
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res5"),
+
+      quercusInput(
+        inputId = "ID7",
+        label = "Select cities: (cascadeSelectChildren = TRUE)",
+        choices = create_tree(cities),
+        cascadeSelectChildren = TRUE,
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res7")
+
+    ),
+    column(
+      width = 4,
+
+      quercusInput(
+        inputId = "ID3",
+        label = "Select cities: (multiSelectEnabled = TRUE, returnValue = \"all\")",
+        choices = create_tree(cities),
+        multiSelectEnabled = TRUE,
+        returnValue = "all",
+        width = "100%"
+      ),
+      verbatimTextOutput("res3"),
+
+      quercusInput(
+        inputId = "ID6a",
+        label = "Select cities: (selected value)",
+        choices = create_tree(cities),
+        selected = "Monastir",
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res6a"),
+
+      quercusInput(
+        inputId = "ID6b",
+        label = "Select cities: (selected valueS)",
+        choices = create_tree(cities),
+        multiSelectEnabled = TRUE,
+        selected = c("Monastir", "Madrid"),
+        returnValue = "text",
+        width = "100%"
+      ),
+      verbatimTextOutput("res6b")
+
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  output$res1 <- renderPrint(input$ID1)
+  output$res2 <- renderPrint(input$ID2)
+  output$res3 <- renderPrint(input$ID3)
+  output$res4 <- renderPrint(input$ID4)
+  output$res5 <- renderPrint(input$ID5)
+  output$res6a <- renderPrint(input$ID6a)
+  output$res6b <- renderPrint(input$ID6b)
+  output$res7 <- renderPrint(input$ID7)
+
+}
+
+if (interactive())
+  shinyApp(ui, server)

examples/quercus-update.R

@@ -0,0 +1,104 @@
+
+library(shiny)
+library(shinyWidgets)
+
+# data
+cities <- data.frame(
+  continent = c("America", "America", "America", "Africa",
+                "Africa", "Africa", "Africa", "Africa",
+                "Europe", "Europe", "Europe", "Antarctica"),
+  country = c("Canada", "Canada", "USA", "Tunisia", "Tunisia",
+              "Tunisia", "Algeria", "Algeria", "Italy", "Germany", "Spain", NA),
+  city = c("Trois-Rivières", "Québec", "San Francisco", "Tunis",
+           "Monastir", "Sousse", "Alger", "Oran", "Rome", "Berlin", "Madrid", NA),
+  stringsAsFactors = FALSE
+)
+
+# app
+ui <- fluidPage(
+  theme = bslib::bs_theme(version = 5, preset = "bootstrap"),
+  tags$h2("updateQuercusInput() example"),
+  fluidRow(
+    column(
+      width = 6,
+      quercusInput(
+        inputId = "ID1",
+        label = "Select cities:",
+        choices = create_tree(cities),
+        multiSelectEnabled = TRUE,
+        initiallyExpanded = TRUE,
+        returnValue = "text"
+      ),
+      verbatimTextOutput("res1")
+    ),
+    column(
+      width = 6,
+      textInput(
+        inputId = "label",
+        label = "Update label:",
+        value = "Select cities:"
+      ),
+      checkboxGroupInput(
+        inputId = "val_country",
+        label = "Select countries:",
+        choices = unique(cities$country),
+        inline = TRUE
+      ),
+      checkboxGroupInput(
+        inputId = "val_city",
+        label = "Select cities:",
+        choices = unique(cities$city),
+        inline = TRUE
+      ),
+      actionButton("clear", "Clear selected"),
+      actionButton("update", "Update choices"),
+      actionButton("back", "Back to first choices")
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  output$res1 <- renderPrint(input$ID1)
+
+  observe(
+    updateTreeInput(inputId = "ID1", label = input$label)
+  )
+
+  observe(
+    updateQuercusInput(inputId = "ID1", selected = input$val_country)
+  )
+
+  observe(
+    updateQuercusInput(inputId = "ID1", selected = input$val_city)
+  )
+
+  observeEvent(input$clear, {
+    updateQuercusInput(inputId = "ID1", selected = character(0))
+    updateCheckboxGroupInput(inputId = "val_country", selected = character(0))
+    updateCheckboxGroupInput(inputId = "val_city", selected = character(0))
+  })
+
+  observeEvent(input$update, {
+    cities <- data.frame(
+      continent = c("Asia", "Asia", "Asia", "Australia",
+                    "Australia", "Australia", "Australia", "Australia",
+                    "South America", "South America", "South America", "Arctic"),
+      country = c("Japan", "Japan", "China", "Australia", "Australia",
+                  "Australia", "New Zealand", "New Zealand",
+                  "Brazil", "Argentina", "Chile", NA),
+      city = c("Tokyo", "Kyoto", "Beijing", "Sydney",
+               "Melbourne", "Perth", "Auckland", "Wellington",
+               "São Paulo", "Buenos Aires", "Santiago", NA),
+      stringsAsFactors = FALSE
+    )
+    updateQuercusInput(inputId = "ID1", choices = create_tree(cities))
+  })
+
+  observeEvent(input$back, {
+    updateQuercusInput(inputId = "ID1", choices = create_tree(cities))
+  })
+}
+
+if (interactive())
+  shinyApp(ui, server)