Merge CRAN package version to master

.Rbuildignore

@@ -21,4 +21,3 @@
 ^CODE_OF_CONDUCT.md$
 ^doc/*
 ^Meta$
-^vignettes$

.github/workflows/main.yml

@@ -42,12 +42,9 @@ jobs:
 
       - name: Install system dependencies
         if: runner.os == 'Linux'
-        env:
-          RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
-        run: |
-          Rscript -e "remotes::install_github('r-hub/sysreqs')"
-          sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
-          sudo -s eval "$sysreqs"
+        uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: rcmdcheck
 
       - name: Install vctrs
         if: runner.os == 'Windows'

DESCRIPTION

@@ -3,7 +3,7 @@ Type: Package
 Title: Semantic UI Support for Shiny
 Version: 0.4.3
 Authors@R: c(person("Filip", "Stachura", email = "filip@appsilon.com", role = "aut"),
-  person("Dominik", "Krzeminski", email = "dominik@appsilon.com", role = "cre"),
+  person("Dominik", "Krzeminski", email = "dominik@appsilon.com", role = "aut"),
   person("Krystian", "Igras", email = "krystian@appsilon.com", role = "aut"),
   person("Adam", "Forys", email = "adam@appsilon.com", role = "aut"),
   person("Paweł", "Przytuła", email = "pawel@appsilon.com", role = "aut"),
@@ -16,12 +16,13 @@ Authors@R: c(person("Filip", "Stachura", email = "filip@appsilon.com", role = "a
   person("Paweł", "Przytuła", email = "pawel@appsilon.com", role = "ctb"),
   person("Kamil", "Żyła", email = "kamil@appsilon.com", role = "ctb"),
   person("Rabii", "Bouhestine", email = "rabii@appsilon.com", role = "ctb"),
+  person("Developers", "Appsilon", email = "support+opensource@appsilon.com", role = "cre"),
   person(family = "Appsilon Sp. z o.o.", role = c("cph")))
 Description: Creating a great user interface for your Shiny apps
     can be a hassle, especially if you want to work purely in R
     and don't want to use, for instance HTML templates. This
     package adds support for a powerful UI library Fomantic UI -
-    <http://fomantic-ui.com/> (before Semantic). It also supports
+    <https://fomantic-ui.com/> (before Semantic). It also supports
     universal UI input binding that works with various DOM elements.
 BugReports: https://github.com/Appsilon/shiny.semantic/issues
 Encoding: UTF-8
@@ -48,5 +49,7 @@ Suggests:
     DT,
     covr,
     leaflet,
-    plotly
-RoxygenNote: 7.1.1
+    plotly,
+    rmarkdown,
+    markdown
+RoxygenNote: 7.1.2

NAMESPACE

@@ -77,17 +77,20 @@ export(showNotification)
 export(show_modal)
 export(sidebar_layout)
 export(sidebar_panel)
+export(single_step)
 export(sliderInput)
 export(slider_input)
 export(splitLayout)
 export(split_layout)
+export(steps)
 export(tabset)
 export(textAreaInput)
 export(textInput)
 export(text_input)
 export(theme_selector)
 export(toast)
 export(toggle)
+export(toggle_step_state)
 export(uiinput)
 export(uirender)
 export(updateActionButton)
@@ -97,6 +100,8 @@ export(updateSliderInput)
 export(update_action_button)
 export(update_calendar)
 export(update_dropdown_input)
+export(update_multiple_checkbox)
+export(update_multiple_radio)
 export(update_numeric_input)
 export(update_progress)
 export(update_range_input)

R/checkbox.R

@@ -103,12 +103,12 @@ toggle <- function(input_id, label = "", is_marked = TRUE, style = NULL) {
 #'         semanticPage(
 #'           title = "Checkbox example",
 #'           h1("Checkboxes"),
-#'           multiple_checkbox("checkboxes", "Select Letters", LETTERS[1:6], value = "A"),
+#'           multiple_checkbox("checkboxes", "Select Letters", LETTERS[1:6], selected = "A"),
 #'           p("Selected letters:"),
 #'           textOutput("selected_letters"),
 #'           tags$br(),
 #'           h1("Radioboxes"),
-#'           multiple_radio("radioboxes", "Select Letter", LETTERS[1:6], value = "A"),
+#'           multiple_radio("radioboxes", "Select Letter", LETTERS[1:6], selected = "A"),
 #'           p("Selected letter:"),
 #'           textOutput("selected_letter")
 #'        )
@@ -140,14 +140,76 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices,
     )
   }))
 
-  shiny::div(
-    id = input_id, class = paste(position, "fields shiny-input-checkboxgroup"),
+  shiny::div(class="ui form",
+    id = input_id, class = paste(position, "fields ss-checkbox-input"),
     tags$label(`for` = input_id, label),
     choices_html,
     ...
   )
 }
 
+#' Update checkbox Semantic UI component
+#'
+#' Change the value of a \code{\link{multiple_checkbox}} input on the client.
+#'
+#' @param session The \code{session} object passed to function given to \code{shinyServer}.
+#' @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 selected The initially selected value.
+#' @param label The label linked to the input
+#'
+#' @examples
+#' if (interactive()) {
+#'
+#' library(shiny)
+#' library(shiny.semantic)
+#'
+#' ui <- function() {
+#'   shinyUI(
+#'     semanticPage(
+#'       title = "Checkbox example",
+#'       form(
+#'         multiple_checkbox(
+#'           "simple_checkbox", "Letters:", LETTERS[1:5], selected = c("A", "C"), type = "slider"
+#'         )
+#'       ),
+#'       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_checkbox"]], collapse = ", "))
+#'
+#'   observeEvent(input$simple_button, {
+#'     update_multiple_checkbox(session, "simple_checkbox", selected = "D")
+#'   })
+#' })
+#'
+#' shinyApp(ui = ui(), server = server)
+#'
+#' }
+#'
+#' @export
+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(choices)) {
+    options <- jsonlite::toJSON(data.frame(name = choices, value = choices_value))
+  } else {
+    options <- NULL
+  }
+
+  message <- list(choices = options, value = value, label = label)
+  message <- message[!vapply(message, is.null, FUN.VALUE = logical(1))]
+
+  session$sendInputMessage(input_id, message)
+}
+
 #' @rdname multiple_checkbox
 #'
 #' @export
@@ -168,10 +230,23 @@ multiple_radio <- function(input_id, label, choices, choices_value = choices,
     )
   }))
 
-  shiny::div(
-    id = input_id, class = paste(position, "fields shiny-input-radiogroup"),
+  shiny::div(class="ui form",
+    id = input_id, class = paste(position, "fields ss-checkbox-input"),
     tags$label(`for` = input_id, label),
     choices_html,
     ...
   )
 }
+
+#' @rdname update_multiple_checkbox
+#' @export
+update_multiple_radio <- function(session = getDefaultReactiveDomain(),
+                                  input_id, choices = NULL, choices_value = choices,
+                                  selected = NULL, label = NULL) {
+  if (length(selected) > 1) {
+    warning("More than one radio box has been selected, only first will be used")
+    selected <- selected[1]
+  }
+
+  update_multiple_checkbox(session, input_id, choices, choices_value, selected, label)
+}

R/input.R

@@ -80,7 +80,7 @@ text_input <- function(input_id, label = NULL, value = "", type = "text",
   }
 
   if (type == "textarea") {
-    input <- tags$textarea(id = input_id, value = value, placeholder = placeholder)
+    input <- tags$textarea(id = input_id, value, placeholder = placeholder)
   } else {
     input <- tags$input(id = input_id, value = value, type = type, placeholder = placeholder)
   }
@@ -110,7 +110,7 @@ text_input <- function(input_id, label = NULL, value = "", type = "text",
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
 #' ui <- semanticPage(
-#'   textAreaInput("a", "Area:", width = "200px"),
+#'   textAreaInput("a", "Area:", value = "200", width = "200px"),
 #'   verbatimTextOutput("value")
 #' )
 #' server <- function(input, output, session) {
@@ -125,7 +125,7 @@ textAreaInput <- function(inputId, label, value = "", width = NULL, placeholder
     style = if (!is.null(width)) glue::glue("width: {shiny::validateCssUnit(width)};"),
     shiny::div(class = "field",
                if (!is.null(label)) tags$label(label, `for` = inputId),
-               text_input(inputId, value,
+               text_input(inputId, value = value,
                           placeholder = placeholder, type = "textarea")
     )
   )

R/layouts.R

@@ -128,8 +128,8 @@ sidebar_layout <- function(sidebar_panel,
 
   grid(
     grid_template = layout,
-    container_style,
-    area_styles,
+    container_style = container_style,
+    area_styles = area_styles,
     sidebar_panel = sidebar_children,
     main_panel = main_children
   )

R/modal.R

@@ -96,6 +96,7 @@
 #' })
 #' shinyApp(ui, server)
 #' }
+#'
 #' ## Changing attributes of header and content.
 #' if (interactive()) {
 #' library(shiny)
@@ -123,24 +124,36 @@
 #' }
 #' shinyApp(ui, server)
 #' }
+#'
+#' ## Modal that closes automatically after specific time
 #' if (interactive()) {
 #' library(shiny)
 #' library(shiny.semantic)
-#' shinyApp(
-#'   ui = semanticPage(
-#'     actionButton("show", "Show modal dialog")
-#'   ),
-#'   server = function(input, output) {
-#'     observeEvent(input$show, {
-#'       showModal(modalDialog(
+#' ui <- function() {
+#'   shinyUI(
+#'     semanticPage(
+#'       actionButton("show", "Show modal dialog")
+#'     )
+#'   )
+#' }
+#'
+#' server <- shinyServer(function(input, output, session) {
+#'   observeEvent(input$show, {
+#'     create_modal(
+#'       modal(
+#'         id = "simple-modal",
 #'         title = "Important message",
-#'         "This modal will close after 3 sec.", easyClose = FALSE
-#'       ))
-#'       Sys.sleep(3)
-#'       removeModal()
-#'     })
-#'   }
-#' )
+#'         header = "Example modal",
+#'         content = "This modal will close after 3 sec.",
+#'         footer = NULL,
+#'       )
+#'     )
+#'     Sys.sleep(3)
+#'     hide_modal(id = "simple-modal")
+#'   })
+#' })
+#'
+#' shinyApp(ui = ui(), server = server)
 #' }
 #'
 #' @rdname modal
@@ -263,12 +276,16 @@ attach_rule <- function(id, behavior, target, value) {
 #' @param id ID of the modal that will be displayed.
 #' @param session The \code{session} object passed to function given to
 #'   \code{shinyServer}.
+#' @param asis A boolean indicating if the id must be handled as is (TRUE) or
+#' will be it must be namespaced (FALSE)
 #' @seealso modal
 #'
 #' @rdname show_modal
 #'
 #' @export
-show_modal <- function(id, session = shiny::getDefaultReactiveDomain()) {
+show_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
+                       asis = TRUE) {
+  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
   session$sendCustomMessage("showSemanticModal", list(id = id, action = "show")) # nolint
 }
 
@@ -279,7 +296,9 @@ showModal <- function(ui, session = shiny::getDefaultReactiveDomain()) {
 
 #' @rdname show_modal
 #' @export
-remove_modal <- function(id, session = shiny::getDefaultReactiveDomain()) {
+remove_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
+                         asis = TRUE) {
+  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
   shiny::removeUI(paste0("#", id))
 }
 
@@ -298,6 +317,8 @@ removeModal <- function(session = shiny::getDefaultReactiveDomain()) {
 
 #' @rdname show_modal
 #' @export
-hide_modal <- function(id, session = shiny::getDefaultReactiveDomain()) {
+hide_modal <- function(id, session = shiny::getDefaultReactiveDomain(),
+                       asis = TRUE) {
+  id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id)
   session$sendCustomMessage("showSemanticModal", list(id = id, action = "hide")) # nolint
 }

R/progress.R

@@ -73,9 +73,9 @@ progress <- function(input_id, value = NULL, total = NULL, percent = NULL, progr
 #' @export
 update_progress <- function(session, input_id, type = c("increment", "decrement", "label", "value"), value = 1) {
   type <- match.arg(type)
-  message <- structure(list(value), names = type)
+  message <- list(id = input_id, type = type, value = value)
 
-  session$sendInputMessage(input_id, message)
+  session$sendCustomMessage("ssprogress", list(type = "change", message = message))
 }
 
 #' Reporting progress (object-oriented API)

R/semanticPage.R

@@ -162,6 +162,7 @@ semanticPage <- function(..., title = "", theme = NULL, suppress_bootstrap = TRU
       shiny::tags$link(rel = "stylesheet", type = "text/css",
                        href = "shiny.semantic/shiny-semantic-DT.css"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-modal.js"),
+      shiny::tags$script(src = "shiny.semantic/shiny-semantic-checkbox.js"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-dropdown.js"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-button.js"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-slider.js"),
@@ -171,7 +172,8 @@ semanticPage <- function(..., title = "", theme = NULL, suppress_bootstrap = TRU
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-rating.js"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-tabset.js"),
       shiny::tags$script(src = "shiny.semantic/shiny-semantic-progress.js"),
-      shiny::tags$script(src = "shiny.semantic/shiny-semantic-toast.js")
+      shiny::tags$script(src = "shiny.semantic/shiny-semantic-toast.js"),
+      shiny::tags$script(src = "shiny.semantic/shiny-semantic-step.js")
     ),
     shiny::tags$body(style = glue::glue("margin:{margin};"),
                      suppress_bootstrap,