From 2858c1f70e13a7780e4a5294a73dc878185d25eb Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Thu, 10 Nov 2016 17:01:18 -0600 Subject: [PATCH 1/8] added script/style string support --- R/params.R | 51 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 16 deletions(-) diff --git a/R/params.R b/R/params.R index 752c8055cc..aaae5f244b 100644 --- a/R/params.R +++ b/R/params.R @@ -194,6 +194,9 @@ params_namedList <- function() { #' @param shiny_args Additional arguments to \code{\link[shiny:runApp]{runApp}}. #' @param save_caption Caption to use use for button that saves/confirms parameters. #' @param encoding The encoding of the input file; see \code{\link{file}}. +#' @param a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD. +#' @param a string or a list/vector of strings representing LINK URLs that will be injected in the HTML HEAD. +#' @param a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD. #' #' @return named list with overridden parameter names and value. #' @@ -203,7 +206,10 @@ knit_params_ask <- function(file = NULL, params = NULL, shiny_args = NULL, save_caption = "Save", - encoding = getOption("encoding")) { + encoding = getOption("encoding"), + html_head_style = c(), + html_head_link = c(), + html_head_script = c()) { if (is.null(input_lines)) { if (is.null(file)) { @@ -402,21 +408,34 @@ knit_params_ask <- function(file = NULL, class = "container-fluid"), class = "navbar navbar-default navbar-fixed-bottom") - style <- shiny::tags$style( - # Our controls are wiiiiide. - ".container-fluid .shiny-input-container { width: auto; }", - # Prevent the save/cancel buttons from squashing together. - ".navbar button { margin-left: 10px; }", - # Style for the navbar footer. - # http://getbootstrap.com/components/#navbar-fixed-bottom - "body { padding-bottom: 70px; }" - ) - ## Escape is "cancel" and Enter is "save". - script <- shiny::tags$script(shiny::HTML("$(document).keyup(function(e) {\n", - "if (e.which == 13) { $('#save').click(); } // enter\n", - "if (e.which == 27) { $('#cancel').click(); } // esc\n", - "});" - )) + if (!is.list(html_head_style) && !is.vector(html_head_style)) { + html_head_style = c(html_head_style) + } + default_style <- c( + # Our controls are wiiiiide. + ".container-fluid .shiny-input-container { width: auto; }", + # Prevent the save/cancel buttons from squashing together. + ".navbar button { margin-left: 10px; }", + # Style for the navbar footer. + # http://getbootstrap.com/components/#navbar-fixed-bottom + "body { padding-bottom: 70px; }" + ) + all_styles <- append(default_style, html_head_style) + style <- do.call(shiny::tags$style, as.list(all_styles)) + + ## Escape is "cancel" and Enter is "save". + if (!is.list(html_head_script) && !is.vector(html_head_script)) { + html_head_script = c(html_head_script) + } + default_script <- c( + "$(document).keyup(function(e) {\n", + "if (e.which == 13) { $('#save').click(); } // enter\n", + "if (e.which == 27) { $('#cancel').click(); } // esc\n", + "});\n" + ) + all_scripts <- append(default_script, html_head_script) + script <- shiny::tags$script(do.call(shiny::HTML, as.list(all_scripts))) + ui <- shiny::bootstrapPage( shiny::tags$head(style, script), contents, From 90b0adaaa53010cc85227088111bdda7df2147f0 Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Fri, 11 Nov 2016 10:32:24 -0600 Subject: [PATCH 2/8] Revert "added script/style string support" This reverts commit 2858c1f70e13a7780e4a5294a73dc878185d25eb. --- R/params.R | 51 ++++++++++++++++----------------------------------- 1 file changed, 16 insertions(+), 35 deletions(-) diff --git a/R/params.R b/R/params.R index aaae5f244b..752c8055cc 100644 --- a/R/params.R +++ b/R/params.R @@ -194,9 +194,6 @@ params_namedList <- function() { #' @param shiny_args Additional arguments to \code{\link[shiny:runApp]{runApp}}. #' @param save_caption Caption to use use for button that saves/confirms parameters. #' @param encoding The encoding of the input file; see \code{\link{file}}. -#' @param a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD. -#' @param a string or a list/vector of strings representing LINK URLs that will be injected in the HTML HEAD. -#' @param a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD. #' #' @return named list with overridden parameter names and value. #' @@ -206,10 +203,7 @@ knit_params_ask <- function(file = NULL, params = NULL, shiny_args = NULL, save_caption = "Save", - encoding = getOption("encoding"), - html_head_style = c(), - html_head_link = c(), - html_head_script = c()) { + encoding = getOption("encoding")) { if (is.null(input_lines)) { if (is.null(file)) { @@ -408,34 +402,21 @@ knit_params_ask <- function(file = NULL, class = "container-fluid"), class = "navbar navbar-default navbar-fixed-bottom") - if (!is.list(html_head_style) && !is.vector(html_head_style)) { - html_head_style = c(html_head_style) - } - default_style <- c( - # Our controls are wiiiiide. - ".container-fluid .shiny-input-container { width: auto; }", - # Prevent the save/cancel buttons from squashing together. - ".navbar button { margin-left: 10px; }", - # Style for the navbar footer. - # http://getbootstrap.com/components/#navbar-fixed-bottom - "body { padding-bottom: 70px; }" - ) - all_styles <- append(default_style, html_head_style) - style <- do.call(shiny::tags$style, as.list(all_styles)) - - ## Escape is "cancel" and Enter is "save". - if (!is.list(html_head_script) && !is.vector(html_head_script)) { - html_head_script = c(html_head_script) - } - default_script <- c( - "$(document).keyup(function(e) {\n", - "if (e.which == 13) { $('#save').click(); } // enter\n", - "if (e.which == 27) { $('#cancel').click(); } // esc\n", - "});\n" - ) - all_scripts <- append(default_script, html_head_script) - script <- shiny::tags$script(do.call(shiny::HTML, as.list(all_scripts))) - + style <- shiny::tags$style( + # Our controls are wiiiiide. + ".container-fluid .shiny-input-container { width: auto; }", + # Prevent the save/cancel buttons from squashing together. + ".navbar button { margin-left: 10px; }", + # Style for the navbar footer. + # http://getbootstrap.com/components/#navbar-fixed-bottom + "body { padding-bottom: 70px; }" + ) + ## Escape is "cancel" and Enter is "save". + script <- shiny::tags$script(shiny::HTML("$(document).keyup(function(e) {\n", + "if (e.which == 13) { $('#save').click(); } // enter\n", + "if (e.which == 27) { $('#cancel').click(); } // esc\n", + "});" + )) ui <- shiny::bootstrapPage( shiny::tags$head(style, script), contents, From b0961f43196695e265d4bddaa89109f2c3497d1e Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Fri, 11 Nov 2016 11:25:55 -0600 Subject: [PATCH 3/8] [params] added support for custom CSS/scripts --- R/params.R | 84 +++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 67 insertions(+), 17 deletions(-) diff --git a/R/params.R b/R/params.R index 752c8055cc..7dc0c75a86 100644 --- a/R/params.R +++ b/R/params.R @@ -186,6 +186,56 @@ params_namedList <- function() { empty } + +setup_html_head <- function(html_head_style = c(), + html_head_script = c(), + html_head_style_link = c(), + html_head_script_link = c()) { + + default_style <- shiny::tags$style( + # Our controls are wiiiiide. + ".container-fluid .shiny-input-container { width: auto; }", + # Prevent the save/cancel buttons from squashing together. + ".navbar button { margin-left: 10px; }", + # Style for the navbar footer. + # http://getbootstrap.com/components/#navbar-fixed-bottom + "body { padding-bottom: 70px; }" + ) + ## Escape is "cancel" and Enter is "save". + default_script <- shiny::tags$script(shiny::HTML("$(document).keyup(function(e) {\n", + "if (e.which == 13) { $('#save').click(); } // enter\n", + "if (e.which == 27) { $('#cancel').click(); } // esc\n", + "});" + )) + + html_head_style <- as.vector(html_head_style) + custom_styles <- lapply(html_head_style, shiny::tags$style) + + html_head_script <- as.vector(html_head_script) + custom_scripts <- lapply(html_head_script, function(x) shiny::tags$script(shiny::HTML(x))) + + html_head_style_link <- as.vector(html_head_style_link) + custom_style_links <- lapply(html_head_style_link, function(x) shiny::tags$link(href = x)) + + html_head_script_link <- as.vector(html_head_script_link) + custom_script_links <- lapply(html_head_script_link, function(x) shiny::tags$script(src = x)) + + return (do.call( + shiny::tags$head, + append( + list(default_style, default_script), + c( + custom_styles, + custom_scripts, + custom_style_links, + custom_script_links + ) + ) + )) + # default_style, custom_styles[0], default_script)) +} + + #' Run a shiny application asking for parameter configuration for the given document. #' #' @param file Path to the R Markdown document with configurable parameters. @@ -194,6 +244,12 @@ params_namedList <- function() { #' @param shiny_args Additional arguments to \code{\link[shiny:runApp]{runApp}}. #' @param save_caption Caption to use use for button that saves/confirms parameters. #' @param encoding The encoding of the input file; see \code{\link{file}}. +#' @param html_head_style a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD. +#' @param html_head_script a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD. +#' @param html_head_style_link same as above except that these are interpreted as HREF attributes in LINK tags. +#' You must take care to unsure that the URL is absolute. +#' @param html_head_script_link same as above except that these are interpreted as SRC attributes in SCRIPT tags. +#' You must take care to unsure that the URL is absolute. #' #' @return named list with overridden parameter names and value. #' @@ -203,7 +259,11 @@ knit_params_ask <- function(file = NULL, params = NULL, shiny_args = NULL, save_caption = "Save", - encoding = getOption("encoding")) { + encoding = getOption("encoding"), + html_head_style = c(), + html_head_script = c(), + html_head_style_link = c(), + html_head_script_link = c()) { if (is.null(input_lines)) { if (is.null(file)) { @@ -402,23 +462,13 @@ knit_params_ask <- function(file = NULL, class = "container-fluid"), class = "navbar navbar-default navbar-fixed-bottom") - style <- shiny::tags$style( - # Our controls are wiiiiide. - ".container-fluid .shiny-input-container { width: auto; }", - # Prevent the save/cancel buttons from squashing together. - ".navbar button { margin-left: 10px; }", - # Style for the navbar footer. - # http://getbootstrap.com/components/#navbar-fixed-bottom - "body { padding-bottom: 70px; }" - ) - ## Escape is "cancel" and Enter is "save". - script <- shiny::tags$script(shiny::HTML("$(document).keyup(function(e) {\n", - "if (e.which == 13) { $('#save').click(); } // enter\n", - "if (e.which == 27) { $('#cancel').click(); } // esc\n", - "});" - )) ui <- shiny::bootstrapPage( - shiny::tags$head(style, script), + setup_html_head( + html_head_style = html_head_style, + html_head_script = html_head_script, + html_head_style_link = html_head_style_link, + html_head_script_link = html_head_script_link + ), contents, footer) From 99e714d12cb34ab2179160d6f78cf2b0ec8b57ae Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Fri, 11 Nov 2016 15:20:14 -0600 Subject: [PATCH 4/8] [params] added tests to params_html_head --- R/params.R | 10 ++--- man/knit_params_ask.Rd | 14 ++++++- tests/testthat/test-params.R | 76 ++++++++++++++++++++++++++++++++++++ 3 files changed, 94 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/test-params.R diff --git a/R/params.R b/R/params.R index 7dc0c75a86..2d4fd8bb0e 100644 --- a/R/params.R +++ b/R/params.R @@ -187,7 +187,7 @@ params_namedList <- function() { } -setup_html_head <- function(html_head_style = c(), +params_html_head <- function(html_head_style = c(), html_head_script = c(), html_head_style_link = c(), html_head_script_link = c()) { @@ -225,10 +225,10 @@ setup_html_head <- function(html_head_style = c(), append( list(default_style, default_script), c( - custom_styles, - custom_scripts, custom_style_links, - custom_script_links + custom_styles, + custom_script_links, + custom_scripts ) ) )) @@ -463,7 +463,7 @@ knit_params_ask <- function(file = NULL, class = "navbar navbar-default navbar-fixed-bottom") ui <- shiny::bootstrapPage( - setup_html_head( + params_html_head( html_head_style = html_head_style, html_head_script = html_head_script, html_head_style_link = html_head_style_link, diff --git a/man/knit_params_ask.Rd b/man/knit_params_ask.Rd index 9af145ec19..01049e707f 100644 --- a/man/knit_params_ask.Rd +++ b/man/knit_params_ask.Rd @@ -6,7 +6,9 @@ \usage{ knit_params_ask(file = NULL, input_lines = NULL, params = NULL, shiny_args = NULL, save_caption = "Save", - encoding = getOption("encoding")) + encoding = getOption("encoding"), html_head_style = c(), + html_head_script = c(), html_head_style_link = c(), + html_head_script_link = c()) } \arguments{ \item{file}{Path to the R Markdown document with configurable parameters.} @@ -20,6 +22,16 @@ knit_params_ask(file = NULL, input_lines = NULL, params = NULL, \item{save_caption}{Caption to use use for button that saves/confirms parameters.} \item{encoding}{The encoding of the input file; see \code{\link{file}}.} + +\item{html_head_style}{a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD.} + +\item{html_head_script}{a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD.} + +\item{html_head_style_link}{same as above except that these are interpreted as HREF attributes in LINK tags. +You must take care to unsure that the URL is absolute.} + +\item{html_head_script_link}{same as above except that these are interpreted as SRC attributes in SCRIPT tags. +You must take care to unsure that the URL is absolute.} } \value{ named list with overridden parameter names and value. diff --git a/tests/testthat/test-params.R b/tests/testthat/test-params.R new file mode 100644 index 0000000000..bc5f90d474 --- /dev/null +++ b/tests/testthat/test-params.R @@ -0,0 +1,76 @@ +context("params_html_head") + +anyHeadParams <- list( + html_head_style="style", + html_head_style_link = "link", + html_head_script = "script", + html_head_script_link = "scriptjs" +) + +test_that("adds default style and script", { + result <- params_html_head()$children + expect_equal(length(result), 2) + expect_equal(result[[1]]$name, "style") + expect_equal(result[[2]]$name, "script") +}) + +test_that("adds custom style after default style", { + result <- do.call(params_html_head, anyHeadParams)$children + expect_equal(length(result), 6) + expect_equal(result[[4]], shiny::tags$style("style")) +}) + +test_that("adds custom style links after default but before inline custom styles", { + result <- do.call(params_html_head, anyHeadParams)$children + expect_equal(length(result), 6) + expect_equal(result[[3]], shiny::tags$link(href = "link")) + expect_equal(result[[4]], shiny::tags$style("style")) +}) + +test_that("adds custom script links after default but before inline custom scripts", { + result <- do.call(params_html_head, anyHeadParams)$children + expect_equal(length(result), 6) + expect_equal(result[[5]], shiny::tags$script(src = "scriptjs")) + expect_equal(result[[6]], shiny::tags$script(shiny::HTML("script"))) +}) + +test_that("can pass string as style link", { + result <- params_html_head(html_head_style_link="link")$children + expect_equal(result[[3]], shiny::tags$link(href = "link")) +}) + +test_that("can pass vector of strings as style link", { + result <- params_html_head(html_head_style_link=c("link"))$children + expect_equal(result[[3]], shiny::tags$link(href = "link")) +}) + +test_that("can pass string as style", { + result <- params_html_head(html_head_style="style")$children + expect_equal(result[[3]], shiny::tags$style("style")) +}) + +test_that("can pass vector of strings as style", { + result <- params_html_head(html_head_style=c("style"))$children + expect_equal(result[[3]], shiny::tags$style("style")) +}) + +test_that("can pass string as script", { + result <- params_html_head(html_head_script="script")$children + expect_equal(result[[3]], shiny::tags$script(shiny::HTML("script"))) +}) + +test_that("can pass vector of strings as script", { + result <- params_html_head(html_head_script=c("script"))$children + expect_equal(result[[3]], shiny::tags$script(shiny::HTML("script"))) +}) + +test_that("can pass string as script link", { + result <- params_html_head(html_head_script_link="script")$children + expect_equal(result[[3]], shiny::tags$script(src = "script")) +}) + +test_that("can pass vector of strings as script link", { + result <- params_html_head(html_head_script_link=c("script"))$children + expect_equal(result[[3]], shiny::tags$script(src = "script")) +}) + From 202f3e9666c3886e2035d9a92f4faf3390487818 Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Fri, 11 Nov 2016 15:23:46 -0600 Subject: [PATCH 5/8] [params] typo in docs --- R/params.R | 2 +- man/knit_params_ask.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/params.R b/R/params.R index 2d4fd8bb0e..5d03aa6807 100644 --- a/R/params.R +++ b/R/params.R @@ -245,7 +245,7 @@ params_html_head <- function(html_head_style = c(), #' @param save_caption Caption to use use for button that saves/confirms parameters. #' @param encoding The encoding of the input file; see \code{\link{file}}. #' @param html_head_style a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD. -#' @param html_head_script a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD. +#' @param html_head_script a string or a list/vector of strings representing JS scripts that will be injected in the HTML HEAD. #' @param html_head_style_link same as above except that these are interpreted as HREF attributes in LINK tags. #' You must take care to unsure that the URL is absolute. #' @param html_head_script_link same as above except that these are interpreted as SRC attributes in SCRIPT tags. diff --git a/man/knit_params_ask.Rd b/man/knit_params_ask.Rd index 01049e707f..9fb402b8fb 100644 --- a/man/knit_params_ask.Rd +++ b/man/knit_params_ask.Rd @@ -25,7 +25,7 @@ knit_params_ask(file = NULL, input_lines = NULL, params = NULL, \item{html_head_style}{a string or a list/vector of strings representing CSS style that will be injected in the HTML HEAD.} -\item{html_head_script}{a string or a list/vector of strings represeting JS scripts that will be injected in the HTML HEAD.} +\item{html_head_script}{a string or a list/vector of strings representing JS scripts that will be injected in the HTML HEAD.} \item{html_head_style_link}{same as above except that these are interpreted as HREF attributes in LINK tags. You must take care to unsure that the URL is absolute.} From c1ab12325335f730842d9936b8533dc7d62f9537 Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Wed, 16 Nov 2016 12:22:59 -0600 Subject: [PATCH 6/8] [params] removed bootstrap --- R/params.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/params.R b/R/params.R index 5d03aa6807..650406d347 100644 --- a/R/params.R +++ b/R/params.R @@ -462,7 +462,7 @@ knit_params_ask <- function(file = NULL, class = "container-fluid"), class = "navbar navbar-default navbar-fixed-bottom") - ui <- shiny::bootstrapPage( + ui <- shiny::tagList( params_html_head( html_head_style = html_head_style, html_head_script = html_head_script, From cfec064acad4883574aa92395a0b664d562aadd2 Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Wed, 16 Nov 2016 16:06:33 -0600 Subject: [PATCH 7/8] [params] added support for disabling bootstrap --- R/params.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/params.R b/R/params.R index 650406d347..02a18ab410 100644 --- a/R/params.R +++ b/R/params.R @@ -250,6 +250,7 @@ params_html_head <- function(html_head_style = c(), #' You must take care to unsure that the URL is absolute. #' @param html_head_script_link same as above except that these are interpreted as SRC attributes in SCRIPT tags. #' You must take care to unsure that the URL is absolute. +#' @param disable_bootstrap if true, does not inject boostrap scripts and styles in the HTML HEAD. #' #' @return named list with overridden parameter names and value. #' @@ -263,7 +264,8 @@ knit_params_ask <- function(file = NULL, html_head_style = c(), html_head_script = c(), html_head_style_link = c(), - html_head_script_link = c()) { + html_head_script_link = c(), + disable_bootstrap = FALSE) { if (is.null(input_lines)) { if (is.null(file)) { @@ -462,7 +464,9 @@ knit_params_ask <- function(file = NULL, class = "container-fluid"), class = "navbar navbar-default navbar-fixed-bottom") - ui <- shiny::tagList( + buildPage <- ifelse((is.null(disable_bootstrap) | !isTruthy(disable_bootstrap)), shiny::bootstrapPage, shiny::tagList) + + ui <- buildPage( params_html_head( html_head_style = html_head_style, html_head_script = html_head_script, From 7f4acd008b1806b3a9808a9db03bf4ff6333ddb1 Mon Sep 17 00:00:00 2001 From: Uriel Avalos Date: Wed, 16 Nov 2016 16:07:45 -0600 Subject: [PATCH 8/8] [doc] updated docs --- man/knit_params_ask.Rd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/man/knit_params_ask.Rd b/man/knit_params_ask.Rd index 9fb402b8fb..87430e881c 100644 --- a/man/knit_params_ask.Rd +++ b/man/knit_params_ask.Rd @@ -8,7 +8,7 @@ knit_params_ask(file = NULL, input_lines = NULL, params = NULL, shiny_args = NULL, save_caption = "Save", encoding = getOption("encoding"), html_head_style = c(), html_head_script = c(), html_head_style_link = c(), - html_head_script_link = c()) + html_head_script_link = c(), disable_bootstrap = FALSE) } \arguments{ \item{file}{Path to the R Markdown document with configurable parameters.} @@ -32,6 +32,8 @@ You must take care to unsure that the URL is absolute.} \item{html_head_script_link}{same as above except that these are interpreted as SRC attributes in SCRIPT tags. You must take care to unsure that the URL is absolute.} + +\item{disable_bootstrap}{if true, does not inject boostrap scripts and styles in the HTML HEAD.} } \value{ named list with overridden parameter names and value.