Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Inject CSS styling into RMD parametrization app #866

Open
wants to merge 10 commits into
base: main
Choose a base branch
from
Open

Inject CSS styling into RMD parametrization app #866

Changes from 4 commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
2858c1f
added script/style string support
Nov 10, 2016
90b0ada
Revert "added script/style string support"
Nov 11, 2016
b0961f4
[params] added support for custom CSS/scripts
Nov 11, 2016
78958a6
Merge branch 'uriel/knit_with_params'
Nov 11, 2016
99e714d
[params] added tests to params_html_head
Nov 11, 2016
202f3e9
[params] typo in docs
Nov 11, 2016
c1ab123
[params] removed bootstrap
Nov 16, 2016
cfec064
[params] added support for disabling bootstrap
Nov 16, 2016
7f4acd0
[doc] updated docs
Nov 16, 2016
b8bb6f0
Merge branch 'master' of https://github.com/rstudio/rmarkdown
Nov 22, 2016
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
84 changes: 67 additions & 17 deletions R/params.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -186,6 +186,56 @@ params_namedList <- function() {
empty
}


setup_html_head <- function(html_head_style = c(),
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

nit: all of our other param helper functions have "params" in their name. It's not the best namespacing, but it's something.

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",
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Any situation where we will want to not inject the defaults?

"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)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why the as.vector conversion? Am I missing some subtlety?

a <- c(1,2)
lapply(a, function(b) b*2)
lapply(as.vector(a), function(b) b*2)

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Again, sorry, when I replied in the email, it put the comments in the wrong place.

the params can be strings or vector of strings.

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.
Expand All @@ -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.
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

nit: spelling of representing

#' @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.
#'
Expand All @@ -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(),
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One option that won't pollute the argument list so much is to have a single argument that accepts a named list.

html_head = list()

Then, if you want to specify some parts:

html_head = list(style = "body { font-size: 15px; }")

Not sure which would be preferred.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sorry, when I replied in the email, it put the comments in the wrong place.
I initially had the same idea, but as per @trestletech , the long form is preferred.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You could indeed go either way. I agree with @trestletech that R tends to stylistically prefer long argument lists. Even though this isn't normally good form in more well decomposed systems in R where many operations tend to be top level "one button" ones it makes some sense (also forces documentation of the parameters in .Rd as a side benefit).

html_head_script = c(),
html_head_style_link = c(),
html_head_script_link = c()) {

if (is.null(input_lines)) {
if (is.null(file)) {
Expand Down Expand Up @@ -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)

Expand Down