[Sciviews-commits] r437 - in komodo/SciViews-K-dev: . R components content/js content/pkgman pylib skin/images
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 20 19:35:34 CET 2012
Author: prezez
Date: 2012-02-20 19:35:33 +0100 (Mon, 20 Feb 2012)
New Revision: 437
Added:
komodo/SciViews-K-dev/R/completion.R
komodo/SciViews-K-dev/pylib/langinfo_r.py
komodo/SciViews-K-dev/skin/images/R_disabled.png
Modified:
komodo/SciViews-K-dev/
komodo/SciViews-K-dev/components/
komodo/SciViews-K-dev/content/js/commands.js
komodo/SciViews-K-dev/content/pkgman/pkgman.xbl
komodo/SciViews-K-dev/content/pkgman/pkgman.xul
komodo/SciViews-K-dev/install.rdf
komodo/SciViews-K-dev/pylib/lang_r.py
Log:
Code intelligence-2 mechanism for R: explicit (Ctrl+J) completions almost fully implemented
completion.R: new functions to support completing
langinfo_r.py: RLangInfo class
Property changes on: komodo/SciViews-K-dev
___________________________________________________________________
Modified: svn:ignore
- !*
*-dev.*
*.xpi
build
sciviewsk-1.0.8dev-ko
arch
maya-1.1.1-ko
ko-Toolbox-Utilities
+ !*
*-dev.*
*.xpi
build
sciviewsk-1.0.8dev-ko
arch
maya-1.1.1-ko
ko-Toolbox-Utilities
rbrowser-new.xul
Added: komodo/SciViews-K-dev/R/completion.R
===================================================================
--- komodo/SciViews-K-dev/R/completion.R (rev 0)
+++ komodo/SciViews-K-dev/R/completion.R 2012-02-20 18:35:33 UTC (rev 437)
@@ -0,0 +1,365 @@
+# 'getFunArgs': returns function argument names, if 'object' is provided and 'f'
+# is generic (either S3 or S4), returns only arguments for an appropriate
+# method and/or default method if not found.
+# Usage:
+# getFunArgs("anova", fm1) # if fm1 is glm returns argument names for 'anova.glm'
+
+# "imports":
+tail <- utils::tail
+getS3method <- utils::getS3method
+findGeneric <- utils:::findGeneric
+
+`getFunArgs` <- function(FUNC.NAME, ...) {
+ rx <- regexpr("^([\\w\\.]+):{2,3}(`|)([\\w\\.]+)\\2$", FUNC.NAME, perl = TRUE)
+ if (rx == 1L) {
+ cs <- attr(rx,"capture.start")
+ fn <- substring(FUNC.NAME, cs, cs - 1L + attr(rx,"capture.length"))[c(1,3)]
+ FUNC.NAME <- fn[2L]
+ envir <- asNamespace(fn[1L])
+ inherit <- FALSE
+ } else {
+ envir <- .GlobalEnv
+ inherit <- TRUE
+ }
+
+ if(exists(FUNC.NAME, envir = envir, mode = "function", inherits = inherit)) {
+ fun <- get(FUNC.NAME, envir = envir, mode = "function", inherits = inherit)
+ } else
+ fun <- NULL
+
+ if(is.null(fun) || mode(fun) != "function") return(NULL)
+ if (findGeneric(FUNC.NAME, envir) != "" || is.primitive(fun)) {
+ cl <- sys.call()
+ cls <- NA_character_
+ if(length(cl) > 2L){
+ object <- cl[[3L]]
+ if(mode(object) == "call") {
+ if ("~" %in% all.names(object, functions = TRUE, max.names = 4L))
+ cls <- "formula"
+ } else {
+ object <- tryCatch(eval(object), error = function(e) NULL)
+ cls <- class(object)
+ }
+ }
+
+ if(is.na(cls)) {
+ ret <- names(formals(getS3method(FUNC.NAME, "default",
+ optional = TRUE)))
+ } else {
+ ncls <- length(cls)
+ ret <- vector(ncls + 2L, mode = "list")
+ if(isS4(object)) ret[[1L]] <- formals(selectMethod(FUNC.NAME, cls,
+ optional = TRUE))
+ ret[seq_len(ncls)] <- lapply(cls, function(x)
+ names(formals(getS3method(FUNC.NAME, x, optional = TRUE))))
+ if(all(vapply(ret, is.null, TRUE)))
+ ret <- names(formals(getS3method(FUNC.NAME, "default",
+ optional = TRUE)))
+ else
+ ret <- unique(unlist(ret, FALSE, FALSE))
+ }
+ } else ret <- character(0L)
+ ret <- unique(c(ret, names(formals(fun))))
+ if (length(ret) > 1L && (FUNC.NAME == "[" || FUNC.NAME == "[["))
+ ret <- ret[-1L]
+ return(ret[ret != "..."])
+}
+
+# provide special completions
+`completeSpecial` <- function(what) {
+ res <- switch(what, search = {
+ res <- search()
+ res[!(res %in% c(".GlobalEnv", "package:tcltk", "package:utils", "komodoConnection",
+ "package:methods", "TempEnv", "Autoloads", "package:base"))]
+ }, library = {
+ res <- unique(unlist(lapply(.libPaths(), dir), use.names = FALSE))
+ }, return(invisible(NULL)))
+ cat(res, sep='\n')
+ return(invisible(NULL))
+}
+
+
+
+
+# From svMisc::completion (simpllified)
+
+`completion` <- function (code, field.sep = "\x1e", sep = "\n",
+ pos = nchar(code), min.length = 2,
+ addition = FALSE, max.fun = 100,
+ skip.used.args = FALSE) {
+
+ types <- list(fun = "function", var = "variable",
+ env = "environment", args = "argument", keyword = "keyword")
+ finalize <- function (completions) {
+ ## Construct a data frame with completions
+ ret <- data.frame(completion = completions,
+ stringsAsFactors = FALSE)
+ 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) exists(x, where = .GlobalEnv, mode = "function")),
+ 1L, 2L)
+ tl <- factor(tl, levels = seq_len(5L), labels = types)
+ ret <- cbind(ret, data.frame(type = tl, stringsAsFactors = FALSE))
+ 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)
+ invisible(NULL)
+ }
+
+ ## 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
+
+ ## 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"]]
+
+ ## 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(""))
+
+ ## 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) > 0L) completions <- completions[-i]
+
+ ## Do we return only additional strings for the completion?
+ if (isTRUE(addition) && triggerPos > 0L)
+ completions <- substring(completions, triggerPos + 1L)
+
+ ## In case of [[, restore original code
+ if (dblBrackets) { # Substitute var$name by var[["name"
+ completions <- sub("\\$(.+)$", '[["\\1"', completions)
+ token <- sub("\\$$", "[[", token)
+ triggerPos <- triggerPos + 1L
+ }
+
+ ## 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_")
+
+## 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 = "")
+ 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)
+ }
+}
+
+## 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 = TRUE)
+ 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
+ return(sub("^package:", "", out))
+}
Property changes on: komodo/SciViews-K-dev/components
___________________________________________________________________
Modified: svn:ignore
- !*
*-dev.*
+ !*
*-dev.*
svIUtils.xpt
Modified: komodo/SciViews-K-dev/content/js/commands.js
===================================================================
--- komodo/SciViews-K-dev/content/js/commands.js 2012-02-19 13:35:13 UTC (rev 436)
+++ komodo/SciViews-K-dev/content/js/commands.js 2012-02-20 18:35:33 UTC (rev 437)
@@ -564,6 +564,11 @@
_setKeybindings();
sv.rconn.startSocketServer();
+
+ // For completions
+ var cuihproto = ko.codeintel.CompletionUIHandler.prototype;
+ cuihproto.types.argument = cuihproto.types.interface;
+ cuihproto.types.environment = cuihproto.types.namespace;
}
// Just in case, run a clean-up before quitting Komodo:
Modified: komodo/SciViews-K-dev/content/pkgman/pkgman.xbl
===================================================================
--- komodo/SciViews-K-dev/content/pkgman/pkgman.xbl 2012-02-19 13:35:13 UTC (rev 436)
+++ komodo/SciViews-K-dev/content/pkgman/pkgman.xbl 2012-02-20 18:35:33 UTC (rev 437)
@@ -201,9 +201,5 @@
</property>
</implementation>
</binding>
-</bindings>
-
-
-
</bindings>
Modified: komodo/SciViews-K-dev/content/pkgman/pkgman.xul
===================================================================
--- komodo/SciViews-K-dev/content/pkgman/pkgman.xul 2012-02-19 13:35:13 UTC (rev 436)
+++ komodo/SciViews-K-dev/content/pkgman/pkgman.xul 2012-02-20 18:35:33 UTC (rev 437)
@@ -10,7 +10,7 @@
<?xml-stylesheet href="chrome://sciviewsk/skin/pkgman.css" type="text/css"?>
<window id="RPackageManager" xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"
- maxheight="350" maxwidth="300" title="R Package manager (pre-alpha)" >
+ maxheight="350" maxwidth="300" title="R Package manager (beta)" >
<script type="text/javascript">
<![CDATA[
Modified: komodo/SciViews-K-dev/install.rdf
===================================================================
--- komodo/SciViews-K-dev/install.rdf 2012-02-19 13:35:13 UTC (rev 436)
+++ komodo/SciViews-K-dev/install.rdf 2012-02-20 18:35:33 UTC (rev 437)
@@ -5,7 +5,7 @@
<em:unpack>true</em:unpack>
<em:id>sciviewsk at sciviews.org</em:id>
<em:name>SciViews-K</em:name>
- <em:version>1.1.1dev</em:version>
+ <em:version>1.1.2dev</em:version>
<em:description>Edit R code with Komodo</em:description>
<em:creator>Philippe Grosjean</em:creator>
<em:contributor>Romain Francois</em:contributor>
Modified: komodo/SciViews-K-dev/pylib/lang_r.py
===================================================================
--- komodo/SciViews-K-dev/pylib/lang_r.py 2012-02-19 13:35:13 UTC (rev 436)
+++ komodo/SciViews-K-dev/pylib/lang_r.py 2012-02-20 18:35:33 UTC (rev 437)
@@ -17,6 +17,7 @@
from codeintel2.util import CompareNPunctLast
from codeintel2.accessor import AccessorCache, KoDocumentAccessor
+#from SilverCity import find_lexer_module_by_id, PropertySet, WordList
from SilverCity.ScintillaConstants import (
SCE_UDL_SSL_DEFAULT, SCE_UDL_SSL_IDENTIFIER, SCE_UDL_SSL_OPERATOR,
@@ -37,7 +38,7 @@
#---- Globals
lang = "R"
-log = logging.getLogger("codeintel.r")
+log = logging.getLogger("R-codeintel")
log.setLevel(logging.DEBUG)
# These keywords and builtin functions are copied from "Rlex.udl".
@@ -48,22 +49,28 @@
]
-# Non reserved keywords
-builtins = [
- ".Alias", ".ArgsEnv", ".AutoloadEnv", ".BaseNamespaceEnv", ".C",
-]
-
#---- Lexer class
class RLexer(UDLLexer):
lang = lang
+ #def __init__(self):
+ #self._properties = SilverCity.PropertySet()
+ #self._keyword_lists = [
+ #SilverCity.WordList(SilverCity.Keywords.perl_keywords),
+ #SilverCity.WordList("")
+ #]
+ #SilverCity.WordList("fsfsd fsfsdf")
-# possible R triggers
-# library|require(<|> available packages (ok)
+
+
+# possible R triggers:
+# library|require(<|> available packages
# detach(<|> loaded namespaces
# data(<|> available datasets
# func(<|> calltip or argument names
# func(arg,<|> argument names
+# func(firstar<|> argument names
+# func(arg, secondar<|> argument names
# list $ <|> list elements
# s4object @ <|> slots
# namespace:: <|> objects within namespace
@@ -75,9 +82,9 @@
## completion for 'library(' or 'require(' R command :
## 'unique(unlist(lapply(.libPaths(), dir)))'
+# TODO: skip if completion is none, i.e. equals the text
-
#---- LangIntel class
# Dev Notes:
# All language should define a LangIntel class. (In some rare cases it
@@ -110,7 +117,11 @@
string_style = SCE_UDL_SSL_STRING
comment_styles = (SCE_UDL_SSL_COMMENT, SCE_UDL_SSL_COMMENTBLOCK)
comment_styles_or_whitespace = comment_styles + (whitespace_style, )
+ word_styles = ( variable_style, identifier_style, keyword_style)
+ type_sep = u'\u001e'
+
+
#def __init__:
# CitadelLangIntel.__init__(self)
# ParenStyleCalltipIntelMixin.__init__(self)
@@ -118,51 +129,10 @@
#
- def _functionCalltipTrigger(self, ac, pos, DEBUG=False):
- # Implicit calltip triggering from an arg separator ",", we trigger a
- # calltip if we find a function open paren "(" and function identifier
- # http://bugs.activestate.com/show_bug.cgi?id=70470
- DEBUG = True
- if DEBUG: r_logfile.writelines("Arg separator found, looking for start of function\n")
- # Move back to the open paren of the function
- paren_count = 0
- p = pos
- min_p = max(0, p - 200) # look back max 200 chars
- while p > min_p:
- p, c, style = ac.getPrecedingPosCharStyle(ignore_styles=self.comment_styles)
- if style == self.operator_style:
- if c == ")":
- paren_count += 1
- elif c == "(":
- if paren_count == 0:
- # We found the open brace of the func
- trg_from_pos = p+1
- p, ch, style = ac.getPrevPosCharStyle()
- start, text = ac.getTextBackWithStyle(style, self.comment_styles, max_text_len = 32)
- #if DEBUG: r_logfile.writelines("Function start found, pos: %d (%s)\n" % (p, text))
- if style in self.comment_styles_or_whitespace:
- # Find previous non-ignored style then
- p, c, style = ac.getPrecedingPosCharStyle(style, self.comment_styles_or_whitespace)
- if style in (self.identifier_style, self.keyword_style):
- return Trigger(lang, TRG_FORM_CALLTIP,
- "call-signature",
- trg_from_pos, implicit=True)
- else:
- paren_count -= 1
- elif c in ";{}":
- # Gone too far and nothing was found
- #if DEBUG:
- #r_logfile.writelines("No function found, hit stop char: %s at p: %d\n" % (c, p))
- return None
- # Did not find the function open paren
- #if DEBUG:
- #print "No function found, ran out of chars to look at, p: %d" % (p,)
- return None
-
-
##
# Implicit triggering event, i.e. when typing in the editor.
#
+ # TODO: trigger positions
def trg_from_pos(self, buf, pos, implicit=True, DEBUG=False, ac=None):
"""If the given position is a _likely_ trigger point, return a
relevant Trigger instance. Otherwise return the None.
@@ -174,14 +144,13 @@
if pos < 3:
return None
- self._log("trg_from_pos: %d" % (pos))
accessor = buf.accessor
last_pos = pos - 1
char = accessor.char_at_pos(last_pos)
style = accessor.style_at_pos(last_pos)
if style == self.operator_style:
if char in '(':
- in_fun = self._is_function(pos, accessor)
+ in_fun = self._in_func(pos, accessor)
if in_fun != None and in_fun[2] in ('library', 'require'):
if(style == self.whitespace_style):
text = ''
@@ -202,131 +171,183 @@
return None
+ def _unquote(self, text, quotes = '`"\''):
+ if(text[0] in quotes and text[-1] == text[0]):
+ return text[1:len(text) - 1]
+ return text
- def _log(self, text):
- if False:
- logfile = open("c:/temp/codeintel_r.log", "a")
- logfile.writelines(text + "\n")
- logfile.close()
- else:
- pass
+ def _is_bquoted(self, text):
+ return len(text) > 1 and text.startswith('`') and text.endswith(text[0])
-
##
# Explicit triggering event, i.e. Ctrl+J.
#
def preceding_trg_from_pos(self, buf, pos, curr_pos,
preceding_trg_terminators=None, DEBUG=False):
- self._log("preceding_trg_from_pos: %d" % (pos))
if pos < 3:
return None
- accessor = buf.accessor
+ acc = buf.accessor
last_pos = pos - 1
- char = accessor.char_at_pos(last_pos)
- style = accessor.style_at_pos(last_pos)
- self._log("char: %r, style: %d, pos: %d" % (char, style, pos))
- #if(style != self.whitespace_style):
- #self._log("Triggered: test-elements")
- #start, end = accessor.contiguous_style_range_from_pos(last_pos)
- #return Trigger(self.lang, TRG_FORM_CPLN, "test-elements", start, False)
- #return None
- lw_start, lw_end, last_word = self._get_word_back(last_pos, accessor)
- if last_word in ('@', '$', '::', ':::'):
- start, end, objname = self._get_word_back(lw_start - 1, accessor)
- style2 = accessor.style_at_pos(end - 1)
- if style2 in (self.keyword_style, self.identifier_style, self.variable_style):
- return Trigger(self.lang, TRG_FORM_CPLN, "list-elements", \
- start, False, obj_name = objname + last_word) #acc.text_range(start, lw_end)
- else:
- in_fun = self._is_function(pos, accessor)
- if in_fun != None and (in_fun[2] in ('library', 'require')):
- self._log("(in_function) last_word: %r " % (last_word))
- text = ''
- if style == self.identifier_style and lw_end >= pos: # started word
- text = accessor.text_range(lw_start, pos)
- pos = lw_start
- return Trigger(self.lang, TRG_FORM_CPLN, "installed-pkgs", \
- pos, False, arg_name = text)
+ style = acc.style_at_pos(last_pos)
+ s, e, w = self._get_word_back(last_pos, acc)
+
+ ch = acc.char_at_pos(pos)
+ prv_ch = acc.char_at_pos(last_pos)
+ #print 'w = "%s", ' % (w, ch, )
+ log.debug('w = "%s", ch = "%s", prv_ch = "%s", pos = %d, curr_pos = %d ' % (w, ch, prv_ch, pos, curr_pos, ))
+ if style in self.word_styles:
+ if self._is_bquoted(w):
+ return None
+ s2, e2, w2 = self._get_word_back(s - 1, acc)
+ #print 'w2 = "%s" ' % (w2, )
+ log.debug( 'w2 = "%s" ' % (w2, ) )
+
+ if w2[-1] in ',(':
+ infun = self._in_func(last_pos, acc)
+ if infun is not None:
+ print 'complete variable or argument "%s" for "%s"' % ( w, infun[2], )
+ s2, e2, funcname, nargs, argnames, firstarg = infun
+ return Trigger(self.lang, TRG_FORM_CPLN, "args", s, False,
+ funcname = funcname, firstarg = firstarg, nargs = nargs,
+ argnames = argnames)
+ else:
+ return None
+ else:
+ vr = self._get_var_back(last_pos, acc)
+ if vr is not None:
+ print 'complete variable "%s"' % ( ''.join(vr[2]), )
+ return Trigger(self.lang, TRG_FORM_CPLN, "variable", vr[4],
+ False, obj_name = ''.join(vr[2]), cutoff = vr[3])
+ if w[-1] in ',(':
+ infun = self._in_func(s + 1, acc)
+ if infun is not None:
+ s2, e2, funcname, nargs, argnames, firstarg = infun
+ print 'arguments for "%s"' % ( infun[2], )
+ return Trigger(self.lang, TRG_FORM_CPLN, "args", \
+ pos, False, funcname = funcname, firstarg = firstarg,
+ nargs = nargs, argnames = argnames)
+
+ elif w[-1] in '@$:' or style in self.word_styles:
+ vr = self._get_var_back(last_pos, acc)
+ if vr is not None:
+ v = ''.join(vr[2])
+ print 'complete "%s"' % ( v, )
+ return Trigger(self.lang, TRG_FORM_CPLN, "variable", vr[4],
+ False, obj_name = v, cutoff = vr[3])
+ elif w in ('[', '[['):
+ infun = self._in_func(pos, acc)
+ if infun is not None:
+ s2, e2, funcname, nargs, argnames, firstarg = infun
+ log.debug('arguments for "%s"' % ( infun[2], ))
+ return Trigger(self.lang, TRG_FORM_CPLN, "args", \
+ pos, False, funcname = funcname, firstarg = firstarg,
+ nargs = nargs, argnames = argnames)
+
+ log.debug( 'None? w = "%s" ' % (w, ) )
+
return None
+# TODO: "variable-or-args" return also variables
def async_eval_at_trg(self, buf, trg, ctlr):
if _xpcom_:
trg = UnwrapObject(trg)
ctlr = UnwrapObject(ctlr)
pos = trg.pos
ctlr.start(buf, trg)
- #ctlr.set_desc("completing...")
- if trg.id == (self.lang, TRG_FORM_CPLN, "installed-pkgs") :
- if(trg.extra.has_key('arg_name')):
- text = trg.extra['arg_name']
- else:
- text = ''
- completions = self._get_completions_available_pkgs(text)
- if completions != None:
- ctlr.set_cplns(completions)
- ctlr.done("success")
- return
- else:
- ctlr.info("Not found for %r" % (trg, ))
- ctlr.done("none found")
- return
- if trg.id == (self.lang, TRG_FORM_CPLN, "list-elements") \
- and trg.extra.has_key('obj_name'):
- completions = self._get_completions(trg.extra['obj_name'])
- if(completions[0] == 'error'):
- ctlr.error(completions[1])
- ctlr.done("error")
- if completions == None or completions[1] == None:
- ctlr.debug("No completions found for '%s'" % (trg.extra['obj_name'], ))
- ctlr.done("nothing found")
- return
+ if trg.id == (self.lang, TRG_FORM_CPLN, "args") or \
+ trg.id == (self.lang, TRG_FORM_CPLN, "variable-or-args") :
+ completions = self._get_completions_args(trg.extra.get('funcname'),
+ trg.extra.get('firstarg'), trg.extra.get('nargs'),
+ trg.extra.get('argnames'))
+ elif trg.id == (self.lang, TRG_FORM_CPLN, "variable") or \
+ trg.id == (self.lang, TRG_FORM_CPLN, "sub-items") :
+ completions = self._get_completions_default(
+ trg.extra.get('obj_name'), trg.extra.get('cutoff'))
+ else:
+ ctlr.error("Unknown trigger type: %r" % (trg, ))
+ ctlr.done("error")
+ return
+
+ if completions == None or completions[0] != "success":
+ ctlr.error("Nothing found" if completions is None else completions[1])
+ ctlr.done("error")
+ else:
+ completions[1].sort(key = lambda x: x[1].lower() )
ctlr.set_cplns(completions[1])
ctlr.done(completions[0])
return
+ #ctlr.info("Not found for %r" % (trg, ))
+ #ctlr.done("none found")
+ #return
- #if trg.id == (self.lang, TRG_FORM_CPLN, "test-elements") :
- # ctlr.set_cplns([('keyword', "Bababa"), ('keyword', "Umpapa")])
- # ctlr.done("success")
- # return
+ #
+ # Rules for implementation:
+ #- Must call ctlr.start(buf, trg) at start.
+ #- Should call ctlr.set_desc(desc) near the start to provide a
+ # short description of the evaluation.
+ #- Should log eval errors via ctlr.error(msg, args...).
+ #- Should log other events via ctlr.{debug|info|warn}.
+ #- Should respond to ctlr.abort() in a timely manner.
+ #- If successful, must report results via one of
+ # ctlr.set_cplns() or ctlr.set_calltips().
+ #- Must call ctlr.done(some_reason_string) when done.
- ctlr.error("Unknown trigger type: %r" % (trg, ))
- ctlr.done("error")
+ def _get_completions_args(self, fname, frstarg, nargs, argnames):
+ fname = self._unquote(fname)
+ log.debug("fname = '%s'" % (fname, ) )
+ if fname in ('library', 'require', 'base::library', 'base::require') \
+ and nargs == 1:
+ #cmd = "cat(unique(unlist(lapply(.libPaths(), dir, pattern='%s'))), sep='\\n')" \
+ #% (('^' + frstarg if(frstarg) else ''), )
+ cmd = 'completeSpecial("library")'
+ types = 'module'
+ sfx = ''
+ argnames = ''
+ elif fname in ('detach', 'base::detach') and nargs == 1:
+ #cmd = "cat(unique(unlist(lapply(.libPaths(), dir, pattern='%s'))), sep='\\n')" \
+ #% (('^' + frstarg if(frstarg) else ''), )
+ cmd = 'completeSpecial("search")'
+ types = 'namespace'
+ sfx = ''
+ argnames = ''
+ else:
+ cmd = 'cat(getFunArgs("%s", %s), sep = "\\\n")' % (fname, frstarg, )
+ types = 'argument'
+ sfx = ' ='
+ res = R.execInR(cmd, "json h", .5)
+ if res.startswith(u'\x03') or not len(res.strip()):
+ return ('error', res.strip("\x02\x03\r\n"))
- #
- # Rules for implementation:
- #- Must call ctlr.start(buf, trg) at start.
- #- Should call ctlr.set_desc(desc) near the start to provide a
- # short description of the evaluation.
- #- Should log eval errors via ctlr.error(msg, args...).
- #- Should log other events via ctlr.{debug|info|warn}.
- #- Should respond to ctlr.abort() in a timely manner.
- #- If successful, must report results via one of
- # ctlr.set_cplns() or ctlr.set_calltips().
- #- Must call ctlr.done(some_reason_string) when done.
+ if len(argnames):
+ return ('success', [(types, x + sfx) for x in res.splitlines()
+ if not x in argnames ])
+ else:
+ return ('success', [(types, x + sfx) for x in res.splitlines() ])
- def _get_completions(self, text):
+ def _get_completions_default(self, text, cutoff):
if not text.strip(): return None
- cmd = 'completion("%s", print=TRUE, sep=";;", field.sep="?")' \
- % text.replace('"', '\\"')
+ cmd = 'completion("%s")' % text.replace('"', '\\"')
res = R.execInR(cmd, "json h", 2)
#TODO: on timeout an empty string is returned
#u'\x03Error: could not find function "completion"\r\n\x02'
if res.startswith(u'\x03'):
- return ('eval error', res.strip("\x02\x03\r\n"))
+ return ('error', res.strip("\x02\x03\r\n"))
cplstr = res.replace('\x03', '').replace('\x02', '')
if not cplstr: return None
- if (re.search("^\d+;;", cplstr) == None): return None
- cpl = [re.split("\\?", x) for x in re.split(";;", cplstr)[1:]]
- [x.reverse() for x in cpl]
- cpl = [tuple(x) for x in cpl]
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 437
More information about the Sciviews-commits
mailing list