From 0495fe2d71f2da0b36184bc340f7cc6cd6fde44f Mon Sep 17 00:00:00 2001
From: Barbara Borges Ribeiro <barb.b.ribeiro@gmail.com>
Date: Mon, 28 Mar 2016 15:31:33 +0100
Subject: [PATCH] updated renderFunc's to include a shinysession arg

---
 R/render-table.R  | 13 +++++++++----
 R/shinywrappers.R | 22 +++++++++++++++++++---
 2 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/R/render-table.R b/R/render-table.R
index 2a2fa2a18..2f49db03b 100644
--- a/R/render-table.R
+++ b/R/render-table.R
@@ -86,8 +86,10 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
   digitsWrapper <- createWrapper(digits)
   naWrapper <- createWrapper(na)
 
-  # Main render function
-  markRenderFunction(tableOutput, function() {
+  renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
+
     striped <- stripedWrapper()
     hover <- hoverWrapper()
     bordered <- borderedWrapper()
@@ -137,7 +139,7 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
       cols <- paste(vapply(data, defaultAlignment, character(1)), collapse = "")
       cols <- paste0(names, cols)
     } else {
-    ## Case 2: user-specified alignment
+      ## Case 2: user-specified alignment
       num_cols <- if (rownames) nchar(align) else nchar(align)+1
       valid <- !grepl("[^lcr\\?]", align)
       if (num_cols == ncol(data)+1 && valid) {
@@ -208,5 +210,8 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
       }
     }
     return(tab)
-  }, outputArgs = outputArgs)
+  }
+
+  # Main render function
+  markRenderFunction(tableOutput, renderFunc, outputArgs = outputArgs)
 }
diff --git a/R/shinywrappers.R b/R/shinywrappers.R
index 2dacb4304..b3e69a72b 100644
--- a/R/shinywrappers.R
+++ b/R/shinywrappers.R
@@ -177,6 +177,9 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
   installExprFunction(expr, "func", env, quoted)
 
   renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
+
     imageinfo <- func()
     # Should the file be deleted after being sent? If .deleteFile not set or if
     # TRUE, then delete; otherwise don't delete.
@@ -241,7 +244,10 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE, func = NULL,
     installExprFunction(expr, "func", env, quoted)
   }
 
-  renderFunc <- function() {
+  renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
+
     op <- options(width = width)
     on.exit(options(op), add = TRUE)
     paste(utils::capture.output(func()), collapse = "\n")
@@ -288,7 +294,9 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE,
     installExprFunction(expr, "func", env, quoted)
   }
 
-  renderFunc <- function() {
+  renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
     value <- func()
     return(paste(utils::capture.output(cat(value)), collapse="\n"))
   }
@@ -335,6 +343,9 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE,
   }
 
   renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
+
     result <- func()
     if (is.null(result) || length(result) == 0)
       return(NULL)
@@ -402,7 +413,9 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE,
 #'
 #' @export
 downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()) {
-  renderFunc <-function(shinysession, name, ...) {
+  renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
     shinysession$registerDownload(name, filename, contentType, content)
   }
   markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
@@ -479,6 +492,9 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
   installExprFunction(expr, "func", env, quoted)
 
   renderFunc <- function(shinysession, name, ...) {
+    session <<- shinysession
+    outputName <<- name
+
     if (is.function(options)) options <- options()
     options <- checkDT9(options)
     res <- checkAsIs(options)