Nothing
# readFile <- function( filename ) {
# f <- file(filename)
# lines <- readLines(filename)
# close( f )
# #print( lines )
# return( lines )
# }
#
# STRTRIM <- function( str ) {
# #print(str)
# ## leading spaces
# str <- sub('[[:space:]]*', '', str)
# ## lagging spaces
# return( sub('[[:space:]]*$', '', str) )
# }
#
# parseArguments <- function( lines ) {
# #print(lines)
#
# ## first separate into a list of strings
# cur <- 0
# lastEmpty <- FALSE
# res <- c()
# for( l in 1:length(lines) ) {
# if( lines[l]=="" ) {
# if( cur!=0 && lastEmpty==FALSE )
# cur<-cur+1
# lastEmpty<-TRUE
# }else{
# lastEmpty<-FALSE
# if( cur==0 ) cur <- 1
#
# #print( l )
# #print( res )
# ## ideally, we would want to trim lines[l], but I can't figure out how
# if( length(res) < cur ) {
# res[cur] <- STRTRIM(lines[l])
# }else{
# res[cur] <- paste( res[cur], STRTRIM(lines[l]), sep=" " )
# }
# }
# }
#
# ## Then split each list of strings on the _first_ ':'
# resNames <- c()
# for( i in 1:length(res) ) {
# spl <- unlist( strsplit( res[i], ":" ) )
# resNames[i] <- STRTRIM(spl[1])
#
# spl <- spl[-1]
# spl[1] <- STRTRIM(spl[1]) ## because of the : operator...
# res[i] <- paste( spl, collapse=":" )
# }
# names(res) <- resNames
# #print( resNames )
#
# return(res)
# }
#
# #splitOnColons <- function( lines ) {
# #
# # colonLines <- c( grep( ":", lines ), length(lines) )
# #
# # res <- list()
# # for( cl in 1:(length(colonLines)-1) ) {
# #
# # ## split var and descr on colon
# # spl <- unlist(strsplit(lines[colonLines[cl]],":"))
# # print( spl )
# # option <- spl[1]
# # spl <- spl[-1]
# # optionDesc <- paste( spl, collapse=":" )
# #
# # ## and put in the rest of the descr if there is one
# # if( colonLines[cl] != colonLines[cl+1]-1 )
# # optionDesc <- paste( optionDesc,
# # subset( lines, (colonLines[cl]+1):(colonLines[cl+1]-1) ),
# # collapse="\n" )
# #
# # ## and put it in the results
# # cur <- length(res)+1
# # res[[cur]] <- optionDesc
# # names(res)[cur] <- option
# # }
# #
# # return( res )
# #}
#
# # parseHelp <- function( func ) {
# # filename <- help( func, offline=FALSE, chmhelp=NA, htmlhelp=NA )[[1]]
# #
# # if( !file.exists(filename) ) {
# # ## It might be in a zip file in windows, lets try to extract it
# #
# # ## parse off the function name
# # funcname <- unlist( strsplit( filename, "/" ) )
# # funcname <- funcname[[length(funcname)]]
# #
# # ## get the path to the zip file
# # ziparchive <- paste( substr( filename, 1, nchar(filename)-nchar(funcname) ), "Rhelp.zip", sep="" )
# # if( file.exists(ziparchive) ) {
# # ## then we _can_ extract it
# # #filename <- zip.file.extract( funcname, ziparchive )
# # ## Arghhh!!!! Sometimes I really, _really_ hate R
# # tmpd <- tempdir()
# # rc <- .Internal( int.unzip(ziparchive,funcname,tmpd) )
# # if( rc==0 )
# # filename <- attr(rc,"extracted")
# # }
# # }
# #
# # ## Read in all of the lines
# # lines <- readFile( filename )
# #
# # ## Extract out the relevant lines
# # lineStart <- unlist( lapply( lines, substr, start=1, stop=2 ) )
# # section <- which( lineStart == "_\b" )
# # usageSection <- which( lines == "_\bA_\br_\bg_\bu_\bm_\be_\bn_\bt_\bs:" )
# #
# # sectionSection <- which( usageSection==section )
# # if( sectionSection == length(section) )
# # section <- c(section, length(lines)+1)
# # usageLinesB <- section[sectionSection]+1
# # usageLinesE <- section[sectionSection+1]-1
# # lines <- lines[usageLinesB:usageLinesE]
# #
# # return( parseArguments(lines) )
# # }
#
# ## DEBUG ONLY
# #lmHelp <- parseHelp( "lm" )
#
#
# # temp <- tools::Rd2txt(.getHelpFile(file), out = tempfile("Rtxt"),
# # package = pkgname)
#
#
# tools___fetchRdDB = function (filebase, key = NULL)
# {
# data <- paste(filebase, "rdb", sep = ".")
# v <- .readRDS(paste(filebase, "rdx", sep = "."))
# compress <- v$compressed
# v <- v$variables
# if (length(key)) {
# if (!key %in% names(v))
# stop(gettextf("No help on %s found in RdDB %s", sQuote(key),
# sQuote(filebase)), domain = NA)
# lazyLoadDBfetch(v[key][[1L]], data, compress, function(n) {
# })
# }
# else {
# res <- v
# for (i in seq_along(res)) res[[i]] <- lazyLoadDBfetch(v[i][[1L]],
# data, compress, function(n) {
# })
# invisible(res)
# }
# }
#
#
#
#
# parseHelp = function(func){
# #require(tools) ## Not required because it's in the 'Depends' of the package file...
#
# a = help(func)
# #print(dir(a[[1]]))
# toks = unlist(strsplit(a[[1]], "/"))
# toks = toks[-length(toks)]
# path = paste(toks, collapse="/")
# rdbfile = dir(path, pattern="*.rdb")
# toks = unlist(strsplit(rdbfile, "\\."))
# #print(toks)
# toks = toks[-length(toks)]
# rdbfile = paste(toks, collapse=".")
# rdbfile = paste(path, rdbfile, sep="/")
# #print(rdbfile)
# #rd = tools:::fetchRdDB(rdbfile, func)
# rd = tools___fetchRdDB(rdbfile, func)
# lines = readFile(tools::Rd2txt(rd, out=tempfile("Rtxt")))
#
#
# ## Extract out the relevant lines
# lineStart <- unlist( lapply( lines, substr, start=1, stop=2 ) )
# section <- which( lineStart == "_\b" )
# usageSection <- which( lines == "_\bA_\br_\bg_\bu_\bm_\be_\bn_\bt_\bs:" )
#
# sectionSection <- which( usageSection==section )
# if( sectionSection == length(section) )
# section <- c(section, length(lines)+1)
# usageLinesB <- section[sectionSection]+1
# usageLinesE <- section[sectionSection+1]-1
# lines <- lines[usageLinesB:usageLinesE]
#
# return( parseArguments(lines) )
# }
# #a = parseHelp2("cor")
#
#
#
# parseHelp = function(functionName = "rnorm"){
# file = help(functionName, help_type="text")
#
# #require(tools)
#
# ## Code taken from print.help_files_with_topic
# path <- dirname(file)
# dirpath <- dirname(path)
# pkgname <- basename(dirpath)
# RdDB <- file.path(path, pkgname)
# if (file.exists(paste(RdDB, "rdx", sep = "."))) {
# # temp <- tools::Rd2txt(tools:::fetchRdDB(RdDB,
# # basename(file)), out = tempfile("Rtxt"), package = pkgname)
# temp <- tools::Rd2txt(tools___fetchRdDB(RdDB,
# basename(file)), out = tempfile("Rtxt"), package = pkgname)
# #file.show(temp, title = gettextf("R Help on '%s'",
# # topic), delete.file = TRUE)
# file = temp
# }
# else {
# ##zfile <- zip.file.extract(file, "Rhelp.zip")
# zfile = unzip("Rhelp.zip", files=file)
# if (file.exists(zfile)) {
# first <- readLines(zfile, n = 1L)
# enc <- if (length(grep("\\(.*\\)$", first)))
# sub("[^(]*\\((.*)\\)$", "\\1", first)
# else ""
# if (enc == "utf8")
# enc <- "UTF-8"
# if (.Platform$OS.type == "windows"
# && enc == ""
# && l10n_info()$codepage < 1000)
# enc <- "CP1252"
# #file.show(zfile, title = gettextf("R Help on '%s'",
# # topic), delete.file = (zfile != file), encoding = enc)
# file = zfile
# }
# else stop(gettextf("No text help for '%s' is available:\ncorresponding file is missing",
# functionName), domain = NA)
# }
#
# ##return(file)
#
#
# lines = readFile(file)
#
# ## Extract out the relevant lines
# lineStart <- unlist( lapply( lines, substr, start=1, stop=2 ) )
# section <- which( lineStart == "_\b" )
# usageSection <- which( lines == "_\bA_\br_\bg_\bu_\bm_\be_\bn_\bt_\bs:" )
#
# sectionSection <- which( usageSection==section )
# if( sectionSection == length(section) )
# section <- c(section, length(lines)+1)
# usageLinesB <- section[sectionSection]+1
# usageLinesE <- section[sectionSection+1]-1
# lines <- lines[usageLinesB:usageLinesE]
#
# return( parseArguments(lines) )
#
# }
## I give up. This interface keeps changing. Disabled.
parseHelp = function(functionName = "rnorm"){
return("")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.