#' Register containers to dragula.
#'
#' Create dragula instace to allow moving around elements of the registered containers.
#'
#' @param x vector of containers ids. Their's elements will become draggable.
#' @param id input id to read from in shiny.
#' @param ... additonal arguments passed to dragula JS as options.
#'
#' @importFrom htmlwidgets createWidget shinyWidgetOutput shinyRenderWidget
#' @import shiny
#' @export
#' @return
#' Return htmlWidget. Should be used only inside shiny ui.
#'
#' @examples
#'
#' if(interactive()) {
#' path <- system.file("apps/example01-dragula", package = "dragulaR")
#' runApp(path, display.mode = "showcase")
#' }
#'
dragula <- function(x, ...) {
if(!is.character(x))
{
stop("x must be a character vector!")
}
settings = list(...)
id <- settings[['id']]
settings[['id']] <- NULL
names(x) = NULL
width = "0px"
height = "0px"
# shortcut option for allowing copying from a single container
if ('copyOnly' %in% names(settings)) {
container <- settings[['copyOnly']]
settings[['copy']] <- JS("function(el, source) { ",
paste0("return source === document.getElementById('", container, "');"),
"}")
settings[['accepts']] <- JS("function(el, target) {",
paste0("return target !== document.getElementById('", container, "');"),
"}")
settings[['copyOnly']] <- NULL
}
# forward options using x
x = list(
x = x,
settings = settings,
elid = id
)
# create widget
createWidget(
name = 'dragula',
x,
width = width,
height = height,
package = 'dragulaR'
)
}
#' Dragula widget.
#'
#' Create dragula widget.
#'
#' @param outputId output variable to read from.
#' @param expr An expression that generates a dragula object.
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable.
#'
#' @return RETURN_DESCRIPTION
#' @rdname dragulaWidget
#' @export
#' @examples
#'
#' if(interactive()) {
#' path <- system.file("apps/example02-input", package = "dragulaR")
#' runApp(path, display.mode = "showcase")
#' }
#'
dragulaOutput <- function(outputId) {
shinyWidgetOutput(outputId, "dragula", width = "0px", height = "0px", package = "dragulaR")
}
#' @export
#' @rdname dragulaWidget
renderDragula <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
shinyRenderWidget(expr, dragulaOutput, env, quoted = TRUE)
}
#' Format dragula input object.
#'
#' @param x dragula input.
#'
#' @description
#' This is a utility function for better formatting dragula's input.
#'
#' @export
#' @importFrom utils tail
#' @examples
#'
#' \dontrun{
#' # Example call:
#' dragulaValue(input$dragula)
#' }
#'
dragulaValue <- function(x) {
x <- lapply(x, unlist)
names(x) <- vapply(
names(x),
FUN.VALUE = "",
function(y) tail(strsplit(y, split = "-")[[1]],1))
x
}
#' Register dragulaR's js functions for refreshing dragula object.
#'
#' @export
#' @importFrom shinyjs extendShinyjs
#' @examples
#'
#' \dontrun{
#' # See example for more details
#' library(dragulaR)
#' runApp(
#' system.file("apps/example05-dragula-dynamic-elements", package = "dragulaR"),
#' display.mode = "showcase")
#' }
#'
useDragulajs <- function() {
shinyjs::extendShinyjs(text = "shinyjs.refreshDragulaR = function(params) {
dragulaR.get(params[0])()
}")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.