mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-29 03:00:45 -04:00
101 lines
2.7 KiB
R
101 lines
2.7 KiB
R
|
|
|
|
#' @export
|
|
textOutput <- function(outputId,
|
|
label = "",
|
|
labelOnTop = FALSE) {
|
|
|
|
tag <- tags$div()
|
|
if (nzchar(label)) {
|
|
tag <- appendTagChild(tag, label)
|
|
if (labelOnTop)
|
|
tag <- appendTagChild(tag, tags$br())
|
|
}
|
|
tag <- appendTagChild(tag, tags$span(id = outputId, class = "live-text"))
|
|
}
|
|
|
|
#' @export
|
|
verbatimTextOutput <- function(outputId) {
|
|
tags$pre(id = outputId, class = "live-text")
|
|
}
|
|
|
|
#' @export
|
|
plotOutput <- function(outputId, width = "100%", height="400px") {
|
|
style <- paste("width:", width, ";", "height:", height)
|
|
tags$div(id = outputId, class="live-plot", style = style)
|
|
}
|
|
|
|
#' @export
|
|
tableOutput <- function(outputId) {
|
|
tags$div(id = outputId, class="live-html")
|
|
}
|
|
|
|
|
|
renderPage <- function(applicationUI, connection) {
|
|
|
|
# provide a filter so we can intercept head tag requests
|
|
context <- new.env()
|
|
context$head <- character()
|
|
context$filter <- function(tag) {
|
|
if (identical(tag$name, "head")) {
|
|
textConn <- textConnection(NULL, "w")
|
|
textConnWriter <- function(text) cat(text, file = textConn)
|
|
writeTagChildren(tag$children, textConnWriter, 1, context)
|
|
context$head <- append(context$head, textConnectionValue(textConn))
|
|
close(textConn)
|
|
return (FALSE)
|
|
}
|
|
else {
|
|
return (TRUE)
|
|
}
|
|
}
|
|
|
|
# write ui HTML to a character vector
|
|
textConn <- textConnection(NULL, "w")
|
|
writeTag(applicationUI, function(text) cat(text, file = textConn), 0, context)
|
|
uiHTML <- textConnectionValue(textConn)
|
|
close(textConn)
|
|
|
|
# write preamble
|
|
writeLines(c('<!DOCTYPE html>',
|
|
'<html>',
|
|
'<head>',
|
|
' <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>',
|
|
' <script src="shared/jquery.js" type="text/javascript"></script>',
|
|
' <script src="shared/shiny.js" type="text/javascript"></script>',
|
|
' <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>',
|
|
context$head[!duplicated(context$head)],
|
|
'</head>',
|
|
'<body>',
|
|
recursive=TRUE),
|
|
con = connection)
|
|
|
|
# write UI html to connection
|
|
writeLines(uiHTML, con = connection)
|
|
|
|
# write end document
|
|
writeLines(c('</body>',
|
|
'</html>'),
|
|
con = connection)
|
|
}
|
|
|
|
#' @export
|
|
clientPage <- function(applicationUI, path='/') {
|
|
|
|
registerClient({
|
|
|
|
function(ws, header) {
|
|
if (header$RESOURCE != path)
|
|
return(NULL)
|
|
|
|
textConn <- textConnection(NULL, "w")
|
|
on.exit(close(textConn))
|
|
|
|
renderPage(applicationUI, textConn)
|
|
html <- paste(textConnectionValue(textConn), collapse='\n')
|
|
return(http_response(ws, 200, content=html))
|
|
}
|
|
})
|
|
}
|
|
|