[Sciviews-commits] r445 - in komodo/SciViews-K-dev: . R components content content/js content/js/tools content/pkgman pylib
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 26 15:46:31 CET 2012
Author: prezez
Date: 2012-02-26 15:46:30 +0100 (Sun, 26 Feb 2012)
New Revision: 445
Added:
komodo/SciViews-K-dev/R/_startup.R
komodo/SciViews-K-dev/content/keybindings-mac.kkf
komodo/SciViews-K-dev/content/keybindings.kkf
komodo/SciViews-K-dev/sciviewsk-1.1.5dev-ko.xpi
Removed:
komodo/SciViews-K-dev/content/default-keybindings.kkf
komodo/SciViews-K-dev/content/js/ask.js
komodo/SciViews-K-dev/content/js/interpolate.js
komodo/SciViews-K-dev/content/js/rinterpolationquery.js
komodo/SciViews-K-dev/content/js/rjson.js
Modified:
komodo/SciViews-K-dev/R/.Rprofile
komodo/SciViews-K-dev/R/captureAll.R
komodo/SciViews-K-dev/R/completion.R
komodo/SciViews-K-dev/R/objList.R
komodo/SciViews-K-dev/R/objSearch.R
komodo/SciViews-K-dev/R/pkgman.R
komodo/SciViews-K-dev/R/quickParse.R
komodo/SciViews-K-dev/R/rserver.R
komodo/SciViews-K-dev/components/koRLinter.py
komodo/SciViews-K-dev/components/koR_UDL_Language.py
komodo/SciViews-K-dev/components/svUtils.py
komodo/SciViews-K-dev/content/RHelpWindow.xul
komodo/SciViews-K-dev/content/js/commands.js
komodo/SciViews-K-dev/content/js/pref-R.js
komodo/SciViews-K-dev/content/js/r.js
komodo/SciViews-K-dev/content/js/rconnection.js
komodo/SciViews-K-dev/content/js/rconsole.js
komodo/SciViews-K-dev/content/js/robjects.js
komodo/SciViews-K-dev/content/js/sciviews.js
komodo/SciViews-K-dev/content/js/tools/array.js
komodo/SciViews-K-dev/content/js/tools/file.js
komodo/SciViews-K-dev/content/js/tools/strings.js
komodo/SciViews-K-dev/content/overlayMain-ko6.xul
komodo/SciViews-K-dev/content/overlayMain.xul
komodo/SciViews-K-dev/content/pkgman/pkgman.xul
komodo/SciViews-K-dev/content/pref-R.xul
komodo/SciViews-K-dev/content/sessions.xul
komodo/SciViews-K-dev/install.rdf
komodo/SciViews-K-dev/pylib/lang_r.py
komodo/SciViews-K-dev/pylib/langinfo_r.py
Log:
_setKeybindings: rewritten to use ko.keybinding.manager
R function names prefixed with sv_ to avoid conflicts, functions are compiled at first use (if library compiler is available)
svUtils.execInR - returns ascii(21)+error message on error (including timeout)
sv.rconn.evalAtOnce - throws now an exception on connection error. All calls have been wrapped in 'try'.
sv.tools.* renamed to sv.* (one less reference to resolve - better performance)
sv.command.startR: removed option to run in console.
cleaned up unused functions
Modified: komodo/SciViews-K-dev/R/.Rprofile
===================================================================
--- komodo/SciViews-K-dev/R/.Rprofile 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/.Rprofile 2012-02-26 14:46:30 UTC (rev 445)
@@ -1,156 +1 @@
-options(json.method="R")
-
-if(existsFunction("stopAllConnections")) stopAllConnections()
-if(existsFunction("stopAllServers")) stopAllServers()
-
-
-if("komodoConnection" %in% search()) detach("komodoConnection")
-attach(new.env(), name = "komodoConnection")
-
-with(as.environment("komodoConnection"), {
-
- #`svOption` <- function (arg.name, default = NA, as.type = as.character, ...) {
- # args <- gsub("\\b-\\b", ".", commandArgs(trailingOnly=TRUE))
- #
- # pfx <- paste("^--", arg.name, "=", sep = "")
- # x <- args[grep(pfx, args)]
- #
- # x <- if (!length(x)) default else sub(pfx, "", x)
- # x <- as.type(x, ...)
- # x <- structure(list(x), names = arg.name)
- # do.call("options", x)
- # return(x)
- #}
-
- `svPager` <- function (files, header, title, delete.file) {
- files <- gsub("\\", "\\\\", files[1], fixed = TRUE)
- tryCatch(koCmd(sprintf('sv.r.pager("%1$s", "%2$s", %3$s)',
- files, title, if (delete.file) 'true' else 'false')),
- error=function(e) browseURL(files, NULL))
- }
-
- `svBrowser` <- function(url) {
- url <- gsub("\\", "\\\\", url, fixed = TRUE)
- ## If the URL starts with '/', assume a file path
- ## on Unix or Mac and prepend 'file://'
- url <- sub("^/", "file:///", url)
- tryCatch(koCmd(sprintf("sv.command.openHelp(\"%s\")", url)),
- warning=function(e) browseURL(url, NULL)
- )
- }
-
- local({
- require(utils)
- `readline` <- function (prompt = "")
- paste(koCmd(sprintf("ko.dialogs.prompt('%s', '', '', 'R asked a question', 'R-readline')", prompt),
- timeout=0), collapse = " ")
- unlockBinding("readline", env = baseenv())
- bindingIsLocked("readline", env = baseenv())
- assign("readline", value=readline, envir = baseenv())
- utils::assignInNamespace("readline", value=readline, ns = "base")
- lockBinding("readline", env = baseenv())
- })
-
- options(browser = svBrowser, pager = svPager)
-
- # a way round to get the url:
- #getHelpURL(help("anova")) <- old syntax
- #getHelpURL("anova") <- new syntax
- `getHelpURL` <- function(..., help_type = "html") {
- if(tools:::httpdPort == 0) suppressMessages(tools:::startDynamicHelp(TRUE))
- help_type <- "html"
- ret <- NULL
- oBrowser <- options(browser = function(url) ret <<- url)
- on.exit(options(oBrowser))
- if(mode((cl <- match.call())[[2L]][[1L]]) == "name") { # handle old syntax
- cl <- cl[[2]]
- cl$help_type <- help_type
- print(eval(cl, .GlobalEnv))
- } else {
- print(utils::help(..., help_type = help_type))
- }
- ret
- }
-
- require(utils)
- #require(stats)
-
- env <- as.environment("komodoConnection")
- src <- dir(pattern = "\\.R$")
- src <- src[src != "init.R"]
- Rdata <- "startup.RData"
-
- if(file.exists(Rdata) && {
- mtime <- file.info(c(Rdata, src))[, "mtime"]
- all(mtime[-1] <= mtime[1])
- }) {
- cat('komodoConnection loaded from "startup.RData" \n')
- load(Rdata, envir = env)
- rm(mtime)
- #sys.source("rserver.R", envir = env)
- } else{
- lapply(src, sys.source, envir = env, keep.source = FALSE)
- suppressWarnings(save(list = ls(env), file = Rdata, envir = env))
- cat('komodoConnection loaded from source files \n')
- }
- init.Rserver()
- rm(env, Rdata, src)
- invisible()
-})
-
-
-`.Last` <- function() {
- tryCatch({
- koCmd("sv.addNotification(\"R says bye!\"); sv.command.updateRStatus(false);")
- stopAllServers()
- stopAllConnections()
- }, error = function(...) NULL)
-}
-
-
-local({
- port <- 1111L
- while((port < 1125L) && (as.character(startServer(port)) == "0"))
- port <- port + 1L
-
- cwd0 <- normalizePath(".")
- if(file.exists("init.R")) source("init.R")
-
- Rservers <- enumServers()
- if(is.numeric(getOption("ko.port")) && length(Rservers) > 0L) {
- cat("Server started at port", Rservers, "\n")
- invisible(koCmd(paste(
- "sv.cmdout.clear()",
- sprintf("sv.cmdout.append('%s is started')", R.version.string),
- "sv.command.updateRStatus(true)",
- sprintf("sv.pref.setPref('sciviews.r.port', %s)", tail(Rservers, 1L)),
- sep = ";")))
- }
-
- cat("cwd is now ", sQuote(getwd()), "\n")
-
- ## Do we have a .Rprofile file to source?
- #rprofile <- file.path(c(getwd(), Sys.getenv("R_USER")), ".Rprofile")
- cwd <- normalizePath(getwd())
- isBaseDir <- file.exists(file.path(cwd, "sv-basedir")) || (cwd == cwd0)
- rprofile <- file.path(c(if(!isBaseDir) getwd(), Sys.getenv("R_USER")), ".Rprofile")
- rprofile <- rprofile[file.exists(rprofile)][1L]
-
- if (!is.na(rprofile)) {
- source(rprofile)
- cat("Loaded file:", rprofile, "\n")
- }
-
- if(.Platform$GUI == "Rgui") {
- if(file.exists("Rconsole")) utils:::loadRconsole("Rconsole")
- utils::setWindowTitle("talking to Komodo")
- }
-
- if(!any(c("--vanilla", "--no-restore", "--no-restore-data") %in% commandArgs())
- && file.exists(".RData")) {
- #sys.load.image(".RData", FALSE)
- }
- if(file.exists(".Rhistory")) loadhistory(".Rhistory")
-
-
-})
+source("_startup.R")
Added: komodo/SciViews-K-dev/R/_startup.R
===================================================================
--- komodo/SciViews-K-dev/R/_startup.R (rev 0)
+++ komodo/SciViews-K-dev/R/_startup.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -0,0 +1,160 @@
+options(json.method="R")
+
+if(existsFunction("stopAllConnections")) stopAllConnections()
+if(existsFunction("stopAllServers")) stopAllServers()
+
+if("komodoConnection" %in% search()) detach("komodoConnection")
+attach(new.env(), name = "komodoConnection")
+
+with(as.environment("komodoConnection"), {
+
+ `svPager` <- function (files, header, title, delete.file) {
+ files <- gsub("\\", "\\\\", files[1L], fixed = TRUE)
+ tryCatch(koCmd(sprintf('sv.r.pager("%1$s", "%2$s", %3$s)',
+ files, title, if (delete.file) 'true' else 'false')),
+ error=function(e) browseURL(files, NULL))
+ }
+
+ `svBrowser` <- function(url) {
+ url <- gsub("\\", "\\\\", url, fixed = TRUE)
+ ## If the URL starts with '/', assume a file path
+ ## on Unix or Mac and prepend 'file://'
+ url <- sub("^/", "file:///", url)
+ tryCatch(koCmd(sprintf("sv.command.openHelp(\"%s\")", url)),
+ warning=function(e) browseURL(url, NULL)
+ )
+ }
+
+ local({
+ require(utils)
+ `readline` <- function (prompt = "")
+ paste(koCmd(sprintf("ko.dialogs.prompt('%s', '', '', 'R asked a question', 'R-readline')", prompt),
+ timeout=0), collapse = " ")
+ unlockBinding("readline", env = baseenv())
+ bindingIsLocked("readline", env = baseenv())
+ assign("readline", value=readline, envir = baseenv())
+ utils::assignInNamespace("readline", value=readline, ns = "base")
+ lockBinding("readline", env = baseenv())
+ })
+
+ options(browser = svBrowser, pager = svPager)
+
+ # a way round to get the url:
+ #getHelpURL(help("anova")) <- old syntax
+ #getHelpURL("anova") <- new syntax
+ `getHelpURL` <- function(..., help_type = "html") {
+ if(tools:::httpdPort == 0L) suppressMessages(tools:::startDynamicHelp(TRUE))
+ help_type <- "html"
+ ret <- NULL
+ oBrowser <- options(browser = function(url) ret <<- url)
+ on.exit(options(oBrowser))
+ if(mode((cl <- match.call())[[2L]][[1L]]) == "name") { # handle old syntax
+ cl <- cl[[2L]]
+ cl$help_type <- help_type
+ print(eval(cl, .GlobalEnv))
+ } else {
+ print(utils::help(..., help_type = help_type))
+ }
+ ret
+ }
+
+ require(utils)
+
+ env <- as.environment("komodoConnection")
+ #setwd("~/Dokumenty/Projects/SciViews/komodo/SciViews-K-dev\\R")
+
+ src <- dir(pattern = "^[^_].*\\.R$")
+ Rdata <- "startup.RData"
+
+ #lapply(src, function(x) {
+ # compiler::cmpfile(x, paste(x, "comp", sep = ""))
+ #}
+ #)
+
+ if(file.exists(Rdata) && {
+ mtime <- file.info(c(Rdata, src))[, "mtime"]
+ all(mtime[-1L] <= mtime[1L])
+ }) {
+ #cat('komodoConnection restored from "startup.RData" \n')
+ load(Rdata, envir = env)
+ rm(mtime)
+ #sys.source("rserver.R", envir = env)
+ } else{
+ lapply(src, sys.source, envir = env, keep.source = FALSE)
+ if(length(.find.package("compiler", quiet = TRUE))) {
+ for(fun in ls(env)) if(exists(fun, env, mode = "function"))
+ assign(fun, compiler::cmpfun(get(fun, env),
+ options = list(suppressAll = TRUE)))
+ }
+ suppressWarnings(save(list = ls(env), file = Rdata, envir = env))
+ cat("'komodoConnection' loaded from source files \n")
+
+ }
+ init.Rserver()
+ rm(env, Rdata, src)
+ invisible()
+})
+
+local({
+ port <- 1111L
+ while((port < 1150L) && (as.character(sv_startServer(port)) == "0"))
+ port <- port + 1L
+
+ cwd0 <- normalizePath(".")
+ if(file.exists("_init.R")) source("_init.R")
+
+ cat("cwd is now ", sQuote(getwd()), "\n")
+
+ ## Do we have a .Rprofile file to source?
+ #rprofile <- file.path(c(getwd(), Sys.getenv("R_USER")), ".Rprofile")
+ cwd <- normalizePath(getwd())
+ isBaseDir <- file.exists(file.path(cwd, "sv-basedir")) || (cwd == cwd0)
+ rprofile <- file.path(c(if(!isBaseDir) getwd(), Sys.getenv("R_USER")), ".Rprofile")
+ rprofile <- rprofile[file.exists(rprofile)][1L]
+
+ if (!is.na(rprofile)) {
+ source(rprofile)
+ cat("Loaded file:", rprofile, "\n")
+ }
+
+ if(.Platform$GUI == "Rgui") {
+ if(file.exists("Rconsole")) utils:::loadRconsole("Rconsole")
+ utils::setWindowTitle("talking to Komodo")
+ }
+
+ #if(!any(c("--vanilla", "--no-restore", "--no-restore-data") %in% commandArgs())
+ #&& file.exists(".RData")) {
+ #sys.load.image(".RData", FALSE)
+ #}
+ if(file.exists(".Rhistory")) loadhistory(".Rhistory")
+
+ Rservers <- enumServers()
+ if(is.numeric(getOption("ko.port")) && length(Rservers) > 0L) {
+ cat("Server started at port", Rservers, "\n")
+ invisible(koCmd(paste(
+ "sv.cmdout.clear()",
+ sprintf("sv.cmdout.append('%s is started')", R.version.string),
+ "sv.command.updateRStatus(true)",
+ # "sv.rbrowser.smartRefresh(true)", # not before workspace is loaded
+ sprintf("sv.pref.setPref('sciviews.r.port', %s)", tail(Rservers, 1L)),
+ sep = ";")))
+ }
+
+ assign(".First", function() {
+ invisible(koCmd("sv.rbrowser.smartRefresh(true)"))
+ #cat("Komodo is refreshed \n")
+ rm(list = ".First", envir = .GlobalEnv) # self-destruct
+ }, .GlobalEnv)
+
+
+ assign(".Last", function() {
+ tryCatch({
+ koCmd("sv.addNotification(\"R says bye!\"); sv.command.updateRStatus(false);")
+ stopAllServers()
+ stopAllConnections()
+ }, error = function(...) NULL)
+ }, .GlobalEnv)
+
+
+
+})
Modified: komodo/SciViews-K-dev/R/captureAll.R
===================================================================
--- komodo/SciViews-K-dev/R/captureAll.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/captureAll.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -62,7 +62,7 @@
# inspired by 'capture.output' and utils:::.try_silent
# Requires: R >= 2.13.0 [??]
-`captureAll` <- function(expr, split = FALSE, file = NULL, markStdErr=FALSE,
+`sv_captureAll` <- function(expr, split = FALSE, file = NULL, markStdErr=FALSE,
envir = .GlobalEnv) {
# TODO: support for 'file' and 'split'
@@ -257,4 +257,4 @@
`captureAllQ` <- function(expr, ...)
- captureAll(as.expression(substitute(expr)), ...)
+ sv_captureAll(as.expression(substitute(expr)), ...)
Modified: komodo/SciViews-K-dev/R/completion.R
===================================================================
--- komodo/SciViews-K-dev/R/completion.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/completion.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -22,7 +22,7 @@
getS3method <- utils::getS3method
findGeneric <- utils:::findGeneric
-`completeArgs` <- function(FUNC.NAME, ..., field.sep = "\x1e") {
+`sv_completeArgs` <- function(FUNC.NAME, ..., field.sep = "\x1e") {
rx <- regexpr("^([\\w\\.]+):{2,3}(`|)([\\w\\.\\[\\%]+)\\2$", FUNC.NAME, perl = TRUE)
if (rx == 1L) {
cs <- attr(rx,"capture.start")
@@ -85,7 +85,7 @@
}
# provide special completions
-`completeSpecial` <- function(what, x = NULL, field.sep = "\x1e") {
+`sv_completeSpecial` <- function(what, x = NULL, field.sep = "\x1e") {
res <- switch(what, search = {
type <- "namespace"
res <- search()
@@ -97,7 +97,7 @@
unique(unlist(lapply(.libPaths(), dir), use.names = FALSE))
}, par = {
type <- "argument"
- res <- completion("par(", sep = NULL)[]
+ res <- sv_completion("par(", sep = NULL)[]
paste(substr(res, 1, nchar(res) - 1), "=")
#names(par())
}, options = {
@@ -115,7 +115,7 @@
# From svMisc::completion (simplified)
-`completion` <- function (code, field.sep = "\x1e", sep = "\n",
+`sv_completion` <- function (code, field.sep = "\x1e", sep = "\n",
pos = nchar(code), min.length = 2L,
addition = FALSE, max.fun = 100L,
skip.used.args = FALSE) {
@@ -207,7 +207,6 @@
#funargs <- ComplEnv$funargs
#isFirstArg <- ComplEnv$isFirstArg
- ret <- data.frame(completion = completions, stringsAsFactors = FALSE)
tl <- integer(length(completions))
tl[grep(" = $", completions)] <- 4L
tl[grep("::$", completions)] <- 3L
Modified: komodo/SciViews-K-dev/R/objList.R
===================================================================
--- komodo/SciViews-K-dev/R/objList.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/objList.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -1,4 +1,4 @@
-objList <- function (id = "default", envir = .GlobalEnv, object = NULL,
+sv_objList <- function (id = "default", envir = .GlobalEnv, object = NULL,
all.names = FALSE, pattern = "", group = "", all.info = FALSE, sep = "\t",
path = NULL, compare = TRUE, ...)
{
Modified: komodo/SciViews-K-dev/R/objSearch.R
===================================================================
--- komodo/SciViews-K-dev/R/objSearch.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/objSearch.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -1,4 +1,4 @@
-objSearch <- function(sep = "\t", path = NULL, compare = TRUE)
+sv_objSearch <- function(sep = "\t", path = NULL, compare = TRUE)
{
Search <- search()
if (isTRUE(compare)) {
Modified: komodo/SciViews-K-dev/R/pkgman.R
===================================================================
--- komodo/SciViews-K-dev/R/pkgman.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/pkgman.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -8,7 +8,7 @@
getCRANmirrors <- utils::getCRANmirrors
write.table <- utils::write.table
-pkgManGetDescription <- function(pkg, print=TRUE) {
+sv_pkgManGetDescription <- function(pkg, print=TRUE) {
if (pkg %in% rownames(installed.packages())) {
desc <- packageDescription(pkg)
} else {
@@ -33,7 +33,7 @@
}
}
-pkgManGetMirrors <- function() {
+sv_pkgManGetMirrors <- function() {
tmpVar <- "pkgMan.CRANmirrors"
if(existsTemp(tmpVar)) {
mirrors <- getTemp(tmpVar)
@@ -46,7 +46,7 @@
}
-pkgManGetAvailable <- function(page = "next", pattern = "", ilen=50,
+sv_pkgManGetAvailable <- function(page = "next", pattern = "", ilen=50,
col=c("Package", "Version", "InstalledVersion", "Status"),
reload=FALSE, sep=';', eol="\t\n") {
if (!existsTemp('avpkg.list') || reload) {
@@ -113,7 +113,7 @@
avpkg
}
-pkgManGetInstalled <- function(sep=';', eol="\t\n") {
+sv_pkgManGetInstalled <- function(sep=';', eol="\t\n") {
inspkg <- installed.packages(fields="Description")
inspkg <- inspkg[order(toupper(inspkg[, "Package"])),
c("Package","Version","Description")]
@@ -123,18 +123,18 @@
write.table(inspkg, row.names = FALSE, col.names = F, sep=sep, quote = F, eol=eol, na='')
}
-pkgManSetCRANMirror <- function(url) {
+sv_pkgManSetCRANMirror <- function(url) {
repos <- getOption("repos")
repos['CRAN'] <- url
options(repos = repos)
}
-pkgManInstallPackages <- function(upkgs, installDeps=FALSE, ask=TRUE) {
+sv_pkgManInstallPackages <- function(upkgs, installDeps=FALSE, ask=TRUE) {
dep <- suppressMessages(utils:::getDependencies(upkgs, available = getTemp('avpkg.list')))
msg <- status <- ""
if (!ask && (installDeps || all(dep %in% upkgs))) {
- msg <- captureAll(install.packages(dep))
+ msg <- sv_captureAll(install.packages(dep))
status <- "done"
} else {
l <- length(dep)
@@ -149,7 +149,7 @@
#invisible(dep)
}
-pkgManRemovePackage <- function(pkgName) {
+sv_pkgManRemovePackage <- function(pkgName) {
sapply(pkgName, function(pkgName) {
if(pkgName %in% loadedNamespaces()) unloadNamespace(pkgName)
pack <- paste("package", pkgName, sep=":")
@@ -172,11 +172,11 @@
}, simplify=FALSE)
}
-pkgManLoadPackage <- function(pkgName) {
+sv_pkgManLoadPackage <- function(pkgName) {
sapply(pkgName, library, character.only = TRUE, logical.return = TRUE, simplify = FALSE)
}
-pkgManDetachPackage <- function(pkgName) {
+sv_pkgManDetachPackage <- function(pkgName) {
sapply(pkgName, function(pkgName) {
tryCatch({
if(pkgName %in% loadedNamespaces()) unloadNamespace(pkgName)
Modified: komodo/SciViews-K-dev/R/quickParse.R
===================================================================
--- komodo/SciViews-K-dev/R/quickParse.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/quickParse.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -1,4 +1,4 @@
-`quickParse` <- function(filename, encoding = "UTF-8") {
+`sv_quickParse` <- function(filename, encoding = "UTF-8") {
if(file.exists(filename)) {
on.exit(close(fconn))
fconn <- file(filename, open = "r", encoding = encoding)
Modified: komodo/SciViews-K-dev/R/rserver.R
===================================================================
--- komodo/SciViews-K-dev/R/rserver.R 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/R/rserver.R 2012-02-26 14:46:30 UTC (rev 445)
@@ -2,7 +2,7 @@
# Simple communication between R and a client through a socket connection
# (c) 2011 Kamil Barton
#
-# Files: 'rserver.R' 'rserver.tcl' 'captureAll.R' (or package svMisc)
+# Files: 'rserver.R' 'rserver.tcl' 'sv_captureAll.R' (or package svMisc)
# Result is evaluated in R and sent back in JSON format
# Client should format the data in a following way:
# - escape newline, carriage returns, formfeeds and backslashes with a backslash
@@ -142,9 +142,9 @@
ret <- c('\x03', c(expr), '\x02')
msg <- 'Parse error'
} else {
- ret <- captureAll(expr, markStdErr = TRUE)
+ ret <- sv_captureAll(expr, markStdErr = TRUE)
#browser()
- #ret <- eval(call("captureAll", expr, markStdErr=TRUE), envir=.GlobalEnv)
+ #ret <- eval(call("sv_captureAll", expr, markStdErr=TRUE), envir=.GlobalEnv)
msg <- 'Done'
# TODO: later
#lapply(unlist(strsplit(c(prevcode, x), "(\r?\n|\r)")), function(entry)
@@ -188,7 +188,7 @@
}
#-------------------------------------------------------------------------------
-`startServer` <-
+`sv_startServer` <-
function(port) tcl("Rserver::Start", port)
`listServers` <-
@@ -277,15 +277,15 @@
x
}
-# tcl-based JSON - not working properly so far.
-tcJSON <- function(x, msg = "Done") {
- .Tcl("set result {}")
- tcl(if(length(x) == 1) "lappend" else "set", "result", x)
- .Tcl("set retval [dict create]")
- .Tcl("dict set retval result $result")
- tcl("dict", "set", "retval", "message", msg)
- .Tcl("set retval [compile_json {dict result list message string} $retval]")
-}
+## tcl-based JSON - not working properly so far.
+#tcJSON <- function(x, msg = "Done") {
+# .Tcl("set result {}")
+# tcl(if(length(x) == 1) "lappend" else "set", "result", x)
+# .Tcl("set retval [dict create]")
+# .Tcl("dict set retval result $result")
+# tcl("dict", "set", "retval", "message", msg)
+# .Tcl("set retval [compile_json {dict result list message string} $retval]")
+#}
init.Rserver <- function() {
if(!file.exists("rserver.tcl")) stop("Cannot find file 'rserver.tcl'")
@@ -293,8 +293,8 @@
tcl('source', "compile_json.tcl")
tclfun(TclReval, "Rserver::Reval", retval = "retval")
tclfun(TclRprint, 'Rserver::Rprint')
- tclfun(tcJSON, "TestJSON", retval = "retval")
- cat("tcl functions defined")
+ #tclfun(tcJSON, "TestJSON", retval = "retval")
+ cat("R server (tcl) functions defined \n")
}
@@ -303,7 +303,7 @@
#.init.Rserver()
#===============================================================================
-#startServer(11111)
+#sv_startServer(11111)
#listConnections()
#listServers()
#stopAllServers()
Modified: komodo/SciViews-K-dev/components/koRLinter.py
===================================================================
--- komodo/SciViews-K-dev/components/koRLinter.py 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/components/koRLinter.py 2012-02-26 14:46:30 UTC (rev 445)
@@ -66,7 +66,7 @@
getService(components.interfaces.svIUtils)
pass
- # 'lint' first evaluates in R 'quickParse(filename)' which returns R-style
+ # 'lint' first evaluates in R 'sv_quickParse(filename)' which returns R-style
# formatted error or empty string. Then it retrieves from the error message
# the position within text and description
def lint(self, request):
@@ -80,14 +80,14 @@
fout = open(tmp_filename, 'wb')
fout.write(text)
fout.close()
- command = 'cat(quickParse(\"' + tmp_filename.replace('\\', '/') + '", encoding = "UTF-8"))'
+ command = 'cat(sv_quickParse(\"' + tmp_filename.replace('\\', '/') + '", encoding = "UTF-8"))'
#log.debug(command)
except Exception, e:
log.exception(e)
try:
lines = self.sv_utils.execInR(command, "json h", 1.5).rstrip() \
.replace('\x03', '').replace('\x02', '')
- if lines == 'timed out':
+ if lines.startswith('\x15'): # connection error
raise ServerException(nsError.NS_ERROR_NOT_AVAILABLE)
log.debug('lint: ' + lines)
Modified: komodo/SciViews-K-dev/components/koR_UDL_Language.py
===================================================================
--- komodo/SciViews-K-dev/components/koR_UDL_Language.py 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/components/koR_UDL_Language.py 2012-02-26 14:46:30 UTC (rev 445)
@@ -65,12 +65,13 @@
"line": [ "#", ],
}
- #downloadURL = "http://cran.r-project.org"
+ downloadURL = "http://cran.r-project.org"
#searchURL = "http://www.rseek.org/"
variableIndicators = '$'
_dedenting_statements = [u'return', u'break', u'else', u'next']
- _indenting_statements = [u'switch', u'if', u'ifelse', u'while', u'for', u'repeat', u'break']
+ _indenting_statements = [u'switch', u'if', u'ifelse', u'while', u'for',
+ u'repeat', u'break', u'local']
supportsSmartIndent = "brace"
#styleStdin = components.interfaces.ISciMoz.SCE_C_STDIN
@@ -92,168 +93,3 @@
return self._get_linter_from_lang("R")
def get_interpreter(self):
None
-
-
- #if 1:
- # # The new autocomplete/calltip functionality based on the codeintel
- # # system.
- # def get_codeintelcompleter(self):
- # if self._codeintelcompleter is None:
- # self._codeintelcompleter =\
- # components.classes["@sciviews.org/koRCodeIntelCompletionLanguageService;1"]\
- # .getService(components.interfaces.koICodeIntelCompletionLanguageService)
- # self._codeintelcompleter.initialize(self)
- # # Ensure the service gets finalized when Komodo shutsdown.
- # finalizeSvc = components.classes["@activestate.com/koFinalizeService;1"]\
- # .getService(components.interfaces.koIFinalizeService)
- # finalizeSvc.registerFinalizer(self._codeintelcompleter)
- # return self._codeintelcompleter
- #else:
- # def get_completer(self):
- # if self._completer is None:
- # self._completer = components.classes["@sciviews.org/koRCompletionLanguageService;1"] \
- # .getService(components.interfaces.koICompletionLanguageService)
- # return self._completer
-
- #def get_lexer(self):
- # return None
- # if self._lexer is None:
- # self._lexer = KoLexerLanguageService()
- # self._lexer.setLexer(components.interfaces.ISciMoz.SCLEX_CPP)
- # self._lexer.setKeywords(0, lang_r.keywords)
- # self._lexer.setKeywords(1, lang_r.builtins)
- # self._lexer.supportsFolding = 1
- # return self._lexer
-
-
-# import re
-# from koLanguageServiceBase import *
-
-# iface = components.interfaces.koICodeIntelCompletionUIHandler
-
-# #log = logging.getLogger("koRCompletion")
-# class KoRCompletion(KoCompletionLanguageService):
- # _com_interfaces_ = [components.interfaces.koICompletionLanguageService]
- # _reg_desc_ = "R Calltip/AutoCompletion Service"
- # _reg_clsid_ = "{DF19E793-ECC2-6571-7CC1-D7F02D1C94C7}"
- # _reg_contractid_ = "@sciviews.org/koRCompletionLanguageService;1"
-
- # #useCharSet = "_: " + string.ascii_uppercase + string.ascii_lowercase + string.digits
-
- # def __init__(self):
- # self._ok = 1
- # self.triggersCallTip = '('
- # self.triggers = ''
- # self.completionSeparator = ord('\n')
- # self._scintilla = None
- # self._lastlComplete = []
- # self._lastcompletion = None
- # self.sv_utils = components.classes["@sciviews.org/svUtils;1"].\
- # getService(components.interfaces.svIUtils)
- # log.debug("KoRCompletion __init__")
-
-
- # def _get_code_frag(self, scimoz):
- # # Get sensible code fragment
- # cur_pos = scimoz.currentPos
- # cur_line = scimoz.lineFromPosition(cur_pos)
- # pos_start = scimoz.positionFromLine(scimoz.getFoldParent(cur_line))
- # pos_end = max(scimoz.anchor, cur_pos)
- # text = scimoz.getTextRange(pos_start, pos_end)
- # return text
-
-
- # def _getCompletions(self, text):
- # if not text.strip(): return 0, None
- # cmd = 'completion("%s", print=TRUE, types="scintilla", field.sep="?")' \
- # % text.replace('"', '\\"')
- # compl_str = self.sv_utils.execInR(cmd, "h")
-
- # if ((compl_str == '') or (re.search("^\d+[\r\n]", compl_str) == None)):
- # return 0, None
-
- # compl_str = re.split("[\r\n]+", compl_str.replace('\r\n', chr(self.completionSeparator)), 1)
- # trig_len = int(compl_str[0])
- # compl_str = compl_str[1]
- # return trig_len, compl_str
-
- # def _getTip(self, text):
- # cmd = 'cat(callTip("%s", location=TRUE, description=TRUE, methods=TRUE, width=80))' \
- # % text.replace('"', '\\"')
- # result = self.sv_utils.execInR(cmd, "h").strip()
- # #if not result: return None
- # result = result.replace('[\r\n]+', '\n')
- # return result
-
- # def _DoTipComplete(self):
- # s = self._scintilla
- # #s.autoCCancelAtStart = 0
- # text = self._get_code_frag(s)
- # if len(text) < 3:
- # if s.autoCActive(): s.autoCCancel()
- # return
- # tip_str = self._getTip(text)
- # if tip_str:
- # self._scintilla.callTipShow(s.currentPos, tip_str)
- # elif s.autoCActive():
- # s.autoCCancel()
-
- # def AutoComplete(self, ch, scimoz):
- # log.debug("KoRCompletion AutoComplete")
- # if not self._ok: return
- # s = self._scintilla = scimoz
- # text = self._get_code_frag(s)
- # trig_len, completions =self._getCompletions(text)
- # if not completions: return
-
- # if s.callTipActive():
- # s.callTipCancel()
- # scimoz.autoCShow(trig_len, completions)
-
- # def StartCallTip(self, ch, scimoz):
- # log.debug("KoRCompletion StartCallTip")
- # if not self._ok: return
- # s = self._scintilla = scimoz
-
- # #s.SCE_UDL_SSL_COMMENT, s.SCE_UDL_SSL_STRING, SCE_UDL_SSL_DEFAULT
-
- # # Only do this if we have no selection
- # if s.selectionStart == s.selectionEnd and s.selectionStart > 0:
- # curPos = s.positionBefore(s.currentPos)
- # style = s.getStyleAt(curPos)
- # if style == s.SCE_UDL_SSL_COMMENT: return
- # if style == s.SCE_UDL_SSL_STRING: return
-
- # if s.callTipActive(): return
- # else:
- # self._DoTipComplete()
- # return
-
- # if s.autoCActive(): s.autoCCancel()
-
-
-# class KoRCodeIntelCompletionLanguageService(KoCodeIntelCompletionLanguageService):
- # _com_interfaces_ = [components.interfaces.koICodeIntelCompletionLanguageService]
- # _reg_desc_ = "R CodeIntel Calltip/AutoCompletion Service"
- # _reg_clsid_ = "{E9C1237A-D3F4-2AE2-EF66-02D3C30D3678}"
- # _reg_contractid_ = "@sciviews.org/koRCodeIntelCompletionLanguageService;1"
-
- # # Characters that should automatically invoke the current completion item
- # # - cannot be '-' for "autocomplete-*-subs" because:
- # # attributes::->import(__PACKAGE__, \$x, 'Bent');
- # # - cannot be '{' for "autocomplete-object-subs" because:
- # # my $d = $self->{'escape'};
- # # - shouldn't be ')' because:
- # # $dumper->dumpValue(\*::);
- # completionFillups = "@$([]"
-
- # def __init__(self):
- # KoCodeIntelCompletionLanguageService.__init__(self)
- # log.debug("KoRCICompletion... __init__")
-
- # def triggerPrecedingCompletionUI(self, path, scimoz, startPos,
- # ciCompletionUtriggerPrecedingCompletionUI):
- # log.debug("KoRCICompletion... triggerPrecedingCompletionUI")
- # KoCodeIntelCompletionLanguageService(self, path, scimoz, startPos,
- # ciCompletionUtriggerPrecedingCompletionUI)
- # pass
Modified: komodo/SciViews-K-dev/components/svUtils.py
===================================================================
--- komodo/SciViews-K-dev/components/svUtils.py 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/components/svUtils.py 2012-02-26 14:46:30 UTC (rev 445)
@@ -46,7 +46,8 @@
import logging
log = logging.getLogger('svUtils')
#log.setLevel(logging.INFO)
-log.setLevel(logging.DEBUG)
+# log.setLevel(logging.DEBUG)
+log.setLevel(logging.WARNING)
def _makeStyledText(text, styles = {chr(2): chr(0), chr(3): chr(23)},
@@ -170,7 +171,11 @@
s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
s.settimeout(timeout)
try: s.connect(self.socketOut)
- except Exception, e: return unicode(e.args[0])
+ except IOError, e:
+ # Windows has : timeout('timed out',)
+ # Linux has: error(111, '... rejected')
+ # e.message or e.strerror
+ return unicode('\x15' + (e.message or e.strerror))
cmdInfo = self._CommandInfo(uid, pretty_command, mode, 'Not ready')
@@ -194,7 +199,7 @@
re.sub("(\r?\n|\r)", '<<<n>>>', command)
#command.replace(os.linesep, '<<<n>>>')
s.send(command + os.linesep)
- ## SOLVED: command must end with newline
+ ## command must end with newline
## TODO: replace all newlines by R
s.shutdown(socket.SHUT_WR)
result = u''
@@ -217,18 +222,19 @@
if useJSON:
# Fix bad JSON: R escapes nonprintable characters as octal numbers
# (\OOO), but json needs unicode notation (\uHHHH).
- result = re.sub('(?<=\\\\)[0-9]{3}', lambda x: ("u%04x" % int(x.group(0), 8)), result)
+ result = re.sub('(?<=\\\\)[0-9]{3}', lambda x: \
+ ("u%04x" % int(x.group(0), 8)), result)
try:
resultObj = json.loads(result)
if(isinstance(resultObj, dict)):
- if (resultObj.has_key('message')): message = resultObj['message']
- if (resultObj.has_key('result')):
- if isinstance(resultObj['result'], list):
- result = os.linesep.join(resultObj['result'])
- else: # isinstance(x, unicode)
- result = resultObj['result']
- #log.debug(type(result)) # <-- should be: <type 'unicode'>
- #log.debug(result)
+ message = resultObj.get('message')
+ result = resultObj.get('result')
+ if isinstance(result, list):
+ result = os.linesep.join(result)
+ #else: # isinstance(x, unicode)
+ # result = resultObj.get('result')
+ #log.debug(type(result)) # <-- should be: <type 'unicode'>
+ #log.debug(result)
cmdInfo.message = unicode(message)
cmdInfo.result = unicode(result)
@@ -409,7 +415,7 @@
text = self._get_code_frag(scimoz)
if not text.strip(): return
- cmd = 'completion("%s", print=TRUE, types="scintilla", field.sep="?")' \
+ cmd = 'sv_completion("%s", print=TRUE, types="scintilla", field.sep="?")' \
% text.replace('"', '\\"')
autoCstring = self.execInR(cmd, "h") \
.replace('\x03', '').replace('\x02', '')
Modified: komodo/SciViews-K-dev/content/RHelpWindow.xul
===================================================================
--- komodo/SciViews-K-dev/content/RHelpWindow.xul 2012-02-25 11:56:52 UTC (rev 444)
+++ komodo/SciViews-K-dev/content/RHelpWindow.xul 2012-02-26 14:46:30 UTC (rev 445)
@@ -213,7 +213,7 @@
}
function rHelpBrowserContextOnShow(event) {
- var selText = sv.tools.string.trim(window._content.getSelection().toString());
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 445
More information about the Sciviews-commits
mailing list