Nothing
#' @title 'Accordion' items
#' @param title character title to show in the header
#' @param ... body content
#' @param footer footer element, hidden if \code{NULL}
#' @param class the class of the item
#' @param collapsed whether collapsed at the beginning
#' @param parentId parent \code{\link{accordion}} id
#' @param itemId the item id
#' @param style_header,style_body 'CSS' style of item header and body
#' @param root_path see \code{template_root}
#' @return \code{'shiny.tag.list'} 'HTML' tags
#' @seealso \code{\link{accordion}}
#' @export
accordion_item <- function(
title, ..., footer = NULL,
class = "", collapsed = TRUE,
parentId = rand_string(prefix = "accordion-"),
itemId = rand_string(prefix = "accordion-item-"),
style_header = NULL, style_body = NULL,
root_path = template_root()){
body <- shiny::tagList(...)
template_path <- file.path(root_path, 'views', 'accordion-item.html')
if(length(footer)){
footer <- shiny::div(
class = "card-footer",
footer
)
} else {
footer <- ''
}
if(length(title) >= 1){
data_title <- trimws(as.character(title[[1]])[[1]])
} else {
data_title <- ""
}
shiny::htmlTemplate(
template_path,
document_ = FALSE,
title = title,
data_title = data_title,
body = body,
class = class,
parentId = parentId,
itemId = itemId,
style_header = style_header,
style_body = style_body,
footer = footer,
collapsed = collapsed
)
}
#' @name accordion
#' @title Generates an 'accordion' tab-set
#' @description Generates an 'accordion' tab-set that only one tab is
#' expanded at a time. This feature is experimental and has bugs in
#' some situations. Please use it at your own risk.
#' @param ... 'accordion' items, generated by \code{\link{accordion_item}}
#' @param id the element id, must be unique
#' @param class the additional 'HTML' class
#' @param style_header additional 'CSS' styles for header
#' @param style_body additional 'CSS' styles for content body
#' @param env environment to evaluate \code{...}
#' @param extras key-value pairs that overrides the parameters in
#' \code{\link{accordion_item}}
#' @param root_path see \code{\link{template_root}}
#' @return \code{'shiny.tag.list'} 'HTML' tags
#' @seealso \code{\link{accordion_item}}
#'
#' @examples
#'
#'
#' if(interactive()) {
#'
#' library(shiny)
#' library(shidashi)
#'
#' accordion(
#' id = "input-set",
#' accordion_item(
#' title = "Input Group A",
#' textInput("input_1", "Input 1"),
#' collapsed = FALSE,
#' footer = "Anim pariatur cliche reprehenderit dolor brunch."
#' ),
#' accordion_item(
#' title = "Input Group B",
#' textInput("input_2", "Input 2"),
#' footer = actionButton("btn1", "OK"),
#' collapsed = FALSE
#' )
#' )
#' }
#'
#' @export
accordion <- function(
..., id = rand_string(prefix = "accordion-"),
class = NULL, style_header = NULL,
style_body = NULL, env = parent.frame(), extras = list(),
root_path = template_root()){
call <- match.call(expand.dots = FALSE)
force(root_path)
parentId <- id
items <- unname(lapply(call[['...']], function(item){
item[["parentId"]] <- parentId
item[["root_path"]] <- root_path
if(!is.null(style_header)){
item[["style_header"]] <- style_header
}
if(!is.null(style_body)){
item[["style_body"]] <- style_body
}
eval(item, envir = env)
}))
extras <- as.list(extras)
extras$id <- parentId
extras$class <- combine_class("card-accordion", class)
extras <- c(extras, items)
do.call(shiny::div, extras)
}
#' @rdname accordion
#' @param itemId \code{\link{accordion_item}} id
#' @param item_title \code{\link{accordion_item}} title, if item id is
#' specified, this title will be ignored
#' @param method operation, choices are \code{'expand'} (default),
#' \code{'collapse'}, or \code{'toggle'}
#' @param session \code{shiny} session
#' @export
accordion_operate <- function(
id, itemId, item_title,
method = c("expand", "collapse", "toggle"),
session = shiny::getDefaultReactiveDomain()) {
method <- match.arg(method)
if(missing(item_title) && missing(itemId)) {
stop("accordion_operate: either accordion item title or id must be specified")
}
if(missing(itemId)) {
selector <- sprintf("#%s .card-accordion-header [data-title='%s']", session$ns(id), item_title)
} else {
itemId <- session$ns(itemId)
selector <- sprintf("#%s .card-accordion-item#%s-accordion-header .card-accordion-title", session$ns(id), itemId)
}
session$sendCustomMessage("shidashi.accordion", list(
selector = selector,
method = method
))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.