[Sciviews-commits] r158 - in pkg/svMisc: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 29 16:08:17 CEST 2009
Author: prezez
Date: 2009-07-29 16:08:17 +0200 (Wed, 29 Jul 2009)
New Revision: 158
Added:
pkg/svMisc/R/Complete2.R
pkg/svMisc/man/Complete2.Rd
Modified:
pkg/svMisc/
pkg/svMisc/DESCRIPTION
pkg/svMisc/NAMESPACE
pkg/svMisc/man/
Log:
New Complete2 function to work with SciViews-K modified autocompletion.
Should be merged with Complete?
Property changes on: pkg/svMisc
___________________________________________________________________
Name: svn:ignore
+ !*
*-dev.*
check.bat
build.bat
Modified: pkg/svMisc/DESCRIPTION
===================================================================
--- pkg/svMisc/DESCRIPTION 2009-07-29 14:03:00 UTC (rev 157)
+++ pkg/svMisc/DESCRIPTION 2009-07-29 14:08:17 UTC (rev 158)
@@ -3,8 +3,8 @@
Imports: utils, methods
Depends: R (>= 2.6.0)
Description: Supporting functions for the GUI API (various utilitary functions)
-Version: 0.9-48
-Date: 2009-05-28
+Version: 0.9-49
+Date: 2009-07-29
Author: Philippe Grosjean, Romain Francois & Kamil Barton
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL (>= 2)
Modified: pkg/svMisc/NAMESPACE
===================================================================
--- pkg/svMisc/NAMESPACE 2009-07-29 14:03:00 UTC (rev 157)
+++ pkg/svMisc/NAMESPACE 2009-07-29 14:08:17 UTC (rev 158)
@@ -14,6 +14,7 @@
clipsource,
compareRVersion,
Complete,
+ Complete2,
CompletePlus,
def,
descArgs,
Added: pkg/svMisc/R/Complete2.R
===================================================================
--- pkg/svMisc/R/Complete2.R (rev 0)
+++ pkg/svMisc/R/Complete2.R 2009-07-29 14:08:17 UTC (rev 158)
@@ -0,0 +1,243 @@
+
+.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_")
+
+.scintilla.completion.types <- list(fun = "1",
+ var = "3",
+ env = "8",
+ args = "11",
+ keyword = "13")
+
+.default.completion.types <- list(fun = "function",
+ var = "variable",
+ env = "environment",
+ args = "arg",
+ keyword = "keyword")
+
+
+# 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 {
+ wp2 <- rev(cumsum(temp$c[-(wp[1L]:nrow(temp))]))
+ # TODO: simplify this:
+ if (length(wp2)) {
+ funargs <- strsplit(sub("^\\s+", "", suffix, perl=T),
+ "\\s*[\\(\\)][\\s,]*", perl = T)[[1]]
+ funargs <- paste(funargs[wp2 == 0], collapse=",")
+ } else {
+ funargs <- suffix
+ }
+ funargs <- strsplit(funargs, " *, *")[[1]]
+
+ funargs <- unname(sapply(funargs,
+ sub, pattern = " *=.*$",
+ replacement = utils:::.CompletionEnv$
+ options$funarg.suffix))
+
+ assign("funargs", funargs, utils:::.CompletionEnv)
+
+ 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"]]) {
+ ComplEnv[["comps"]] <- if (probablyNotFilename)
+ character(0L)
+ else utils:::fileCompletions(text)
+ utils:::.setFileComp(FALSE)
+ }
+ else {
+ ComplEnv[["comps"]] <- character(0L)
+ utils:::.setFileComp(TRUE)
+ }
+ }
+ else {
+
+ #Completion does not do good job when there are quoted strings,
+ # e.g for linebuffer = "Complete2("anova(", )" would give arguments for anova
+ # rather than for Complete2.
+ # Code below replaces 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 = T)[[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]
+ }
+
+ utils:::.setFileComp(FALSE)
+ utils:::setIsFirstArg(FALSE)
+ guessedFunction <- if (ComplEnv$settings[["args"]])
+ .inFunctionExt(linebuffer, st)
+ else ""
+
+ 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)
+ comps <- if (length(spl))
+ 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"))
+ utils:::normalCompletions(text, check.mode = appendFunctionSuffix)
+ }
+ if (haveArithOp && length(comps)) {
+ comps <- paste(prefix, comps, sep = "")
+ }
+ comps <- c(comps, fargComps)
+ assign("comps", comps, ComplEnv)
+ }
+}
+
+Complete2 <- function(code, print = FALSE, types = c("default", "scintilla"),
+ addition = FALSE, skip.used.args = TRUE,
+ sep = "\n", type.sep = "?") {
+
+ if (is.character(types[1L])) {
+ types <- switch(match.arg(types), default = .default.completion.types,
+ scintilla = .scintilla.completion.types,
+ .default.completion.types)
+ }
+
+
+ add.types <- !is.na(types[1L])
+
+
+ code <- paste(as.character(code), collapse = "\n")
+ if (is.null(code) || !length(code) || code == "")
+ return(invisible(""))
+
+ pos <- nchar(code, type = "chars")
+ utils:::.assignLinebuffer(code)
+ utils:::.assignEnd(pos)
+ utils:::.guessTokenFromLine()
+ #utils:::.completeToken()
+ .completeTokenExt()
+
+ ComplEnv <- utils:::.CompletionEnv
+ completions <- utils:::.retrieveCompletions()
+
+ fguess <- ComplEnv$fguess
+
+ #print(c(skip.used.args, length(fguess), nchar(fguess)))
+
+ if (skip.used.args && length(fguess) && nchar(fguess)) {
+ completions <- completions [!(completions %in% ComplEnv$funargs)]
+ }
+
+ triggerPos <- pos - ComplEnv[["start"]]
+ token <- ComplEnv[["token"]]
+
+ if (!length(completions))
+ return(invisible(""))
+
+ i <- -grep("<-.+$", completions)
+ if (length(i) > 0) completions <- completions[-grep("<-.+$", completions)]
+
+ if (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)
+ }
+
+ if (addition && triggerPos > 0L)
+ completions <- substring(completions, triggerPos + 1)
+
+
+
+
+ if (add.types)
+ ret <- data.frame(completion = completions, type = tl)
+ else
+ ret <- completions
+
+ attr(ret, "token") <- token
+ attr(ret, "triggerPos") <- triggerPos
+ attr(ret, "fguess") <- ComplEnv$fguess
+ attr(ret, "funargs") <- ComplEnv$funargs
+ attr(ret, "isFirstArg") <- ComplEnv$isFirstArg
+
+ if (print) {
+ cat(triggerPos,
+ if (add.types) paste(completions, tl, sep=type.sep) else completions,
+ sep=sep)
+ if (sep != "\n") cat("\n")
+
+ invisible(ret)
+ } else
+ return(ret)
+}
Property changes on: pkg/svMisc/man
___________________________________________________________________
Name: svn:ignore
+ !*
*-dev.*
Added: pkg/svMisc/man/Complete2.Rd
===================================================================
--- pkg/svMisc/man/Complete2.Rd (rev 0)
+++ pkg/svMisc/man/Complete2.Rd 2009-07-29 14:08:17 UTC (rev 158)
@@ -0,0 +1,53 @@
+\name{Complete2}
+\alias{Complete2}
+
+\title{ Get a completion list for a R code fragment }
+\description{
+ Returns names of objects/arguments/namespaces matching a code fragment.
+}
+\usage{
+
+Complete2(code, print = FALSE, types = c("default", "scintilla"), addition =
+FALSE, skip.used.args = TRUE, sep = "\n", type.sep = "?")
+
+}
+\arguments{
+ \item{code}{ A partial R code to be completed. }
+ \item{print}{ logical, print result and return invisibly. See details. }
+ \item{types}{ a named list giving names of types. Set to \code{NA} to give only names. See details. }
+ \item{addition}{ should only addition string be returned? }
+ \item{skip.used.args}{ logical, in case if completion is within function arguments, should the already used named arguments be omitted? }
+ \item{sep}{ The separator to use between returned items. }
+ \item{type.sep}{ Character string to separate types from name. }
+}
+
+\value{
+If \code{types} == \code{NA}, a character vector giving the completions,
+otherwise a data frame with two columns: "completion", and "type" (factor with
+levels given by \code{types} argument).\cr
+Attributes:\cr
+\code{attr(,"token")} - a completed token.\cr
+\code{attr(,"triggerPos")} - number of already typed characters.\cr
+\code{attr(,"fguess")} - name of guessed function.\cr
+\code{attr(,"isFirstArg")} - is this a first argument?
+
+}
+
+\details{
+If \code{print} == \code{TRUE}, results are returned invisibly, and printed in a form:
+triggerPos[newline]completions separated by \code{sep}.\cr
+If \code{types} are supplied, a completion will consist of name and type, separated by \code{type.sep}.
+\code{types} may me a vector of length 5, giving the type codes for "function", "variable", "environment", "argument" and "keyword". If \code{types == "default"}, above type names are given, \code{types == "scintilla"} will give numeric codes that can be used "with scintilla.autoCShow" function.
+
+}
+
+
+\author{ Kamil Barton }
+
+\seealso{ \code{\link{Complete}}, \code{\link[utils]{rc.settings()}} }
+\examples{
+
+## TODO
+
+}
+\keyword{ utilities }
More information about the Sciviews-commits
mailing list