# Copyright (C) 2016 Carl Ganz
#
# This file is part of rintrojs.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#' Initiate intro.js
#'
#' Initiates an introduction via the intro.js library
#' @import shiny
#' @importFrom jsonlite toJSON
#' @param session the Shiny session object (from the server function of the Shiny app)
#' @param options List of options to be passed to intro.js
#' @param events List of text that are the body of a Javascript function. Must wrap in [I()]
#' @note For documentation on intro.js options and events, see \url{https://introjs.com/docs/}.
#' @seealso [introjsUI()] [introBox()]
#' @examples
#' \dontrun{
#' library(rintrojs)
#' library(shiny)
#' ui <- shinyUI(fluidPage(
#' introjsUI(), # must include in UI
#' mainPanel(
#' introBox(
#' tableOutput("mtcars"),
#' data.step = 1,
#' data.intro = "This is the table"
#' ),
#' introBox(
#' actionButton("btn","Intro"),
#' data.step = 2,
#' data.intro = "This is the button",
#' data.hint = "Here is clue"
#' )
#' )))
#' server <- shinyServer(function(input, output, session) {
#'
#' hintjs(session, options = list("hintButtonLabel"="That was a hint"))
#'
#' output$mtcars <- renderTable({
#' head(mtcars)
#' })
#' observeEvent(input$btn,
#' introjs(session, options = list("nextLabel"="Onwards and Upwards"),
#' events = list("oncomplete"=I('alert("It is over")'))))
#' })
#' # Run the application
#' shinyApp(ui = ui, server = server)
#' }
#' @export
introjs <- function(session,
options = list(),
events = list()) {
options <- list(options = options, events = events)
session$sendCustomMessage(type = "introjs",
message = jsonlite::toJSON(options,
auto_unbox = TRUE))
}
#' Read a JS callback function into rintrojs
#'
#' Reads a JS callback function into rintrojs
#'
#' @param funname The name of the function you want to use. Options include:
#' \describe{
#' \item{switchTabs}{This function is intended to be passed to IntroJs's
#' \href{https://introjs.com/docs/intro/api/#introjsonbeforechangeprovidedcallback}{onbeforechange method}. It will switch the currently active tab in your
#' Shiny app to be the one containing the next element in your tour (this
#' function is called by IntroJs right before it moves to the next element).
#' Try running \code{shiny::runApp(system.file("examples/switchTabs.R",
#' package = "rintrojs"))} to see an example.
#' }
#' }
#' @return A string containing the body of a callback function
#' @export
#' @examples
#' \dontrun{
#' introjs(session, events = list(onbeforechange = readCallback("switchTabs")))
#' }
readCallback <- function(funname = c("switchTabs")) {
funname <- match.arg(funname)
switch(funname,
switchTabs = I("rintrojs.callback.switchTabs(targetElement)"))
}
#' @rdname introjs
#' @export
hintjs <- function(session,
options = list(),
events = list()) {
options <- list(options = options, events = events)
session$sendCustomMessage(type = "hintjs", message = jsonlite::toJSON(options))
}
#' Set up Shiny app to use intro.js
#'
#' This function must be called from a Shiny app's UI in order
#' to use the package.
#'
#' @param includeOnly Only include intro.js files. For users who will write their own javascript
#' @param cdn Indicate whether to include intro.js files from CDN
#' @param version Specify intro.js version to use from cdn
#' @export
#' @examples
#' \dontrun{
#' library(rintrojs)
#' library(shiny)
#'
#' shinyApp(
#' ui = fluidPage(
#' introjsUI(), # must include in UI
#' actionButton("btn", "Click me")
#' ),
#' server = function(input, output, session) {
#' observeEvent(input$btn, {
#' intro <- data.frame(element="#btn",
#' intro="In Codd we trust")
#' introjs(session, options = list(steps= intro))
#' })
#' }
#' )
#' }
introjsUI <-
function(includeOnly = FALSE,
cdn = FALSE,
version = "3.2.1") {
if (!missing(version) && !cdn) {
warningf("Version parameter is ignored when cdn = FALSE")
}
shiny::tags$head(shiny::singleton(
shiny::tagList(
shiny::includeScript(if (cdn) {
paste0("https://cdn.jsdelivr.net/intro.js@",
version,
"/minified/intro.min.js")
} else {
system.file("javascript/introjs/intro.min.js", package = "rintrojs")
}),
shiny::includeCSS(if (cdn) {
paste0("https://cdn.jsdelivr.net/intro.js@",
version,
"/minified/introjs.min.css")
} else {
system.file("javascript/introjs/introjs.min.css",
package = "rintrojs")
}),
if (!includeOnly) {
shiny::includeScript(system.file("javascript/rintro.js", package = "rintrojs"))
}
)
))
}
#' Generate intro elements in UI
#'
#' Wrap `introBox` around elements you want to include in introduction.
#' Use data.step to order the boxes and data.intro to specify the comment in the introduction
#'
#' @param ... Elements in introduction element
#' @param data.step a number indicating its spot in the order in the intro
#' @param data.intro text for introduction
#' @param data.hint text for clickable hints
#' @param data.position position of intro
#' @seealso [introjsUI()] [introjs()]
#' @examples
#' \dontrun{
#' library(rintrojs)
#' library(shiny)
#' ui <- shinyUI(fluidPage(
#' introjsUI(), # must include in UI
#' mainPanel(
#' introBox(
#' tableOutput("mtcars"),
#' data.step = 1,
#' data.intro = "This is the table"
#' ),
#' introBox(
#' actionButton("btn","Intro"),
#' data.step = 2,
#' data.intro = "This is the button"
#' )
#' )))
#' server <- shinyServer(function(input, output, session) {
#' output$mtcars <- renderTable({
#' head(mtcars)
#' })
#' observeEvent(input$btn,
#' introjs(session))
#' })
#' # Run the application
#' shinyApp(ui = ui, server = server)
#' }
#' @export
introBox <-
function(... ,
data.step,
data.intro,
data.hint,
data.position = c(
"bottom",
"auto",
"top",
"left",
"right",
"bottom",
"bottom-left_aligned",
"bottom-middle-aligned",
"bottom-right-aligned",
"auto"
)) {
if ((
!missing(data.step) &
missing(data.intro)
) | (
missing(data.step) & !missing(data.intro)
)) {
stopf("Must include data step and data intro")
}
data.position <- match.arg(data.position)
data <- match.call(expand.dots = TRUE)
n <- length(list(...)) + 1
names(data)[-seq_len(n)] <-
gsub("\\.", "-", names(data)[-seq_len(n)])
data[[1]] <- quote(shiny::tags$div)
# http://stackoverflow.com/a/40180906/4564432
eval.parent(data)
}
warningf <- function(fmt, ..., immediate. = FALSE, noBreaks. = FALSE) {
msg <- gettextf(fmt, ..., domain = "R-rintrojs")
warning(msg,
domain = NA,
call. = FALSE,
immediate. = immediate.,
noBreaks. = noBreaks.
)
}
stopf <- function(fmt, ...) {
msg <- gettextf(fmt, ..., domain = "R-rintrojs")
stop(msg, domain = NA, call. = FALSE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.