From 6cd3a9f88378a3398ffbd3a0a17f1cc009cddcf5 Mon Sep 17 00:00:00 2001 From: federiva Date: Mon, 11 Jan 2021 18:30:37 -0300 Subject: [PATCH 01/40] getting namespace from session context --- R/modal.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/modal.R b/R/modal.R index 8cf7be8b..c699ef89 100644 --- a/R/modal.R +++ b/R/modal.R @@ -269,6 +269,7 @@ attach_rule <- function(id, behavior, target, value) { #' #' @export show_modal <- function(id, session = shiny::getDefaultReactiveDomain()) { + id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id) session$sendCustomMessage("showSemanticModal", list(id = id, action = "show")) # nolint } From 3c69095adc603e0b316b36001ddf72ac9e3f0518 Mon Sep 17 00:00:00 2001 From: federiva Date: Sun, 31 Jan 2021 17:48:51 -0300 Subject: [PATCH 02/40] adding step --- NAMESPACE | 3 ++ R/semanticPage.R | 3 +- R/step.R | 81 +++++++++++++++++++++++++++++++++ inst/www/shiny-semantic-step.js | 16 +++++++ man/steps.Rd | 22 +++++++++ 5 files changed, 124 insertions(+), 1 deletion(-) create mode 100644 R/step.R create mode 100644 inst/www/shiny-semantic-step.js create mode 100644 man/steps.Rd diff --git a/NAMESPACE b/NAMESPACE index ef8b9543..615bb88f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -77,10 +77,12 @@ 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) @@ -88,6 +90,7 @@ export(text_input) export(theme_selector) export(toast) export(toggle) +export(toggle_step_state) export(uiinput) export(uirender) export(updateActionButton) diff --git a/R/semanticPage.R b/R/semanticPage.R index c00352ec..029cca3a 100644 --- a/R/semanticPage.R +++ b/R/semanticPage.R @@ -171,7 +171,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, diff --git a/R/step.R b/R/step.R new file mode 100644 index 00000000..3d0a5314 --- /dev/null +++ b/R/step.R @@ -0,0 +1,81 @@ +# Implementing Steps element from fomantic +# https://fomantic-ui.com/elements/step.html + + +#' @rdname single_step +#' @import shiny +#' @export +single_step <- function(id, title, description = NULL, icon_class = NULL, + class = NULL) { + step_icon <- if (is.null(icon_class)) NULL else tags$i(class = paste(icon_class, "icon")) + step_description <- if (is.null(description)) NULL else shiny::div( + class = "description", + description + ) + step_title <- shiny::div(class = "title", title) + step_class <- ifelse( + is.null(class), + "step", + sprintf("%s step", class) + ) + + shiny::div( + id = id, + class = step_class, + step_icon, + shiny::div( + class = "content", + step_title, + step_description) + ) +} + + +#' Show, Hide or Remove Semantic UI modal +#' +#' This displays a hidden Semantic UI modal. +#' +#' @param id ID of the Steps that will be displayed. +#' @param steps_list A list of steps generated by single_steps. +#' @param class (Optional) A character string with the semantic class to be +#' added to the steps element. +#' @seealso single_steps +#' @rdname steps +#' @import shiny +#' @export +steps <- function(id, steps_list, class = NULL) { + steps_class <- ifelse( + test = is.null(class), + yes = "ui steps", + no = sprintf("ui %s steps", class) + ) + shiny::div( + class = steps_class, + steps_list + # lapply(steps_list, function(step) step) + ) +} + +# Example usage +# UI +# steps(list( +# single_step("Step 1", "Make a call", "phone", TRUE), +# single_step("Step 2", "Order some food", "leaf"), +# single_step("Step 3", "Feed the bird", "kiwi bird") +# ), +# class = "ordered" +# ) + +#' @rdname toggle_step_state +#' @export +toggle_step_state <- function(id, state = TRUE, asis = FALSE) { + session <- shiny::getDefaultReactiveDomain() + # Make sure set_attribute_by_id works with namespaces (shiny modules) + id <- ifelse( + inherits(session, "session_proxy") && !asis, + session$ns(id), + id + ) + parameters <- list("step_id" = id, "state" = state) + session$sendCustomMessage("toggle_step_state", parameters) +} \ No newline at end of file diff --git a/inst/www/shiny-semantic-step.js b/inst/www/shiny-semantic-step.js new file mode 100644 index 00000000..e3fbf738 --- /dev/null +++ b/inst/www/shiny-semantic-step.js @@ -0,0 +1,16 @@ +const _toggleStepCompleteState = (stepId, state = true) => { + state ? $(`#${stepId}`).addClass("completed") : $(`#${stepId}`).removeClass("completed") +} + +const toggleCompletedState = (message) => { + console.log(message) + let stepId = message.step_id ? message.step_id : false; + let state = message.state; + if (!stepId) { + return + } + console.log(`id is ${stepId} and state is ${state}`) + _toggleStepCompleteState(stepId, state) +} + +Shiny.addCustomMessageHandler("toggle_step_state", toggleCompletedState) \ No newline at end of file diff --git a/man/steps.Rd b/man/steps.Rd new file mode 100644 index 00000000..f223ffcc --- /dev/null +++ b/man/steps.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/step.R +\name{steps} +\alias{steps} +\title{Show, Hide or Remove Semantic UI modal} +\usage{ +steps(id, steps_list, class = NULL) +} +\arguments{ +\item{id}{ID of the Steps that will be displayed.} + +\item{steps_list}{A list of steps generated by single_steps.} + +\item{class}{(Optional) A character string with the semantic class to be +added to the steps element.} +} +\description{ +This displays a hidden Semantic UI modal. +} +\seealso{ +single_steps +} From d93292d3e9a1412fc8722013092e6ba3beb658a0 Mon Sep 17 00:00:00 2001 From: federiva Date: Sun, 31 Jan 2021 17:55:42 -0300 Subject: [PATCH 03/40] adding example --- R/step.R | 122 ++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 85 insertions(+), 37 deletions(-) diff --git a/R/step.R b/R/step.R index 3d0a5314..54583af7 100644 --- a/R/step.R +++ b/R/step.R @@ -1,5 +1,88 @@ -# Implementing Steps element from fomantic -# https://fomantic-ui.com/elements/step.html +#' Show steps +#' +#' @param id ID of the Steps that will be displayed. +#' @param steps_list A list of steps generated by single_steps. +#' @param class (Optional) A character string with the semantic class to be +#' added to the steps element. +#' @seealso single_steps +#' @examples +#' if (interactive()) { +#' library(shiny) +#' library(shiny.semantic) +#' ui <- semanticPage( +#' title = "Steps Example", +#' hr(), +#' shiny::tagList( +#' h2("Steps example"), +#' shiny.semantic::steps( +#' id = "steps", +#' steps_list = list( +#' single_step( +#' id = "step_1", +#' title = "Step 1", +#' description = "It's night?", +#' icon_class = "moon" +#' ), +#' single_step( +#' id = "step_2", +#' title = "Step 2", +#' description = "Order some food", +#' icon_class = "bug" +#' ), +#' single_step(id = "step_3", +#' title = "Step 3", +#' description = "Feed the Kiwi", +#' icon_class = "kiwi bird" +#' ) +#' ) +#' ), +#' hr(), +#' h3("Actions"), +#' shiny.semantic::action_button("step_1_complete", "Make it night"), +#' shiny.semantic::action_button("step_2_complete", "Call the insects"), +#' shiny.semantic::action_button("step_3_complete", "Feed the Kiwi"), +#' shiny.semantic::action_button("hungry_kiwi", "Kiwi is hungry again"), +#' ) +#') +#' +#' server <- function(input, output, session) { +#' observeEvent(input$step_1_complete, { +#' toggle_step_state("step_1") +#' }) +#' +#' observeEvent(input$step_2_complete, { +#' toggle_step_state("step_2") +#' }) +#' +#' observeEvent(input$step_3_complete, { +#' toggle_step_state("step_3") +#' }) +#' +#' observeEvent(input$hungry_kiwi, { +#' toggle_step_state("step_1", FALSE) +#' toggle_step_state("step_2", FALSE) +#' toggle_step_state("step_3", FALSE) +#' }) +#' +#' } +#' +#' shiny::shinyApp(ui, server) +#' } +#'#' @rdname steps +#'#' @import shiny +#' @export +steps <- function(id, steps_list, class = NULL) { + steps_class <- ifelse( + test = is.null(class), + yes = "ui steps", + no = sprintf("ui %s steps", class) + ) + shiny::div( + class = steps_class, + steps_list + # lapply(steps_list, function(step) step) + ) +} #' @rdname single_step @@ -31,41 +114,6 @@ single_step <- function(id, title, description = NULL, icon_class = NULL, } -#' Show, Hide or Remove Semantic UI modal -#' -#' This displays a hidden Semantic UI modal. -#' -#' @param id ID of the Steps that will be displayed. -#' @param steps_list A list of steps generated by single_steps. -#' @param class (Optional) A character string with the semantic class to be -#' added to the steps element. -#' @seealso single_steps -#' @rdname steps -#' @import shiny -#' @export -steps <- function(id, steps_list, class = NULL) { - steps_class <- ifelse( - test = is.null(class), - yes = "ui steps", - no = sprintf("ui %s steps", class) - ) - shiny::div( - class = steps_class, - steps_list - # lapply(steps_list, function(step) step) - ) -} - -# Example usage -# UI -# steps(list( -# single_step("Step 1", "Make a call", "phone", TRUE), -# single_step("Step 2", "Order some food", "leaf"), -# single_step("Step 3", "Feed the bird", "kiwi bird") -# ), -# class = "ordered" -# ) - #' @rdname toggle_step_state #' @export toggle_step_state <- function(id, state = TRUE, asis = FALSE) { From 848195a2cecf1914f853e58116b3f88860ea67b3 Mon Sep 17 00:00:00 2001 From: federiva Date: Sun, 31 Jan 2021 17:55:55 -0300 Subject: [PATCH 04/40] removing console.log --- inst/www/shiny-semantic-step.js | 2 -- 1 file changed, 2 deletions(-) diff --git a/inst/www/shiny-semantic-step.js b/inst/www/shiny-semantic-step.js index e3fbf738..9cf2a204 100644 --- a/inst/www/shiny-semantic-step.js +++ b/inst/www/shiny-semantic-step.js @@ -3,13 +3,11 @@ const _toggleStepCompleteState = (stepId, state = true) => { } const toggleCompletedState = (message) => { - console.log(message) let stepId = message.step_id ? message.step_id : false; let state = message.state; if (!stepId) { return } - console.log(`id is ${stepId} and state is ${state}`) _toggleStepCompleteState(stepId, state) } From 7e9478335c09673de3c7501129d46e586e9d3ef3 Mon Sep 17 00:00:00 2001 From: federiva Date: Sun, 31 Jan 2021 17:59:20 -0300 Subject: [PATCH 05/40] minor - linting --- R/step.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/step.R b/R/step.R index 54583af7..0c8ca819 100644 --- a/R/step.R +++ b/R/step.R @@ -90,7 +90,7 @@ steps <- function(id, steps_list, class = NULL) { #' @export single_step <- function(id, title, description = NULL, icon_class = NULL, class = NULL) { - step_icon <- if (is.null(icon_class)) NULL else tags$i(class = paste(icon_class, "icon")) + step_icon <- if (is.null(icon_class)) NULL else tags$i(class = paste(icon_class, "icon")) # nolint step_description <- if (is.null(description)) NULL else shiny::div( class = "description", description From 643413adf4d72695e779da3437adb41b729c3e0f Mon Sep 17 00:00:00 2001 From: federiva Date: Sun, 31 Jan 2021 18:08:40 -0300 Subject: [PATCH 06/40] getting the namespace from the session object, adding asis as param --- R/modal.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/modal.R b/R/modal.R index c699ef89..15677f92 100644 --- a/R/modal.R +++ b/R/modal.R @@ -263,12 +263,14 @@ 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 = FALSE) { id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id) session$sendCustomMessage("showSemanticModal", list(id = id, action = "show")) # nolint } @@ -280,7 +282,8 @@ 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 = FALSE) { + id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id) shiny::removeUI(paste0("#", id)) } @@ -299,6 +302,7 @@ removeModal <- function(session = shiny::getDefaultReactiveDomain()) { #' @rdname show_modal #' @export -hide_modal <- function(id, session = shiny::getDefaultReactiveDomain()) { +hide_modal <- function(id, session = shiny::getDefaultReactiveDomain(), asis = FALSE) { + id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id) session$sendCustomMessage("showSemanticModal", list(id = id, action = "hide")) # nolint } From c7b433f0242c45fccbb1e085c888fe7098e42535 Mon Sep 17 00:00:00 2001 From: federiva Date: Mon, 1 Feb 2021 11:36:03 -0300 Subject: [PATCH 07/40] fixing selector to be compatible when setting another class in the menu_class arg of the tabset() function --- inst/www/shiny-semantic-tabset.js | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/www/shiny-semantic-tabset.js b/inst/www/shiny-semantic-tabset.js index 5a592444..2db2ee83 100644 --- a/inst/www/shiny-semantic-tabset.js +++ b/inst/www/shiny-semantic-tabset.js @@ -2,7 +2,7 @@ var semanticTabset = new Shiny.InputBinding(); $.extend(semanticTabset, { find: function(scope) { - return $(scope).find('.tabular.menu'); + return $(scope).find('.ui.menu.sem'); }, initialize: function(el){ $(el).find('.item').tab(); From 1ccd9656c092c1110a5d3d028cb8634b388f7867 Mon Sep 17 00:00:00 2001 From: federiva Date: Mon, 1 Feb 2021 15:05:42 -0300 Subject: [PATCH 08/40] passing id to steps container --- R/step.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/step.R b/R/step.R index 0c8ca819..50b8f4df 100644 --- a/R/step.R +++ b/R/step.R @@ -78,9 +78,9 @@ steps <- function(id, steps_list, class = NULL) { no = sprintf("ui %s steps", class) ) shiny::div( + id = id, class = steps_class, steps_list - # lapply(steps_list, function(step) step) ) } @@ -116,7 +116,7 @@ single_step <- function(id, title, description = NULL, icon_class = NULL, #' @rdname toggle_step_state #' @export -toggle_step_state <- function(id, state = TRUE, asis = FALSE) { +toggle_step_state <- function(id, state = TRUE, automatic_steps = TRUE, asis = FALSE) { session <- shiny::getDefaultReactiveDomain() # Make sure set_attribute_by_id works with namespaces (shiny modules) id <- ifelse( @@ -124,6 +124,9 @@ toggle_step_state <- function(id, state = TRUE, asis = FALSE) { session$ns(id), id ) - parameters <- list("step_id" = id, "state" = state) + parameters <- list( + "step_id" = id, + "state" = state, + "automatic_steps" = automatic_steps) session$sendCustomMessage("toggle_step_state", parameters) } \ No newline at end of file From a05245e586f626fc80eaf463f06507cd96c81a59 Mon Sep 17 00:00:00 2001 From: federiva Date: Mon, 1 Feb 2021 15:06:32 -0300 Subject: [PATCH 09/40] making simple DOM changes as functions, automatic activation of next steps, and resetting function --- inst/www/shiny-semantic-step.js | 58 +++++++++++++++++++++++++++++++-- 1 file changed, 55 insertions(+), 3 deletions(-) diff --git a/inst/www/shiny-semantic-step.js b/inst/www/shiny-semantic-step.js index 9cf2a204..69b1987e 100644 --- a/inst/www/shiny-semantic-step.js +++ b/inst/www/shiny-semantic-step.js @@ -1,14 +1,66 @@ -const _toggleStepCompleteState = (stepId, state = true) => { - state ? $(`#${stepId}`).addClass("completed") : $(`#${stepId}`).removeClass("completed") +const resetAllSteps = (stepperId) => { + $(`#${stepperId}`).children(".step").addClass("disabled"); + $(`#${stepperId}`).children(".step").removeClass("completed"); + // Activating first step + $(`#${stepperId}`).children(".step").first().addClass("active") + $(`#${stepperId}`).children(".step").first().removeClass("disabled"); } +const _toggleStepCompleteState = (stepId, state, automaticSteps) => { + state ? _addCompletedState(stepId) : _removeCompletedState(stepId); + _removeActiveState(stepId); + if (automaticSteps) { + _toggleNextStep(stepId, state); + } +} + +const _toggleNextStep = (stepId, state) => { + let next_step = _getNextStep(stepId); + if (next_step) { + state ? _removeDisabledState(next_step.attr("id")) : _addDisabledState(next_step.attr("id")); + state ? _addActiveState(next_step.attr("id")) : _removeActiveState(next_step.attr("id")); + } +} + +const _removeCompletedState = (stepId) => { + $(`#${stepId}`).removeClass("completed"); +} + +const _addCompletedState = (stepId, autodisable = true) => { + $(`#${stepId}`).addClass("completed"); + autodisable ? _removeDisabledState(stepId) : null; +} + +const _removeDisabledState = (stepId) => { + $(`#${stepId}`).removeClass("disabled"); +} + +const _addDisabledState = (stepId) => { + $(`#${stepId}`).addClass("disabled"); +} + +const _removeActiveState = (stepId) => { + $(`#${stepId}`).removeClass("active") +} + +const _addActiveState = (stepId) => { + $(`#${stepId}`).addClass("active") +} + +const _getNextStep = (stepId) => { + let siblingStep = $(`#${stepId}`).next(".step"); + return siblingStep.length > 0 ? siblingStep : false +} + + const toggleCompletedState = (message) => { let stepId = message.step_id ? message.step_id : false; let state = message.state; + let automaticSteps = message.automatic_steps ? true : false; if (!stepId) { return } - _toggleStepCompleteState(stepId, state) + _toggleStepCompleteState(stepId, state, automaticSteps) } Shiny.addCustomMessageHandler("toggle_step_state", toggleCompletedState) \ No newline at end of file From d96792b1a990562d6445797aba2222d71c0d3b3c Mon Sep 17 00:00:00 2001 From: federiva Date: Wed, 3 Feb 2021 16:28:34 -0300 Subject: [PATCH 10/40] documenting single_step --- R/step.R | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/R/step.R b/R/step.R index 50b8f4df..0dfb2ff6 100644 --- a/R/step.R +++ b/R/step.R @@ -85,8 +85,20 @@ steps <- function(id, steps_list, class = NULL) { } + +#' Creates a single step to be used inside of a list of steps by the steps +#' function +#' +#' @param id The \code{input} slot that will be used to access the value. +#' @param title A character that will be the title of the ste +#' @param description A character that will fill the description of the step +#' @param icon_class A character which will be correpond to a fomantic icon +#' class to be used in the step +#' @param class A character representing a class to be passed to the step +#' +#' @seealso steps +#' #' @rdname single_step -#' @import shiny #' @export single_step <- function(id, title, description = NULL, icon_class = NULL, class = NULL) { From 0c952ccfc3345bd781d37e0f497cef11323d8b4b Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 5 Feb 2021 11:52:15 +0100 Subject: [PATCH 11/40] Fixing standard sliders --- inst/www/shiny-semantic-slider.js | 1 - 1 file changed, 1 deletion(-) diff --git a/inst/www/shiny-semantic-slider.js b/inst/www/shiny-semantic-slider.js index 45aa58af..bcb07d28 100644 --- a/inst/www/shiny-semantic-slider.js +++ b/inst/www/shiny-semantic-slider.js @@ -18,7 +18,6 @@ $.extend(semanticSliderBinding, { } sliderOptions.max = sliderData.ticks.length - 1; } else { - sliderOptions.interpretLabel = Number(sliderData.min); sliderOptions.max = Number(sliderData.max); sliderOptions.step = Number(sliderData.step); sliderOptions.start = Number(sliderData.start); From ee2f25c39197b0191857c29774959ed144410f57 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Fri, 5 Feb 2021 11:54:30 +0100 Subject: [PATCH 12/40] Re-adding min for standard sliders --- inst/www/shiny-semantic-slider.js | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/www/shiny-semantic-slider.js b/inst/www/shiny-semantic-slider.js index bcb07d28..4376e42b 100644 --- a/inst/www/shiny-semantic-slider.js +++ b/inst/www/shiny-semantic-slider.js @@ -18,6 +18,7 @@ $.extend(semanticSliderBinding, { } sliderOptions.max = sliderData.ticks.length - 1; } else { + sliderOptions.min = Number(sliderData.min); sliderOptions.max = Number(sliderData.max); sliderOptions.step = Number(sliderData.step); sliderOptions.start = Number(sliderData.start); From 6affbdbf92645eda460e5aed9550b2f4470d1bbc Mon Sep 17 00:00:00 2001 From: federiva Date: Fri, 5 Feb 2021 19:25:32 -0300 Subject: [PATCH 13/40] asis as TRUE for backwards compatibility --- R/modal.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/modal.R b/R/modal.R index 15677f92..c9a18f13 100644 --- a/R/modal.R +++ b/R/modal.R @@ -270,7 +270,8 @@ attach_rule <- function(id, behavior, target, value) { #' @rdname show_modal #' #' @export -show_modal <- function(id, session = shiny::getDefaultReactiveDomain(), asis = FALSE) { +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 } @@ -282,7 +283,8 @@ showModal <- function(ui, session = shiny::getDefaultReactiveDomain()) { #' @rdname show_modal #' @export -remove_modal <- function(id, session = shiny::getDefaultReactiveDomain(), asis = FALSE) { +remove_modal <- function(id, session = shiny::getDefaultReactiveDomain(), + asis = TRUE) { id <- ifelse(inherits(session, "session_proxy"), session$ns(id), id) shiny::removeUI(paste0("#", id)) } @@ -302,7 +304,8 @@ removeModal <- function(session = shiny::getDefaultReactiveDomain()) { #' @rdname show_modal #' @export -hide_modal <- function(id, session = shiny::getDefaultReactiveDomain(), asis = FALSE) { +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 } From ad159b3aeaddd50e0f40eccf701574f20d6a84b3 Mon Sep 17 00:00:00 2001 From: Jakub Chojna Date: Wed, 24 Feb 2021 09:49:49 +0100 Subject: [PATCH 14/40] fix: assign variables to all parameters in grid function --- R/layouts.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/layouts.R b/R/layouts.R index 61a75a70..d52aa0e7 100644 --- a/R/layouts.R +++ b/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 ) From 277bc1aaa135a0ca52807668d3f2b3a096f9a42e Mon Sep 17 00:00:00 2001 From: Federico Rivadeneira Date: Tue, 2 Mar 2021 14:42:30 -0300 Subject: [PATCH 15/40] adding step example --- examples/steps/app.R | 56 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) create mode 100644 examples/steps/app.R diff --git a/examples/steps/app.R b/examples/steps/app.R new file mode 100644 index 00000000..c834701f --- /dev/null +++ b/examples/steps/app.R @@ -0,0 +1,56 @@ +library(shiny) +library(shiny.semantic) + +ui <- semanticPage( + title = "Steps Example", + shiny::tagList( + h2("Steps example"), + steps( + id = "steps", + steps_list = list( + single_step( + id = "step_1", + title = "Step 1", + description = "It's night?", + icon_class = "moon" + ), + single_step( + id = "step_2", + title = "Step 2", + description = "Order some food", + icon_class = "bug" + ), + single_step( + id = "step_3", + title = "Step 3", + description = "Feed the Kiwi", + icon_class = "kiwi bird" + ) + ) + ), + h3("Actions"), + action_button("step_1_complete", "Make it night"), + action_button("step_2_complete", "Call the insects"), + action_button("step_3_complete", "Feed the Kiwi"), + action_button("hungry_kiwi", "Kiwi is hungry again"), + ) +) + +server <- function(input, output, session) { + observeEvent(input$step_1_complete, { + toggle_step_state("step_1") + }) + observeEvent(input$step_2_complete, { + toggle_step_state("step_2") + }) + observeEvent(input$step_3_complete, { + toggle_step_state("step_3") + }) + observeEvent(input$hungry_kiwi, { + toggle_step_state("step_1", FALSE) + toggle_step_state("step_2", FALSE) + toggle_step_state("step_3", FALSE) + }) +} + +shinyApp(ui = ui, server = server) From e6cb0fed048affb6eb64d974a6eb049f3cb6bddd Mon Sep 17 00:00:00 2001 From: Federico Rivadeneira Date: Tue, 2 Mar 2021 14:43:00 -0300 Subject: [PATCH 16/40] removing hr, removing ifelse --- R/step.R | 41 +++++++++++++++-------------------------- 1 file changed, 15 insertions(+), 26 deletions(-) diff --git a/R/step.R b/R/step.R index 0dfb2ff6..82b855c6 100644 --- a/R/step.R +++ b/R/step.R @@ -5,13 +5,12 @@ #' @param class (Optional) A character string with the semantic class to be #' added to the steps element. #' @seealso single_steps -#' @examples +#' @examples #' if (interactive()) { #' library(shiny) #' library(shiny.semantic) #' ui <- semanticPage( #' title = "Steps Example", -#' hr(), #' shiny::tagList( #' h2("Steps example"), #' shiny.semantic::steps( @@ -36,7 +35,6 @@ #' ) #' ) #' ), -#' hr(), #' h3("Actions"), #' shiny.semantic::action_button("step_1_complete", "Make it night"), #' shiny.semantic::action_button("step_2_complete", "Call the insects"), @@ -68,15 +66,10 @@ #' #' shiny::shinyApp(ui, server) #' } -#'#' @rdname steps -#'#' @import shiny +#' @rdname steps #' @export steps <- function(id, steps_list, class = NULL) { - steps_class <- ifelse( - test = is.null(class), - yes = "ui steps", - no = sprintf("ui %s steps", class) - ) + steps_class <- if (is.null(class)) "ui steps" else sprintf("ui %s steps", class) # nolint shiny::div( id = id, class = steps_class, @@ -94,25 +87,23 @@ steps <- function(id, steps_list, class = NULL) { #' @param description A character that will fill the description of the step #' @param icon_class A character which will be correpond to a fomantic icon #' class to be used in the step -#' @param class A character representing a class to be passed to the step +#' @param step_class A character representing a class to be passed to the step #' #' @seealso steps #' #' @rdname single_step #' @export single_step <- function(id, title, description = NULL, icon_class = NULL, - class = NULL) { - step_icon <- if (is.null(icon_class)) NULL else tags$i(class = paste(icon_class, "icon")) # nolint + step_class = NULL) { + step_icon <- if (is.null(icon_class)) NULL else tags$i( + class = paste(icon_class, "icon") + ) step_description <- if (is.null(description)) NULL else shiny::div( class = "description", description ) step_title <- shiny::div(class = "title", title) - step_class <- ifelse( - is.null(class), - "step", - sprintf("%s step", class) - ) + step_class <- if(is.null(step_class)) "step" else sprintf("%s step", step_class) # nolint shiny::div( id = id, @@ -128,17 +119,15 @@ single_step <- function(id, title, description = NULL, icon_class = NULL, #' @rdname toggle_step_state #' @export -toggle_step_state <- function(id, state = TRUE, automatic_steps = TRUE, asis = FALSE) { +toggle_step_state <- function(id, state = TRUE, automatic_steps = TRUE, + asis = TRUE) { session <- shiny::getDefaultReactiveDomain() # Make sure set_attribute_by_id works with namespaces (shiny modules) - id <- ifelse( - inherits(session, "session_proxy") && !asis, - session$ns(id), - id - ) + if (inherits(session, "session_proxy") && !asis) session$ns(id) else id parameters <- list( "step_id" = id, "state" = state, - "automatic_steps" = automatic_steps) + "automatic_steps" = automatic_steps + ) session$sendCustomMessage("toggle_step_state", parameters) -} \ No newline at end of file +} From 4405cf62be9cf43fb6c34a764318730752fa30b0 Mon Sep 17 00:00:00 2001 From: Federico Rivadeneira Date: Tue, 2 Mar 2021 14:55:32 -0300 Subject: [PATCH 17/40] adding simple unit test for step --- tests/testthat/test_step.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 tests/testthat/test_step.R diff --git a/tests/testthat/test_step.R b/tests/testthat/test_step.R new file mode 100644 index 00000000..2081f17f --- /dev/null +++ b/tests/testthat/test_step.R @@ -0,0 +1,29 @@ +context("steps") + +test_that("test steps", { + # type + expect_is(single_step("step_1", "Step 1"), "shiny.tag") + expect_is( + steps( + "steps", + list( + single_step("step_1", "Step 1"), + single_step("step_1", "Step 1")) + ), + "shiny.tag" + ) + # empty input + expect_error(single_step()) + expect_error(steps()) + # Single step + single_step_str <- as.character(single_step("step_1", "Step 1")) + expect_true(grepl("
\n
\n
Step 1
\n
\n
", # nolint + single_step_str)) + + # Steps + steps_str <- steps("steps", list(single_step("step_1", "Step 1"), + single_step("step_1", "Step 1"))) + expect_true(grepl("
\n
\n
\n
Step 1
\n
\n
\n
\n
\n
Step 1
\n
\n
\n
", # nolint + steps_str)) + +}) From 25ee566a3c720862d20bb835e6d8ef799c788ed4 Mon Sep 17 00:00:00 2001 From: Federico Rivadeneira Date: Tue, 2 Mar 2021 15:14:12 -0300 Subject: [PATCH 18/40] adding example to main app.R --- examples/app.R | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/examples/app.R b/examples/app.R index 58767a9d..9512e4ae 100644 --- a/examples/app.R +++ b/examples/app.R @@ -104,6 +104,36 @@ icon_demo <- function() { ) } +step_demo <- function() { + div( + h1(class = "ui header", id = "step", "Step"), + demo(steps( + id = "steps", + steps_list = list( + single_step( + id = "step_1", + title = "Step 1", + description = "It's night?", + icon_class = "moon" + ), + single_step( + id = "step_2", + title = "Step 2", + description = "Order some food", + icon_class = "bug" + ), + single_step( + id = "step_3", + title = "Step 3", + description = "Feed the Kiwi", + icon_class = "kiwi bird" + ) + ) + ) + ) + ) +} + toast_demo <- function(){ toast_code <- "toast( \"This is a semantic toast. Cheers!\", @@ -494,6 +524,7 @@ ui <- function() { button(), counter_button_demo(), icon_demo(), + step_demo(), divider(), uiinput_demo(), uilabel(), From 050c8b2fa452c106daf1597e3bcea37d2b4e90cb Mon Sep 17 00:00:00 2001 From: ncullen93 Date: Sun, 14 Mar 2021 11:35:13 +0100 Subject: [PATCH 19/40] inline works for checkbox and radio --- R/checkbox.R | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/R/checkbox.R b/R/checkbox.R index 3f824825..ed6a56cb 100644 --- a/R/checkbox.R +++ b/R/checkbox.R @@ -140,11 +140,13 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices, ) })) - shiny::div( - id = input_id, class = paste(position, "fields shiny-input-checkboxgroup"), - tags$label(`for` = input_id, label), - choices_html, - ... + shiny::div(class="ui form", + shiny::div( + id = input_id, class = paste(position, "fields shiny-input-checkboxgroup"), + tags$label(`for` = input_id, label), + choices_html, + ... + ) ) } @@ -168,10 +170,12 @@ multiple_radio <- function(input_id, label, choices, choices_value = choices, ) })) - shiny::div( - id = input_id, class = paste(position, "fields shiny-input-radiogroup"), - tags$label(`for` = input_id, label), - choices_html, - ... + shiny::div(class="ui form", + shiny::div( + id = input_id, class = paste(position, "fields shiny-input-radiogroup"), + tags$label(`for` = input_id, label), + choices_html, + ... + ) ) } From 4addd40a965b1a7b45bfe37c6955b9e550ba4322 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 22 Mar 2021 18:18:58 +0000 Subject: [PATCH 20/40] Checkbox uses Fomantic JS rather than shiny --- R/checkbox.R | 2 +- examples/multiple_checkbox/app.R | 14 +++--- inst/www/shiny-semantic-checkbox.js | 68 +++++++++++++++++++++++++++++ 3 files changed, 77 insertions(+), 7 deletions(-) create mode 100644 inst/www/shiny-semantic-checkbox.js diff --git a/R/checkbox.R b/R/checkbox.R index 3f824825..f6106846 100644 --- a/R/checkbox.R +++ b/R/checkbox.R @@ -141,7 +141,7 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices, })) shiny::div( - id = input_id, class = paste(position, "fields shiny-input-checkboxgroup"), + id = input_id, class = paste(position, "fields ss-checkbox-input"), tags$label(`for` = input_id, label), choices_html, ... diff --git a/examples/multiple_checkbox/app.R b/examples/multiple_checkbox/app.R index 623c5876..e4b73664 100644 --- a/examples/multiple_checkbox/app.R +++ b/examples/multiple_checkbox/app.R @@ -6,17 +6,19 @@ ui <- function() { shinyUI( semanticPage( title = "Multiple checkbox example", - uiOutput("sliders"), + tags$head(shiny::tags$script(src = "shiny.semantic/shiny-semantic-checkbox.js")), + multiple_checkbox( + "chcbx", "Select type:", list("Type one" = "first", "Type two" = "second"), type = "slider", style = "margin: 1em;" + ), + actionButton("update", "Update Checkboxes"), textOutput("result") ) ) } -server <- shinyServer(function(input, output) { - - output$sliders <- renderUI({ - multiple_checkbox("chcbx", "Select type:", list("Type one" = "first", "Type two" = "second"), type = "slider", - style = "margin: 1em;") +server <- shinyServer(function(input, output, session) { + observeEvent(input$update, { + shiny::updateCheckboxGroupInput(session, "chcbx", choices = list("Type three" = "third", "Type four" = "fourth")) }) output$result <- renderText({ diff --git a/inst/www/shiny-semantic-checkbox.js b/inst/www/shiny-semantic-checkbox.js new file mode 100644 index 00000000..46bfcccc --- /dev/null +++ b/inst/www/shiny-semantic-checkbox.js @@ -0,0 +1,68 @@ +var semanticCheckboxBinding = new Shiny.InputBinding(); + +$.extend(semanticCheckboxBinding, { + + // This initialize input element. It extracts data-value attribute and use that as value. + initialize: function(el) { + $(el).checkbox({ + fireOnInit: true + }); + }, + + // This returns a jQuery object with the DOM element. + find: function(scope) { + return $(scope).find('.ss-checkbox-input'); + }, + + // Returns the ID of the DOM element. + getId: function(el) { + return el.id; + }, + + // Given the DOM element for the input, return the value as JSON. + getValue: function(el) { + var checkboxes = $(el).find('.ui.checkbox'); + var checkboxCheck = checkboxes.checkbox('is checked'); + var checkboxValues = $.map(checkboxes.find('input'), function(n) { return n.value; }); + return checkboxValues.filter(x => checkboxCheck[checkboxValues.indexOf(x)]); + }, + + // Given the DOM element for the input, set the value. + setValue: function(el, value) { + var checkboxes = $(el).find('.ui.checkbox'); + checkboxes.checkbox('unckecked'); + return null; + }, + + // Set up the event listeners so that interactions with the + // input will result in data being sent to server. + // callback is a function that queues data to be sent to + // the server. + subscribe: function(el, callback) { + $(el).checkbox({ + onChange: function() { + callback(); + } + }); + }, + + // TODO: Remove the event listeners. + unsubscribe: function(el) { + $(el).off(); + }, + + receiveMessage: function(el, data) { + if (data.hasOwnProperty('choices')) { + } + + if (data.hasOwnProperty('value')) { + this.setValue(el, data.value); + } + + if (data.hasOwnProperty('label')) { + $("label[for='" + el.id + "'").html(data.label); + } + } +}); + +Shiny.inputBindings.register(semanticCheckboxBinding, 'shiny.semanticCheckbox'); From dd2dc7b4ce63f8c35c1667b80092a1f054a2d4c7 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Wed, 24 Mar 2021 19:56:33 +0000 Subject: [PATCH 21/40] Enabled update of radio and checkboxes --- NAMESPACE | 2 ++ R/checkbox.R | 31 +++++++++++++++++- examples/multiple_checkbox/app.R | 50 ++++++++++++++++++++++++----- inst/www/shiny-semantic-checkbox.js | 25 ++++++++++++++- man/multiple_checkbox.Rd | 20 ++++++++++++ 5 files changed, 118 insertions(+), 10 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 615bb88f..04287eb1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -100,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) diff --git a/R/checkbox.R b/R/checkbox.R index f6106846..9fd789f2 100644 --- a/R/checkbox.R +++ b/R/checkbox.R @@ -148,6 +148,23 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices, ) } +#' @rdname multiple_checkbox +#' @export +update_multiple_checkbox <- function(session, input_id, choices = NULL, choices_value = choices, + value = NULL, label = NULL) { + if (!is.null(value)) value <- jsonlite::toJSON(value) 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 @@ -169,9 +186,21 @@ multiple_radio <- function(input_id, label, choices, choices_value = choices, })) shiny::div( - id = input_id, class = paste(position, "fields shiny-input-radiogroup"), + id = input_id, class = paste(position, "fields ss-checkbox-input"), tags$label(`for` = input_id, label), choices_html, ... ) } + +#' @rdname multiple_checkbox +#' @export +update_multiple_radio <- function(session, input_id, choices = NULL, choices_value = choices, + value = NULL, label = NULL) { + if (length(value) > 1) { + warning("More than one radio box has been selected, only first will be used") + value <- value[1] + } + + update_multiple_checkbox(session, input_id, choices, choices_value, value, label) +} diff --git a/examples/multiple_checkbox/app.R b/examples/multiple_checkbox/app.R index e4b73664..ed8b059f 100644 --- a/examples/multiple_checkbox/app.R +++ b/examples/multiple_checkbox/app.R @@ -7,23 +7,57 @@ ui <- function() { semanticPage( title = "Multiple checkbox example", tags$head(shiny::tags$script(src = "shiny.semantic/shiny-semantic-checkbox.js")), - multiple_checkbox( - "chcbx", "Select type:", list("Type one" = "first", "Type two" = "second"), type = "slider", style = "margin: 1em;" - ), - actionButton("update", "Update Checkboxes"), - textOutput("result") + div( + class = "ui form", + div( + class = "inline fields", + multiple_checkbox( + "chcbx", "Select type:", c("Type one", "Type two"), c("first", "second"), + type = "slider" + ) + ), + actionButton("chcbx_update", "Update Checkboxes"), + textOutput("chcbx_result"), + + div( + class = "inline fields", + multiple_radio( + "radio", "Select type:", c("Option one", "Option two"), c("first", "second"), "first", + ) + ), + actionButton("radio_update", "Update Checkboxes"), + textOutput("radio_result"), + ) ) ) } server <- shinyServer(function(input, output, session) { - observeEvent(input$update, { - shiny::updateCheckboxGroupInput(session, "chcbx", choices = list("Type three" = "third", "Type four" = "fourth")) + observeEvent(input$chcbx_update, { + update_multiple_checkbox( + session, + "chcbx", + choices = c("Type Three", "Type Four"), + c("third", "fourth"), + value = c("third", "fourth")) }) - output$result <- renderText({ + output$chcbx_result <- renderText({ input$chcbx }) + + observeEvent(input$radio_update, { + update_multiple_radio( + session, + "radio", + choices = c("Option Three", "Option Four"), + c("third", "fourth"), + value = "third") + }) + + output$radio_result <- renderText({ + input$radio + }) }) shinyApp(ui = ui(), server = server) diff --git a/inst/www/shiny-semantic-checkbox.js b/inst/www/shiny-semantic-checkbox.js index 46bfcccc..09d937d4 100644 --- a/inst/www/shiny-semantic-checkbox.js +++ b/inst/www/shiny-semantic-checkbox.js @@ -30,7 +30,14 @@ $.extend(semanticCheckboxBinding, { // Given the DOM element for the input, set the value. setValue: function(el, value) { var checkboxes = $(el).find('.ui.checkbox'); - checkboxes.checkbox('unckecked'); + checkboxes.checkbox('unckeck'); + + for (i = 0; i < checkboxes.length; i++) { + if (value.includes($(checkboxes[i]).find('input').attr('value'))) { + $(checkboxes[i]).checkbox('check'); + } + } + return null; }, @@ -53,6 +60,22 @@ $.extend(semanticCheckboxBinding, { receiveMessage: function(el, data) { if (data.hasOwnProperty('choices')) { + var checkboxClass = $(el).find('.field .checkbox').attr('class'); + var checkboxType = $(el).find('.field .checkbox input').attr('type'); + + $(el).find(".field").remove(); + + data.choices.forEach(x => { + $(el).append( + $(`
+
+ + +
+
`) + ); + }); + } if (data.hasOwnProperty('value')) { diff --git a/man/multiple_checkbox.Rd b/man/multiple_checkbox.Rd index 29c8120b..3c7a019d 100644 --- a/man/multiple_checkbox.Rd +++ b/man/multiple_checkbox.Rd @@ -2,7 +2,9 @@ % Please edit documentation in R/checkbox.R \name{multiple_checkbox} \alias{multiple_checkbox} +\alias{update_multiple_checkbox} \alias{multiple_radio} +\alias{update_multiple_radio} \title{Create Semantic UI multiple checkbox} \usage{ multiple_checkbox( @@ -16,6 +18,15 @@ multiple_checkbox( ... ) +update_multiple_checkbox( + session, + input_id, + choices = NULL, + choices_value = choices, + value = NULL, + label = NULL +) + multiple_radio( input_id, label, @@ -26,6 +37,15 @@ multiple_radio( type = "radio", ... ) + +update_multiple_radio( + session, + input_id, + choices = NULL, + choices_value = choices, + value = NULL, + label = NULL +) } \arguments{ \item{input_id}{Input name. Reactive value is available under \code{input[[input_id]]}.} From 2ad200912d8fe5b2cf38121acfb18482b39602fe Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Wed, 24 Mar 2021 20:19:13 +0000 Subject: [PATCH 22/40] Updating documentation and writing example --- R/checkbox.R | 70 ++++++++++++++++++++++++----- R/semanticPage.R | 1 + examples/multiple_checkbox/app.R | 24 +++++----- inst/www/shiny-semantic-checkbox.js | 2 +- man/multiple_checkbox.Rd | 24 +--------- 5 files changed, 72 insertions(+), 49 deletions(-) diff --git a/R/checkbox.R b/R/checkbox.R index 9fd789f2..8a173f31 100644 --- a/R/checkbox.R +++ b/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") #' ) @@ -148,11 +148,56 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices, ) } -#' @rdname multiple_checkbox +#' 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 value 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, input_id, choices = NULL, choices_value = choices, - value = NULL, label = NULL) { - if (!is.null(value)) value <- jsonlite::toJSON(value) else value <- NULL +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 { @@ -193,14 +238,15 @@ multiple_radio <- function(input_id, label, choices, choices_value = choices, ) } -#' @rdname multiple_checkbox +#' @rdname update_multiple_checkbox #' @export -update_multiple_radio <- function(session, input_id, choices = NULL, choices_value = choices, - value = NULL, label = NULL) { - if (length(value) > 1) { +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") - value <- value[1] + selected <- selected[1] } - update_multiple_checkbox(session, input_id, choices, choices_value, value, label) + update_multiple_checkbox(session, input_id, choices, choices_value, selected, label) } diff --git a/R/semanticPage.R b/R/semanticPage.R index 029cca3a..8500cdb2 100644 --- a/R/semanticPage.R +++ b/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"), diff --git a/examples/multiple_checkbox/app.R b/examples/multiple_checkbox/app.R index ed8b059f..0f33a0fc 100644 --- a/examples/multiple_checkbox/app.R +++ b/examples/multiple_checkbox/app.R @@ -6,24 +6,20 @@ ui <- function() { shinyUI( semanticPage( title = "Multiple checkbox example", - tags$head(shiny::tags$script(src = "shiny.semantic/shiny-semantic-checkbox.js")), div( class = "ui form", - div( - class = "inline fields", - multiple_checkbox( - "chcbx", "Select type:", c("Type one", "Type two"), c("first", "second"), - type = "slider" - ) + multiple_checkbox( + "chcbx", "Select type:", c("Type one", "Type two"), c("first", "second"), + type = "slider", position = "inline" ), actionButton("chcbx_update", "Update Checkboxes"), textOutput("chcbx_result"), - div( - class = "inline fields", - multiple_radio( - "radio", "Select type:", c("Option one", "Option two"), c("first", "second"), "first", - ) + tags$br(), + + multiple_radio( + "radio", "Select type:", c("Option one", "Option two"), c("first", "second"), + "first", position = "inline" ), actionButton("radio_update", "Update Checkboxes"), textOutput("radio_result"), @@ -39,7 +35,7 @@ server <- shinyServer(function(input, output, session) { "chcbx", choices = c("Type Three", "Type Four"), c("third", "fourth"), - value = c("third", "fourth")) + selected = c("third", "fourth")) }) output$chcbx_result <- renderText({ @@ -52,7 +48,7 @@ server <- shinyServer(function(input, output, session) { "radio", choices = c("Option Three", "Option Four"), c("third", "fourth"), - value = "third") + selected = "third") }) output$radio_result <- renderText({ diff --git a/inst/www/shiny-semantic-checkbox.js b/inst/www/shiny-semantic-checkbox.js index 09d937d4..a008c3e4 100644 --- a/inst/www/shiny-semantic-checkbox.js +++ b/inst/www/shiny-semantic-checkbox.js @@ -30,7 +30,7 @@ $.extend(semanticCheckboxBinding, { // Given the DOM element for the input, set the value. setValue: function(el, value) { var checkboxes = $(el).find('.ui.checkbox'); - checkboxes.checkbox('unckeck'); + checkboxes.checkbox('uncheck'); for (i = 0; i < checkboxes.length; i++) { if (value.includes($(checkboxes[i]).find('input').attr('value'))) { diff --git a/man/multiple_checkbox.Rd b/man/multiple_checkbox.Rd index 3c7a019d..7b14fe36 100644 --- a/man/multiple_checkbox.Rd +++ b/man/multiple_checkbox.Rd @@ -2,9 +2,7 @@ % Please edit documentation in R/checkbox.R \name{multiple_checkbox} \alias{multiple_checkbox} -\alias{update_multiple_checkbox} \alias{multiple_radio} -\alias{update_multiple_radio} \title{Create Semantic UI multiple checkbox} \usage{ multiple_checkbox( @@ -18,15 +16,6 @@ multiple_checkbox( ... ) -update_multiple_checkbox( - session, - input_id, - choices = NULL, - choices_value = choices, - value = NULL, - label = NULL -) - multiple_radio( input_id, label, @@ -37,15 +26,6 @@ multiple_radio( type = "radio", ... ) - -update_multiple_radio( - session, - input_id, - choices = NULL, - choices_value = choices, - value = NULL, - label = NULL -) } \arguments{ \item{input_id}{Input name. Reactive value is available under \code{input[[input_id]]}.} @@ -90,12 +70,12 @@ if (interactive()) { 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") ) From ce3ec25c8225a5313c8f1704e279b725fa8bf7f4 Mon Sep 17 00:00:00 2001 From: Ashley Baldry Date: Mon, 29 Mar 2021 10:26:20 +0100 Subject: [PATCH 23/40] Unbinding progress bar as an input. Fixes #359 --- R/progress.R | 4 +- examples/progress/app.R | 2 +- inst/www/shiny-semantic-progress.js | 119 +++++++--------------------- 3 files changed, 30 insertions(+), 95 deletions(-) diff --git a/R/progress.R b/R/progress.R index 6cce97de..d31b067b 100644 --- a/R/progress.R +++ b/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) diff --git a/examples/progress/app.R b/examples/progress/app.R index f20f8805..443b5590 100644 --- a/examples/progress/app.R +++ b/examples/progress/app.R @@ -15,7 +15,7 @@ ui <- semanticPage( "percent_ex", percent = 35, progress_lab = TRUE, label = "{percent}% complete", label_complete = "All done!" ), tags$br(), - button("button2", "Increase b 5%"), + button("button2", "Increase by 5%"), button("button3", "Decrease by 5%"), textOutput("percent_ex") ) diff --git a/inst/www/shiny-semantic-progress.js b/inst/www/shiny-semantic-progress.js index 210669a0..b0b4f760 100644 --- a/inst/www/shiny-semantic-progress.js +++ b/inst/www/shiny-semantic-progress.js @@ -1,97 +1,20 @@ // Shiny input for progress bars -var semanticProgressBinding = new Shiny.InputBinding(); - -$.extend(semanticProgressBinding, { - - // This initialize input element. It extracts data-value attribute and use that as value. - initialize: function(el) { - $(el).progress({ - text: { - active: $(el).data('label'), - success: $(el).data('label-complete') - } - }); - }, - - // This returns a jQuery object with the DOM element. - find: function(scope) { - return $(scope).find('.ss-progress'); - }, - - // Returns the ID of the DOM element. - getId: function(el) { - return el.id; - }, - - // Given the DOM element for the input, return the value as JSON. - getValue: function(el) { - if ($(el).data('value')) { - return $(el).progress('get value'); - } else { - return $(el).progress('get percent'); - } - }, - - // Given the DOM element for the input, set the value. - setValue: function(el, value) { - if ($(el).data('value')) { - return $(el).progress('set progress', value); - } else { - return $(el).progress('set percent', value); - } - }, - - // Set up the event listeners so that interactions with the - // input will result in data being sent to server. - // callback is a function that queues data to be sent to - // the server. - subscribe: function(el, callback) { - $(el).on('keyup change', function () { callback(true); }); - }, - - // TODO: Remove the event listeners. - unsubscribe: function(el) { - $(el).off('.semanticProgressBinding'); - }, - - // This returns a full description of the input's state. - getState: function(el) { - return { - value: this.getValue(el) - }; - }, - - // The input rate limiting policy. - getRatePolicy: function() { - return { - // Can be 'debounce' or 'throttle': - policy: 'debounce', - delay: 50 - }; - }, - - receiveMessage: function(el, data) { - if (data.hasOwnProperty('value')) { - this.setValue(el, data.value); - } - - if (data.hasOwnProperty('label')) { - $(el).progress('set label', data.label); +renderProgressBars = function() { + $('.progress').progress({ + text: { + active: $(this).data('label'), + success: $(this).data('label-complete') + }, + onActive: function() { + Shiny.setInputValue(this.id, $(this).progress('get value')); + }, + onChange: function() { + Shiny.setInputValue(this.id, $(this).progress('get value')); } + }); +}; - if (data.hasOwnProperty('increment')) { - $(el).progress('increment', Number(data.increment)); - } - - if (data.hasOwnProperty('decrement')) { - $(el).progress('decrement', Number(data.decrement)); - } - - $(el).trigger('change'); - } -}); - -Shiny.inputBindings.register(semanticProgressBinding, 'shiny.semanticProgress'); +$(window).on('load', renderProgressBars); // JS to handle the Progress object similar to shiny Shiny.addCustomMessageHandler('ssprogress', function(message) { @@ -125,6 +48,18 @@ var ssProgressHandlers = { $(`#ss-progress-${message.id}`).progress(); }, + change: function(message) { + var progress = $('#' + message.id); + + if (message.type === 'label') { + progress.progress('set label', message.value); + } else if (message.type === 'value') { + progress.progress('set progress', message.value); + } else { + progress.progress(message.type, message.value); + } + }, + // Update page-level progress bar update: function(message) { // For new-style (starting in Shiny 0.14) progress indicators that use @@ -139,7 +74,7 @@ var ssProgressHandlers = { } if (typeof(message.value) !== 'undefined' && message.value !== null) { progress.progress('set progress', message.value); - } + } }, From 4684068925da19699cb95fd0e872a6064f122910 Mon Sep 17 00:00:00 2001 From: dokato Date: Fri, 30 Apr 2021 09:44:17 +0100 Subject: [PATCH 24/40] Update DESCRIPTION --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index babadccc..420792e4 100755 --- a/DESCRIPTION +++ b/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,6 +16,7 @@ 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 = "dev+shinysemantic@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 From 00adf9b19c8133504081d8cb259f5daf65f88f99 Mon Sep 17 00:00:00 2001 From: Jeroen Ooms Date: Fri, 30 Apr 2021 12:46:52 +0200 Subject: [PATCH 25/40] Fix the build --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 420792e4..ae624c80 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,5 +49,6 @@ Suggests: DT, covr, leaflet, - plotly + plotly, + rmarkdown RoxygenNote: 7.1.1 From a38162d20c15446f068c0f1aaacc0dd4d2af0870 Mon Sep 17 00:00:00 2001 From: Ryszard Szymanski Date: Fri, 14 May 2021 09:55:55 +0200 Subject: [PATCH 26/40] Add markdown to DESCRIPTION to fix CI --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ae624c80..64f4c42a 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,5 +50,6 @@ Suggests: covr, leaflet, plotly, - rmarkdown + rmarkdown, + markdown RoxygenNote: 7.1.1 From 7622a1635083c21746b1c6e4d17f974b1c74a0cf Mon Sep 17 00:00:00 2001 From: ARawles Date: Thu, 24 Jun 2021 08:34:24 +0100 Subject: [PATCH 27/40] Fixed `textAreaInput` value parameter --- R/input.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/input.R b/R/input.R index bc88b756..4f06af65 100644 --- a/R/input.R +++ b/R/input.R @@ -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") ) ) From 028a095b708b1497dc6c43a145e72a81381a7538 Mon Sep 17 00:00:00 2001 From: ARawles Date: Thu, 24 Jun 2021 08:53:57 +0100 Subject: [PATCH 28/40] Fixed passing of the default value when type = 'textarea' --- R/input.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/input.R b/R/input.R index 4f06af65..d3c5d510 100644 --- a/R/input.R +++ b/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) } From 256db9c699b81d6666ccbe1af1ca5432a866fe4e Mon Sep 17 00:00:00 2001 From: ARawles Date: Fri, 23 Jul 2021 14:02:20 +0100 Subject: [PATCH 29/40] Improved textAreaInput example --- R/input.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/input.R b/R/input.R index d3c5d510..3b345152 100644 --- a/R/input.R +++ b/R/input.R @@ -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) { From 7fc52819010d7316f650a08679ddd3425613b6b9 Mon Sep 17 00:00:00 2001 From: aniaskrzydlo Date: Tue, 19 Oct 2021 18:26:41 +0200 Subject: [PATCH 30/40] Updated modal example --- R/modal.R | 43 ++++++++++++++++++++++++++++--------------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/R/modal.R b/R/modal.R index c9a18f13..e73a96ef 100644 --- a/R/modal.R +++ b/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,7 +276,7 @@ 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 +#' @param asis A boolean indicating if the id must be handled as is (TRUE) or #' will be it must be namespaced (FALSE) #' @seealso modal #' From 6466e2a98914f100e2012ba1d34b93faed7eaa17 Mon Sep 17 00:00:00 2001 From: aniaskrzydlo Date: Tue, 19 Oct 2021 18:28:49 +0200 Subject: [PATCH 31/40] Updated documentation --- man/modal.Rd | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/man/modal.Rd b/man/modal.Rd index fcebbf6d..ab0fdef1 100644 --- a/man/modal.Rd +++ b/man/modal.Rd @@ -125,6 +125,7 @@ server <- shinyServer(function(input, output) { }) shinyApp(ui, server) } + ## Changing attributes of header and content. if (interactive()) { library(shiny) @@ -152,24 +153,36 @@ server = function(input, output) { } 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) } } From 6c86116802cf2bfe8e3ebfdb857b53a92a2a6c02 Mon Sep 17 00:00:00 2001 From: aniaskrzydlo Date: Tue, 19 Oct 2021 18:30:35 +0200 Subject: [PATCH 32/40] Added standalone example --- examples/modal/app_6.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 examples/modal/app_6.R diff --git a/examples/modal/app_6.R b/examples/modal/app_6.R new file mode 100644 index 00000000..bde04d4d --- /dev/null +++ b/examples/modal/app_6.R @@ -0,0 +1,28 @@ +library(shiny) +library(shiny.semantic) + +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", + 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) From f5801eed4a18de37f4bda598c07a67d500f6d14d Mon Sep 17 00:00:00 2001 From: Damian Budelewski Date: Wed, 20 Oct 2021 10:46:48 +0200 Subject: [PATCH 33/40] feat: change way system dependencies are installed in the pipeline --- .github/workflows/main.yml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 698c2855..23da446f 100644 --- a/.github/workflows/main.yml +++ b/.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' From 8f3e6d2349429a1400d6a01bd3a12797fc99195e Mon Sep 17 00:00:00 2001 From: Pawel Przytula Date: Sun, 31 Oct 2021 17:29:00 +0100 Subject: [PATCH 34/40] Changed dev@appsilon.com to support+opensource@appsilon.com --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fb4f349e..89eaabf0 100644 --- a/README.md +++ b/README.md @@ -245,11 +245,11 @@ install.packages("shiny", version='0.14.2.9001') - adding more semantic components - new version release on CRAN -## Appsilon Data Science +## Appsilon Appsilon is the **Full Service Certified RStudio Partner**. Learn more at [appsilon.com](https://appsilon.com). -Get in touch [dev@appsilon.com](dev@appsilon.com) +Get in touch [support+opensource@appsilon.com](support+opensource@appsilon.com) From fbec76bb2892c3e70f53359acb81f1d8c7cbf100 Mon Sep 17 00:00:00 2001 From: Pawel Przytula Date: Sun, 31 Oct 2021 17:30:54 +0100 Subject: [PATCH 35/40] Description updated --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 64f4c42a..a32cfb46 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,7 @@ 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 = "dev+shinysemantic@appsilon.com", role = "cre"), + 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 From 6c6e62bd86276fa3b0a5cefa703093426911add3 Mon Sep 17 00:00:00 2001 From: Jakub Sobolewski Date: Fri, 5 Nov 2021 10:04:38 +0100 Subject: [PATCH 36/40] Updated documentation for CRAN submission --- DESCRIPTION | 2 +- R/checkbox.R | 2 +- R/step.R | 11 ++++- man/show_modal.Rd | 9 ++-- man/single_step.Rd | 34 +++++++++++++++ man/steps.Rd | 66 +++++++++++++++++++++++++++- man/textAreaInput.Rd | 2 +- man/toggle_step_state.Rd | 24 +++++++++++ man/update_multiple_checkbox.Rd | 76 +++++++++++++++++++++++++++++++++ man/update_numeric_input.Rd | 2 +- 10 files changed, 218 insertions(+), 10 deletions(-) create mode 100644 man/single_step.Rd create mode 100644 man/toggle_step_state.Rd create mode 100644 man/update_multiple_checkbox.Rd diff --git a/DESCRIPTION b/DESCRIPTION index a32cfb46..40d4fa4b 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,4 +52,4 @@ Suggests: plotly, rmarkdown, markdown -RoxygenNote: 7.1.1 +RoxygenNote: 7.1.2 diff --git a/R/checkbox.R b/R/checkbox.R index 1e5f6280..fce96aaf 100644 --- a/R/checkbox.R +++ b/R/checkbox.R @@ -156,7 +156,7 @@ multiple_checkbox <- function(input_id, label, choices, choices_value = choices, #' @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 selected The initially selected value. #' @param label The label linked to the input #' #' @examples diff --git a/R/step.R b/R/step.R index 82b855c6..ea5b9ae4 100644 --- a/R/step.R +++ b/R/step.R @@ -116,7 +116,16 @@ single_step <- function(id, title, description = NULL, icon_class = NULL, ) } - +#' Toggle step state +#' +#' @param id ID of step to be toggled +#' @param state State of the step, \code{TRUE} stands for enabled +#' @param automatic_steps Whether to toggle focus of next step automatically +#' @param asis When used inside of Shiny module, \code{TRUE} will disable adding +#' the namespace to \code{id} +#' +#' @seealso steps +#' #' @rdname toggle_step_state #' @export toggle_step_state <- function(id, state = TRUE, automatic_steps = TRUE, diff --git a/man/show_modal.Rd b/man/show_modal.Rd index e0961013..8bfa2cfa 100644 --- a/man/show_modal.Rd +++ b/man/show_modal.Rd @@ -8,21 +8,24 @@ \alias{hide_modal} \title{Show, Hide or Remove Semantic UI modal} \usage{ -show_modal(id, session = shiny::getDefaultReactiveDomain()) +show_modal(id, session = shiny::getDefaultReactiveDomain(), asis = TRUE) -remove_modal(id, session = shiny::getDefaultReactiveDomain()) +remove_modal(id, session = shiny::getDefaultReactiveDomain(), asis = TRUE) remove_all_modals(session = shiny::getDefaultReactiveDomain()) removeModal(session = shiny::getDefaultReactiveDomain()) -hide_modal(id, session = shiny::getDefaultReactiveDomain()) +hide_modal(id, session = shiny::getDefaultReactiveDomain(), asis = TRUE) } \arguments{ \item{id}{ID of the modal that will be displayed.} \item{session}{The \code{session} object passed to function given to \code{shinyServer}.} + +\item{asis}{A boolean indicating if the id must be handled as is (TRUE) or +will be it must be namespaced (FALSE)} } \description{ This displays a hidden Semantic UI modal. diff --git a/man/single_step.Rd b/man/single_step.Rd new file mode 100644 index 00000000..17741df3 --- /dev/null +++ b/man/single_step.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/step.R +\name{single_step} +\alias{single_step} +\title{Creates a single step to be used inside of a list of steps by the steps +function} +\usage{ +single_step( + id, + title, + description = NULL, + icon_class = NULL, + step_class = NULL +) +} +\arguments{ +\item{id}{The \code{input} slot that will be used to access the value.} + +\item{title}{A character that will be the title of the ste} + +\item{description}{A character that will fill the description of the step} + +\item{icon_class}{A character which will be correpond to a fomantic icon +class to be used in the step} + +\item{step_class}{A character representing a class to be passed to the step} +} +\description{ +Creates a single step to be used inside of a list of steps by the steps +function +} +\seealso{ +steps +} diff --git a/man/steps.Rd b/man/steps.Rd index f223ffcc..6dbe348c 100644 --- a/man/steps.Rd +++ b/man/steps.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/step.R \name{steps} \alias{steps} -\title{Show, Hide or Remove Semantic UI modal} +\title{Show steps} \usage{ steps(id, steps_list, class = NULL) } @@ -15,7 +15,69 @@ steps(id, steps_list, class = NULL) added to the steps element.} } \description{ -This displays a hidden Semantic UI modal. +Show steps +} +\examples{ +if (interactive()) { + library(shiny) + library(shiny.semantic) + ui <- semanticPage( + title = "Steps Example", + shiny::tagList( + h2("Steps example"), + shiny.semantic::steps( + id = "steps", + steps_list = list( + single_step( + id = "step_1", + title = "Step 1", + description = "It's night?", + icon_class = "moon" + ), + single_step( + id = "step_2", + title = "Step 2", + description = "Order some food", + icon_class = "bug" + ), + single_step(id = "step_3", + title = "Step 3", + description = "Feed the Kiwi", + icon_class = "kiwi bird" + ) + ) + ), + h3("Actions"), + shiny.semantic::action_button("step_1_complete", "Make it night"), + shiny.semantic::action_button("step_2_complete", "Call the insects"), + shiny.semantic::action_button("step_3_complete", "Feed the Kiwi"), + shiny.semantic::action_button("hungry_kiwi", "Kiwi is hungry again"), + ) +) + + server <- function(input, output, session) { + observeEvent(input$step_1_complete, { + toggle_step_state("step_1") + }) + + observeEvent(input$step_2_complete, { + toggle_step_state("step_2") + }) + + observeEvent(input$step_3_complete, { + toggle_step_state("step_3") + }) + + observeEvent(input$hungry_kiwi, { + toggle_step_state("step_1", FALSE) + toggle_step_state("step_2", FALSE) + toggle_step_state("step_3", FALSE) + }) + + } + + shiny::shinyApp(ui, server) +} } \seealso{ single_steps diff --git a/man/textAreaInput.Rd b/man/textAreaInput.Rd index 11c6691e..b835f469 100644 --- a/man/textAreaInput.Rd +++ b/man/textAreaInput.Rd @@ -24,7 +24,7 @@ Create a text area input control for entry of unstructured text values. ## 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) { diff --git a/man/toggle_step_state.Rd b/man/toggle_step_state.Rd new file mode 100644 index 00000000..3aab200c --- /dev/null +++ b/man/toggle_step_state.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/step.R +\name{toggle_step_state} +\alias{toggle_step_state} +\title{Toggle step state} +\usage{ +toggle_step_state(id, state = TRUE, automatic_steps = TRUE, asis = TRUE) +} +\arguments{ +\item{id}{ID of step to be toggled} + +\item{state}{State of the step, \code{TRUE} stands for enabled} + +\item{automatic_steps}{Whether to toggle focus of next step automatically} + +\item{asis}{When used inside of Shiny module, \code{TRUE} will disable adding +the namespace to \code{id}} +} +\description{ +Toggle step state +} +\seealso{ +steps +} diff --git a/man/update_multiple_checkbox.Rd b/man/update_multiple_checkbox.Rd new file mode 100644 index 00000000..f35f67a7 --- /dev/null +++ b/man/update_multiple_checkbox.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/checkbox.R +\name{update_multiple_checkbox} +\alias{update_multiple_checkbox} +\alias{update_multiple_radio} +\title{Update checkbox Semantic UI component} +\usage{ +update_multiple_checkbox( + session = getDefaultReactiveDomain(), + input_id, + choices = NULL, + choices_value = choices, + selected = NULL, + label = NULL +) + +update_multiple_radio( + session = getDefaultReactiveDomain(), + input_id, + choices = NULL, + choices_value = choices, + selected = NULL, + label = NULL +) +} +\arguments{ +\item{session}{The \code{session} object passed to function given to \code{shinyServer}.} + +\item{input_id}{The id of the input object} + +\item{choices}{All available options one can select from. If no need to update then leave as \code{NULL}} + +\item{choices_value}{What reactive value should be used for corresponding choice.} + +\item{selected}{The initially selected value.} + +\item{label}{The label linked to the input} +} +\description{ +Change the value of a \code{\link{multiple_checkbox}} input on the client. +} +\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) + +} + +} diff --git a/man/update_numeric_input.Rd b/man/update_numeric_input.Rd index 1b2f4446..4e37fb64 100644 --- a/man/update_numeric_input.Rd +++ b/man/update_numeric_input.Rd @@ -16,7 +16,7 @@ update_numeric_input( ) updateNumericInput( - session, + session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL, From 801bf9388a698361f3bfa6930e84514fd86cb7a0 Mon Sep 17 00:00:00 2001 From: Jakub Sobolewski Date: Fri, 5 Nov 2021 15:24:59 +0100 Subject: [PATCH 37/40] Adopt `warn_unsupported_args` to r-devel `intersect` implementation In r-devel `intersect` returns NULL if any of arguments are NULL in contrast to previous R versions in which `intersect` returned a vector of length 0 of a type same as given arguments --- R/utils.R | 2 ++ tests/testthat/test_utils.R | 1 + 2 files changed, 3 insertions(+) diff --git a/R/utils.R b/R/utils.R index 0a12ae3a..b7a1b423 100644 --- a/R/utils.R +++ b/R/utils.R @@ -73,6 +73,8 @@ warn_unsupported_args <- function(args) { to_wrn <- paste0(as.character(names(args)), collapse = ',') else if (class(args) == "character") to_wrn <- paste0(args, collapse = ',') + else if (is.null(args)) + return() else stop("Wrong input type!") if (nchar(to_wrn) >= 1) diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R index 55f8c43b..aa30a4dd 100644 --- a/tests/testthat/test_utils.R +++ b/tests/testthat/test_utils.R @@ -14,6 +14,7 @@ test_that("test check_proper_color", { }) test_that("test warn_unsupported_args", { + expect_null(warn_unsupported_args(NULL)) expect_error(warn_unsupported_args(1), "Wrong input type!") expect_warning(warn_unsupported_args(c("a","b")), "arguments: `a,b` are not supported yet") expect_warning(warn_unsupported_args(list(a=1,b=2)), "arguments: `a,b` are not supported yet") From cb29808e1b879cbc0705c7146c993f6aaa64c74f Mon Sep 17 00:00:00 2001 From: Jakub Sobolewski Date: Fri, 5 Nov 2021 15:28:08 +0100 Subject: [PATCH 38/40] Fix R CMD check notes - Updated links in DESCRIPTION and vignette - Removed vignettes from .Rbuildignore --- .Rbuildignore | 1 - DESCRIPTION | 2 +- vignettes/basics.Rmd | 4 ++-- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 50b376b4..4917606f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -21,4 +21,3 @@ ^CODE_OF_CONDUCT.md$ ^doc/* ^Meta$ -^vignettes$ diff --git a/DESCRIPTION b/DESCRIPTION index 40d4fa4b..06eec92b 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ 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 - - (before Semantic). It also supports + (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 diff --git a/vignettes/basics.Rmd b/vignettes/basics.Rmd index 533b4eef..c5886d1c 100644 --- a/vignettes/basics.Rmd +++ b/vignettes/basics.Rmd @@ -37,7 +37,7 @@ UI framework that works under the hood. - **What `shiny.semantic` has to do with Fomantic UI?** Similarly to `Shiny` attaching *Bootstrap* CSS and JS libraries, `shiny.semantic` relies on -[Fomantic UI](fomantic-ui.com/). Historically, we built this package around *Semantic UI* +[Fomantic UI](https://fomantic-ui.com/). Historically, we built this package around *Semantic UI* library, but it got deprecated and now (since December 2019) we rely on the well-supported and maintained community fork called [Fomantic UI](fomantic-ui.com/). @@ -107,7 +107,7 @@ text_input("txt", type = "text", placeholder = "Enter Text") date_input("date") ``` -For more components visit our [Components live demo website](https://demo.appsilon.ai/semantic/) +For more components visit our [Components live demo website](https://demo.appsilon.com/apps/semantic) or the `examples/` folder on our [repository](https://github.com/Appsilon/shiny.semantic/). Little sneak-peak of what you can get is listed on the graphics below. Most of the components From 2b08dc97cd8cced0fd2b7b5e0dd2c9a6179d879f Mon Sep 17 00:00:00 2001 From: Jakub Sobolewski Date: Mon, 8 Nov 2021 10:21:30 +0100 Subject: [PATCH 39/40] Fix invalid URL note --- vignettes/basics.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/basics.Rmd b/vignettes/basics.Rmd index c5886d1c..4d2dcd14 100644 --- a/vignettes/basics.Rmd +++ b/vignettes/basics.Rmd @@ -39,7 +39,7 @@ UI framework that works under the hood. Similarly to `Shiny` attaching *Bootstrap* CSS and JS libraries, `shiny.semantic` relies on [Fomantic UI](https://fomantic-ui.com/). Historically, we built this package around *Semantic UI* library, but it got deprecated and now (since December 2019) we rely on the well-supported -and maintained community fork called [Fomantic UI](fomantic-ui.com/). +and maintained community fork called [Fomantic UI](https://fomantic-ui.com/). - **Do I need to learn a new syntax to be able to use it?** @@ -70,7 +70,7 @@ You can use `shiny.semantic` in two ways: ### (a) Using Fomantic CSS classes If you know this and that about web development, you can create a number of components -by extending standard `Shiny` objects with class definitions from [Fomantic UI](fomantic-ui.com/) +by extending standard `Shiny` objects with class definitions from [Fomantic UI](https://fomantic-ui.com/) documentation. For example: ```{r echo=T, include = T, eval = FALSE, screenshot.force = FALSE} From b81d133c043b6dcafc02e312613b08fce1d2680d Mon Sep 17 00:00:00 2001 From: Jakub Sobolewski Date: Tue, 9 Nov 2021 10:22:21 +0100 Subject: [PATCH 40/40] Add R-devel and R-oldrel to CI --- .github/workflows/main.yml | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 23da446f..be04eba0 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -12,20 +12,23 @@ jobs: fail-fast: false matrix: config: - - { os: windows-latest, r: '3.6'} - - { os: macOS-latest, r: '3.6'} - - { os: ubuntu-18.04, r: '3.6', cran: "https://demo.rstudiopm.com/all/__linux__/bionic/latest"} + - {os: macOS-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-18.04, r: 'devel', http-user-agent: 'release', cran: "https://demo.rstudiopm.com/all/__linux__/bionic/latest"} + - {os: ubuntu-18.04, r: 'release', cran: "https://demo.rstudiopm.com/all/__linux__/bionic/latest"} + - {os: ubuntu-18.04, r: 'oldrel', cran: "https://demo.rstudiopm.com/all/__linux__/bionic/latest"} env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true CRAN: ${{ matrix.config.cran }} steps: - - uses: actions/checkout@v1 + - uses: actions/checkout@v2 - uses: r-lib/actions/setup-r@master with: r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} - uses: r-lib/actions/setup-pandoc@master @@ -53,7 +56,7 @@ jobs: - name: Install vctrs if: runner.os == 'macos' run: Rscript -e "remotes::install_cran('Rcpp')" - + - name: Install dependencies run: Rscript -e "library(remotes)" -e "update(readRDS('depends.Rds'))" -e "remotes::install_cran('rcmdcheck')" @@ -68,6 +71,6 @@ jobs: path: check - name: Test coverage - if: matrix.config.os == 'macOS-latest' && matrix.config.r == '3.6' + if: matrix.config.os == 'ubuntu-18.04' && matrix.config.r == 'release' run: | Rscript -e 'covr::codecov(token = "${{secrets.CODECOV_TOKEN}}")'