From 848bcd2688e482e8a453f6e285278a077370f0e3 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Mon, 11 Dec 2017 11:12:48 +0100
Subject: [PATCH] Remove unnecessary library overrides
---
.../fastrShiny/shiny/R/fastr-imageutils.R | 38 ---
.../fastrShiny/shiny/R/fastr-render-plot.R | 230 ------------------
2 files changed, 268 deletions(-)
delete mode 100644 com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-imageutils.R
delete mode 100644 com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-render-plot.R
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-imageutils.R b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-imageutils.R
deleted file mode 100644
index b4eb62f148..0000000000
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-imageutils.R
+++ /dev/null
@@ -1,38 +0,0 @@
-eval(expression({
-plotPNG <- function(func, filename=tempfile(fileext='.png'),
- width=400, height=400, res=72, ...) {
-
- # If quartz is available, use png() (which will default to quartz).
- # Otherwise, if the Cairo package is installed, use CairoPNG().
- # Finally, if neither quartz nor Cairo, use png().
- if (capabilities("aqua")) {
- pngfun <- grDevices::png
- } else if ((getOption('shiny.usecairo') %OR% TRUE) &&
- nchar(system.file(package = "Cairo"))) {
- pngfun <- Cairo::CairoPNG
- } else {
- pngfun <- grDevices::png
- }
-
- pngfun(filename=filename, width=width, height=height, res=res, ...)
- # Call plot.new() so that even if no plotting operations are performed at
- # least we have a blank background. N.B. we need to set the margin to 0
- # temporarily before plot.new() because when the plot size is small (e.g.
- # 200x50), we will get an error "figure margin too large", which is triggered
- # by plot.new() with the default (large) margin. However, this does not
- # guarantee user's code in func() will not trigger the error -- they may have
- # to set par(mar = smaller_value) before they draw base graphics.
- ## TODO:
- #op <- graphics::par(mar = rep(0, 4))
- #tryCatch(
- #graphics::plot.new(),
- #finally = graphics::par(op)
- #)
-
- dv <- grDevices::dev.cur()
- on.exit(grDevices::dev.off(dv), add = TRUE)
- func()
-
- filename
-}
-}), asNamespace("shiny"))
\ No newline at end of file
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-render-plot.R b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-render-plot.R
deleted file mode 100644
index 82b949a45d..0000000000
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrShiny/shiny/R/fastr-render-plot.R
+++ /dev/null
@@ -1,230 +0,0 @@
-eval(expression({
-renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
- env=parent.frame(), quoted=FALSE,
- execOnResize=FALSE, outputArgs=list()
-) {
-
- ## TODO: always exec until the display list is re-enabled
- execOnResize=TRUE
-
- # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
- # is called
- installExprFunction(expr, "func", env, quoted, ..stacktraceon = TRUE)
-
- args <- list(...)
-
- if (is.function(width))
- widthWrapper <- reactive({ width() })
- else
- widthWrapper <- function() { width }
-
- if (is.function(height))
- heightWrapper <- reactive({ height() })
- else
- heightWrapper <- function() { height }
-
- # A modified version of print.ggplot which returns the built ggplot object
- # as well as the gtable grob. This overrides the ggplot::print.ggplot
- # method, but only within the context of renderPlot. The reason this needs
- # to be a (pseudo) S3 method is so that, if an object has a class in
- # addition to ggplot, and there's a print method for that class, that we
- # won't override that method. https://github.com/rstudio/shiny/issues/841
- print.ggplot <- function(x) {
- grid::grid.newpage()
-
- build <- ggplot2::ggplot_build(x)
-
- gtable <- ggplot2::ggplot_gtable(build)
- grid::grid.draw(gtable)
-
- structure(list(
- build = build,
- gtable = gtable
- ), class = "ggplot_build_gtable")
- }
-
-
- getDims <- function() {
- width <- widthWrapper()
- height <- heightWrapper()
-
- # Note that these are reactive calls. A change to the width and height
- # will inherently cause a reactive plot to redraw (unless width and
- # height were explicitly specified).
- if (width == 'auto')
- width <- session$clientData[[paste0('output_', outputName, '_width')]]
- if (height == 'auto')
- height <- session$clientData[[paste0('output_', outputName, '_height')]]
-
- list(width = width, height = height)
- }
-
- # Vars to store session and output, so that they can be accessed from
- # the plotObj() reactive.
- session <- NULL
- outputName <- NULL
-
- # This function is the one that's returned from renderPlot(), and gets
- # wrapped in an observer when the output value is assigned. The expression
- # passed to renderPlot() is actually run in plotObj(); this function can only
- # replay a plot if the width/height changes.
- renderFunc <- function(shinysession, name, ...) {
- session <<- shinysession
- outputName <<- name
-
- dims <- getDims()
-
- if (is.null(dims$width) || is.null(dims$height) ||
- dims$width <= 0 || dims$height <= 0) {
- return(NULL)
- }
-
- # The reactive that runs the expr in renderPlot()
- plotData <- plotObj()
-
- img <- plotData$img
-
- # If only the width/height have changed, simply replay the plot and make a
- # new img.
- if (dims$width != img$width || dims$height != img$height) {
- pixelratio <- session$clientData$pixelratio %OR% 1
-
- coordmap <- NULL
- plotFunc <- function() {
- ## TODO: display list
- #..stacktraceon..(grDevices::replayPlot(plotData$recordedPlot))
-
- # Coordmap must be recalculated after replaying plot, because pixel
- # dimensions will have changed.
-
- if (inherits(plotData$plotResult, "ggplot_build_gtable")) {
- coordmap <<- getGgplotCoordmap(plotData$plotResult, pixelratio, res)
- } else {
- coordmap <<- getPrevPlotCoordmap(dims$width, dims$height)
- }
- }
- outfile <- ..stacktraceoff..(
- plotPNG(plotFunc, width = dims$width*pixelratio, height = dims$height*pixelratio,
- res = res*pixelratio)
- )
- on.exit(unlink(outfile))
-
- img <- dropNulls(list(
- src = session$fileUrl(name, outfile, contentType='image/png'),
- width = dims$width,
- height = dims$height,
- coordmap = coordmap,
- # Get coordmap error message if present
- error = attr(coordmap, "error", exact = TRUE)
- ))
- }
-
- img
- }
-
-
- plotObj <- reactive(label = "plotObj", {
- if (execOnResize) {
- dims <- getDims()
- } else {
- isolate({ dims <- getDims() })
- }
-
- if (is.null(dims$width) || is.null(dims$height) ||
- dims$width <= 0 || dims$height <= 0) {
- return(NULL)
- }
-
- # Resolution multiplier
- pixelratio <- session$clientData$pixelratio %OR% 1
-
- plotResult <- NULL
- recordedPlot <- NULL
- coordmap <- NULL
- plotFunc <- function() {
- success <-FALSE
- tryCatch(
- {
- # This is necessary to enable displaylist recording
- #grDevices::dev.control(displaylist = "enable")
-
- # Actually perform the plotting
- result <- withVisible(func())
- success <- TRUE
- },
- finally = {
- if (!success) {
- # If there was an error in making the plot, there's a good chance
- # it's "Error in plot.new: figure margins too large". We need to
- # take a reactive dependency on the width and height, so that the
- # user's plotting code will re-execute when the plot is resized,
- # instead of just replaying the previous plot (which errored).
- getDims()
- }
- }
- )
-
- if (result$visible) {
- # Use capture.output to squelch printing to the actual console; we
- # are only interested in plot output
- utils::capture.output({
- # This ..stacktraceon.. negates the ..stacktraceoff.. that wraps
- # the call to plotFunc. The value needs to be printed just in case
- # it's an object that requires printing to generate plot output,
- # similar to ggplot2. But for base graphics, it would already have
- # been rendered when func was called above, and the print should
- # have no effect.
- plotResult <<- ..stacktraceon..(print(result$value))
- })
- }
-
- ## TODO: display list
- #recordedPlot <<- grDevices::recordPlot()
-
- if (inherits(plotResult, "ggplot_build_gtable")) {
- coordmap <<- getGgplotCoordmap(plotResult, pixelratio, res)
- } else {
- coordmap <<- getPrevPlotCoordmap(dims$width, dims$height)
- }
- }
-
- # This ..stacktraceoff.. is matched by the `func` function's
- # wrapFunctionLabel(..stacktraceon=TRUE) call near the beginning of
- # renderPlot, and by the ..stacktraceon.. in plotFunc where ggplot objects
- # are printed
- outfile <- ..stacktraceoff..(
- do.call(plotPNG, c(plotFunc, width=dims$width*pixelratio,
- height=dims$height*pixelratio, res=res*pixelratio, args))
- )
- on.exit(unlink(outfile))
-
- list(
- # img is the content that gets sent to the client.
- img = dropNulls(list(
- src = session$fileUrl(outputName, outfile, contentType='image/png'),
- width = dims$width,
- height = dims$height,
- coordmap = coordmap,
- # Get coordmap error message if present.
- error = attr(coordmap, "error", exact = TRUE)
- )),
- # Returned value from expression in renderPlot() -- may be a printable
- # object like ggplot2. Needed just in case we replayPlot and need to get
- # a coordmap again.
- plotResult = plotResult,
- recordedPlot = recordedPlot
- )
- })
-
-
- # If renderPlot isn't going to adapt to the height of the div, then the
- # div needs to adapt to the height of renderPlot. By default, plotOutput
- # sets the height to 400px, so to make it adapt we need to override it
- # with NULL.
- outputFunc <- plotOutput
- if (!identical(height, 'auto')) formals(outputFunc)['height'] <- list(NULL)
-
- markRenderFunction(outputFunc, renderFunc, outputArgs = outputArgs)
-
-}
-}), asNamespace("shiny"))
\ No newline at end of file
--
GitLab