## Do *NOT* use 1L -- it gives parse errors in historical versions of R .ess_funargs <- function(funname) { if(.ess.Rversion > '2.14.1') { ## temporarily disable JIT compilation and errors comp <- compiler::enableJIT(0) op <- options(error=NULL) on.exit({ options(op); compiler::enableJIT(comp) }) } ## don't remove; really need eval(parse( here!! fun <- tryCatch(eval(parse(text=funname)), error=function(e) NULL) ## also works for special objects containing @:$ etc if(is.function(fun)) { special <- grepl('[:$@[]', funname) args <- if(!special){ fundef <- paste(funname, '.default',sep='') do.call('argsAnywhere', list(fundef)) } if(is.null(args)) args <- args(fun) if(is.null(args)) args <- do.call('argsAnywhere', list(funname)) fmls <- formals(args) fmls_names <- names(fmls) fmls <- gsub('\"', '\\\"', gsub("\\", "\\\\", as.character(fmls),fixed = TRUE), fixed=TRUE) args_alist <- sprintf("'(%s)", paste("(\"", fmls_names, "\" . \"", fmls, "\")", sep = '', collapse = ' ')) allargs <- if(special) fmls_names else tryCatch(gsub('=', '', utils:::functionArgs(funname, ''), fixed = TRUE), error=function(e) NULL) allargs <- sprintf("'(\"%s\")", paste(allargs, collapse = '\" "')) envname <- environmentName(environment(fun)) if(envname == "R_GlobalEnv") envname <- "" cat(sprintf('(list \"%s\" %s %s)\n', envname, args_alist, allargs)) } } .ess_get_completions <- function(string, end){ if(.ess.Rversion > '2.14.1'){ comp <- compiler::enableJIT(0) op <- options(error=NULL) on.exit({ options(op); compiler::enableJIT(comp) }) } utils:::.assignLinebuffer(string) utils:::.assignEnd(end) utils:::.guessTokenFromLine() utils:::.completeToken() c(get('token', envir=utils:::.CompletionEnv), utils:::.retrieveCompletions()) } .ess_arg_help <- function(arg, func){ op <- options(error=NULL) on.exit(options(op)) fguess <- if(is.null(func)) get('fguess', envir=utils:::.CompletionEnv) else func findArgHelp <- function(fun, arg){ file <- help(fun, try.all.packages=FALSE)[[1]] hlp <- utils:::.getHelpFile(file) id <- grep('arguments', tools:::RdTags(hlp), fixed=TRUE) if(length(id)){ arg_section <- hlp[[id[[1]]]] items <- grep('item', tools:::RdTags(arg_section), fixed=TRUE) ## cat('items:', items, fill=TRUE) if(length(items)){ arg_section <- arg_section[items] args <- unlist(lapply(arg_section, function(el) paste(unlist(el[[1]][[1]], TRUE, FALSE), collapse=''))) fits <- grep(arg, args, fixed=TRUE) ## cat('args', args, 'fits', fill=TRUE) if(length(fits)) paste(unlist(arg_section[[fits[1]]][[2]], TRUE, FALSE), collapse='') } } } funcs <- c(fguess, tryCatch(methods(fguess), warning=function(w) {NULL}, error=function(e) {NULL})) if(length(funcs) > 1 && length(pos <- grep('default', funcs))){ funcs <- c(funcs[[pos[[1]]]], funcs[-pos[[1]]]) } i <- 1; found <- FALSE out <- 'No help found' while(i <= length(funcs) && is.null(out <- tryCatch(findArgHelp(funcs[[i]], arg), warning=function(w) {NULL}, error=function(e) {NULL}) )) i <- i + 1 cat('\n\n', as.character(out), '\n') }; ## Local Variables: ## eval: (ess-set-style 'RRR t) ## End: