Merge pull request #462 from Appsilon/develop

shiny.semantic 0.5.1 release

.github/workflows/main.yml

@@ -1,4 +1,10 @@
-on: push
+on:
+  push:
+    branches:
+      - master
+      - develop
+  pull_request:
+  workflow_dispatch:
 
 name: R-CMD-check
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shiny.semantic
 Title: Semantic UI Support for Shiny
-Version: 0.5.0
+Version: 0.5.1
 Authors@R: c(person("Filip", "Stachura", email = "filip@appsilon.com", role = "aut"),
   person("Dominik", "Krzeminski", role = "aut"),
   person("Krystian", "Igras", role = "aut"),
@@ -10,6 +10,7 @@ Authors@R: c(person("Filip", "Stachura", email = "filip@appsilon.com", role = "a
   person("Jakub", "Chojna", email = "jakub.chojna@appsilon.com", role = "aut"),
   person("Olga", "Mierzwa-Sulima", email = "olga@appsilon.com", role = "aut"),
   person("Jakub", "Nowicki", email = "opensource+kuba@appsilon.com", role = c("aut", "cre")),
+  person("Tymoteusz", "Makowski", email = "tymoteusz.makowski@appsilon.com", role = "aut"),
   person("Ashley", "Baldry", role = "ctb"),
   person("Pedro", "Manuel Coutinho da Silva", email = "pedro@appsilon.com", role = "ctb"),
   person("Kamil", "Żyła", email = "kamil@appsilon.com", role = "ctb"),
@@ -39,6 +40,7 @@ Imports:
     stats
 Suggests:
     covr,
+    chromote,
     dplyr,
     DT,
     gapminder,
@@ -51,11 +53,12 @@ Suggests:
     rcmdcheck,
     rmarkdown,
     testthat,
+    shinytest2,
     tibble,
     withr
 VignetteBuilder:
     knitr
 Encoding: UTF-8
 Language: en-US
 LazyData: TRUE
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NEWS.md

@@ -1,4 +1,18 @@
-# shiny.semantic 0.5.0
+# shiny.semantic (development)
+
+# [shiny.semantic 0.5.1](https://github.com/Appsilon/shiny.semantic/releases/tag/0.5.1)
+
+- Fixed `range_input` now returns both lower and upper bound.
+
+- Fixed `update_multiple_checkbox` not supporting choices with single quote.
+
+- `semantic_DT` now accepts style and class arguments.
+
+-  **Breaking change:** fixed `update_dropdown_input`.
+  - It now clears the dropdown on `value = character(0)` and `value = ""`.
+  - It now clears the dropdown on `choices` update.
+
+# [shiny.semantic 0.5.0](https://github.com/Appsilon/shiny.semantic/releases/tag/0.5.0)
 
 - `shiny.semantic` no longer uses CDN as the default source of assets. Instead, `semantic.assets` package was introduced.
 

R/checkbox.R

@@ -198,9 +198,9 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices,
 update_multiple_checkbox <- function(session = getDefaultReactiveDomain(),
                                      input_id, choices = NULL, choices_value = choices,
                                      selected = NULL, label = NULL) {
-  if (!is.null(selected)) value <- jsonlite::toJSON(selected) else value <- NULL
+  if (!is.null(selected)) value <- jsonlite::toJSON(gsub("'", '"', selected)) else value <- NULL
   if (!is.null(choices)) {
-    options <- jsonlite::toJSON(data.frame(name = choices, value = choices_value))
+    options <- jsonlite::toJSON(data.frame(name = choices, value = gsub("'", '"', choices_value)))
   } else {
     options <- NULL
   }

R/dropdown.R

@@ -149,51 +149,52 @@ selectInput <- function(inputId, label, choices, selected = NULL, multiple = FAL
 #' @param input_id The id of the input object
 #' @param choices All available options one can select from. If no need to update then leave as \code{NULL}
 #' @param choices_value What reactive value should be used for corresponding choice.
-#' @param value The initially selected value.
+#' @param value A value to update dropdown to. Defaults to \code{NULL}.
+#' \itemize{
+#'   \item a value from \code{choices} updates the selection
+#'   \item \code{character(0)} and \code{""} clear the selection
+#'   \item \code{NULL}:
+#'   \itemize{
+#'     \item clears the selection if \code{choices} is provided
+#'     \item otherwise, \code{NULL} does not change the selection
+#'   }
+#'   \item a value not found in \code{choices} does not change the selection
+#' }
 #'
 #' @examples
 #' if (interactive()) {
+#'   library(shiny)
+#'   library(shiny.semantic)
 #'
-#' library(shiny)
-#' library(shiny.semantic)
-#'
-#' ui <- function() {
-#'   shinyUI(
-#'     semanticPage(
-#'       title = "Dropdown example",
-#'       dropdown_input("simple_dropdown", LETTERS[1:5], value = "A", type = "selection multiple"),
-#'       p("Selected letter:"),
-#'       textOutput("selected_letter"),
-#'       shiny.semantic::actionButton("simple_button", "Update input to D")
-#'     )
+#'   ui <- semanticPage(
+#'     title = "Dropdown example",
+#'     dropdown_input("simple_dropdown", LETTERS[1:5], value = "A", type = "selection multiple"),
+#'     p("Selected letter:"),
+#'     textOutput("selected_letter"),
+#'     shiny.semantic::actionButton("simple_button", "Update input to D")
 #'   )
-#' }
 #'
-#' server <- shinyServer(function(input, output, session) {
-#'   output$selected_letter <- renderText(paste(input[["simple_dropdown"]], collapse = ", "))
-#'
-#'   observeEvent(input$simple_button, {
-#'     update_dropdown(session, "simple_dropdown", value = "D")
-#'   })
-#' })
+#'   server <- function(input, output, session) {
+#'     output$selected_letter <- renderText(paste(input[["simple_dropdown"]], collapse = ", "))
 #'
-#' shinyApp(ui = ui(), server = server)
+#'     observeEvent(input$simple_button, {
+#'       update_dropdown_input(session, "simple_dropdown", value = "D")
+#'     })
+#'   }
 #'
+#'   shinyApp(ui, server)
 #' }
 #'
 #' @export
 update_dropdown_input <- function(session, input_id, choices = NULL, choices_value = choices, value = NULL) {
-  if (!is.null(value)) value <- paste(as.character(value), collapse = ",") else value <- NULL
+  msg <- list()
+  if (!is.null(value)) {
+    msg$value <- paste(as.character(value), collapse = ",") # NOTE: paste() converts character(0) to ""
+  }
   if (!is.null(choices)) {
-    options <- jsonlite::toJSON(list(values = data.frame(name = choices, text = choices, value = choices_value)))
-  } else {
-    options <- NULL
+    msg$choices <- jsonlite::toJSON(list(values = data.frame(name = choices, text = choices, value = choices_value)))
   }
-
-  message <- list(choices = options, value = value)
-  message <- message[!vapply(message, is.null, FUN.VALUE = logical(1))]
-
-  session$sendInputMessage(input_id, message)
+  session$sendInputMessage(input_id, msg)
 }
 
 #' Change the value of a select input on the client

R/shiny.R

@@ -1,27 +1,3 @@
-#' Semantic UI wrapper for Shiny
-#'
-#'
-#' @description With this library it’s easy to wrap Shiny with Semantic UI
-#' components. Add a few simple lines of code and some CSS classes to give
-#' your UI a fresh, modern and highly interactive look.
-#'
-#' @section Options:
-#' There are a number of global options that affect shiny.semantic as well as
-#' Shiny behavior.The options can be set globally with `options()`
-#' \describe{
-#' \item{shiny.custom.semantic.cdn (defaults to `NULL`)}{This controls from where the css
-#' and javascripts will be downloaded.}
-#' \item{shiny.custom.semantic (defaults to `NULL`)}{This allows to set custom local path
-#' to semantic dependencies.}
-#' \item{shiny.minified (defaults to `TRUE`)}{Defines including JavaScript as a minified or
-#' un-minified file.}
-#' }
-#'
-#' @docType package
-#' @name shiny.semantic
-#' @aliases shiny.semantic-package
-NULL
-
 #' Internal function that expose javascript bindings to Shiny app.
 #'
 #' @param libname library name
@@ -31,6 +7,14 @@ NULL
   # Add directory for static resources
   file <- system.file("www", package = "shiny.semantic", mustWork = TRUE)
   shiny::addResourcePath("shiny.semantic", file)
+  shiny::registerInputHandler("shiny.semantic.vector", function(value, ...) {
+    if (is.null(value)) {
+      return(value)
+    } else {
+      values <- jsonlite::fromJSON(value)
+      return(values)
+    }
+  }, force = TRUE)
 }
 
 #' Create universal Shiny input binding

R/shiny.semantic-package.R

@@ -0,0 +1,21 @@
+#' Semantic UI wrapper for Shiny
+#'
+#'
+#' @description With this library it’s easy to wrap Shiny with Semantic UI
+#' components. Add a few simple lines of code and some CSS classes to give
+#' your UI a fresh, modern and highly interactive look.
+#'
+#' @section Options:
+#' There are a number of global options that affect shiny.semantic as well as
+#' Shiny behavior.The options can be set globally with `options()`
+#' \describe{
+#' \item{shiny.custom.semantic.cdn (defaults to `NULL`)}{This controls from where the css
+#' and javascripts will be downloaded.}
+#' \item{shiny.custom.semantic (defaults to `NULL`)}{This allows to set custom local path
+#' to semantic dependencies.}
+#' \item{shiny.minified (defaults to `TRUE`)}{Defines including JavaScript as a minified or
+#' un-minified file.}
+#' }
+#'
+#' @keywords internal
+"_PACKAGE"

R/tables.R

@@ -4,6 +4,8 @@
 #'
 #' @param ... datatable parameters, check \code{?DT::datatable} to learn more.
 #' @param options datatable options, check \code{?DT::datatable} to learn more.
+#' @param style datatable style, check \code{?DT::datatable} to learn more.
+#' @param class datatable class, check \code{?DT::datatable} to learn more.
 #'
 #' @examples
 #' if (interactive()){
@@ -22,11 +24,14 @@
 #' }
 #'
 #' @export
-semantic_DT <- function(..., options = list()) {
-  DT::datatable(..., options = options,
-                class = 'ui small compact table',
-                style = "semanticui",
-                rownames = FALSE)
+semantic_DT <- function(..., options = list(), style = "semanticui", class = 'ui small compact table') {
+  DT::datatable(
+    ...,
+    options = options,
+    class = class,
+    style = style,
+    rownames = FALSE
+  )
 }
 
 #' Semantic DT Output
@@ -36,5 +41,5 @@ semantic_DT <- function(..., options = list()) {
 #' @return DT Output with semanitc style
 #' @export
 semantic_DTOutput <- function(...) {
-    DT::DTOutput(...)
+  DT::DTOutput(...)
 }

inst/www/shiny-semantic-DT.css

@@ -16,3 +16,6 @@
   -webkit-transition: color .1s ease,border-color .1s ease;
   transition: color .1s ease,border-color .1s ease;
 }
+table.dataTable tr.selected td, table.dataTable td.selected {
+  background-color: #95d8f5;
+}

inst/www/shiny-semantic-dropdown.js

@@ -32,6 +32,10 @@ $.extend(semanticDropdownBinding, {
 
   // Given the DOM element for the input, set the value.
   setValue: function(el, value) {
+    if (value === '') {
+      $(el).dropdown('clear');
+      return;
+    }
     if ($(el).hasClass('multiple')) {
       $(el).dropdown('clear', true);
       value.split(",").map(v => $(el).dropdown('set selected', v));
@@ -59,22 +63,15 @@ $.extend(semanticDropdownBinding, {
   },
 
   receiveMessage: function(el, data) {
+    let value = data.value;
     if (data.hasOwnProperty('choices')) {
       // setup menu changes dropdown options without triggering onChange event
       $(el).dropdown('setup menu', data.choices);
-      // when no value passed, return null for multiple dropdown and first value for single one
-      if (!data.hasOwnProperty('value')) {
-        let value = ""
-        if (!$(el).hasClass('multiple')) {
-          value = data.choices.values[0].value
-        }
-        this.setValue(el, value);
-      }
+      // either keep the value provided or use the fact that an empty string clears the input and triggers a change event
+      value ||= ""
     }
 
-    if (data.hasOwnProperty('value')) {
-      this.setValue(el, data.value);
-    }
+    this.setValue(el, value);
 
     if (data.hasOwnProperty('label')) {
       $("label[for='" + el.id + "'").html(data.label);

inst/www/shiny-semantic-slider.js

@@ -52,14 +52,14 @@ $.extend(semanticSliderBinding, {
     if ($(el).data('ticks')) {
       return $(el).data('ticks')[value];
     } else {
-      return value;
+      return(JSON.stringify(value))
     }
   },
   getType: function(el) {
     if ($(el).data('ticks')) {
       return false;
     } else {
-      return 'shiny.number';
+      return 'shiny.semantic.vector';
     }
   },
   // Given the DOM element for the input, set the value.