From 08400d3f18d0b25fd129ea92f8d4ed41c2a37341 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Wed, 8 Jun 2016 12:55:50 -0500 Subject: [PATCH] Add configureBookmarking function --- NAMESPACE | 6 +- R/save-state.R | 157 +++++++++++++++++++++++------------- R/shiny.R | 1 + man/configureBookmarking.Rd | 30 +++++++ man/saveStateQueryString.Rd | 24 ++++++ 5 files changed, 161 insertions(+), 57 deletions(-) create mode 100644 man/configureBookmarking.Rd create mode 100644 man/saveStateQueryString.Rd diff --git a/NAMESPACE b/NAMESPACE index 5eda97c39..ca9480d79 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -55,6 +55,7 @@ export(code) export(column) export(conditionStackTrace) export(conditionalPanel) +export(configureBookmarking) export(createWebDependency) export(dataTableOutput) export(dateInput) @@ -68,7 +69,7 @@ export(downloadHandler) export(downloadLink) export(em) export(encodeStateModal) -export(encodeStateURL) +export(encodeStateQueryString) export(eventReactive) export(exprToFunction) export(extractStackTrace) @@ -184,7 +185,7 @@ export(runGitHub) export(runUrl) export(safeError) export(saveStateModal) -export(saveStateURL) +export(saveStateQueryString) export(selectInput) export(selectizeInput) export(serverInfo) @@ -237,6 +238,7 @@ export(updateSelectizeInput) export(updateSliderInput) export(updateTabsetPanel) export(updateTextInput) +export(urlModal) export(validate) export(validateCssUnit) export(verbatimTextOutput) diff --git a/R/save-state.R b/R/save-state.R index b23a711af..5e34c583c 100644 --- a/R/save-state.R +++ b/R/save-state.R @@ -9,7 +9,7 @@ #' @param exclude A character vector of input names that should not be #' bookmarked. #' @export -saveStateURL <- function(input, exclude = NULL) { +saveStateQueryString <- function(input, exclude = NULL) { id <- createUniqueId(8) saveInterface <- getShinyOption("save.interface", default = saveInterfaceLocal) @@ -46,9 +46,9 @@ restoreStateURL <- function(queryString) { res } -#' @rdname saveStateURL +#' @rdname saveStateQueryString #' @export -encodeStateURL <- function(input, exclude = NULL) { +encodeStateQueryString <- function(input, exclude = NULL) { vals <- serializeReactiveValues(input, exclude, stateDir = NULL) vals <- vapply(vals, @@ -168,7 +168,6 @@ RestoreContext <- R6Class("RestoreContext", restoreCtxStack <- Stack$new() -# Equivalent to withRestoreContext <- function(ctx, expr) { restoreCtxStack$push(ctx) @@ -208,16 +207,6 @@ restoreInput <- function(id, default) { } } -#' @export -restoreValue <- function(id, default) { - ctx <- getCurrentRestoreContext() - if (id %in% names(ctx$values)) { - ctx$values[[id]] - } else { - default - } -} - #' @export updateQueryString <- function(queryString, session = getDefaultReactiveDomain()) { @@ -226,60 +215,118 @@ updateQueryString <- function(queryString, session = getDefaultReactiveDomain()) #' @export -saveStateModal <- function(input, exclude = NULL, - session = getDefaultReactiveDomain()) -{ - clientData <- session$clientData +urlModal <- function(url, title = "Share link", subtitle = NULL) { + + subtitleTag <- NULL + if (!is.null(subtitle)) { + subtitleTag <- tagList( + br(), + span(class = "text-muted", subtitle) + ) + } modalDialog( - title = "Share link", + title = title, easyClose = TRUE, footer = NULL, - tags$input(type = "text", class = "form-control", - value = paste0( - clientData$url_protocol, "//", - clientData$url_hostname, - if (nzchar(clientData$url_port)) paste0(":", clientData$url_port), - clientData$url_pathname, - "?", saveStateURL(input, exclude) - ) - ), - br(), - span(class = "text-muted", - "The state of this application has been saved." + tags$textarea(class = "form-control", rows = "1", style = "resize: none;", + readonly = "readonly", + url ), + subtitleTag, + # Need separate show and shown listeners. The show listener sizes the + # textarea just as the modal starts to fade in. The 200ms delay is needed + # because if we try to resize earlier, it can't calculate the text height + # (scrollHeight will be reported as zero). The shown listener selects the + # text; it's needed because because selection has to be done after the fade- + # in is completed. tags$script( - "$('#shiny-modal').one('shown.bs.modal', function() { - $('#shiny-modal input[type=text]').select().focus(); - })" + "$('#shiny-modal'). + one('show.bs.modal', function() { + setTimeout(function() { + var $textarea = $('#shiny-modal textarea'); + $textarea.innerHeight($textarea[0].scrollHeight); + }, 200); + }); + $('#shiny-modal') + .one('shown.bs.modal', function() { + $('#shiny-modal textarea').select().focus(); + });" ) ) } +#' Configure bookmarking for the current session +#' +#' There are two types of bookmarking: saving state, and encoding state. +#' +#' @param eventExpr An expression to listen for, similar to +#' \code{\link{observeEvent}}. +#' @param enable If \code{TRUE} (the default), enable bookmarking for this app. +#' @param type Either \code{"save"}, which saves to disk, or \code{"encode"}, +#' which encodes all of the relevant values in a URL. +#' @param exclude Input values to exclude from bookmarking. +#' @param onBookmarked A callback function to invoke after the bookmarking has +#' been done. +#' @param session A Shiny session object. #' @export -encodeStateModal <- function(input, exclude = NULL, - session = getDefaultReactiveDomain()) +configureBookmarking <- function(eventExpr, enable = TRUE, + type = c("save", "encode"), exclude = NULL, + onBookmarked = NULL, session = getDefaultReactiveDomain()) { - clientData <- session$clientData - modalDialog( - title = "Share link", - easyClose = TRUE, - footer = NULL, - tags$textarea(class = "form-control", rows = "5", style = "resize: none;", - paste0( - clientData$url_protocol, "//", - clientData$url_hostname, - if (nzchar(clientData$url_port)) paste0(":", clientData$url_port), - clientData$url_pathname, - "?", encodeStateURL(input, exclude) - ) - ), - tags$script( - "$('#shiny-modal').one('shown.bs.modal', function() { - $('#shiny-modal textarea').select().focus(); - })" + eventExpr <- substitute(eventExpr) + type <- match.arg(type) + + # If no onBookmarked function is provided, use one of these defaults. + if (is.null(onBookmarked)) { + if (!is.function(onBookmarked)) + stop("onBookmarked must be a function") + + if (type == "save") { + onBookmarked <- function(url) { + showModal(urlModal(url, subtitle = "The state of this application has been saved.")) + } + } else { + onBookmarked <- function(url) { + showModal(urlModal(url)) + } + } + } + + # If there's an existing onBookmarked observer, destroy it before creating a + # new one. + if (!is.null(session$onBookmarkedObserver)) { + session$onBookmarkedObserver$destroy() + session$onBookmarkedObserver <- NULL + } + + if (enable) { + session$onBookmarkedObserver <- observeEvent( + eventExpr, + event.env = parent.frame(), + event.quoted = TRUE, + { + if (type == "save") { + url <- saveStateQueryString(session$input, exclude) + } else { + url <- encodeStateQueryString(session$input, exclude) + } + + clientData <- session$clientData + url <- paste0( + clientData$url_protocol, "//", + clientData$url_hostname, + if (nzchar(clientData$url_port)) paste0(":", clientData$url_port), + clientData$url_pathname, + "?", url + ) + + onBookmarked(url) + } ) - ) + } + + invisible() } diff --git a/R/shiny.R b/R/shiny.R index e2a785137..5305fb5d2 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -424,6 +424,7 @@ ShinySession <- R6Class( ), public = list( restoreContext = NULL, + onBookmarkedObserver = NULL, # Observer that's fired when bookmark event happens progressStack = 'Stack', # Stack of progress objects input = 'reactivevalues', # Externally-usable S3 wrapper object for .input output = 'ANY', # Externally-usable S3 wrapper object for .outputs diff --git a/man/configureBookmarking.Rd b/man/configureBookmarking.Rd new file mode 100644 index 000000000..61b319daa --- /dev/null +++ b/man/configureBookmarking.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/save-state.R +\name{configureBookmarking} +\alias{configureBookmarking} +\title{Configure bookmarking for the current session} +\usage{ +configureBookmarking(eventExpr, enable = TRUE, type = c("save", "encode"), + exclude = NULL, onBookmarked = NULL, + session = getDefaultReactiveDomain()) +} +\arguments{ +\item{eventExpr}{An expression to listen for, similar to +\code{\link{observeEvent}}.} + +\item{enable}{If \code{TRUE} (the default), enable bookmarking for this app.} + +\item{type}{Either \code{"save"}, which saves to disk, or \code{"encode"}, +which encodes all of the relevant values in a URL.} + +\item{exclude}{Input values to exclude from bookmarking.} + +\item{onBookmarked}{A callback function to invoke after the bookmarking has +been done.} + +\item{session}{A Shiny session object.} +} +\description{ +There are two types of bookmarking: saving state, and encoding state. +} + diff --git a/man/saveStateQueryString.Rd b/man/saveStateQueryString.Rd new file mode 100644 index 000000000..bfe49f977 --- /dev/null +++ b/man/saveStateQueryString.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/save-state.R +\name{saveStateQueryString} +\alias{encodeStateQueryString} +\alias{saveStateQueryString} +\title{Save or encode state of Shiny session} +\usage{ +saveStateQueryString(input, exclude = NULL) + +encodeStateQueryString(input, exclude = NULL) +} +\arguments{ +\item{input}{The session's input object.} + +\item{exclude}{A character vector of input names that should not be +bookmarked.} +} +\description{ +Shiny applications can have their state \emph{encoded} in a URL or +\emph{saved}. If the state is encoded, all of the input values are stored in +the URL. If the state is saved, the input values and any uploaded files are +stored on disk. +} +