[Rpad-commits] r5 - in pkg/Rpad: . R inst inst/basehtml inst/basehtml/server man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jan 5 15:58:57 CET 2014
Author: jedick
Date: 2014-01-05 15:58:57 +0100 (Sun, 05 Jan 2014)
New Revision: 5
Added:
pkg/Rpad/inst/basehtml/DojoEvents.Rpad
pkg/Rpad/inst/basehtml/RpadWidgets.Rpad
Removed:
pkg/Rpad/inst/basehtml/RpadTest.Rpad
Modified:
pkg/Rpad/DESCRIPTION
pkg/Rpad/NAMESPACE
pkg/Rpad/R/Graphing.R
pkg/Rpad/R/HtmlTree.R
pkg/Rpad/R/LocalVersion.R
pkg/Rpad/R/Rpad-internal.R
pkg/Rpad/R/Util.R
pkg/Rpad/inst/NEWS
pkg/Rpad/inst/basehtml/BasicDocumentation.html
pkg/Rpad/inst/basehtml/DojoTest.html
pkg/Rpad/inst/basehtml/Example1.Rpad
pkg/Rpad/inst/basehtml/InputExamples.Rpad
pkg/Rpad/inst/basehtml/Rpad_body.js
pkg/Rpad/inst/basehtml/index.html
pkg/Rpad/inst/basehtml/server/R_process.pl
pkg/Rpad/man/Rpad-internal.Rd
pkg/Rpad/man/RpadGraphing.Rd
pkg/Rpad/man/RpadHTML.Rd
pkg/Rpad/man/RpadLocalServer.Rd
pkg/Rpad/man/RpadUtil.Rd
Log:
consolidate graphing functions; add Dojo events demo
Modified: pkg/Rpad/DESCRIPTION
===================================================================
--- pkg/Rpad/DESCRIPTION 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/DESCRIPTION 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,6 +1,6 @@
Package: Rpad
Title: Workbook-style, web-based interface to R
-Version: 1.3.99.2
+Version: 1.3.99.3
Author: Tom Short (EPRI), Philippe Grosjean (UMH EcoNum), Jeffrey Dick
Description: A workbook-style user interface to R through a web
browser. Provides convenient interaction with an R process
Modified: pkg/Rpad/NAMESPACE
===================================================================
--- pkg/Rpad/NAMESPACE 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/NAMESPACE 2014-01-05 14:58:57 UTC (rev 5)
@@ -5,7 +5,6 @@
Rpad,
startRpadServer,
stopRpadServer,
- ROutputFormat,
Html,
H,
HtmlTree,
@@ -13,11 +12,6 @@
BR,
HTMLon,
HTMLoff,
- HTMLh1,
- HTMLh2,
- HTMLh3,
- HTMLh4,
- HTMLh5,
HTMLargs,
HTMLtag,
HTMLetag,
@@ -31,12 +25,12 @@
graphoptions,
newgraph,
showgraph,
- RpadPlotName,
RpadURL,
RpadBaseURL,
RpadBaseFile,
RpadIsLocal,
- json
+ json,
+ RpadEnv
)
S3method(json, default)
Modified: pkg/Rpad/R/Graphing.R
===================================================================
--- pkg/Rpad/R/Graphing.R 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/R/Graphing.R 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,198 +1,121 @@
# Rpad graphing functions
-"graphoptions" <- function (..., reset = FALSE, override.check = TRUE) {
- # set various Rpad graph options
- # modified based on code from ps.options
- l... <- length(new <- list(...))
- old <- check.options(new = new, envir = .RpadEnv, name.opt = ".RpadGraphOptions",
- reset = as.logical(reset), assign.opt = l... > 0, override.check = override.check)
- if (reset || l... > 0)
- invisible(old)
- else old
-}
+######################
+# internal functions #
+######################
"newRpadPlotName" <- function(name = "") {
# Create a new Rpad plot name
# Updates the plot counter and name
if (name == "") {
- Counter <- get("Rpad.plot.counter", envir = .RpadEnv)
- assign("Rpad.plot.counter", Counter + 1, envir = .RpadEnv)
- name <- paste("Rpad_plot", Counter, sep="")
+ Counter <- get("plot.counter", envir = .RpadEnv)
+ assign("plot.counter", Counter + 1, envir = .RpadEnv)
+ name <- sprintf("Rpad_plot%03d", Counter)
}
- assign("Rpad.plot.name", name, envir = .RpadEnv)
+ assign("plot.name", name, envir = .RpadEnv)
name
}
-"RpadPlotName" <- function()
- get("Rpad.plot.name", envir = .RpadEnv)
+GScmd <- function(name, invisible=FALSE, infile=paste(name, ".eps", sep = "")) {
+ # generate a ghostscript command
+ # set invisible=TRUE for windows
+ # set infile="" for output piped to command (see ?postscript)
+ GO <- graphoptions()
+ gsexe <- Sys.getenv("R_GSCMD")
+ if (is.null(gsexe) || nchar(gsexe) == 0)
+ gsexe <- ifelse(.Platform$OS.type == "windows", "gswin32c.exe", "gs")
+ if(invisible) gshelp <- system(paste(gsexe, "-help"), intern = TRUE, invisible = TRUE)
+ else gshelp <- system(paste(gsexe, "-help"), intern = TRUE)
+ st <- grep("^Available", gshelp)
+ en <- grep("^Search", gshelp)
+ gsdevs <- gshelp[(st + 1):(en - 1)]
+ devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
+ if (match(GO$type, devs, 0) == 0)
+ stop(paste(paste("Device ", GO$type, "is not available"),
+ "Available devices are", paste(gsdevs, collapse = "\n"),
+ sep = "\n"))
+ cmd <- paste(gsexe, " -dNOPAUSE -dBATCH -q -sDEVICE=", GO$type,
+ " -r", GO$res, " -g", ceiling(GO$res * GO$width), "x",
+ ceiling(GO$res * GO$height), " -sOutputFile=", name,
+ ".", GO$extension, " ", infile, sep = "")
+}
-
+"newDevice" <- function(name) {
+ # Open a new device.
+ # If it's an R graphics device, initiate it.
+ # If it's a ghostscript-based device, set up the ghostscript handling.
+ name <- newRpadPlotName(name)
+ GO <- graphoptions()
+ if (GO$type == "Rpng") {
+ # for builtin png support
+ png(filename = paste(name, ".png", sep=""), width = GO$width*GO$res, height = GO$height*GO$res)
+ } else if (GO$type == "pngalpha") {
+ # for a ghostscript device using bitmap
+ if (.Platform$OS.type == "windows") {
+ cmd <- NULL
+ } else {
+ cmd <- GScmd(name, infile="")
+ }
+ postscript(file = paste(name, ".eps", sep=""), width = GO$width, height = GO$height,
+ pointsize = GO$pointsize,
+ paper = "special", horizontal = FALSE, print.it = !is.null(cmd),
+ command = cmd)
+ }
+}
"closeCurrentDevice" <- function() {
# Closes the current device and if the current device is postscript,
# process the output with ghostscript to generate the desired output.
- if (exists("RpadPlotParams", envir = .RpadEnv))
- p <- get("RpadPlotParams", envir = .RpadEnv)
- else
- return()
- dev.set(p$dev)
if (.Device == "postscript") {
dev.off()
if (.Platform$OS.type == "windows") {
- gsexe <- Sys.getenv("R_GSCMD")
- if (is.null(gsexe) || nchar(gsexe) == 0)
- gsexe <- ifelse(.Platform$OS.type == "windows", "gswin32c.exe", "gs")
-
- gshelp <- system(paste(gsexe, "-help"), intern = TRUE, invisible = TRUE)
- st <- grep("^Available", gshelp)
- en <- grep("^Search", gshelp)
- gsdevs <- gshelp[(st + 1):(en - 1)]
- devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
- if (match(p$type, devs, 0) == 0)
- stop(paste(paste("Device ", p$type, "is not available"),
- "Available devices are", paste(gsdevs, collapse = "\n"),
- sep = "\n"))
- cmd <- paste(gsexe, " -dNOPAUSE -dBATCH -q -sDEVICE=", p$type,
- " -r", p$res, " -g", ceiling(p$res * p$width), "x",
- ceiling(p$res * p$height), " -sOutputFile=", p$name,
- "-%03d.", p$extension, " ", p$name, ".eps", sep = "")
+ cmd <- GScmd(get("plot.name", envir = .RpadEnv), invisible=TRUE)
system(cmd, intern = TRUE, invisible = TRUE)
}
- for (fun in getHook("closeRpadDevice")) try(fun())
} else if (.Device != "null device") {
dev.off()
- for (fun in getHook("closeRpadDevice")) try(fun())
}
- assign("RpadPlotParams", NULL, envir = .RpadEnv)
}
-"newDevice" <- function(name, extension, type, res, width, height, deviceUsesPixels, pointsize, ...) {
- # Open a new device. If it's a ghostscript-based device, set up the
- # ghostscript handling.
- # If it's an R graphics device, initiate it.
- name <- newRpadPlotName(name)
- assign("Rpad.plot.type", type, envir = .RpadEnv)
- if (is.character(type) && type == "Rpng") { # for builtin png support
- unlink(grep(paste(name,".*\\.png",sep=""), dir(), value=T))
- png(filename = paste(name,"-%03d.png",sep=""), width = width*res, height = height*res)
- assign("RpadPlotParams", list(dev=dev.cur(), extension="png"), envir = .RpadEnv)
- } else if (is.function(type)) {
- # for an arbitrary R graphics device
- unlink(grep(paste(name,".*\\.", extension, sep=""), dir(), value=T))
- funargs <- formals(type)
- callargs <- list(file = paste(name, "-%03d.", extension, sep=""))
- if (deviceUsesPixels) {
- height <- height * res
- width <- width * res
- }
- extraargs <- c(list(res = res, width = width, height = height, pointsize = pointsize),
- list(...))
- if ("..." %in% names(funargs)) {
- # the device function has a ..., so we (probably) can pass everything
- callargs <- c(callargs, extraargs)
- } else {
- # remove arguments not used by this device function
- callargs <- c(callargs, extraargs[intersect(names(extraargs), names(funargs))])
- }
- do.call("type", callargs)
- assign("RpadPlotParams", list(dev=dev.cur(), extension=extension), envir = .RpadEnv)
- } else {
- # for a ghostscript device using bitmap
- unlink(grep(paste(name,".*\\.", extension,sep=""), dir(), value=T))
- if (.Platform$OS.type == "windows") {
- cmd <- NULL
- } else {
- gsexe <- Sys.getenv("R_GSCMD")
- if (is.null(gsexe) || nchar(gsexe) == 0)
- gsexe <- ifelse(.Platform$OS.type == "windows", "gswin32c.exe", "gs")
- gshelp <- system(paste(gsexe, "-help"), intern = TRUE)
- st <- grep("^Available", gshelp)
- en <- grep("^Search", gshelp)
- gsdevs <- gshelp[(st + 1):(en - 1)]
- devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
- if (match(type, devs, 0) == 0)
- stop(paste(paste("Device ", type, "is not available"),
- "Available devices are", paste(gsdevs, collapse = "\n"),
- sep = "\n"))
- cmd <- paste(gsexe, " -dNOPAUSE -dBATCH -q -sDEVICE=", type,
- " -r", res, " -g", ceiling(res * width), "x", ceiling(res *
- height), " -sOutputFile=", name, "-%03d.", extension, " ", sep = "")
- }
- postscript(file = paste(name,".eps",sep=""), width = width, height = height,
- pointsize = pointsize,
- paper = "special", horizontal = FALSE, print.it = !is.null(cmd),
- command = cmd, ...)
- assign("RpadPlotParams",
- list(dev=dev.cur(), name=name, type=type, width=width,
- height=height, res=res, extension=extension), envir = .RpadEnv)
- }
-}
-"newgraph" <- function(name = "", extension = graphoptions()$extension,
- type = graphoptions()$type, res = graphoptions()$res,
- width = graphoptions()$width, height = graphoptions()$height,
- deviceUsesPixels = graphoptions()$deviceUsesPixels,
- pointsize = graphoptions()$pointsize, sublines = graphoptions()$sublines,
- toplines = graphoptions()$toplines, ratio = graphoptions()$ratio,
- leftlines = graphoptions()$leftlines, lwd = graphoptions()$lwd, ...) {
-# Start a new Rpad graph.
-# uses code from bitmap and from Frank Harrell's Hmisc routine setps
-
- if (width == 0 & height == 0)
- width <- 3.5
- if (width > 0 & height == 0)
- height <- width/ratio
- if (width == 0 & height > 0)
- width <- height * ratio
- closeCurrentDevice()
- newDevice(name, extension, type, res, width, height, deviceUsesPixels, pointsize, ...)
+##########################
+# user-visible functions #
+##########################
- par(lwd = lwd, mgp = c(2.5, 0.6, 0),
- mar = c(3 + sublines + 0.25 * (sublines > 0) +
- 0.5, 3 + leftlines + 0.5, toplines+.4, 1) + 0.1,
- cex.main=1,font.main=1,las=1)
- #require(lattice)
+"graphoptions" <- function (..., reset = FALSE, override.check = TRUE) {
+ # set various Rpad graph options
+ # modified based on code from ps.options
+ l... <- length(new <- list(...))
+ old <- check.options(new = new, envir = .RpadEnv, name.opt = "GraphOptions",
+ reset = as.logical(reset), assign.opt = l... > 0, override.check = override.check)
+ if (reset || l... > 0)
+ invisible(old)
+ else old
+}
-# lattice::lset(lattice::canonical.theme("postscript", color = TRUE))
-
-# if (exists('xyplot')) {
-# trellis.device(col=T)
-# lset(list(axis.line=list(col="gray50"),axis.text=list(col="black"),
-# strip.background=list(col="white"),strip.shingle=list(col="gray70")))
-# }
- for (fun in getHook("newgraph")) try(fun())
+"newgraph" <- function(name = "") {
+ # Start a new Rpad graph.
+ closeCurrentDevice()
+ newDevice(name)
+ GO <- graphoptions()
+ par(lwd = GO$lwd, mgp = c(2.5, 0.6, 0),
+ mar = c(3 + GO$sublines + 0.25 * (GO$sublines > 0) +
+ 0.5, 3 + GO$leftlines + 0.5, GO$toplines+.4, 1) + 0.1,
+ cex.main=1, font.main=1, las=1)
invisible()
}
# Start a new Rpad graph, and show the existing graph(s).
-"showgraph" <- function(name = RpadPlotName(), link = FALSE, ...) {
+"showgraph" <- function(name = get("plot.name", envir = .RpadEnv), link = FALSE, ...) {
name
newgraph()
- for (n in dir(pattern = paste(name, ".*", get("RpadPlotParams", envir = .RpadEnv)$extension, sep="")))
+ for (n in dir(pattern = paste(name, graphoptions()$extension, sep=".")))
print(HTMLimg(n))
- if (link && # show a link to an EPS file if specified and if using the ghostscript graphics
- get("Rpad.plot.type", envir = .RpadEnv) != "Rpng" &&
- !is.function(get("Rpad.plot.type", envir = .RpadEnv)))
+ # show a link to an EPS file if specified and if using the ghostscript graphics
+ if (link && graphoptions()$type == "pngalpha")
cat("<span contentEditable='false'>",
"<sub><a href='", RpadURL(name), ".eps'>[EPS]</a></sub>",
"</span>\n",
sep="")
invisible()
}
-
-
-# Here's an example hook that you could use to add an EPS preview to eps files (requires epstool)
-
-#eps.add.preview <- function(fname) system(paste("epstool -n1 -b -t6p -zbmp256 -r200 -g\"gswin32c\" -o",fname,".eps ",fname,".eps",sep=""),show.output.on.console = TRUE)
-#
-#setHook("closeRpadDevice", function() { # add a tiff preview to an eps file
-# name = RpadPlotName()
-# if (length(dir(pattern=paste(name,".eps",sep=""))) == 1)
-# eps.add.preview(name)
-#})
-
-### This will set the default graphics option to the GDD device:
-# library(GDD)
-# graphoptions(type = GDD)
-### This is how you could change the pointsize on a GDD device:
-# newgraph(ps = 10) # the default is 12
Modified: pkg/Rpad/R/HtmlTree.R
===================================================================
--- pkg/Rpad/R/HtmlTree.R 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/R/HtmlTree.R 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,10 +1,3 @@
-#
-#
-#
-#
-#
-#
-
"Html" <- function(x,...) {
UseMethod("Html")
}
@@ -118,23 +111,6 @@
}
-# broken:
-#"HtmlTree.list" <- "Html.list" <- function (x, first = TRUE, ...) {
-# res = rep(H("dum"), length = 2*length(x))
-# res[seq(1, 2*length(x), by = 2)] = H(NULL, names(x), collapseContents = FALSE)
-# res[seq(2, 2*length(x), by = 2)] = sapply(x, FUN = function(x)
-# H("ul",
-# Html(x, first = FALSE)))
-# if (first) # IE needs contenteditable off
-# H("div", contentEditable='false',
-# H("ul",
-# H("li",
-# H(NULL, res))))
-# else
-# H("li",
-# H(NULL, res))
-#}
-
"HTMLbutton" <- function(label = "Calculate", js = "rpad.calculatePage()", ...)
# Other useful js parameters:
# js = "rpad.calculateNext(this)" # calculate the next Rpad block
@@ -193,7 +169,7 @@
H("a", href = url, ...,
text))
-"HTMLimg" <- function(filename = RpadPlotName(), ...)
+"HTMLimg" <- function(filename = get("plot.name", envir = .RpadEnv), ...)
H("img", src = RpadURL(filename), ...)
"HTMLembed" <- function(filename, width = 600, height = 600, ...)
@@ -223,31 +199,12 @@
"BR" = function()
H("br", standaloneTag = TRUE) # <br/>
-"HTMLh1" <- function(text) {
- H("h1", text)
-}
-"HTMLh2" <- function(text) {
- H("h2", text)
-}
-"HTMLh3" <- function(text) {
- H("h3", text)
-}
-"HTMLh4" <- function(text) {
- H("h4", text)
-}
-"HTMLh5" <- function(text) {
- H("h5", text)
-}
-
"HTMLon" <- function()
H("htmlon", standaloneTag = TRUE)
"HTMLoff" <- function()
H("htmloff", standaloneTag = TRUE)
-"ROutputFormat" <- function(Format)
- options(R.output.format = Format)
-
"HTMLtag" <- function(tagName, ...) {
# outputs the given HTML tagName with arguments supplied in ...
str <- paste("<", tagName, HTMLargs(list(...)), ">", sep = "", collapse = "")
@@ -283,34 +240,3 @@
Html(x)
}
}
-
-"dojoTree" <- function(x, first = TRUE, ...) {
- x <- as.list(x)
- res <- sapply(seq(len = length(x)),
- function(i)
- H("div", dojoType="TreeNodeV3", ...,
- title = names(x)[i],
- if (is.list(x[[i]]) && !(any(class(x[[i]]) %in% gsub("^Html.","",methods(Html)))))
- dojoTree(x[[i]], first = FALSE)
- else
- H("div", dojoType="TreeNodeV3", title = Html(x[[i]]))))
- res <- paste(res, collapse="") # combine the list elements
- if (first) {
- H(NULL,
- H("div", dojoType = "TreeBasicControllerV3", widgetId="controller"),
- H("div", dojoType="TreeV3", listeners="controller",
- res))
- } else {
- res
- }
-}
-
-## ##tests for dojoTree
-## x = list(a = 1:2, 44, b = list(a = 3:4, b = 6:5), c = data.frame(a=1:5, b = 11:15))
-## HTMLon()
-## H("p", "A simple tree:")
-## dojoTree(x)
-## H("p", "An expanded version:")
-## dojoTree(x, expandLevel = 2)
-## H("p", "A bigger tree:")
-## dojoTree(as.list(lm(1:10 ~ rnorm(10))))
Modified: pkg/Rpad/R/LocalVersion.R
===================================================================
--- pkg/Rpad/R/LocalVersion.R 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/R/LocalVersion.R 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,19 +1,17 @@
# Rpad utility functions for running Rpad locally.
# Here we use a local Tcl httpd server to receive Rpad commands.
+# this is an internal function, but is exported to the package namespace
+# so that it can be evaluated from within the Tcl scripts
"processRpadCommands" <-
function() {
require("tcltk")
commands <- tclvalue(.Tcl("set user(R_commands)"))
textcommands <- textConnection(commands)
- .dev.active <- dev.cur()
- if (exists("RpadPlotParams", envir = .RpadEnv))
- dev.set( get("RpadPlotParams", envir = .RpadEnv)$dev )
-
results <- tryCatch({
tc <- textConnection("textfromconnection",open="w")
sink(file=tc)
- guiSource(textcommands)
+ source(textcommands, print.eval=TRUE)
sink()
close(tc)
# the result is R result text
@@ -27,48 +25,38 @@
etext <- paste(paste(get("textfromconnection"), "\n", collapse=""), '\n', e)
etext
}, finally=close(textcommands))
- dev.set(.dev.active)
formattedresults <- paste(results,"\n",sep="",collapse="")
-# cat(formattedresults)
escapeBrackets <- function(x) gsub("(\\{|\\})", "\\\\\\1", x)
.Tcl(paste("set RpadTclResults {", escapeBrackets(formattedresults), "}", sep=""))
}
-
"Rpad" <-
-function(file = "", defaultfile = "index.html", port = 8079) {
- startRpadServer(defaultfile, port)
- browseURL(paste("http://127.0.0.1:", port, "/", file, sep = ""))
+function(file = "", port = 8079, type="Rpng") {
+ # stop the local server if it's running
+ if(RpadIsLocal()) {
+ stopRpadServer()
+ WasRunning <- TRUE
+ } else WasRunning <- FALSE
+ # start the local server, set the graph type and browse to the default page
+ graphoptions(type=type)
+ startRpadServer(port=port)
+ if(!WasRunning) browseURL(paste("http://127.0.0.1:", port, "/", file, sep = ""))
}
"startRpadServer" <-
-function(defaultfile = "index.html", port = 8079) {
- require("tcltk")
+function(file = "index.html", port = 8079) {
# This is the main function that starts the server
- # This function implements a basic http server on 'port'
- # The server is written in Tcl.
- # This way it is not blocking the R command-line!
-
if (!require("tcltk")) stop("package tcltk required for the local Rpad http server")
assign("RpadLocal", TRUE, envir = .RpadEnv)
assign("RpadDir", ".", envir = .RpadEnv)
- assign("RpadPort", port, envir = .RpadEnv)
- graphoptions(type = "Rpng")
+ # This implements a basic http server on 'port', written in Tcl.
+ # This way it is not blocking the R command-line!
tclfile <- file.path(find.package(package = "Rpad"), "tcl", "mini1.1.tcl")
htmlroot <- file.path(find.package(package = "Rpad"), "basehtml")
tcl("source", tclfile)
- tcl("Httpd_Server", htmlroot, port, defaultfile)
- # delete the Rpad graphics files in the dir
- unlink(dir(pattern="Rpad_plot.*\\.png"))
- unlink(dir(pattern="Rpad_plot.*\\.eps"))
- # turn on the interactive plotting device so as not to confuse the command-line user if they later plot
- # ... but it's kind of distracting when Rpad starts so leave it off for now
- #if(interactive() && .Device == "null device") x11()
- #dev <- dev.cur()
+ tcl("Httpd_Server", htmlroot, port, file)
# this initializes the png device for Rpad
newgraph()
- # switch back to the existing device to not confuse the user
- #dev.set(dev)
return(TRUE)
}
@@ -76,9 +64,6 @@
function() {
require("tcltk")
assign("RpadLocal", FALSE, envir = .RpadEnv)
- # delete the Rpad graphics files in the dir
- unlink(dir(pattern="Rpad_plot.*\\.png"))
- unlink(dir(pattern="Rpad_plot.*\\.eps"))
.Tcl("close $Httpd(listen)")
.Tcl("unset Httpd")
}
Modified: pkg/Rpad/R/Rpad-internal.R
===================================================================
--- pkg/Rpad/R/Rpad-internal.R 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/R/Rpad-internal.R 2014-01-05 14:58:57 UTC (rev 5)
@@ -2,6 +2,9 @@
".onLoad" <-
function(lib, pkg) {
+ # create the RpadEnv environment
+ #attach(NULL, name=".RpadEnv")
+ # look for R2HTML package
isR2HMTLAvailable <- length(find.package("R2HTML", quiet = TRUE)) != 0
if (isR2HMTLAvailable) {
options(R2HTML.sortableDF = TRUE)
@@ -13,39 +16,36 @@
.HTML.file <<- ""
}
# The following uses the environment variable DOCUMENT_ROOT with apache to find
- # the directory of the R process. Change may be required for another server.
- if (Sys.getenv("DOCUMENT_ROOT") != "") { # works for Apache 1.3 linux & win
- RpadDir <- gsub(Sys.getenv("DOCUMENT_ROOT"), "",
- getwd(), ignore.case = TRUE) # strip off the document root
- } else if (Sys.getenv("SCRIPT_NAME") != "") { # for Apache 2.0
- RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("SCRIPT_NAME"), ignore.case = TRUE),
- gsub(".*/", "", getwd()),
- sep="")
- } else if (Sys.getenv("PATH_INFO") != "") { # for microsoft IIS
- RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("PATH_INFO"), ignore.case = TRUE),
- gsub(".*/", "", getwd()),
- sep="")
- } else {
- .rootdir = ifelse(.Platform$OS.type == "windows", "C:/www", "/var/www")
- RpadDir <- gsub(.rootdir, "", getwd(), ignore.case = TRUE)
- }
+ # the directory of the R process. Change may be required for another server.
+ if (Sys.getenv("DOCUMENT_ROOT") != "") {
+ # for Apache 1.3 linux & win
+ # strip off the document root
+ RpadDir <- gsub(Sys.getenv("DOCUMENT_ROOT"), "", getwd(), ignore.case = TRUE)
+ } else if (Sys.getenv("SCRIPT_NAME") != "") {
+ # for Apache 2.0
+ RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("SCRIPT_NAME"), ignore.case = TRUE),
+ gsub(".*/", "", getwd()), sep="")
+ } else if (Sys.getenv("PATH_INFO") != "") {
+ # for microsoft IIS
+ RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("PATH_INFO"), ignore.case = TRUE),
+ gsub(".*/", "", getwd()), sep="")
+ } else {
+ .rootdir = ifelse(.Platform$OS.type == "windows", "C:/www", "/var/www")
+ RpadDir <- gsub(.rootdir, "", getwd(), ignore.case = TRUE)
+ }
- options(R.output.format = "text") # do we need or want this anymore? If we do, why don't we put it in .RpadEnv?
-
- assign(".RpadGraphOptions",
- list(type = "pngalpha", extension = "png",
- res = 120, width = 0, height = 0, deviceUsesPixels = TRUE, pointsize = 10,
- sublines = 0, toplines = .6, ratio = 4/3, leftlines = 0, lwd = 0.6),
- envir = .RpadEnv)
+ assign("GraphOptions",
+ list(type = "pngalpha", extension = "png",
+ res = 120, width = 4, height = 3, deviceUsesPixels = TRUE, pointsize = 10,
+ sublines = 0, toplines = 0.6, leftlines = 0, lwd = 0.6),
+ envir = .RpadEnv)
assign("RpadLocal", FALSE, envir = .RpadEnv)
assign("RpadDir", RpadDir, envir = .RpadEnv)
- assign("Rpad.plot.counter", 0, envir = .RpadEnv)
+ assign("plot.counter", 0, envir = .RpadEnv)
}
".onUnload" <-
function(libpath) {
if (interactive()) stopRpadServer()
}
-
-".packageName" <- "Rpad"
Modified: pkg/Rpad/R/Util.R
===================================================================
--- pkg/Rpad/R/Util.R 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/R/Util.R 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,94 +1,8 @@
# Rpad utility functions.
-# this function is used to parse and evaluate the commands from an Rpad input block
-"guiSource" <-
-function (file, out.form = getOption("R.output.format"), local = FALSE,
- echo = verbose, print.eval = TRUE,
- verbose = getOption("verbose"), prompt.echo = getOption("prompt"),
- max.deparse.length = 150, chdir = FALSE)
-{
- eval.with.vis <- function(expr, envir = parent.frame(), enclos = if (is.list(envir) ||
- is.pairlist(envir))
- parent.frame()) withVisible(eval(expr, envir,
- enclos))
- envir <- if (local)
- parent.frame()
- else .GlobalEnv
- if (!missing(echo)) {
- if (!is.logical(echo))
- stop("echo must be logical")
- if (!echo && verbose) {
- warning(paste("verbose is TRUE, echo not; ... coercing",
- sQuote("echo <- TRUE")))
- echo <- TRUE
- }
- }
- if (verbose) {
- cat(sQuote("envir"), "chosen:")
- print(envir)
- }
- Ne <- length(exprs <- parse(n = -1, file = file))
- if (verbose)
- cat("--> parsed", Ne, "expressions; now eval(.)ing them:\n")
- if (Ne == 0)
- return(invisible())
- if (chdir && (path <- dirname(file)) != ".") {
- owd <- getwd()
- on.exit(setwd(owd))
- setwd(path)
- }
- if (echo) {
- sd <- "\""
- nos <- "[^\"]*"
- oddsd <- paste("^", nos, sd, "(", nos, sd, nos, sd, ")*",
- nos, "$", sep = "")
- }
- for (i in 1:Ne) {
- if (verbose)
- cat("\n>>>> eval(expression_nr.", i, ")\n\t\t =================\n")
- ei <- exprs[i]
- if (echo) {
- dep <- substr(paste(deparse(ei), collapse = "\n"),
- 12, 1e+06)
- nd <- nchar(dep) - 1
- do.trunc <- nd > max.deparse.length
- dep <- substr(dep, 1, if (do.trunc)
- max.deparse.length
- else nd)
- cat("\n", prompt.echo, dep, if (do.trunc)
- paste(if (length(grep(sd, dep)) && length(grep(oddsd,
- dep)))
- " ...\" ..."
- else " ....", "[TRUNCATED] "), "\n", sep = "")
- }
- yy <- eval.with.vis(ei, envir)
- i.symbol <- mode(ei[[1]]) == "name"
- if (!i.symbol) {
- curr.fun <- ei[[1]][[1]]
- if (verbose) {
- cat("curr.fun:")
- str(curr.fun)
- }
- }
- if (verbose >= 2) {
- cat(".... mode(ei[[1]])=", mode(ei[[1]]), "; paste(curr.fun)=")
- str(paste(curr.fun))
- }
- if ( yy$visible ) {
- # always print, even if not shown for side effects
- printoutput = capture.output(print(yy$value))
- if (out.form == "html" && exists("HTML"))
- HTML(yy$value)
- else if (out.form != "none")
- cat(paste(printoutput,collapse="\n"),"\n")
- }
- if (verbose)
- cat(" .. after ", sQuote(deparse(ei)), "\n", sep = "")
- }
- invisible(yy)
-}
+# for debugging, it's nice to have the .RpadEnv environment accessible
+RpadEnv <- function() .RpadEnv
-
"RpadURL" <- function(filename = "") {
# returns the URL for the given filename
# "./filename" for the local version
Modified: pkg/Rpad/inst/NEWS
===================================================================
--- pkg/Rpad/inst/NEWS 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/inst/NEWS 2014-01-05 14:58:57 UTC (rev 5)
@@ -1,4 +1,4 @@
-CHANGES IN Rpad 1.3.99.2 (2014-01-04)
+CHANGES IN Rpad 1.3.99.3 (2014-01-05)
-------------------------------------
- Restore Perl files related to server version of Rpad
@@ -15,6 +15,9 @@
uses Linux:Inotify to become aware of R commands, and attempts to
to self-destruct after 10 minutes.
+- Remove guiSource() (used to parse and evaluate the commands from an
+ Rpad input block - R's source() suffices).
+
CHANGES IN Rpad 1.3.99.0 (2013-12-31)
-------------------------------------
Modified: pkg/Rpad/inst/basehtml/BasicDocumentation.html
===================================================================
--- pkg/Rpad/inst/basehtml/BasicDocumentation.html 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/inst/basehtml/BasicDocumentation.html 2014-01-05 14:58:57 UTC (rev 5)
@@ -287,7 +287,15 @@
<li>rpad.calculateNext(node) -- Calculates the first Rpad widget after or under the given DOM node</li>
</ul>
+<p>Debugging hint: the dojo.js that is packaged with Rpad is an optimized (compressed)
+version. To debug errors in the Javascript code using e.g. Firebug, it is easier
+to use a non-compressed dojo.js. This can be built by setting layerOptimize: false
+in app.profile.js and then building Dojo as outlined in the README (you will need
+the complete Dojo source distribution). Then, place the un-optimized dojo.js
+in your working directory and start Rpad; this new dojo.js will take precedence
+over the one installed with the package.</p>
+
<h3>Example</h3>
<p>Here is an example of a complete Rpad HTML file:</p>
Added: pkg/Rpad/inst/basehtml/DojoEvents.Rpad
===================================================================
--- pkg/Rpad/inst/basehtml/DojoEvents.Rpad (rev 0)
+++ pkg/Rpad/inst/basehtml/DojoEvents.Rpad 2014-01-05 14:58:57 UTC (rev 5)
@@ -0,0 +1,115 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
+<html>
+
+
+<head>
+ <title>Dojo Events</title>
+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+ <script src="Rpad_head.js"></script>
+</head>
+
+
+<body>
+<script src="Rpad_body.js"></script>
+
+<h1>Dojo Events</h1>
+
+<p>(Modified from testDojoEvents.Rpad of Rpad 1.3.0)</p>
+
+<p>Normally, Rpad runs calculations on a page from top to bottom. With
+Dojo's event system, you can change that and run things in different orders
+or with different dependencies or to make interactions more dynamic.
+The following example updates the top Rpad input block whenever you change the select
+box created by the third Rpad input block. </p>
+
+
+<div data-dojo-type="Rpad" rpadRun="none" id="rpad3">
+<pre>
+# this block (id=rpad3) runs after the Rpad section below is finished
+p = state.x77[sname, "Population"]
+a = state.area[state.name==sname]
+cat("population density of", sname, "is", 1000*p/a, "persons/sq.mile")
+</pre>
+</div>
+<br/>
+
+<div data-dojo-type="Rpad" rpadRun="none" id="rpad2">
+<pre>
+# this block (id=rpad2) runs when the select box is updated
+HTMLon()
+H("h3", sname)
+Html(state.x77[sname, , drop=FALSE])
+n <- n + 1
+pop <- pop + state.x77[sname, "Population"]
+BR()
+cat("in the", n, "states selected so far, the total population is", pop, "thousand people")
+</pre>
+</div>
+<br/>
+
+<div data-dojo-type="Rpad" rpadRun="init" id="rpad1">
+<pre>
+# this block (id=rpad1) runs initially
+pop <- n <- 0
+data(state)
+cat("Pick a state:")
+HTMLon()
+HTMLselect("sname", state.name, id="sNameSelect")
+</pre>
+</div>
+<br/>
+
+
+<br/>
+
+<p>Dojo Javascript code to tie the GUI together (normally, you'd hide this code):</p>
+
+
+<div data-dojo-type="Rpad" rpadRun="init" rpadOutput="javascript">
+<pre>
+require(["dojo/parser", "dojo/on", "dojo/dom", "dijit/registry", "dojo/aspect", "dojo/domReady!"],
+function(parser, on, dom, registry, aspect){
+
+ // parsing the nodes is needed when using declarative syntax
+ // http://dojotoolkit.org/documentation/tutorials/1.8/declarative/
+ parser.parse();
+
+ // to make the select box automatically update the R variable
+ // we watch for a change in the widget holding the select box
+ var myWidget1 = registry.byId("rpad1");
+ on(myWidget1, "change", function(evt){
+
+ var mySelect = dom.byId("sNameSelect");
+ // here, set 'doit' (second argument) to true to force calculation of
+ // a node with rpadRun="init" (which otherwise is calculated only on page load).
+ rpad.calculateNode(mySelect, true)
+
+ // when the select is done updating (has a response from R), calculate "rpad2"
+ var handle = aspect.after(mySelect, "onReceive", function(response){
+ // to run just once, we remove this handle, otherwise the 'n' increments indefinitely
+ handle.remove();
+ //rpad.calculateNode("rpad2", true)
+ var myWidget2 = registry.byId("rpad2");
+ myWidget2.calculate();
+ });
+
+ // when "rpad2" is done, calculate "rpad3"
+ var myWidget2 = registry.byId("rpad2");
+ on(myWidget2, "receive", function(evt) {
+ var myWidget3 = registry.byId("rpad3");
+ // set a 0.5s timeout to visually demonstrate the order of calculation
+ setTimeout(function() {
+ myWidget3.calculate();
+ }, 500);
+ });
+
+ });
+
+});
+</pre>
+</div>
+
+
+</body>
+</html>
+
Modified: pkg/Rpad/inst/basehtml/DojoTest.html
===================================================================
--- pkg/Rpad/inst/basehtml/DojoTest.html 2014-01-04 10:15:39 UTC (rev 4)
+++ pkg/Rpad/inst/basehtml/DojoTest.html 2014-01-05 14:58:57 UTC (rev 5)
@@ -60,6 +60,7 @@
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rpad -r 5
More information about the Rpad-commits
mailing list