[R] Completion for proto objects

Vitalie S. vitosmail at rambler.ru
Sat Sep 12 10:59:18 CEST 2009


On Fri, 11 Sep 2009 18:56:36 +0200, Gabor Grothendieck
<ggrothendieck at gmail.com> wrote:

> in the devel version.  If that does not help let me know offline
> and I will try to help you.

Thanks Gabor,
I solved the problem.
Here is the code in case somebody else wants to have full completions for  
proto objects:

# slightly modified utils:::specialCompletions
specialCompletions1 <- function (text, spl)
{
     wm <- which.max(spl)
     op <- names(spl)[wm]
     opStart <- spl[wm]
     opEnd <- opStart + nchar(op)
     if (opStart < 1)
         return(character(0L))
     prefix <- substr(text, 1L, opStart - 1L)
     suffix <- substr(text, opEnd, 1000000L)
     if (op == "?")
         return(helpCompletions(prefix, suffix))
     if (opStart <= 1)
         return(character(0L))
     tryToEval <- function(s) {
         try(eval(parse(text = s), envir = .GlobalEnv), silent = TRUE)
     }
     comps <- switch(op, `$` = {
         if (.CompletionEnv$settings[["ops"]]) {
             object <- tryToEval(prefix)
             if (inherits(object, "try-error"))
                 suffix
             else {
                 if (!inherits(object, 'proto') && is.environment(object))  
{  ## this line is modified!!
                     ls(object, all.names = TRUE, pattern = sprintf("^%s",
                                                  makeRegexpSafe(suffix)))
                 }
                 else {
                     grep(sprintf("^%s", makeRegexpSafe(suffix)),
                          names(object), value = TRUE)
                 }
             }
         }
         else suffix
     }, `@` = {
         if (.CompletionEnv$settings[["ops"]]) {
             object <- tryToEval(prefix)
             if (inherits(object, "try-error"))
                 suffix
             else {
                 grep(sprintf("^%s", makeRegexpSafe(suffix)),
                      methods::slotNames(object), value = TRUE)
             }
         }
         else suffix
     }, `::` = {
         if (.CompletionEnv$settings[["ns"]]) {
             nse <- try(getNamespaceExports(prefix), silent = TRUE)
             if (inherits(nse, "try-error"))
                 suffix
             else {
                 grep(sprintf("^%s", makeRegexpSafe(suffix)),
                      nse, value = TRUE)
             }
         }
         else suffix
     }, `:::` = {
         if (.CompletionEnv$settings[["ns"]]) {
             ns <- try(getNamespace(prefix), silent = TRUE)
             if (inherits(ns, "try-error"))
                 suffix
             else {
                 ls(ns, all.names = TRUE, pattern = sprintf("^%s",
                                          makeRegexpSafe(suffix)))
             }
         }
         else suffix
     }, `[` = , `[[` = {
         comps <- normalCompletions(suffix)
         if (length(comps))
             comps
         else suffix
     })
     if (length(comps) == 0L)
         comps <- ""
     sprintf("%s%s%s", prefix, op, comps)
}

environment(specialCompletions1) <- asNamespace("utils")
assignInNamespace("specialCompletions", specialCompletions1, "utils")

## names for proto objects
names.proto <- function(x){
     .local <- function(x){
         if(inherits(x[[".super"]], "proto")) c(ls(x),  
Recall(x[[".super"]]))
         else ls(x)
     }
     unlist(.local(x))
}


## checks
tl <- list(abc="afdas")
p1 <- proto(p1_abc=123)
p2 <- proto(.=p1, p2_abc=23423)

names(p2)
#[1] "p2_abc" "p1_abc"
names(p1)
#[1] "p1_abc"

Completion works fine.

Vitalie.




More information about the R-help mailing list