[Sciviews-commits] r378 - komodo/SciViews-K komodo/SciViews-K/components komodo/SciViews-K/content/js pkg/svGUI pkg/svGUI/R pkg/svMisc pkg/svMisc/R pkg/svMisc/inst pkg/svMisc/inst/unitTests pkg/svMisc/man pkg/svSocket pkg/svSocket/R pkg/svUnit pkg/svUnit/inst/doc pkg/tcltk2
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 13 22:22:00 CEST 2011
Author: phgrosjean
Date: 2011-06-13 22:21:58 +0200 (Mon, 13 Jun 2011)
New Revision: 378
Added:
pkg/tcltk2/tcltk2 tk2icoReplacement.R
Modified:
komodo/SciViews-K/.DS_Store
komodo/SciViews-K/components/svIRinterpreter.idl
komodo/SciViews-K/content/js/r.js
komodo/SciViews-K/sciviewsk-0.9.21-ko.xpi
pkg/svGUI/DESCRIPTION
pkg/svGUI/NEWS
pkg/svGUI/R/httpServer.R
pkg/svMisc/DESCRIPTION
pkg/svMisc/NEWS
pkg/svMisc/R/captureAll.R
pkg/svMisc/R/parseText.R
pkg/svMisc/inst/CITATION
pkg/svMisc/inst/unitTests/runitsvMisc.R
pkg/svMisc/man/captureAll.Rd
pkg/svMisc/man/parseText.Rd
pkg/svSocket/DESCRIPTION
pkg/svSocket/NEWS
pkg/svSocket/R/processSocket.R
pkg/svSocket/TODO
pkg/svUnit/NEWS
pkg/svUnit/inst/doc/svUnit.pdf
Log:
Fine-tuning of parseText() and captureAll() in svMisc and change of related functions elsewhere
Modified: komodo/SciViews-K/.DS_Store
===================================================================
(Binary files differ)
Modified: komodo/SciViews-K/components/svIRinterpreter.idl
===================================================================
--- komodo/SciViews-K/components/svIRinterpreter.idl 2011-05-13 21:22:17 UTC (rev 377)
+++ komodo/SciViews-K/components/svIRinterpreter.idl 2011-06-13 20:21:58 UTC (rev 378)
@@ -35,6 +35,7 @@
[scriptable, uuid(5e04a8de-ac01-4df1-af7a-184130e645b8)]
interface svIRinterpreter : nsISupports {
+
/**
* Escape from multiline mode in the R interpreter.
*/
Modified: komodo/SciViews-K/content/js/r.js
===================================================================
--- komodo/SciViews-K/content/js/r.js 2011-05-13 21:22:17 UTC (rev 377)
+++ komodo/SciViews-K/content/js/r.js 2011-06-13 20:21:58 UTC (rev 378)
@@ -108,7 +108,7 @@
// Define the 'sv.r' namespace
if (typeof(sv.r) == 'undefined')
sv.r = {
- RMinVersion: "2.11.0", // Minimum version of R required
+ RMinVersion: "2.13.0", // Minimum version of R required
// server: "http", // Currently, either 'http' or 'socket'
server: "socket", // KB: http is still problematic, changed the default
@@ -189,8 +189,10 @@
}
} else { // This is some data returned by R
if (!partial) sv.cmdout.message("R is ready!", 0, false);
+ sv.cmdout.append(text, newline);
}
- sv.cmdout.append(text, newline);
+ // PhG: echo of commands is now done by the server, but still needed hereabove
+ //sv.cmdout.append(text, newline);
}
// Evaluate code in R
Modified: komodo/SciViews-K/sciviewsk-0.9.21-ko.xpi
===================================================================
(Binary files differ)
Modified: pkg/svGUI/DESCRIPTION
===================================================================
--- pkg/svGUI/DESCRIPTION 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svGUI/DESCRIPTION 2011-06-13 20:21:58 UTC (rev 378)
@@ -1,14 +1,14 @@
Package: svGUI
Type: Package
Title: SciViews GUI API - Functions to manage GUI client
-Depends: R (>= 2.11.0), svMisc (>= 0.9-60)
+Depends: R (>= 2.11.0), svMisc (>= 0.9-62)
Imports: tools
-Suggests: svSocket (>= 0.9-50)
+Suggests: svSocket (>= 0.9-52)
SystemRequirements: Komodo Edit (http://www.openkomodo.com), SciViews-K (http://www.sciviews.org/SciViews-K)
Description: Functions to manage the GUI client, like Komodo with the
SciViews-K extension
-Version: 0.9-50
-Date: 2010-10-01
+Version: 0.9-51
+Date: 2011-06-13
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svGUI/NEWS
===================================================================
--- pkg/svGUI/NEWS 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svGUI/NEWS 2011-06-13 20:21:58 UTC (rev 378)
@@ -1,5 +1,11 @@
= svGUI News
+== Changes in svGUI 0.9-51
+
+* HTTP server now works with the new version of captureAll() from svMisc 0.9-62
+ and it is compatible with its echo = and split = arguments.
+
+
== Changes in svGUI 0.9-50
* HTTP server now works correctly with incomplete commands (bug corrected).
Modified: pkg/svGUI/R/httpServer.R
===================================================================
--- pkg/svGUI/R/httpServer.R 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svGUI/R/httpServer.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -292,12 +292,15 @@
Continue <- pars$continue
Echo <- pars$echo
}
+ ## TODO: do we still need this?
## Eliminate last carriage return
msg <- sub("(.*)[\n][^\n]*$", "\\1", msg)
if (!hiddenMode) {
if (Echo) {
+ ## Note: command lines are now echoed directly in captureAll()
+ ## => no need of this any more!
if (pars$code == "") Pre <- Prompt else Pre <- Continue
- cat(Pre, msg, "\n", sep = "")
+ #cat(Pre, msg, "\n", sep = "")
}
## Add previous content if we were in multiline mode
if (pars$code != "") msg <- paste(pars$code, msg, sep = "\n")
@@ -361,8 +364,7 @@
}
}
## Correct code,... we evaluate it
- ## TODO: here, evaluate line by line and return result immediately!
- results <- captureAll(expr)
+ results <- captureAll(expr, echo = Echo, split = Echo)
## Should we run taskCallbacks?
if (!hiddenMode) {
h <- getTemp(".svTaskCallbackManager", default = NULL,
@@ -371,7 +373,7 @@
}
## Collapse and add last and the prompt at the end
results <- paste(results, collapse = "\n")
- if (Echo) cat(results)
+ #if (Echo) cat(results)
if (!returnResults) {
if (is.null(callback)) {
return(NULL)
Modified: pkg/svMisc/DESCRIPTION
===================================================================
--- pkg/svMisc/DESCRIPTION 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/DESCRIPTION 2011-06-13 20:21:58 UTC (rev 378)
@@ -2,11 +2,11 @@
Type: Package
Title: SciViews GUI API - Miscellaneous functions
Imports: utils, methods, tools
-Depends: R (>= 2.13.0)
+Depends: R (>= 2.11.0)
Suggests: svUnit
Description: Supporting functions for the GUI API (various utilitary functions)
Version: 0.9-62
-Date: 2011-05-11
+Date: 2011-06-12
Author: Philippe Grosjean, Romain Francois & Kamil Barton
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svMisc/NEWS
===================================================================
--- pkg/svMisc/NEWS 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/NEWS 2011-06-13 20:21:58 UTC (rev 378)
@@ -1,9 +1,19 @@
= svMisc News
-== Changes in svMisc **Working version**
+== Changes in svMisc 0.9-62
-* captureAll() now handles user interrupts and allows for traceback() afterwards.
+* captureAll() now handles user interrupts and allows for traceback() afterwards
+ and default value for split now changed to TRUE. The 'echo' argument allows
+ for echoing expressions being evaluated, like in the usual console, but a
+ mechanism allows to abbreviate very long expressions.
+* parseText() is reworked internally and it uses the srcfile/srcref mechanism
+ introduced in R recently. firstline, srcfilename and encoding arguments are
+ added.
+
+* Unit tests added (should run with both svUnit (advised) and RUnit).
+
+
== Changes in svMisc 0.9-61
* Better handling of non syntactically correct names in objList().
Modified: pkg/svMisc/R/captureAll.R
===================================================================
--- pkg/svMisc/R/captureAll.R 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/R/captureAll.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -1,58 +1,101 @@
-# inspired by 'capture.output' and utils:::.try_silent
-# Requires: R >= 2.13.0 [??]
-`captureAll` <- function(expr, split = FALSE, file = NULL, markStdErr=FALSE) {
- # TODO: support for 'file' and 'split'
+## Inspired by 'capture.output' and utils:::.try_silent
+## Requires: R >= 2.13.0 [??]
+`captureAll` <- function (expr, split = TRUE, echo = TRUE, file = NULL,
+markStdErr = FALSE) {
+ if (!is.expression(expr))
+ if (is.na(expr)) return(NA) else
+ stop("expr must be an expression or NA")
+
+ ## TODO: support for 'file'
+ ## markStdErr: if TRUE, stderr is separated from sddout by STX/ETX character
- # markStdErr: if TRUE, stderr is separated from sddout by STX/ETX character
-
last.warning <- list()
Traceback <- list()
- NframeOffset <- sys.nframe() + 20L # frame of reference (used in traceback) +
- # length of the call stack when a condition
- # occurs
- # Note: if 'expr' is a call not expression, 'NframeOffset' is lower by 2
- # (i.e. 21): -1 for lapply, -1 for unwrapping 'expression()'
+ NframeOffset <- sys.nframe() + 23L # frame of reference (used in traceback)
+ # + length of the call stack when a
+ # condition occurs
+ ## Note: if 'expr' is a call not expression, 'NframeOffset' is lower by 2
+ ## (i.e. 24): -1 for lapply, -1 for unwrapping 'expression()'
- getWarnLev <- function() options('warn')[[1L]] # this may change in course of
- # evaluation, so must be retrieved dynamically
-
+ getWarnLev <- function() options('warn')[[1L]] # This may change in course
+ # of evaluation, so must be
+ # retrieved dynamically
rval <- NULL
tconn <- textConnection("rval", "w", local = TRUE)
- sink(tconn, type = "output"); sink(tconn, type = "message")
+ split <- isTRUE(split)
+ if (split) {
+ ## This is required to print error messages when we are, say, in a
+ ## browser() environment
+ sink(stdout(), type = "message")
+ } else {
+ ## This is the conventional way to do it
+ sink(tconn, type = "message")
+ }
+ sink(tconn, type = "output", split = split)
+ #sink(tconn, type = "message")
on.exit({
- sink(type = "message"); sink(type = "output")
+ sink(type = "message")
+ sink(type = "output")
close(tconn)
})
inStdOut <- TRUE
- if (markStdErr) {
- putMark <- function(to.stdout, id) {
+ if (isTRUE(markStdErr)) {
+ putMark <- function (toStdout, id) {
if (inStdOut) {
- if (!to.stdout) {
+ if (!toStdout) {
cat("\x03")
inStdOut <<- FALSE
- }} else { # in StdErr stream
- if (to.stdout) {
+ }
+ } else { # in StdErr stream
+ if (toStdout) {
cat("\x02")
inStdOut <<- TRUE
- }}
+ }
+ }
#cat("<", id, inStdOut, ">")
}
} else {
- putMark <- function(to.stdout, id) {}
+ putMark <- function (toStdout, id) {}
}
- `evalVis` <- function(x) withVisible(eval(x, .GlobalEnv))
+ evalVis <- function (x) {
+ ## Do we print the command? (note that it is reformatted here)
+ if (isTRUE(echo)) {
+ ## Reformat long commands... and possibly abbreviate them
+ cmd <- deparse(x)
+ l <- length(cmd)
+ if (l > 7) cmd <- c(cmd[1:3], "[...]", cmd[(l-2):l])
+ cat(":> ", paste(cmd, collapse = "\n:+ "), "\n", sep = "")
+ }
+ res <- withVisible(eval(x, .GlobalEnv))
+ ## Do we have result to print?
+ if (inherits(res, "list") && res$visible)
+ print(res$value)
+
+ return(res)
+ }
- `restartError` <- function(e, calls) {
- # remove call (eval(expr, envir, enclos)) from the message
+ formatMsg <- function (msg) {
+ ## For some reasons, 'Error: ' and 'Error in ' are not translated,
+ ## although the rest of the message is correctly translated
+ ## This is a workaround for this little problem
+ res <- .makeMessage(msg)
+ res <- sub("^Error: ", ngettext(1, "Error: ", "Error: ", domain = "R"),
+ res)
+ res <- sub("^Error in ", ngettext(1, "Error in ", "Error in ",
+ domain = "R"), res)
+ return(res)
+ }
+
+ restartError <- function (e, calls) {
+ ## Remove call (eval(expr, envir, enclos)) from the message
ncls <- length(calls)
- cat("n calls: ", ncls, "NframeOffset: ", NframeOffset, "\n")
-
-
- if(isTRUE(all.equal(calls[[NframeOffset]], e$call, check.attributes=FALSE)))
+ ##DEBUG: cat("n calls: ", ncls, "NframeOffset: ", NframeOffset, "\n")
+ if (isTRUE(all.equal(calls[[NframeOffset]], e$call,
+ check.attributes = FALSE)))
e$call <- NULL
Traceback <<- rev(calls[-c(seq.int(NframeOffset), (ncls - 1L):ncls)])
@@ -62,87 +105,96 @@
#Warning message:
#In log(-1) : NaNs produced
-
putMark(FALSE, 1)
- cat(.makeMessage(e))
- if(getWarnLev() == 0L && length(last.warning) > 0L)
- cat(gettext("In addition: ", domain="R"))
+ cat(formatMsg(e))
+ if (getWarnLev() == 0L && length(last.warning) > 0L)
+ cat(ngettext(1, "In addition: ", "In addition: ", domain = "R"))
}
res <- tryCatch(withRestarts(withCallingHandlers({
- # TODO: allow for multiple expressions and calls (like in
- # 'capture.output'). The problem here is how to tell 'expression'
- # from 'call' without evaluating it?
- #list(evalVis(expr))
+ ## TODO: allow for multiple expressions and calls (like in
+ ## 'capture.output'). The problem here is how to tell 'expression'
+ ## from 'call' without evaluating it?
+ ##list(evalVis(expr))
lapply(expr, evalVis)
},
- error = function(e) invokeRestart("grmbl", e, sys.calls()),
- warning = function(e) {
- # remove call (eval(expr, envir, enclos)) from the message
- if(isTRUE(all.equal(sys.call(NframeOffset), e$call, check.attributes=FALSE)))
+ error = function (e) invokeRestart("grmbl", e, sys.calls()),
+ warning = function (e) {
+ ## Remove call (eval(expr, envir, enclos)) from the message
+ if (isTRUE(all.equal(sys.call(NframeOffset), e$call,
+ check.attributes = FALSE)))
e$call <- NULL
- last.warning <<- c(last.warning, structure(list(e$call), names=e$message))
+ last.warning <<- c(last.warning, structure(list(e$call),
+ names = e$message))
- if(getWarnLev() != 0L) {
+ if (getWarnLev() != 0L) {
putMark(FALSE, 2)
- .Internal(.signalCondition(e, conditionMessage(e), conditionCall(e)))
+ .Internal(.signalCondition(e, conditionMessage(e),
+ conditionCall(e)))
.Internal(.dfltWarn(conditionMessage(e), conditionCall(e)))
putMark(TRUE, 3)
}
invokeRestart("muffleWarning")
-
}),
- # Restarts:
+ ## Restarts:
- # Handling user interrupts. Currently it works only from within R.
- #TODO: how to trigger interrupt via socket connection?
- abort = function(...) {
- putMark(FALSE, 4)
- cat("<aborted!>\n") #DEBUG
- },
+ ## Handling user interrupts. Currently it works only from within R.
+ ##TODO: how to trigger interrupt via socket connection?
+ abort = function (...) {
+ putMark(FALSE, 4)
+ cat("<aborted!>\n") #DEBUG
+ },
- #interrupt = function(...) cat("<interrupted!>\n"), #DEBUG: this does not seem to be ever called.
+ interrupt = function (...) cat("<interrupted!>\n"), #DEBUG: this does not seem to be ever called.
- muffleWarning = function() NULL,
- grmbl = restartError),
- error = function(e) { #XXX: this is called if warnLevel=2
- putMark(FALSE, 5)
- cat(.makeMessage(e))
- e #identity
- },
- finally = { }
+ muffleWarning = function () NULL,
+ grmbl = restartError),
+ error = function (e) { ##XXX: this is called if warnLevel == 2
+ putMark(FALSE, 5)
+ cat(formatMsg(e))
+ e #identity
+ },
+ finally = {}
)
- lapply(res, function(x) {
- if(inherits(x, "list") && x$visible) {
- print(x$value)
- } #else { cat('<invisible>\n') }
- })
-
- if(getWarnLev() == 0L) {
+ if (getWarnLev() == 0L) {
nwarn <- length(last.warning)
- assign("last.warning", last.warning, envir=baseenv())
+ assign("last.warning", last.warning, envir = baseenv())
- if(nwarn > 0L) putMark(FALSE, 6)
- if(nwarn <= 10L) {
+ if (nwarn > 0L) putMark(FALSE, 6)
+ if (nwarn <= 10L) {
print.warnings(last.warning)
} else if (nwarn < 50L) {
- cat(gettextf("There were %d warnings (use warnings() to see them)\n", nwarn, domain="R"))
+ ## This is buggy and does not retrieve a translation of the message!
+ #cat(gettextf("There were %d warnings (use warnings() to see them)\n",
+ # nwarn, domain = "R"))
+ msg <- ngettext(1,
+ "There were %d warnings (use warnings() to see them)\n",
+ "There were %d warnings (use warnings() to see them)\n",
+ domain = "R")
+ cat(sprintf(msg, nwarn))
} else {
- cat(gettext("There were 50 or more warnings (use warnings() to see the first 50)\n", domain="R"))
+ cat(ngettext(1,
+ "There were 50 or more warnings (use warnings() to see the first 50)\n",
+ "There were 50 or more warnings (use warnings() to see the first 50)\n",
+ domain = "R"))
}
}
putMark(TRUE, 7)
- sink(type = "message"); sink(type = "output")
+ sink(type = "message")
+ sink(type = "output")
close(tconn)
on.exit()
- # allow for tracebacks of this call stack:
+ ## Allow for tracebacks of this call stack:
assign(".Traceback", lapply(Traceback, deparse), envir = baseenv())
+ ## Make sure last line ends up with \n
+ l <- length(rval)
+ if (l) rval[l] <- paste(rval[l], "\n", sep = "")
return(rval)
}
Modified: pkg/svMisc/R/parseText.R
===================================================================
--- pkg/svMisc/R/parseText.R 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/R/parseText.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -5,37 +5,37 @@
return(parseText(text))
}
-`parseText` <- function (text) {
+`parseText` <- function (text, firstline = 1, srcfilename = NULL,
+encoding = "unknown") {
## Parse R instructions provided as a string and return the expression if it
## is correct, or a 'try-error' object if it is an incorrect code, or NA if
## the (last) instruction is incomplete
- res <- tryCatch(parse(text=text), error=identity)
+ text <- paste(text, collapse = "\n")
+ ## if firstline is higher than 1, "align" code by prepending empty codes
+ firstline <- as.integer(firstline)[1]
+ if (firstline > 1)
+ text <- paste(c(rep("", firstline - 1), text), collapse = "\n")
+ if (is.null(srcfilename)) srcfilename <- "<text>"
+ res <- tryCatch(parse(text = text, srcfile = srcfilecopy(srcfilename, text),
+ encoding = encoding), error = identity)
- if(inherits(res, "error")) {
- # Check if this is incomplete code
+ if (inherits(res, "error")) {
+ ## Check if this is incomplete code
msg <- conditionMessage(res)
- rxUEOI <- sprintf(gsub("%d", "\\\\d", gettext("%s%d:%d: %s", domain="R")),
- if(getOption("keep.source")) "<text>:" else "",
- gettextf("unexpected %s", gettext("end of input", domain="R"),
- domain="R"))
-
-
- if(regexpr(rxUEOI, res$message) == 1) return(NA)
-
+ if (regexpr(gettext("end of input", domain = "R"), msg) > 0)
+ return(NA)
- # This reformats the message as it would appear in the CLI:
- #mess <- conditionMessage(res)
- #errinfo <- strsplit(sub("(\\d+):(\\d+): +([^\n]+)[\\s\\S]*$", "\\1\n\\2\n\\3", mess, perl=T), "\n", fixed=TRUE)[[1]]
- #errpos <- as.numeric(errinfo[1:2])
- #errcode <- substr(strsplit(x, "(\r?\n|\r)")[[1]][errpos[1]], start = 0, stop = errpos[2])
- #res <- simpleError(sprintf("%s in \"%s\"", errinfo[3], errcode))
-
- e <- res <- simpleError(mess, NULL)
-
- # for legacy uses, make it a try-error
- res <- .makeMessage(res)
+ ## This should be incorrect R code
+ ## Rework the message a little bit... keep line:col position in front
+ err <- res
+ err$message <- res <- sub("^<.*>:", "", msg)
+ ## Call is from instructions in "text"... but from the corresponding line
+ err$call <- strsplit(text, "\n")[[1]][as.integer(
+ sub("^[^0-9]*([0-9]+):.*$", "\\1", res))]
+
+ ## Return a try-error object to remain compatible with previous versions
class(res) <- "try-error"
- attr(res, 'error') <- e
+ attr(res, 'error') <- err
}
return(res)
Modified: pkg/svMisc/inst/CITATION
===================================================================
--- pkg/svMisc/inst/CITATION 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/inst/CITATION 2011-06-13 20:21:58 UTC (rev 378)
@@ -8,7 +8,7 @@
year = version$year,
url = "http://www.sciviews.org/SciViews-R",
- textVersion =
+ textVersion =
paste("Grosjean, Ph. (", version$year, "). ",
"SciViews: A GUI API for R. ",
"UMONS, Mons, Belgium. ",
@@ -18,5 +18,5 @@
citFooter("We have invested a lot of time and effort in creating SciViews-R,",
"please cite it when using it together with R.",
- "See also", sQuote("citation()"),
- "for citing R.")
+ "See also", sQuote("citation()"),
+ "for citing R.")
Modified: pkg/svMisc/inst/unitTests/runitsvMisc.R
===================================================================
--- pkg/svMisc/inst/unitTests/runitsvMisc.R 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/inst/unitTests/runitsvMisc.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -8,14 +8,49 @@
.tearDown <- function () {}
testparseText <- function () {
- checkTrue(is.na(parseText("1 +")), msg = "parseText() returns NA when parsing incomplete command")
- ## TODO: the other tests...
+ ## Note: the srcfile mechanism with timestamp does not produce identical
+ ## objects on two successive calls of parse(). To get around this,
+ ## we only compare the expression transformed into a character string
+ ## Check that correct expressions are parsed
+ expr <- "1+1"; res <- as.character(parse(text = expr))
+ checkIdentical(res, as.character(parseText(expr)),
+ msg = "parseText() with a single instruction")
+ expr <- "1+1; ls()"; res <- as.character(parse(text = expr))
+ checkIdentical(res, as.character(parseText(expr)),
+ msg = "parseText() with two instructions on one line")
+ expr <- c("1+1", "ls()"); res <- as.character(parse(text = expr))
+ checkIdentical(res, as.character(parseText(expr)),
+ msg = "parseText() with two separate instructions")
+ ## Check that incomplete instructions produce NA in parseText()
+ expr <- "1 +"
+ checkTrue(is.na(parseText(expr)),
+ msg = "parseText() returns NA when parsing incomplete command")
+ ## Check that incorrect expression return a try-error object
+ ## with correct error message
+ expr <- "1+)"
+ checkTrue(inherits(parseText(expr), "try-error"),
+ msg = "parseText() returns a 'try-error' object with incorrect code")
+ ## This function retrieves the error message as it should appear
+ ## in parseText()
+ getErrorMsg <- function (text) {
+ res <- try(parse(text = text), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ res <- sub("^.*<text>:", "", as.character(res))
+ res <- sub("\n$", "", res)
+ return(res)
+ } else return("") # This is not supposed to happen!
+ }
+ ## TODO: for some reasons this does not work as expected...
+ #checkIdentical(getErrorMsg(expr), as.character(parseText(expr)),
+ # msg = "parseText() returns an error message with wrong code")
+
+ ## TODO: add other tests...
}
testcaptureAll <- function () {
## A couple of expressions and expected results from captureAll()
- expr1 <- parse(text = 1+1)
- res1 <- c("[1] 2", "") # Note: should we really always got that empty string at the end???
+ expr1 <- parse(text = "1+1")
+ res1 <- "[1] 2\n"
## General tests of captureAll()
## TODO...
@@ -33,14 +68,14 @@
## Test of 'split' argument
## TODO: we cannot check if split is correct, but at least, we can check it does not raise error
## Expected behaviour: split can be anything, but only split = TRUE do split the output
- checkIdentical(res1, captureAll(expr1, split = TRUE), msg = "captureAll(...., split = TRUE) test")
- checkIdentical(res1, captureAll(expr1, split = FALSE), msg = "captureAll(...., split = FALSE) test")
- checkIdentical(res1, captureAll(expr1, split = c(TRUE, FALSE)), msg = "captureAll(...., split = c(TRUE, FALSE)) test")
- checkIdentical(res1, captureAll(expr1, split = logical(0)), msg = "captureAll(...., split = logical(0)) test")
- checkIdentical(res1, captureAll(expr1, split = NULL), msg = "captureAll(...., split = NULL) test")
- checkIdentical(res1, captureAll(expr1, split = "TRUE"), msg = "captureAll(...., split = \"TRUE\") test")
- checkIdentical(res1, captureAll(expr1, split = 1), msg = "captureAll(...., split = 1) test")
- checkIdentical(res1, captureAll(expr1, split = NA), msg = "captureAll(...., split = NA) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = TRUE), msg = "captureAll(...., split = TRUE) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = FALSE), msg = "captureAll(...., split = FALSE) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = c(TRUE, FALSE)), msg = "captureAll(...., split = c(TRUE, FALSE)) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = logical(0)), msg = "captureAll(...., split = logical(0)) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = NULL), msg = "captureAll(...., split = NULL) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = "TRUE"), msg = "captureAll(...., split = \"TRUE\") test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = 1), msg = "captureAll(...., split = 1) test")
+ checkIdentical(res1, captureAll(expr1, echo = FALSE, split = NA), msg = "captureAll(...., split = NA) test")
## TODO:... other tests (warnings, errors, sink(), capture.output(), interactive commands -how?-, etc.)
}
Modified: pkg/svMisc/man/captureAll.Rd
===================================================================
--- pkg/svMisc/man/captureAll.Rd 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/man/captureAll.Rd 2011-06-13 20:21:58 UTC (rev 378)
@@ -13,7 +13,7 @@
}
\usage{
-captureAll(expr, split = FALSE, file = NULL)
+captureAll(expr, split = TRUE, echo = TRUE, file = NULL, markStdErr = FALSE)
}
\arguments{
@@ -21,10 +21,15 @@
accepted). }
\item{split}{ do we split output, that is, do we also issue it at the R console
too, or do we only capture it silently? }
+ \item{echo}{ do we echo each expression in front of the results (like in the
+ console)? In case the expression spans on more than 7 lines, only first and
+ last three lines are echoed, separated by [...]. }
\item{file}{ a file, or a valid opened connection where output is sinked. It
is closed at the end, and the function returns \code{NULL} in this case. If
\code{file = NULL} (by default), a textConnection() captures the output and
it is returned is a character string by the function. }
+ \item{markStdErr}{ if \code{TRUE}, stderr is separated from sddout by STX/ETX
+ character }
}
\value{
@@ -50,18 +55,18 @@
\code{\link{sourceClipboard}} }
\examples{
-writeLines(captureAll(expression(1+1)))
+writeLines(captureAll(expression(1+1), split = FALSE))
writeLines(captureAll(expression(1+1), split = TRUE))
-writeLines(captureAll(parseText("search()")))
+writeLines(captureAll(parseText("search()"), split = FALSE))
\dontrun{
-writeLines(captureAll(parseText('1:2 + 1:3')))
-writeLines(captureAll(parseText("badname")))
+writeLines(captureAll(parseText('1:2 + 1:3'), split = FALSE))
+writeLines(captureAll(parseText("badname"), split = FALSE))
}
## Management of incomplete lines
captRes <- captureAll(parseText("1 +")) # Clearly an incomplete command
-if (is.na(captRes)) cat("Incomplete line!\n") else writeLines(res)
+if (is.na(captRes)) cat("Incomplete line!\n") else writeLines(captRes)
rm(captRes)
}
Modified: pkg/svMisc/man/parseText.Rd
===================================================================
--- pkg/svMisc/man/parseText.Rd 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svMisc/man/parseText.Rd 2011-06-13 20:21:58 UTC (rev 378)
@@ -11,11 +11,16 @@
}
\usage{
-parseText(text)
+parseText(text, firstline = 1, srcfilename = NULL, encoding = "unknown")
}
\arguments{
\item{text}{ the character string vector to parse into an R expression. }
+ \item{firstline}{ the index of first line being parsed in the file. If this
+ is larger than \code{1}, empty lines are added in front of \code{text} in
+ order to match the correct position in the file. }
+ \item{srcfilename}{ a character string with the name of the source file. }
+ \item{encoding}{ encoding of \code{text}, as in \code{\link[base]{parse}}. }
}
\value{
@@ -33,11 +38,13 @@
\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
-\seealso{ \code{\link{captureAll}}, \code{\link{sourceClipboard}} }
+\seealso{ \code{\link{captureAll}}, \code{\link{sourceClipboard}},
+ \code{\link[base]{parse}} }
\examples{
parseText('1+1')
parseText('1+1; log(10)')
+parseText(c('1+1', 'log(10)'))
## Incomplete instruction
parseText('log(')
Modified: pkg/svSocket/DESCRIPTION
===================================================================
--- pkg/svSocket/DESCRIPTION 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svSocket/DESCRIPTION 2011-06-13 20:21:58 UTC (rev 378)
@@ -2,10 +2,10 @@
Type: Package
Title: SciViews GUI API - R Socket Server
Depends: R (>= 2.6.0)
-Imports: tcltk, svMisc (>= 0.9-60)
+Imports: tcltk, svMisc (>= 0.9-62)
Description: Implements a simple socket server allowing to connect GUI clients to R
-Version: 0.9-51
-Date: 2010-10-01
+Version: 0.9-52
+Date: 2011-06-13
Author: Philippe Grosjean & Matthew Dowle
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svSocket/NEWS
===================================================================
--- pkg/svSocket/NEWS 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svSocket/NEWS 2011-06-13 20:21:58 UTC (rev 378)
@@ -2,6 +2,13 @@
== Changes in svSocket 0.9-51
+* processSocket() now uses the new version of captureAll() from svMisc >= 0.9-62
+ with the split = and echo = arguments. Commands and results are now interwoven
+ like in a normal console output.
+
+
+== Changes in svSocket 0.9-51
+
* processSocket() no longer adds en empty line at the top of R commands (bug
corrected).
Modified: pkg/svSocket/R/processSocket.R
===================================================================
--- pkg/svSocket/R/processSocket.R 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svSocket/R/processSocket.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -86,8 +86,10 @@
}
if (!hiddenMode) {
if (Echo) {
+ ## Note: command lines are now echoed directly in captureAll()
+ ## => no need of this any more!
if (pars$code == "") Pre <- Prompt else Pre <- Continue
- cat(Pre, msg, "\n", sep = "")
+ #cat(Pre, msg, "\n", sep = "")
}
## Add previous content if we were in multiline mode
if (pars$code != "") msg <- paste(pars$code, msg, sep = "\n")
@@ -128,7 +130,7 @@
## Something like this should allow for real-time echo in client, but it is too slow
## and it outputs all results at the end...
#results <- captureAll(expr, split = Echo, file = socketClientConnection(socket))
- results <- captureAll(expr, split = Echo)
+ results <- captureAll(expr, echo = Echo, split = Echo)
## Should we run taskCallbacks?
if (!hiddenMode) {
h <- getTemp(".svTaskCallbackManager", default = NULL, mode = "list")
Modified: pkg/svSocket/TODO
===================================================================
--- pkg/svSocket/TODO 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svSocket/TODO 2011-06-13 20:21:58 UTC (rev 378)
@@ -13,8 +13,6 @@
* Delete SocketClient_xxxx on disconnection + make sure they are all deleted
on server stopping and on package detaching (in .Last.lib()).
-* Parse error => rework message a little bit + line number is 1 too much.
-
* sourcePart() function sourcing only from line X to line Y in a file!
* Send a command to the regular command line.
@@ -25,9 +23,6 @@
* A mode that flags various parts of output.
-* Parse and executes one command at a time in case several commands are send at
- once (should we? The current way of working has some interesting features!).
-
* Unattended messages should be printed above command line.
* Allow for remote connection + security?
@@ -49,15 +44,11 @@
# the address is the allowed list
}
-* Correct handling of the prompt when several lines of code are pasted at once!
-
-* Currently, code send through the socket server cannot be interrupted.
-
* Implement a way to interrupt from the remote console + correct <<<esc>>>.
* Manage buffered output with flush.console()!
-* Redirect stdin() so that scan(), etc. work (+ browser(), etc.).
+* Redirect stdin() so that scan(), etc.
* For multiline commands, do number them.
Modified: pkg/svUnit/NEWS
===================================================================
--- pkg/svUnit/NEWS 2011-05-13 21:22:17 UTC (rev 377)
+++ pkg/svUnit/NEWS 2011-06-13 20:21:58 UTC (rev 378)
@@ -1,15 +1,15 @@
= svUnit News
-
== svUnit 0.7-6
-* refer to last test environment through a local identifier. closes #1327
-* strip attributes from context fields when saving them temporarily.
+* Refer to last test environment through a local identifier. Closes #1327.
+* Strip attributes from context fields when saving them temporarily.
+
== svUnit 0.7-5
-* XML-encoding entities in protocol_junit.svTestData. closes #1147
+* XML-encoding entities in protocol_junit.svTestData. Closes #1147.
== svUnit 0.7-4
Modified: pkg/svUnit/inst/doc/svUnit.pdf
===================================================================
(Binary files differ)
Added: pkg/tcltk2/tcltk2 tk2icoReplacement.R
===================================================================
--- pkg/tcltk2/tcltk2 tk2icoReplacement.R (rev 0)
+++ pkg/tcltk2/tcltk2 tk2icoReplacement.R 2011-06-13 20:21:58 UTC (rev 378)
@@ -0,0 +1,20 @@
+## Replacement for tk2ico in tcltk2 package
+## to avoid all the nightmare of compiling C Tcl package code!
+## I need to drop the taskbar feature and just keep the
+## possibility to change Tk windows icons
+
+
+## Here is how one defines the default icon out of one exe (under Windows)
+tkwm.iconbitmap(tt, default = file.path(R.home("bin"), "Rgui.exe"))
+
+## Here is how one define an icon for a given Tk window
+tkwm.iconbitmap(tt, file.path(R.home("bin"), "Rgui.exe"))
+
+## One can also use an .ico file under Windows
+tkwm.iconbitmap(tt2, system.file("gui", "SciViews.ico", package = "tcltk2"))
+
+## Under Linux, it is a xbm file and filename must start with '@'
+## TODO...
+
+## Here is how to use a loaded bitmap ressource
+## TODO...
\ No newline at end of file
More information about the Sciviews-commits
mailing list