Skip to content
This repository
Browse code

Integrate UI builder into Shiny

Replace example #1 HTML with builder
  • Loading branch information...
commit 04081ec2d3393cbcaa89e8cc68f9534a177bad1e 1 parent 442f3d9
Joe Cheng jcheng5 authored
18 NAMESPACE
... ... @@ -1,10 +1,28 @@
  1 +export(br)
  2 +export(defineUI)
  3 +export(div)
  4 +export(h1)
  5 +export(h2)
  6 +export(head)
  7 +export(header)
  8 +export(img)
  9 +export(input)
  10 +export(inputs)
1 11 export(invalidateLater)
  12 +export(outputs)
  13 +export(p)
  14 +export(page)
2 15 export(reactive)
3 16 export(reactivePlot)
4 17 export(reactiveTable)
5 18 export(reactiveText)
6 19 export(reactiveTimer)
7 20 export(runApp)
  21 +export(script)
  22 +export(shinyPlot)
  23 +export(shinyText)
  24 +export(style)
  25 +export(tag)
8 26 S3method(reactive,default)
9 27 S3method(reactive,"function")
10 28 S3method("$",reactvaluesreader)
144 R/ui.R
... ... @@ -1,10 +1,10 @@
1   -
2   -tag <- function(name, ...) {
  1 +#' @export
  2 +tag <- function(`_tag_name`, ...) {
3 3
4 4 # create basic tag data structure
5 5 tag <- list()
6 6 class(tag) <- "shiny.tag"
7   - tag$name <- name
  7 + tag$name <- `_tag_name`
8 8 tag$attribs <- list()
9 9 tag$children <- list()
10 10
@@ -14,33 +14,35 @@ tag <- function(name, ...) {
14 14 if (is.null(varArgsNames))
15 15 varArgsNames <- character(length=length(varArgs))
16 16
17   - for (i in 1:length(varArgsNames)) {
18   - # save name and value
19   - name <- varArgsNames[[i]]
20   - value <- varArgs[[i]]
21   -
22   - # process attribs
23   - if (nzchar(name))
24   - tag$attribs[[name]] <- value
25   -
26   - # process child tags
27   - else if (inherits(value, "shiny.tag")) {
28   - tag$children[[length(tag$children)+1]] <- value
29   - }
30   -
31   - # process lists of children
32   - else if (is.list(value)) {
33   - for(child in value) {
34   - if (inherits(child, "shiny.tag"))
35   - tag$children[[length(tag$children)+1]] <- child
36   - else
37   - tag$children[[length(tag$children)+1]] <- as.character(child)
  17 + if (length(varArgsNames) > 0) {
  18 + for (i in 1:length(varArgsNames)) {
  19 + # save name and value
  20 + name <- varArgsNames[[i]]
  21 + value <- varArgs[[i]]
  22 +
  23 + # process attribs
  24 + if (nzchar(name))
  25 + tag$attribs[[name]] <- value
  26 +
  27 + # process child tags
  28 + else if (inherits(value, "shiny.tag")) {
  29 + tag$children[[length(tag$children)+1]] <- value
  30 + }
  31 +
  32 + # process lists of children
  33 + else if (is.list(value)) {
  34 + for(child in value) {
  35 + if (inherits(child, "shiny.tag"))
  36 + tag$children[[length(tag$children)+1]] <- child
  37 + else
  38 + tag$children[[length(tag$children)+1]] <- as.character(child)
  39 + }
  40 + }
  41 +
  42 + # everything else treated as text
  43 + else {
  44 + tag$children[[length(tag$children)+1]] <- as.character(value)
38 45 }
39   - }
40   -
41   - # everything else treated as text
42   - else {
43   - tag$children[[length(tag$children)+1]] <- as.character(value)
44 46 }
45 47 }
46 48
@@ -48,38 +50,56 @@ tag <- function(name, ...) {
48 50 return (tag)
49 51 }
50 52
  53 +#' @export
51 54 h1 <- function(...) {
52 55 tag("h1", ...)
53 56 }
54 57
  58 +#' @export
55 59 h2 <- function(...) {
56 60 tag("h2", ...)
57 61 }
58 62
  63 +#' @export
59 64 p <- function(...) {
60 65 tag("p", ...)
61 66 }
62 67
  68 +#' @export
63 69 div <- function(...) {
64 70 tag("div", ...)
65 71 }
66 72
  73 +#' @export
67 74 img <- function(...) {
68 75 tag("img", ...)
69 76 }
70 77
  78 +#' @export
71 79 head <- function(...) {
72 80 tag("head", ...)
73 81 }
74 82
  83 +#' @export
75 84 script <- function(...) {
76 85 tag("script", ...)
77 86 }
78 87
  88 +#' @export
79 89 style <- function(...) {
80 90 tag("style", ...)
81 91 }
82 92
  93 +#' @export
  94 +input <- function(...) {
  95 + tag("input", ...)
  96 +}
  97 +
  98 +#' @export
  99 +br <- function(...) {
  100 + tag("br", ...)
  101 +}
  102 +
83 103 htmlEscape <- local({
84 104 .htmlSpecials <- list(
85 105 `&` = '&amp;',
@@ -119,24 +139,34 @@ htmlEscape <- local({
119 139 }
120 140 })
121 141
  142 +#' @export
122 143 shinyPlot <- function(outputId) {
123 144 list(head(script(src="foobar.js"),
124 145 style(src="foobar.css")),
125   - img(id = outputId, class ="live-plot"))
  146 + div(id = outputId, class ="live-plot"))
  147 +}
  148 +
  149 +#' @export
  150 +shinyText <- function(outputId) {
  151 + div(id = outputId, class = "live-text")
126 152 }
127 153
  154 +#' @export
128 155 header <- function(...) {
129 156 div(class="shiny-header", ...)
130 157 }
131 158
  159 +#' @export
132 160 inputs <- function(...) {
133 161 div(class="shiny-inputs", ...)
134 162 }
135 163
  164 +#' @export
136 165 outputs <- function(...) {
137 166 div(class="shiny-outputs", ...)
138 167 }
139 168
  169 +#' @export
140 170 defineUI <- function(...) {
141 171 div(class="shiny-ui", ...)
142 172 }
@@ -243,32 +273,36 @@ renderPage <- function(ui, connection) {
243 273 con = connection)
244 274 }
245 275
  276 +#' @export
  277 +page <- function(ui, path='/') {
  278 + function(ws, header) {
  279 + if (header$RESOURCE != path)
  280 + return(NULL)
  281 +
  282 + textConn <- textConnection(NULL, "w")
  283 + on.exit(close(textConn))
  284 +
  285 + renderPage(ui, textConn)
  286 + html <- paste(textConnectionValue(textConn), collapse='\n')
  287 + return(http_response(ws, 200, content=html))
  288 + }
  289 +}
246 290
247   -ui <- defineUI(
248   - header(
249   - h1("My first application"),
250   - p("This is a really exciting application")
251   - ),
252   - inputs(
253   - p("Here are the inputs")
254   - ),
255   - outputs(
256   - p("Check out my shiny plot:"),
257   - shinyPlot("plot1"),
258   - p("Check out my other shiny plot:"),
259   - shinyPlot("plot2")
260   - )
261   -)
  291 +# ui <- defineUI(
  292 +# header(
  293 +# h1("My first application"),
  294 +# p("This is a really exciting application")
  295 +# ),
  296 +# inputs(
  297 +# p("Here are the inputs")
  298 +# ),
  299 +# outputs(
  300 +# p("Check out my shiny plot:"),
  301 +# shinyPlot("plot1"),
  302 +# p("Check out my other shiny plot:"),
  303 +# shinyPlot("plot2")
  304 +# )
  305 +# )
262 306
263 307
264 308 #renderPage(ui, stdout())
265   -
266   -
267   -
268   -
269   -
270   -
271   -
272   -
273   -
274   -
15 examples/01_allcaps/app.R
... ... @@ -1,9 +1,22 @@
1 1 library(shiny)
2 2
  3 +
  4 +ui <- defineUI(
  5 + h1("Example 1: All Caps"),
  6 + p(
  7 + "Input:", br(),
  8 + input(name='val', type='text', value='Hello World!')
  9 + ),
  10 + p(
  11 + "You said:", br(),
  12 + shinyText("valUpper")
  13 + )
  14 +)
  15 +
3 16 app <- function(input, output) {
4 17 output$valUpper <- reactive(function() {
5 18 toupper(input$val)
6 19 })
7 20 }
8 21
9   -runApp(client='./www', server=app)
  22 +runApp(client=page(ui), server=app)
21 examples/01_allcaps/www/index.html
... ... @@ -1,21 +0,0 @@
1   -<html>
2   -<head>
3   - <script src="shared/jquery.js" type="text/javascript"></script>
4   - <script src="shared/shiny.js" type="text/javascript"></script>
5   - <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>
6   -</head>
7   -<body>
8   - <h1>Example 1: All Caps</h1>
9   -
10   - <p>
11   - Input:<br/>
12   - <input name="val" type="text" value="Hello World!"/>
13   - </p>
14   -
15   - <p>
16   - You said:<br/>
17   - <div id="valUpper" class="live-text"/>
18   - </p>
19   -
20   -</body>
21   -</html>
4 man/startApp.Rd
@@ -9,7 +9,9 @@
9 9 \arguments{
10 10 \item{client}{Path to the root of the
11 11 application-specific www files (which should include
12   - index.html).}
  12 + index.html); or, a function that knows how to serve up
  13 + www files (TODO: document); or, a list of one or more
  14 + paths and/or functions.}
13 15
14 16 \item{server}{If a character string, a path to the R file
15 17 that contains the server application logic. If a
2  shiny.Rproj
@@ -14,4 +14,4 @@ LaTeX: pdfLaTeX
14 14 RootDocument:
15 15
16 16 BuildType: Package
17   -PackageRoxygenize: rd
  17 +PackageRoxygenize: rd,namespace

0 comments on commit 04081ec

Please sign in to comment.
Something went wrong with that request. Please try again.