R/golem_utils_ui.R
In joseph-shaw/OpenTrack: OpenTrack
Defines functions
sessiontypelist
theme_light
col_1
col_2
col_3
col_4
col_6
col_8
col_10
col_12
enurl
rep_br
with_red_star
jq_hide
display
undisplay
tagRemoveAttributes
named_to_li
list_to_p
list_to_li
Documented in
theme_light
#' Turn an R list into an HTML list
#'
#' @param list An R list
#' @param class a class for the list
#'
#' @return an HTML list
#' @noRd
#'
#' @examples
#' list_to_li(c("a","b"))
#'
#' @importFrom htmltools tags tagAppendAttributes tagList
list_to_li <- function(list, class = NULL){
if (is.null(class)){
tagList(
lapply(
list,
tags$li
)
)
} else {
res <- lapply(
list,
tags$li
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' @importFrom htmltools tags tagAppendAttributes tagList
list_to_p <- function(list, class = NULL){
if (is.null(class)){
tagList(
lapply(
list,
tags$p
)
)
} else {
res <- lapply(
list,
tags$p
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' @importFrom htmltools tags tagAppendAttributes tagList
named_to_li <- function(list, class = NULL){
if(is.null(class)){
res <- mapply(
function(x, y){
tags$li(
HTML(
sprintf("<b>%s:</b> %s", y, x)
)
)
},
list,
names(list),
SIMPLIFY = FALSE
)
tagList(res)
} else {
res <- mapply(
function(x, y){
tags$li(
HTML(
sprintf("<b>%s:</b> %s", y, x)
)
)
},
list,
names(list),
SIMPLIFY = FALSE
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' Remove a tag attribute
#'
#' @param tag the tag
#' @param ... the attributes to remove
#'
#' @return a new tag
#' @noRd
#'
#' @examples
#' a <- shiny::tags$p(src = "plop", "pouet")
#' tagRemoveAttributes(a, "src")
tagRemoveAttributes <- function(tag, ...) {
attrs <- as.character(list(...))
for (i in seq_along(attrs)) {
tag$attribs[[ attrs[i] ]] <- NULL
}
tag
}
#' Hide or display a tag
#'
#' @param tag the tag
#'
#' @return a tag
#' @noRd
#'
#' @examples
#' ## Hide
#' a <- shiny::tags$p(src = "plop", "pouet")
#' undisplay(a)
#' b <- shiny::actionButton("go_filter", "go")
#' undisplay(b)
#'
#' @importFrom htmltools tagList
undisplay <- function(tag) {
# if not already hidden
if (
!is.null(tag$attribs$style) &&
!grepl("display:\\s+none", tag$attribs$style)
) {
tag$attribs$style <- paste(
"display: none;",
tag$attribs$style
)
} else {
tag$attribs$style <- "display: none;"
}
tag
}
#' @importFrom htmltools tagList
display <- function(tag) {
if (
!is.null(tag$attribs$style) &&
grepl("display:\\s+none", tag$attribs$style)
) {
tag$attribs$style <- gsub(
"(\\s)*display:(\\s)*none(\\s)*(;)*(\\s)*",
"",
tag$attribs$style
)
}
tag
}
#' Hide an elements by calling jquery hide on it
#'
#' @param id the id of the element to hide
#'
#' @noRd
#'
#' @importFrom htmltools tags
jq_hide <- function(id) {
tags$script(sprintf("$('#%s').hide()", id))
}
#' Add a red star at the end of the text
#'
#' Adds a red star at the end of the text
#' (for example for indicating mandatory fields).
#'
#' @param text the HTLM text to put before the red star
#'
#' @return an html element
#' @noRd
#'
#' @examples
#' with_red_star("Enter your name here")
#'
#' @importFrom htmltools tags HTML
with_red_star <- function(text) {
htmltools::tags$span(
HTML(
paste0(
text,
htmltools::tags$span(
style = "color:red", "*"
)
)
)
)
}
#' Repeat tags$br
#'
#' @param times the number of br to return
#'
#' @return the number of br specified in times
#' @noRd
#'
#' @examples
#' rep_br(5)
#'
#' @importFrom htmltools HTML
rep_br <- function(times = 1) {
HTML(rep("<br/>", times = times))
}
#' Create an url
#'
#' @param url the URL
#' @param text the text to display
#'
#' @return an a tag
#' @noRd
#'
#' @examples
#' enurl("https://www.thinkr.fr", "ThinkR")
#'
#' @importFrom htmltools tags
enurl <- function(url, text){
tags$a(href = url, text)
}
#' Columns wrappers
#'
#' These are convenient wrappers around
#' `column(12, ...)`, `column(6, ...)`, `column(4, ...)`...
#'
#' @noRd
#'
#' @importFrom shiny column
col_12 <- function(...){
column(12, ...)
}
#' @importFrom shiny column
col_10 <- function(...){
column(10, ...)
}
#' @importFrom shiny column
col_8 <- function(...){
column(8, ...)
}
#' @importFrom shiny column
col_6 <- function(...){
column(6, ...)
}
#' @importFrom shiny column
col_4 <- function(...){
column(4, ...)
}
#' @importFrom shiny column
col_3 <- function(...){
column(3, ...)
}
#' @importFrom shiny column
col_2 <- function(...){
column(2, ...)
}
#' @importFrom shiny column
col_1 <- function(...){
column(1, ...)
}
# UNCOMMENT AND USE
#
# usethis::use_package("markdown")
# usethis::use_package("rmarkdown")
#
# To use this part of the UI
#
#' #' Include Content From a File
#' #'
#' #' Load rendered RMarkdown from a file and turn into HTML.
#' #'
#' #' @rdname includeRMarkdown
#' #' @export
#' #'
#' #' @importFrom rmarkdown render
#' #' @importFrom markdown markdownToHTML
#' #' @importFrom htmltools HTML
#' includeRMarkdown <- function(path){
#'
#' md <- tempfile(fileext = '.md')
#'
#' on.exit(unlink(md),add = TRUE)
#'
#' rmarkdown::render(
#' path,
#' output_format = 'md_document',
#' output_dir = tempdir(),
#' output_file = md,quiet = TRUE
#' )
#'
#' html <- markdown::markdownToHTML(md, fragment.only = TRUE)
#'
#' Encoding(html) <- "UTF-8"
#'
#' return(HTML(html))
#' }
#'
#'
# Created shinydashboardplus theme
#' @import shinydashboardPlus
theme_light <- function(){
# Create dashboard theme ----
theme_light <- shinyDashboardThemeDIY(
### general
appFontFamily = "Arial"
,appFontColor = "#616161"
,primaryFontColor = "rgb(0,0,0)"
,infoFontColor = "rgb(0,0,0)"
,successFontColor = "rgb(0,0,0)"
,warningFontColor = "rgb(0,0,0)"
,dangerFontColor = "rgb(0,0,0)"
,bodyBackColor = "#F9FAFB"
### header
,logoBackColor = "#252E3E"
,headerButtonBackColor = "#252E3E"
,headerButtonIconColor = "white"
,headerButtonBackColorHover = "#538CC6"
,headerButtonIconColorHover = "white"
,headerBackColor = "#252E3E"
,headerBoxShadowColor = "#CB2030"
,headerBoxShadowSize = "0px 0px 0px"
### sidebar
,sidebarBackColor = "#F9FAFB"
,sidebarPadding = 0
,sidebarMenuBackColor = "#F9FAFB"
,sidebarMenuPadding = 0
,sidebarMenuBorderRadius = 0
,sidebarShadowRadius = "0px 0px 0px"
,sidebarShadowColor = "#aaaaaa"
,sidebarUserTextColor = "#343D46"
,sidebarSearchBackColor = "rgb(55,72,80)"
,sidebarSearchIconColor = "rgb(153,153,153)"
,sidebarSearchBorderColor = "#D8DEE9"
,sidebarTabTextColor = "#343D46"
,sidebarTabTextSize = 15
,sidebarTabBorderStyle = "none none none none"
,sidebarTabBorderColor = "#D8DEE9"
,sidebarTabBorderWidth = 100
,sidebarTabBackColorSelected = "#D8DEE9"
,sidebarTabTextColorSelected = "rgb(0,0,0)"
,sidebarTabRadiusSelected = "0px 0px 0px 0px"
,sidebarTabBackColorHover = "#D8DEE9"
,sidebarTabTextColorHover = "rgb(50,50,50)"
,sidebarTabBorderStyleHover = "none solid solid solid"
,sidebarTabBorderColorHover = "transparent"
,sidebarTabBorderWidthHover = 1
,sidebarTabRadiusHover = "0px 0px 0px 0px"
### boxes
,boxBackColor = "rgb(255,255,255)"
,boxBorderRadius = 1
,boxShadowSize = "0px 0px 0px"
,boxShadowColor = "transparent"
,boxTitleSize = 16
,boxDefaultColor = "white" # "rgb(210,214,220)"
,boxPrimaryColor = "rgba(44,222,235,1)"
,boxInfoColor = "rgb(210,214,220)"
,boxSuccessColor = "#6699CC"
,boxWarningColor = "rgb(244,156,104)"
,boxDangerColor = "rgb(255,88,55)"
,tabBoxTabColor = "rgb(255,255,255)"
,tabBoxTabTextSize = 14
,tabBoxTabTextColor = "lightgrey" #"rgb(0,0,0)"
,tabBoxTabTextColorSelected = "#6699CC"
,tabBoxBackColor = "rgb(255,255,255)"
,tabBoxHighlightColor = "rgb(248,248,248)" #"#6699CC"
,tabBoxBorderRadius = 0
### inputs
,buttonBackColor = "rgb(245,245,245)"
,buttonTextColor = "rgb(0,0,0)"
,buttonBorderColor = "rgb(200,200,200)"
,buttonBorderRadius = 5
,buttonBackColorHover = "rgb(235,235,235)"
,buttonTextColorHover = "rgb(100,100,100)"
,buttonBorderColorHover = "rgb(200,200,200)"
,textboxBackColor = "rgb(255,255,255)"
,textboxBorderColor = "rgb(200,200,200)"
,textboxBorderRadius = 5
,textboxBackColorSelect = "rgb(245,245,245)"
,textboxBorderColorSelect = "rgb(200,200,200)"
### tables
,tableBackColor = "rgb(255,255,255)"
,tableBorderColor = "rgb(240,240,240)"
,tableBorderTopSize = 1
,tableBorderRowSize = 1
)
return(theme_light)
}
# Dropdown Lists
sessiontypelist <- function(){
return(read.csv("settings/lists.csv")[,1])
}
joseph-shaw/OpenTrack documentation built on Dec. 1, 2022, 9:54 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions sessiontypelist theme_light col_1 col_2 col_3 col_4 col_6 col_8 col_10 col_12 enurl rep_br with_red_star jq_hide display undisplay tagRemoveAttributes named_to_li list_to_p list_to_li
Documented in theme_light
#' Turn an R list into an HTML list
#'
#' @param list An R list
#' @param class a class for the list
#'
#' @return an HTML list
#' @noRd
#'
#' @examples
#' list_to_li(c("a","b"))
#'
#' @importFrom htmltools tags tagAppendAttributes tagList
list_to_li <- function(list, class = NULL){
if (is.null(class)){
tagList(
lapply(
list,
tags$li
)
)
} else {
res <- lapply(
list,
tags$li
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' @importFrom htmltools tags tagAppendAttributes tagList
list_to_p <- function(list, class = NULL){
if (is.null(class)){
tagList(
lapply(
list,
tags$p
)
)
} else {
res <- lapply(
list,
tags$p
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' @importFrom htmltools tags tagAppendAttributes tagList
named_to_li <- function(list, class = NULL){
if(is.null(class)){
res <- mapply(
function(x, y){
tags$li(
HTML(
sprintf("<b>%s:</b> %s", y, x)
)
)
},
list,
names(list),
SIMPLIFY = FALSE
)
tagList(res)
} else {
res <- mapply(
function(x, y){
tags$li(
HTML(
sprintf("<b>%s:</b> %s", y, x)
)
)
},
list,
names(list),
SIMPLIFY = FALSE
)
res <- lapply(
res,
function(x) {
tagAppendAttributes(
x,
class = class
)
}
)
tagList(res)
}
}
#' Remove a tag attribute
#'
#' @param tag the tag
#' @param ... the attributes to remove
#'
#' @return a new tag
#' @noRd
#'
#' @examples
#' a <- shiny::tags$p(src = "plop", "pouet")
#' tagRemoveAttributes(a, "src")
tagRemoveAttributes <- function(tag, ...) {
attrs <- as.character(list(...))
for (i in seq_along(attrs)) {
tag$attribs[[ attrs[i] ]] <- NULL
}
tag
}
#' Hide or display a tag
#'
#' @param tag the tag
#'
#' @return a tag
#' @noRd
#'
#' @examples
#' ## Hide
#' a <- shiny::tags$p(src = "plop", "pouet")
#' undisplay(a)
#' b <- shiny::actionButton("go_filter", "go")
#' undisplay(b)
#'
#' @importFrom htmltools tagList
undisplay <- function(tag) {
# if not already hidden
if (
!is.null(tag$attribs$style) &&
!grepl("display:\\s+none", tag$attribs$style)
) {
tag$attribs$style <- paste(
"display: none;",
tag$attribs$style
)
} else {
tag$attribs$style <- "display: none;"
}
tag
}
#' @importFrom htmltools tagList
display <- function(tag) {
if (
!is.null(tag$attribs$style) &&
grepl("display:\\s+none", tag$attribs$style)
) {
tag$attribs$style <- gsub(
"(\\s)*display:(\\s)*none(\\s)*(;)*(\\s)*",
"",
tag$attribs$style
)
}
tag
}
#' Hide an elements by calling jquery hide on it
#'
#' @param id the id of the element to hide
#'
#' @noRd
#'
#' @importFrom htmltools tags
jq_hide <- function(id) {
tags$script(sprintf("$('#%s').hide()", id))
}
#' Add a red star at the end of the text
#'
#' Adds a red star at the end of the text
#' (for example for indicating mandatory fields).
#'
#' @param text the HTLM text to put before the red star
#'
#' @return an html element
#' @noRd
#'
#' @examples
#' with_red_star("Enter your name here")
#'
#' @importFrom htmltools tags HTML
with_red_star <- function(text) {
htmltools::tags$span(
HTML(
paste0(
text,
htmltools::tags$span(
style = "color:red", "*"
)
)
)
)
}
#' Repeat tags$br
#'
#' @param times the number of br to return
#'
#' @return the number of br specified in times
#' @noRd
#'
#' @examples
#' rep_br(5)
#'
#' @importFrom htmltools HTML
rep_br <- function(times = 1) {
HTML(rep("<br/>", times = times))
}
#' Create an url
#'
#' @param url the URL
#' @param text the text to display
#'
#' @return an a tag
#' @noRd
#'
#' @examples
#' enurl("https://www.thinkr.fr", "ThinkR")
#'
#' @importFrom htmltools tags
enurl <- function(url, text){
tags$a(href = url, text)
}
#' Columns wrappers
#'
#' These are convenient wrappers around
#' `column(12, ...)`, `column(6, ...)`, `column(4, ...)`...
#'
#' @noRd
#'
#' @importFrom shiny column
col_12 <- function(...){
column(12, ...)
}
#' @importFrom shiny column
col_10 <- function(...){
column(10, ...)
}
#' @importFrom shiny column
col_8 <- function(...){
column(8, ...)
}
#' @importFrom shiny column
col_6 <- function(...){
column(6, ...)
}
#' @importFrom shiny column
col_4 <- function(...){
column(4, ...)
}
#' @importFrom shiny column
col_3 <- function(...){
column(3, ...)
}
#' @importFrom shiny column
col_2 <- function(...){
column(2, ...)
}
#' @importFrom shiny column
col_1 <- function(...){
column(1, ...)
}
# UNCOMMENT AND USE
#
# usethis::use_package("markdown")
# usethis::use_package("rmarkdown")
#
# To use this part of the UI
#
#' #' Include Content From a File
#' #'
#' #' Load rendered RMarkdown from a file and turn into HTML.
#' #'
#' #' @rdname includeRMarkdown
#' #' @export
#' #'
#' #' @importFrom rmarkdown render
#' #' @importFrom markdown markdownToHTML
#' #' @importFrom htmltools HTML
#' includeRMarkdown <- function(path){
#'
#' md <- tempfile(fileext = '.md')
#'
#' on.exit(unlink(md),add = TRUE)
#'
#' rmarkdown::render(
#' path,
#' output_format = 'md_document',
#' output_dir = tempdir(),
#' output_file = md,quiet = TRUE
#' )
#'
#' html <- markdown::markdownToHTML(md, fragment.only = TRUE)
#'
#' Encoding(html) <- "UTF-8"
#'
#' return(HTML(html))
#' }
#'
#'
# Created shinydashboardplus theme
#' @import shinydashboardPlus
theme_light <- function(){
# Create dashboard theme ----
theme_light <- shinyDashboardThemeDIY(
### general
appFontFamily = "Arial"
,appFontColor = "#616161"
,primaryFontColor = "rgb(0,0,0)"
,infoFontColor = "rgb(0,0,0)"
,successFontColor = "rgb(0,0,0)"
,warningFontColor = "rgb(0,0,0)"
,dangerFontColor = "rgb(0,0,0)"
,bodyBackColor = "#F9FAFB"
### header
,logoBackColor = "#252E3E"
,headerButtonBackColor = "#252E3E"
,headerButtonIconColor = "white"
,headerButtonBackColorHover = "#538CC6"
,headerButtonIconColorHover = "white"
,headerBackColor = "#252E3E"
,headerBoxShadowColor = "#CB2030"
,headerBoxShadowSize = "0px 0px 0px"
### sidebar
,sidebarBackColor = "#F9FAFB"
,sidebarPadding = 0
,sidebarMenuBackColor = "#F9FAFB"
,sidebarMenuPadding = 0
,sidebarMenuBorderRadius = 0
,sidebarShadowRadius = "0px 0px 0px"
,sidebarShadowColor = "#aaaaaa"
,sidebarUserTextColor = "#343D46"
,sidebarSearchBackColor = "rgb(55,72,80)"
,sidebarSearchIconColor = "rgb(153,153,153)"
,sidebarSearchBorderColor = "#D8DEE9"
,sidebarTabTextColor = "#343D46"
,sidebarTabTextSize = 15
,sidebarTabBorderStyle = "none none none none"
,sidebarTabBorderColor = "#D8DEE9"
,sidebarTabBorderWidth = 100
,sidebarTabBackColorSelected = "#D8DEE9"
,sidebarTabTextColorSelected = "rgb(0,0,0)"
,sidebarTabRadiusSelected = "0px 0px 0px 0px"
,sidebarTabBackColorHover = "#D8DEE9"
,sidebarTabTextColorHover = "rgb(50,50,50)"
,sidebarTabBorderStyleHover = "none solid solid solid"
,sidebarTabBorderColorHover = "transparent"
,sidebarTabBorderWidthHover = 1
,sidebarTabRadiusHover = "0px 0px 0px 0px"
### boxes
,boxBackColor = "rgb(255,255,255)"
,boxBorderRadius = 1
,boxShadowSize = "0px 0px 0px"
,boxShadowColor = "transparent"
,boxTitleSize = 16
,boxDefaultColor = "white" # "rgb(210,214,220)"
,boxPrimaryColor = "rgba(44,222,235,1)"
,boxInfoColor = "rgb(210,214,220)"
,boxSuccessColor = "#6699CC"
,boxWarningColor = "rgb(244,156,104)"
,boxDangerColor = "rgb(255,88,55)"
,tabBoxTabColor = "rgb(255,255,255)"
,tabBoxTabTextSize = 14
,tabBoxTabTextColor = "lightgrey" #"rgb(0,0,0)"
,tabBoxTabTextColorSelected = "#6699CC"
,tabBoxBackColor = "rgb(255,255,255)"
,tabBoxHighlightColor = "rgb(248,248,248)" #"#6699CC"
,tabBoxBorderRadius = 0
### inputs
,buttonBackColor = "rgb(245,245,245)"
,buttonTextColor = "rgb(0,0,0)"
,buttonBorderColor = "rgb(200,200,200)"
,buttonBorderRadius = 5
,buttonBackColorHover = "rgb(235,235,235)"
,buttonTextColorHover = "rgb(100,100,100)"
,buttonBorderColorHover = "rgb(200,200,200)"
,textboxBackColor = "rgb(255,255,255)"
,textboxBorderColor = "rgb(200,200,200)"
,textboxBorderRadius = 5
,textboxBackColorSelect = "rgb(245,245,245)"
,textboxBorderColorSelect = "rgb(200,200,200)"
### tables
,tableBackColor = "rgb(255,255,255)"
,tableBorderColor = "rgb(240,240,240)"
,tableBorderTopSize = 1
,tableBorderRowSize = 1
)
return(theme_light)
}
# Dropdown Lists
sessiontypelist <- function(){
return(read.csv("settings/lists.csv")[,1])
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.