[Sciviews-commits] r300 - in pkg/svMisc: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 10 17:02:49 CEST 2010
Author: phgrosjean
Date: 2010-09-10 17:02:49 +0200 (Fri, 10 Sep 2010)
New Revision: 300
Added:
pkg/svMisc/R/argsTip.R
pkg/svMisc/R/completion.R
pkg/svMisc/man/Args-deprecated.Rd
pkg/svMisc/man/Complete-deprecated.Rd
pkg/svMisc/man/CompletePlus-deprecated.Rd
pkg/svMisc/man/argsTip.Rd
pkg/svMisc/man/completion.Rd
Removed:
pkg/svMisc/R/Args.R
pkg/svMisc/R/CallTip.R
pkg/svMisc/R/Complete.R
pkg/svMisc/R/CompletePlus.R
pkg/svMisc/man/Args.Rd
pkg/svMisc/man/Complete.Rd
pkg/svMisc/man/CompletePlus.Rd
Modified:
pkg/svMisc/NAMESPACE
pkg/svMisc/NEWS
pkg/svMisc/R/descFun.R
pkg/svMisc/R/isHelp.R
pkg/svMisc/R/svMisc-internal.R
Log:
Rework of Args(), CallTip(), Complete() and CompletePlus() into argsTip(), callTip() and completion()
Modified: pkg/svMisc/NAMESPACE
===================================================================
--- pkg/svMisc/NAMESPACE 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/NAMESPACE 2010-09-10 15:02:49 UTC (rev 300)
@@ -7,14 +7,17 @@
addMethods,
addTemp,
Args,
+ argsTip,
assignTemp,
CallTip,
+ callTip,
changeTemp,
captureAll,
clipsource,
compareRVersion,
Complete,
CompletePlus,
+ completion,
def,
descArgs,
descFun,
Modified: pkg/svMisc/NEWS
===================================================================
--- pkg/svMisc/NEWS 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/NEWS 2010-09-10 15:02:49 UTC (rev 300)
@@ -27,6 +27,12 @@
* r() is deprecated in favor of pkg() (r is not informative enough and more
susceptible to be used elsewere too).
+
+* Args() is deprecated in favor of argsTip() and CallTip() is deprecated in
+ favor of callTip() (further homogeneization of svMisc function names).
+
+* Complete() and CompletePlus() are deprecated in favor of a unique completion()
+ function. Code of both original functions has been fused and reworked.
== Changes in svMisc 0.9-59
Deleted: pkg/svMisc/R/Args.R
===================================================================
--- pkg/svMisc/R/Args.R 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/R/Args.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -1,18 +0,0 @@
-Args <- 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)
- if (inherits(ret, "try-error") || is.null(res))
- return("") # Function 'name' not found
- res <- deparse(res)
- res <- paste(res[-length(res)], collapse = "\n")
- if (only.args) {
- res <- sub("^function *[(]", "", res)
- res <- sub(" *[)] *$", "", res)
- } else {
- res <- sub("^function *", name, res)
- res <- sub(" *$", "", res)
- }
- return(res)
-}
Deleted: pkg/svMisc/R/CallTip.R
===================================================================
--- pkg/svMisc/R/CallTip.R 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/R/CallTip.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -1,19 +0,0 @@
-CallTip <- function (code, only.args = FALSE, location = FALSE)
-{
- code <- attr(Complete(code, types = NA), "fguess")
- if (is.null(code) || !length(code) || code == "")
- return("")
-
- ## Get the corresponding calltip
- ctip <- "" # Default value, in case the function does not exist
- if (code != "") ctip <- Args(code, only.args = only.args)
- if (is.null(ctip)) return("")
- ## Do we need to append an indication of where this function is located?
- if (location == TRUE) {
- ## TODO: use getAnywhere() instead
- pkg <- sub("^package:", "", find(code, mode = "function"))
- if (length(pkg) > 0 && pkg != ".GlobalEnv")
- ctip <- paste(ctip, " [", pkg, "]", sep = "")
- }
- return(ctip)
-}
Deleted: pkg/svMisc/R/Complete.R
===================================================================
--- pkg/svMisc/R/Complete.R 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/R/Complete.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -1,296 +0,0 @@
-Complete <- function (code, print = FALSE, types = c("default", "scintilla"),
-addition = FALSE, skip.used.args = TRUE, sep = "\n", type.sep = "?") {
- ComplEnv <- utils:::.CompletionEnv
-
- finalize <- function (completions) {
- ## Sort completion items alphabetically
- completions <- sort(completions)
- if (isTRUE(add.types)) {
- tl <- numeric(length(completions))
- tl[grep(" = $", completions)] <- 4L
- tl[grep("::$", completions)] <- 3L
- tl[grep("<-$", completions)] <- 1L
- tl[completions %in% .reserved.words] <- 5L
- i <- !tl
- tl[i] <- ifelse(sapply(completions[i],
- function(x) existsFunction(x)), 1L, 2L)
- tl <- factor(tl, levels = 1:5, labels = types)
- ret <- data.frame(completion = completions, type = tl,
- stringsAsFactors = FALSE)
- } else {
- ret <- completions
- }
-
- attr(ret, "token") <- token
- attr(ret, "triggerPos") <- triggerPos
- attr(ret, "fguess") <- fguess
- attr(ret, "funargs") <- funargs
- attr(ret, "isFirstArg") <- isFirstArg
-
- if (isTRUE(print)) {
- if (isTRUE(add.types))
- completions <- paste(completions, tl, sep = type.sep)
- cat(triggerPos, completions, sep = sep)
- if (sep != "\n") cat("\n")
- return(invisible(ret))
- } else {
- return(ret)
- }
- }
-
- if (is.character(types[1L])) {
- types <- switch(match.arg(types),
- default = .default.completion.types,
- scintilla = .scintilla.completion.types,
- .default.completion.types)
- }
- if (is.na(types[1L])) add.types <- FALSE else add.types <- TRUE
-
- ## Default values for completion context
- token <- ""
- triggerPos <- 0L
- fguess <- ""
- funargs <- list()
- isFirstArg <- FALSE
-
- ## Is there some code provided?
- code <- paste(as.character(code), collapse = "\n")
- if (is.null(code) || !length(code) || code == "") {
- ## Just return a list of objects in .GlobalEnv
- return(finalize(ls(envir = .GlobalEnv)))
- }
-
- ## If code ends with a single [, then nothing to return
- if (regexpr("[^[][[]$", code) > 0)
- return(invisible(""))
-
- ## If code ends with a double [[, then, substitute $ instead and indicate
- ## to quote returned arguments (otherwise, [[ is not correctly handled)!
- if (regexpr("[[][[]$", code) > 0) {
- code <- sub("[[][[]$", "$", code)
- dblBrackets <- TRUE
- } else dblBrackets <- FALSE
-
- ## Save funarg.suffix and use " = " temporarily
- opts <- ComplEnv$options
- funarg.suffix <- opts$funarg.suffix
- on.exit({
- opts$funarg.suffix <- funarg.suffix
- ComplEnv$options <- opts
- })
- opts$funarg.suffix <- " = "
- ComplEnv$options <- opts
-
- utils:::.assignLinebuffer(code)
- pos <- nchar(code, type = "chars")
- utils:::.assignEnd(pos)
- utils:::.guessTokenFromLine()
- #utils:::.completeToken()
- .completeTokenExt()
-
- completions <- utils:::.retrieveCompletions()
-
- triggerPos <- pos - ComplEnv[["start"]]
- token <- ComplEnv[["token"]]
-
- ## If token is empty, we complete by using objects in .GlobalEnv by default
- if (!length(completions) && token == "") {
- triggerPos <- nchar(code, type = "chars")
- return(finalize(ls(envir = .GlobalEnv)))
- }
-
- ## From CompletePlus() for a similar behaviour
- ## For tokens like "a[m", the actual token should be "m"
- ## completions are modified accordingly
- rx <- regexpr("[[]+", ComplEnv$token)
- if (rx > 0) {
- ## Then we need to trim out whatever is before the [ in the completion
- ## and the token
- start <- rx + attr(rx, "match.length")
- ComplEnv$token <- substring(ComplEnv$token, start)
- completions <- substring(completions, start)
- }
- if (!length(completions)) return(invisible(""))
-
- ## Remove weird object names (useful when the token starts with ".")
- i <- grep("^[.]__[[:alpha:]]__", completions)
- if (length(i) > 0)
- completions <- completions[-i]
-
- if (!length(completions)) return(invisible(""))
-
- fguess <- ComplEnv$fguess
-
- if (skip.used.args && length(fguess) && nchar(fguess))
- completions <- completions[!(completions %in% ComplEnv$funargs)]
- if (!length(completions)) return(invisible(""))
-
- i <- grep("<-.+$", completions)
- if (length(i) > 0)
- completions <- completions[-i]
-
- if (isTRUE(addition) && triggerPos > 0L)
- completions <- substring(completions, triggerPos + 1)
-
- if (dblBrackets) {
- ## Substitute var$name by var[["name"
- completions <- sub("[$](.+)$", '[["\\1"', completions)
- token <- sub("[$]$", "[[", token)
- triggerPos <- triggerPos + 1
- }
- fguess <- ComplEnv$fguess
- funargs <- ComplEnv$funargs
- isFirstArg <- ComplEnv$isFirstArg
- return(finalize(completions))
-}
-
-.reserved.words <- c("if", "else", "repeat", "while", "function", "for", "in",
- "next", "break", "TRUE", "FALSE", "NULL", "Inf", "NaN", "NA", "NA_integer_",
- "NA_real_", "NA_complex_", "NA_character_")
-
-.default.completion.types <- list(fun = "function", var = "variable",
- env = "environment", args = "arg", keyword = "keyword")
-
-.scintilla.completion.types <- list(fun = "1", var = "3",
- env = "8", args = "11", keyword = "13")
-
-## Modified utils:::inFunction()
-## The only difference is that it also gets current arguments list (if applicable).
-## They are assigned to utils:::.CompletionEnv$funargs
-.inFunctionExt <-
-function (line = utils:::.CompletionEnv[["linebuffer"]],
-cursor = utils:::.CompletionEnv[["start"]])
-{
- parens <- sapply(c("(", ")"), function(s)
- gregexpr(s, substr(line, 1L, cursor), fixed = TRUE)[[1L]],
- simplify = FALSE)
- parens <- lapply(parens, function(x) x[x > 0])
- temp <- data.frame(i = c(parens[["("]], parens[[")"]]),
- c = rep(c(1, -1), sapply(parens, length)))
- if (nrow(temp) == 0)
- return(character(0L))
- temp <- temp[order(-temp$i), , drop = FALSE]
- wp <- which(cumsum(temp$c) > 0)
- if (length(wp)) {
- index <- temp$i[wp[1L]]
- prefix <- substr(line, 1L, index - 1L)
- suffix <- substr(line, index + 1L, cursor + 1L)
- if ((length(grep("=", suffix, fixed = TRUE)) == 0L) &&
- (length(grep(",", suffix, fixed = TRUE)) == 0L))
- utils:::setIsFirstArg(v = TRUE)
- if ((length(grep("=", suffix, fixed = TRUE))) && (length(grep(",",
- substr(suffix, tail(gregexpr("=", suffix, fixed = TRUE)[[1L]],
- 1L), 1000000L), fixed = TRUE)) == 0L)) {
- return(character(0L))
- } else {
- ## This is the code added to utils:::inFunction()
- wp2 <- rev(cumsum(temp$c[-(wp[1L]:nrow(temp))]))
- suffix <- sub("^\\s+", "", suffix, perl = TRUE)
- ## TODO: simplify this:
- if (length(wp2)) {
- funargs <- strsplit(suffix, "\\s*[\\(\\)][\\s,]*",
- perl = TRUE)[[1]]
- funargs <- paste(funargs[wp2 == 0], collapse = ",")
- } else {
- funargs <- suffix
- }
- funargs <- strsplit(funargs, "\\s*,\\s*", perl=TRUE)[[1]]
- funargs <- unname(sapply(funargs, sub, pattern = "\\s*=.*$",
- replacement = utils:::.CompletionEnv$options$funarg.suffix,
- perl=TRUE))
- assign("funargs", funargs, utils:::.CompletionEnv)
- ## ... addition ends here
-
- possible <- suppressWarnings(strsplit(prefix, utils:::breakRE,
- perl = TRUE))[[1L]]
- possible <- possible[possible != ""]
- if (length(possible)) {
- return(tail(possible, 1))
- } else {
- return(character(0L))
- }
- }
- } else {
- return(character(0L))
- }
-}
-
-## Modified utils:::.completeToken()
-## Main difference is that calls .inFunctionExt instead of utils:::inFunction.
-.completeTokenExt <- function () {
- ComplEnv <- utils:::.CompletionEnv
- text <- ComplEnv$token
- linebuffer <- ComplEnv$linebuffer
- st <- ComplEnv$start
-
- if (utils:::isInsideQuotes()) {
- probablyNotFilename <- (st > 2L &&
- (substr(linebuffer, st - 1L, st - 1L) %in% c("[", ":", "$")))
- if (ComplEnv$settings[["files"]]) {
- if (probablyNotFilename) {
- ComplEnv[["comps"]] <- character(0L)
- } else {
- ComplEnv[["comps"]] <- utils:::fileCompletions(text)
- }
- utils:::.setFileComp(FALSE)
- } else {
- ComplEnv[["comps"]] <- character(0L)
- utils:::.setFileComp(TRUE)
- }
- } else {
-
- ## Completion does not a good job when there are quoted strings,
- ## e.g for linebuffer = "Complete2("anova(", )" would give arguments for
- ## anova rather than for Complete2.
- # Replace quoted strings with sequences of "_" of the same length.
- # This is a temporary solution though, there should be a better way...
- mt <- gregexpr('(?<!\\\\)(["\']).*?((?<!\\\\)\\1|$)', linebuffer,
- perl = TRUE)[[1]]
- if (mt[1L] != -1) {
- ml <- attr(mt, "match.length")
- y <- sapply(lapply(ml, rep, x = "a"), paste, collapse = "")
- for (i in seq_along(mt))
- substr(linebuffer, mt[i], mt[i] + ml[i]) <- y[i]
- }
- ## ... additions until here
-
- utils:::.setFileComp(FALSE)
- utils:::setIsFirstArg(FALSE)
- guessedFunction <- ""
- if (ComplEnv$settings[["args"]]) {
- ## Call of .inFunctionExt() instead of utils:::inFunction()
- guessedFunction <- .inFunctionExt(linebuffer, st)
- } else {
- guessedFunction <- ""
- }
-
- assign("fguess", guessedFunction, ComplEnv)
- fargComps <- utils:::functionArgs(guessedFunction, text)
-
- if (utils:::getIsFirstArg() && length(guessedFunction) &&
- guessedFunction %in% c("library", "require", "data")) {
- assign("comps", fargComps, ComplEnv)
- return()
- }
- lastArithOp <- tail(gregexpr("[\"'^/*+-]", text)[[1L]], 1)
- if (haveArithOp <- (lastArithOp > 0)) {
- prefix <- substr(text, 1L, lastArithOp)
- text <- substr(text, lastArithOp + 1L, 1000000L)
- }
- spl <- utils:::specialOpLocs(text)
- if (length(spl)) {
- comps <- utils:::specialCompletions(text, spl)
- } else {
- appendFunctionSuffix <- !any(guessedFunction %in%
- c("help", "args", "formals", "example", "do.call",
- "environment", "page", "apply", "sapply", "lapply",
- "tapply", "mapply", "methods", "fix", "edit"))
- comps <- utils:::normalCompletions(text,
- check.mode = appendFunctionSuffix)
- }
- if (haveArithOp && length(comps))
- comps <- paste(prefix, comps, sep = "")
- comps <- c(comps, fargComps)
- assign("comps", comps, ComplEnv)
- }
-}
Deleted: pkg/svMisc/R/CompletePlus.R
===================================================================
--- pkg/svMisc/R/CompletePlus.R 2010-09-07 18:14:12 UTC (rev 299)
+++ pkg/svMisc/R/CompletePlus.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -1,128 +0,0 @@
-CompletePlus <- function (linebuffer, cursorPosition = nchar(linebuffer),
-minlength = 2, simplify = FALSE, types = c("arguments", "functions", "packages"))
-{
- ## Call the rcompgen API to get completions
- if (nchar(linebuffer, type = "chars") < minlength) return(invisible(NULL))
- utils:::.assignLinebuffer(linebuffer)
- utils:::.assignEnd(cursorPosition)
- utils:::.guessTokenFromLine()
- token <- utils:::.CompletionEnv[["token"]]
- utils:::.completeToken()
- comps <- utils:::.retrieveCompletions()
- if (!length(comps)) return(invisible(NULL))
-
- ## For tokens like "a[m", the actual token should be "m"
- ## completions are modified accordingly
- rx <- regexpr("[[]+", token)
- if (rx > 0) {
- ## Then we need to trim out whatever is before the [ in the completion
- ## and the token
- start <- rx + attr(rx, "match.length")
- token <- substring(token, start)
- comps <- substring(comps, start)
- }
-
- ## Remove weird object names (useful when the token starts with ".")
- comps <- comps[ !grepl( "^[.]__[[:alpha:]]__", comps ) ]
- if (!length(comps))
- return(invisible(NULL))
-
- ## Restrict completion for which information is gathered (speed things up)
- if (!"arguments" %in% types)
- comps <- comps[regexpr("=$", comps) < 0]
- if (!length(comps))
- return(invisible(NULL))
-
- if (!"packages" %in% types)
- comps <- comps[regexpr("::$", comps) < 0]
- if (!length(comps))
- return(invisible(NULL))
-
- if (!"functions" %in% types)
- comps <- comps[regexpr("(::|=)$", comps) > 0]
- if (!length(comps))
- return(invisible(NULL))
-
- ## Build the output structure
- out <- matrix("", nrow = length(comps), ncol = 3)
- out[, 1] <- comps
-
- ## 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 =)
- 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)
- }
- }
-
- ## 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)
- }
-
- ## 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)
- }
-
- ## TODO: do not know what to do with these?
- test.others <- grep(" ", comps)
- ## 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))
- if (length(test.fun)) {
- 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)
- }
- }
- out[test.fun, 2] <- packs
- out[test.fun, 3] <- desc.fun
- }
-
- out[, 3] <- gsub("\t", " ", out[, 3])
- out[, 3] <- gsub("\n", " ", out[, 3])
-
- ## Make sure that arguments are witten 'arg = ', and not 'arg='
- out[, 1] <- sub("=$", " = ", out[, 1])
-
- attr( out, "token" ) <- token
-
- if (simplify) {
- cat(apply(out, 1, paste, collapse = "\t"), sep = "\n")
- } else {
- return(out)
- }
-}
Added: pkg/svMisc/R/argsTip.R
===================================================================
--- pkg/svMisc/R/argsTip.R (rev 0)
+++ pkg/svMisc/R/argsTip.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -0,0 +1,23 @@
+Args <- function (name, only.args = FALSE) {
+ .Deprecated("argsTip")
+ return(argsTip(name, only.args = only.args))
+}
+
+argsTip <- 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)
+ if (inherits(ret, "try-error") || is.null(res))
+ return("") # Function 'name' not found
+ res <- deparse(res)
+ res <- paste(res[-length(res)], collapse = "\n")
+ if (isTRUE(only.args)) {
+ res <- sub("^function *[(]", "", res)
+ res <- sub(" *[)] *$", "", res)
+ } else {
+ res <- sub("^function *", name, res)
+ res <- sub(" *$", "", res)
+ }
+ return(res)
+}
Property changes on: pkg/svMisc/R/argsTip.R
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/svMisc/R/completion.R
===================================================================
--- pkg/svMisc/R/completion.R (rev 0)
+++ pkg/svMisc/R/completion.R 2010-09-10 15:02:49 UTC (rev 300)
@@ -0,0 +1,454 @@
+## TODO: activate rc.settings(ipck = TRUE) and rc.settings(files = TRUE)
+
+Complete <- function (code, print = FALSE, types = c("default", "scintilla"),
+addition = FALSE, skip.used.args = TRUE, sep = "\n", type.sep = "?")
+{
+ .Deprecated("completion")
+ return(completion(code, print = print, types = types, addition = addition,
+ skip.used.args = skip.used.args, sep = sep, field.sep = type.sep))
+}
+
+CompletePlus <- function (linebuffer, cursorPosition = nchar(linebuffer),
+minlength = 2, simplify = FALSE, types = c("arguments", "functions", "packages"))
+{
+ .Deprecated("completion")
+ res <- completion(linebuffer, pos = cursorPosition, min.length = minlength,
+ print = FALSE, what = types, types = NA, addition = FALSE,
+ sort = FALSE, describe = TRUE, max.fun = 10000, skip.used.args = FALSE,
+ field.sep = "\t")
+ if (is.character(res) && length(res) && res == "") return(NULL) else {
+ if (isTRUE(simplify)) {
+ cat(apply(res[, c("completion", "context", "desc")], 1, paste,
+ collapse = "\t"), sep = "\n")
+ } else return(res)
+ }
+}
+
+completion <- function (code, pos = nchar(code), min.length = 2,
+print = FALSE, types = c("default", "scintilla"), addition = FALSE, sort = TRUE,
+what = c("arguments", "functions", "packages"), describe = FALSE, max.fun = 100,
+skip.used.args = TRUE, sep = "\n", field.sep = "\t")
+{
+ finalize <- function (completions) {
+ ## Construct a data frame with completions
+ ret <- data.frame(completion = completions,
+ stringsAsFactors = FALSE)
+
+ ## Do we add types?
+ if (isTRUE(add.types)) {
+ tl <- numeric(length(completions))
+ tl[grep(" = $", completions)] <- 4L
+ tl[grep("::$", completions)] <- 3L
+ tl[grep("<-$", completions)] <- 1L
+ tl[completions %in% .reserved.words] <- 5L
+ tl[!tl] <- ifelse(sapply(completions[!tl],
+ function(x) existsFunction(x, where = .GlobalEnv)), 1L, 2L)
+ tl <- factor(tl, levels = 1:5, labels = types)
+ ret <- cbind(ret, data.frame(type = tl, stringsAsFactors = FALSE))
+ }
+
+ ## Do we add descriptions?
+ if (isTRUE(describe)) {
+ ret <- cbind(ret, data.frame(desc = rep("", nrow(ret)),
+ context = rep("", nrow(ret)), stringsAsFactors = FALSE))
+
+ ## Deal with packages (completions ending with ::)
+ if (length(test.pack <- grep("::$", completions))) {
+ pkgDesc <- function (pkg) {
+ ## This is to deal with completion of :, ::, ::: in pkg base
+ if (grepl(":$", pkg)) return("") else
+ return(packageDescription(pkg, field = "Description"))
+ }
+ ret[test.pack, "desc"] <- sapply(sub(":{2,3}$", "",
+ completions[test.pack]), pkgDesc)
+ }
+
+ ## Deal with argument completions (ending with " = ")
+ if (length(test.arg <- grep(" = ", completions))) {
+ fun <- utils:::.CompletionEnv[["fguess"]]
+ ret[test.arg, "context"] <- fun
+ ret[test.arg, "desc"] <- descArgs(fun,
+ sub(" = $", "", completions[test.arg]))
+ }
+
+ ## Deal with completions with "$" (excluding things like base::$)
+ if (length(test.dollar <- grep("[^:]\\$", completions))) {
+ elements <- completions[test.dollar]
+ object <- gsub("\\$.*$", "", completions)[1]
+ items <- gsub("^.*\\$", "", completions)
+ pack <- .find.multiple(object)
+ ret[test.dollar, "context"] <- pack
+ ret[test.dollar, "desc"] <- .descData(object, items,
+ package = pack)
+ }
+
+ ## Deal with completions with "@" (excluding things like base:::$)
+ if (length(test.slot <- grep("[^:]@", completions))) {
+ elements <- completions[test.slot]
+ object <- gsub("@.*$", "", completions)[1]
+ slots <- gsub("^.*@", "", completions)
+ pack <- .find.multiple(object)
+ ret[test.slot, "context"] <- pack
+ ret[test.slot, "desc"] <- .descSlots(object, slots,
+ package = pack)
+ }
+
+ ## Deal with completions with "["
+ if (length(test.square <- grep("\\[", completions))) {
+ ret[test.square, "desc"] <- .descSquare(completions[test.square],
+ package = pack)
+ }
+
+ ## TODO: do not know what to do with these?
+ test.others <- grep(" ", completions)
+ ## TODO: are there other kind of completions I miss here?
+
+ ## Deal with function completions
+ test.fun <- setdiff(1:length(completions), c(test.arg, test.pack,
+ test.others, test.dollar, test.slot, test.square))
+ if (length(test.fun)) {
+ funs <- completions[test.fun]
+ ## If we have nmspace::fun, or nmspace:::fun, split it
+ test.nms <- grep(".+::.+", funs)
+ packs <- rep("", length(funs))
+ if (length(test.nms)) {
+ packs[test.nms] <- sub(":{2,3}[^:]+$", "", funs[test.nms])
+ funs[test.nms] <- sub("^.+:{2,3}", "", funs[test.nms])
+ packs[-test.nms] <- .find.multiple(funs[-test.nms])
+ } else packs <- .find.multiple(funs)
+ desc.fun <- rep("", length(packs))
+ ## Do not try to find description for functions in those envs
+ isPack <- !packs %in% c("", ".GlobalEnv", "TempEnv", "Autoloads",
+ "tools:RGUI")
+ ## The following code is too slow for many function
+ ## (it takes 6-7sec for the 1210 base:::XXXX functions)
+ ## So, do it only if less than max.fun
+ ## Note, without descriptions, it takes 0.3sec on my MacBook Pro
+ if (length(isPack) < max.fun)
+ desc.fun[isPack] <- descFun(funs[isPack], packs[isPack])
+ ret[test.fun, "context"] <- packs
+ ret[test.fun, "desc"] <- desc.fun
+ }
+ }
+
+ ## Do we sort results alphabetically?
+ if (isTRUE(sort)) ret <- ret[order(completions), ]
+
+ ## Add metadata as attributes
+ attr(ret, "token") <- token
+ attr(ret, "triggerPos") <- triggerPos
+ attr(ret, "fguess") <- fguess
+ attr(ret, "funargs") <- funargs
+ attr(ret, "isFirstArg") <- isFirstArg
+
+ if (isTRUE(print)) {
+ if (is.null(ret$desc)) {
+ cat(triggerPos, paste(ret$completion, ret$type, sep = field.sep),
+ sep = sep)
+ } else {
+ cat(triggerPos, paste(ret$completion, ret$type, ret$desc,
+ ret$context, sep = field.sep), sep = sep)
+ }
+ if (sep != "\n") cat("\n")
+ return(invisible(ret))
+ } else {
+ return(ret)
+ }
+ }
+
+ ## Do we return the type of the entry, and if yes, in which format?
+ if (is.character(types[1L])) {
+ types <- switch(match.arg(types),
+ default = .default.completion.types,
+ scintilla = .scintilla.completion.types,
+ .default.completion.types)
+ }
+ add.types <- as.logical(!is.na(types[1L]))
+
+ ## Default values for completion context
+ token <- ""
+ triggerPos <- 0L
+ fguess <- ""
+ funargs <- list()
+ isFirstArg <- FALSE
+
+ ## Is there some code provided?
+ code <- paste(as.character(code), collapse = "\n")
+ if (is.null(code) || !length(code) || code == "" ||
+ nchar(code, type = "chars") < min.length) {
+ ## Just return a list of objects in .GlobalEnv
+ ## TODO: look if we are inside a function and list
+ ## local variables (code analysis is required!)
+ return(finalize(ls(envir = .GlobalEnv)))
+ }
+
+ ## If code ends with a single [, then look for names in the object
+ if (regexpr("[^[][[]$", code) > 0) {
+ ## TODO: look for object names... currently, return nothing
+ return(invisible(""))
+ }
+
+ ## If code ends with a double [[, then, substitute $ instead and indicate
+ ## to quote returned arguments (otherwise, [[ is not correctly handled)!
+ if (regexpr("[[][[]$", code) > 0) {
+ code <- sub("[[][[]$", "$", code)
+ dblBrackets <- TRUE
+ } else dblBrackets <- FALSE
+
+ ## Save funarg.suffix and use " = " locally
+ ComplEnv <- utils:::.CompletionEnv
+ opts <- ComplEnv$options
+ funarg.suffix <- opts$funarg.suffix
+ on.exit({
+ opts$funarg.suffix <- funarg.suffix
+ ComplEnv$options <- opts
+ })
+ opts$funarg.suffix <- " = "
+ ComplEnv$options <- opts
+
+ ## Calculate completion with standard R completion tools
+ utils:::.assignLinebuffer(code)
+ utils:::.assignEnd(pos)
+ utils:::.guessTokenFromLine()
+ ## The standard utils:::.completeToken() is replaced by our own version:
+ .completeTokenExt()
+ completions <- utils:::.retrieveCompletions()
+ triggerPos <- pos - ComplEnv[["start"]]
+ token <- ComplEnv[["token"]]
+
+ ## If token is empty, we complete by using objects in .GlobalEnv by default
+ if (!length(completions) && token == "") {
+ triggerPos <- nchar(code, type = "chars")
+ ## TODO: look if we are inside a function and list
+ ## local variables (code analysis is required!)
+ return(finalize(ls(envir = .GlobalEnv)))
+ }
+
+ ## For tokens like "a[m", the actual token should be "m"
+ ## completions are modified accordingly
+ rx <- regexpr("[[]+", ComplEnv$token)
+ if (rx > 0) {
+ ## Then we need to trim out whatever is before the [ in the completion
+ ## and the token
+ start <- rx + attr(rx, "match.length")
+ ComplEnv$token <- substring(ComplEnv$token, start)
+ completions <- substring(completions, start)
+ }
+ if (!length(completions)) return(invisible(""))
+
+ ## Remove weird object names (useful when the token starts with ".")
+ i <- grep("^[.]__[[:alpha:]]__", completions)
+ if (length(i) > 0) completions <- completions[-i]
+ if (!length(completions)) return(invisible(""))
+
+ ## Restrict completion for which information is gathered (speed things up)
+ if (!"arguments" %in% what)
+ completions <- completions[regexpr("=$", completions) < 0]
+ if (!length(completions)) return(invisible(""))
+
+ if (!"packages" %in% what)
+ completions <- completions[regexpr("::$", completions) < 0]
+ if (!length(completions)) return(invisible(""))
+
+ if (!"functions" %in% what)
+ completions <- completions[regexpr("(::|=)$", completions) > 0]
+ if (!length(completions)) return(invisible(""))
+
+ ## Eliminate function arguments that are already used
+ fguess <- ComplEnv$fguess
+ if (skip.used.args && length(fguess) && nchar(fguess))
+ completions <- completions[!(completions %in% ComplEnv$funargs)]
+ if (!length(completions)) return(invisible(""))
+
+ ## Eliminate function names like `names<-`
+ i <- grep("<-.+$", completions)
+ if (length(i) > 0) completions <- completions[-i]
+
+ ## Do we return only additional strings for the completion?
+ if (isTRUE(addition) && triggerPos > 0L)
+ completions <- substring(completions, triggerPos + 1)
+
+ ## In case of [[, restore original code
+ if (dblBrackets) { # Substitute var$name by var[["name"
+ completions <- sub("[$](.+)$", '[["\\1"', completions)
+ token <- sub("[$]$", "[[", token)
+ triggerPos <- triggerPos + 1
+ }
+
+ ## Finalize processing of the completion list
+ funargs <- ComplEnv$funargs
+ isFirstArg <- ComplEnv$isFirstArg
+ return(finalize(completions))
+}
+
+.reserved.words <- c("if", "else", "repeat", "while", "function", "for", "in",
+ "next", "break", "TRUE", "FALSE", "NULL", "Inf", "NaN", "NA", "NA_integer_",
+ "NA_real_", "NA_complex_", "NA_character_")
+
+.default.completion.types <- list(fun = "function", var = "variable",
+ env = "environment", args = "arg", keyword = "keyword")
+
+.scintilla.completion.types <- list(fun = "1", var = "3",
+ env = "8", args = "11", keyword = "13")
+
+## Modified utils:::inFunction()
+## (checked equivalent with R 2.11.1)
+## The only difference is that it also gets current arguments list (if applicable).
+## They are assigned to utils:::.CompletionEnv$funargs
+.inFunctionExt <-
+function (line = utils:::.CompletionEnv[["linebuffer"]],
+cursor = utils:::.CompletionEnv[["start"]])
+{
+ parens <- sapply(c("(", ")"), function(s)
+ gregexpr(s, substr(line, 1L, cursor), fixed = TRUE)[[1L]],
+ simplify = FALSE)
+ parens <- lapply(parens, function(x) x[x > 0])
+ temp <- data.frame(i = c(parens[["("]], parens[[")"]]),
+ c = rep(c(1, -1), sapply(parens, length)))
+ if (nrow(temp) == 0)
+ return(character(0L))
+ temp <- temp[order(-temp$i), , drop = FALSE]
+ wp <- which(cumsum(temp$c) > 0)
+ if (length(wp)) {
+ index <- temp$i[wp[1L]]
+ prefix <- substr(line, 1L, index - 1L)
+ suffix <- substr(line, index + 1L, cursor + 1L)
+ if ((length(grep("=", suffix, fixed = TRUE)) == 0L) &&
+ (length(grep(",", suffix, fixed = TRUE)) == 0L))
+ utils:::setIsFirstArg(v = TRUE)
+ if ((length(grep("=", suffix, fixed = TRUE))) && (length(grep(",",
+ substr(suffix, tail(gregexpr("=", suffix, fixed = TRUE)[[1L]],
+ 1L), 1000000L), fixed = TRUE)) == 0L)) {
+ return(character(0L))
+ } else {
+ ## This is the code added to utils:::inFunction()
+ wp2 <- rev(cumsum(temp$c[-(wp[1L]:nrow(temp))]))
+ suffix <- sub("^\\s+", "", suffix, perl = TRUE)
+ ## TODO: simplify this:
+ if (length(wp2)) {
+ funargs <- strsplit(suffix, "\\s*[\\(\\)][\\s,]*",
+ perl = TRUE)[[1]]
+ funargs <- paste(funargs[wp2 == 0], collapse = ",")
+ } else {
+ funargs <- suffix
+ }
+ funargs <- strsplit(funargs, "\\s*,\\s*", perl=TRUE)[[1]]
+ funargs <- unname(sapply(funargs, sub, pattern = "\\s*=.*$",
+ replacement = utils:::.CompletionEnv$options$funarg.suffix,
+ perl=TRUE))
+ assign("funargs", funargs, utils:::.CompletionEnv)
+ ## TODO: how to take non named arguments into account too?
+ ## ... addition ends here
+
+ possible <- suppressWarnings(strsplit(prefix, utils:::breakRE,
+ perl = TRUE))[[1L]]
+ possible <- possible[possible != ""]
+ if (length(possible)) {
+ return(tail(possible, 1))
+ } else {
+ return(character(0L))
+ }
+ }
+ } else {
+ return(character(0L))
+ }
+}
+
+## Modified utils:::.completeToken()
+## (checked equivalent with R 2.11.1)
+## Main difference is that calls .inFunctionExt instead of utils:::inFunction
+## and it also makes sure completion is for Complete in 'Complete("anova(", )'!
+.completeTokenExt <- function () {
+ ComplEnv <- utils:::.CompletionEnv
+ text <- ComplEnv$token
+ linebuffer <- ComplEnv$linebuffer
+ st <- ComplEnv$start
+
+ if (utils:::isInsideQuotes()) {
+ probablyNotFilename <- (st > 2L &&
+ (substr(linebuffer, st - 1L, st - 1L) %in% c("[", ":", "$")))
+ if (ComplEnv$settings[["files"]]) {
+ if (probablyNotFilename) {
+ ComplEnv[["comps"]] <- character(0L)
+ } else {
+ ComplEnv[["comps"]] <- utils:::fileCompletions(text)
+ }
+ utils:::.setFileComp(FALSE)
+ } else {
+ ComplEnv[["comps"]] <- character(0L)
+ utils:::.setFileComp(TRUE)
+ }
+ } else {
+
+ ## Completion does not a good job when there are quoted strings,
+ ## e.g for linebuffer = "Complete("anova(", )" would give arguments for
+ ## anova rather than for Complete.
+ # Replace quoted strings with sequences of "_" of the same length.
+ # This is a temporary solution though, there should be a better way...
+ mt <- gregexpr('(?<!\\\\)(["\']).*?((?<!\\\\)\\1|$)', linebuffer,
+ perl = TRUE)[[1]]
+ if (mt[1L] != -1) {
+ ml <- attr(mt, "match.length")
+ y <- sapply(lapply(ml, rep, x = "a"), paste, collapse = "")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 300
More information about the Sciviews-commits
mailing list