[Sciviews-commits] r113 - komodo komodo/SciViews-K komodo/SciViews-K/templates pkg/svGUI/R pkg/svIDE/R pkg/svMisc/R pkg/svSocket/R pkg/svSocket/testCLI pkg/svTools pkg/svTools/inst pkg/svUnit pkg/svUnit/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Feb 20 11:18:03 CET 2009
Author: phgrosjean
Date: 2009-02-20 11:18:03 +0100 (Fri, 20 Feb 2009)
New Revision: 113
Added:
pkg/svTools/COPYING
pkg/svTools/NEWS
pkg/svTools/TODO
pkg/svTools/inst/
pkg/svTools/inst/CITATION
pkg/svUnit/COPYING
Removed:
komodo/SciViews-K/sciviewsk-0.6.5-ko.xpi
komodo/SciViews-K/templates/svGUI_0.9-43.tar.gz
komodo/SciViews-K/templates/svGUI_0.9-43.tgz
komodo/SciViews-K/templates/svGUI_0.9-43.zip
komodo/SciViews-K/templates/svMisc_0.9-45.tar.gz
komodo/SciViews-K/templates/svMisc_0.9-45.tgz
komodo/SciViews-K/templates/svMisc_0.9-45.zip
komodo/SciViews-K/templates/svSocket_0.9-42.tar.gz
komodo/SciViews-K/templates/svSocket_0.9-42.tgz
komodo/SciViews-K/templates/svSocket_0.9-42.zip
pkg/svSocket/testCLI/testCLI.r
pkg/svSocket/testCLI/testCLIcmd.r
Modified:
komodo/.DS_Store
komodo/SciViews-K/.DS_Store
pkg/svGUI/R/guiInstall.R
pkg/svGUI/R/guiUninstall.R
pkg/svGUI/R/koCmd.R
pkg/svGUI/R/svGUI-internal.R
pkg/svIDE/R/Source.R
pkg/svIDE/R/Startup.R
pkg/svIDE/R/TinnR.R
pkg/svIDE/R/createCallTipFile.R
pkg/svIDE/R/createSyntaxFile.R
pkg/svIDE/R/getFunctions.R
pkg/svIDE/R/getKeywords.R
pkg/svIDE/R/guiDDEInstall.R
pkg/svMisc/R/Args.R
pkg/svMisc/R/CallTip.R
pkg/svMisc/R/Complete.R
pkg/svMisc/R/CompletePlus.R
pkg/svMisc/R/Parse.R
pkg/svMisc/R/Sys.tempdir.R
pkg/svMisc/R/Sys.userdir.R
pkg/svMisc/R/TempEnv.R
pkg/svMisc/R/addItems.R
pkg/svMisc/R/addTemp.R
pkg/svMisc/R/assignTemp.R
pkg/svMisc/R/captureAll.R
pkg/svMisc/R/changeTemp.R
pkg/svMisc/R/clipsource.R
pkg/svMisc/R/compareRVersion.R
pkg/svMisc/R/def.R
pkg/svMisc/R/descFun.R
pkg/svMisc/R/existsTemp.R
pkg/svMisc/R/getEnvironment.R
pkg/svMisc/R/getTemp.R
pkg/svMisc/R/guiCmd.R
pkg/svMisc/R/helpSearchWeb.R
pkg/svMisc/R/isAqua.R
pkg/svMisc/R/isHelp.R
pkg/svMisc/R/isMac.R
pkg/svMisc/R/isRgui.R
pkg/svMisc/R/isSDI.R
pkg/svMisc/R/isWin.R
pkg/svMisc/R/listMethods.R
pkg/svMisc/R/listTypes.R
pkg/svMisc/R/objBrowse.R
pkg/svMisc/R/objClear.R
pkg/svMisc/R/objDir.R
pkg/svMisc/R/objInfo.R
pkg/svMisc/R/objList.R
pkg/svMisc/R/objMenu.R
pkg/svMisc/R/objSearch.R
pkg/svMisc/R/progress.R
pkg/svMisc/R/r.R
pkg/svMisc/R/rmTemp.R
pkg/svMisc/R/svMisc-internal.R
pkg/svMisc/R/tempvar.R
pkg/svSocket/R/closeSocketClients.R
pkg/svSocket/R/getSocket.R
pkg/svSocket/R/parSocket.R
pkg/svSocket/R/processSocket.R
pkg/svSocket/R/sendSocketClients.R
pkg/svSocket/R/startSocketServer.R
pkg/svSocket/R/stopSocketServer.R
pkg/svSocket/R/svSocket-Internal.R
pkg/svTools/DESCRIPTION
pkg/svUnit/R/Log.R
pkg/svUnit/R/check.R
pkg/svUnit/R/guiTestReport.R
pkg/svUnit/R/koUnit.R
pkg/svUnit/R/svSuite.R
pkg/svUnit/R/svSuiteData.R
pkg/svUnit/R/svTest.R
pkg/svUnit/R/svTestData.R
pkg/svUnit/R/svUnit-internal.R
Log:
Housekeeping, mainly of R packages
Modified: komodo/.DS_Store
===================================================================
(Binary files differ)
Modified: komodo/SciViews-K/.DS_Store
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/sciviewsk-0.6.5-ko.xpi
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svGUI_0.9-43.tar.gz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svGUI_0.9-43.tgz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svGUI_0.9-43.zip
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svMisc_0.9-45.tar.gz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svMisc_0.9-45.tgz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svMisc_0.9-45.zip
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svSocket_0.9-42.tar.gz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svSocket_0.9-42.tgz
===================================================================
(Binary files differ)
Deleted: komodo/SciViews-K/templates/svSocket_0.9-42.zip
===================================================================
(Binary files differ)
Modified: pkg/svGUI/R/guiInstall.R
===================================================================
--- pkg/svGUI/R/guiInstall.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svGUI/R/guiInstall.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"guiInstall" <-
-function() {
+function ()
+{
assignTemp(".guiCmd", function(command, ...) {
command <- switch(command, ## TODO: define these commands
load = "",
Modified: pkg/svGUI/R/guiUninstall.R
===================================================================
--- pkg/svGUI/R/guiUninstall.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svGUI/R/guiUninstall.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"guiUninstall" <-
-function() {
+function ()
+{
# Eliminate .guiCmd
rmTemp(".guiCmd")
rmTemp(".guiObjBrowse")
@@ -7,7 +8,7 @@
rmTemp(".guiObjMenu")
rmTemp(".koCmd")
-
+
# Unregister the TaskCallback
# Use getTaskCallbackNames() to know if some tasks are registered
Callback.Id <- getTemp(".guiObjCallbackId", default = NULL)
Modified: pkg/svGUI/R/koCmd.R
===================================================================
--- pkg/svGUI/R/koCmd.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svGUI/R/koCmd.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,6 +1,7 @@
"koCmd" <-
-function(cmd, data = NULL, async = FALSE, host = getOption("ko.host"),
-port = getOption("ko.port")) {
+function (cmd, data = NULL, async = FALSE, host = getOption("ko.host"),
+ port = getOption("ko.port"))
+{
if (is.null(host)) host <- "localhost" # Default value
if (is.null(port)) port <- 7052 # Idem
cmd <- gsub("\n", "\\\\n", cmd)
Modified: pkg/svGUI/R/svGUI-internal.R
===================================================================
--- pkg/svGUI/R/svGUI-internal.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svGUI/R/svGUI-internal.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
".onLoad" <-
-function(lib, pkg) {
+function (lib, pkg)
+{
serve <- getOption("ko.serve")
if (!is.null(serve)) {
startSocketServer(port = as.integer(serve)[1])
@@ -8,7 +9,8 @@
}
".onUnload" <-
-function(libpath) {
+function (libpath)
+{
serve <- getOption("ko.serve")
if (!is.null(serve) && "package:svSocket" %in% search())
stopSocketServer(port = as.integer(serve)[1])
Modified: pkg/svIDE/R/Source.R
===================================================================
--- pkg/svIDE/R/Source.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/Source.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,12 +1,13 @@
"Source" <-
-function(file, out.form = getOption("R.output.format"), local = FALSE,
+function (file, out.form = getOption("R.output.format"), local = FALSE,
echo = FALSE, print.eval = TRUE, verbose = getOption("verbose"),
prompt.echo = getOption("prompt"), max.deparse.length = 150,
- chdir = FALSE, prompt = FALSE) {
+ chdir = FALSE, prompt = FALSE)
+{
# This is a reworked version of .Rsource from RpadUtils (Tom Short)
# but this version uses source() itself
-
+
if (is.null(out.form)) out.form <- "text"
# capture.all() is inspired from capture.output(), but it captures
# both the output and the message streams and it evaluates in .GlobalEnv
@@ -20,18 +21,18 @@
sink(type = "message")
close(file)
})
-
+
for (i in seq(length = length(args))) {
expr <- args[[i]]
- if (mode(expr) == "expression")
+ if (mode(expr) == "expression")
tmp <- lapply(expr, withVisible) #tmp <- lapply(expr, evalVis)
- else if (mode(expr) == "call")
+ else if (mode(expr) == "call")
tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
- else if (mode(expr) == "name")
+ else if (mode(expr) == "name")
tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
else stop("bad argument")
for (item in tmp) {
- if (item$visible)
+ if (item$visible)
print(item$value)
}
}
@@ -42,7 +43,7 @@
cat("====\n")
return(file)
}
-
+
# We capture output from source() with default args slightly modified
### TODO: get rid of source() and use something like:
# (try(parse(textConnection("ls()")), silent = TRUE))
Modified: pkg/svIDE/R/Startup.R
===================================================================
--- pkg/svIDE/R/Startup.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/Startup.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,13 +1,12 @@
-# last modified 2008/05/15 by Ph. Grosjean
-
".onLoad" <-
-function(lib, pkg) {
+function (lib, pkg)
+{
# Starting the DDE server automatically if under Windows
- # and option use.DDE == TRUE
+ # and option use.DDE == TRUE
use.DDE <- getOption("use.DDE")
if (.Platform$OS.type == "windows" && !is.null(use.DDE) && use.DDE)
guiDDEInstall()
-
+
# If an IDE is defined, start it now
IDE <- getOption("IDE")
if (!is.null(IDE) && file.exists(IDE))
@@ -19,5 +18,3 @@
if (.Platform$OS.type != "windows")
"writeClipboard" <- function (str, format = 1)
stop("Not implemented yet on other platforms than Windows")
-
-
Modified: pkg/svIDE/R/TinnR.R
===================================================================
--- pkg/svIDE/R/TinnR.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/TinnR.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -4,7 +4,8 @@
# and objList() in the svMisc package
"trObjSearch" <-
-function(path = NULL) {
+function (path = NULL)
+{
res <- objSearch(sep = "\n", compare = FALSE)
if (is.null(path)) {
return(data.frame(search.. = strsplit(res, "\n")[[1]]))
@@ -14,8 +15,9 @@
}
"trObjList" <-
-function(id = "default", envir = ".GlobalEnv", all.names = TRUE,
-pattern = "", group = "", path = NULL) {
+function (id = "default", envir = ".GlobalEnv", all.names = TRUE,
+ pattern = "", group = "", path = NULL)
+{
# Get data
res <- objList(id = id, envir = envir, all.names = all.names,
pattern = pattern, compare = FALSE)
Modified: pkg/svIDE/R/createCallTipFile.R
===================================================================
--- pkg/svIDE/R/createCallTipFile.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/createCallTipFile.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,6 +1,7 @@
"createCallTipFile" <-
-function(file = "Rcalltips.txt", pos = 2:length(search()), field.sep = "=",
- only.args = FALSE, return.location = FALSE) {
+function (file = "Rcalltips.txt", pos = 2:length(search()), field.sep = "=",
+ only.args = FALSE, return.location = FALSE)
+{
# Create a .txt file containing calltips for R functions.
cat("", file = file) # Create the beginning of the file
Modified: pkg/svIDE/R/createSyntaxFile.R
===================================================================
--- pkg/svIDE/R/createSyntaxFile.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/createSyntaxFile.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,9 +1,10 @@
"createSyntaxFile" <-
-function(svlfile = "R.svl", pos = 2:length(search())) {
+function (svlfile = "R.svl", pos = 2:length(search()))
+{
# Create an .svl syntax file for R.
# Note: use only main keywords for keywords2, because it is limited
# to a little bit less than 32k (2.000 to 2.500 keywords)
-
+
# Create the beginning of the file
cat(";This is a config file internally used by SciViews.\n",
file = svlfile)
@@ -19,14 +20,14 @@
file = svlfile, append = TRUE)
cat(";This file is automatically generated from R using createSyntaxFile()\n\n",
file = svlfile, append = TRUE)
-
+
cat("[General]\n", file = svlfile, append = TRUE)
cat("Description=Syntax definition for R\n",
file = svlfile, append = TRUE)
cat(paste("Version=", R.version$major, ".", R.version$minor, "\n",
sep = ""), file = svlfile, append = TRUE)
cat("FileExtensions=*.R\n\n", file = svlfile, append = TRUE)
-
+
cat("[Syntax]\n", file = svlfile, append = TRUE)
cat("CaseSensitive=1\n", file = svlfile, append = TRUE)
cat("SingleLineComment=#\n", file = svlfile, append = TRUE)
@@ -38,7 +39,7 @@
#cat("StringDelimiters=\",',`\n", file = svlfile, append = TRUE)
cat("StringDelimiters=\",'\n", file = svlfile, append = TRUE)
cat("EscapeChar=\\\n\n", file = svlfile, append = TRUE)
-
+
cat("[Options]\n", file = svlfile, append = TRUE)
cat("FixupKeywordCase=0\n", file = svlfile, append = TRUE)
cat("AutoIndent=1\n", file = svlfile, append = TRUE)
@@ -47,15 +48,15 @@
cat("ColumnSel=0\n", file = svlfile, append = TRUE)
cat("HSplitter=0\n", file = svlfile, append = TRUE)
cat("VSplitter=1\n\n", file = svlfile, append = TRUE)
-
+
cat("[Operators]\n", file = svlfile, append = TRUE)
cat("-\n!\n!=\n%\n%%\n%*%\n%/%\n%in%\n%o%\n%x%\n&\n&&\n*\n,\n/\n:\n::\n:::\n?\n^\n|\n||\n~\n+\n<\n<-\n<<-\n<=\n=\n==\n>\n->\n>=\n->>\n\n",
file = svlfile, append = TRUE)
-
+
cat("[Keywords1]\n", file = svlfile, append = TRUE)
cat("...\n..1\n..2\n..3\n..4\n..5\n..6\n..7\n..8\n..9\nbreak\nelse\nFALSE\nfor\nfunction\nif\nin\nInf\nNA\nNaN\nnext\nNULL\nrepeat\nTRUE\nwhile\n\n",
file = svlfile, append = TRUE)
-
+
cat("[Keywords2]\n", file = svlfile, append = TRUE)
write.table(getKeywords(pos = pos), file = svlfile, append = TRUE, quote = FALSE,
row.names = FALSE, col.names = FALSE)
Modified: pkg/svIDE/R/getFunctions.R
===================================================================
--- pkg/svIDE/R/getFunctions.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/getFunctions.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"getFunctions" <-
-function(pos) {
+function (pos)
+{
# Get a list of all R functions in a certain position
return(as.character(lsf.str(pos = pos, all.names = TRUE)))
}
Modified: pkg/svIDE/R/getKeywords.R
===================================================================
--- pkg/svIDE/R/getKeywords.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/getKeywords.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"getKeywords" <-
-function(pos = 2:length(search())){
+function (pos = 2:length(search()))
+{
# Get a sorted list of unique function names for libraries loaded
# in positions provided by pos
res <- NULL
Modified: pkg/svIDE/R/guiDDEInstall.R
===================================================================
--- pkg/svIDE/R/guiDDEInstall.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svIDE/R/guiDDEInstall.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"guiCallTip" <-
-function(code, file = NULL, onlyargs = FALSE, width = 60, location = FALSE) {
+function (code, file = NULL, onlyargs = FALSE, width = 60, location = FALSE)
+{
# This is an interface to CallTip for external programs
# Clear ::SciViewsR_CallTip
.Tcl("set ::SciViewsR_CallTip {}")
@@ -36,7 +37,8 @@
}
"guiComplete" <-
-function(code, file = NULL, givetype = FALSE, sep = "|") {
+function (code, file = NULL, givetype = FALSE, sep = "|")
+{
# This is an interfacte to Complete for external programs
# Clear ::SciViewsR_Complete
.Tcl("set ::SciViewsR_Complete {}")
@@ -68,7 +70,8 @@
}
"guiDDEInstall" <-
-function() {
+function ()
+{
# Register a dde server for R and install callbacks for serveur functions
# Make sure tcl/tk dde is operational
Modified: pkg/svMisc/R/Args.R
===================================================================
--- pkg/svMisc/R/Args.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/Args.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"Args" <-
-function(name, only.args = FALSE){
+function (name, only.args = FALSE
+{
#### TODO: handle primitives and S3/S4 methods for generic functions
ret <- try(res <- eval(parse(text = paste("argsAnywhere(", name, ")",
sep = ""))), silent = TRUE)
Modified: pkg/svMisc/R/CallTip.R
===================================================================
--- pkg/svMisc/R/CallTip.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/CallTip.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"CallTip" <-
-function(code, only.args = FALSE, location = FALSE) {
+function (code, only.args = FALSE, location = FALSE)
+{
# Get a call tip, given a part of the code
# Extract the last variable name, given it is either at the end,
# or terminated by '('
Modified: pkg/svMisc/R/Complete.R
===================================================================
--- pkg/svMisc/R/Complete.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/Complete.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"Complete" <-
-function(code, givetype = FALSE, sep = "\t") {
+function (code, givetype = FALSE, sep = "\t")
+{
### TODO: implement 'givetype'!
# Get a completion list, given a part of the code
Modified: pkg/svMisc/R/CompletePlus.R
===================================================================
--- pkg/svMisc/R/CompletePlus.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/CompletePlus.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,7 +1,10 @@
-CompletePlus <-
+"CompletePlus" <-
function (linebuffer, cursorPosition = nchar(linebuffer), minlength = 2,
-simplify = FALSE, types = c("arguments", "functions", "packages")) {
- ### call the rcompgen API to get completions
+ simplify = FALSE, types = c("arguments", "functions", "packages"))
+{
+ # PhG: find.multiple() renamed .find.multiple() and moved to svMisc-internal
+
+ # call the rcompgen API to get completions
if (nchar(linebuffer, type = "chars") < minlength) return(invisible(NULL))
utils:::.assignLinebuffer(linebuffer)
utils:::.assignEnd(cursorPosition)
@@ -11,7 +14,7 @@
comps <- utils:::.retrieveCompletions()
if (!length(comps)) return(invisible(NULL))
- ### restrict the completion for which information is gathered (speed things up)
+ # restrict the completion for which information is gathered (speed things up)
if (!"arguments" %in% types)
comps <- comps[regexpr("=$", comps) < 0]
if (!length(comps))
@@ -27,72 +30,73 @@
if (!length(comps))
return(invisible(NULL))
- ### build the output structure
+ # build the output structure
out <- matrix("", nrow = length(comps), ncol = 3)
out[, 1] <- comps
- ### deal with packages (completions ending with ::)
+ # deal with packages (completions ending with ::)
if (length(test.pack <- grep("::", comps)))
out[test.pack, 3] <- sapply(sub("::", "", comps[test.pack]),
packageDescription, fields = "Description")
- ### deal with argument completions (ending with =)
+ # deal with argument completions (ending with =)
if (length(test.arg <- grep("=", comps))) {
- arg <- sub("=$", "", comps[test.arg])
- fguess <- utils:::.CompletionEnv[["fguess"]]
- pack <- sub( "^package:", "", find(fguess)[1])
- if(pack == ".GlobalEnv") {
- out[test.arg, 3] <- ""
- } else{
- out[test.arg, 2] <- fguess
- out[test.arg, 3] <- descArgs(fguess, arg, pack)
- }
+ arg <- sub("=$", "", comps[test.arg])
+ fguess <- utils:::.CompletionEnv[["fguess"]]
+ pack <- sub( "^package:", "", find(fguess)[1])
+ if (pack == ".GlobalEnv") {
+ out[test.arg, 3] <- ""
+ } else {
+ out[test.arg, 2] <- fguess
+ out[test.arg, 3] <- descArgs(fguess, arg, pack)
+ }
}
- ### deal with completions with "$"
+ # deal with completions with "$"
if (length(test.dollar <- grep("\\$", comps))) {
- elements <- comps[ test.dollar ]
- object <- gsub( "\\$.*$" , "" , comps )[1]
- after <- gsub( "^.*\\$" , "" , comps )
- pack <- find.multiple( object )
- out[ test.dollar, 2 ] <- pack
- out[ test.dollar, 3 ] <- descData( object, after, package = pack )
+ elements <- comps[test.dollar]
+ object <- gsub("\\$.*$", "", comps)[1]
+ after <- gsub("^.*\\$", "", comps)
+ pack <- .find.multiple(object)
+ out[test.dollar, 2] <- pack
+ out[test.dollar, 3] <- descData(object, after, package = pack)
}
- ### deal with completions with "@"
- if( length(test.slot <- grep("@", comps)) ){
- elements <- comps[ test.dollar ]
- object <- gsub( "@.*$" , "" , comps )[1]
- slots <- gsub( "^.*@" , "" , comps )
- pack <- find.multiple( object )
- out[ test.dollar, 2 ] <- pack
- out[ test.dollar, 3 ] <- descSlots( object, slots, package = pack )
+ # deal with completions with "@"
+ if (length(test.slot <- grep("@", comps))) {
+ elements <- comps[test.dollar]
+ object <- gsub("@.*$", "", comps)[1]
+ slots <- gsub("^.*@", "", comps)
+ pack <- .find.multiple(object)
+ out[test.dollar, 2] <- pack
+ out[test.dollar, 3] <- descSlots(object, slots, package = pack)
}
- ### deal with completions with "["
- if( length(test.square <- grep("\\[", comps)) ){
- elements <- comps[ test.square ]
- out[ test.square, 2 ] <- ""
- out[ test.square, 3 ] <- descSquare( elements, package = pack )
+ # deal with completions with "["
+ if (length(test.square <- grep("\\[", comps))) {
+ elements <- comps[test.square]
+ out[test.square, 2] <- ""
+ out[test.square, 3] <- descSquare(elements, package = pack)
}
### TODO: do not know what to do with these
test.others <- grep(" ", comps)
- # TODO: are there other kind of completions I miss here
+ ### TODO: are there other kind of completions I miss here
- ### deal with function completions
- test.fun <- setdiff(1:length(comps), c(test.arg, test.pack, test.others, test.dollar, test.slot, test.square))
+ # deal with function completions
+ test.fun <- setdiff(1:length(comps), c(test.arg, test.pack, test.others,
+ test.dollar, test.slot, test.square))
if (length(test.fun)) {
- funs <- comps[test.fun]
- packs <- find.multiple( funs )
+ funs <- comps[test.fun]
+ packs <- .find.multiple(funs)
desc.fun <- rep("", length(packs))
- for (pack in unique(packs)) {
- if (! pack %in% c("", ".GlobalEnv" ) ) {
- desc.fun[packs == pack] <- descFun(funs[packs == pack], pack)
- }
+ for (pack in unique(packs)) {
+ if (!pack %in% c("", ".GlobalEnv")) {
+ desc.fun[packs == pack] <- descFun(funs[packs == pack], pack)
}
- out[test.fun, 2] <- packs
- out[test.fun, 3] <- desc.fun
+ }
+ out[test.fun, 2] <- packs
+ out[test.fun, 3] <- desc.fun
}
out[, 3] <- gsub("\t", " ", out[, 3])
@@ -101,25 +105,9 @@
# Make sure that arguments are witten 'arg = ', and not 'arg='
out[, 1] <- sub("=$", " = ", out[, 1])
- if (simplify) {
+ if (simplify) {
cat(apply(out, 1, paste, collapse = "\t"), sep = "\n")
- } else {
+ } else {
return(out)
- }
+ }
}
-
-### similar to "find" but `what` can be a vector
-### also, this one only searches in packages (position of the search path matching '^package:')
-### and only gives one result per what
-find.multiple <- function (what) {
- stopifnot(is.character(what))
- sp <- grep( "^package:", search(), value = T )
- out <- rep( "" , length(what) )
- for (i in sp) {
- ok <- what %in% ls(i, all.names = TRUE) & out == ""
- out[ok] <- i
- if(all(out!="")) break
- }
- names(out) <- what
- sub( "^package:", "", out )
-}
Modified: pkg/svMisc/R/Parse.R
===================================================================
--- pkg/svMisc/R/Parse.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/Parse.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"Parse" <-
-function (text) {
+function (text)
+{
# Parse R instructions provided as a string and return the expression if it
# is correct, or try-error if it is an incorrect code, or NA if the (last)
# instruction is incomplete
@@ -7,7 +8,7 @@
msgcon <- textConnection(text)
expr <- try(parse(msgcon), silent = TRUE)
close(msgcon)
-
+
# Determine if this code is correctly parsed
if (inherits(expr, "try-error")) {
# Determine if it is incorrect code, or incomplete line!
@@ -21,7 +22,7 @@
if (regexpr("\\n\")$", dp) > 0 &&
regexpr("\n[\"'][ \t\r\n\v\f]*($|#.*$)", text) < 0)
return(NA)
-
+
# Is it an incomplete variable name (like `name)?
if (regexpr("\n`)$", dp) > 0 &&
regexpr("\n`[ \t\r\n\v\f]*($|#.*$)", text) < 0)
Modified: pkg/svMisc/R/Sys.tempdir.R
===================================================================
--- pkg/svMisc/R/Sys.tempdir.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/Sys.tempdir.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"Sys.tempdir" <-
-function() {
+function ()
+{
# On the contrary to tempdir(), this function returns the temporary
# directory used by the system. It is assumed to be
# the parent directory of tempdir()
Modified: pkg/svMisc/R/Sys.userdir.R
===================================================================
--- pkg/svMisc/R/Sys.userdir.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/Sys.userdir.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"Sys.userdir" <-
-function() {
+function ()
+{
if (isWin()) {
# Return the user directory ("My Documents" under Windows)
udir <- Sys.getenv("R_User")
Modified: pkg/svMisc/R/TempEnv.R
===================================================================
--- pkg/svMisc/R/TempEnv.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/TempEnv.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"TempEnv" <-
-function() {
+function ()
+{
pos <- match("TempEnv", search())
if (is.na(pos)) { # Must create it
TempEnv <- list()
Modified: pkg/svMisc/R/addItems.R
===================================================================
--- pkg/svMisc/R/addItems.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/addItems.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"addItems" <-
-function(x, y, use.names = TRUE, replace = TRUE) {
+function (x, y, use.names = TRUE, replace = TRUE)
+{
if (replace) res <- c(y, x) else res <- c(x, y)
if (use.names) {
res <- res[!duplicated(names(res))]
@@ -10,15 +11,16 @@
}
"addActions" <-
-function(obj = ".svActions", text = NULL, code = NULL, state = NULL,
- options = NULL, replace = TRUE) {
+function (obj = ".svActions", text = NULL, code = NULL, state = NULL,
+ options = NULL, replace = TRUE)
+{
dat <- getTemp(obj, default = list())
if (!inherits(dat, "list"))
stop("'obj' should inherit from 'list'")
-
+
# Make sure we return an svActions object
class(dat) <- unique(c("svActions", class(dat)))
-
+
# Add new actions characteristics to dat; make sure newdata are correct
"addData" <- function(x, newdata, replace) {
newnames <- names(newdata)
@@ -33,26 +35,27 @@
if (!is.null(code)) dat$code <- addData(dat$code, code, replace)
if (!is.null(state)) dat$state <- addData(dat$state, state, replace)
if (!is.null(options)) dat$options <- addData(dat$options, options, replace)
-
+
# Reassign the modified values
assignTemp(obj, dat)
return(invisible(dat))
}
"addIcons" <-
-function(obj = ".svIcons", icons, replace = TRUE) {
+function (obj = ".svIcons", icons, replace = TRUE)
+{
# get the list of icons
icn <- getTemp(obj, default = character())
if (!inherits(icn, "character"))
stop("'obj' should inherit from 'character'")
-
+
# Check that new icons are correctly formatted
nicons <- names(icons)
if (is.null(nicons))
stop("Icons map you add must be a named character vector")
- icons <- as.character(icons)
+ icons <- as.character(icons)
names(icons) <- nicons
-
+
# Add new icons to it
icn <- addItems(icn, icons, replace = replace)
@@ -65,7 +68,8 @@
}
"addMethods" <-
-function(methods) {
+function (methods)
+{
# get the list of methods
met <- getOption("svGUI.methods")
if (!is.null(met)) methods <- addItems(met, methods, use.names = FALSE)
Modified: pkg/svMisc/R/addTemp.R
===================================================================
--- pkg/svMisc/R/addTemp.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/addTemp.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"addTemp" <-
-function(x, item, value, use.names = TRUE, replace = TRUE) {
+function (x, item, value, use.names = TRUE, replace = TRUE)
+{
x <- as.character(x)[1]
item <- as.character(item)[1]
if (existsTemp(x)) dat <- getTemp(x) else dat <- list()
@@ -9,6 +10,6 @@
if (item %in% names(dat))
value <- addItems(dat[[item]], value,
use.names = use.names, replace = replace)
- dat[[item]] <- value
+ dat[[item]] <- value
assignTemp(x, dat)
}
Modified: pkg/svMisc/R/assignTemp.R
===================================================================
--- pkg/svMisc/R/assignTemp.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/assignTemp.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,5 @@
"assignTemp" <-
-function(x, value, replace.existing = TRUE)
+function (x, value, replace.existing = TRUE)
if (replace.existing || !exists(x, envir = TempEnv(), mode = "any",
inherits = FALSE))
assign(x, value, envir = TempEnv())
Modified: pkg/svMisc/R/captureAll.R
===================================================================
--- pkg/svMisc/R/captureAll.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/captureAll.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"captureAll" <-
-function (expr) {
+function (expr)
+{
# capture.all() is inspired from capture.output(), but it captures
# both the output and the message streams
rval <- NULL # Just to avoid a note during code analysis
@@ -35,7 +36,8 @@
rm("warning", envir = TempEnv())
})
- "evalVis" <- function (Expr) {
+ "evalVis" <- function (Expr)
+ {
# We need to install our own warning handling
# and also, we use a customized interrupt handler
owarns <- getOption("warning.expression")
@@ -152,7 +154,8 @@
}
# This is my function to display delayed warnings
- WarningMessage <- function (last.warning) {
+ WarningMessage <- function (last.warning)
+ {
assign("last.warning", last.warning, envir = baseenv())
n.warn <- length(last.warning)
if (n.warn < 11) { # If less than 11 warnings, print them
@@ -173,7 +176,7 @@
tmp <- evalVis(expr[[i]])
if (inherits(tmp, "try-error")) {
- # This is not necessary anymore, since errors are printed by error handler:
+ # This is not necessary any more, since errors are printed by error handler:
#{{
#
# # Rework the error message if occurring in calling env
Modified: pkg/svMisc/R/changeTemp.R
===================================================================
--- pkg/svMisc/R/changeTemp.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/changeTemp.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"changeTemp" <-
-function(x, item, value, replace.existing = TRUE) {
+function (x, item, value, replace.existing = TRUE)
+{
x <- as.character(x)[1]
item <- as.character(item)[1]
if (existsTemp(x)) dat <- getTemp(x) else dat <- list()
Modified: pkg/svMisc/R/clipsource.R
===================================================================
--- pkg/svMisc/R/clipsource.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/clipsource.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"clipsource" <-
-function(primary = TRUE, ...) {
+function (primary = TRUE, ...)
+{
# Source data from the clipboard, manage clipboard correctly depending
# on the OS
if (isWin()) { # Windows OS
@@ -16,5 +17,5 @@
on.exit(close(data))
# Invoke source() with the data from the clipboard
res <- source(data, ...)
- return(invisible(res))
-}
+ return(invisible(res))
+}
Modified: pkg/svMisc/R/compareRVersion.R
===================================================================
--- pkg/svMisc/R/compareRVersion.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/compareRVersion.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,6 @@
"compareRVersion" <-
-function(version) {
+function (version)
+{
# This is similar to compareVersion, but works for R version comparison
compareVersion(paste(R.Version()$major, R.Version()$minor, sep = "."),
version)
Modified: pkg/svMisc/R/def.R
===================================================================
--- pkg/svMisc/R/def.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/def.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,9 +1,10 @@
"def" <-
-function(value, default = "", mode = "character", length = NULL) {
+function (value, default = "", mode = "character", length = NULL)
+{
# Ensure we got a value of a given mode, and if not, use default
# If length is provided, make sure that the returned vector has that length
# (if needed, cut or recycle 'value')
-
+
# If either NULL or NA, or something of length == 0 is in 'value', then,
# return default
if (is.null(value) || is.na(value) || length(value) < 1) value <- default
@@ -15,13 +16,13 @@
numeric = as.numeric(value),
factor = as.factor(value),
complex = as.complex(value),
- value) # This is for unrecognized modes!
+ value) # This is for unrecognized modes!
# If length is provided, make sure the vector has this length
if (!is.null(length)) {
if (!is.numeric(length) || length[1] < 1) length <- 1 else
length <- round(length[1]) # Make sure 'length' argument is correct
res <- rep(res, length.out = length)
- }
- return(res)
-}
+ }
+ return(res)
+}
Modified: pkg/svMisc/R/descFun.R
===================================================================
--- pkg/svMisc/R/descFun.R 2009-02-12 13:53:29 UTC (rev 112)
+++ pkg/svMisc/R/descFun.R 2009-02-20 10:18:03 UTC (rev 113)
@@ -1,5 +1,7 @@
-descFun <-
-function (fun, package, lib.loc = NULL) {
+# These are all hidden functions for the moment!
+"descFun" <-
+function (fun, package, lib.loc = NULL)
+{
fun <- as.character(fun)
if (length(fun) == 0) return("")
# Get the description associated with this Topic
@@ -38,20 +40,21 @@
return(res)
}
-descData <- function( data, columns, package = NULL, lib.loc = NULL ){
- character( length( columns ) )
-}
+"descData" <-
+function (data, columns, package = NULL, lib.loc = NULL)
+ character(length(columns))
-descSlots <- function( object, slots, package = NULL, lib.loc = NULL ){
- character( length( slots ) )
-}
+"descSlots" <-
+function (object, slots, package = NULL, lib.loc = NULL)
+ character(length(slots))
-descSquare <- function( completions, package = NULL ){
- character( length( completions ))
-}
+"descSquare" <-
+function (completions, package = NULL)
+ character(length(completions))
-descArgs <-
-function (fun, args = NULL, package = NULL, lib.loc = NULL) {
+"descArgs" <-
+function (fun, args = NULL, package = NULL, lib.loc = NULL)
+{
# Start from the text version of the online help instead of the .Rd file
if (is.null(package)) {
File <- as.character(help(fun,
@@ -61,26 +64,26 @@
lib.loc = lib.loc, chmhelp = FALSE, htmlhelp = FALSE))
}
if (length(File) == 0) return(rep("", length(args)))
-
- # doing the same as help to extract the file if it is in a zip
+
+ # doing the same as help to extract the file if it is in a zip
File <- zip.file.extract(File, "Rhelp.zip")
-
+
# guess the encoding (from print.help_files_with_topic)
first <- readLines( File, n = 1)
- enc <- if (length(grep("\\(.*\\)$", first)) > 0)
- sub("[^(]*\\((.*)\\)$", "\\1", first)
- else ""
- if (enc == "utf8")
- enc <- "UTF-8"
- if (.Platform$OS.type == "windows" && enc ==
- "" && l10n_info()$codepage < 1000)
- enc <- "CP1252"
- File. <- file( File, encoding = enc, open = "r" )
-
+ enc <- if (length(grep("\\(.*\\)$", first)) > 0) {
+ sub("[^(]*\\((.*)\\)$", "\\1", first)
+ } else ""
+ if (enc == "utf8")
+ enc <- "UTF-8"
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 113
More information about the Sciviews-commits
mailing list